(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
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