ORELMAIN867

(George Source)

Macros used: ACROSS, ADDMODE, APVSF, BACKSPACE, BASEFCB, BC, BS, BXE, BXU, CHAIN, CLOSETOP, COOR3, DOWN, FREECORE, GEOERR, GFCBC, HUNT, JBC, JBS, JMBAC, LONGOFF, LONGON, LONGSET, LONGSTOP, MBS, MFREE, MFREEW, MHUNT, MHUNTW, MONOUT, NAME, NEXTFCB, NXFCA, OPEN, OUTPACK, READ, REOPEN, REWRITE, SEG, SEGENTRY, SETNCORE, SETREP, SETREP2, TESTMODE, TESTNAMX, TESTREP2, TOPFCA, TOPFCB, TRACE, TRACEIF, TRANSFCB, TRF, UP, UPPLUS, VFREEBAX, VFREEW

ORELMAIN867.txt
22FL ...      SEG      ORELMAIN,70,ROB RUSHTON ,OPEN              [8OPAE
22KH ...[   
22PD ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983
22T* ...[   
22^=          SEGENTRY K1ORELMAIN,Z1ORELMAIN
23DW          SEGENTRY K4ORELMAIN,Z4ORELMAIN
23YG    [   
24D6    XCMM           #30200040           [MASKS FOR PRESERVING COMM& FCOMM FRO
24XQ    XFCMM          #42357              [FILE CHAIN FCB WHEN IT IS BEING 
25CB                                       [OVERWRITTEN BY ACTIVITY CHAIN FCB IN
25X2                                       [EMPTY MODE CASE 
26BL    WTFR           +FWFREE  
26W= ...#   
27*W ...#   
2#PQ    XGETFCB 
2*9B ...      BVCI     £
2B8L    [ THIS ROUTINE FINDS FCB WHOSE UNIQUE NUMBER IS IN X6 & EXITS + 0 IF
2BN=    [ FCB NOT FOUND & +1 IF IT IS   
2C7W    XGFCB   
2CMG          GFCBC    6,3,NF   
2CT* ...      BVCR     X1   
2D38 ...X0  
2D93 ...      EXIT  2  0
2DBW ...X1  
2DJP ...      EXIT  2  1
2DQJ ...NF    BVC      X0   
2DYC ...      GEOERR 1,FCB MISS 
2F6B    [THIS ROUTINE TESTS WHETHER THE FCB INDICATED BY X2 CAN BE OPENED   
2FL2    YCOP
2G5L          JMBAC    OK,2,BFFCB,BFMCOP   [WAIT IF OPEN OR BEING OPENED IN COPY
2GK=          BRN      WAIT                [IS ALREADY OPEN 
2H4W    TRYREEL 
2HJG          TESTMAIN 7,YCOP,,COPY        [DO EXTRA TESTS IF COPY MODE 
2J46          TESTMODE 7,ORDINARY,NOT,EMPTY[J UNLESS EMPTY MODE 
2JHQ          JBS      OPDIR,2,BFDIR       [J IF A DIRECTORY
2K3B          LDX   4  FWAITCOUNT(2)       [WE MUST MAKE SURE THAT  
2KH2          ORX   4  CTOPEN(2)           [THE FILE IS UTTERLY UNUSED. 
2L2L          SLC   4  1
2LG=          SLL   4  1                   [COMMUNE BIT DOESN'T MATTER. 
2L^W          ORX   4  FREEZECOUNT(2)      [NO GOOD IF FROZEN   
2MFG          ORX   4  FSVCT(2)            [OR SAVED
2M^6          BNZ   4  NOK  
2NYB          JMBAC    OK,2,BFFCB,BFMCOP   [& FILE OPEN OR BEING OPENED IN COPY 
2PD2    NOK 
2PXL          LDN   4  0                   [ZEROISE REPLY MARKER
2QC=          TESTMODE 7,SAYCANT,,REPLY    [DON'T WAIT IF REPLY MODE
2QWW          LDX   5  BACK1(2)            [KEEP BACKING STORE HOME PAIR
2RBG          LDX   6  BACK2(2) 
2RW6          LONGSET  6,XSET,6 
2S*Q          LDX   0  WTFR(1)  
2STB          STO   0  AWORK4(2)
2T*2          TESTMODE 7,NOUWB,,CAREFUL    [DON'T SET UWB IF CAREFUL MODE   
2TSL          BS       3,BFUWB  
2W#=    NOUWB   
2WRW          BS       3,BFEMPTY           [SET WAITING TE EMPTY BIT ANYWAY 
2X?G          DOWN     OPENWAIT,2          [GO DOWN TO WAIT FOR FILE TO BE FREE 
2XR6          BRN      XBR  
2Y=Q          CALL  2  XGFCB
2YQB          BRN      NF1  
2^=2          BC       3,BFEMPTY           [CLEAR 'WAITING TO EMPTY'BIT (WHO SET
2^PL    NF1 
329=          LDX   2  FX2  
32NW          TESTREP2 DIRCLOSE,XDC,CLUDGE,UPCLD,OK,REOP
338G          SETREP2  NAME 
347Q          UPPLUS   1
34MB    XBRK                               [BREAKIN DURING OPENWAIT OR LONGSTOP 
3572          CALL  2  XGFCB
35LL          BRN      XBRK2
366=          LDN   0  1
36KW          SBS   0  FWAITCOUNT(3)       [BROKEN IN SO NO LONGER WAITING  
375G    XBRK2   
37K6          VFREEW   FILE,FCB            [FREE FCB IF PRESENT 
384Q          VFREEBAX  
38JB          UP
3942    XBR 
39HL          CALL  2  XGFCB
3=3=          BRN      NF2  
3=GW          BC       3,BFEMPTY           [UNSET 'WAITING TO EMPTY'BIT (?) 
3?2G    NF2 
3?G6          LONGON   6,6                 [WAKE UP ANY OTHER WAITERS   
3?^Q          BRN      XBRK2
3#FB    UPCLD   
3#^2          NGN   4  1                   [SET CLUDGE MARKER   
3*DL          CALL  2  XGETFCB             [FIND FCB AGAIN  
3*Y=          BRN      SAYCANT             [CLEAR UP
3BCW    REOP
3BXG    [BEFORE GOING BACK TO OPENREL MUST CHECK GEN NO AND IF ZERO SET BIT 2   
3CC6          MHUNT    1,FILE,FLOCNB       [BUG 1860
3CWQ          LDX   0  A1+4(1)  
3DBB          BNZ   0  REOPEN              [J IF NOT ZERO   
3DW2          LDCT  0  #100 
3F*L          STO   0  A1+4(1)             [OTHERWISE SET BIT 2 OF GEN  
3FT=    REOPEN  
3G#W          ACROSS   OPENREL,5           [START RE-OPENING THE FILE   
3GSG    OPDIR GEOERR   1,DIREMPTY          [OPENREL EMPTY ON A DIRECT-ORY   
3H#6    [NO ONE CAN BE USING THE FILE IN ANY SENSE IN THE MULTI-REEL/EMPTY CASE.
3HRQ    [WE MIGHT AS WELL DO THE SAME FOR ONE REEL. 
3J?B    ORDINARY
3JR2          LDX   4  CTOPEN(2)           [PICK UP OPEN MODE:  
3K=L          TRACEIF  K6ORELMAIN,199,299,4,CTOPEN  
3KQ=    [FORMAT IS; L.S. 12 BITS,COUNT OF READ OPENERS. NEXT L.S. 9 BITS,COUNT  
3L9W    [OF APPEND OPENERS. B0=SOLE OPENER BIT   B1=COMMUNAL BIT.   
3LPG          LDX   0  FREEZECOUNT(2)   
3M96          BZE   0  NOFRZ               [OK IF NOT FROZEN
3MNQ          TESTMAIN 7,TSYC,NOT,READING  [IF NOT READER J TO TEST FOR SYSTCOMM
3N8B ...      TESTMODE 7,WAIT,,DESTRUCT,GDESTR [WAIT IF READ + DESTRUCT OR GDR. 
3NN2          BRN      NOFRZ
3P7L    TSYC
3PM=          TESTMODE 7,WAIT,NOT,SYSTCOMM [WAIT UNLESS SYSTCOMM TO ALLOW LOGANA
3Q6W                                       [WRITE TO FROZEN MONFILE 
3QLG                                       [ALLOW SOMEONE TO LF MONILE &
3R66                                       [THEN OL AN OUTPUT PERI TO IT
3RKQ    NOFRZ   
3S5B          LDX   0  FSVCT(2)            [J IF THE FILE IS NEITHER READ- NOR  
3SK2          BZE   0  NOSFZ               [WRITE-FROZEN
3T4L          ANDN  0  #7777
3TJ=          BZE   0  NRF                 [J IF NOT READ-FROZEN
3W3W          LDX   0  FSVCT(2) 
3WHG          ANDX  0  HALFTOP  
3X36          BNZ   0  RWF                 [ERROR IF ALSO WRITE-FROZEN  
3XGQ          TESTMAIN 7,NOSFZ,,READING    [OK IF READER
3Y2B          BRN      WAIT 
3YG2    RWF   GEOERR   1,REWRFROZ   
3Y^L    NRF 
3^F=          TESTMAIN 7,WAIT,NOT,UNCLEAN   
3^YW          TESTMODE 7,WAIT,NOT,REOPEN   [WAIT UNLESS REOPEN MODE 
42DG    NOSFZ   
42Y6          BZE   4  OK                  [CARRY ON IF FCB OPEN
43CQ          TESTMAIN 7,S31,NOT,READING
43XB          LDX   0  4
44C2          SRL   0  12                  [ISOLATE APPEND COUNT & SOLE BIT 
44WL          ANDN  0  #5777               [RID OF COMMUNE BIT. 
45B=          BNZ   0  TBC                 [TRY FOR COMMUNE MODE & FILE 
45TW          TESTMODE 7,WAIT,,DESTRUCT    [WAIT IF FILE DESTRUCT OR GDR & MODE 
46*G          JBS      WAIT,2,BFDCF 
46T6          TESTMODE 7,NDR1,NOT,GDESTR
47#Q          JBC      WAIT,2,BFGDR 
47SB          LDX   1  FCOMMCT(2)   
48#2          SRL   1  12   
48RL          TESTMODE 7,NC1,NOT,COMMUNE   [J UNLESS COMMUNE
49?=          BZE   1  WAIT                [J IF NOT OPEN IN COMMUNE
49QW          BRN      OK                  [OK SINCE FILE OPEN IN GDR & COMMUNE,
4==G                                       [& MODES GDR & COMMUNE GIVEN 
4=Q6    NC1 
4?9Q          BNZ   1  WAIT                [J IF OPEN IN COMMUNE
4?PB          BRN      OK                  [OK SINCE FILE OPEN IN GDR & NOT 
4#92    NDR1                               [COMMUNE & GDR GIVEN BUT NOT COMMUNE 
4#NL          JBS      WAIT,2,BFGDR        [WAIT IF OPEN IN GDR & GDR MODE ABSEN
4*8=          BRN      OK   
4*MW    S31 
4B7G          LDEX  0  FREEZECOUNT(2)   
4BM6          BZE   0  TBC                 [IF FROZEN WAIT UNLESS SYSTCOMM  
4C6Q          TESTMODE 7,WAIT,NOT,SYSTCOMM [ALLOWS LF MONFILE THEN OL MONFILE (B
4CLB    TBC 
4D62          LDX   4  FCOMMCT(2)   
4DKL          ANDN  4  #7777               [CT OF CLEAN OPENERS 
4F5=          BZE   4  RCOMM               [J IF NONE   
4FJW          TESTMODE 7,WAIT,NOT,USERCLEAN[WAIT UNLESS USERCLEAN   
4G4G          LDX   0  CTOPEN(2)
4GJ6          BPZ   0  RDCT                [J IF NO WRITER  
4H3Q          TESTMAIN 7,WAIT,NOT,READING   
4H?J ...OK  
4H?L ...      JBC      NABOK,2,BFCLOSEAB   [J IF FILE NOT TO BE CLOSEABANDONED  
4H?N ...      TESTMODE 7,NABOK,,REOPEN  
4H?Q ...      SMO      FX2                 [ONLY ALLOW FILE TO BE OPENED BY 
4H?S ...      LDX   0  ATYPE               [LISTFILE OR HLS / JOBWELL   
4H?W ...      SRL   0  18   
4H?Y ...      SBN   0  ACTLF/64 
4H#2 ...      BNZ   0  WAIT                [OTHERWISE WAIT FOR CLOSEABANDON TO F
4H#4 ...NABOK   
4H#B ...#   
4H#R ...#   
4HR8 ...      EXIT  6  0
4J32    RCOMM   
4JGL          LDX   4  FCOMMCT(2)   
4K2=          BZE   4  WAIT                [WAIT IF NO COMMUNERS
4KFW          JBC      NOSYS,3,BFSYSCOMM   [J IF FILE NOT OPEN IN SYSTCOMM MODE 
4K^G          TESTMODE 7,WAIT,NOT,SYSTCOMM [WAIT UNLESS MODE ALSO SYSTCOMM  
4LF6          BRN      TDES                [J TO TEST FOR APPENDERS IF IT IS
4LYQ    NOSYS   
4MDB          TESTMODE 7,WAIT,NOT,COMMUNE  [WAIT UNLESS COMMUNE MODE GIVEN  
4MY2          TESTMODE 7,NOTDESTRUCT,NOT,DESTRUCT   
4NCL          JBC      WAIT,2,BFDCF        [WAIT IF MODE GIVEN IS DESTRUCT & FIL
4NX=          BRN      TDES 
4PBW    NOTDESTRUCT 
4PWG          JBS      WAIT,2,BFDCF        [WAIT IF MODE GIVEN NOT DESTRUCT & FI
4QB6    TDES
4QTQ          TESTMODE 7,NGD2,NOT,GDESTR   [J UNLESS GDR MODE   
4R*B          JBS      OK,2,BFGDR          [OK IF GDR MODE & FILE OPEN IN GDR   
4RT2          BRN      WAIT                [OTHERWISE WAIT  
4S#L    NGD2
4SS=          JBS      WAIT,2,BFGDR        [WAIT IF FILE GDR & GDR MODE NOT GIVE
4T?W                                       [BUT FILE OPEN IN GDR
4TRG          LDX   0  CTOPEN(2)
4W?6          SRL   0  12   
4WQQ          ANDN  0  #1777               [EXTRACT APPEND CT   
4X=B          BZE   0  RDCT1               [J IF NO APPENDERS   
4XQ2          JBC      OK,2,BFDCF          [FOR MULTIPLE APPENDERS (SEE ALSO CLO
4Y9L          TESTMAIN 7,WAIT,,APPEND   
4YP=          BRN      OK                  [
4^8W    RDCT1   
4^NG          SRL   4  12   
5286    RDCT
52MQ          LDX   0  CTOPEN(2)
537B          ANDN  0  #7777               [CT OF READERS   
53M2          ERX   4  0
546L          BZE   4  OK                  [J IF EQUAL  
54L=          BRN      WAIT 
555W    [   
55KG    Z1ORELMAIN  
55T#          STOZ     AWORK4(2)
5656          MHUNTW   2,FILE,FCB          [PICK UP VERSION IN ACTIVITY CHAIN   
592W    [AN FCB HAS BEEN FORMED WITH THE CORRECT SHORT NAME 
59GG    [SEARCH THE FILE CHAIN TO SEE IF THIS FCB IS ALREADY THERE  
5=26    [SOME OF THE WORDS TO BE COMPARED ARE CONTAINED IN X4,X5,X6&X0  
5=FQ    [FOR HALFOPEN FILES WE MUST SEARCH BOTH OPEN AND HALFOPEN FILE CHAINS   
5=^B    [ FOR THE FCB.  IF THE FCB IS FOUND IN THE HALFOPEN CHAIN IT IS RECHAINE
5?F2    [ IN THE OPEN FILE CHAIN
5?YL ...
5#D= ...      STOZ     GEN0 
5#XW ...      LDX   4  FLOC1(2) 
5*CG ...      LDX   0  BACK2(2)            [DIR OR TERM FILE
5*X6 ...      BNG   0  ZDIRS            [B IF DIR   
5BBQ ...      BASEFCB 3,FILE,ZNF,6      [FILE SEARCH
5BWB ...ZLOOPF  
5CB2 ...      BXE   4  FLOC1-FCBRING(3),ZSOK
5CTL ...ZRETSF  
5D*= ...      NEXTFCB 3,FILE,ZLOOPF,6   
5DSW ...      BRN      ZNF  
5F#G ...ZRETSQ  
5FS6 ...      LDX   0  BACK2(2) 
5G?Q ...      BPZ   0  ZRETSF   
5GRB ...      BRN      ZRETS
5H?2 ...
5HQL ...ZLOOP   
5J== ...      BXE   4  FLOC1-FCBRING(3),ZSOK         [COMPARE FIRST WORD
5JPW ...ZRETS   
5K9G ...      NEXTFCB 3,DIR,ZLOOP,6        [TRY NEXT FCB
5KP6 ...      LDX   1  GEN0         [HAVE WE SEARCHED BOTH CHAINS   
5L8Q ...      BNZ   1  ZNF            [YES JUST SEARCHED HALF   
5LNB ...ZNODIR  
5M82 ...      STO   2  GEN0            [SET GEN0 NON ZERO   
5MML ...      BASEFCB 3,HALF,ZNF,6      [PREPARE TO SEARCH HALF OPEN CHAIN  
5N7= ...      BRN      ZLOOP
5NLW ...ZDIRS   
5P6G ...      BASEFCB 3,DIR,ZNODIR,6   [PREPARE TO SEARCH DIR CHAIN 
5PL6 ...      BRN      ZLOOP
5Q5Q ...ZSOK                     [FIRST NAME NOW AGREES 
5QKB ...      TESTNAMX 9,FUSER1-FCBRING(3),FUSER1(2),ZRETSQ,1   
5R52 ...      SBN   3  FCBRING         [COMPLETE NAAME AGREES   
5RJL ...      LDX   1  GEN0 
5S4= ...      BZE   1 ONEREEL         [B IF FOUND ON FILE CHAIN 
5SHW ...
5T3G ...      LDX   2  3         [FOUND ON HALF THEREFORE  RECHAIN  
5TH6 ...      LDX   3  FPTR(2)  
5W2Q ...      TRANSFCB 2,HALF,FILE  
5WGB ...      CHAIN 3,BFILE+1            [CHAIN FINDEXF BLOCK AS WELL   
5X22 ...      LDX   3  BFILE+1  
5XFL ...      LDX   3  BPTR(3)  
5X^= ...      BRN      ONEREEL  
5YDW ...ZNF                   [NOT FOUND ON FILE CHAINS 
5YYG ...      TRANSFCB 2,ACT,FILE   
5^D6 ...      LDX   3  BFILE+1  
65*6          LDX   0  FINFC(3)            [IF FILE IS INDEXED THE FINDEXF  
65SQ          ANDN  0  #77                 [IN THE ACTIVITY CHAIN MUST BE   
66#B          BZE   0  ONEREEL             [CHAINED AFTER FCB JUST PUT IN   
66S2          HUNT     1,FI,FINDEXF        [FIEL CHAIN  
67?L          CHAIN    1,3  
67R=          BRN      ONEREEL  
68=W    WAIT
68QG          LDN   4  0
69=6          TESTMODE 7,OOR3,NOT,REPLY    [WAIT UNLESS REPLY MODE  
69PQ    SAYCANT 
69^J ...      TESTMAIN 7,POSN,,COPY 
6=9B          TESTMAIN 7,UNCLMODE,,UNCLEAN  
6=P2          TESTMODE 7,UNCLMODE,,GDESTR  [GDESTR MODE IS UNCLEAN - JUMP   
6?8L    POSN
6?N=          TESTMODE 7,NREWR,,EMPTY      [J IF EMPTY MODE 
6#7W          MHUNTW   1,FILE,ENT          [IF FILEHAS NOT BEEN RETRIEVED   
6#MG          LDX   0  ECOPS(1)            [BECAUSE FCB FOUND & IT STILL HAS
6*76          ANDN  0  1                   [NOT BEEN RESTORED DON'T BACKSPACE   
6*LQ          BZE   0  NREWR
6B6B          BACKSPACE                    [POINTERS POSITIONED ON COPIES REC   
6BL2          BRN      NREWR               [AND WE MUST BACKSPACE (BUG 1913)
6C5L    UNCLMODE
6CK=          JBS      POSN,3,BFUWB        [J IF FILE ALREADY OPEN UNCLEANLY
6D4W          TESTMODE 7,POSN,,CAREFUL     [J IF CAREFUL
6DJG          MHUNTW   1,FILE,ENT   
6F46          NAME     1,FILE,FWB   
6FHQ          BC       1,BEUWB             [REMOVE UWB PUT THERE IN OPENREL 
6GH2          TESTMODE 7,NBACK,,EMPTY      [NO NEED TO BACKSPACE IF EMPTY MODE  
6H2L          LDX   0  ECOPS(1)            [IF FILE HAS NOT BEEN RETRIEVED  
6HG=          ANDN  0  1                   [BECAUSE FCB FOUND & IT STILL HAS
6H^W          BZE   0  NBACK               [NOT BEEN RESTORED DON'T BACKSPACE   
6JFG          BACKSPACE                    [REPOSITION (LAST RECORD READ WAS BLO
6J^6    NBACK   
6KDQ          REWRITE                      [REWRITE RECORD AS WE CANT OPEN THIS 
6KYB          MHUNTW   1,FILE,FWB   
6LD2          NAME     1,FILE,ENT          [RENAME BLOCK AGAIN  
6LXL    NREWR   
6MC=          TESTMODE 7,NOCLOSE2,,DIROPEN  
6MWW          CLOSETOP  
6NBG    NOCLOSE2
6P*Q          TESTMODE 7,MENT,,LEAVE       [DONT FREE ENT IF LEAVE GIVEN
6PTB          MFREEW   FILE,ENT 
6Q*2    MENT
6QSL          VFREEW   FILE,FCB 
6R#=          BNG   4  SCLD                [J IF CLUDGE 
6RRW          SETREP   CANT 
6S?G          BRN      REPG                [REPLY SET   
6SR6    SCLD  SETREP   CLUDGE   
6T=Q          TOPFCB   2                   [X2 -> FCB OF FILE OPEN AT TOP LEVEL 
6TQB          BXU   6  BACK2(2),REPG       [TEST FOR CLUDGE AT TOP LEVEL
6W=2          TOPFCA   2
6WPL          BS       2,BACLUDGE          [???? FOR COPY (COMMAND?)
6X9=    REPG  UPPLUS   1
6XNW    OOR3
6Y8G          LDN   0  1
6YN6          ADS   0  FWAITCOUNT(3)       [ADD ONE TO THE COUNT OF WAITERS 
6^7Q          LDX   5  BACK1(3) 
6^MB          LDX   6  BACK2(3)            [PICK UP BACKING STORE HOME PAIR 
7272          LONGSET  6,XSET,6            [SET WAITING STYLE   
72LL          TESTMAIN 7,NCLD,,COPY        [CLUDGE TEST UNNECCESSARY IF COPY MOD
736=          DOWN     OPENWAIT,3          [TEST FOR CLUDGE 
73KW          BRN      NCLD                [NO CLUDGE IF COMES STRAIGHT UP  
745G          NGN   4  1                   [SET CLUDGE MARKER   
74K6          CALL  2  XGETFCB             [FIND FCB AGAIN  
754Q          LDN   0  1
75JB          SBS   0  FWAITCOUNT(3)       [NO LONGER GOING TO WAIT 
7642          BRN      SAYCANT             [REMOVE UNCLEAN BIT AND CLEAR UP 
76HL    NCLD
76RD          LDN   4  0                   [ZEROISE LONGSTOP MARKER.
773=          MHUNTW   1,FILE,ENT   
77GW          LDX   0  EUSE1(1)            [IF THE FILE IS A DIRECTORY  
782G          BNZ   0  PAR                 [OR ONE SUCH THAT ACTIVITY   
78G6          JBC      RAP,1,BECOOR        [CAN'T LONGSTOP WITH IT OPEN, DO LONG
78^Q    PAR 
79FB          LDEX  0  CLONG1(2)           [IF LONGWAIT HAS BEEN UNSET(WHO BY?),
79^2          BZE   0  SFCBA               [DON'T TRY TO WAIT   
7=DL          LONGOFF  2
7=G*          LDX   0  AWORK4(2)
7=J4          BNZ   0  RAP  
7=KR          CALL  2  XGETFCB  
7=MG          JBC      WCOOR,3,BFFREZ      [J IF FILE NOT FROZEN BY DUMPER. 
7=P9          OUTPACK  FME1(3),3,USERNAME  [PREPARE USERNAME OF DIRECTORY AS
7=QY          MONOUT   INCFREZD            [OUTPUT PARAM. OUTPUT 'WAITING' MESSA
7=SM          LDN   4  1
7=WB          STO   4  AWORK4(2)
7=Y=    RAP 
7?CW          CALL  2  XGETFCB             [FIND FCB AGAIN  
7?XG    WCOOR   
7#7# ...      TESTMAIN 7,TSTRP,,COPY
7#C6          TESTMAIN 7,UNCLE,,UNCLEAN 
7#WQ          TESTMODE 7,TSTRP,NOT,GDESTR  [J IF GDR-ELSE SET UWB EVEN IF READ  
7*BB    UNCLE   
7*W2          TESTMODE 7,TSTRP,,CAREFUL    [IF CAREFUL MODE, DON'T SET UWB  
7B*L          BS       3,BFUWB  
7BT=    TSTRP   
7CSG          MHUNTW   1,FILE,ENT   
7D#6          JBS      WTDIR,1,BECOOR      [MUST DO COOR3 IF CANT LONGSTOP BIT S
7DRQ          LDX   0  EUSE1(1) 
7F?B          BNZ   0  WTDIR               [J IF A DIRECTORY
7FR2          LDN   4  2                   [MARKER FOR LONGSTOP 
7G=L          TESTMODE 7,YCLOSE,NOT,DIROPEN[CLOSE DIR IF NOT ALREADY CLOSED 
7GQ=          BRN      NOCLOSE  
7H9W    WTDIR   
7HPG          TESTMODE 7,NOCLOSE,,DIROPEN  [DON'T CLOSE IF DIROPEN MODE GIVEN   
7J96          ADDMODE  7,DIROPEN           [TO ENSURE IT DOESN'T GET CLOSED AGAI
7JNQ          CLOSETOP                     [CLOSE DIRECTORY 
7KN2          LDN   4  1                   [MARKER FOR DIR WHOSE DIR HAS JUST BE
7L7L          BRN      NOCLOSE  
7LM=    XSET  GEOERR   1,ORELMAIN          [LONGSET FIELD ALREADY SET   
7M6W    YCLOSE  
7MLG          ADDMODE  7,DIROPEN           [TO ENSURE DIR CLOSED ONLY ONCE  
7N66          TOPFCB   3
7NKQ          SMO      FX2                 [PRESERVE DIR'S NAME IN CASE DIR 
7P5B          LDN   1  AWORK2              [NEEDS TO BE REOPENED
7PK2          LDN   0  FME1(3)  
7Q4L          MOVE  0  3
7QJ=          CLOSETOP  
7R3W          CALL  2  XGETFCB             [FIND FCB
7RHG          LDX   0  CTOPEN(3)           [SEE IF FILE IS NOW UNUSED   
7S36          BNZ   0  NOCLOSE             [IF NOT, GO WAITING  
7SGQ          LONGOFF                      [IF IT IS, CLEAR THE LONGSET 
7T2B          BRN      SFCBA
7TG2    NOCLOSE 
7T^L          BNZ   4  NOWT 
7WF=    #SKI  K6ORELMAIN>199-199
7WYW    (   
7XDG    [   
7XY6    [THIS WAS PUT RN TO CORRECT BUG 2889. THIS CODE IS ONLY REQIRED FOR 
7YCQ    [LISTING LEVEL > OR = 200, SINCE AT THIS LEVEL ONLY CLUDGE IS TESTED
7YXB    [FOR ON DIRECTORIES. IF THIS CODE IS NOT INCLUDED AN ACTIVITY CAN GO
7^C2    [WAITING FOR A FILE WHICH IS NOT OPEN, BECAUSE THERE ARE COORDINATIONS  
7^WL    [BETWEEN TESTING FOR A FRLE FREE AND WAITING FOR FILE TO BE FREE
82B=    [   
82TW          CALL  2  XGETFCB  
83*G          LDX   0  CTOPEN(3)           [TEST IF FILE HAS BECOME FREE
83T6          BZE   0  SDFCB
84#Q    )   
84SB          COOR3    6                   [WAIT FOR OBSTRUCTION TO CLEAR:  
85#2          TESTMODE 7,SFCBA,NOT,REPWAIT [J UNLESS REPWAIT
85RL    SETDIRC 
86?=          CALL  2  XGFCB
86QW          BRN      NF3  
87=G          LDN   0  1
87Q6          SBS   0  FWAITCOUNT(3)       [REPLY  DIRECTORY HAS BEEN CLOSED
889Q    NF3 
88PB          SETREP   DIRCLOSE 
8992    XDC 
89NL          TESTMODE 7,XUP,,LEAVE        [DON'T FREE ENT IF LEAVE MODE GIVEN  
8=8=          VFREEW   FILE,ENT 
8=MW    XUP 
8?7G          UPPLUS   1
8?M6    NF6 
8#6Q          VFREEW   FILE,ENT 
8#LB          VFREEW   FILE,FCB 
8#W8 ...      VFREEW   FI,FINDEXF   
8*62          SETNCORE 4,1,FILE,FABSNB  
8*KL          LDN   0  4
8B5=          STO   0  A1(1)               [PICK UP DIR'S NAME & REOPEN IT. 
8BJW          LDN   0  AWORK2(2)
8C4G          ADN   1  A1+1 
8CJ6          MOVE  0  3
8D3Q          OPEN     NF5,GENERAL,QUERY
8DHB          MFREE    FILE,FABSNB  
8DNJ ...      CLEARMOD 7,DIROPEN           [CLEAR SWITCH SET WHEN DIRECTORY 
8DTQ ...                                     [CLOSED BEFORE LONGSTOP
8F32          TESTREP2 OK,REOP  
8FGL          SETREP2  NAME 
8G2=          UPPLUS   1
8GFW    NF5   GEOERR   1,DIRREOP
8G^G    NOWT  SBN   4  2
8HF6          BNZ   4  SFCBA               [J IF WAITING FOR DIRECTORY TO SEE IF
8HYQ          SMO      FX2  
8JDB          LDN   2  FILERING 
8JY2          NXFCA 2,2,WTOK               [J IF NO FILES OPEN, THUS OK.
8KCL          JBC      WTOK,2,BANOWAIT     [J UNLESS DIR
8KX=          GEOERR   1,DIROPENW          [OTHERWISE ERROR 
8LBW    WTOK
8LWG          LONGSTOP XBRK,,FWFREE 
8MB6          TESTMODE 7,SETDIRC,,REPWAIT  [J IF REPWAIT
8MTQ          CALL  2  XGFCB
8N*B          BRN      NF6  
8P4S ...      LDX   2  FX2  
8P#L    [   
8PS=    Z4ORELMAIN  
8Q44          STOZ     AWORK4(2)
8Q?W    SFCBA   
8QRG          CALL  2  XGETFCB             [GET X3 -> FCB AGAIN 
8R?6    SDFCB   
8RQQ          LDN   0  1                   [REMOVE THIS ACTIVITY FROM THE   
8S=B          SBS   0  FWAITCOUNT(3)       [COUNT OF WAITERS.   
8SQ2    ONEREEL 
8T9L          LDX   2  3                   [X2 -> REEL TO BE OPENED:
8TP=          TESTMODE 7,NR,NOT,ERASE   
8W8W          BS       2,BFERASE           [SET 'TO BE ERASED' BIT IF ERASE MODE
8WNG    NR  
8X86          CALL  6  TRYREEL  
8XMQ          TESTMODE 7,OFCB,NOT,GDESTR
8Y7B          TESTMODE 7,OFCB,NOT,REPWAIT   
8YM2          MHUNTW   1,FILE,FCB          [IF GDESTR MODE IS SET & THERE WAS   
8^6L          BNG   1  OFCB                [ALREADY AN FCB IN THE FILE CHAIN
8^L=          JBC      OFCB,3,BFCARE       [COULD BE FMAPP AS GDR FILE CANT BE O
925W                                       [CAREFULLY IF FILE ALREADY OPEN  
92KG          LDX   0  CTOPEN(3)           [OR BEING CLOSED THE DIR MUST BE 
9356          BNZ   0  XGD1                [CLOSED, THE REPTY REPWAIT GIVEN &   
93JQ          LDX   1  FPTR(3)             [UP+1 OBEYED 
944B          LDX   0  ATYPE(1)            [IF THERE IS A FMAPP BUT FILE NOT
94J2          SRL   0  12                  [BEING ACCESSED THE FMAPP CAN BE 
953L          SBN   0  FILE+FSTACK         [FREED, CAREFUL BIT UNSET & THE  
95H=          BNZ   0  XGD2                [OPEN CAN CONTRNUE   
962W          LDX   0  ALOGLEN(1)   
96GG          BZE   0  XGD2 
9726    XGD1
979Y ...      TESTMODE  7,NF3,,DIROPEN  
97#H ...      LDCT  0  2
97C6 ...      ORS   0  COMM(3)             [SET UWB IN FCB AS SET IN ENT.   
97FQ          CLOSETOP  
97^B          BRN      NF3  
98F2    XGD2
98YL          BC       3,BFCARE 
99D=          LDX   1  FPTR(3)  
99XW    XGD3  LDX   0  ATYPE(1) 
9=CG          SRL   0  12   
9=X6          SBN   0  FILE+FMAPP   
9?BQ          BZE   0  XGD4 
9?WB          LDX   1  FPTR(1)  
9#B2          BRN      XGD3 
9#TL    XGD4
9**=          FREECORE 1
9*SW    OFCB
9B#G          TESTMODE 7,NOBLK,NOT,EMPTY
9BS6          MHUNTW   2,FILE,FCB          [IF THERE IS AN FCB IN THE ACTIVITY C
9C?Q          BNG   2  NOTTWO              [B. IF ONLY ONE FCB  
9CRB          LDN   4  BSPRE-FBLMOD 
9D?2          LDX   1  FX1  
9DQL          LDX   0  COMM(3)             [WHEN WVERWRITING FCB IN FILE CHAIN  
9F==          ANDX  0  XCMM(1)             [WITH FCB IN ACTIVITY CHAIN IT IS
9FPW          ORS   0  COMM(2)             [NECESSARY TO PRESERVE SOME BITS 
9G9G          LDX   0  FCOMM(3)            [IN COMM & FCOMM FROM FCB IN FILE
9GP6          ANDX  0  XFCMM(1)            [CHAIN   
9H8Q          ORS   0  FCOMM(2) 
9HNB ...      TRF      3,FFAUTCLCT,2,FFAUTCLCT [COPY AUTOCLOSE COUNT TO NEW FCB 
9JML          LDX   0  FUSEBL(3)           [PRESERVE FUSEBL FROM LOD FCB
9K7=          STO   0  FUSEBL(2)
9KLW          LDN   0  FBLMOD(2)           [OVERWRITE"OLD" FCB IN FILE CHAIN
9L6G          LDN   1  FBLMOD(3)           [BY "NEW" FCB IN  ACTIVITY CHAIN,AS  
9LL6          SMO      4                   [THE LATTER IS MORE UP-TO-DATE.  
9M5Q          MOVE  0  0
9MKB    NOTTWO  
9N52 ...      LDN   4  FBLKS-A1            [RESET FBLMOD IN FILE CHAIN FCB TO   
9NJL          STO   4  FBLMOD(3)           [INDICATE EMPTY FILE 
9P4=    NOBLK   
9PHW          LDX   5  BACK1(3)            [PICK UP HOME PAIR OF FCB.   
9Q3G          LDX   6  BACK2(3) 
9QH6          TESTMAIN 7,NCOP,NOT,COPY     [ENSURE FCB KEPT IN CHAIN IF COPY MOD
9R2Q          BS       3,BFFCB  
9RGB          BRN      NOSC 
9S22    NCOP
9SFL          TESTMODE 7,NOBL1,NOT,USERCLEAN                       [J IF NOT CLE
9S^=          LDN   0  1
9TDW          BRN      NOBL2
9YW=    NOBL1   
9^*W          TESTMODE 7,PLUS,NOT,COMMUNE,SYSTCOMM [DON'T INCREMENT COMMUNE COUN
9^TG          LDCT  0  #200                [SET COMMUNE BIT 
=2*6          ORS   0  CTOPEN(3)
=2SQ          LDX   0  BIT11
=3#B    NOBL2   
=3S2          ADS   0  FCOMMCT(3)   
=4?L    PLUS
=4R=          TESTMAIN 7,READ,,READING  
=5=W          BC    3,BFNODUMP             [CLEAR 'NOT TO BE REDUMPED' BIT. 
=5QG          TESTMAIN 7,SOLE,,CLEAN
=6=6          TESTMODE 7,NUWB,,CAREFUL     [NO UWB IF CAREFUL   
=6PQ          BS       3,BFUWB  
=79B    NUWB
=7P2          TESTMAIN 7,RAPP,,APPEND   
=88L    SOLE  LDCT  0  #400                [SOLE OPENER, JUST ONE BIT TO STORE  
=8N=          ORS   0  CTOPEN(3)
=97W          BRN      OPENFCBED
=9MG    READ  LDN   0  1
==76          ADS   0  CTOPEN(3)           [INCREASE COUNT OF READERS.  
==LQ          TESTMODE 7,OPENFCBED,NOT,GDESTR   
=?6B          BS       3,BFUWB             [SET UWB IF GDESTR READER
=?L2          BRN      OPENFCBED                    [[CHECK IT IS SMALL?
=#5L    RAPP
=#K=          LDX   0  BIT11
=*4W          ADS   0  CTOPEN(3)           [INCREASE COUNT OF APPENDERS. <1024  
=*JG    OPENFCBED   
=B46          TESTMODE 7,NOSC,NOT,SYSTCOMM  
=BHQ          BS       3,BFSYSCOMM         [SET SYSTCOMM BIT
=C3B    NOSC
=CH2          TESTMODE 7,NDS,NOT,DESTRUCT   
=D2L          MBS      3,BFCORE,BFDCF      [SET DCF BIT & KEEP USAGE BLOCKS IN C
=DG=    NDS 
=D^W          TESTMODE 7,NGD3,NOT,GDESTR
=FFG          BS       3,BFGDR             [SET GDR BIT IF GDR MODE 
=F^6    NGD3
=GDQ          TESTMODE 7,NERAD,NOT,ERASE
=GYB ...      BS       3,BFOPENERASE            [SET BIT IF ERASE ????  
=HD2    NERAD   
=HXL          TESTMODE 7,NCOM,NOT,COMMUNE   
=JC=          LONGON   FOPENWT,BACK2(3)    [OTHERWISE WAKE UP WAITERS   
=JWW    NCOM
=KBG          MHUNTW   1,FILE,ENT   
=KW6          JBC      NONLINEBIT,1,BEONLINE
=L*Q          BS       3,BFVSF             [TRANSFER BIT
=LGY ...      APVSF  UP       [ADJUST ACT PRI   
=LN6 ...      MHUNTW   1,FILE,ENT    [X1->ENT   
=LTB    NONLINEBIT  
=M*2          JBC      NOTMDF,1,BEMDF   
=MSL          BS       3,BFSDF             [TRANSFER BIT
=N#=    NOTMDF  
=NRW          JBC      NOTMULT,1,BEMULT 
=P?G          BS       3,BFMULT            [TRANSFER BIT
=PR6    NOTMULT 
=Q=Q          LDX   0  ECOPS(1)            [IF FILE OFFLINE BUT NOTEMPTY
=QQB          BNZ   0  TEMM                [AND ERASING HO TO ORELEMPT  
=R=2          TESTMODE 7,TEM1,NOT,EMPTY 
=RPL          TESTMODE 7,S33,,ERASING   
=S9=    TEM1
=SNW          MHUNTW   1,BSTB,FULLB        [IF FILE OFFLINE & NO FULLB  
=T8G          BNG   1  S33                 [DON'T GO TO ORELEMPT
=TN6          BRN      XEOM 
=W7Q    TEMM
=WMB          TESTMODE 7,S33,NOT,EMPTY     [IF EMPTY & CAREFUL OR ERASING GO TO 
=X72          TESTMODE 7,XEOM,,ERASING,CAREFUL                     [TO FREE OR A
=XLL          MHUNTW   1,BSTB,FULLB        [IF EMPTY BUT NOT CAREFUL OR ERASING 
=Y6=          BNG   1  S33                 [& NO FULLB NOT GO TO ORELEMPT   
=YKW    XEOM
=^5G    #SKI  K6ORELMAIN>100-100
=^K6          TRACE    6,LOOKBS 
?24Q          ACROSS   ORELEMPT,1   
?342    S33 
?3HL          ACROSS   ORELEND,1
?52G    [   
?5^Q    #END
^^^^ ...62777320000200000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1