{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CORE867)}}
====== CORE867 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BACKWAIT|BACKWAIT]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHNUMCOD|CHNUMCOD]], [[george:macro:COBJUSE|COBJUSE]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ENDPAXES|ENDPAXES]], [[george:macro:EXTRACOR|EXTRACOR]], [[george:macro:FINDPUC|FINDPUC]], [[george:macro:FJOCA|FJOCA]], [[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:HUNT|HUNT]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNTW|HUNTW]], [[george:macro:ISSUCOM|ISSUCOM]], [[george:macro:JBCC|JBCC]], [[george:macro:JENV|JENV]], [[george:macro:KICKASWINT|KICKASWINT]], [[george:macro:LOADNOW|LOADNOW]], [[george:macro:LOCK|LOCK]], [[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:PARAPASS|PARAPASS]], [[george:macro:PERCOUNT|PERCOUNT]], [[george:macro:PROGAXES|PROGAXES]], [[george:macro:RTTEST|RTTEST]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SWAPOUT|SWAPOUT]], [[george:macro:TESTCOR|TESTCOR]], [[george:macro:TESTLOAD|TESTLOAD]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTTP|TESTTP]], [[george:macro:TRACE|TRACE]], [[george:macro:WORDFIN|WORDFIN]], [[george:macro:WRITEAUTO|WRITEAUTO]]
22FL #LIS K0CORE>K0ALLGEO>K0GREATGEO>K0COMMAND
22RB ... SEG CORE,867,SECTION CENT
2357 ...[
2394 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983
23#^ ...[
23YG #
24D6 # THIS SEGMENT IMPLEMENTS THE CORE COMMAND WHICH ALTERS
24XQ # THE MAXIMUM CORE AVAILABLE TO AN OBJECT PROGRAM TO
25CB # THE VALUE SPECIFIED, AND ALSO IMPLEMENTS THE MAXSIZE
25X2 # COMMAND.
26BL #
26W= # ENTRY POINTS:-
27*W #
27TG SEGENTRY K1CORE,ZEP1 [CORE COMMAND
28*6 SEGENTRY K2CORE,ZEP2 [MAXSIZE COMMAND
28MG ... SEGENTRY K3CORE,ZEP3 [MAXQUOTA COMMAND
28SQ #
2=?L #DEF PROGRND=64 [ROUNDING CONSTANT FOR MAXSIZE
2=HD ...#DEF PROGCMESTAR=256
2=R= XK +1024
2?=W XMINK -1024
2?GN ...XMIN256 #77777400
2?QG X128 +128
2#PQ XJD 8HJD 6, [INTERNAL JOBDATA COMMAND
2*46 ...XMQ 8HJD MQ
2*9B MAGIC +7036875 [2 TO POWER 46 / 10 TO POWER 7
2DLQ MAXSIZE #20000000
2F6B PROGRNDN -PROGRND
2F?J ...PROGCMESTRN -PROGCMESTAR
2FDQ ...XB2T13 #17776000
2FL2 #
2G5L # ERROR MESSAGES
2GK= XERM1 +JPARMIS [ %C PARAMETER MISSING
2H4W XERM2 +ICR [ %C INVALID CORE REQUEST
2HJG XERM3 +ICRA [ CURRENT CORE IMAGE IS LARGER THAN %
2J46 XERM4 +JRTCOR [ REALTIME PROGRAMS CANNOT ALTER THEI
2JBG ...XERM5 +IMQR
2JHQ # [ CORE SIZE
2K3B # ERROR EXITS
2KH2 NCORE LDN 3 XERM1
2L2L BRN XERR
2LG= WRCR LDN 3 XERM2
2L^W BRN XERR
2MFG WRCRA LDN 3 XERM3
2M^6 BRN XERR
2NDQ RTCOR LDN 3 XERM4
2NNH ... BRN XERR
2NR6 ...WRMQ LDN 3 XERM5
2NYB XERR SMO FX1
2PD2 LDX 7 0(3)
2PXL COMERRX 7
2QC= #
2QCW ...#UNS ISTDP
2QDG ...(
2QGB ...[ SUBROUTINE TO INVALIDATE A VALID FPB FOR JOBS PROGRAM IF ONE EXIST
2QH2 ...[ X7 - LINK, ON EXIT X2=FX2. ENTRY MUST BE IN CPA
2QHL ...XINVFPB
2QJ= ... FJOCA 2,FX2 [FIND JOB BLOCK
2QJW ... JBCC XG4Z2,2,JBWASIN [J IF VALID FPB DOESN'T EXIST
2QKG ... LDX 0 JOBNUM(2) [USE JOB NO. TO LOCATE FPB
2QL6 ... LDN 2 BOBJUNUSE [BASE OF FPB CHAIN
2QLQ ...XG4FPB
2QMB ... LDX 2 FPTR(2) [LOAD NEXT FPB
2QN2 ... BXU 2 CXOBJUN,XG4Z3
2QNL ... GEOERR 1,FPBMISNG
2QP= ...XG4Z3 BXU 0 JOBNOWAS(2),XG4FPB [J IF NOT OUR FPB
2QPW ... STOZ JOBNOWAS(2)
2QQG ... LDX 0 ALOGL(2)
2QR6 ... ADS 0 CINVFPB [ADD INTO INVALID FPB TOTAL
2QRQ ...XG4Z2
2QSB ... LDX 2 FX2
2QT2 ... EXIT 7 0
2QW= ...)
2QWW #
2RBG ZEP1 [ENTRY FOR CORE COMMAND
2RW6 PARAPASS [EXTRACT CORE REQUIRED
2S*Q HUNT 2,CPB,CUNI
2STB LDXC 7 ANUM(2)
2T*2 BCS NCORE [ERROR IF NO
2TSL BZE 7 NCORE [CORE SPECIFIED
2W#= CHNUMCOD ,2,XDED1 [ 1 IF BREAKIN
2WRW TESTREP CHNUMERR,XDEAD [ERROR IN CHNUMCON
2XR6 LDX 6 ACOMMUNE1(2) [REQUEST IN BINARY
2^=2 FJOCA 3,2
2^PL TESTLOAD 3,NODELAY
329= LOADNOW XDED1,XDEAD,0
32F4 ...
32NW NODELAY
347Q LDXC 6 6
34MB BCS WRCR [ERROR IF -VE
3572 BVSR £ [ENSURE OVF IS CLEAR
35BS ... JENV NODELA1,CMESTAR
35LL ADN 6 63
366= BVSR WRCR [ERROR IF TOO BIG
36KW ANDX 6 CMIN64
36MD ... BRN NODELA2
36P2 ...
36QJ ...NODELA1
36S6 ...
36TN ...
36X= ... ADN 6 255
36YS ... BVSR WRCR
372B ... ANDX 6 XMIN256(1)
373Y ...NODELA2
375G BZE 6 WRCR
37K6 FPCACA 3,2
384Q LDN 5 1
38JB LDXC 0 ASU2(3)
3942 SBN 5 0
39HL LDXC 0 ASU3(3)
3=3= SBN 5 0
3=GW LDXC 0 ASU4(3)
3?2G SBN 5 0
3?G6 BNG 5 XCC [J IF > 1 MEMBER NON EXISTENT
3?^Q BXL 6 X128(1),WRCR [ ELSE ERROR IF REQUEST < 128
3#FB XCC FJOCA 2
3#^2 RTTEST RTCOR,2
3*8S ...
3*DL LDX 2 FX2
3*Y= TESTTP 3,XTP
3BCW BRN XNTP [J IF NOT TP
3BXG XTP FINDPUC 3,1
3CC6 LDX 5 ALIMIT(1)
3CWQ SBX 5 ALIMIT(3) [CALC NEW PUC
3DBB ADX 5 6 [LIMIT(SIZE).
3DW2 BNG 5 WRCR
3F*L BZE 5 WRCR
3FT= LDN 7 1
3G#W LDXC 0 ASU2(1)
3GSG SBN 7 0
3H#6 LDXC 0 ASU3(1)
3HRQ SBN 7 0
3J?B LDXC 0 ASU4(1)
3JR2 SBN 7 0
3K=L BNG 7 PUCN [J IF > 1 MEMBER NOT EXISTENT
3KQ= SMO FX1
3L9W BXL 5 X128,WRCR [ ELSE ERROR IF PUC LIMIT < 128
3LPG PUCN STO 5 ALIMIT(1) [SET NEW PUC LIMIT
3M96 XNTP
3MNQ HUNT2 1,ASCBT,0,3
3N8B TXU 6 BCORSZ(1)
3NN2 BCS XCD
3P7L #
3PM= # REQUEST = CURRENT TOTAL CORE
3Q6W #
3QLG XCY TXU 6 ACORSZ(1)
3R66 BCC XCE [BRN IF REQUEST = CURRENT
3RKQ # [ACTIVE CORE ALSO
3S5B CALL 7 SCB [ELSE UPDATE SCB ETC
3S*8 ... CALL 7 XINVFPB [INVALIDATE ANY VALID FPB
3SK2 XCE
3W3W FPCACA 3,FX2
3WHG XSTPC LDX 7 ALMT(3)
3X36 LDX 0 ADTM(3)
3XGQ ADX 0 ALIMIT(3) [CALCULATE NEW LIMIT FOR EXEC
3Y2B DCH 7 0 [ AND DUMP MODES BACK IN
3YG2 STO 0 ALMT(3)
3Y^L ANDX 7 CACT [ FLOATING POINT OVERFLOW
3^F= ORS 7 ALMT(3) [ AND UNDERFLOW
3^YW TESTTP 3,XNOR [DO THE SAME THING FOR THE PUC IF ITS
42DG BRN XNOS
42Y6 XNOR FINDPUC 3,3 [ AN RCTP
43CQ BRN XSTPC
43XB XNOS
44WL OUTBLOCN 6
45B= OUTPACKC 6,1,PROGCORE
45TW OUTPARC JOBMILL,TIMENOW
46*G OUTPMILL
46T6 MONOUT CORE [WRITE MESSAGE SAYING CORE SIZE GIVEN
47#Q PERCOUNT [OUTPUT CNT OF PERIPH TRANSFERS (S/J)
47SB #SKI K6CORE>99-99
48#2 TRACE 6,NEWCORE
48RL FJOCA 3,2
49?= LDX 5 JCSIZE(3)
49QW ANDX 5 BITS22LS [REMEMBER OLD SIZE
4==G LDCT 0 #600
4=Q6 ANDX 0 BITS22LS
4?9Q ORX 0 6
4?PB STO 0 JCSIZE(3) [SET NEW SIZE
4#92 LDX 0 COBJQUOTA
4#NL BXGE 0 6,XDEAD [J IF NEW SIZE < OR = OBJECTQUOTA
4*8= BXL 0 5,XDEAD [J IF OLD SIZE > OBJECTQUOTA
4*MW MONOUT BIGPROG [ ELSE ISSUE BIGPROG MESSAGE
4B7G XDEAD ENDCOM
4B#N ...
4BFW ...
4BM6 XDED1 COMBRKIN
4BS# ...
4B^G ...
4C6Q SCBA NGN 5 1 [ENTRY FOR SETTING AWORK3,X4,X5 ONLY
4CLB BRN SCB1
4D62 SCB SBX 7 FX1 [ENTRY FOR UPDATING SCB WITH SWAPOUT
4DKL SWAPOUT [ AND EXIT WITH
4F5= ADX 7 FX1
4FJW SCZ LDN 5 0
4G4G SCB1 LDX 2 FX2
4GJ6 FPCACA 3,2
4H3Q HUNT2 1,ASCBT,0,3
4HHB LDX 0 AOBJLF(1)
4J32 STO 0 AWORK3(2) [LOGICAL FILE NO OF SWAP FILE
4JGL LDX 0 5
4K2= LDX 5 6
4KFW SBN 5 1 [ENSURE A REMAINDER IN THE RANGE
4K^G [ 1 TO [BSSS],NOT 0 TO ([BSSS]-1)
4LF6 DVS 4 BSSS
4LYQ ADN 5 1
4MDB BNG 0 SCB2 [IF ENTRY AT SCBA,AVOID UPDATING SCB
4MY2 ADN 4 1
4NCL STO 6 ALIMIT(3)
4NX= LDX 0 BWRDNUM(1)
4PBW STO 0 AWORK1(2)
4PWG LDX 0 BCORSZ(1)
4QB6 STO 0 AWORK2(2)
4QTQ LDX 0 ACORSZ(1)
4R*B STO 4 BWRDNUM(1)
4RT2 STO 4 AWRDNUM(1)
4S#L STO 4 AWORK4(2)
4SS= LDX 4 BSHEET(1)
4T?W STO 5 ASHEET(1)
4TRG STO 5 BSHEET(1)
4W?6 STO 6 ACORSZ(1)
4WQQ STO 6 BCORSZ(1)
4X=B EXIT 7 0
4XQ2 SCB2 LDX 4 BSHEET(1)
4Y9L EXIT 7 0
4YP= #
4^8W NUSHT [INSERTS EXTRA SHEET NUMBERS IN SCB.IF ACOM7<0 WE TAKE
4^NG [[X5] ENTRIES FROM A FULLB BLOCK;IF NOT THEN ACOM7 IS THE
5286 [NUMBER OF A SINGLE SHEET
52MQ STO 7 GEN4
537B LDX 7 ACOMMUNE7(2)
53M2 BPZ 7 NUSH1
546L MHUNTW 1,BSTB,FULLB
54L= NUSH1 FPCACA 2
555W HUNT2 2,BSTB,BSCB
55KG BPZ 7 NUSH2
5656 STO 1 GEN5
56JQ ADN 1 A1+2
574B ADX 2 4
57J2 ADN 2 AOBJST
583L SMO 5
58H= MOVE 1 0
592W FREECORE GEN5
59GG BRN (GEN4)
5=26 NUSH2 SMO 4
5=FQ STO 7 AOBJST(2)
5=^B BRN (GEN4)
5?F2 #
5?YL XGET1 [GETS A SINGLE BACKING STORE SHEET AFTER TRANSFER FAILURE
5#D= SBX 7 FX1
5#XW LDX 2 FX2
5*CG GETBACK AWORK3(2),PRIV
5*X6 ADX 7 FX1
5BBQ EXIT 7 0
5BWB XGET2 [GETS A SINGLE BACKING STORE SHEET FOR NORMAL USE
5CB2 SBX 7 FX1
5CTL LDX 2 FX2
5D*= GETBACK AWORK3(2)
5DSW ADX 7 FX1
5F#G EXIT 7 0
5FS6 #
5G?Q #
5GRB #
5H?2 # ZEROISATION ROUTINE
5HQL # START ADDRESS IN X1
5J== # LENGTH IN X3 (MULTIPLE OF 64 <1025)
5JPW #
5K9G ZERO STOZ 0(1)
5KP6 SBN 3 2
5L8Q STOZ 1(1)
5LNB LDN 2 2(1)
5M82 SBNC 3 512
5MML BCS ZEZ [BRN IF < 512 WORDS LEFT TO ZEROISE
5N7= ZEY MOVE 1 0
5NLW ADN 2 512 [NO NEED TO UPDATE X1
5P6G SBNC 3 512
5PL6 BCC ZEY
5Q5Q ZEZ MOVE 1 0(3)
5QKB LDX 2 FX2
5R52 ZEX EXIT 0 0
5RJL #
5S4= # ZEROISATION ROUTINE
5SHW # LENGTH (1 SHEET FOR FREEING,SET UP FULLB
6D4W SETUPCORE 4,3,BSTB,FULLB
6DJG XLA FJOCA 3,2
6F46 LDX 0 JMISC(3)
6FHQ SRL 0 3
6G3B ANDN 0 #6000
6GH2 BZE 0 XLC [J IF PROGRAM NOT SWAPPED IN
6H2L LDX 7 AWORK1(2)
6HG= BNG 7 XLC [J TO UPDATE SCB WITH SWAPOUT IF
6H^W [ CORE REQUEST > CURRENT ACTIVE
6JFG PROGAXES 3,XLA [CHECK OK TO ALTER PROG BLOCK - IF
6J^6 [ NOT,WAIT UNTIL OK THEN J TO XLA
6KDQ FPCACA 1,2
6KYB HUNT2 1,AOBJPROG,0
6LD2 SBS 7 COBJUSE [DECREMENT CORE USED FOR O/PS
6LXL NGX 7 7
6MC= ADX 7 ALOGLEN(1) [NEW LOGICAL LENGTH OF OBJECT PROGRAM
6MWW ALTLEN 1,7 [ SHORTEN O/P - NO COORDINATION
6N44 ...#SKI ELLS [ACTIVATE CORE SCHEDULER TO USE
6N9= ... KICKASWINT [NEWLY FREED CORE
6NBG ENDPAXES 3 [SIGNAL END OF PROGRAM ACCESS
6NW6 XLD CALL 7 SCZ [UPDATE SCB WITHOUT SWAPOUT
6P*Q BRN XLE
6PTB XLC CALL 7 SCB [UPDATE SCB WITH SWAPOUT
6Q58 ... CALL 7 XINVFPB [INVALIDATE ANY VALID FPB
6Q*2 XLE SBX 4 5
6QSL BZE 4 XCE [J IF NO SPARE SHEETS
6R#= BCT 4 XLG [J IF >1 SPARE SHEETS
6RRW ADN 4 1
6S?G SMO 5
6SR6 LDX 7 AOBJST(1) [GET SHEET NO OF SHEET TO BE FREED
6T=Q FREEBACK AOBJLF(1),7 [ AND FREE IT
6TQB BRN XLH
6W=2 XLG HUNTW 3,BSTB,FULLB [FIND FULLB AND SET IT UP IN REQUIRED
6WPL ADN 4 3 [ FORMAT
6X9= STO 4 A1(3)
6XNW SBN 4 2
6Y8G LDX 0 AOBJLF(1)
6YN6 STO 0 A1+1(3)
6^7Q SMO 5
6^MB LDN 7 AOBJST(1)
7272 LDN 0 A1+2(3)
72LL SMO 4
736= MOVE 7 0 [INSERT NUMBERS OF SHEETS TO BE FREED
73KW FREEBAX [FREE SPARE B/S SHEETS
745G MFREEW BSTB,EMPTYB
74K6 XLH FPCACA 3,2
754Q HUNT2 3,BSTB,BSCB
75JB LDX 7 ALOGLEN(3)
7642 SBX 7 4
76HL ALTLEN 3,7 [SHORTEN SCB BY NO OF SHEETS FREED
773= BRN XCE
77GW #
782G XCF
78G6 #
78^Q # REQUEST > PRESENT TOTAL
79FB #
79^2 LDX 4 BCORSZ(1)
7=Y= FJOCA 3,2 [CONSTRAINT IN ACC 5
7BY6 ... LDX 5 JSIZE(3) [SAVE [JSIZE] OVER HLSINFORM
7BYT ... LDX 0 AOBJCORES
7B^J ... BXGE 0 6,XSIZEOK [J IF REQUEST JSIZE(MAXSIZE ETC.)
7C32 ... LDX 7 6
7C3P ... ADN 7 1023 [LOAD SIZE AND ROUND UP TO NEXT 'K'
7C4D ... SRL 7 10 [ FOR HLSINFORM
7C57 ...[ INFORM HLS THAT SIZE REQUIRED IS > COREOBJECT & < MAXSIZE
7C5W ...[ JUMPS TO XDX1 IF REQUEST ALLOWED
7C6K ... HLSINFORM XDED1,MAXSIZE,JOBNO(2),7,,,XDX1
7C7# ... LDX 5 AOBJCORES [REQUEST DENIED
7C83 ... BRN XDX1
7C8B ...
7C8Q ...XSIZEOK
7C9F ... TXL 5 AOBJCORES
7C=8 ... BCS XDX [IF [JSIZE] > COREOBJECT,WE USE
7C=X ... LDX 5 AOBJCORES [ COREOBJECT
7CBD ...XDX1
7CF= ... LDX 2 FX2 [AS HLSINFORM MAY SET X1=FX1
7CJ4 ... FPCACA 1,2 [RESET X1 TO ASCBT
7CLW ... HUNT2 1,ASCBT,0
7CPN ...XDX LDX 0 AFREE
7CSG TXL 0 6
7D#6 BCS XDA [BRN UNLESS NO FREE CORE LEFT
7DRQ TXL 5 6
7F?B BCC XCA [BRN UNLESS REQUEST .GE. COREOBJECT
7FR2 XDA TXL 4 5
7G=L BCS XDB
7GQ= LDX 5 4
7H9W XDB LDX 6 4
7HPG TXL 6 0
7J96 BCC XDC
7JNQ LDX 6 0
7K8B XDC TXL 5 6
7KN2 BCC XDD
7L7L LDX 6 5 [X6=MIN(MAX(CURRENT TOTAL,COREOBJECT)
7LM= [ MAX(C.T.,AFREE))
7LQB ...XDD
7LTG ... JENV XDE,CMESTAR
7LYL ... ANDX 6 CMIN64
7M3Q ... BRN XDF
7M6W ...
7M=2 ...XDE
7M*6 ... SMO FX1
7MD= ... ANDX 6 XMIN256
7MHB ...XDF
7MLG TXU 6 BCORSZ(1)
7N66 BCC XCY
7NKQ XCA
7P5B CALL 7 SCBA [FIND NO OF NEW SHEETS NEEDED,ETC
7PK2 LDX 7 BCORSZ(1)
7Q4L SBX 7 ACORSZ(1)
7QJ= SBX 5 4
7R3W BZE 5 WCP [J IF NO NEW SHEETS NEEDED
7RHG LDX 3 1
7S36 LDX 0 ALOGLEN(3)
7SGQ ADX 0 5
7T2B STO 0 AWORK1(2)
7TG2 ALTLEN 3,AWORK1(2) [LENGTHEN SCB BY NO OF NEW SHEETS
7T^L WCP BZE 7 NOSO [IF ACTIVE1 EXTRA SHEET REQUIRED
7XY6 CALL 7 XGET2 [ OTHERWISE,IF JUST ONE, GET IT
7YCQ BRN QSO
7YXB SHGT1 ADN 5 3
7^C2 SETUPCORE 5,3,BSTB,EMPTYB [GET SHEETS IF >1 REQUIRED
7^WL STO 5 A1(3)
82B= LDX 0 AWORK3(2)
82TW STO 0 A1+1(3)
83*G GETBAX
83T6 NGS 5 ACOMMUNE7(2) [SET -VE IF SHEET INFO IN BSTB/FULLB
84#Q [ BLOCK
84SB QSO EXTRACOR 6,YES [TRY TO EXTEND O/P BLK-J TO YES IF OK
85#2 CALL 7 SCZ [OTHERWISE UPDATE SCB
85HS ... CALL 7 XINVFPB [INVALIDATE ANY VALID FPB
85RL SBX 5 4
86?= BZE 5 WCSU [J IF NO NEW SHEETS
86QW CALL 7 NUSHT [INSERT NEW SHEET NUMBERS IN SCB
87=G SETNCORE 1024,7,AOBJPROG,BHWRITE
87Q6 LOCK 7 [SET UP LOCKED BLOCK OF ZEROS
889Q ADN 7 A1
88PB LDX 1 7
8992 LDN 3 1024
89NL CALL 0 ZERO
8=8= LDX 3 7
8=MW WCH SBN 5 1 [DECREMENT NO OF SHEETS NEEDING 0-ING
8?7G WCJ NGN 7 1 [X7<0 FOR FIRST ATTEMPT AT A WRITE
8?M6 WCJ1 LDX 6 BSSS [IF WE ARE ZEROISING THE LAST SHEET,
8#6Q BNZ 5 WCK [ FORM COUNT OF NO OF 1K BLOCKS TO
8#LB LDX 6 AWORK4(2) [ BE ZEROISED
8*62 ADN 6 1023
8*KL WCK SRL 6 10
8B5= FPCACA 1,2
8BJW HUNT2 1,BSTB,BSCB
8C4G BPZ 7 WCK1 [IF WRITE HAS NOT PREVIOUSLY FAILED
8CJ6 SMO 4
8D3Q LDX 7 AOBJST(1) [ GET SHEET NUMBER
8DHB BRN WCK2
8F32 WCK1 SMO 4 [IF WRITE PREVIOUSLY FAILED,REPLACE-
8FGL STO 7 AOBJST(1) [ MENT SHEET NO IN X7
8G2= WCK2 LDX 1 FX1
8GFW WCL WRITEAUTO BSET+ASWAP,XK(1),,AWORK3(2),EX7,3
8G^G ADN 7 8 [NO OF BLOCKLETS IN 1K
8HF6 BCT 6 WCL [J IF MORE 1K BLOCKS TO ZEROISE
8HYQ WCM ADN 6 1
8JDB BACKWAIT WCM
8JY2 BCT 6 WCN [J IF FAILURE HAS OCCURED
8KCL ADN 4 1 [OTHERWISE STEP PNTR TO NEXT SHEET
8KX= BNZ 5 WCH [ IN SCB,& J IF MORE SHEETS TO ZEROIS
8LBW SBN 3 A1
8LWG FREECORE 3 [FREE LOCKED 1K ZERO BLOCK
8MB6 LDX 3 FX2
8MTQ LDX 4 FPTR(3)
8N*B WCSS LDX 3 4 [FREE ANY FQBLKS
8NT2 LDX 4 FPTR(3)
8P#L LDX 0 ATYPE(3)
8PS= TXL 0 CACT
8Q?W BCC WCST
8SQ2 BRN WCSS
8T9L #
8TP= WCN CALL 7 XGET1 [IF A BS FAIL OCCURS,GET A NEW SHEET
8W8W LDX 7 ACOMMUNE7(2)
8WNG BRN WCJ1 [ AND TRY AGAIN
8X86 #
8XMQ YES CALL 7 SCZ [IF O/P WAS SUCCESSFULLY EXTENDED
8Y7B [ UPDATE SCB
8^L= SBX 5 4
925W BZE 5 XCE
92KG CALL 7 NUSHT
9356 BRN XCE
93JQ #
944B WCSU SBX 6 AWORK2(2) [ZEROISE NEW AREAS OF OLD ULTIMATE
94J2 BRN WCSV [ SHEET
953L WCST LDX 6 BSSS
95H= SBX 6 AWORK1(2)
962W WCSV BZE 6 WCG
96GG CALL 7 STOZ
9726 WCG
97FQ WCS FPCACA 1,2
97^B LDX 6 ALIMIT(1)
98F2 BRN XCE
?SKM ...#
?SMB ...# THIS IMPLEMENTS THE MAXQUOTA COMMAND
?SP5 ...#
?SQS ...ZEP3 LDN 4 1
?SSH ... BRN ZEP3C
?SY6 #
?TCQ # THIS IMPLEMENTS THE MAXSIZE COMMAND WHICH
?TXB # SETS A BOUND JSIZE TO THE PROGRAM LENGTH
?WC2 #
?WWL ZEP2 [ENTRY FOR MAXSIZE COMMAND
?X6C ... LDN 4 0
?X92 ...ZEP3C
?XB= PARAPASS [EXTRACT LIMIT REQUIRED
?XTW HUNT 3,CPB,CUNI
?Y*G LDXC 7 ANUM(3) [ERROR IF NO CORE SPECIFIED
?YT6 BCS NCORE
?^#Q BZE 7 NCORE
?^SB CHNUMCOD ,3
#2#2 TESTREP CHNUMERR,XDEAD [ERROR IN CHNUMCON
#2RL LDX 6 ACOMMUNE1(2) [REQUESTED LIMIT
#2XT ... BZE 4 ZMZ1 [J IF FROM MZ
#2^= ... BNG 6 WRMQ
#32M ... BZE 6 WRMQ [J IF SILLY REQUEST
#344 ... ADN 6 1023
#35F ... ANDX 6 XB2T13(1) [ROUND UP TO K MULTIPLE
#36W ... BRN ZM02
#38? ...ZMZ1
#3?= BNG 6 WRCRA [ERROR IF < OR = ZERO
#3QW ... JENV ZMZ01,CMESTAR
#4=G ADN 6 PROGRND-1
#4Q6 ANDX 6 PROGRNDN(1) [ROUND UP REQUEST
#4S* ... BRN ZMZ11
#4WJ ...
#4YR ...ZMZ01
#532 ... ADN 6 PROGCMESTAR-1
#559 ... ANDX 6 PROGCMESTRN(1)
#57D ...ZMZ11
#59Q BXL 6 MAXSIZE(1),ZM02 [IF REQUESTED LIMIT > 4M, TAKE IT
#5PB LDX 6 MAXSIZE(1) [ AS 4M
#692 ZM02 FJOCA 3,2
#6NL TESTCOR 3,ZM021 [J IF CORE IMAGE EXISTS
#78= BRN ZM03 [ ELSE NO FURTHER RESTRICTION
#7MW ZM021
#8^G ... BNZ 4 ZM03 [J IF MQ IN G3
#96Q TESTLOAD 3,ZM022 [IN G3,SCB SET UP AFTER 'LOADNOW'
#9LB LDX 5 JCSIZE(3) [ HENCE,IF PROG NOT LOADED, GET ITS
#=62 BRN ZM023 [ SIZE FROM THE JOB BLOCK
#=KL ZM022
#?JW FPCACA 1,2
##4G HUNT2 1,BSTB,BSCB [FIND THE SWAP CONTROL BLOCK
#*3Q LDX 5 BCORSZ(1) [GET PROGRAMS DORMANT LIMIT
#CMN ...ZM023 BXGE 6 5,ZM03 [J IF REQUEST OK
#CPL ... BZE 4 WRCRA [J IF MAXSIZE
#CRJ ... BRN WRMQ
#DF6 ZM03
#DL? ... BZE 4 ZMZ3 [J IF MZ
#DRD ... BRN ZMZ4
#DT7 ...ZMZ3
#DYQ STO 6 JSIZE(3) [STORE LIMITING SIZE
#F8J ...ZMZ4
#FDB # NOW ISSUE INTERNAL JOBDATA COMMAND TO UPDATE INFO IN :SYSTEM.JOBLIST
#FY2 ... SETNCORE CPDATA-A1+4,2,ADATA,CREADL [READLINE BUFFER FOR COMMAN
#GCL LDN 0 15
#GX= STO 0 A1(2) [SET NO OF CHARACTERS
#H54 ... BZE 4 ZMZ5
#H72 ... LDN 4 XMQ(1)
#H8Y ... BRN ZMZ6
#H=W ...ZMZ5
#HBW LDN 4 XJD(1)
#HLN ...ZMZ6
#HWG LDN 5 CPDATA(2)
#JB6 MOVE 4 2 [MOVE IN'JD 6,'
#JNG ... SBN 4 XJD(1)
#JTQ MPY 6 MAGIC(1) [NOW SET IN DECIMAL FORM OF ROUNDED
#K*B MODE 1 [ UP MZ LIMIT AS 2ND PARAM OF JD
#KT2 ... LDN 0 6
#L#L ZM05 CBD 6 CPDATA+2(2)
#LS= BCHX 2 £
#M?W BCT 0 ZM05
#MF4 ... MODE 0 [DON'T ERASE LAST ZERO
#ML= ... CBD 6 CPDATA+2(2) [ (IF IT SHOULD BE A ZERO)
#MNW ... ISSUCOM WRISSU
#N3# ...WRISSU [COMMAND ERRORS REPORTED BY JOBDATA(B2033)
#N?6 ENDCOM
#NQQ MENDAREA 20
#P=B #END
^^^^ ...06201123000600000000