GIVE867
(George Source)
Macros used: ADDRESS, ALTLEN, BACKWAIT, BXGE, BXL, BXU, CAPCA, COBJUSE, DATUMA, DATUMB, EVENTFIN, EXTRACOR, FINDPUC, FJOCA, FJOPCA, FPCACA, FREEBACK, FREEBAX, FREECORE, GEOERR, GETBACK, GETBAX, GETWORD, HLSINFORM, HUNT2, ILLEGAL, JBCC, JENV, KICKASWINT, LOCK, MACCS, MENDAREA, MFREEW, MHUNTW, MONOUT, OUTBLOCN, OUTPACKC, OUTPARC, OUTPMILL, PCAPLUG, PERCOUNT, PROGBRKIN, RUNPROG, SEG, SEGENTRY, SETNCORE, SETUPCORE, STEPBACK, SWAPOUT, TESTRT, TESTTP, TRACE, UNPLUG, WORDFIN, WRITEAUTO
- GIVE867.txt
22FL #OPT K0GIVE=0 22^= #LIS K0GIVE>K0OBJPROG>K0ALLGEO>K0GREATGEO 23?2 ... SEG GIVE,867,SECTION CENT 23JR ...[ 23NN ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983 23SK ...[ 24D6 # 24XQ # 25CB [ THIS SEGMENT IS ENTERED FROM OPCA TO PROCESS THE 25X2 ...[ 165 (GIVE) ORDER WITH N(M) = 4 OR 12. SEGMENT GIVEA DEALS WITH 26BL ...[ ALL OTHER VALUES OF N(M). (GIVE USED TO DEAL WITH THEM ALL BUT 26W= ...[ BECAME TOO BIG.) 27TG # 28*6 [ ENTRY POINT 28SQ SEGENTRY K1GIVE,ZEP1 29#B # 2?QG XK9 +K9 2#=6 XK +1024 2#PQ XMINK -1024 2*9B ...XMIN256 #77777400 2DLQ # 2F6B ZEP1 [ENTRY POINT FROM OPCA 2FL2 LDX 7 EVENT5(2) [ISOLATE X-FIELD OF EXTRACODE 2G5L SLC 7 3 2GK= ANDN 7 7 2H4W DATUMA 3 2HJG MACCS ,3 2J46 LDX 3 0 2JHQ ADX 3 7 2K3B LDXC 4 EVENT2(2) [(MODIFIED) OPERAND 2KF3 ... BCS (GEOERR) [MUST BE 4 OR 12 2KWN ... SBN 4 4 2L#* ... BZE 4 XG4 [J IF N(M) = 4 2LQ2 ... SBN 4 8 2M7M ... BZE 4 XG12 2MK# ... BRN (GEOERR) [IF N(M) NOT 4 OR 12 AS FOUND BY OPCA 2N2^ ...# 2NDQ STSLR STO 4 0(3) [STORE SINGLE-LENGTH REPLY 2NYB #SKI K6GIVE>99-99 2PD2 TRACE 4,GIVESLR 2PXL TC EVENTFIN 2QC= # 36KW XG12 375G [ GIVE(12) NEW ACTIVE CORE SIZE 37K6 [ CORE GIVEN MESSAGE INCLUDED BY G12MESS MACRO - HENCE THE LOCATING 384Q [ UNIVERSALS K2GIVE,K3GIVE DEFINED BY SEGENTRIES 3#FB CALL 6 SIZEA 3#^2 TXL 4 BCORSZ(1) 3*DL BCS XG12B [BRN IF REQUEST<CURRENT TOTAL 3*Y= LDX 4 BCORSZ(1) [ELSE SET REPLY=CURRENT TOTAL 3BCW XG12B 3BXG TXU 4 ACORSZ(1) [EXIT IF REQUEST = 3CC6 BCC STSLR [PRESENT ACTIVE CORE 3CWQ UNPLUG 3DBB CALL 6 TPTST 3DW2 DATUMB 6 3F*L ADDRESS 6,7,3 3FT= #SKI ELLS [ ACTIVATE CORE SCHEDULER TO USE 3G#W KICKASWINT [ NEWLY FREED CORE 3GSG STO 4 0(3) 3H#6 #SKI K6GIVE>99-99 3HRQ TRACE 4,GIV12REP 3J?B CAPCA 3JR2 SWAPOUT 3K2S ... CALL 3 XINVFPB [INVALIDATE ANY VALID FPB 3K=L FPCACA 1,2 3KQ= STO 4 ALIMIT(1) 3L9W HUNT2 1,BSTB,BSCB 3LPG LDX 6 4 3M96 SBN 6 1 [ENSURE A REMAINDER IN 3MNQ DVS 5 BSSS [THE RANGE 1 - [BSSS], 3N8B ADN 5 1 [NOT 0 - ([BSSS]-1) 3NN2 ADN 6 1 3P7L STO 4 ACORSZ(1) [UPDATE SCB 3PM= STO 5 AWRDNUM(1) 3Q6W STO 6 ASHEET(1) 3QLG [ K2GIVE **** 3R66 SEGENTRY K2GIVE 3RKQ BRN XG4Z1 3S5B # 3S*8 ...SIZEA 3SK2 ... JENV SIZE1,CMESTAR 3SSS ... NGN 0 128 3T4L BRN SZD 3T94 ...SIZE 3T*G ... JENV SIZE1,CMESTAR 3TFY ... NGN 0 64 3TLB ... BRN SZD 3TQS ...SIZE1 3TX= ... NGN 0 256 3W3W SZD LDX 4 0(3) 3WHG BNG 4 SZ [ERROR IF -VE 3X36 BZE 4 SZ [ERROR IF ZERO 3XGQ SBN 4 1 3Y2B SBX 4 0 [V IS CLEARED BY CALL 3YG2 BVSR SZ [ERROR IF TOO BIG 3Y^L ANDX 4 0 3^F= LDN 5 1 3^YW LDXC 0 ASU2(2) 42DG SBN 5 0 42Y6 LDXC 0 ASU3(2) 43CQ SBN 5 0 43XB LDXC 0 ASU4(2) 44C2 SBN 5 0 44WL BNG 5 SZB [J IF > 1 MEMBER NON-EXISTENT 45B= LDN 5 128 45TW BXL 4 5,SZ [ ELSE ERROR IF REQUEST < 128 46*G SZB FJOPCA 2 46T6 TESTRT XG12A,2 47#Q LDX 2 FX2 47SB MHUNTW 1,ASCBT 48#2 EXIT 6 0 48#* ... 48#N ...#UNS ISTDP 48*B ...( 48B4 ...[ SUBROUTINE TO INVALIDATE A VALID FPB FOR PROGRAM IF ONE EXISTS 48BQ ...[ X3 - LINK, ON EXIT X2=FX2. ENTRY MUST BE IN CPA 48CD ...XINVFPB 48D6 ... FJOCA 2,FX2 48DS ... JBCC XG4Z2,2,JBWASIN [J IF VALID FPB DOESN'T EXIST 48FG ... LDX 0 JOBNUM(2) [USE JOB NO. TO LOCATE FPB 48G8 ... LDN 2 BOBJUNUSE [BASE OF FPB CHAIN 48GW ...XG4FPB 48HJ ... LDX 2 FPTR(2) [LOAD NEXT FPB 48J= ... BXU 2 CXOBJUN,XG4Z3 48JY ... GEOERR 1,FPBMISNG 48K? ... 48KL ...XG4Z3 BXU 0 JOBNOWAS(2),XG4FPB [J IF NOT OUR FPB 48L# ... STOZ JOBNOWAS(2) 48M2 ... LDX 0 ALOGL(2) 48MN ... ADS 0 CINVFPB [ADD INTO INVALID FPB TOTAL 48NB ...XG4Z2 48P4 ... LDX 2 FX2 48PQ ... EXIT 3 0 48QD ...) 492T ... 49?= SZ UNPLUG 49H4 ... 49QW SZ1 4==G ILLEGAL ILLINS 4=Q6 ...# 5286 XG12A 52MQ LDX 2 FX2 537B XG3 53M2 # 546L [ GIVE(3) CORE STORE ALLOCATED TO PROGRAM 54L= # 5=26 LDX 4 ALIMIT(2) [GET SIZE 5=FQ BRN STSLR [J TO STORE SINGLE LENGTH REPLY 5=^B # 5#D= SCBC NGN 5 1 [ENTRY FOR MERELY UPDATING SCB 5#XW LDX 2 FX2 5*CG BRN SCB1 5*X6 SCBA LDN 5 1 [ENTRY FOR UNPLUG ETC,GETTING LOGICAL 5BBQ BRN UNP [ FILE NO,AND AVOIDING SWAPOUT 5BWB SCZ NGNC 5 1 [ENTRY FOR EVERYTHING,AVOIDING S/O 5CB2 SCB NGN 5 0 [NORMAL ENTRY 5CTL UNP SBX 3 FX1 5D*= UNPLUG 5DSW ADDRESS 2,7,1 5F#G STO 4 0(1) 5FS6 #SKI K6GIVE>99-99 5G?Q TRACE 4,GIVE4REP 5GRB CALL 6 TPTST 5H?2 LDX 1 FX2 5HQL BNG 5 SCY 5J== CAPCA 5JPW BNZ 5 SCB1 5K9G SWAPOUT 5KP6 SCB1 FPCACA 1,2 5L8Q BNG 5 SCB3 5LNB SCY ADX 3 FX1 5M82 SCB3 STO 1 GEN6 5MML HUNT2 1,BSTB,BSCB 5N7= LDX 0 AOBJLF(1) 5NLW STO 0 AWORK3(2) 5P6G NGX 0 5 5PL6 LDX 6 4 5Q5Q SBN 6 1 5QKB DVS 5 BSSS 5R52 ADN 6 1 5RJL BNG 0 SCB2 5S4= ADN 5 1 5SHW SMO GEN6 5T3G STO 4 ALIMIT 5TH6 LDX 0 BWRDNUM(1) 5W2Q STO 0 AWORK1(2) 5WGB LDX 0 BCORSZ(1) 5X22 STO 0 AWORK2(2) 5XFL LDX 7 ACORSZ(1) 5X^= STO 4 ACORSZ(1) 5YDW STO 4 BCORSZ(1) 5YYG STO 5 AWRDNUM(1) 5^D6 STO 5 BWRDNUM(1) 5^XQ STO 5 AWORK4(2) 62CB LDX 5 BSHEET(1) 62X2 STO 6 ASHEET(1) 63BL STO 6 BSHEET(1) 63W= EXIT 3 0 64*W SCB2 LDX 5 BSHEET(1) 64TG EXIT 3 0 65*6 # 65SQ TPTST TESTTP ,SCTP 66#B EXIT 6 0 66S2 SCTP STO 6 GEN6 67?L FINDPUC ,1 [TRUSTED PROGRAM 67R= LDX 6 ALIMIT(1) [CALC NEW PUC LIMIT 68=W SBX 6 ALIMIT(2) 68QG ADX 6 4 69=6 BNG 6 SZ1 [ILLEGAL IF PUC LIMIT -VE 69PQ BZE 6 SZ1 [ OR ZERO 6=9B LDN 2 1 6=P2 LDXC 0 ASU2(1) 6?8L SBN 2 0 6?N= LDXC 0 ASU3(1) 6#7W SBN 2 0 6#MG LDXC 0 ASU4(1) 6*76 SBN 2 0 6*LQ BNG 2 PUCN [J IF > 1 MEMBER OF PUC NON-EXISTENT 6B6B LDN 0 128 6BL2 BXL 6 0,SZ1 [ ELSE ERROR IF PUC LIMIT < 128 6C5L PUCN LDX 2 FX2 6CK= STO 6 ALIMIT(1) [SET NEW PUC LIMIT 6D4W BRN (GEN6) 6DJG # 6F46 NUSHT [INSERTS EXTRA SHEET NUMBERS IN SCB.IF ACOM7=0 WE TAKE 6FHQ [[X6] ENTRIES FROM A FULLB BLK;IF NOT THEN IT IS SHEET NO 6G3B STO 7 GEN4 6GH2 LDX 7 ACOMMUNE7(2) 6H2L BPZ 7 NUSH1 6HG= MHUNTW 1,BSTB,FULLB 6H^W NUSH1 FPCACA 2 6JFG HUNT2 2,BSTB,BSCB 6J^6 BPZ 7 NUSH2 6KDQ STO 1 GEN5 6KYB ADN 1 A1+2 6LD2 ADX 2 5 6LXL ADN 2 AOBJST 6MC= SMO 6 6MWW MOVE 1 0 6NBG FREECORE GEN5 6NW6 BRN (GEN4) 6P*Q NUSH2 SMO 5 6PTB STO 7 AOBJST(2) 6Q*2 BRN (GEN4) 6QSL # 6R#= XGET1 [GETS A SINGLE BACKING STORE SHEET AFTER TRANSFER FAILURE 6RRW SBX 7 FX1 6S?G LDX 2 FX2 6SR6 GETBACK AWORK3(2),PRIV 6T=Q ADX 7 FX1 6TQB EXIT 7 0 6W=2 # 6WPL XGET2 [GETS A SINGLE BACKING STORE SHEET FOR NORMAL USE 6X9= SBX 7 FX1 6XNW LDX 2 FX2 6Y8G GETBACK AWORK3(2) 6YN6 ADX 7 FX1 6^7Q EXIT 7 0 6^MB # 7272 ZERO STOZ 0(1) 72LL SBN 3 2 736= STOZ 1(1) 73KW LDN 2 2(1) 745G SBNC 3 512 74K6 BCS ZEZ 754Q ZEY MOVE 1 0 75JB ADN 2 512 [NO NEED TO UPDATE X1 7642 SBNC 3 512 76HL BCC ZEY 773= ZEZ MOVE 1 0(3) 77GW LDX 2 FX2 782G ZEX EXIT 0 0 78G6 # 78^Q STOZ SBX 7 FX1 79FB LDX 3 AWORK2(2) 79^2 ADN 3 1023 7=DL SMO FX1 7=Y= ANDX 3 XMINK 7?CW SBX 3 AWORK2(2) 7?XG BZE 3 STA 7#C6 TXL 4 3 7#WQ BCC STB 7*BB STC LDX 3 4 7*W2 STB SBX 4 3 7B*L GETWORD AWORK2(2),1,WRITE,3,3 7BT= ADS 3 AWORK2(2) 7C#W CALL 0 ZERO 7CSG BZE 4 STX 7D#6 STA SMO FX1 7DRQ TXL 4 XK 7F?B BCS STC [BRN IF <1K LEFT 7FR2 LDN 3 1024 7G=L BRN STB [ELSE LOOP TO ZEROISE 1K 7GQ= STX WORDFIN 7H9W ADX 7 FX1 7HPG EXIT 7 0 7JNQ # 7K8B # 7KN2 [ GIVE(4) NEW CORE ALLOCATION IF POSSIBLE 7L7L # 7MLG XG4 7N66 CALL 6 SIZE 7NKQ LDX 6 BCORSZ(1) 7P5B TXL 6 4 7PK2 BCS XG4A [BRN IF REQUEST>CURRENT TOTAL 7Q4L TXL 4 6 7QJ= BCS YG4A [BRN IF REQUEST<CURRENT TOTAL 7R3W XG4V TXU 6 ACORSZ(1) 7RHG BCC STSLR 7S36 XG4B [ACTIVE=CURRENT TOTAL 7SGQ CALL 3 SCB 7SQJ ... CALL 3 XINVFPB [INVALIDATE ANY VALID FPB 7T2B YG4B 7TG2 SBX 5 6 7T^L BZE 5 XG4Z 7WF= SBN 5 1 7WYW BNZ 5 XG4AA 7XDG SMO 6 [ONLY ONE SHEET TO BE FREED 7XY6 LDX 7 AOBJST(1) [SHET NUMBER 7YCQ LDN 6 1 7YXB SBS 6 ALOGLEN(1) [SHORTEN SCB BY ONE WORD 7^C2 FREEBACK AOBJLF(1),7 [FREE THE SHEET 7^WL BRN XG4Z 82B= XG4AA ADN 5 3 82TW SETUPCORE 5,3,BSTB,FULLB 83*G FPCACA 1,2 83T6 HUNT2 1,BSTB,BSCB 84#Q STO 5 A1(3) 84SB SBN 5 2 85#2 LDX 0 AOBJLF(1) 85RL STO 0 A1+1(3) 86?= ADN 6 AOBJST(1) 86QW LDN 7 A1+2(3) 87=G SMO 5 87Q6 MOVE 6 0 889Q LDX 6 ALOGLEN(1) 88PB SBX 6 5 8992 LDX 7 1 89NL ALTLEN 7,6 8=8= FREEBAX 8=MW MFREEW BSTB,EMPTYB 8?7G BRN XG4Z 8?M6 YG4A 8#6Q NGNC 0 1 8#LB TXL 4 ACORSZ(1) 8*62 BCC XG4B [BXG 8*KL CALL 3 SCZ 8B5= TXU 4 7 8BJW BCC YG4Y 8C4G [ J IF REQ =CURR ACTIVE 8CJ6 HUNT2 1,AOBJPROG,0 8D3Q SBX 7 4 8DHB SBS 7 COBJUSE [DECREMENT CORE USED FOR O/PS 8F32 LDX 7 1 8F4Y ...#UNS CA1D 8F6W ...( 8F8S ... ADX 4 CA1D 8F=Q ... SBN 4 A1 8F#N ...) 8FBL ...#UNS CA1D 8FDJ ...#SKI 8FGL ADN 4 A1D-A1 8G2= ALTLEN 7,4 [SHORTEN PROGRAM BLOCK 8GFW #SKI ELLS [ ACTIVATE CORE SCHEDULER TO USE 8G^G KICKASWINT [ NEWLY FREED CORE 8H3D ...#UNS CA1D 8H5B ...( 8H7# ... SBX 4 CA1D 8H9= ... ADN 4 A1 8H?8 ...) 8H*6 ...#UNS CA1D 8HC4 ...#SKI 8HF6 SBN 4 A1D-A1 8HYQ YG4Y CAPCA 8JDB FPCACA 1,2 8JY2 HUNT2 1,BSTB,BSCB 8KCL BRN YG4B 8KX= # 8LBW XG4A 8LWG FJOPCA 2 8Q*L ... LDX 5 JSIZE(2) [SAVE [JSIZE] OVER HLSINFORM 8QB4 ... LDX 0 AOBJCORES 8QBG ... BXGE 0 4,XSIZEOK [J IF REQUEST <OR= COREOBJECT 8QBY ... BXL 5 4,XSIZEOK [J IF REQUEST > JSIZE(MAXSIZE ETC.) 8QCB ... LDX 3 4 8QCS ... ADN 3 1023 [LOAD SIZE AND ROUND UP TO NEXT 'K' 8QD= ... SRL 3 10 [ FOR HLSINFORM 8QDN ...[ 8QF6 ...[ AS WE ARE IN PCA AND NEED TO BE IN CPA FOR HLSINFORM,WE NEED TO 8QFJ ...[ UNPLUG PROGRAM AND RETURN TO CPA.HOWEVER,AFTER HLSINFORM,WE NEED 8QG2 ...[ TO RETURN TO PCA AS CODE LATER(IN SUBR. SCBA) DOES A CAPCA TO GET 8QGD ...[ 8QGW ...[ TO THE CPA 8QH# ...[ 8QHQ ... UNPLUG 8QJ8 ... CAPCA 8QJL ...[ INFORM HLS THAT SIZE REQUIRED IS > COREOBJECT & < MAXSIZE 8QK4 ...[ 8QKG ... HLSINFORM XBRKIN,MAXSIZE,JOBNO(2),3,,,XOK 8QKY ... LDX 5 AOBJCORES [REQUEST DENIED 8QLB ...XOK [REQUEST GRANTED 8QLS ... PCAPLUG XBRKIN 8QM= ... BRN XG4BB 8QMN ...XBRKIN 8QN6 ... STEPBACK [IN CASE OF BREAK IN WE STEP BACK ONR 8QNJ ... PROGBRKIN [ AND REPORT BREAKIN 8QNR ... 8QP2 ...XSIZEOK 8QPD ... TXL 5 AOBJCORES 8QPW ... BCS XG4BB [IF [JSIXE] > COREOBJECT,WE USE 8QQ# ... LDX 5 AOBJCORES [ COREOBJECT 8QRG XG4BB 8R?6 LDX 0 AFREE 8RQQ TXL 0 4 8S=B BCS XG4C [BRN UNLESS ENOUGH FREE CORE LEFT 8SQ2 TXL 5 4 8T9L BCC XG4T [BRN IF REQUEST .LE. COREOBJECT 8TP= XG4C TXL 6 5 [SET X5 = MAX(X5,X6) 8W8W BCS XG4D 8WNG LDX 5 6 8X86 XG4D LDX 4 6 [SET X4 = MAX(X6,X0) 8XMQ TXL 4 0 8Y7B BCC XG4E 8YM2 LDX 4 0 8^6L XG4E TXL 5 4 [SET X4 = MIN(X4,X5) 8^L= BCC XG4U 925W LDX 4 5 9292 ...XG4U 92#6 ... JENV XG4UA,CMESTAR 92C= ... ANDX 4 CMIN64 92GB ... BRN XG4UB 92KG ... 92NL ...XG4UA 92RQ ... SMO FX1 92WW ... ANDX 4 XMIN256 9322 ...XG4UB 9356 TXL 6 4 93JQ BCC XG4V [BRN IF AMENDED REQUEST=CURRENT TOTAL 944B XG4T 94J2 CALL 3 SCBA 953L LDX 7 BCORSZ(1) 95H= SBX 7 ACORSZ(1) 962W SBX 6 5 96GG BZE 6 XG4P [J IF NO EXTRA SHEETS NEEDED 9726 LDX 3 1 [ OTHERWISE EXTEND SCB 97FQ LDX 0 ALOGLEN(3) 97^B ADX 0 6 98F2 STO 0 AWORK1(2) 98YL ALTLEN 3,AWORK1(2) 99D= XG4P BZE 7 NOSO [J IF ACTIVE=TOTAL TO AVOID S/O 99XW SWAPOUT 9=CG NOSO 9=X6 BZE 6 QS0 [J IF NO EXTRA SHEETS REQUIRED 9?BQ BCT 6 SHGT1 [J IF >1 EXTRA SHEET REQUIRED 9?WB CALL 7 XGET2 [ OTHERWISE,IF JUST ONE,GET IT 9#B2 BRN QS0 9#TL SHGT1 ADN 6 3 9**= SETUPCORE 6,3,BSTB,EMPTYB [GET SHEETS IF >1 REQUIRED 9*SW STO 6 A1(3) 9B#G LDX 0 AWORK3(2) 9BS6 STO 0 A1+1(3) 9C?Q GETBAX 9CRB NGS 6 ACOMMUNE7(2) [SET -VE IF SHEET INFO IN BSTB/FULLB 9D?2 [ BLOCK 9DQL QS0 EXTRACOR 4,YES [TRY TO EXTEND O/P BLK-J TO YES IF OK 9F== CALL 3 SCBC [OTHERWISE UPDATE SCB 9FG4 ... CALL 3 XINVFPB [INVALIDATE ANY VALID FPB 9FPW SBX 6 5 9G9G BZE 6 XG4SU 9GP6 CALL 7 NUSHT [ AND INSERT NEW SHEET NUMBERS 9H8Q SETNCORE 1024,7,AOBJPROG,BHWRITE 9HNB LOCK 7 [SET UP LOCKED BLOCK OF ZEROS 9J82 ADN 7 A1 9JML LDX 1 7 9K7= LDN 3 1024 9KLW CALL 0 ZERO 9L6G LDX 3 7 9LL6 XG4H SBN 6 1 [DECREMENT NO OF SHEETS NEEDING 0-ING 9M5Q XG4J NGN 7 1 [X7<0 FOR 1ST ATTEMPT AT A WRITE 9MKB XG4J1 LDX 4 BSSS [IF WE ARE ZEROISING THE LAST SHEET, 9N52 BNZ 6 XG4K [ FORM COUNT OF NO OF 1K BLOCKS TO 9NJL LDX 4 AWORK4(2) [ BE ZEROISED 9P4= ADN 4 1023 9PHW XG4K SRL 4 10 9Q3G FPCACA 1,2 9QH6 HUNT2 1,BSTB,BSCB 9R2Q BPZ 7 XG4K1 [IF WRITE HAS NOT PREVIOUSLY FAILED, 9RGB SMO 5 9S22 LDX 7 AOBJST(1) [ GET SHEET NUMBER 9SFL BRN XG4K2 9S^= XG4K1 SMO 5 [IF WRITE PREVIOUSLY FAILED,REPLACE- 9TDW STO 7 AOBJST(1) [ MENT SHEET NO IN X7 9TYG XG4K2 LDX 1 FX1 9WD6 XG4L WRITEAUTO BSET+ASWAP,XK(1),,AWORK3(2),EX7,3 9WXQ ADN 7 8 [NO OF BLOCKLETS IN 1K 9XCB BCT 4 XG4L [J IF MORE 1K BLOCKS TO ZEROISE 9XX2 XG4M ADN 4 1 9YBL BACKWAIT XG4M 9YW= BCT 4 XG4N [J IF FAILURE HAS OCCURED 9^*W ADN 5 1 [OTHERWISE INCREMENT PNTR TO NEXT SHT 9^TG BNZ 6 XG4H [ IN SCB,AND J IF MORE SHEETS TO OISE =2*6 SBN 3 A1 =2SQ FREECORE 3 [FREE LOCKED 1K ZERO BLOCK =3#B LDX 3 FX2 =3S2 LDX 4 FPTR(3) =4?L XG4SS LDX 3 4 [FREE ANY FQBLKS =4R= LDX 4 FPTR(3) =5=W LDX 0 ATYPE(3) =5QG TXL 0 CACT =6=6 BCC XG4ST =8N= BRN XG4SS =97W # =9MG XG4N CALL 7 XGET1 [IF A BS FAIL OCCURS,GET A NEW SHEET ==76 LDX 7 ACOMMUNE7(2) ==LQ BRN XG4J1 [ AND TRY AGAIN =?6B # =?L2 YES CALL 3 SCBC [IF O/P WAS SUCCESSFULLY EXTENDED, =*JG SBX 6 5 [ UPDATE SCB =B46 BZE 6 XG4Z =BHQ CALL 7 NUSHT =C3B BRN XG4Z =CH2 XG4SU SBX 4 AWORK2(2) =D2L BRN XG4SV =DG= XG4ST LDX 4 BSSS [ZEROISE NEW AREAS OF OLD ULTIMATE =D^W SBX 4 AWORK1(2) [ SHEET =FFG XG4SV BZE 4 XG4G =F^6 CALL 7 STOZ =GDQ XG4G =GYB XG4S =HD2 XG4Z FPCACA 3,FX2 =HXL LDX 4 ALIMIT(3) =KBG XG4ZZ LDX 7 ALMT(3) =KW6 LDX 0 ADTM(3) =L*Q ADX 0 ALIMIT(3) [CALCULATE NEW LIMIT FOR EXEC =LTB DCH 7 0 [ AND DUMP MODES BACK IN =M*2 STO 0 ALMT(3) =MSL ANDX 7 CACT [ FLOATING POINT OVERFLOW =N#= ORS 7 ALMT(3) [ AND UNDERFLOW =NRW TESTTP 3,XG4NR [UPDATE PUCS PDA WDS IF ITS =P?G BRN XG4NS =PR6 XG4NR FINDPUC 3,3 [ AN RCTP =Q=Q BRN XG4ZZ =QQB XG4NS =RPL [ K3GIVE **** =S9= SEGENTRY K3GIVE =SNW OUTBLOCN 6 =T8G OUTPACKC 4,1,PROGCORE =TN6 OUTPARC JOBMILL,TIMENOW =W7Q OUTPMILL =WMB MONOUT COREG4 [PUT CORE GIVEN MESSAGE IN MON. FILE =X72 PERCOUNT [OUTPUT CNT OF PERIPH TRANSFERS (S/J) =XLL XG4Z1 =Y6= FJOCA 3,2 =YKW LDX 5 JCSIZE(3) =^5G ANDX 5 BITS22LS [REMEMBER OLD SIZE =^K6 LDCT 0 #600 ?24Q ANDX 0 JCSIZE(3) ?2JB ORX 0 4 ?342 STO 0 JCSIZE(3) ?3HL LDX 0 COBJQUOTA ?43= BXGE 0 4,XG4X [J IF NEW SIZE < OR = OBJECTQUOTA ?4GW BXL 0 5,XG4X [J IF OLD SIZE > OBJECTQUOTA ?52G MONOUT BIGPROG [ ELSE ISSUE BIGPROG MESSAGE ?5G6 XG4X ?5^Q RUNPROG CH5B # CHK2 MENDAREA 25 CJ4L #END ^^^^ ...60121562000600000000