{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CLOSEDIR867)}}
====== CLOSEDIR867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BACKWAIT|BACKWAIT]], [[george:macro:BC|BC]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BITDEFS|BITDEFS]], [[george:macro:BLAM|BLAM]], [[george:macro:BS|BS]], [[george:macro:BSXD|BSXD]], [[george:macro:BXE|BXE]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CONFURWB|CONFURWB]], [[george:macro:COOR3|COOR3]], [[george:macro:DOWN|DOWN]], [[george:macro:FILEAUTW|FILEAUTW]], [[george:macro:FILENUMB|FILENUMB]], [[george:macro:FILETRAN|FILETRAN]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBAC|JMBAC]], [[george:macro:JMBC|JMBC]], [[george:macro:JMBS|JMBS]], [[george:macro:LBW|LBW]], [[george:macro:MBSXD|MBSXD]], [[george:macro:POP|POP]], [[george:macro:PSTAC|PSTAC]], [[george:macro:RERING|RERING]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:SUBCUBS|SUBCUBS]], [[george:macro:TAB|TAB]], [[george:macro:TOPFCAB|TOPFCAB]], [[george:macro:TOPFCB|TOPFCB]], [[george:macro:TRACEIF|TRACEIF]], [[george:macro:UP|UP]]
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