(George Source)
Macros used: ACROSS, CHAREA, CHUCK, CHUCKWR, CLOSEST, MENDAREA, MFINDSU, MHUNT, MHUNTW, OPENST, READSAVE, READST, SAVEST, SEGENTRY, TESTREPNOT, WRITEST
22FL ...#SEG EXINTWO70 [BACK 22^= #LIS K0EXINTWO 23DW 8HEXINTWO 23YG #DEF XCA=EVENT2 24D6 # 24XQ ... SEGENTRY K1EXINTWO,QK1EX [#1500 VIA ACROSS FROM EXINONE 25CB ... SEGENTRY K2EXINTWO,QK2EX [FENCE BREAKER 25X2 # 26BL ZMASK #37777777 26W= ZMASK1 #00777777 27*W Z6 +6 27TG # SET UP CELL WHOSE ADDRESS IS IN X2,ACTUAL CORE 28*6 # ADDRESS IN X1-LINK X6 28SQ ...XCELLSET 29#B STO 1 5(2) [STORE CORE ADDRESS 29S2 STO 4 4(2) [BS ADDR TO CELL 2=?L LDXC 0 1(1) 2=R= DVS 7 EDEPF(3) [CONVERT ABSOLUTE BLOCK NO.TO... 2?=W STO 7 2(2) [...CYLINDER/BLOCK 2?QG STO 0 0(2) [START BLOCK 2#=6 LDXC 0 2(1) 2#PQ BCS ZA32 2*9B ZA32 SBN 0 1 [END BLOCK 2*P2 DVS 7 EDEPF(3) 2B8L STO 7 3(2) 2BN= STO 0 1(2) 2C7W EXIT 6 0 2CMG ...XISITSCR [IS AREA(1) A SCRATCH AREA? 2DLQ SBX 6 FX1 2F6B MFINDSU 2,ARUNIT(3) 2FL2 LDXC 0 1(1) [START BLOCK NO-BIT 0 2G5L BCS ZA31 2GK= ZA31 LDN 7 0 2H4W ZA34 TXU 7 CSCRATCH(2) [ANY MORE SCRATCH AREAS? 2HJG BCS ZA30 2K3B LDX 7 1 [SAVE PTR 2KH2 LDX 2 3 [PTR TO GEXD 2L2L LDX 3 0 [BLOCK NO 2L4* ...#UNS IPBD 2L64 ...( 2L7R ... CHAREA ARUNIT(2),3,NC [CHECK IF AREA IN USE AS SCRATCH 2L9G ... MHUNTW 1,EWDAS,GEXD [..FILE OTHER PROCESSOR 2L?9 ...) 2L#Y ...#UNS IPBD 2LBM ...#SKI 2LDB ...( 2LG= CHAREA 3,ARUNIT(2),NB,NC,NC,NOC [SEE IF OTHER PROCESSOR HAS THIS 2L^W [..BLOCK IN USE AS SCRATCH FILE 2MFG NOC MHUNTW 1,EWDAS,GEXD 2MP# ...) 2M^6 MFINDSU 2,ARUNIT(1) 2NDQ LDX 0 3 [BLOCK NO 2NYB LDX 3 1 [PTR TO GEXD 2PD2 LDX 1 7 2PXL ADX 6 FX1 2QWW EXIT 6 1 2RBG ZA30 SMO 7 2RW6 TXU 0 HSCRATCH(2) [START BLOCK NO.A SCRATCH AREA? 2S*Q BCS ZA33 2T*2 ND ADX 6 FX1 2TSL EXIT 6 0 2W#= ZA33 ADN 7 1 [GO TO LOOK AT NEXT 2WRW BRN ZA34 2X?G ...NC LDX 0 3 [AREA IN USE IN OTHER PROCESSOR 2YQB MHUNTW 3,EWDAS,GEXD 2^=2 MFINDSU 2,ARUNIT(3) 2^PL ... LDX 1 7 329= BRN ND 338G # 33N6 ...XMALG SBX 6 FX1 [ON ENTRY X1 IS POINTER TO LAST... 347Q LDX 2 FX2 [WORD OF PREVIOUS CELL(P) AND AWORK4 34MB STO 6 AWORK1(2) [...IS POINTER TO SCH.X3 IS POINTER 3572 SMO 6(1) [...TO GEXD. 35LL LDXC 6 1 [LOAD START BLOCK FROM CELL+1 366= BCS ZA45 [CLEAR BIT 0... 36KW ZA45 STO 6 AWORK2(2) [REMEMBER IN AWORK2(2) 375G DVS 5 EDEPF(3) [CONVERT TO CYL/BLOCK 37K6 SMO 12(1) 384Q LDXC 7 2 [LOAD END BLOCK FROM CELL+2 38JB BCS ZA46 [CLEAR BIT 0 3942 ZA46 STO 7 AWORK3(2) [REMEMBER IN AWORK3(2) 39HL DVS 6 EDEPF(3) [CONVERT TO CYL/BLOCK 3=3= ADX 5 6 [ADD BLOCKS FROM CYL/BLOCK 3=GW BZE 5 ZA42 [IF ZERO FILE AREA IS... 3?2G LDCT 5 256 [...NOW FULL DEPTH 3?G6 ORS 5 AWORK3(2) 3?^Q ZA42 LDX 5 8(1) [UPDATE END CYLINDER/END BLOCK IN 3#FB STO 5 2(1) [...CELL+1 3#^2 LDX 5 10(1) 3*DL STO 5 4(1) 3*Y= LDX 6 5(1) [IS BACKING STORE ADDRESS OF CELL+1 3BCW TXL 6 11(1) [...LESS THAN THAT OF CELL+2 3BXG BCS ZA44 [BRANCH IF GREATER 3CC6 LDX 5 5(1) 3CWQ LDX 6 11(1) [BECAUSE WE MUST ALWAYS FREE HIGHEST 3DBB STO 5 11(1) [...ADDRESSED CELL WE SWITCH CELLS.. 3DW2 STO 6 5(1) [...SO THAT WE CAN ALWAYS FREE CELL+2 3F*L LDX 5 6(1) 3FT= LDX 6 12(1) 3G#W STO 5 12(1) 3GSG STO 6 6(1) 3H#6 LDX 2 1 3HRQ SBN 2 5 [SETX2 TO POINT TO FIRSTWORD... 3J?B BRN ZA48 [OF PREVIOUS CELL 3JR2 ZA44 LDN 2 1(1) [SET X2 TO POINT TO CELL+1 3K=L ZA48 SMO 12(1) 3KQ= LDX 5 0 [COPY POINTER FROM CELL+2 TO CELL(2) 3L9W SMO 5(2) 3LPG STO 5 0 3M96 SBX 1 3 [REMEMBER POINTER TO PREVIOUS CELL 3MNQ STO 1 5 [...RELATIVE TO GEXD 3N8B WRITEST C,5(2),ZA49 [WRITE AWAY CELL(2) 3NN2 TESTREPNOT OK,ZAE9 3P7L ZA49 LDX 1 3 3PM= ADX 1 5 [RECREATE ABSOLUTE POINTER TO GEXD 3Q6W LDX 2 FX2 3QLG LDX 6 AWORK2(2) 3R66 SMO 6(1) [UPDATE STARTING/ENDING BLOCK FOR 3RKQ STO 6 1 [...NEW CELL(+1) 3S5B LDX 6 AWORK3(2) 3SK2 SMO 6(1) 3T4L STO 6 2 3TJ= WRITEST C,6(1),ZA50 [WRITE AWAY NEW CELL 3W3W TESTREPNOT OK,ZAE9 3WHG ZA50 SMO AWORK4(2) 3X36 LDN 1 12 [X1 IS POINTER TO VACANT CHAIN 3XGQ ZA53 LDX 6 0(1) [X6 IS PONTER TO NEXT VACANT CELL 3Y2B BZE 6 ZA51 [IF ZERO END OF CHAIN OTHERWISE... 3YG2 SMO 5 [...SEE IF OUR VACANT CELL SHOULD... 3Y^L TXL 6 11(3) [...FIT IN THE CHAIN AT THIS POINT 3^F= BCC ZA51 [BRANCH IF IT SHOULD 3^YW LDX 1 6 [READ NEXT CELL IN VACANT CHAIN 42DG READST 1,ZA53 42Y6 TESTREPNOT OK,ZAE9 43CQ LDX 1 ECOR(3) [X1 POINTS TO CELL JUST READ 43XB BRN ZA53 44C2 ZA51 SAVEST C,1 [SAVE THIS CELL 44WL LDX 7 1 45B= SMO 5 [POINT FREED CELL TO NEXT VACANT 45TW LDX 1 12(3) 46*G STO 6 0(1) 46T6 CHUCKWR C,1,ZA54 [MARK CELL TO BE WRITTEN 47#Q TESTREPNOT OK,ZAE9 47SB ZA54 SMO 5 48#2 LDX 0 11(3) [POINT PREVIOUS VACANT TO FREED CELL 48RL SMO 7 49?= STO 0 0 49QW CHUCKWR C,7,ZA55 [MARK CELL TO BE WRITTEN 4==G TESTREPNOT OK,ZAE9 4=Q6 ZA55 LDX 6 AWORK1(2) [LOAD LINK 4?9Q ADX 6 FX1 [DATUMISE LINK 4?PB EXIT 6 0 4#92 # 4#NL ZAE70 LDN 4 0 [X4=REPLY FOR BREAKIN 4*8= BRN ZCANT 4*MW ZA10 LDN 4 6 [X4=REPLY STORAGE UNIT NOT ONLINE 4B7G ZCANT ACROSS EXINONE,4 4BM6 ZAE6 LDN 4 4 [REPLY=INVALID AREA 4C6Q ZFR1 LDN 7 1 [MARKER FOR EXTEND 4CLB BRN ZJRB9 4D62 ZAE10 LDN 4 2 [REPLY=AREA WOULD CREATE TOO MANY... 4DKL LDCT 0 #400 4F5= SMO CELLA+5(3) 4FJW LDXC 7 2 [OK IF FULL DEPTH 4G4G BCC ZJRB8 4GJ6 ORS 0 CELLA+1(3) [NOT FULL DEPTH 4H3Q BRN ZJRB8 [...FENCES 4HHB ZAE9 4J32 ZAF9 LDCT 4 #40 [REPLY=FAILURE 4JGL BRN ZFR1 4K2= ZAE7 LDN 4 1 [REPLY=PART OR WHOLE OF AREA ASSIGNED 4KFW ZJRB8 NGN 7 1 [MARKER FOR EXTEND 4K^G MHUNT 3,EWDAS,GEXD 4LF6 CLOSEST ZJRB5 [CLOSE UNIT TO TRANSFER SYSTEM 4LYQ TESTREPNOT OK,ZAE9 4MDB ZJRB9 MHUNT 3,EWDAS,GEXD 4MY2 ZJRB5 LDCT 0 128 4NCL ANDX 0 EMARK(3) [SEE IF MODE #1500... 4NX= BZE 0 ZJRB6 [...BRANCH IF SO 4PBW ACROSS SCEXEND,3 4PWG ZJRB6 ACROSS EXINONE,5 4QB6 # 4QTQ QK1EX 4R*B MHUNT 3,EWDAS,GEXD 4RT2 MFINDSU 1,ARUNIT(3) [ASTUC FOR AREA UNIT 4S#L LDX 7 AREQT+1(3) 4SS= TXL 7 HCYL(1) [MAKE SURE AREA REQUIRED... 4T?W BCC ZAE6 [...BY OBJ PROG IS WITHIN... 4TRG LDX 7 AREQT+3(3) [...DEVICES BOUNDARIES 4W?6 TXL 7 HBLOCK(1) 4WQQ BCC ZAE6 4X=B LDX 0 AREQT+2(3) 4XQ2 LDX 7 AREQT(3) [CHANGE CYL/BLOCK ADDRESS... 4Y9L MPA 7 HBLOCK(1) [...TO BLOCK ADDRESS 4YP= STO 0 ARQS(3) 4^8W OPENST ARUNIT(3) [OPEN AREA UNIT 4^NG LDN 0 128 5286 READSAVE 0,ZA25 [READ AND SAVE SCH 52MQ TESTREPNOT OK,ZAF9 537B ZA25 LDX 4 ECOR(3) [ADDR OF SCH 53M2 SMO FX2 546L STO 4 AWORK4 [REMEMBER ADDRESS OF SCH 54L= SMO ECOR(3) 555W LDN 1 10 [ADDRESS OF UNUSED FILE... 55KG STO 1 CELLA+5(3) [...AREA CHAIN 5656 STOZ CELLB+5(3) [CELL IS NOT YET READ 56JQ SAVEST C,1 [SAVE SCH TWICE 574B ZA37 LDX 4 0(1) [ADDRESS OF NEXT FILE AREA CELL 57J2 BZE 4 ZAE7 [REPLY 1 IF END OF CHAIN 583L LDX 0 CELLA+5(3) 58H= STO 0 CELLP(3) [REMEMER CORE POINTER OF LAST CELL 592W LDX 0 CELLB+5(3) 59GG BNZ 0 ZA28 5=26 READSAVE 4,ZA29 [READANDSAVE NEXT FILE AREA CELL 5=FQ TESTREPNOT OK,ZAF9 5=^B LDX 1 ECOR(3) [CORE ADDRESS OF CELL 5?F2 ZA29 LDN 2 CELLA(3) 5?YL ... CALL 6 XCELLSET [SET UP CELLA 5#D= ...ZA36 CALL 6 XISITSCR [SEE IF SCRATCH AREA 5#XW BRN ZA35 [BRANCH IF SO 5*CG LDX 7 ARQS(3) [BRANCH IF AREA NOT VACANT 5*X6 TXL 7 0 5BBQ BCS ZAE7 [IS ARQS LESS THAN START BLOCK OF A 5BWB QK2EX 5CB2 MHUNT 3,EWDAS,GEXD 5CTL ZA41 SMO CELLA+5(3) [FENCE BREAKER 5D*= LDX 4 0 [LOAD ADDRESS OF NEXT CELL 5DSW BZE 4 ZA38 [BRANCH IF NO MORE 5F#G READSAVE 4,ZA39 [READ NEXT FILE AREA CELL 5FS6 TESTREPNOT OK,ZAF9 5G?Q LDX 1 ECOR(3) 5GRB ZA39 LDN 2 CELLB(3) 5H?2 ... CALL 6 XCELLSET [SET UP CELLB IN GEXD... 5HQL ... CALL 6 XISITSCR [...AND SEE IF SCRATCH AREA 5J== BRN ZA38 5JPW SMO CELLA+5(3) 5K9G LDXC 5 2 [IS CELLA A FULL DEPTH AREA... 5KP6 BCC ZA40 [...BRANCH IF SO 5L8Q LDX 5 CELLA(3) 5LNB LDX 6 CELLA+1(3) [IS CELLB SAME CYLINDERS AS CELLA... 5M82 TXU 5 CELLB(3) [...AND STARTING BLOCK NEXT... 5MML TXU 6 CELLB+1(3) [...AFTER CELLA 5N7= BCS ZA38 5NLW LDX 5 CELLB+2(3) 5P6G SBN 5 1 [IS AREA SPECIFIED IN CELLB... 5PL6 TXU 5 CELLA+3(3) [IMMEDIATELY AFTER THAT SPECIFIED... 5Q5Q BCS ZA38 [BY CELLA?-SAME CYLINDERS ADJACENT 5QKB ZA56 LDN 1 CELLP(3) [BLOCKS 5R52 ... CALL 6 XMALG [AMALGAMATE CELLB INTO CELLA 5RJL STOZ CELLB+5(3) 5S4= BRN ZA41 5SHW ZA28 LDN 7 CELLB(3) [CELLB TO CELLA 5T3G LDN 0 CELLA(3) 5TH6 MOVE 7 6 5W2Q STOZ CELLB+5(3) [CELLB NOT YET READ 5WGB LDX 1 CELLA+5(3) 5X22 BRN ZA36 5XFL ZAA3 5X^= ZA35 CHUCK C,CELLP(3) [CHUCK IF SCRATCH AREA 5YDW BRN ZA37 5YYG ZA40 LDX 5 CELLA+1(3) [DOES CELLB START AT BLOCK 0 OF... 5^D6 ADN 5 1 [NEXT CYLINDER AFTER CELLA? 5^XQ TXU 5 CELLB(3) 62CB BCS ZA38 [BRANCH IF NOT 62X2 LDX 5 CELLB+2(3) 63BL BNZ 5 ZA38 63W= ZA58 SMO CELLB+5(3) 64*W LDXC 5 2 [IS CELLB A FULL DEPTH AREA... 64TG BCC ZA56 65*6 SMO CELLB+5(3) [IF NOT SEE IF WE CAN AMALGAMATE... 65SQ LDX 4 0 [ANOTHER CELL WITH CELLB TO... 66#B BZE 4 ZA38 [MAKE IT FULL DEPTH 66S2 READST 4,ZA57 [IF ANOTHER VACANT CELL READ IT 67?L TESTREPNOT OK,ZAF9 67R= LDX 1 ECOR(3) 68=W ...ZA57 CALL 6 XISITSCR [IS IT A SCRATCH AREA... 68QG BRN ZA38 [BRANCH IF SO 69=6 LDX 1 ECOR(3) 69PQ LDN 2 CELLC(3) 6=9B ... CALL 6 XCELLSET [SET UP CELLC WITH INFO FROM CELL 6=P2 LDX 5 CELLC(3) 6?8L LDX 6 CELLC+1(3) [IS CELLC SAME CYLINDERS AS CELLB... 6?N= TXU 5 CELLB(3) [AND STARTING BLOCK NEXT AFTER CELLB 6#7W TXU 6 CELLB+1(3) 6#MG BCS ZA38 [BRANCH IF NOT 6*76 LDX 5 CELLC+2(3) 6*LQ SBN 5 1 6B6B TXU 5 CELLB+3(3) 6BL2 BCS ZA38 [BRANCH IF NOT 6C5L SAVEST C,CELLC+5(3) [SAVE THIS CELL AND AMALGAMATE... 6CK= LDN 1 CELLA+5(3) [...WITH PREVIOUS CELL 6D4W ... CALL 6 XMALG 6DJG BRN ZA58 6F46 ZA38 LDCT 0 #200 6FHQ ANDX 0 EMARK(3) [SEE IF MODE #1500 6G3B BZE 0 ZA38A [BRANCH IF #1500 6GH2 ACROSS SCEXEND,2 6H2L ZA38A LDX 1 CELLA+5(3) [IS CELLA THE AREA REQUESTED 6HG= LDX 5 1(1) 6H^W ZA59 TXU 5 ARQS(3) 6JFG BCC ZA60 [BRANCH IF EQUAL 6J^6 LDX 5 AREQT(3) 6KDQ TXL 5 CELLA(3) [DOES AREA REQUESTED START... 6KYB BCS ZAA3 [...WITHIN AREA SPECIFIED BY CELLA? 6LD2 TXL 5 CELLA+1(3) 6LXL BCS ZA61 [IF IT DOESN'T GO TO TRY NEXT AREA 6MC= TXU 5 CELLA+1(3) 6MWW BCS ZAA3 6NBG ZA61 LDX 5 AREQT+2(3) 6NW6 TXL 5 CELLA+2(3) [IS START BLOCK OF AREA REQUESTED... 6P*Q BCS ZAA3 [LESS THAN START BLOCK OF CELLA... 6PTB TXL 5 CELLA+3(3) [AND IS IT LESS THAN END BLOCK... 6Q*2 BCS ZA62 [OF CELLA 6QSL TXU 5 CELLA+3(3) 6R#= BCS ZAA3 6RRW ZA62 LDX 5 AREQT+1(3) [ENDING CYLINDER... 6S?G TXL 5 CELLA+1(3) [...LESS THAN ENDING CYLINDER... 6SR6 BCS ZA63 [...OF UNALLOCATED AREA? 6T=Q TXU 5 CELLA+1(3) 6TQB BCS ZAE7 [REPLY 1 6W=2 ZA63 LDX 5 AREQT+3(3) [ENDING BLOCK... 6WPL TXL 5 CELLA+3(3) [...LESS THAN ENDING BLOCK... 6X9= BCS ZAE10 [...OF UNALLOCATED AREA? 6XNW TXU 5 CELLA+3(3) 6Y8G BCS ZAE7 [REPLY 1 6YN6 BRN ZAE10 [REPLY 2 6^7Q ZA60 LDX 5 CELLB+5(3) [OK SO FAR 6^MB BZE 5 ZA64 [HAS CELLB BEEN READ? 7272 CHUCK C,5 [IF SO CHUCK 72LL ZA64 LDX 5 AREQT+1(3) [ENDING CYLINDER... 736= TXL 5 CELLA+1(3) [...LESS THAN ENDING CYLINDER... 73KW BCS ZA65 [...OF UNALLOCATED AREA? 745G TXU 5 CELLA+1(3) 74K6 BCS ZAE7 [REPLY 1 754Q ZA65 LDN 6 0 [X6=COUNT OF VACANT CELLS REQUIRED 75JB LDX 5 AREQT+3(3) 7642 TXU 5 CELLA+3(3) [IS UNALLOCATED AREA EXACTLY... 76HL BCC ZA66 [...THE RIGHT LENGTH? 773= ADN 6 1 [IF NOT ADD 1 TO COUNT OF CELLS 77GW ORX 6 GSIGN 782G TXL 5 CELLA+3(3) 78G6 BCC ZAE7 [BRANCH IF AREA NOT LONG ENOUGH 78^Q ZA66 LDX 5 AREQT+1(3) 79FB TXU 5 CELLA+1(3) [IS AREA EXACTLY RIGHT WIDTH? 79^2 BCC ZAA6 [BRANCH IF SO 7=DL SMO CELLA+5(3) [UNALLOCATED AREA MUST BE FULL... 7=Y= LDXC 5 2 [...DEPTH FOR O/P PERI TO BE LEGAL- 7?CW BCS ZAE10 [OTHERWISE ILLEGAL FENCE BREAKING 7?XG BCHX 6 £ [+1 TO NUMBER OF VACANT CELLS 7#C6 ADN 6 1 7#WQ ZAA6 ACROSS EXINTO,3 7*BB # 7*W2 MENDAREA 30,K99EXINTWO 7B*L #END ^^^^ ...56117506000200000000