{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: EXINTO867)}}
====== EXINTO867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:CHUCKWR|CHUCKWR]], [[george:macro:CLOSEST|CLOSEST]], [[george:macro:CLOSEWR|CLOSEWR]], [[george:macro:EXMESS|EXMESS]], [[george:macro:FIPPER|FIPPER]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETWORD|GETWORD]], [[george:macro:KEEPMESS|KEEPMESS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFINDEXOF|MFINDEXOF]], [[george:macro:MFINDSU|MFINDSU]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:OPENST|OPENST]], [[george:macro:READSAVE|READSAVE]], [[george:macro:READST|READST]], [[george:macro:RELST|RELST]], [[george:macro:RUNPROG|RUNPROG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:TESTREPNOT|TESTREPNOT]], [[george:macro:UNLOCKSU|UNLOCKSU]], [[george:macro:WORDFIN|WORDFIN]], [[george:macro:WRITEST|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