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