EXINTO867

(George Source)

Macros used: ACROSS, ALTLEN, CHUCKWR, CLOSEST, CLOSEWR, EXMESS, FIPPER, FREECORE, GEOERR, GETWORD, KEEPMESS, MENDAREA, MFINDEXOF, MFINDSU, MHUNT, MHUNTW, OPENST, READSAVE, READST, RELST, RUNPROG, SEGENTRY, TESTREPNOT, UNLOCKSU, WORDFIN, WRITEST

EXINTO867.txt
22FL ...#SEG  EXINTO70                     [BACK
22KH ...#   
22PD ...#     COPYRIGHT INTERNATIONAL COMPUTERS LTD   1982  
22T* ...#   
22^=    #LIS  K0EXINTO  
23DW          8HEXINTO  
23YG    #   
24D6    #DEF HNEW=CELLB 
24XQ    #DEF  XCA=EVENT2
25CB    #   
25X2    #   
26BL          SEGENTRY K3EXINTO,QK3EXINTO   
26W=    #   
27*W    ZMASK          #37777777
27TG    ZMASK1         #00777777
28*6    Z6             +6   
28SQ    ZEWG           +EWGORN  
29#B    #FID  1 1 1 
29S2    #   
2=?L    RERITEA 
2=R=          LDX   4  ARQS(3)  
2?=W          STO   4  1(2)                [STARTING BLOCK  
2?QG          LDX   5  AREQT+3(3)   
2#=6          ADN   5  1                   [ENDING BLOCK+1  
2#PQ          LDX   6  AREQT+2(3)   
2*9B          BNZ   6  ZA85                [IF STARTING BLOCK NON ZERO ...  
2*P2          TXU   5  7                   [...AND/OR END BLOCK NOT EQUAL TO... 
2B8L          ADN   6  0                   [...AREA DEPTH-AREA IS NOT FULL DEPTH
2BN=    ZA85  LDX   4  AREQT+1(3)   
2C7W          MPA   4  7                   [ENDING BLOCK
2CMG          STO   5  2(2) 
2D76          BZE   6  ZA86                [BRANCH IF FULL DEPTH
2DLQ          LDCT  6  256                 [SET FULL DEPTH BIT  
2F6B          ORS   6  2(2) 
2FL2    ZA86  STO   7  4(2)                [S.U.DEPTH   
2G5L          EXIT  0  0
2GK=    #   
2H4W    #   
2HJG    ZAE70 LDN   4  0                   [X4=REPLY FOR BREAKIN
2J46          BRN      ZCANT
2JHQ    ZA10  LDN   4  6                   [X4=REPLY STORAGE UNIT NOT ONLINE
2K3B    ZCANT ACROSS   EXINONE,4
2KH2    ZAE15 MHUNT    3,EWDAS,GEXD 
2L2L          LDX   5  ARUNIT(3)
2LG=          TXU   5  HMUNIT(3)           [AREA UNIT=HOME UNIT?
2L^W          BCC      ZFR2                [BRANCH IF EQUAL 
2MFG          LDX   1  FX1  
2M^6          KEEPMESS ZEWG(1),5,ARQS(3)   [SPECIFIED AREA LOST TO SYSTEM   
2NDQ    ZFR2  LDN   7  0                   [MARKER FOR EXTEND   
2NYB          LDCT  4  #40                 [REPLY = FAILURE 
2PD2          BRN      ZJRB9
2PXL    ZAE9
2QC=    ZAF9  LDCT  4  #40                 [REPLY=FAILURE   
2QWW          LDN   7  1                   [MARKER FOR SCEX 
2RBG          BRN      ZJRB9
2RW6    ZAE11 LDN   4  0                   [REPLY=SYSTEM CONTROL AREA FULL  
2S*Q          NGN   7  1                   [MARKER FOR SCEX 
2STB          MHUNT    3,EWDAS,GEXD 
2T*2          CLOSEST  ZJRB5               [CLOSE UNIT TO TRANSFER SYSTEM   
2TSL          TESTREPNOT OK,ZAE9
2W#=    ZJRB9 MHUNT    3,EWDAS,GEXD 
2WRW    ZJRB5 LDCT  0  128  
2X?G          ANDX  0  EMARK(3)            [SEE IF MODE #1500...
2XR6          BZE   0  ZJRB6               [...BRANCH IF SO 
2Y=Q          ACROSS   SCEXEND,3
2YQB    ZJRB6 ACROSS   EXINONE,5
2^=2    #   
2^PL    QK3EXINTO   
329=          MHUNT    3,EWDAS,GEXD 
32NW    ZAA6  SMO      6
338G          LDN   5  0
33N6          BNZ   5  ZA67                [ANY VACANT CELLS NEEDED?
347Q          LDX   5  EMARK(3) 
34MB          BPZ   5  ZA68                [IS AREA A SCRATCH FILE? 
3572          LDCT  6  #400 
35LL          SMO      CELLA+5(3)          [SET FULL DEPTH MARKER   
366=          ANDX  6  2
36KW          CLOSEST  ZAA9                [IF IT IS TERMINATE TRANSFERS
375G          MHUNT    3,EWDAS,GEXD 
37K6          TESTREPNOT OK,ZAE9           [FAIL REPLY  
384Q          BRN      ZAA9 
38JB    ZA68  SMO      CELLA+5(3)   
3942          LDX   0  0                   [ADDRESS OF NEXT UNALLOCATED AREA
39HL          STO   0  HNEW(3)  
3=3=          BRN      ZAA8 
3=GW    ZA67  SMO      AWORK4(2)           [CORE ADDRESS OF SCH 
3?2G          LDX   4  12   
3?G6          BZE   4  ZAE11               [REPLY 0 IF NO VACANT CELLS  
3?^Q          READSAVE 4,ZA70              [READ FIRST VACANT CELL  
3#FB          TESTREPNOT OK,ZAE9
3#^2          LDX   1  ECOR(3)  
3*DL    ZA70  STO   1  HNEW+1(3)           [REMEMBER CORE ADDRESS OF CELL   
3*Y=          STO   4  HNEW(3)             [REMEMBER B.S. ADDRESS OF CELL   
3BCW          BCT   6  ZA71                [ANY MORE CELLS REQUIRED?
3BXG          BRN      ZA72 
3CC6    ZA71  LDX   4  0(1) 
3CWQ          BZE   4  ZAE11               [REPLY 0 IF NOT ENOUGH VACANT CELLS  
3DBB          READSAVE 4,ZA72              [READ CELL   
3DW2          TESTREPNOT OK,ZAE9
3F*L    ZA73  LDX   1  ECOR(3)  
3FT=    ZA72  STO   1  HNEW+2(3)           [REMEMBER CORE ADDRESS OF CELL   
3G#W          MFINDSU  1,ARUNIT(3)         [FIND ASTUC FOR AREA UNIT
3GSG          LDX   5  CEXTEND(1)          [LOAD COUNT OF EXTENDS   
3H#6          LDX   0  EMARK(3) 
3HRQ          SLL   0  1                   [IS EXTEND MODE #1500?   
3J?B          BPZ   0  ZA74                [BRANCH IF SO
3JR2          LDX   0  ARUNIT(3)
3K=L          TXU   0  HMUNIT(3)           [IF AREA UNIT=HOME UNIT SUBTRACT...  
3KQ=          BCS      ZA74                [...ONE FROM COUNT OF EXTENDS
3L9W          SBN   5  1
3LPG    ZA74  BZE   5  ZAA7                [IF NO OUTSTANDING EXTENDS-OK
3M96    ZA75  SMO      ECOR(3)  
3MNQ          LDX   4  0
3N8B          BZE   4  ZAE11               [READ DOWN VACANT CELL CHAIN...  
3NN2          SBN   5  1                   [...TO ENSURE ENOUGH VACANT CELLS... 
3P7L          BZE   5  ZAA7                [...FOR ALL OUTSTANDING EXTENDS  
3PM=          READST   4,ZA75   
3Q6W          TESTREPNOT OK,ZAE9
3QLG          BRN      ZA75 
3R66    ZAA7  SMO      HNEW+2(3)           [DECHAIN VACANT CELL(S) FROM...  
3RKQ          LDX   4  0                   [...VACANT CELL CHAIN
3S5B          LDX   2  FX2  
3SK2          SMO      AWORK4(2)
3T4L          STO   4  12   
3TJ=          WRITEST  C,AWORK4(2),ZA76    [WRITE AWAY SCH  
3W3W          TESTREPNOT OK,ZAE9
3WHG    ZA76  SMO      CELLA+5(3)   
3X36          LDX   5  0                   [CHAIN LAST VACANT CELL INTO...  
3XGQ          LDX   2  HNEW+2(3)           [UNALLOCATED AREA CHAIN  
3Y2B          STO   5  0(2) 
3YG2          SLC   6  1                   [IS MARKER = SPLIT OFF CYLINDERS SET 
3Y^L          BPZ   6  ZA77                [BRANCH IF NOT   
3^F=          LDX   0  ARUNIT(3)           [REWRITE SECOND VACANT CELL TO...
3^YW          STO   0  3(2)                [DESCRIBE AREA CREATED BY SPLITTING. 
42DG          LDX   4  AREQT+1(3)          [...OFF CYLINDERS
42Y6          ADN   4  1
43CQ          LDX   5  AREQT+2(3)   
43XB          MPA   4  EDEPF(3)            [CONVERT START BLOCK NUMBER  
44C2          STO   5  1(2) 
44WL          LDX   4  EDEPF(3)            [DEVICE DEPTH
45B=          STO   4  4(2) 
45TW          SMO      CELLA+5(3)          [END BLOCK AND FULL DEPTH MARKER...  
46*G          LDX   4  2                   [...AS FOR AREA UNALLOCATED  
46T6          STO   4  2(2) 
47#Q          CHUCKWR  C,2,ZA78            [WRITE NEW UNALLOCATED AREA CELL 
47SB          TESTREPNOT OK,ZAE9
48#2    ZA78  ANDN  6  1                   [IS MARKER = SPLIT OFF BLOCK SET?
48RL          BZE   6  ZA79                [BRANCH IF NOT   
49?=    ZA77  LDX   2  HNEW+1(3)
49QW          LDX   0  ARUNIT(3)           [REWRITE FIRST VACANT CELL TO... 
4==G          STO   0  3(2)                [DESCRIBE AREA CREATED BY SPLITTING  
4=Q6          LDX   0  EDEPF(3)            [...OFF BLOCKS   
4?9Q          STO   0  4(2)                [DEVICE DEPTH
4?PB          LDX   4  AREQT(3) 
4#92          LDX   5  AREQT+3(3)   
4#NL          ADN   5  1
4*8=          MPA   4  EDEPF(3)            [CALCULATE START BLOCK NO.   
4*MW          STO   5  1(2) 
4B7G          LDX   4  AREQT+1(3)   
4BM6          LDX   5  CELLA+3(3)          [CALCULATE END BLOCK NO. 
4C6Q          MPA   4  EDEPF(3) 
4CLB          ADN   5  1
4D62          ORX   5  GSIGN               [NOT FULL DEPTH  
4DKL          STO   5  2(2) 
4F5=          CHUCKWR  C,2,ZA79            [WRITE NEW UNALLOCATED AREA CELL 
4FJW          TESTREPNOT OK,ZAE9
4G4G    ZA79  LDX   0  EMARK(3) 
4GJ6          BPZ   0  ZAA8                [BRANCH IF NOT A SCRATCH FILE
4H3Q          LDX   2  CELLA+5(3)   
4HHB          LDX   0  ARUNIT(3)
4J32          STO   0  3(2)                [SERIAL NO. TO AREA UNIT 
4JGL          LDX   7  EDEPF(3) 
4K2=          CALL  0  RERITEA             [SET UP CELL TO DESCRIBE AREA... 
4KFW          LDX   0  HNEW(3)             [...REQUESTED
4K^G          STO   0  0(2) 
4LF6          CLOSEWR  C,2                 [WRITE AWAY CELL AND END ACCESS...   
4LYQ          MHUNT    3,EWDAS,GEXD        [...TO THIS STORAGE UNIT 
4MDB          TESTREPNOT OK,ZAE9
4MY2    ZAA9  LDX   0  ARUNIT(3)
4NCL          STO   0  HMUNIT(3)           [SET AREA=HOME UNIT FOR SCEX 
4NX=          MFINDSU  2,HMUNIT(3)  
4PBW          LDX   4  CSCRATCH(2)  
4PWG          ADN   4  HSCRATCH-A1         [SEE IF BIG ENOUGH FOR ANOTHER...
4QB6          TXL   4  ALOGLEN(2)          [ENTRY INTO SCRATCH LIST 
4QTQ          BCS      ZA92 
4R*B          ADN   4  1
4RT2          LDX   5  2
4S#L          ALTLEN   5,4                 [-IF NOT ALTLEN  
4SS=          SBN   4  1
4T?W          MHUNT    3,EWDAS,GEXD        [REFIND GEXD 
4TRG          MFINDSU  2,HMUNIT(3)         [REFIND ASTUC
4W?6    ZA92  LDX   5  ARQS(3)  
4WQQ          SMO      4                   [INSERT NEW ENTRY
4X=B          STO   5  A1(2)
4XQ2          LDN   5  1                   [UPDATE COUNT OF SCRATCH AREAS   
4Y9L          ADS   5  CSCRATCH(2)  
4YP=          BRN      ZA90 
4^8W    ZAA8  LDX   0  HNEW(3)             [UPDATE LAST UNALTERED UNALLOCATED...
4^NG          SMO      CELLP(3)            [...AREA CELL TO POINT TO NEWLY...   
5286          STO   0  0                   [...CREATED UNALLOCATED CELL 
52MQ          CHUCKWR  C,CELLP(3),ZA80     [WRITE AWAY CELL 
537B          TESTREPNOT OK,ZAE9
53M2    ZA80  LDX   0  ARUNIT(3)
546L          LDX   7  EDEPF(3)            [X7=DEPTH OF AREA UNIT   
54L=          TXU   0  HMUNIT(3)           [IS AREA UNIT=HOME UNIT? 
555W          BCC      ZAA10               [BRANCH IF SO
55KG          LDX   2  CELLA+5(3)   
5656          LDX   0  HMUNIT(3)           [REWRITE CELL TO DESCRIBE AREA...
56JQ          STO   0  3(2)                [...REQUESTED
574B          CALL  0  RERITEA             [CREATE CELL 
57J2          LDX   1  FX2  
583L          SMO      AWORK4(1)           [POINTER TO SCH  
58H=          LDX   4  11                  [STORE POINTER FROM SCH TO POINTER...
592W          STO   4  0(2)                [...OF NEW FILE AREA CELL(FOREIGN)   
59GG          CHUCKWR  C,2,ZA81            [WRITE NEW FILE AREA CELL
5=26          TESTREPNOT OK,ZAE9,   
5=FQ    ZA81  LDX   4  CELLA+4(3)          [COPY B.S. ADDRESS OF NEW FILE ...   
5=^B          LDX   2  FX2                 [...AREA CELL TO FOREIGN CHAIN...
5?F2          SMO      AWORK4(2)           [...POINTER  
5?YL          STO   4  11   
5#D=          CLOSEWR  C,AWORK4(2)         [WRITE AWAY SCH AND END ACCESS TO SU 
5#XW          TESTREPNOT OK,ZAE9
5*CG          MHUNT    3,EWDAS,GEXD 
5*X6          LDX   4  HMUNIT(3)
5BBQ          UNLOCKSU ARUNIT(3)           [UNLOCK AREA UNIT
5BP6 ...      MHUNTW   3,EWDAS,GEXD 
5BWB          RELST    ARUNIT(3)           [RELEASE AREA UNIT   
5CTL          MHUNTW   3,EWDAS,GEXD 
5D*=          OPENST   4
5DSW          LDN   0  128  
5F#G          READSAVE 0,ZA82              [READ SYSTEM CONTROL HEADER FOR...   
5FS6          TESTREPNOT OK,ZAE15          [...HOME UNIT AND... 
5G?Q    ZA82  LDX   4  ECOR(3)  
5GRB          SMO      4
5H?2          LDX   0  12   
5HQL          STO   0  CELLA+4(3)          [B.S. ADDRESS OF FIRST VACANT CELL   
5J==    #SKIP          K6EXINTO 
5JPW    (   
5K9G          BNZ   0  ZA93 
5KP6          GEOERR   1,NOCELL!
5L8Q    ZA93
5LNB    )   
5M82          READSAVE 0,ZA83              [READ VACANT CELL
5MML          TESTREPNOT OK,ZAE15   
5N7=    ZA83  LDX   1  ECOR(3)  
5NLW          LDX   0  0(1)                [DECHAIN FIRST VACANT CELL   
5P6G          SMO      4
5PL6          STO   0  12   
5Q5Q          STO   1  CELLA+5(3)          [REMEMBER CORE ADDRESS OF CELL   
5QKB          CHUCKWR  C,4,ZAA10           [WRITE SCH   
5R52          TESTREPNOT OK,ZAE15   
5RJL    ZAA10 MFINDEXOF 1,CEFN(3)          [FIND EXOF FOR THIS FILE 
5S4=          READSAVE HOME(1),ZA87        [READ FILE INDEX CELL
5SHW          TESTREPNOT OK,ZAE15   
5T3G    ZA87  LDX   2  CELLA+5(3)   
5TH6          CALL  0  RERITEA             [CREATE NEW FILE AREA CELL   
5W2Q          LDX   0  ARUNIT(3)
5WGB          STO   0  3(2)                [SERIAL NO.= AREA UNIT   
5X22          LDX   1  ECOR(3)  
5XFL          LDX   4  1(1)                [CHAIN NEW FILE AREA CELL TO...  
5X^=          STO   4  0(2)                [...RELEVANT FILE INDEX CELL 
5YDW          LDX   4  1                   [REMEMBER ADDRESS OF FIC 
5YYG          CHUCKWR  C,2,ZA88            [WRITE NEW FILE AREA CELL
5^D6          TESTREPNOT OK,ZAE15   
5^XQ    ZA88  LDX   1  4
62CB          LDN   5  1
62X2          ADS   5  7(1) 
63BL          LDX   4  CELLA+4(3)   
63W=          STO   4  1(1) 
64*W          CLOSEWR  C,1                 [WRITE FIC AND END ACCESS TO SU  
64TG          TESTREPNOT OK,ZAE15   
65*6          MHUNT    3,EWDAS,GEXD        [REFIND GEXD 
65SQ          MFINDSU  2,HMUNIT(3)         [FIND ASTUC  
66#B          LDX   4  EMARK(3) 
66S2          SLL   4  1
67?L          BNG   4  ZA89                [BRANCH IF MODE #1500
67R=          LDX   4  ARUNIT(3)
68=W          TXU   4  HMUNIT(3)           [IS NEW AREA ON HOME UNIT?   
68QG          BCC      ZA90 
69=6    ZA89  LDX   4  CEXTEND(2)   
69PQ          SBN   4  1                   [SUBTRACT 1 FROM COUNT OF EXTENDS... 
6=9B          STO   4  CEXTEND(2)          [...ON HOME UNIT 
6=P2    ZA90  MFINDEXOF 1,CEFN(3)          [FIND EXOF   
6?8L          LDEX  0  FIP+5(1) 
6?N=          LDX   4  FIP+8(1)            [BUCKET SIZE ETC.
6#7W          SMO      FX1  
6#MG          MPA   0  Z6                  [CALCULATE ADDRESS OF LAST WORD...   
6*76          ADN   1  FDCELLS-7           [...OF LAST USED FDCELL IN EXOF  
6*LQ          LDX   7  AREQT(3) 
6B6B          STO   7  2(1)                [STARTING CYLINDER TO FDCELL 
6BL2          LDX   7  AREQT+2(3)   
6C5L          STO   7  3(1)                [STARTING BLOCK TO FDCELL
6CK=          LDX   7  AREQT+1(3)   
6D4W          SBX   7  AREQT(3) 
6DJG          ADN   7  1                   [NUMBER OF CYLINDERS IN AREA 
6F46          STO   7  4(1) 
6FHQ          LDX   0  AREQT+3(3)          [ENDING BLOCK
6G3B          SBX   0  AREQT+2(3)   
6GH2          ADN   0  1
6H2L          STO   0  5(1) 
6HG=          MPY   7  0               [CALCULATE FIRST LBN IN NEXT AREA-   
6H^W          ANDN  4  #77  
6JFG          DVS   7  4
6J^6          ADX   0  0(1)            [ADD FIRST LBN OF THIS AREA TO NUMBER... 
6KDQ          STO   0  6(1)            [...OF BUCKETS IN THIS AREA  
6KYB          ORS   6  4(1)            [FULL DEPTH BIT  
6LD2          LDX   5  ARUNIT(3)       [SERIAL NO OF AREA UNIT  
6MWW          MFINDEXOF 2,CEFN(3)          [REFIND EXOF 
6N44          LDX   0  ASUSN(2) 
6N9=          BZE   0  NOC                  [J IF ZERO SUSN 
6NBG    NA    FIPPER   HOME(2),ASUSN(2),NA,NB,NOC  [TELL OTHER SIDE TO RE-READ  
6NW6    NB    MHUNTW   3,EWDAS,GEXD 
6P*Q    NOC 
6Q*2          UNLOCKSU HMUNIT(3)       [UNLOCK HOME UNIT
6QMB ...      MHUNTW   3,EWDAS,GEXD 
6QSL          RELST    HMUNIT(3)
6R#=          MHUNT    3,EWDAS,GEXD 
6RRW    ZAC2  LDCT  0  #200 
6S?G          ANDX  0  EMARK(3)            [MODE #1500? 
6SR6          BZE   0  ZAB1                [BRANCH IF IT IS 
6T=Q          ACROSS   SCEXEND,4
6TQB    ZAB1  LDX   4  CNR(3)   
6W=2          FREECORE 3
6WPL          ADN   4  1
6X9=          GETWORD  4,3,WRITE       [GET ADDRESS OF N+1 OF CA
6XNW          TESTREPNOT OK,ZA91
6Y8G          STO   5  0(3)            [STORE SERIAL NO 
6YN6          ADN   4  2
6^7Q          GETWORD  4,3,WRITE           [GET ADDRESS OF N+3 OF CA
6^MB          TESTREPNOT OK,ZA91
7272          LDX   4  ZMASK(1)        [ZEROISE BIT 0   
72LL          ANDS  4  0(3) 
736=          ORS   6  0(3)            [RESET FULL DEPTH BIT
73KW          WORDFIN                  [NO MORE GETWORDS
745G          EXMESS   ALL             [OUTPUT MESSAGES(IF ANY?)
74K6          RUNPROG                      [EXINTO FINISHED 
754Q    #   
75JB    ZA91  GEOERR   1,GTWDFAIL          [GETWORD OUT OF RESERVATIONS 
7642    #   
76HL          MENDAREA 30,K99EXINTO 
773=    #END
^^^^ ...67413704000100000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1