(George Source)
Macros used: BFCBX, BXE, BXU, GEOERR, JBC, JBS, MAPBDEL, MAPBIN, MBS, NAME, PSTAC, SEG, SEGENTRY, SFSTACK, SFUB, STEPAGAIN, STEPREWRITE, STILLSLOW, SUBCUBS, SUBSTITUTE, TOPFCA, TOPFCA2, TOPFCAB, TOPFCAB2, TRACE, TRACEIF, UP, XGDRPTRS
22FL ... SEG CLOSTIDY,860,SECTION FILE,CLOSE 24XQ SEGENTRY K1CLOSTIDY,XCLOSTIDY 25CB # 26BL # IT TIDIES UP THE READ POINTERS OF DESTRUCTIVELY READ FILES WHEN 26W= # THEY ARE CLOSED 27*W # THERE ARE TWO TYPES OF DESTRUCTIVE READ ACCESS. 27TG # 1) DESTRUCTIVE COMMUNICATION FILES (DCF'S). THESE ARE ANNOUNCED 28*6 # BY THE "DESTCOMM" QUALIFIER. THEY MAY BE CAREFUL. IT IS HOPED THAT 28SQ # THEY MAY BE PHASED OUT EVENTUALLY. 29#B # 2) GENERAL DESTRUCTIVE READ.THESE MAY NOT BE CAREFUL.THIS TYPE 29S2 # OF ACCESS IS ANNOUNCED BY THE "GDR" QUALIFIER. THE ACCESS MAY NOT 2=?L # BE COMMUNAL BUT LIFE IS MADE DIFFICULT BY HAVING MORE THAN ONE 2=R= # GDR READER.NEVERTHELESS,THE FILESTORE COPES!!!!! 2?=W # 2?QG # THE METHOD USED IS TO FIND THE CURRENT READ BLOCK,AND OVERWRITE 2#=6 # ALL RECORDS READ,WITH THOSE AS YET UNREAD.FOR GDR FILES,WE DO NOT 2#PQ # DO THIS IF WE ARE NOT THE "SLOWEST READER".IF WE ARE,WE REPOSITION 2*9B # THE CURRENT ACTIVITY ON THE READ POINTERS OF THE NEXT SLOWEST 2*P2 # ACTIVITY. 2B8L # ALL THE BLOX UP TO THE CURRENT ONE ARE REMOVED FROM THE "USED" 2BN= # LIST AND STORED @ THE END OF THE FCB. 2C7W # THE ROUTINE THEN EXITS UP TO CLOSEDIR. 2CMG # 2D76 # 2DLQ # USE OF AWORK WORDS 2F6B # 2FL2 # AWORK1 2G5L # B0:(GDR) MORE THAN ONE READER. 2G*D ...# B1: DESTCOMM MARKER 2GK= # 2H4W # B15-23:SIZE THE CURRENT USAGE BLOCK MOVED UP BY. 2HJG # 2J46 # AWORK2 2JHQ # NUMBER OF BLOCKS MOVED FROM TOP OF BLOCKLIST TO BOTTOM. 2K3B # 2K8J ...# AWORK3 2K*Q ...# NUMBER OF WORDS REMOVED FROM NEW 1ST BLOCK OF FILE 2KH2 # 2L2L ZGEOER1 2LG= GEOERR 1,DCF BLK? [DCF INCORRECTLY POSITIONED 2NYB ZGEOER4 2PD2 GEOERR 1,EMPTY? [EMPTIED FILE 2PXL ZGEOER5 2QC= GEOERR 1,SUMS ??? [CLOSTIDY ERROR. 2RW6 # 2S*Q TESTSLOW 2STB XTESTSLOW 1,ZEXITZ,2 [ EXIT +1 F SLOWEST 2T*2 EXIT 7 0 2TSL ZEXITZ 2W#= #SKI K6CLOSTIDY>99$99 2WRW TRACE FREADBLOCK(1),SLOWEST 2X?G EXIT 7 1 2XR6 # 2Y=Q XMOVEUP 2YQB #SKI K6CLOSTIDY>199$199 2^=2 TRACE FBLMOD(2),XMOVEUP 2^PL LDX 3 FBLMOD(2) 329= SBN 3 FBLKS-A1+1 [JUST DECREMENT FBLMOD IF NO BLOX 32NW BZE 3 NOMOVEX 33N6 BNG 3 ZGEOER4 [ERROR IF FILE ALREADY EMPTY 347Q LDX 0 FBLKS(2) [BLOCK BEING MOVED 34MB LDN 4 FBLKS+1(2) [ MOVE [X3] FROM ... 3572 LDN 5 FBLKS(2) [ TO... 35LL MOVE 4 0(3) 366= SMO 3 36KW STO 0 FBLKS(2) [ STORE BLOCK NO. 375G NOMOVEX 37K6 #SKI K6CLOSTIDY>199$199 384Q TRACE 3,BL MOVE 38JB LDN 0 1 [ STORE NEW FBLMOD 3942 SBS 0 FBLMOD(2) 39HL EXIT 7 0 3=3= # 3=GW XMOREAD 3?2G # SIS S/R CHECKS IF THERE ARE ANY NORE READEIS. EXITS +1 IF ANY 3?G6 # MORE,+0 IF SOLE 3?^Q LDEX 0 ARINGNO(2) [ CT. OF ELEMENTS 3#FB ADN 2 A1 3#^2 XOTHRLP 3*DL BXE 2 1,XBCTS [ J IF OWN 3*Y= LDXC 4 FGENERAL1(2) [ JIF READER 3BCW BCS XEXITM1 3BXG XBCTS 3CC6 ADN 2 FELLEN [ STP PTTRS 3CWQ BCT 0 XOTHRLP [ LOOP 3DBB EXIT 7 0 3DW2 XEXITM1 3F*L EXIT 7 1 3FT= # 3G#W XCLOSTIDY 3GSG STOZ AWORK1(2) [ SWITCH WORD 3H#6 TOPFCAB2 1,2 [ X1 -> FCA, X2 -> FCB 3HHY ... TRACEIF K6CLOSTIDY,99,299,FLOC1(2),CL DEST [CLOSE FROM DESTCOMM 3HRQ ... JBC NOTSLOW,1,BAMREAD [J IF NOT READER 3JR2 LDXC 0 FREADBLOCK(1) [J IF FILE REWOUND 3K=L BCS NOTSLOW 3KQ= SBN 0 FBLKS 3L9W BNZ 0 NOTREWO 3LPG LDXC 0 FREADWORD(1) 3M96 BCS NOTSLOW 3MNQ NOTREWO 3N8B ... JBS YGDR1,2,BFGDR [J IF GDR 3NN2 ... LDCT 0 #200 3P7L ... SMO FX2 3PM= ... ORS 0 AWORK1 [SET 'DESTCOMM' MARKER 3Q6W ... JBC NDCFCARE,2,BFCARE [MUST BE DCF - J IF NOT CAREFUL 3R66 SUBSTITUTE [ SUBSTITUTE CURRENT BLOCK 3RKQ NDCFCARE 3S5B STEPAGAIN [ X3-> CURRENT RECORD 3SK2 TOPFCA2 1 [ X1-> FCA 3T4L LDX 0 FREADBLOCK(1) 3TJ= SBN 0 FBLKS 3WHG BNZ 0 ZGEOER1 [ ERROR IF NOT 1ST BLOCK 3X36 ... BRN QENDFILE [ MERGE 3XGQ YGDR1 3Y^L LDX 2 FPTR(2) [ X2 -> FSTACK 3^F= CALL 7 TESTSLOW [ ARE WE SLOWEST READER? 3^YW BRN NOTSLOW [ NO 42DG PSTAC 2,1 [ X2 -> FSTACK 42Y6 CALL 7 XMOREAD [ JIF SOTE 43CQ BRN XOREND 43XB XGDRPTRS 1,2,7, [ GDR 44C2 #SKI K6CLOSTIDY>199$199 44WL ( 45B= TRACE FREADWORD(1),UPTO RD 45TW TRACE FREADBLOCK(1),UPTO BL 46*G ) 46T6 LDXC 0 FREADBLOCK(1) [ IF THE READ POINTERS ARE ALREADY 47#Q BCS NOTSLOW 47SB SBN 0 FBLKS [ REWOUND,DO NOT TAKE FURTHER ACTION. 48#2 BNZ 0 XOREND 48RL LDXC 0 FREADWORD(1) 49?= BCS NOTSLOW 49QW XOREND 4==G STEPAGAIN [ X3 -> RECORD 4=Q6 #SKI K6CLOSTIDY>199$199 4?9Q TRACE FRH(3),CURR REC 4?PB SFSTACK ,1,2 [ X1 -> FCA,X2-> FSTACK. 4#92 CALL 7 XMOREAD [ J IF STILL SOLE,OR BECOME SOLE 4#NL BRN NOSETB1 [ O/W SET BIT 4*8= LDCT 0 #400 4*MW SMO FX2 4B7G ORS 0 AWORK1 4BM6 NOSETB1 4C6Q PSTAC 2,1 [ JJJJJ X1/>FCA,X2->FCB 4CLB LDX 6 3 [ PRESERVE 4D62 ... STILLSLOW 1,XSTILL,2 [J IF STILL SLOWEST OR EQUAL SLOW 4DKL BRN NOTSLOW [ J IF NOT 4DTD ...XSTILL 4F5= LDX 3 6 4FJW QENDFILE 4G4G BNZ 3 RHZERO [ J IF NOT END-OF-FILE 4GJ6 PSTAC 2,1 4H3Q BFCBX 2,2 [ X2 -> FCB 4H?J ... LDX 0 FBLMOD(2) 4HHB ... SBN 0 FBLKS-A1 4HR8 ... SMO FX2 4J32 ... STO 0 AWORK2 [UPDATE "COUNT OF BLOCKS DELETED" 4J=S ... SBS 0 FBLMOD(2) [EMPTY FILE 4JGL SETALTB 4K2= #SKI K6CLOSTIDY>199$199 4KFW TRACE FBLMOD(2),END CLTD 4K^G ... MBS 2,BFALTB,BFALTR [SET BLOCK & FILE ALTERED BITS 4LF6 ... NGS 2 CMOD(2) 4MDB LDX 7 FUSEBL(2) [ WE NOW RE-NAME ALL SPENT FUWB'S 4MY2 LDX 6 7 [ AS FURBS'S 4NCL SBX 6 FBLMOD(2) [ FIRSTLY,WE DON'T WANT THEM BACK- 4NX= BZE 6 NOTSLOW [ WRITTEN AS THAT CAUSES A GEORGE 4PBW LDX 3 1 [ ERROR - THE BLOCK NO.S ARE NO LOEGE 4PWG UC [ DARKED AS "USED" 4QB6 SMO 7 4QTQ LDX 4 A1-1(2) 4R*B PSTAC 1,1 [ SECONDLY,WE DONT FREECORE THEM-CLOS 4RT2 SFUB 1,4,1,UB [ WILL TIDY THEM UP 4S#L NAME 1,FILE,FURB 4SS= STOZ A1+FRH(1) 4T?W UB SBN 7 1 4TRG LDX 1 3 4W?6 BCT 6 UC 4WC3 ... LDX 2 FX2 4WGY ... SUBCUBS ,AWORK2(2),JOB,DEPTH [REDUCE CUBS FOR THIS JOB & OTHER CO 4WLT ... [ OF THIS FILE BY NO. OF BLOCKS DELE 4WQQ NOTSLOW 4X=B UP [EXIT 4XQ2 # 4Y9L # 4YP= RHZERO 4^8W #SKI K6CLOSTIDY>199$199 4^NG TRACE 2(3),REC IDE 537B STEPREWRITE [ ROUTE BLOCK TO B.S. 53M2 LDX 2 FX2 546L LDX 4 3 54L= SBX 4 FREADWORD(1) [ -> START OF BLOCK 555W ADN 4 A1 55*N ... LDCT 0 #200 55KG ... ANDX 0 AWORK1(2) 55T# ... BNZ 0 NGDR1 [J IF DESTCOMM 5656 LDXC 0 AWORK1(2) [ IF GDR & MORE READERS ,DON'T OVER- 56JQ [ WRITE 'LAST RECORD READ' AS NEXT 574B BCS YMORER [ SLOWEST ACTIVITY MAY WANT TO REREAD 57J2 NGDR1 [ IT. 583L LDEX 0 FRH(3) [ STEP ON PTR.TO O/WRITE LAST READ 58H= ADX 3 0 592W LDEX 7 FRH(3) 59GG #SKI K6CLOSTIDY>199$199 5=26 TRACE 7,X7 5=FQ BZE 7 NEXTRESET [ J IF NO MORE IN BLOCK 5=^B YMORER 5?F2 LDX 2 4 [ CALCULATE AMOUNT OVER-WRITTEN FOR 5?YL SBX 2 3 [ RECALCULATING READ PTRS. 5#D= SMO FX2 [ MOVE UP REMAINDER BY MAX NECESSARY 5#XW NGS 2 AWORK3 5*CG ...#SKI K6CLOSTIDY>199$199 5*X6 TRACE 2,AMOUNT 5BBQ ADN 2 GSBS 5CTL BZE 2 ZGEOER5 5D*= BNG 2 ZGEOER5 5J== MOVE 3 0(2) [ MOVE UP. 5K9G PSTAC 2,1 5KP6 BFCBX 2,2 [ X2 -> FCB 5L8Q LDX 6 FREADBLOCK(1) 5LNB SBN 6 FBLKS 5M82 SMO FX2 5MML STO 6 AWORK2 [ NO.OF BLOCKS DELETED 5N7= BZE 6 XNOMOVE [ J IF NOT ANY TO MOVE 5NLW XMO 5P6G CALL 7 XMOVEUP [ RECURSE MOVING UP BLOCKLIST 5PL6 BCT 6 XMO 5Q5Q XNOMOVE 5QKB LDX 3 FX2 5R52 LDXC 0 AWORK1(3) [ J IF NOT SOLE READER 5RJL BCS NOTONLY 5S4= TOPFCA 1 [ X1 -> FCA 5SHW NGS 0 FREADWORD(1) [ RESET READ POINTERS 5T3G NGS 0 FREADBLOCK(1) 5TH6 BRN SETALTB 5W2Q NOTONLY 5WGB LDX 2 FPTR(2) [ X2->FSTBCK 5X22 LDX 6 AWORK2(3) [ NUMBER OF BLOX DELETED 5XFL LDEX 5 AWORK3(3) [ AMOUNT NOW BLOCK MOVED UP 5X^= LDEX 7 ARINGNO(2) [ NUMBER OF ELEMENTS 5Y94 ... LDX 4 FREADBLOCK(1) 5YDW XLOOPPTR 5YYG LDXC 0 A1+FREADBLOCK(2) 5^D6 BCS STEPPTR [ J IF NOT BEING READ. 5^XQ SBS 6 FREADBLOCK+A1(2) [ DECREMENT BLOCK POINTER. 62CB #SKI K6CLOSTIDY>99$99 62X2 TRACE FREADBLOCK+A1(2),NEW BLX 63BL ... BXU 0 4,STPTR [ J IF NOT READING FROM WHAT IS NOW 63W= BZE 5 STPTR [THE 1ST. BL.J ALSO IF NO ADJUSTMENT 64*W [ NECESSARY TO READ PTRS. 64TG LDXC 0 FREADWORD+A1(2) 65*6 BCS STPTR 65SQ SBS 5 A1+FREADWORD(2) [ ADJUST READ RECORD PTR. 66#B STPTR 66S2 #SKI K6CLOSTIDY>99$99 67?L TRACE A1+FREADWORD(2),NEW RECX 67R= STEPPTR 68=W ADN 2 FELLEN [ NEXT ELEMENT 68QG BCT 7 XLOOPPTR [ DROP THRU IF NO MORE 69=6 PSTAC 2,1 [ X2 -> FC 69PQ BFCBX 2,2 6=9B BRN SETALTB [ END 6=P2 NEXTRESET [ BLOCK EMPTIED 6?8L #SKI K6CLOSTIDY>199$199 6?N= TRACE 0,NEXTRESE 6#7W SBX 3 0 6#MG SBX 3 FREADWORD(1) 6*76 NAME 3, FILE,FURB [ RENAME USAGE BLOCK,CLOSE WILL FREE. 6*LQ LDN 0 1 [ ABOUT TO READ 1ST RECORD IN NEXT 6B6B ADS 0 FREADBLOCK(1) [ BLOCK 6BL2 NGS 0 FREADWORD(1) 6C5L PSTAC 2,1 6CK= BFCBX 2,2 [ X2 -> FCB 6D4W LDX 6 FREADBLOCK(1) 6DJG SBN 6 FBLKS 6F46 SMO FX2 6FHQ STO 6 AWORK2 [ NO.OF BLOX TO DELETE. 6H2L BZE 6 ZGEOER5 6HG= BNG 6 ZGEOER5 6JFG XMOV 6J^6 CALL 7 XMOVEUP [ DELETE THEM 6KDQ BCT 6 XMOV 6KYB ... JBC SETALTB,2,BFCARE [J IF NOT CAREFUL 6MC= LDX 4 FBLMOD(2) [ AND NEED TO CORRECT READ PTRS. 6MWW LDN 0 1 6NBG MAPBDEL 0,2 [ UPDATE BIT MAP (ONLY ONE BIT). 6NW6 SBN 4 FBLKS-A1-1 6P*Q LDN 6 0 6PTB MAPBIN 4,6 6Q*2 TOPFCAB 1,2 6QSL BRN SETALTB 6R#= # 6S?G #END ^^^^ ...12265562000600000000