(George Source)
Macros used: ACROSS, APVSF, BC, BITDEFS, BS, BSXD, BXE, BXL, BXU, CHAIN, CHAIND, CLOSETOP, COOR1, COOR3, DELFCB, DELWORK, DOWN, FC, FDRMAUTX, FON, FPUT, FREEBAX, FREECORE, FRITE, GEOERR, GETFNAME, JBC, JBCC, JBS, JBSC, JFNZ, JFZ, JMBAC, JMBAS, JMBS, LF, LFCLOSE, LONGCOOR, LONGON, LONGON1, LONGSET, MBC, MBS, MFREEW, MHUNTW, PSTAC, RERING, SEG, SEGENTRY, SETNCORE, SFCA, STF, SUBCUBS, SUBRELT, SUICIDE, TAB, TOPFCAB, TOPFCB, TRACEIF, TRANSFCB, UP, VOP
2259 ... SEG CLOSEND,863,SECTION FILE,CLOSE 228D ...# 22=3 ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983 22?M ...# 22BW ...# USES OF X7 22G5 ...# ---------- 22K# ... BITDEFS 7,0,XBSHORT [CLOSESHORT 22NH ... BITDEFS 7,1,XBTOP [CLOSETOP/CLOSEDIR 22RQ ... BITDEFS 7,2,XBFULL [CLOSE (FULL) 22W^ ... BITDEFS 7,3,XBFRBS [CLOSEFRBS 23?T ... BITDEFS 7,10,XBFRITEALL [FRITE WITH 'ALL' PARAMETER 23*^ ... BITDEFS 7,11,XBCORUNJWR [ADATA/CORUNJAM BUFFER BEING (FIXED) 23D5 ... [ WRITTEN BY CORE UNJAMMER 23G? ... BITDEFS 7,12,XBTHROW [CLOSETHROW 23KG ... BITDEFS 7,14,XBABAND [CLOSEABANDON 23QT ... BITDEFS 7,15,XBNONAUTOWR [NON-AUTONOMOUS WRITING OF WRITE 23Y8 ... [ BUFFER BLOCKS REQUIRED 245K ... BITDEFS 7,20,XBCOPY [CLOSING FROM COPY MODE 24#3 ... BITDEFS 7,22,XBAUTO [AUTONOMOUS 24C= ... BITDEFS 7,23,XBSET [CLOSESET 24GF ...# 24KN ...# 24NX ...# ENTRY POINTS. 24S6 ...# 24XQ SEGENTRY K1CLOSEND,XENT1 25CB ... SEGENTRY K2CLOSEND,XENT2 [ENTRY FROM CLOSEMAS 26DT ...# 26S2 ...# 2777 ...# 27G# ...# 27TG # CLOSEND CLOSES THE FILE IN THAT IT ADJUSTS CTOPEN, UNSETS 28*6 ...# BFMCOP (THE OPEN IN COPY MODE BIT) AND RELEASES ANY WAITERS. 28SQ # IT DECIDES WHETHER AN AUTONOMOUS CLOSE SHOULD BE SET UP TO UPDATE 29#B ...# THE DIRECTORY, AND IF SO, GOES ACROSS TO CLOSEONE TO SET ONE GOING 29S2 [ 2B8L ...# 2BN= ...# 2G5L SFINDEXF 2GK= #HAL FI+FINDEXF,0 2HJG MCOMMUNE #57777777 2J46 MASKV #47577737 2KH2 # 2KLX ...# 2KQS ...# SUBROUTINES 2KWP ...# ----------- 2L2L # 2LG= # 2LQ4 ...# FREES THE FSTACK ELEMENT POINTED AT BY X2. ON EXIT, X1=FX1, X2=FX2 2L^W SUBRELT 2MFG SUBRELT 2 2M^6 EXIT 6 0 2N8Y ...# 2N=G ...# 2N#4 ...# LOCATES A FMAPP BLOCK. 2N*L ...# ON ENTRY, X2->FCB OR FSTACK. X1 IS S/R LINK. 2NC8 ...# ON EXIT, X2->FMAPP. X0 OVERWRITTEN. 2NDQ SFMAPP 2NYB ... LDX 0 FFSFMAPP 2PXL MAPFIND 2QC= LDX 2 FPTR(2) 2QWW ... BXU 0 ATYPE(2),MAPFIND 2RW6 EXIT 1 0 2S5Y ...# 2S9T ...# 2S*Q TAB 2STB TOPFCAB 3,2 [X2->FCB X3->FCA 2T*2 EXIT 6 0 2TJS ...# 2TNP ...# 2TSL TB 2W#= ... TOPFCB 2 [X2-> FCB 2WRW EXIT 6 0 2X?G # 2XR6 ...[ 2Y=Q ...[ADJUST ACTIVITY PRIORITY WHEN CLOSING VITAL SYS FILE:ASF REQUIREMENT 2YQB ...[ ON ENTRY X2->FCB 2^=2 ...PRIORITY 2^PL ... JMBAC (5),2,BFDIR,BFVSF [EXIT IF NOT VITAL SYS FILE 329= ... APVSF DOWN [ADJUST ACT PRI 32NW ... CALL 6 TB [X2->FCB AGAIN 338G ... EXIT 5 0 375G # 37K6 # FIND THE ACTIVITY ATTACHED TO THE FCA ADDRESSED BY X2 384Q SFACT 38JB LDX 2 BPTRF(2) 3942 SMO FBACKPOINT(2) 39HL LDX 0 ATYPE(2) 3=3= TXL 0 CACT 3=GW BCS SFACT 3?2G ADX 2 FBACKPOINT(2) 3?G6 ... TRACEIF K6CLOSEND,99,299,ACNUM(2),ACTOUT 3?^Q EXIT 1 0 3#FB # 3G#W # 3GSG ...# CONVERT TO A FULL CLOSE - CHANGE X7 B0-8 TO HAVE JUST XBFULL SET 3H#6 XCONVERT 3HRQ ... TRACEIF K6CLOSEND,99,299,7,CLOSE??? 3J?B ... ANDX 7 BSP16 [PRESERVE L.S. 15 BITS OF X7 3JR2 ... BS ,XBFULL 3M96 EXIT 5 0 3MNQ # 3MYJ ...# 3N8B # RELEASE ANY AUTOCLOSE ON THE FILE WHICH IS WAITING FOR THE FILE TO 3ND8 ...# BE FREE (IT WILL ONLY BE WAITING IF THE FILE IS OPEN IN GENERAL, 3NN2 ...# WRITE OR APPEND MODE). 3NXS ...# ON ENTRY, X2-> FCB. X5 IS S/R LINK. 3P?H ...# ON EXIT, X2-> FCB, X0,X1 & X6 MAY BE OVERWRITTEN. NO COORDINATION 3PM= RELCLFR 3QLG ... JBCC (5),2,BFCLEANW [EXIT IF NO WAITING AUTOCLOSE 3R66 ... TRACEIF K6CLOSEND,99,299,FLOC1(2),REL CLFR 3XGQ LONGON CLOSEFREE,BACK2(2) 3Y2B ... CALL 6 TB [X2->FCB 3YG2 ... EXIT 5 0 3Y^L # 3^9D ...# 3^F= ...# THIS SUBROUTINE WAKES WAITERS IN STYLE 6 ON THIS FILE, 3^P4 ...# I.E. ANY FWAITCOUNT TYPE WAITERS OR ANYONE WAITING TO EMPTY. 3^YW ...# ON ENTRY, X2-> FCB. X5 IS S/R LINK. 428N ...# ON EXIT, X0,X1 & X6 MAY BE OVERWRITTEN, X2-> FCB. NO COORDINATION 42DG RELWAIT 48RL LDX 0 FWAITCOUNT(2) 49?= BNZ 0 WAITER [J IF SOMEONE WAITING 49QW ... JBC (5),2,BFEMPTY [EXIT IF NO-ONE WAITING TO EMPTY 4?9Q WAITER 4?PB ... TRACEIF K6CLOSEND,99,299,FLOC1(2),RL STY6 4#92 LONGON 6,BACK2(2) 4#NL ... CALL 6 TB [X2-> FCB 4*8= ... EXIT 5 0 4HKD ...# 4HLF ...# 4HN= ...[ THIS SUBROUTINE CLEARS THE BFTIDY SEMAPHORE WHICH IS SET UP IN 4HQ3 ...[ SEGMENT CLOSEDIR - THE SEMAPHORE IS USED TO PREVENT ONE CLOSE 4HRS ...[ OVERTAKING ANOTHER IN CRITICAL CIRCUMSTANCES. 4HTN ...[ ON ENTRY, X2->FCB. X5 IS S/R LINK. 4HXQ ...[ ON EXIT , X0, X1 & X6 MAY BE DESTROYED, X2->FCB. NO COORDINATION. 4H^S ...SBFTIDY 4J5Y ... VOP 2,BFTIDY [CLEAR BFTIDY SEMAPHORE 4J82 ... CALL 6 TB [X2->FCB 4J=4 ... EXIT 5 0 4J#6 ...[ 4J#8 ...# 4J#9 ...# SUBROUTINE TO ISSUE A LFCLOSE MACRO, IF NECESSARY, TO TELL 4J#= ...# LISTFILE THAT THIS FILE IS NO LONGER OPEN FOR WRITING. 4J#? ...# ON ENTRY, TOP FILE RINGED IN IS ONE FOR WHICH LFCLOSE TO BE ISSUED 4J## ...# X2->FCB, X3->FCA. X5 IS S/R LINK. 4J#* ...# ON EXIT, X0,X1 & X6 MAY BE OVERWRITTEN, X2->FCB, X3->FCA. 4J#B ...# MAY COORDINATE. 4J#K ...XLFCLOSE 4J#M ... JFZ (5),2,FFFREZCT [J IF FILE NOT LISTFILE-FROZEN 4J#P ... LDX 0 FSAVECOUNT(2) 4J#R ... ANDX 0 HALFTOP 4J#T ... BNZ 0 (5) [J IF HLS WRITE FROZEN 4J#X ... TRACEIF K6CLOSEND,99,299,FLOC1(2),LFCLOS [LFCLOSE MACRO ISSUED 4J#^ ... SBX 5 FX1 4J*3 ... GETFNAME [SET UP FABSNB FOR THIS FILE 4J*5 ... CALL 6 TB [X2-> FCB 4J*6 ...#UNS AWLSZ 4J*7 ...( 4J*8 ... LDX 6 FBLMOD(2) 4J*9 ... SBN 6 FBLKS-A1 [PICK UP FILE SIZE 4J*= ...) 4J*? ... LF 2,FFFREZCT,0 4J*# ...#UNS AWLSZ 4J** ... LFCLOSE 0,6 [INFORM LF THAT FILE CAN BE LISTED 4J*B ...#UNS AWLSZ 4J*C ...#SKI 4J*D ... LFCLOSE 0 [INFORM LISTFILE THAT FILE CAN NOW BE 4J*F ... [ LISTED 4J*G ... CALL 6 TAB [X2-> FCB, X3->FCA 4J*H ... ADX 5 FX1 4J*J ... EXIT 5 0 4J*K ...# 4J*L ...# 4J*M ...TICKLEDRM 4J*P ... SBX 5 FX1 4J*S ... FDRMAUTX 6 4J*T ... CALL 6 TAB [X2->FCB, X3->FCA 4J*X ... ADX 5 FX1 4JB2 ... EXIT 5 0 4JB5 ...# 4JBG ...# 4JBX ...# MAIN CODE 4JC# ...# ---- ---- 4JCP ...[ 4JD= ...[ 4JGL # THIS IS THE MAIN ENTRY FROM CLOSEDIR 4K2= ...# THE FILE IS STILL OPEN & ATTACHED TO THE CLOSING ACTIVITY. 4KFW ...# AUTOCLOSES COULD BE RINGED IN. 4LF6 XENT1 4LMK ...MERGEAB 4LN4 ... CALL 6 TAB [X2 -> FCB X3 -> FCA 4LX2 ... JBC NOFFWF,2,BFWORK [J IF NOT WORK FILE 4LY? ... JBC NOTERALL,2,BFERALLWF 4L^J ... COOR3 #41 [WAIT FOR ERALLWF TO FINISH 4M2T ... BRN MERGEAB [AND MOVE FCB TO FILE CHAIN 4M46 ...NOTERALL 4M5C ... BS 2,BFERALLWF [TO LOCK OUT ERALLWF DURING FRBS 4M6Q ... ANDX 7 BSP16 [PRESERVE L.S. 15 BITS OF X7 (ESP. 4MBG ... [ CLOSEABANDON BIT IF SET) 4ML= ... BS ,XBFRBS [CONVERT TO CLOSEFRBS 4M^W ...NOFFWF 4N5J ... JBC NOTAB,2,BFCLOSEAB [J IF FILE NOT TO BE CLOSEABANDONED 4N9= ... BS ,XBABAND 4N#^ ...NOTAB 4NSK ... JBS XABAND,,XBABAND [J IF CLOSEABANDON 4P#9 ... JBS NOTOPSTILL,,XBAUTO [IGNORE OTHER OPENERS IF AUTOCLOSE 4PRT ... LDX 0 CTOPEN(2) [X0= NO. OF TIMES FILES OPEN 4Q?F ... SBX 0 4 [ALLOW FOR MODE THIS ACT HAS FILE 4QR5 ... [ OPEN IN 4XQ2 ANDX 0 MCOMMUNE(1) 4XY= ... BZE 0 NOTOPSTILL [J IF NOT OPEN 4Y6G ... JBC STILLOPEN,2,BFWORK 4Y#Q ... BC 2,BFERALLWF [CLEAR IN CASE SET ABOVE FOR FRBS 4YH2 ... BRN STILLOPEN 4YP= ... [IGNORE COPY MODE AT THIS POINT SO WE 4^8W ... [ RELEASE RIGHT WAITERS 52MQ NOTOPSTILL 537B ... JBS TESTMAS,,XBFULL [J IF FULL CLOSE 53M2 ... JMBAS WORKERASE,2,BFWORK,BFERASE [J IF TO-BE-ERASED WORKFILE 546L ... JMBS START,,XBSHORT,XBFRBS [J IF CLOSESHORT OR CLOSEFRBS 6KDQ # 6KYB # CHECK TO SEE IF WE SHOULD CONVERT TO A FULL CLOSE. CONVERT IF 6LD2 ...# BLOCKS ALT. OR UWB OR BFDIRUPDATE SET 6LLB ...# 6M36 ... JMBAC MFULL,2,BFALTB,BFUWB,BFDIRUPDATE 6M6L ... CALL 5 XCONVERT [CONVERT TO FULL CLOSE 6M=6 ...TESTMAS 6M*L ... BXU 2 BFILE,MFULL [J IF NOT MASTER 6MF6 ...# 6MJL ...# 6MN6 ...# 6MRL ...# FULL CLOSE ON MASTER & NO OTHER OPENERS. 6MX6 ...# GO ACROSS TO CLOSEMAS TO REWRITE MASTER'S 6N2L ...# DIRECTORY ENTRY. COME BACK TO K2CLOSEND IF NOT AN AUTOCLOSE. IF IT 6N66 ...# IS AN AUTOCLOSE, CLOSEMAS GOES ACROSS TO CLOSEALT TO WIND UP THE 6N9L ...# CAREFUL UPDATE 6N*6 ...# 6NDL ... LDCT 0 #774 6NJ6 ... ANDX 0 FGENERAL1(3) 6NML ... ERS 0 FGENERAL1(3) [CLEAR MODE OPEN IN FCA 6NR6 ... BS 3,BAMGEN [SET 'GENERAL MODE' IN FCA 6NWL ... LDCT 0 #400 6P26 ... STO 0 CTOPEN(2) [PRETEND MASTER OPEN IN GENERAL MODE 6P5L ... CALL 5 SBFTIDY [CLEAR 'BFTIDY' SEMAPHORE 6P96 ... ACROSS CLOSEMAS,1 6P#L ...XENT2 6PD6 ... CALL 6 TAB [X2-> FCB, X3-> FCA 6PHL ... STOZ CTOPEN(2) [CLEAR WAY MASTER IS OPEN 6PKB ... CALL 5 PRIORITY 6PM6 ... CALL 5 RELWAIT [RELEASE WAITERS IN STYLE 6 6PQL ... BRN TORIDFCB [GO TO FREE FSTACK BLOCK 6PW6 ...# 6P^L ...# 6Q56 ...# 6Q8L ...# CLOSEABANDON 6Q#6 ...# FOR A WORKFILE, CARRY ON CLOSING 6QCL ...# OTHERWISE WE GO DOWN TO CLOSEAB TO RETURN THE FILE TO THE STATE 6QH6 ...# IT WAS IN BEFORE IT WAS WRITTEN TO OR OPENED. 6QLL ...# 6QQ6 ...XABAND 6QTL ... JBS WFAB,2,BFWORK [J IF WORK FILE 6Q^6 ... DOWN CLOSEAB,1 [CLOSEABANDON FILE 6R4L ... BRN OTHEROPE [OTHER OPENERS (DO ABSOLUTE MINIMUM) 6R86 ... CALL 6 TAB [X2->FCB, X3->FCA 6R?L ... BRN XCTOPEN 6RC6 ...OTHEROPE 6RGL ... CALL 6 TAB [X2->FCB, X3->FCA 6RJY ... JBS XCTOPEN,,XBCOPY [J IF COPIER(MUSTN'T GO TO STILLOPEN 6RM= ... [ - ROUTE ALL COPIERS BY XCTOPEN) 6RPL ... LDX 0 CTOPEN(2) 6RT6 ... ANDX 0 MCOMMUNE(1) 6RYL ... SBX 0 4 6S46 ... BZE 0 XCTOPEN [J IF STILLOPEN ONLY IN COPY MODE 6S7L ... BRN STILLOPEN 6S?6 ...# 6SBL ...# 6SG6 ...# 6SKL ...WORKERASE [TO-BE-ERASED ! FILE 6SP6 ... JFNZ START,2,FFFREZCT [J IF LF-FROZEN (CAN'T BE HLS FROZEN) 6SSL ...WFAB1 6SY6 ... LDX 6 FBLMOD(2) 6T3L ... SBN 6 FBLKS-A1 6T76 ... SMO FX2 6T9D ... STOZ AWORK1 [REMEMBER IN AWORK1 NO. OF BLOCKS IN 6T?Q ... [ FILE TO GIVE TO DELWORK 6TB6 ... LDN 0 FBLKS-A1 6TFL ... STO 0 FBLMOD(2) [EMPTY FILE 6TLW ... SUBCUBS 3,6,JOB [REDUCE CUBS 6TS6 ... CALL 6 TB [X2-> FCB 6TXL ... BRN START 6W36 ...WFAB [TO-BE-ABANDONED ! FILE 6W6L ... LDX 0 CTOPEN(2) 6W=6 ... ANDX 0 MCOMMUNE(1) 6W*L ... SBX 0 4 6WF6 ... BZE 0 WFAB1 [J IF NOT STILL OPEN 6WJL ... BS 2,BFCLOSEAB [SET 'TO-BE-CLOSEABANDON' BIT IN FCB 6WPL # 6X4R ...# 6XCY ...# 6XN? ...# IT'S CLOSESHORT OR CLOSEFRBS. IF THERE ARE ANY SPARE BLOCKS IN THE 6XYL ...# FCB, PUT THEM IN A FULLB. IF CAREFUL, LOCATE ANY FULLBS AFTER THE 6Y8^ ...# FMAPP AND CHAIN THESE TO THE ACT.. 6YFC ...# IF CLOSEFRBS, FREEBAX ALL THIS BACKING STORE. 6YSJ ...# IF CLOSESHORT, CHAIN THE FULLBS AFTER THE DIRECTORY'S FMAPP 6^7Q # - THE DIRECTORY MUST BE OPEN AT LEVEL 1 6^MB START 7272 LDX 3 FUSEBL(2) 72LL ... SBX 3 FBLMOD(2) [X3= NO. OF BLOCKS WHICH NEED FREEING 736= ... LDN 5 0 [INITIALISE 'NO. OF FULLBS' 73KW ... BZE 3 MAPCHX [J IF NO BLOCKS TO FREE 745G ... SETNCORE 2(3),2,BSTB,FULLB [X2-> FULLB 74K6 ... TOPFCB 1 [X1-> FCB 754Q ... LDX 6 FUSEBL(1) 75DF0... SBX 6 FBLMOD(1) [X6= NEW NO. OF BLKS NEEDING FREEING 75S8 ... BXL 3 6,ZBSERR [GEOERR IF NO. OF SPARE BLOCKS HAS 767X ... [ INCREASED 76HL ... LDX 3 6 [X3= NO. OF SPARE BLOCKS 773= ... SBS 3 FUSEBL(1) [ADJUST NO. OF BLOCKS IN FCB 77GW ... SBS 3 ALOGLEN(1) [ADJUST LENGTH OF FCB 782G ... ADN 3 2 78G6 ... STO 3 A1(2) [SET UP RECORD HEADER FOR FULLB 7G=L LDX 0 BSPRE(1) 7GK3 ... STO 0 A1+1(2) [FILE RESIDENCE INTO FULLB 7GXD ... BZE 3 NBLKS [J IF NOW NO BLOCKS 7H9W ADX 1 FBLMOD(1) 7HPG ADN 1 A1 7J96 ADN 2 A1+2 7JNQ ... MOVE 1 510(3) [MOVE SPARE BLOCKS TO FULLB 7K8B ...NBLKS 7KN2 ... ADN 5 1 [UPDATE COUNT OF FULLBS 7LM= MAPCHX 7LX4 ... CALL 6 TAB [X2->FCB, X3->FCA 7M6W JBC NOCARE,2,BFCARE 7MLG ... CALL 1 SFMAPP [X2->FMAPP 7PK2 LDX 3 2 7Q4L ... LDX 6 FFSFULLB 7RHG MOVENEXT 7S36 LDX 1 FPTR(3) 7SGQ ... BXU 6 ATYPE(1),MOVEDALL [FINISH IF NOT FULLB 7T2B ... CHAIN 1,FX2 [RECHAIN THE FULLBS AFTER THE ACT. 7T^L BUX 5 MOVENEXT [COUNT THEM 7WF= MOVEDALL 7WYW ... CALL 6 TAB [X2->FCB, X3->FCA 7XDG NOCARE 7XY6 ... BZE 5 NOSPARE [J IF NO FULLBS 7YXB ... JBS TOFREEBS,,XBFRBS [J IF CLOSEFRBS 82B= LDX 2 FPTRF(3) [X3->DIRECTORY'S FCA 82TW ADX 2 FBACKPOINT(2) 83*G ... CALL 1 SFMAPP [X2->DIRECTORY'S FMAPP 85#2 # WHEN TRANSFERRING FULLB'S THEY SHOULD BE PUT AFTER THE FIRST FULLB 85RL ...# OF THE TRANSFEREE, OR AFTER THE FMAPP IF NO FULLB 86QW SMO FPTR(2) 87=G LDX 0 ATYPE 87Q6 ... BXU 0 FFSFULLB,NODIRFUL [J IF NO FULLB AFTER DIRECTORY'S FMAP 889Q ... LDX 2 FPTR(2) [X2-> FIRST FULLB 89NL NODIRFUL 8=8= ... LDX 3 2 [X3-> BLOCK TO CHAIN FULLBS TO 8=MW NEXTMV 8?7G MHUNTW 1,BSTB,FULLB 8?M6 CHAIN 1,3 [CHAIN FULLB'S AFTER DIRECTORY 8#6Q BCT 5 NEXTMV 8#LB BRN NOSPARE 8*62 TOFREEBS [CLOSEFRBS FREES BACKING STORE NON-CAREFULLY 8*KL FREEBAX 8B5= MFREEW BSTB,EMPTYB 8BJW BCT 5 TOFREEBS 8C4G NOSPARE 8CJ6 ... CALL 6 TAB [X2->FCB, X3->FCA 8D3Q ... JBC NOTWOR,2,BFWORK 8DHB ... BC 2,BFERALLWF [CLEAR BIT SET DURING FRBS 8F32 ...NOTWOR 8FGL LDX 0 CTOPEN(2) 8G2= SMO FX1 8GFW ANDX 0 MCOMMUNE 8G^G SBX 0 4 8HF6 ... BNZ 0 STILLOPEN [J IF FILE NOW STILL OPEN (CAN BE IF 8HYQ ... [ WORKFILE) 8LWG MFULL 8MB6 ... STOZ FGENERAL1(3) [CLEAR OUT FCA MARKERS SINCE ON 8MTQ ... STOZ FGENERAL2(3) [ UPDATING CTOPEN WE ENTER NEW PHASE 8N*B ... [ - MARK THE FCA AS SPARE 953L # 95H= ...# CLOSE THE FILE - CLEAR CTOPEN 9726 ...XCTOPEN 979Y ... CALL 5 PRIORITY 97FQ ... JBS YCOPY,,XBCOPY [J IF CLOSING FROM COPY MODE 97PJ ...YCTOPEN 97^B ... STOZ CTOPEN(2) [CLEAR 'WAY FILE IS OPEN' 98F2 ... MBC 2,BFDCF,BFCORE,BFSTEPWAIT,BFAPPWAIT 98YL ... CALL 5 RELWAIT [RELEASE ANY STYLE 6 WAITERS 99D= ... CALL 5 RELCLFR [RELEASE ANY AUTOCLOSE WAITING 99XW ... JBSC TLF,2,BFGDR [J IF GDR 9=CG ... LDX 0 4 9=X6 ... ANDN 0 1 9?BQ ... BNZ 0 YREAD [J IF CLOSING FROM READING 9?WB ... [SINCE LISTFILE MAY SHARE WITH READ 9#B2 ...TLF 9#NC ... CALL 5 XLFCLOSE [INFORM LISTFILE (IF FROZEN) FILE NOW 9*2S ... [ FREE 9**= ...YREAD 9*SW ... CALL 5 SBFTIDY [CLEAR BFTIDY SEMAPHORE 9B#G ... JMBS SAVETEST,,XBABAND,XBSHORT,XBFRBS 9BS6 ...WTFILE 9C?Q ... JBS ZAUTO,2,BFSOLE [J IF AUTOCLOSE ON FILE 9CRB ... JBC NFULL,,XBFULL [J IF NOT FULL CLOSE *NGB # *NSR ...# *P78 ...# *PFK ...# THE DIRECTORY IS TO BE UPDATED. *PS2 ...# SET THE DIRECTORY-BEING-UPDATED BIT (BFSOLE). *Q6C ...# MARK THE FCA AS BELONGING TO AN UNCONVERTED AUTOCLOSE. *QDW # PRESERVE THE FCB NO. IN X5 FOR CHECKING IF THE FILE STILL EXISTS *QR? ...# AFTER A COORDINATION - SOMEONE MAY HAVE CLOSESHORTED OR *R5N ...# CLOSEABANDONED IT !!! *RD6 # SET UP AN AUTONOMOUS CLOSE ACTIVITY TO DO THE UPDATE, UNLESS THIS *RXQ ...# IS AN AUTOCLOSE CLOSE - THEN THE CURRENT ACTIVITY MUST DO *SCB ...# THE DIRECTORY UPDATE. *SX2 ... BS 2,BFSOLE [SET 'WE ARE GOING TO UPDATE THE *TBL ... [ DIRECTORY' BIT *TW= [ *W*W ...[ NOW FIND THE LATEST AUTOCLOSE (IF ANY) AND UNMARK IT, MARK OUR FCA *WTG ...[ AS THE LATEST, CONVERTED SOLECLOSE. *X*6 [ *XC* ... LF 2,FFAUTCLCT,6 [X6= COUNT OF AUTOCLOSES ON FILE *XFJ ... ADN 6 1 *XHR ... STF 2,FFAUTCLCT,6 [UPDATE COUNT OF AUTOCLOSES BY 1 *XL2 ... SBN 6 4095 *XN9 ... BPZ 6 ZAUTTOOBIG [J IF FIELD FFAUTCLCT HAS OVERFLOWED *XQD ... LDX 5 BACK2(2) [REMEMBER FCB NO. OF TOP FILE OPEN *XSQ PSTAC 2,3 [X2 -> FSTACK BLOCK *Y#B ... LDEX 6 ARINGNO(2) *YS2 ... ADN 2 A1 [X2-> 1ST ELEMNT IN FSTACK *^?L NEXT *^L3 ... JBSC XLATEST,2,BALATEST [J IF FOUND LATEST AUTOCLOSE (& CLEAR *^YD ... [ BIT) B2=W ... ADN 2 FELLEN B2QG ... BCT 6 NEXT [J IF MORE ELEMENTS TO LOOK AT B3=6 XLATEST B67W MBS 3,BACONV,BASOLE,BALATEST B776 ... JBC NOTCLAUT,,XBAUTO [J IF NOT AN AUTONOMOUS CLOSE B9K= ACROSS CLOSEONE,1 B=4W NOTCLAUT B=C? ... ACROSS CLOSEONE,4 [TO SET UP AUTONOMOUS CLOSE WHICH B=PN ... [ THEN GOES TO K1CLOSEONE B?46 # B?4C ...# B?4N ...# B?4^ ...YCOPY B?53 ... BXE 2 BFILE,YCTOPEN [J IF :MASTER(OPEN IN GENERAL MODE B?55 ... [ FOR COPYING - FULL CLOSE SINCE FILE B?57 ... [ NOT ACTUALLY COPIED) B?5= ... BC 2,BFMCOP [CLEAR 'OPEN IN COPY MODE' BIT B?5B ... BRN NOCOPYTEST B?5H ... SMO FX2 B?5S ... LDX 0 FILERING B?65 ... SMO FX2 B?69 ... BXU 0 FILEBRING,XCOPYERR2 [GEOERR IF EXTRA FILE RINGED INTO B?6* ... [ AUTOCOPY B?6G ...NOCOPYTEST B?6M ... JBCC NOWCLOSED,2,BFFRITEW B?6Y ... TRACEIF K6CLOSEND,99,299,FLOC1(2),RL FRITE B?76 ... FON FRITEWAIT [RELEASE ANY FRITES WAITING FOR COPY B?7# ... [ TO FINISH B?7G ... CALL 6 TB [X2->FCB B?7R ...NOWCLOSED B?84 ... CALL 5 RELWAIT [RELEASE ANY (COPY) WAITER IN STYLE 6 B?88 ... CALL 5 RELCLFR B?8* ... CALL 5 SBFTIDY [CLEAR BFTIDY SEMAPHORE B?8L ... JBC WTFILE,,XBABAND [J IF NOT CLOSEABANDON B?8X ... LDX 0 CTOPEN(2) B?98 ... BNZ 0 NOSET [J IF STILL OPEN B?9F ... BRN SAVETEST B?9Q ...# B?=3 ...# B?=# ...# B?=K ...ZAUTO [AUTOCLOSE ON FILE (BFSOLE SET) B?=W ... JBC XJBRN,,XBAUTO [J IF THIS NOT AN AUTOCLOSE B??4 ... JBC XWAITAUTO,2,BFAUTO [J IF AUTOCLOSE BEING SET UP BUT IS B??= ... [ NOT QUITE THERE B??D ... SMO FBACKPOINT(3) B??P ... LDN 2 0(3) [X2-> FSTACK B?#2 ... LDEX 5 ARINGNO(2) B?#? ... ADN 2 A1 B?#J ...SFCA B?#T ... BXE 2 3,OURS [J IF THIS IS OUR FCA B?*6 ... BSXD 6,BALATEST B?*C ... ANDX 6 FGENERAL1(2) B?*N ... BNZ 6 XFOUND [J IF LATEST FCA FOUND B?*^ ...OURS B?B= ... ADN 2 FELLEN B?BH ... BCT 5 SFCA [J IF MORE ELEMENTS TO LOOK AT B?BS ... GEOERR BRIEFPM,NO FCA B?C5 ...XFOUND [X2-> FCA OF LATEST AUTOCLOSE B?CB ... CALL 1 SFACT [X2-> FILE'S AUTOCLOSE ACT. B?CM ... SMO FX2 B?CY ... STO 2 AWORK1 [REMEMBER POINTER TO OTHER AUTOCLOSE B?D9 ...[ MERGE TO SOLECLOSE OR COPYFILE B?DG ...# B?DR ...# RERING OUR FILE RING, EXCEPT OUR FCA, AT THE BOTTOM OF THE OTHER'S B?F4 ...# B?F* ... LDX 2 FX2 B?FL ... LDX 3 FILERING(2) [X3-> OUR TOP FCA B?FX ... LDX 4 3 B?G4 ... BXE 3 FILEBRING(2),OURSUB [J IF OUR (TOP) FCA IS THE ONLY FCA B?G9 ... [ RINGED TO OUR ACT. B?GB ... [NO NEED FOR RERINGING SINCE OTHER B?GH ... [ AUTOCLOSE ALREADY RINGED TO FILE B?GQ ... LDX 2 AWORK1(2) [OTHER ACT B?H3 ... LDX 5 FILEBRING(2) [X5-> BOTTOM FCA OF OTHER ACT. B?H# ... LDX 3 FPTRF(3) [X3-> OUR 2ND FCA B?HK ...NXX1 B?HW ... RERING 3,5 B?J7 ... SMO 4 B?JD ... LDX 3 FPTRF [X3-> NEXT FCA IN OUR RING B?JP ... SMO FBACKPOINT(3) B?JX ... LDN 2 0(3) [X2-> BLOCK CONTAINING THIS RING B?K5 ... [ ELEMENT B?K? ... BXU 2 FX2,NXX1 [J IF NOT BACK TO OUR ACT. BLOCK B?KJ ...OURSUB B?KT ... LDX 2 4 B?L6 ... CALL 6 SUBRELT [DERING OUR (TOP) FCA B?LC ... BRN SUICIDE B?LN ...# B?L^ ...# B?M= ...# B?MH ...XWAITAUTO B?MS ...[ WAIT FOR THE FILE TO BE RUNG TO THE AUTOCLOSE B?N5 ... BS 2,BFAUTOW B?NB ... TRACEIF K6CLOSEND,99,299,FLOC1(2),WT CLWT1 B?NM ... LDX 5 BACK2(2) B?NY ... LONGSET CLOSEWAIT,(GEOERR),5 B?P9 ... LONGCOOR B?PG ... CALL 6 TAB [X2-> FCB, X3->FCA B?PR ... BXE 5 BACK2(2),WTFILE [J IF FILE STILL THERE B?Q4 ... TRACEIF K6CLOSEND,99,299,FX2,CLWTGONE B?Q* ... SUICIDE B?QL ...# B?QX ...# B?R8 ...# B?RF ...NFULL B?RM ... JBC NCOPY,,XBCOPY [J IF NOT COPY (CAN BE NO OTHER B?RT ... [ OPENER) B?S3 ... LDX 0 CTOPEN(2) B?S# ... BNZ 0 NOSET [J IF FILE STILL OPEN B?SK ...NCOPY B?SR ... JFZ TORIDFCB,2,FFAUTCLCT [J IF NO AUTOCLOSES OPERATING ON B?S^ ... [ FILE B?T7 ... JBC NOSET,,XBSET [J IF NOT CLOSESET B?TD ...# CLOSESET SO MAKE THE CLOSING ACTIVITY WAIT UNTIL THE OTHER CLOSE B?TP ...# FINISHES AND RELEASES US. B?W2 ...WAITSET B?W? ... STOZ FGENERAL1(3) B?WF ... BS 3,BASET [THIS ACT. IS ABOUT TO WAIT ON A B?WM ... [ CLOSESET B?WT ... BS 2,BFCLOSESET [SET WAIT MARKER IN FCB B?X6 ... TRACEIF K6CLOSEND,99,299,FLOC1(2),WT CLST B?XC ... COOR1 B?XN ... UP B?X^ ...# B?Y= ...# B?YH ...# B?YS ...# CLOSEABANDON CLOSESHORT OR CLOSEFRBS SO THERE ISN'T MUCH POINT B?^5 ...# LETTING OTHER CLOSES CONTINUE. LOOK AT THE FCA'S IN THE FSTACK, B?^B ...# RELEASING ANY CLOSESET WAITERS BEFORE GOING ON TO FREE THE FSTACK. B?^M ...SAVETEST B?^Y ... JBC NOCLOSESET,2,BFCLOSESET [J IF NO CLOSESET ON FILE B#26 ... LDN 6 0 [INITIALISE COUNT OF CLOSESETS B#2# ... [ RELEASED B#2G ... SMO FBACKPOINT(3) B#2R ... LDN 5 0(3) [X5-> FSTACK B#34 ... SMO 5 B#3* ... LDEX 4 ARINGNO [X4= NO. OF RING ELEMENTS B#3L ... ADN 5 A1 [SET UP TO SEARCH FSTACK B#3X ...SFCAPT B#48 ... BXE 5 3,OURFCA [J IF THIS IS OUR FCA B#4F ... LDX 2 5 [X2-> NEXT FCA B#4Q ... JBC OURFCA,2,BASET [J IF THIS FCA IS ON A CLOSESET B#53 ... CALL 1 SFACT [X2->ACTIVITY ATTACHED TO THE FCA B#5# ... TRACEIF K6CLOSEND,99,299,ACNUM(2),CLOSESET B#5K ... FPUT [PUT CLOSESET BACK ON LIST B#5W ... ADN 6 1 [UPDATE COUNT OF CLOSESETS RELEASED B#67 ...OURFCA B#6D ... ADN 5 FELLEN [LOCATE NEXT FCA B#6P ... BCT 4 SFCAPT [J IF MORE ELEMENTS TO LOOK AT B#6X ... BZE 6 ZCLOSESET [GEOERR IF NO CLOSESET WAITER & B#75 ... [ BFCLOSESET SET B#7? ... CALL 6 TB [X2-> FCB B#7J ...NOCLOSESET B#7T ... FC 2,FFAUTCLCT [CLEAR COUNT OF AUTOCLOSES ON FILE B#86 ... TRACEIF K6CLOSEND,99,299,FLOC1(2),SH/FR/AB B#8C ...# B#8N ...# B#8^ ...# B#9= ...# TRY TO FREE THE REMAINING BLOCKS ASSOCIATED WITH THE FILE BEFORE. B#9H ...# GOING UP B#9S ...# FSTACK FREE IT UNLESS BEING OPENED IN COPY MODE B#=5 ...# FMAPP FREE UNLESS CLOSESAVE - THEN CHAIN AFTER CURRENT ACT B#=B ...# FINDEXF GOES WITH THE FCB - FREED OR PUT IN HALF-OPEN CHAIN B#=M ...# FULLB ONLY HERE IF CLOSESAVE - CHAIN AFTER CURRENT ACT B#=Y ...# FEXTRA FREE IT IF WF IS TO-BE-ERASED, NOT FROZEN, NOT BEING B#?9 ...# UPDATED BY ERALLWF AND NOT CLOSESAVE B#?G ...# FCB FREE IT OR PUT DIRECTORY IN HALF-OPEN CHAIN UNLESS B#?R ...# MARKED KEEP HALF-OPEN (COMM B14) B##4 ...# WAITERS, OR SOMEONE WAITING TO EMPTY B##* ...# CONVERTED AUTOCLOSE ON THE FILE I.E. CLOSECT SET B##L ...# BEING OPENED IN COPY MODE B##X ...# WF NOT TO-BE-ERASED B#*8 ...# WF TO-BE-ERASED BUT FROZEN OR BEING UPDATED BY B#*F ...# ERALLWF B#*Q ...TORIDFCB B#B3 ... MBC 2,BFSOLE,BFCLOSESET,BFAUTO B#B4 ... LDX 0 CTOPEN(2) B#B5 ... BNZ 0 NOSET B#B8 ... JMBS NOSET,2,BFMCOP,BFFCB [J IF FILE BEING COPIED (NEED THIS B#B* ... [ SINCE STILL OPEN IN COPY MODE SENT B#BG ... [ THROUGH SOLE OPENER PATH) B#BM ... JBS TOFREEFCB,,XBABAND [J IF CLOSEABANDON (IGNORE EMPTIERS & B#BS ... [ WAITERS) B#B^ ... JMBS TOFREEFSTAC,2,BFHALF,BFEMPTY [J IF EMPTY OR TO KEEP FCB B#C6 ... [ IN FILE CHAIN (:MASTER ONLY) B#CD ... LDX 0 FWAITCOUNT(2) B#CP ... BNZ 0 TOFREEFSTAC [J IF WAITED FOR B#D2 ...TOFREEFCB B#D? ... JBS TOWF,2,BFWORK [J IF WORKFILE B#DJ ... LDX 3 2 [X3->FCB B#DT ... FREECORE FPTR(2) [FREE FILE/FSTACK B#F6 ... LDN 6 0 [SET 'NO FINDEXF' MARKER B#FC ...TRYNEXT B#FN ... LDX 2 FPTR(3) [X2-> BLOCK CHAINED TO FCB B#F^ ...TRYX B#G= ... BXE 2 CXFI,OVERCHECK [J IF BASE OF FILE CHAIN B#GH ... LDX 0 ATYPE(2) B#GS ... BXE 0 FILEPLUSFCB,OVERCHECK [J IF NEXT FCB B#H5 ... BXU 0 SFINDEXF(1),TRYFMAPP [J IF NOT FINDEXF B#HB ... LDN 6 #77 B#HM ... ANDX 6 FINFC(3) B#HY ... BZE 6 ODDEND [GEOERR IF FINDEXF BUT NOT INDEXED B#J9 ... LDX 2 FPTR(2) [X2-> NEXT BLOCK IN FILE CHAIN B#JG ... BRN TRYX B#JR ...TRYFMAPP B#K4 ... BXU 0 FFSFMAPP,ODDEND [GEOERR IF NOT FMAPP B#K* ... JBCC ODDEND,3,BFCARE [GEOERR IF FMAPP BUT NOT CAREFUL B#KL ... FREECORE 2 [FREE FILE/FMAPP B#KX ... BRN TRYNEXT B#L8 ...ODDEND B#LF ... GEOERR BRIEFPM,ODD END B#LQ ...OVERCHECK B#M3 ... JMBS SFDIR,,XBSHORT,XBFRBS,XBTHROW B#M# ... JBS YDIRECTORY,3,BFDIR [J IF DIRECTORY B#MK ...SFDIR B#MW ... BZE 6 NOFINDEXF [J IF NO FINDEXF BLOCK B#N7 ... FREECORE FPTR(3) [THE FINDEXF B#ND ...NOFINDEXF B#NP ... DELFCB 3,FILE [FREE FCB B#P2 ... JBC UPA,,XBABAND [J IF NOT CLOSEABANDON B#P? ... CLOSETOP [CLOSE DIRECTORY (OPENED IN CLOSEAB) B#PJ ... BRN UPA B#PT ...YDIRECTORY B#Q6 ... BZE 6 NOINDEX B#QC ... CHAIND FPTR(3),BHALF B#QN ...NOINDEX B#QW ... TRANSFCB 3,FILE,HALF [TRANSFER FCB FROM FILE TO HALFOPEN B#R4 ... [ CHAIN B#R= ... BRN UPA B#RH ...TOFREEFSTAC B#RS ... FREECORE FPTR(2) [THE FSTACK B#S5 ... BRN UPA B#SB ...TOWF B#SM ... TRACEIF K6CLOSEND,99,299,FLOC3(2),CL FFWF [SOLE CLOSE OF A WF B#SY ... SMO FX1 B#T9 ... LDX 0 MASKV B#TG ... ANDS 0 COMM(2) B#TR ... JBC TOFREEFSTAC,2,BFERASE [J IF NOT TO-BE-ERASED B#W4 ... JBS TOFREEFSTAC,2,BFERALLWF [J IF ERALLWF OPERATING B#W* ... JFNZ TOFREEFSTAC,2,FFFREZCT [J IF FROZEN B#WL ... TRACEIF K6CLOSEND,99,299,FLOC3(2),ER FFWF B#WX ... DELWORK B#X8 ... BRN UPA B#XF ...# B*2L ...STILLOPEN B*G= ... TRACEIF K6CLOSEND,99,299,FLOC1(2),STILOPEN [FILE STILL OPEN B*^W ... CALL 5 PRIORITY BJSL SBS 4 CTOPEN(2) [ADJUST CTOPEN BL*8 ... STOZ FGENERAL1(3) [CLEAR OUT FCA MARKERS SINCE ENTERING BLDM ... STOZ FGENERAL2(3) [ NEW PHASE BLJ6 ... JBS YCOPYERR,,XBAUTO [GEOERR IF AUTOCLOSE OR AUTOCOPY BLMK ... [ (THEY GO DOWN XCTOPEN PATH) BLR6 ... LDX 0 4 BM=Q ... ANDN 0 1 BMM= ... BZE 0 XCLOSAPP [J IF CLOSING FROM APPENDING (READING BN3Q ... [ OTHERWISE) BND= ... LDX 0 FCOMMCT(2) BP9= ... BZE 0 XBFTIDY [J IF NOT STILL OPEN COMMUNALLY BQ5B ... CALL 5 RELWAIT [RELEASE WAITING COMMUNAL APPENDER IF BQBQ ... [ ANY (MUST BE A COMMUNAL READER) BQN6 ... LDN 6 FCBAPPWAIT BR7Q ... CALL 5 TICKLEDRM [TICKLE ANY DRMERS BRMB ... JBCC XBFTIDY,2,BFFREEW [WAKE UP ANY DESTRUCTIVE APPENDERS BR^R ... LONGON IWTDEST,BACK2(2) [ WAITING FOR BLOCK TO BE FREED (MAY BS#8 ... [ BE COOR4 AS WELL AS LONG WAITERS) BSLL ... CALL 6 TB [X2-> FCB BT6= ...XBFTIDY BTKW ... CALL 5 SBFTIDY [CLEAR BFTIDY SEMAPHORE BW5G ...# BWK6 ...# BX4Q ...# CH5B XJBRN CJ4L ... JBC NOSET,,XBSET [J IF NOT CLOSESET CJJ= ... JBS WAITSET,,XBFULL [J TO WAIT IF CLOSESET CONVERTED FROM CK3W ... [ 'TOP' TO 'FULL' CLOSE CKHG ... JFNZ WAITSET,2,FFAUTCLCT [J IF AUTOCLOSE STILL GOING ON ON CL36 ... [ FILE CM2B NOSET CMG2 LDX 2 3 CM^L CALL 6 SUBRELT CNF= ...UPA CNYW ... JBC UP,,XBCOPY [J IF NOT CLOSING FROM COPY CPY6 SUICIDE CQCQ SUICIDE [ONLY IF AUTOCOPY ACTIVITY CQXB UP CRC2 UP CRC3 ...# CRC4 ...# CRD9 ...# CRFD ...# CRGM ...# CRHW ...# CRK5 ...XCLOSAPP [SINCE STILL OPEN MUST BE COMMUNAL CRL# ... LDX 0 CTOPEN(2) CRMH ... ANDX 0 COMUNI CRNQ ... BNZ 0 XBFTIDY [J IF OTHER APPENDERS CRPJ ... CALL 5 RELWAIT [LAST APPENDER - SO ALLOW ANY WAITING CRQB ... [ NON-COMMUNAL READERS IN CRR8 ... CALL 5 RELCLFR [RELEASE ANY AUTOCLOSE WAITING CRS2 ... CALL 5 XLFCLOSE [TELL LISTFILE FILE CAN NOW BE LISTED CRSS ... [ (IF FROZEN) CRTL ... LDN 6 FCBSTEPWAIT CRWT ... CALL 5 TICKLEDRM [TICKLE ANY DRMERS WAITING FOR RECORD CRXD ... JBCC YBFTIDY,2,BFAPPC [J IF STYLE 5 WAITER EXISTS (CLEAR CRY3 ... [ BIT TOO) CRYL ... BC 2,BFAPPLW [THIS BIT MAY BE SET TOO ! CR^? ... LONGON1 5,BACK2(2) CS2G ... CALL 6 TB [X2-> FCB CS3P ...YBFTIDY CS4Y ... CALL 5 SBFTIDY [CLEAR BFTIDY SEMAPHORE CS5M ... JMBS XJBRN,,XBABAND,XBFRBS [NO DIR. UPDATE IF FILE WILL BE CS6B ... [ CLOSEABANDONED OR IS A ! FILE CS75 ... CALL 5 XCONVERT [CONVERT TO FULL CLOSE TO ENSURE CS7S ... [ ATTEMPT TO UPDATE DIR. ENTRY CS8K ... BRN WTFILE [GO & UPDATE DIR. CS9S ...# CS?3 ...# CS#= ...# CS*F ...# CSBN ...# CSCP ...# CSCS ...# CSCX ...ZBSERR CSDP ... GEOERR BRIEFPM,BS INC [CLOSESHORT OR CLOSEFRBS - NO. OF CSFH ... [ SPARE BLOCKS HAS INCREASED CSG* ...YCOPYERR CSH7 ... GEOERR BRIEFPM,STILAUTO [AUTOCLOSE OR AUTOCOPY HAS GONE DOWN CSH^ ... [ STILLOPEN PATH CSJR ...XCOPYERR2 CSL2 ... GEOERR BRIEFPM,COPYRING [FILE RINGED INTO AUTOCOPY (TOO EARLY CSM9 ...ZCLOSESET CSN3 ... GEOERR BRIEFPM,NO SET [BFCLOSESET SET BUT NO CLOSESET CSNT ... [ WAITING CSPM ...ZAUTTOOBIG CSQ6 ... GEOERR BRIEFPM,AUT OVR [COUNT OF AUTOCLOSES ON FILE HAS CSQK ... [ OVERFLOWED (BEYOND 12 BITS!!) CSRH ...# CSS5 ...# CSTW #END ^^^^ ...11153501000500000000