{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: GIVE867)}}
====== GIVE867 ======
(George Source)
**Macros used:** [[george:macro:ADDRESS|ADDRESS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BACKWAIT|BACKWAIT]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CAPCA|CAPCA]], [[george:macro:COBJUSE|COBJUSE]], [[george:macro:DATUMA|DATUMA]], [[george:macro:DATUMB|DATUMB]], [[george:macro:EVENTFIN|EVENTFIN]], [[george:macro:EXTRACOR|EXTRACOR]], [[george:macro:FINDPUC|FINDPUC]], [[george:macro:FJOCA|FJOCA]], [[george:macro:FJOPCA|FJOPCA]], [[george:macro:FPCACA|FPCACA]], [[george:macro:FREEBACK|FREEBACK]], [[george:macro:FREEBAX|FREEBAX]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETBACK|GETBACK]], [[george:macro:GETBAX|GETBAX]], [[george:macro:GETWORD|GETWORD]], [[george:macro:HLSINFORM|HLSINFORM]], [[george:macro:HUNT2|HUNT2]], [[george:macro:ILLEGAL|ILLEGAL]], [[george:macro:JBCC|JBCC]], [[george:macro:JENV|JENV]], [[george:macro:KICKASWINT|KICKASWINT]], [[george:macro:LOCK|LOCK]], [[george:macro:MACCS|MACCS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:OUTBLOCN|OUTBLOCN]], [[george:macro:OUTPACKC|OUTPACKC]], [[george:macro:OUTPARC|OUTPARC]], [[george:macro:OUTPMILL|OUTPMILL]], [[george:macro:PCAPLUG|PCAPLUG]], [[george:macro:PERCOUNT|PERCOUNT]], [[george:macro:PROGBRKIN|PROGBRKIN]], [[george:macro:RUNPROG|RUNPROG]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:STEPBACK|STEPBACK]], [[george:macro:SWAPOUT|SWAPOUT]], [[george:macro:TESTRT|TESTRT]], [[george:macro:TESTTP|TESTTP]], [[george:macro:TRACE|TRACE]], [[george:macro:UNPLUG|UNPLUG]], [[george:macro:WORDFIN|WORDFIN]], [[george:macro:WRITEAUTO|WRITEAUTO]]
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 REQUEST99-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 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