(George Source)
Macros used: ACROSS, BC, BS, CHAIN, CHAIND, CLOSETOP, DELFCB, ERASEND, FAILCLEAR, FILETRAN, FPUT, FREEBAX, FREECORE, GEOERR, GETDIR, HUNTW, INSERT, JBC, JBCC, JBS, JFNZ, JMBS, LF, LONGCOOR, LONGSET, MFREE, MFREEW, MHUNTW, NAME, NEXTFCB, REPLACE, RERING, SEG, SEGENTRY, SETNCORE, SFCA, SFCAB, STEP, STEPWRITE, STF, SUBRELT, SUBSTITUTE, SUICIDE, TOPFCA2, TOPFCAB, TOPFCB, TOPFCB2, TRACEIF, TRANSFCB
22FL ... SEG CLOSEALT,863,SECTION FILE,CLOSE 24XQ [ 25CB SEGENTRY K1CLOSEALT,XENT1 25X2 SEGENTRY K2CLOSEALT,XENT2 26BL SEGENTRY K3CLOSEALT,XENT3 26W= SEGENTRY K4CLOSEALT,XENT4 27*W SEGENTRY K5CLOSEALT,XENT5 27TG ... SEGENTRY K7CLOSEALT,XENT7 28*6 ... SEGENTRY K8CLOSEALT,XENT8 28SQ # 29#B # IF ONE BLOCK ONLY HAS CHANGED, THIS IS THE LAST STAGE OF THE 29S2 # CAREFUL UPDATE - WE DO A NON-AUTONOMOUS FILE WRITE FOR THE 2=?L # NEW DIRECTORY ENTRY, FREE THE BS, DERING THE TRAILING FILES, 2=R= # RELEASE ANY CLOSESET WAITERS ON THESE FILES AND CLOSE THE 2?=W # DIRECTORY 2?QG # IF MORE THAN ONE BLOCK NUMBER HAS CHANGED, WE REWRITE THE BLOCKS 2#=6 # RECORD BY A STEPWRITE, AND THEN GO ACROSS TO K8CLOSEDIR TO 2#PQ # CLOSE THE DIRECTORY JUST UPDATED 2*9B # IF THE LENGTH OF THE BLOCKS RECORD HAS ALTERED, WE REWRITE BY 2*P2 # INSERT/REPLACE BEFORE GOING ACROSS TO K8CLOSEDIR 2B8L # 2BDD ...N4AST 4H**** 2BN= SFULLB 2C7W #HAL BSTB+FULLB,0 2CMG SMAPP 2D76 #HAL FILE+FMAPP,0 2DLQ SFINDEXF 2F6B #HAL FI+FINDEXF,0 2FL2 FILETRAN [SUBROUTINE MACRO FOR FILEWRITE 2G5L SUBRELT 2GK= SUBRELT 2 2H4W EXIT 7 0 2HJG OLDFCA 2J46 LDN 0 1 2JHQ SFCA 0,3 [X3->FCA AT LEVEL 1 2K3B EXIT 7 0 2KH2 OLDFCAB 2L2L LDN 0 1 2LG= SFCAB 0,3,2 [X2->FCB X3->FCA AT LEVEL 1 2L^W EXIT 7 0 2MFG TOPFCB 2M^6 SFCAB ,2,2 [X2->FCB 2NDQ EXIT 7 0 2NYB TOPFCAB 2PD2 SFCAB ,3,2 [X2->FCB X3->FCA 2PXL EXIT 7 0 2QC= # 2QWW STEPWRITE 2RBG SBX 7 FX1 2RW6 STEPWRITE 2S*Q ADX 7 FX1 2STB EXIT 7 0 2T*2 # 2TSL # FIND THE FMAPP AFTER THE BLOCK ADDRESSED BY X2 2W#= SFMAPP 2WRW LDX 1 FX1 2X?G LDX 0 SMAPP(1) 2XR6 XAGMAP 2Y=Q LDX 2 FPTR(2) 2YQB TXU 0 ATYPE(2) 2^=2 BCS XAGMAP 2^PL EXIT 7 0 384Q # 38JB # FREE THE FCB, FSTACK AND FMAPP IF POSSIBLE 3942 # WE CANT FREE THE FCB IF 39HL # SOMEONE'S WAITING TO EMPTY 3=3= # THERE'S AN AUTOCLOSE ON THE FILE 3=GW # IT'S STILL OPEN 3?2G # THERE ARE CLOSECTS ON THE FILE 3?G6 # THERE ARE WAITERS 3?^Q # IT'S OPEN IN COPY MODE 3#FB # OR BEING OPENED IN COPY MODE 3#^2 [ THE FCA/FCB MAY BE REMOVED OVER A CO-ORDINATION, IF SO 3*DL [ EXIT IS AT 0+ 3*Y= [ EXIT AT 3BCW [ 0+ FCB FREED. 3BXG [ 1+ FCB STILL IN USE 3CC6 [ 1+ FCB NOT TO BE REMOVED FROM FILE-CHAIN, OR OPEN IN 3CWQ [ COPY MODE 3DBB TFRFCB 3DW2 SMO FBACKPOINT(3) [REL. PTR. TO START OF BLOCK 3F*L LDN 0 0(3) [WRT WD 0 OF FCA 3FT= TXU 0 FX2 3G#W BCC (7) [BRN IF FCA WAS REALLY ACTIVITY BLOC 3GSG ADN 7 1 3H#6 ... JMBS (7),2,BFSOLE,BFEMPTY,BFMCOP,BFFCB,BFTIDYLOCK 3HRQ ... LF 2,FFAUTCLCT,0 [X0= COUNT OF AUTOCLOSES ON FILE 3J?B ... ORX 0 CTOPEN(2) 3JR2 ORX 0 FWAITCOUNT(2) 3K=L BNZ 0 (7) 3KQ= [ FCB MAY BE FREED. 3L9W LDX 3 2 [X2->FCB 3LPG FREECORE FPTR(2) [THE FSTACK 3M96 LDN 6 0 3MNQ TRYNEXT 3N8B LDX 2 FPTR(3) [X2->FINDEXF, FMAPP, FCB OR FILE CHAI 3NN2 TRYX TXU 2 CXFI 3P7L BCC OVERCHECK [J IF BASE OF FILE CHAIN 3PM= LDX 0 ATYPE(2) 3Q6W TXU 0 FILEPLUSFCB 3QLG BCC OVERCHECK [J IF NEXT FCB 3R66 TXU 0 SFINDEXF(1) 3RKQ BCS TRYFMAPP [J IF NOT FINDEXF 3S5B LDN 6 #77 3SK2 ANDX 6 FINFC(3) 3T4L BZE 6 ODDALT [J IF FINDEXF BUT NO INDEX NUMBER 3TJ= LDX 2 FPTR(2) [NEXT BLOCK 3W3W BRN TRYX 3WHG TRYFMAPP 3X36 TXU 0 SMAPP(1) 3XGQ BCS ODDALT [J IF NOT FMAPP 3Y2B JBCC ODDALT,3,BFCARE [CAREFUL BIT UNSET! WHY!?!? 3YG2 FREECORE 2 [THE FMAPP 3Y^L BRN TRYNEXT 3^F= ODDALT 3^YW GEOERR BRIEFPM,ODD ALT 42DG OVERCHECK 42Y6 JBS YDIRECTORY,3,BFDIR 43CQ BZE 6 NOFINDEXF 43XB FREECORE FPTR(3) [THE FINDEXF 44C2 NOFINDEXF 44WL ... DELFCB 3,FILE 45B= BRN NOFREE 45TW YDIRECTORY 46*G BZE 6 NOINDEX 46T6 CHAIND FPTR(3),BHALF [PUT THE FINDEXF IN THE HALF-OPEN CH. 47#Q NOINDEX 47SB ... TRANSFCB 3,FILE,HALF [TRANSFER FCB FROM FILE TO HALF 49?= NOFREE 49QW SBN 7 1 4==G EXIT 7 0 4=Q6 # 4?9Q # LOOK FOR AN FCA, IN THE FSTACK CONTAINING THE FCA ADDRESSED BY X3, 4?PB # WITH THE SAME BIT SET IN FGENERAL1 AS IN X6, AND LEAVE ITS 4#92 # ADDRESS IN X2 4#NL SEARCHFCA 4*8= SMO FBACKPOINT(3) 4*MW LDN 2 0(3) 4B7G LDEX 4 ARINGNO(2) [PICK COUNT OF ELEMENTS 4BM6 ADN 2 A1 [SET X2-> FIRST ELEMENT 4C6Q SFCAPT 4CLB TXU 2 3 4D62 BCC OURFCA [J.IF OWN FCA 4DKL LDX 0 FGENERAL1(2) 4F5= ANDX 0 6 [CHECK AGAINST MASK 4FJW BNZ 0 (7) [AND EXIT IF FIT 4G4G OURFCA 4GJ6 ADN 2 FELLEN [STEP TO NEXT ELEMENT 4HHB BCT 4 SFCAPT [EXIT +1 WHEN NOMORE FCAS IN STACK 4J32 EXIT 7 1 4JGL # 4K2= # ANY FULLB'S BEHIND THE FMAPP ADDRESSED BY X6 ARE RECHAINED AFTER 4KFW # THE FMAPP ADDRESSED BY X5, OR AFTER THE FIRST FULLB IF PRESENT 4K^G MOVEFULLBS 4LF6 TXU 6 5 4LYQ BCC (7) [EXIT IF THE SAME FMAPP - SAME FILE 4MDB LDX 1 FX1 4MY2 LDX 4 SFULLB(1) 4NCL SMO 5 4NX= LDX 2 FPTR 4PBW TXU 4 ATYPE(2) 4PWG BCS NOCURR [CHECK THAT THERE IS NO CURRENT FULLB 4QB6 LDX 5 2 4QTQ NOCURR 4R*B MVFLBS 4RT2 SMO 6 [X6->OLD FMAPP 4S#L LDX 2 FPTR [X2->NEXT BLOCK 4SS= TXU 4 ATYPE(2) 4T?W BCS (7) [EXIT IF NO MORE FULLB'S TO MOVE 4TRG CHAIN 2,5 [A FULLB 4W?6 BRN MVFLBS 4WQQ # 4X=B # IF THE FILE, WHOSE DIRECTORY ENTRY WAS THE LAST TO BE MPDATED 4XQ2 # (I E ITS ENT BLOCK IS STILL PRESENT), IS MARKED 4Y9L # TO-BE-ERASED, WE ERASE IT IF 4YP= # NOT FROZEN, AND 4^8W # IF A DIRECTORY, IT IS EMPTY 4^NG # N B THE FCB MAY HAVE BEEN FREED BY NOW 5286 XERASCH 52MQ SBX 6 FX1 537B MHUNTW 1,FILE,ENT 538* ... LDX 0 ELAN(1) 539# ... SMO FX1 53=? ... SBX 0 N4AST 53#9 ... BNZ 0 NOTJOB [J IF NOT USER JOBLIST FILE 53*8 ... LDX 0 ECOPS(1) 53B7 ... SRL 0 15 53C6 ... BNZ 0 NOERASE [J IF NOT EMPTY 53D5 ... CALL 7 OLDFCAB 53F4 ... LDX 0 CTOPEN(2) 53G3 ... ADX 0 FWAITCOUNT(2) 53H2 ... BNZ 0 NOERASE 53H^ ... JBS NOERASE,2,BFMCOP [J IF FILE OPEN IN COPY MODE 53J6 ...#UNS CLOSESTATS 53J? ...( 53JD ... LDN 0 1 53JK ... ADS 0 CLSTAT8 [NO. OF ERASES OF JOBLIST **** FILES 53JQ ...) 53JY ... BRN YERASE [ERASE EMPTY JOBLIST FILE 53KX ...NOTJOB 53M2 JBC NOERASE,1,BEERASE 53WS ...YERASE 546L LDEX 0 EAUTOCOUNT(1) 54L= ADX 0 ESVCT(1) 555W BNZ 0 NOERASE [J IF FROZEN 55KG LDX 0 EUSE1(1) 5656 BZE 0 YESTER [J IF IT'S A TERMINAL FILE 56JQ LDCT 0 #777 574B ANDX 0 ECOPS(1) 57J2 BNZ 0 NOERASE [J IF DIRECTORY NOT EMPTY 583L YESTER 58H= SETNCORE 6,3,FILE,FLOCNB 592W MHUNTW 2,FILE,ENT 59GG LDX 0 ELAN(2) 5=26 STO 0 A1+5(3) 5=FQ ADN 3 A1 5=^B ADN 2 ELOC1 5?F2 MOVE 2 5 5?YL GETDIR 3 5#D= ERASEND 5#XW MFREE FILE,FLOCNB 5*CG MHUNTW 1,FILE,ENT 5*X6 NOERASE 5BBQ FREECORE 1 [THE ENT BLOCK 5BWB MFREE FILE,FABSNB 5CB2 ADX 6 FX1 5CTL EXIT 6 0 5D*= # 5DSW # ENTRY FROM CLOSEFUL WHEN NO BLOCK NUMBERS HAVE BEEN CHANGED 5F#G XENT1 5H?2 ... TRACEIF K6CLOSEALT,99,299,FX2,NOALT 5HQL ... CALL 7 OLDFCAB [X2->FCB, X3->FCA OF FILE 5M82 CALL 7 TFRFCB [SEE IF WE CAN FREE THE FCB AT LEV 1 5MML BRN SUPDIRCLOSE [FCB FREED 5N7= BRN SUPDIRCLOSE [FCB STILL IN USE 5NLW # 5P6G # ENTRY FROM CLOSEFUL WHEN 5PL6 # THE LENGTH OF THE BLOCKS RECORD HAS CHANGED 5Q5Q # COMPLETELY REWRITE THE DIRECTORY ENTRY CAREFULLY - STEPWRITE THE 5QKB # NAME RECORD AND INSERT/REPLACE THE BLOCKS RECORD 5R52 XENT2 5S4= ... TRACEIF K6CLOSEALT,99,299,FX2,NUMCHANG 5T3G CALL 7 STEPWRITE 5TH6 MHUNTW 2,FILE,ENT 5W2Q ADN 2 A1 5WGB SMO FRH(2) 5X22 MOVE 2 0 [THE NAME RECORD 5XFL STEP 5X^= MHUNTW 1,FILE,FINTER3 5YDW NAME 1,FILE,FWB 5YYG LDEX 0 AWORK3(2) 5^D6 BZE 0 NOCOPS [J IF THERE WAS NO BLOCKS RECORD 5^XQ REPLACE [REPLACE THE OLD BLOCKS RECORD 62CB BRN UPDMJ 62X2 NOCOPS 63BL INSERT [INSERT THE NEW BLOCKS RECORD 63W= UPDMJ 64*W MFREEW FILE,FWB 64TG HUNTW 1,FI,CFINDEXF [IF CFINDEXF EXISTS THEN 65*6 BNG 1 TOENDUNCL [INDEX HAS CHANGED & THUS MUST 65SQ NAME 1,FILE,FWB [BE UPDATED IN DIRECTORY 65^Y ... LDEX 0 AWORK3(2) 6676 ... BZE 0 NOSTEP [J IF ALREADY POSITIONED ON INDEXREC 66#B STEP 66J8 ...NOSTEP 66S2 REPLACE 67?L MFREEW FILE,FWB 67R= TOENDUNCL 68=W CALL 6 XERASCH [CHECK IF TO-BE-ERASED 68QG ... ACROSS CLOSEDIR,4 69=6 # 69PQ # ENTRY FROM CLOSEFUL WHEN 6=9B # MORE THAN ONE BLOCK NUMBER HAS CHANGED 6=P2 # REWRITE THE DIRECTORY ENTRY CAREFULLY - SINCE THE RECORD LENGTHS 6?8L # ARE UNCHANGED USE STEPWRITE 6?N= ...XENT3 6#MG ... TRACEIF K6CLOSEALT,99,299,FX2,MANYALT 6*LQ CALL 7 STEPWRITE 6B6B MHUNTW 2,FILE,ENT 6BL2 ADN 2 A1 6C5L SMO FRH(2) 6CK= MOVE 2 0 [THE NAME RECORD 6D4W YINF 6DJG STEP 6F46 CALL 7 STEPWRITE 6FHQ MHUNTW 2,FILE,FINTER3 6G3B ADN 2 A1 6GH2 SMO FRH(2) 6H2L MOVE 2 0 [THE BLOCKS RECORD 6HG= SBN 2 A1 6H^W FREECORE 2 [THE FINTER3 6JFG HUNTW 1,FI,CFINDEXF [IF CFINDEXF EXISTS 6J^6 BNG 1 TOENDUNCL [INDEX HAS CHANGED AND THUS MUST 6KDQ STEP [BE UPDATED IN DIRECTORY 6KYB CALL 7 STEPWRITE 6LD2 MHUNTW 2,FI,CFINDEXF 6LXL ADN 2 A1 6MC= SMO FRH(2) 6MWW MOVE 2 0 6NBG SBN 2 A1 6NW6 FREECORE 2 6P*Q BRN TOENDUNCL 6PTB # 6Q*2 # ENTRY FROM CLOSEFUL WHEN 6QSL # ONLY ONE BLOCK NUMBER HAS CHANGED, SO WE CAN UPDATE THE DIRECTORY 6R#= # CLEANLY, DO A NON-AUTONOMOUS FILE WRITE - THE ENTRY IS THEN 6RRW # SECURE ON BACKING STORE, AND ALL THE BACKING STORE IN THE 6S?G # ACCUMULATION OF FULLB'S AFTER THE DIRECTORY CAN BE FREED, 6SR6 # THE TRAILING CONVERTED CLOSECT FILES DETACHED AND CLOSESET 6T=Q # WAITERS FREED. CLOSE THE DIRECTORY. END OF CAREFUL UPDATE. 6TQB # HOWEVER, IF THERE'S AN AUTOCLOSE OR A COPIER ON THE DIRECTORY 6W=2 # WE WONT BE SECURE UNTIL THEY'VE FINISHED.- SO HAND OVER THE 6WPL # FULLB'S, AND OUR FILE RING, AND GIVE UP 6X9= XENT4 6Y8G ... TRACEIF K6CLOSEALT,99,299,FX2,ONE ALT 6^7Q HUNTW 1,FI,CFINDEXF [UPDATE NO LONGER CLEAN IF 6^MB [ TWO RECORDS NEED UPDATING 7272 [RECORDS NEED UPDATING 72LL BPZ 1 YINF 736= STEP 73KW MHUNTW 2,FILE,FINTER3 745G ADN 2 A1 74K6 SMO FRH(2) 754Q MOVE 2 0 [THE BLOCKS RECORD 75JB SBN 2 A1 7642 FREECORE 2 [FREE FINTER3 76HL TOPFCA2 2 773= SBX 3 FREADWORD(2) 77GW CHAIN 3,FX2 782G FILEWRIT ,FREE,,,,,TFAIL 78G6 SUPDIRCLOSE 78^Q ... CALL 7 TOPFCAB [X2->FCB & X3->FCA OF TOP FILE (DIR.) 79FB ... JFNZ QWAIT,2,FFAUTCLCT [J IF AUTOCLOSE ON FILE 7=Y= JBS NONZCLSCT,2,BFMCOP 7?CW JBC TOFREEBS,2,BFALTB 7?H2 ... SMO FBACKPOINT(3) 7?L6 ... LDEX 0 ARINGNO(3) 7?P= ... SBN 0 1 7?SB ... BZE 0 TOENDUNCL [J IF NO OTHER CLOSE ACTIVITY 7?XG # 7#C6 # WAIT FOR THE AUTOCLOSE TO GET GOING AND CONVERT THE FILE TO 7#WQ # CLOSECT TYPE, BEFORE HANDING OVER 7*BB # 7*W2 QSETWAIT 7B*L BS 2,BFAUTOW 7BT= ... TRACEIF K6CLOSEALT,99,299,FLOC1(2),WT CLWT 7CSG LDX 7 BACK2(2) 7D#6 LONGSET CLOSEWAIT,XBRK,7 7DRQ LONGCOOR 7F?B BRN SUPDIRCLOSE 7FR2 QWAIT 7G=L JBS NONZCLSCT,2,BFAUTO 7GQ= JBS QSETWAIT,2,BFSOLE 7H9W [ IF SLOECLOSE & NOT BELONG TO AUTOCLOSE THEN GO WAITING 7HPG NONZCLSCT 7J96 LDCT 6 #10 7JNQ CALL 7 SEARCHFCA 7K8B BRN SIOUX [J IF COPIER'S FCA FOUND 7KN2 LDN 6 #40 7L7L CALL 7 SEARCHFCA 7LM= BRN SFOU [J IF 'MOST-RECENT-CONVERT' FCA FOUND 7M6W GEOERR BRIEFPM,FCA??? 7MLG [ 7N66 [ FIND THE SOLECLOSER, IF THIS IS NOT FOUND, THE TOP LEVEL FILE 7NKQ [ IS CORRECT AND HAND FULLBS OVER TO THIS FILE. 7P5B SFOU JMBS SFFCA,2,BAMCOPY,BASOLE 7PK2 LDX 2 BPTRF(2) 7Q4L SMO FBACKPOINT(2) 7QJ= LDX 0 ATYPE(2) 7R3W TXL 0 CACT [TEST IF ACTIVITY REACHED 7RHG BCS SFOU 7S36 LDX 7 FPTRF(2) [STEP FORWARD 7SGQ BRN SFFCA1 [TO FCA 7T2B SFFCA [FOUND MERGE 7TG2 LDX 7 2 7T^L SFFCA2 7WF= LDX 2 BPTRF(2) 7WYW SMO FBACKPOINT(2) 7XDG LDX 0 ATYPE(2) 7XY6 TXL 0 CACT 7YCQ BCS SFFCA2 7YXB SFFCA1 [X7 -> FCA,X2 -> ACTIVITIES FILERING 7^C2 ADX 2 FBACKPOINT(2) 7^WL SMO FX2 82B= STO 2 AWORK1 [-> ACTIVITY 82TW LDX 2 7 [-> FCA 83T6 ADX 2 FBACKPOINT(2) 84#Q CALL 7 SFMAPP [X2->OTHER FMAPP 84SB LDX 5 2 85#2 TOPFCB 2 85RL CALL 7 SFMAPP [X2->OUR FMAPP 86?= LDX 6 2 86QW CALL 7 MOVEFULLBS [AND PASS THE BS UP 87Q6 LDX 2 FX2 889Q LDX 2 AWORK1(2) 88PB BRN TOCLOS 8992 SIOUX 89NL LDX 2 BPTRF(2) 8=8= SMO FBACKPOINT(2) 8=MW LDX 0 ATYPE(2) 8?7G TXL 0 CACT 8?M6 BCS SIOUX [J IF NOT THE ACTIVITY YET 8#6Q ADX 2 FBACKPOINT(2) 8#LB TOCLOS 8*62 LDX 5 FILEBRING(2) [X5->FCA OF BOTTOM FILE IN OTHER RING 8*KL CALL 7 OLDFCA 8B5= LDX 6 BPTRF(3) [X6->FCA OF DIRECTORY IN OUR RING 8BJW NEXONE 8C4G RERING 3,5 [GIVE THE FCA TO OTHER ACT 8CJ6 SMO 6 8D3Q LDX 3 FPTRF 8DHB SMO FBACKPOINT(3) [PICK UP NEXT FCA ETC. 8F32 LDN 2 0(3) 8FGL TXU 2 FX2 8G2= BCS NEXONE [J.IF LAST FCA 8GFW # 8G^G # EITHER WE'VE JUST FINISHED A CAREFUL UPDATE, OR WE'VE HANDED OVER 8HF6 # TO ANOTHER AUTOCLOSE - IN EITHER CASE WE'VE HAD ENOUGH SO. AFTER 8HYQ # CHECKING TO SEE IF WE CAN ERASE THE LAST FILE CLOSED, WE CLOSE 8JDB # THE DIRECTORY AND SUICIDE 8JY2 TOEND 8KCL LDX 2 FX2 8KX= LDN 0 FILERING(2) 8LBW TXU 0 FILERING(2) 8LWG BCC SUICIDE [NO DIRECTORY OPEN IF K6 ENTRY 8MB6 TOPFCB 2 8MTQ TXU 2 BFILE 8N*B BCC MAS 8NT2 CALL 6 XERASCH [CHECK IF THE FILE IS TO-BE-ERASED 8P#L MAS 8PS= CLOSETOP 8Q?W BRN SUICIDE 8QRG # 8R?6 # CAREFUL UPDATE FINISHED - SO FREE THE BACKING STORE IN THE FULLB'S 8RQQ # AFTER THE DIRECTORY, EMPTY THE FILE RING, RELEASE ANY 8S=B # CLOSESET WAITERS ON ANY FILE IN THE RING AND GIVE UP 8SQ2 # K5CLOSEALT IS THE ENTRY FROM CLOSEMAS AFTER MASTER'S DIRECTORY 8T9L # ENTRY HAS BEEN UPDATED 8TP= XENT5 8W8W TOFREEBS 8WNG LDX 4 SFULLB(1) 8X86 TCHBS 8XMQ CALL 7 TOPFCB [X2->DIRECTORY 8Y7B CALL 7 SFMAPP [X2->DIRECTORY'S FMAPP 8YM2 LDX 7 2 8^6L LDN 3 0 8^L= NEXTBS 925W SMO 7 92KG LDX 2 FPTR 9356 TXU 4 ATYPE(2) 93JQ BCS NMORBS [J IF NO MORE FULLB'S 944B CHAIN 2,FX2 [THE FULLB'S 94J2 BUX 3 NEXTBS [COUNT THEM 953L NMORBS 95H= BZE 3 NONFREE [J IF NO FULLB'S 962W YESFREE 96GG FREEBAX 9726 MFREEW BSTB,EMPTYB 97FQ BCT 3 YESFREE 97^B BRN TCHBS [J BACK TO CHECK NO MORE B.S. TO FREE 98F2 NONFREE 98YL LDN 5 0 99D= NEXTFCB 99XW BNG 5 NODIR [J IF K8 ENTRY - NO DIRECTORY OPEN 9=CG CALL 7 OLDFCAB 9=X6 BRN YESDIR 9?BQ NODIR 9?WB CALL 7 TOPFCAB 9#B2 YESDIR 9#TL SMO FBACKPOINT(3) 9**= LDN 0 0(3) 9*SW TXU 0 FX2 9B#G BCC TOEND [J IF ONLY THE DIRECTORY LEFT 9DQL ... TRACEIF K6CLOSEALT,99,299,FLOC1(2),CL FL 9F7L ... TRACEIF K6CLOSEALT,99,299,FINFD(2),CL CC 9FJM ... LF 2,FFAUTCLCT,7 [X7= COUNT OF AUTOCLOSES ON FILE 9FX4 ... BZE 7 XCLCCNEG [GEOERR IF NONE 9G9F ... SBN 7 1 9GHW ... STF 2,FFAUTCLCT,7 [REDUCE AUTOCLOSE COUNT BY 1 9GW? ... BNZ 7 SCLCT [J TO DERING IF THERE'S ANOTHER FCA 9H8Q BC 2,BFAUTO 9HNB JBCC NCLST,2,BFCLOSESET [J IF CLOSESET 9J82 [ I'M NOT APPY ABOUT THIS BIT! 9JML ... TRACEIF K6CLOSEALT,99,299,FLOC1(2),REL CLST 9KLW TRYFCAS 9L6G LDN 6 #200 9LL6 CALL 7 SEARCHFCA 9M5Q BRN PICKEDFCA [J. IF CLOSESET FCA FOUND 9MKB SMO FBACKPOINT(3) 9N52 LDX 2 BPTR(3) 9NJL NCLST CALL 7 TFRFCB [TRY TO FREE THE FCB AT LEVEL 1 9P4= BRN NEXTFCB 9PHW SCLCT LDX 2 3 9Q3G CALL 7 SUBRELT [CANT FREE FCB AT LEV 1 - DERING FCA 9QH6 BRN NEXTFCB 9R2Q ...PICKEDFCA 9RGB LDX 7 2 9S22 LDX 1 2 9SFL NOTACT 9S^= LDX 1 BPTRF(1) 9TDW SMO FBACKPOINT(1) 9TYG LDN 2 0(1) 9WD6 LDX 0 ATYPE(2) 9WXQ TXL 0 CACT 9XCB BCS NOTACT [J IF NOT THE CLOSESET ACTIVITY YET 9XX2 FPUT [SET THE CLOSESET GOING 9YBL LDX 2 7 9YW= CALL 7 SUBRELT [AND REMOVE ITS FCA 9^*W CALL 7 OLDFCAB 9^TG BRN TRYFCAS [REL ANY MORE CLOSESETS ON THIS FILE =2*6 # =2SQ ...# THE FILE BEING CLOSED HAS BEEN REMOVED BY A CLOSESHORT OR =3#B ...# CLOSEABANDON. THE DIRECTORY ISN'T OPEN. ENTERED FROM CLOSEONE. =3S2 ...XENT8 =4?L NGN 5 1 =4R= BRN WRNGTRACE =5=W # =5QG ...# AS K8, BUT THE DIRECTORY IS OPEN. ENTERED FROM CLOSEONE. =6=6 ...XENT7 =79B LDN 5 0 =7P2 WRNGTRACE =88L ... TRACEIF K6CLOSEALT,99,299,5,WRNG FCB =8N= BRN NEXTFCB =97W # =9MG # BRANCH HERE IF THERE'S A FAILURE DURING THE FILEWRITE ==76 TFAIL ==LQ MHUNTW 1,BSTB,BWRITE =?6B FAILCLEAR BACK1(1),BACK2(1) =?L2 TOPFCB2 2 =#5L MHUNTW 1,BSTB,BWRITE =#K= NAME 1,FILE,FUWB =*4W CHAIN 1,FPTR(2) =*JG SUBSTITUTE [SWAP BLOCK NOS =B46 BRN TOENDUNCL =BHQ SUICIDB =C3B CLOSETOP =D2L ... TRACEIF K6CLOSEALT,99,299,FX2,CLOSED =D^W SUICIDE =FFG SUICIDE =F^6 XBRK =GDQ GEOERR BRIEFPM,CL BRKIN =GR7 ...XCLCCNEG =H25 ... GEOERR BRIEFPM,CL CCNEG [FFAUTCLCT ZERO (COUNT OF AUTOCLOSES) =H93 ... [ & THIS IS AN AUTOCLOSE =HD2 #END ^^^^ ...14274715000200000000