CORE867

(George Source)

Macros used: ALTLEN, BACKWAIT, BXGE, BXL, BXU, CHNUMCOD, COBJUSE, COMBRKIN, COMERRX, ENDCOM, ENDPAXES, EXTRACOR, FINDPUC, FJOCA, FPCACA, FREEBACK, FREEBAX, FREECORE, GEOERR, GETBACK, GETBAX, GETWORD, HLSINFORM, HUNT, HUNT2, HUNTW, ISSUCOM, JBCC, JENV, KICKASWINT, LOADNOW, LOCK, MENDAREA, MFREEW, MHUNTW, MONOUT, OUTBLOCN, OUTPACKC, OUTPARC, OUTPMILL, PARAPASS, PERCOUNT, PROGAXES, RTTEST, SEG, SEGENTRY, SETNCORE, SETUPCORE, SWAPOUT, TESTCOR, TESTLOAD, TESTREP, TESTTP, TRACE, WORDFIN, WRITEAUTO

CORE867.txt
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 (<BSSS) IN X6  
5T3G    #     START ADDRESS IN AWORK2(2)
5TH6    #   
5W2Q    STOZ  SBX   7  FX1  
5WGB          LDX   3  AWORK2(2)           [FIND DISTANCE TO
5X22          ADN   3  1023                 [NEXT MULTIPLE OF 1K
5XFL          SMO      FX1  
5X^=          ANDX  3  XMINK
5YDW          SBX   3  AWORK2(2)
5YYG          BZE   3  STA                 [BRN IF START ADR DIVISIBLE BY 1K
5^D6          TXL   6  3
5^XQ          BCC      STB                 [BRN IF MORE THAN THIS TO ZEROISE
62CB    STC   LDX   3  6                   [AMOUNT TO ZEROISE THIS TIME ROUND   
62X2    STB   SBX   6  3                    [LOOP - REDUCE COUNT
63BL          GETWORD  AWORK2(2),1,WRITE,3,3
63W=          ADS   3  AWORK2(2)           [UPDATE START ADR
64*W          CALL  0  ZERO 
64TG          BZE   6  STX  
65*6    STA   SMO      FX1  
65SQ          TXL   6  XK   
66#B          BCS      STC                 [BRN IF <1K LEFT TO ZEROISE  
66S2          LDN   3  1024 
67?L          BRN      STB                 [ELSE LOOP TO ZEROISE 1K 
67R=    STX   WORDFIN   
68=W          ADX   7  FX1  
68QG          EXIT  7  0
69=6    #   
69PQ    XCD   TXL   6  BCORSZ(1)
6=9B          BCC      XCF  
6=P2    #   
6?8L    #     REQUEST < CURRENT TOTAL   
6?N=    #   
6#7W          CALL  7  SCBA                [FIND NO OF EXCESS SHEETS ETC
6#MG          LDX   0  ACORSZ(1)
6*76          SBX   0  6
6*LQ          STO   0  AWORK1(2)           [REMEMBER CURRENT ACTIVE MINUS REQUES
6B6B          SBX   4  5
6BL2          SBN   4  2
6C5L          BNG   4  XLA                 [J IF NO OR JUST ONE SHEET TO BE FREE
6CK=    XLB   ADN   4  4                   [IF >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 <OR= COREOBJECT
7C2? ...      BXL   5  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 ACTIVE<CURRENT,SWAP OUT O/P TO   
7WF=          SWAPOUT                      [ ENSURE EXTRACOR FAILS  
7WYW    NOSO  BZE   5  QSO                 [J IF NO EXTRA SHEETS NEEDED 
7XDG          BCT   5  SHGT1               [J IF >1 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
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1