{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CLOSTIDY860)}}
====== CLOSTIDY860 ======
(George Source)
**Macros used:** [[george:macro:BFCBX|BFCBX]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:GEOERR|GEOERR]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:MAPBDEL|MAPBDEL]], [[george:macro:MAPBIN|MAPBIN]], [[george:macro:MBS|MBS]], [[george:macro:NAME|NAME]], [[george:macro:PSTAC|PSTAC]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:SFUB|SFUB]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:STEPREWRITE|STEPREWRITE]], [[george:macro:STILLSLOW|STILLSLOW]], [[george:macro:SUBCUBS|SUBCUBS]], [[george:macro:SUBSTITUTE|SUBSTITUTE]], [[george:macro:TOPFCA|TOPFCA]], [[george:macro:TOPFCA2|TOPFCA2]], [[george:macro:TOPFCAB|TOPFCAB]], [[george:macro:TOPFCAB2|TOPFCAB2]], [[george:macro:TRACE|TRACE]], [[george:macro:TRACEIF|TRACEIF]], [[george:macro:UP|UP]], [[george:macro:XGDRPTRS|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