CLOSEDIR867

(George Source)

Macros used: ACROSS, BACKWAIT, BC, BFCBX, BITDEFS, BLAM, BS, BSXD, BXE, BXU, CHAIN, CONFURWB, COOR3, DOWN, FILEAUTW, FILENUMB, FILETRAN, FREECORE, GEOERR, JBC, JBS, JMBAC, JMBC, JMBS, LBW, MBSXD, POP, PSTAC, RERING, SEG, SEGENTRY, SFSTACK, SUBCUBS, TAB, TOPFCAB, TOPFCB, TRACEIF, UP

CLOSEDIR867.txt
22FL ...      SEG   CLOSEDIR,863,SECTION FILE,CLOSE 
2Y=Q    #   
2YGJ ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983
2YQB    #   
2^=2    #     USES OF X7
2^*Y ...#     ----------
2^FW ...      BITDEFS  7,0,XBSHORT         [CLOSESHORT  
2^KS ...      BITDEFS  7,1,XBTOP           [CLOSETOP/CLOSEDIR   
2^PQ ...      BITDEFS  7,2,XBFULL          [CLOSE (FULL)
2^TN ...      BITDEFS  7,3,XBFRBS          [CLOSEFRBS   
329G ...      BITDEFS  7,10,XBFRITEALL     [FRITE WITH 'ALL' PARAMETER  
32#6 ...      BITDEFS  7,11,XBCORUNJWR     [ADATA/CORUNJAM BUFFER BEING (FIXED) 
32BQ ...                                   [ WRITTEN BY CORE UNJAMMER   
32FB ...      BITDEFS  7,12,XBTHROW        [CLOSETHROW  
32M? ...      BITDEFS  7,14,XBABAND        [CLOSEABANDON
32XS ...      BITDEFS  7,15,XBNONAUTOWR    [NON-AUTONOMOUS WRITING OF WRITE 
338* ...                                   [ BUFFER BLOCKS REQUIRED 
33DW ...      BITDEFS  7,20,XBCOPY         [CLOSING FROM COPY MODE  
33NQ ...      BITDEFS  7,22,XBAUTO         [AUTONOMOUS  
33SN ...      BITDEFS  7,23,XBSET          [CLOSESET
33YL ...#   
344J ...#   
348G ...#     ENTRY POINTS. 
34#D ...#   
34DB ...      SEGENTRY K1CLOSEDIR,XENT1    [CLOSE %A
34J# ...      SEGENTRY K2CLOSEDIR,XENT2    [CLOSETOP
34M= ...      SEGENTRY K4CLOSEDIR          [ENTRY IN AUTOCLOSE FROM CLOSEALT
34Q8 ...                                   [ AFTER DIRECTORY HAS BEEN UNCLEANLY 
34T6 ...                                   [ UPDATED (IT IS SPECIAL FULL CLOSE) 
34Y6 ...        MBSXD  7,XBFULL,XBAUTO  
3544 ...        BRN    SMERGE   
356# ...      SEGENTRY K9CLOSEDIR          [ENTRY FROM COPYFILE WHICH HAS JUST  
358J ...                                   [ WRITTEN THE FILE'S DIRECTORY ENTRY 
35=S ...                                   [ AND CLOSED THE DIRECTORY. IF FILE  
35*4 ...                                   [ IS DIRECTORY, WILL CONVERT TO FULL 
35C# ...                                   [ CLOSE SINCE BFDIRUPDATE SET (UNLESS
35FJ ...                                   [ DIR. NOT ACTUALLY COPIED). 
35HS ...                                   [ OTHERWISE CONVERTS TO FULL CLOSE   
35L4 ...                                   [ TYPE IF FILE ALTERED.  
35NC ...        MBSXD  7,XBTOP,XBCOPY,XBAUTO
35RN ...        BRN    SMERGE   
35XL ...      SEGENTRY K12CLOSEDIR         [CLOSEABANDON.   
363W ...        MBSXD  7,XBABAND,XBFULL    [NEED MAIN MODE (FAIRLY ARBITRARY
3686 ...        BRN    SMERGE              [ WHAT IT IS !!) 
36#C ...      SEGENTRY K21CLOSEDIR,XENT21  [CLOSE   
36F# ...      SEGENTRY K23CLOSEDIR,XENT23  [CLOSESHORT  
36L9 ...      SEGENTRY K16CLOSEDIR,XENT16  [CLOSESET
36R8 ...        NULL
36TS ...      SEGENTRY K27CLOSEDIR         [CLOSEFRBS (A CLOSESHORT WHICH FREES 
36YD ...                                   [ SPARE BS NON-CAREFULLY)
3734 ...        BSXD   7,XBFRBS 
3772 ...        BRN    XENT27   
37=Y ...        NULL
37BW ...        NULL
37GS ...        NULL
37LQ ...        NULL
37QN ...      SEGENTRY K88CLOSEDIR,XENT88  [AUTONOMOUS FRITE
37WL ...      SEGENTRY K89CLOSEDIR,XENT89  [NON-AUTONOMOUS FRITE.   
382J ...      SEGENTRY K5CLOSEDIR,XENT5    [CLOSEDIR
386G ...      SEGENTRY K95CLOSEDIR         [CLOSETHROW (A CLOSETOP WHICH DOES   
38=D ...                                   [ NOT RETAIN DIR. IN HALF-OPEN CHAIN)
38BB ...        MBSXD  7,XBTOP,XBTHROW  
38G# ...        BRN    XENT95   
38L= ...#   
38Q8 ...#   
38W6 ...MCOMMUNE       #57777777           [TO REMOVE COMMUNE BIT FROM CTOPEN   
39FS ...SADATA  
39KQ ...#HAL           ADATA+CORUNJAM,0    [CORE UNJAMMER BLOCK--DON'T TOUCH
39PN ...SEXTRA  
39TL ...#HAL           FILE+FEXTRA,0
3=9D ...SFINDEXF
3=*B ...#HAL           FI+FINDEXF,0 
3=GW    #   
3=L2 ...#   
3=P6 ...#     SUBROUTINES   
3=S= ...#      ----------   
3=XB ...#   
3?2G    #   
3?G6          FILETRAN                     [SUBROUTINE MACRO FOR FILEAUTW   
3?^Q    #   
3CWQ    RINGFIRST   
3DBB          ADN   2  FILERING 
3DW2          RERING   3,2  
3F*L          EXIT  5  0
3FKD ...#   
3FT=    SFSTACK 
3G#W ...      SFSTACK  AWORK1(2),3         [X3-> FCA OF FILE AT DEPTH IN AWORK1 
3GSG          EXIT  4  0
3H4# ...#   
3H#6    TAB 
3HRQ          TOPFCAB  3,2                 [X2->FCB X3->FCA AT LEVEL 0  
3J?B          EXIT  6  0
3JH8 ...#   
3JR2    TB  
3K=L ...      TOPFCB   2                   [X2-> FCB AT LEVEL 0 
3KQ=          EXIT  6  0
3PM=    #   
3PMY ...#   
3PNG ...#     THIS SUBROUTINE WRITES A 'WRITE BUFFER' TO BS USING FILEAUTW (FOR 
3PP4 ...#      SERIAL FILE BUFFER) OR CONFURWB (FOR DA OR MT FILE BUFFER).  
3PPL ...#     ON ENTRY, X2->BLOCK TO BE WRITTEN BACK, X4= BLOCK TYPE FOR FUWB OR
3PQ8 ...#               FURWB, AWORK1= DEPTH OF FILE, XBNONAUTOWR SET IF
3PQQ ...#               NON-AUTONOMOUS WRITE REQUIRED.    X6 IS S/R LINK.   
3PRB ...#     ON EXIT, X1=FX1, X2= FX2.   OVERWRITES X0, X3, X4 & X5.   
3PS4 ...#   
3PSQ ...WBWRITE 
3PTD ...      SBX   6  FX1  
3PW6 ...      SMO      FX2  
3PWS ...      LDX   5  AWORK1              [X5= DEPTH   
3PXG ...      BXU   4  FFSFUWB,RANDWR      [J IF RANDOM WRITE   
3PY8 ...#SKI  K6FREEBUFF>199-199           [FREEBUFF DIAGNOSTIC 
3PYW ...(   
3P^J ...      JBC      NALL1,,XBFRITEALL   [J IF NOT 'FRITE ALL'
3Q2= ...      LDN   0  1
3Q2N ...      ADS   0  INSTPARAM+1         [UPDATE COUNT OF FUWBS WRITTEN (IN   
3Q36 ...                                   [ IP MANAGER1)   
3Q3L ...NALL1   
3Q4# ...)   
3Q52 ...      CHAIN    2,FX2
3Q5N ...      BLAM     5                   [X1= FREADBLOCK TYPE MODIFIER FOR BLK
3Q6B ...      LDX   4  1
3Q74 ...      FILEAUTW 5,FREE+FAIL,,4   
3Q85 ...      JBC      WREXIT,,XBNONAUTOWR  
3Q96 ...      BACKWAIT  
3Q9S ...WREXIT  
3Q=G ...      ADX   6  FX1  
3Q?8 ...      EXIT  6  0
3Q?W ...RANDWR  
3Q#J ...#SKI  K6FREEBUFF>199-199           [FREEBUFF DIAGNOSTIC 
3Q*= ...(   
3Q*Y ...      JBC      NALL2,,XBFRITEALL   [J IF NOT 'FRITE ALL'
3QBL ...      LDN   0  1
3QC4 ...      ADS   0  INSTPARAM+2         [UPDATE COUNT OF FURWBS WRITTEN (IN  
3QCG ...                                   [ IP MANAGER2)   
3QD2 ...NALL2   
3QDN ...)   
3QFB ...      LBW      ,XBNONAUTOWR,4      [X4 NON-ZERO IF NON-AUTO 
3QFS ...      CONFURWB 2,5,4               [FOR DA & MT BUFFERS, DECIDE HOW MUCH
3QG= ...                                   [ TO WRITE & WRITE IT
3QGQ ...      BRN      WREXIT   
3QHD ...#   
3QJ6 ...#   
3QJ* ...#     MAIN CODE 
3QJJ ...#     ---- ---- 
3QJS ...#   
3QKG ...#   
3QLG    #     CLOSE ENTRY POINTS.  X7 IS SET TO INDICATE THE TYPE OF CLOSE  
3R66    #     IF THE FILE IS AT NON-ZERO DEPTH IT IS RERINGED AT DEPTH 0.   
3RKQ    #   
3Y^L    #   
3^F=    # CLOSESET  
3^YW    #     A CLOSETOP IN WHICH THE CLOSING ACTIVITY IS MADE TO WAIT UNTIL THE
42DG    #     FILE HAS BEEN CAREFULLY UPDATED   
42Y6    #   
43CQ ...XENT16                             [CLOSESET
44WL          CALL  6  TB   
45B= ...      JBC      XENT2,2,BFCARE      [J IF NON-CAREFUL FILE (DO CLOSETOP) 
45TW ...      MBSXD    7,XBTOP,XBSET
48#2          BRN      SMERGE   
48RL    #   
49?=    # CLOSE 
49QW ...#     UPDATES THE DIRECTORY, EXCEPT CLOSES ON DIRECTORIES   
4==G ...#     WHICH CONVERT TO CLOSETOPS.   
4=Q6    #   
4=WJ ...XENT1                              [CLOSE %A
4?32 ...      LDX   0  ACOMMUNE8(2)        [PICK UP FILE DEPTH  
4?7D ...      SLL   0  12   
4??W ...      SRA   0  12                  [RESTORE B0-11 IF -IVE DEPTH 
4?D# ...      STO   0  AWORK1(2)           [STORE DEPTH 
4?JQ ...      CALL  4  SFSTACK             [X3-> FCA FOR FILE AT DEPTH IN AWORK1
4?P8 ...      CALL  5  RINGFIRST           [RERING FILE TO BE AT DEPTH 0
4?TL ...XENT21                             [CLOSE   
4#24 ...#UNS   CLOSESTATS   
4#6G ...(   
4#=Y ...      LDN   0  1
4#CB ...      ADS   0  CLSTAT4             [NO. OF CLOSE USES   
4#HS ...)   
4#NL          CALL  6  TB   
4*8= ...      JBS      XENT2,2,BFDIR       [CONVERT TO CLOSETOP IF DIRECTORY
4*MW ...#   
4B7G ...XFULL   
4CLB ...      BSXD     7,XBFULL 
4DKL          BRN      SMERGE   
4F5=    #   
4FJW    # CLOSETOP  
4G4G    #     CLOSES THE FILE AT LEVEL 0. IT WONT UPDATE THE DIRECTORY UNLESS   
4GJ6    #     NECESSARY (E.G. BLOCKS ALTERED), WHEN IT CONVERTS TO A FULL CLOSE 
4H3Q    #   
4HHB ...XENT2                              [CLOSETOP
4J32 ...      BSXD     7,XBTOP  
4J#5 ...XENT95  
4JK9 ...#UNS  CLOSESTATS
4JMS ...(   
4JQC ...      LDN   0  1
4JT2 ...      ADS   0  CLSTAT6             [NO. OF USES OF CLOSETOP 
4JXK ...)   
4K2=          CALL  6  TB   
4KFW ...      JBS      XFULL,2,BFERASE     [IF ERASE, FULL CLOSE
4K^G          BRN      SMERGE   
4LF6    #   
4LYQ    # CLOSEDIR  
4MDB    #     CLOSES THE FILE AT LEVEL 1. OTHERWISE AS CLOSETOP 
4MY2    #   
4N95 ...XENT5                              [CLOSEDIR
4NG9 ...#UNS  CLOSESTATS
4NJS ...(   
4NMC ...      LDN   0  1
4NQ2 ...      ADS   0  CLSTAT7             [NO. OF CLOSEDIR MACROS OBEYED   
4NSK ...)   
4NX=          LDX   3  FILERING(2)  
4PBW          LDX   3  FPTRF(3) 
4PP? ...      CALL  5  RINGFIRST           [RERING FILE AT DEPTH 1 TO BE AT 
4Q3N ...                                   [ DEPTH 0
4QB6 ...      BRN      XENT2
4QTQ    #   
4QWR ...# CLOSEFRBS 
4QXS ...#     CHECK THAT NO ONE ELSE IS USING OR WAITING FOR FILE, SINCE THIS IS
4QYT ...#     A HIGHLY SPECIALISED MACRO.   
4Q^W ...#   
4R2X ...XENT27  
4R3Y ...      CALL  6  TB                  [X2-> FCB
4R4^ ...      LDX   0  FWAITCOUNT(2)
4R62 ...      BNZ   0  XERRFRBS            [GEOERR IF WAITERS   
4R73 ...      LDX   2  FPTR(2)             [X2-> FSTACK 
4R84 ...      LDEX  0  ARINGNO(2)   
4R95 ...      SBN   0  1
4R=6 ...      BZE   0  SMERGE   
4R=S ...      BRN      XERRFRBS            [GEOERR IF OTHER ACTS. HAVE FILE OPEN
4R?G ...                                   [ (OR AUTOCLOSE GOING)   
4R#8 ...#   
4R*B    # CLOSESHORT
4RT2    #     CLOSES THE FILE AT LEVEL 0, BUT NEVER UPDATES THE DIRECTORY, WHICH
4S#L    #     MUST BE OPEN AT LEVEL 1.  
4SS=    #   
4T?W ...XENT23                             [CLOSESHORT  
4WQQ ...      BSXD     7,XBSHORT
4XQ2    #   
5X^=    #   
5YDW ...#   
5YYG ...#     START OF MAIN PATH
5^D6 ...#     ----- -- ---- ----
5^XQ ...#   
62CB ...#   
65*6    SMERGE  
65SQ ...#UNS  CLOSESTATS
66#B ...(   
66S2 ...      LDN   0  1
67?L ...      ADS   0  CLSTAT3             [NO. OF ENTRIES TO CLOSEDIR SEGMENT  
67R= ...)   
6?N=          LDX   2  FX2  
6#MG    #   
6*76    #     BREAK IF THERE'S NO FILE OPEN TO THE CURRENT ACTIVITY 
6B6B          LDN   0  FILERING(2)  
6BL2 ...      BXE   0  FILERING(2),NOFILE  [GEOERR IF NO FILE OPEN  
6DJG    #   
6NW6          CALL  6  TAB  
6Q*2 ...      JMBAC    NEMPTIER,2,BFREV,BFEMPTY,BFINDEXALT [THESE CONDITIONS
6QSL ...                                   [ IMPLY FULL UPDATE  
6^MB ...      JBC      NEMPTIER,,XBTOP     [J IF NOT CLOSETOP/CLOSEDIR  
7272 ...      ANDX  7  BSP16               [PRESERVE L.S. 15 BITS OF X7 
72LL ...      BS       ,XBFULL             [CONVERT TO FULL CLOSE   
754Q    NEMPTIER
7=Y=    #   
7?CW    # IF FILE IS DESTCOMM OR ACCESS IS GDR & FILE WAS OPEN IN READ MODE 
7?XG    # IT IS NECESSARY TO TIDY UP THE READ POINTERS AT THIS STAGE AND ALSO   
7#C6    # TO SORT OUT WHICH BLOCKS ARE ALLOCATED TO THE FILE
7#WQ    #   
7*BB          JMBAC    NODESTCOMM,2,BFGDR,BFDCF 
7*W2          JBC      NODESTCOMM,3,BAMREAD 
7DRQ          DOWN     CLOSTIDY,1   
7F?B          CALL  6  TAB  
7G=L    NODESTCOMM  
7GQ=          NGS   3  FREADWORD(3) 
7H9W          NGS   3  FREADBLOCK(3)
7HFN ...#   
7HPG ...#     IF NOT A WF, ADJUST THE CURRENT-USED-ONLINE-BS
7HTC ...#   
7J3= ...      JMBS     NOSUBCUBS,2,BFWORK,BFERALLWF  [J IF WORKFILE 
7J96 ...      LDX   0  FBLMOD(2)
7JDY ...      SBN   0  FBLKS-A1 
7JNQ ...      SUBCUBS  3,0,JOB  
7JYJ ...      CALL  6  TAB                 [X2-> FCB,  X3-> FCA 
7K8B ...NOSUBCUBS   
7KD8 ...      TRACEIF  K6CLOSEDIR,99,299,7,CLOSE  [TYPE OF CLOSE
7KJ5 ...#   
7KN2    #     CHECK THE MODE AND SET X4 TO THE APPROPRIATE DECREMENT FOR CTOPEN 
7L7L    #   
7LM= ...      LDN   4  1                   [SET UP READ COUNT   
7M6W ...      JMBS     SUBT,3,BAMREAD,BAMREADR  
7MLG ...      LDCT  4  #400                [SET UP WRITE COUNT  
7N66 ...      JMBS     SUBT,3,BAMWRITE,BAMGEN,BAMCLEAN  
7NKQ ...      LDX   4  BIT11               [SET UP APPEND COUNT 
7P5B ...      JBS      SUBT,3,BAMAPP
7PK2 ...      LDN   4  0                   [NOTHING IN CTOPEN TO INDICATE COPY  
7Q4L ...      JBC      NOPEN,3,BAMCOPY     [GEOERR IF NOT COPY  
7WYW    SUBT
7X== ...#   
7XHL ...#     UPDATE FCOMMCT IF COMMUNAL ACCESS.
7XT2 ...#   
7Y6B ...      JMBAC    RIDBUFF,3,BACOMM,BACLEAN [J IF NOT COMMUNE OR CLEAN DA   
7YCQ          LDX   6  BIT11               [COMMUNE FIELD LS BIT
7YXB          JBS      SUBCT,3,BACOMM   
7^C2          LDN   6  1                   [CLEAN FIELD LS BIT  
7^WL    SUBCT   
82B=          SBS   6  FCOMMCT(2)          [REDUCE COUNT OF COMM/CLEAN OPENERS. 
82TW          LDX   6  FCOMMCT(2)   
83*G          BNZ   6  NOTLASTCOM          [STILL COMMUNERS 
83T6          BC       2,BFSYSCOMM  
84#Q    NOTLASTCOM  
84SB ...      TRACEIF  K6CLOSEDIR,99,299,FLOC1(2),CLOSCMCT  
8MB6    #   
8N*B    #     CLEANS UP THE FILE CHAIN IF NOBODY ELSE HAS THE FILE OPEN 
8NK8 ...#     UPDATES DATE/TIME LAST WRITTEN FOR ALTERED ! FILES.   
8NT2    #     FREES READ BLOCKS AND WRITES AWAY THE WRITE BLOCKS
8P#L    #     CHECKS FOR STRANGE BLOCKS AND THAT FULLB'S ARE IN THE RIGHT PLACE 
8PS=    #     WAIT IF THERE'S A CORE JAM
8Q?W    #     BACKWAIT FOR TRANSFERS TO FINISH AND THEN GO ACROSS TO CLOSEND TO 
8QRG    #           CLOSE THE FILE  
8R?6    #   
8RMB ...RIDBUFF 
8S3M ...      SMO      FX2  
8S#J ...      STO   4  AWORK2              [REMEMBER CTOPEN DECREMENT   
8SFX ...RIDBL                              [LOOP BACK HERE IF COORDINATION  
8SM= ...                                   [ DURING FILE CHAIN SEARCH   
8SSK ...      BC       ,XBCORUNJWR         [CLEAR 'BUFFER BEING WRITTEN BY CORE 
8S^Y ...                                   [ UNJAMMER' BIT  
8T7? ...      CALL  6  TB                  [X2-> FCB
8TD8 ...      LDX   3  FPTR(2)             [X3-> FSTACK 
8TRN ...      LDX   0  CTOPEN(2)
8T^D ...      ANDX  0  MCOMMUNE(1)  
8W78 ...      SMO      FX2  
8W#Y ...      SBX   0  AWORK2   
8WCS ...      BZE   0  TWORK               [J IF NO OTHER OPENERS (IGNORE ANY   
8WGN ...                                   [ COPIERS)   
8WKJ ...      JBS      STILLOPEN1,,XBCOPY   
8WND ...      SMO      FX2  
8WW8 ...      LDX   0  AWORK2   
8X3Y ...      ANDN  0  #7777
8X7Q ...      BNZ   0  STILLOPEN1          [J IF OTHER OPENERS & CLOSING FROM   
8X?J ...                                   [ READING
8XCD ...      LDX   0  CTOPEN(2)           [MUST BE CLOSING FROM APPENDING  
8XK8 ...      ANDX  0  COMUNI   
8XQY ...      SMO      FX2  
8XYN ...      SBX   0  AWORK2   
8Y2# ...      BZE   0  TWORK               [J IF NO OTHER APPENDERS 
8Y3Y ...STILLOPEN1  
8Y=D ...      BRN      STILLOPEN
8Y#8 ...TWORK   
8YFY ...      JMBC     TRYMORE,2,BFWORK,BFALTR [J IF NOT AN ALTERED ! FILE  
8YMN ...      LDX   0  SEXTRA(1)
8YTD ...NOEX
8^38 ...      LDX   2  FPTR(2)             [FIND THE FILE/FEXTRA
8^8Y ...      BXU   0  ATYPE(2),NOEX
8^BN ...      LDX   0  CLEANCT  
8^JD ...      STO   0  FWRITTIME(2)        [UPDATE DATE/TIME LAST WRITTEN   
8^Q8 ...      LDX   0  EDATE
8^XY ...      STO   0  FWRITDAY(2)  
9276 ...TRYMORE                            [LOOP BACK HERE IF NO COORDINATION   
92B# ...                                   [ DURING FILE CHAIN SEARCH   
92KG ...      LDX   2  3                   [X2-> FILE/FSTACK
9356    TRYX
93CH ...      LDX   2  FPTR(2)             [X2-> NEXT BLOCK IN FILE CHAIN OR
93PY ...                                   [ WORKFILE RING  
944B ...      BXE   2  CXFI,QUARRYON       [J IF END OF FILE CHAIN  
94J2 ...      SMO      FX2  
953L ...      LDN   0  BWORKRING
95H= ...      BXE   2  0,QUARRYON          [J IF END OF WORK FILE RING  
962W ...      LDX   4  ATYPE(2) 
96GG ...      ANDX  4  HALFTOP             [X4= TYPE OF NEXT BLOCK  
9726 ...      BXE   4  FILEPLUSFCB,QUARRYON [J IF FCB   
97FQ ...      BXE   4  FFSFURB,XFREE       [J IF FURB   
97^B ...      BXE   4  FFSFURRB,XFREE      [J IF FURRB  
98F2 ...      BXE   4  FFSFUWB,XWRITE      [J IF FUWB   
98YL ...      BXE   4  FFSFURWB,XWRITE     [J IF FURWB  
99D= ...      BXE   4  SADATA(1),XWRITECOR [J IF ADATA/CORUNJAM (BEING WRITTEN  
99XW ...                                   [ BY CORE UNJAMMER)  
9=CG ...      BXE   4  SFINDEXF(1),TRYX    [J IF FI/FINDEXF 
9=X6 ...      BXE   4  FFSFMAPP,XFMAPP     [J IF FILE/FMAPP 
9?BQ ...      BXU   4  SEXTRA(1),ODDBLOK   [GEOERR IF NOT FILE/FEXTRA   
9?WB ...QUARRYON
9#8R ...      JBS      WAITWRCOR,,XBCORUNJWR [J IF ADATA/CORUNJAM FOUND (BEING  
9#H8 ...                                     [ WRITTEN BY CORE UNJAMMER)
9#TL ...STILLOPEN   
9**= ...      CALL  6  TB                  [X2->FCB 
9*SW ...#   
9B#G ...#     ON 'B', WE HAVE AN ADDITIONAL INTERLOCK TO SIMPLIFY THINGS A BIT -
9BS6 ...#     IT'S A PITY IT ISN'T IN STANDARD GEORGE TOO!!  NOONE IS ALLOWED TO
9C?Q ...#     START CLOSING THE FILE IF SOMEONE IS IN THE PROCESS OF OPENING IT,
9CRB ...#     WHICH IS INDICATED BY B0-6 OF FGENERAL1 OF AN FCA BEING ZERO. 
9D?2 ...#     (THE OPPOSITE IS ALSO TRUE.)   IF FSTACK BEING ALTLENED, WE   
9DQL ...#     MUST ALSO WAIT SINCE THIS INDICATES SOMEONE IS JUST STARTING  
9F== ...#     OPENING.  
9P4= ...#   
9PHW ...      POP      RIDBL,2,BFTIDY      [STOP HERE IF SOMEONE ELSE IS
=*4W ...                                   [CROSSING TO CLOSEND 
=*#N ...      BACKWAIT                     [ENSURE ALL BLOCKS OF FILE WRITTEN TO
=*JG ...                                   [ BS 
=*S# ...      LDX   4  AWORK2(2)           [RESTORE CTOPEN DECREMENT TO X4  
=B46          ACROSS   CLOSEND,1
=B49 ...#   
=B6? ...#   
=B6J ...XFREE   
=B6^ ...      FREECORE 2                   [FREE BUFFER BLOCK   
=B7B ...      BRN      TRYMORE  
=B7R ...#   
=B88 ...XWRITE  
=B92 ...      SMO      FX2  
=B9C ...      STOZ     AWORK1              [ZERO DEPTH  
=B9S ...      CALL  6  WBWRITE             [WRITE AWAY FUWB OR FURWB
=B=9 ...      BRN      RIDBL
=B=L ...#   
=B?3 ...XWRITECOR   
=B?? ...      BS       ,XBCORUNJWR         [SET 'CORE UNJAMMER WRITE BUFFER 
=B?H ...                                   [ PRESENT' MARKER
=B?T ...      BRN      TRYX 
=B#= ...#   
=B#M ...XFMAPP  
=B*4 ...      LDX   2  FPTR(2)             [X2-> NEXT BLOCK 
=B*# ...      BXE   2  CXFI,QUARRYON       [J IF END OF FILE CHAIN (CAN'T BE WF 
=B*J ...                                   [ RING SINCE WF NEVER CAREFUL)   
=B*W ...      LDX   4  ATYPE(2) 
=BB? ...      BXE   4  FILEPLUSFCB,QUARRYON [J IF NEXT FCB  
=BBN ...      BXE   4  FFSFULLB,XFMAPP     [J IF BSTB/FULLB 
=BC5 ...ODDBLOK 
=BCB ...      GEOERR   BRIEFPM,ODD BLOK    [BLOCK OF IMPERMISSIBLE TYPE IN FILE 
=BCM ...                                   [ CHAIN (OR BLOCK OTHER THAN FULLB   
=BCY ...                                   [ FOLLOWS FMAPP) 
=BD# ...#   
=BDP ...WAITWRCOR   
=BF6 ...      COOR3    #55                 [WAIT FOR CORE UNJAMMER TO FINISH
=BFH ...                                   [ (FIXED) WRITING AWAY ADATA/CORUNJAM
=BFY ...                                   [ BLOCK  
=BG* ...      BRN      RIDBL               [LOOK AGAIN FOR BUFFER BLOCKS (MIGHT 
=BGQ ...                                   [ BE >1 CORUNJAM BLOCK ANYWAY, ALL   
=BH7 ...                                   [ACTS. WAITING IN STYLE #55 RELEASED)
=BHQ    #   
=GYB    #   
=HXL    #     K88 AND K89 CLOSEDIR ARE THE ENTRIES FROM THE FRITE MACRO.
=JC=    #     K88 FORCES AN AUTONOMOUS, K89 A NON-AUTONOMOUS WRITE ON ANY FUWB'S
=JWW    #           OR FURWB'S AFTER THE FILE WHOSE DEPTH IS IN ACOMMUNE7   
=K4G ...#           (ACOMMUNE7=#40000000 IS SPECIAL CASE MEANING 'WRITE BUFFERS 
=K=6 ...#           FOR ALL FILES OPEN TO THIS ACT.' (BUT EXCLUDE FILES OPEN TO 
=KCQ ...#           OTHERS)).   
=KKD ...XENT88  
=KW6 ...      LDN   7  0                   [AUTONOMOUS FRITE (CLEAR MARKER WORD)
=L*Q          BRN      WRMERGE  
=LTB ...XENT89  
=M*2 ...      BSXD     7,XBNONAUTOWR       [NON-AUTONOMOUS FRITE
=MSL    WRMERGE 
=N8* ...      LDX   0  ACOMMUNE7(2) 
=NJ4 ...      BXE   0  GSIGN,WALL          [J IF 'ALL' PARAMETER SPECIFIED  
=NPX ...WRNEXT3 
=NXR ...      STO   0  AWORK1(2)           [REMEMBER DEPTH  
=P?G    WRNEXT2 
=PH# ...      CALL  4  SFSTACK             [X3->FCA AT DEPTH AWORK1 
=PR6 ...      PSTAC 3,3                    [X3-> FSTACK 
=Q2Y ...      BFCBX 2,3                    [X2-> FCB
=Q=Q ...      JBC      NOTALL,,XBFRITEALL  [J IF NOT 'ALL'  
=QCY ...                                   [DON'T WRITE BUFFERS IF OTHERS ARE   
=QK6 ...                                   [ USING FILE 
=QQB ...      LDEX  0  ARINGNO(3)   
=R28 ...      SBN   0  1
=R=2 ...      BNZ   0  WALL2               [J IF >1 ACT. RINGED INTO FILE   
=RFS ...NOTALL  
=RJC ...      JBC      WRNEXT1,,XBNONAUTOWR [J IF AUTONOMOUS(FILEAUTOW DEALS
=RM2 ...                                    [ WITH FILE BEING COPIED)   
=RPL          JMBAC    WRNEXT1,2,BFFCB,BFMCOP   
=S9=    [              OPEN IN COPY, DON'T REMOVE FCB FROM FILE CHAIN?  
=SNW          BS       2,BFFRITEW   
=T8G ...      TRACEIF  K6CLOSEDIR,99,299,FLOC1(2),FRITE WT  
=TN6 ...      COOR3    FRITEWAIT           [WAIT FOR THE COPIER TO FINISH   
=X72          BRN      WRNEXT2  
=XLL    WRNEXT1 
=Y6=          LDX   2  FPTR(2)  
=YKW ...      BXE   2  CXFI,WREND          [J IF END OF FILE CHAIN  
=^5G ...      SMO      FX2  
=^K6 ...      LDN   0  BWORKRING
?24Q ...      BXE   2  0,WREND             [J IF END OF WORK FILE RING  
?2JB ...      LDX   4  ATYPE(2) 
?342 ...      ANDX  4  HALFTOP             [X4= TYPE OF BLOCK   
?3HL ...      BXE   4  FILEPLUSFCB,WREND   [J IF FCB
?43= ...      BXE   4  FFSFUWB,WRITE       [J IF FUWB   
?47N ...      BXE   4  FFSFURWB,WRITE      [J IF FURWB  
?4#6 ...      BXU   4  SADATA(1),WRNEXT1   [J IF NOT ADATA/CORUNJAM 
?4DJ ...      JBC      WRNEXT1,,XBNONAUTOWR [J IF AUTONOMOUS FRITE  
?4K2 ...      COOR3    #55                 [WAIT FOR CORE UNJAMMER TO FINISH
?4PD ...                                   [  FIXED CORE WRITE OF BUFFER
?4TW ...      BRN      WRNEXT2  
?52G ...WRITE   
?5G6 ...      CALL  6  WBWRITE             [WRITE AWAY FUWB OR FURWB
?5^Q ...      BRN      WRNEXT2  
?6FB ...WREND   
?6^2 ...      JBC      UP,,XBFRITEALL      [J IF NOT 'ALL'  
?7DL ...WALL2   
?7Y= ...      LDX   2  FX2  
?8CW ...      LDX   0  AWORK1(2)           [X0= DEPTH OF CURRENT FILE   
?9C6 ...WALL1   
?9WQ ...      SBN   0  1                   [REDUCE DEPTH BY 1   
?=BB ...      BPZ   0  WRNEXT3             [J IF MORE FILES TO LOOK AT  
??T= ...UP  
?##W ...      UP
?#SG ...WALL
?*#6 ...      BS       ,XBFRITEALL         [MARKER TO SAY 'THIS IS FRITE ALL
?*RQ ...                                   [ CASE'  
?B?B ...      FILENUMB 0                   [X0= NO. OF FILES OPEN TO THIS ACT.  
?BR2 ...      BRN      WALL1
?C=L ...#   
?XS6 ...#   
?Y34 ...NOFILE  
?Y=2 ...      GEOERR   BRIEFPM,NO FILE     [NO FILE OPEN TO CURRENT ACTIVITY
?YDY ...NOPEN   
?YMW ...      GEOERR   BRIEFPM,CL NOPEN    [FILE NOT OPEN IN PERMISSIBLE MODE   
?YWS ...XERRFRBS
?^3D ...      GEOERR   BRIEFPM,CLOSFRBS    [CLOSEFRBS MACRO & OTHERS RINGED INTO
?^84 ...                                   [ OR WAITING FOR FILE
?^#Q    #END
^^^^ ...46176321000100000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1