READFILE84

(George Source)

Macros used: ACROSS, ADDSKIP, BC, BFCBX, BS, BXE, BXGE, BXL, BXU, CHAIN, COOR3, FILEAUTW, FILENUMB, FILEREAD, FILETRAN, FON, FREECORE, GEOERR, JBC, JBS, JMBAC, JMBS, MBC, MHUNTW, NAME, PSTAC, READ, SEGENTRY, SETNCORE, SETREP, SFSTACK, SFUB, SKIPTRACE, STEP, STEPAGAIN, TESTLOOK, TESTSLOWEST, TESTUSEJ, TESTWAIT, TRACE, TRACEVER, UP, VARIADNR, VARIADNW, VFREE, VSKIP

READFILE84.txt
22FL    #SEG  READFILE7                    [JUDY BIDGOOD.   
22^=    #OPT  K0READFILE=K0ACCESS>K0FILESTORE>K0ALLGEO  
23DW    #LIS  K0READFILE
23YG    #OPT  K6READFILE=K6ACCESS>K6FILESTORE>K6ALLGEO  
24D6          8HREADFILE
24XQ    #   
25CB          SEGENTRY K1READFILE,NZREAD
25X2          SEGENTRY K2READFILE,STEP  
26BL          SEGENTRY K3READFILE,STEPAGAIN 
26W=          SEGENTRY K5READFILE,SHUFFLED  
27*W          SEGENTRY K7READFILE,WAITED
27TG ...      SEGENTRY K9READFILE,VSKIP 
28*6          SEGENTRY K21READFILE,ZREAD
28SQ          SEGENTRY K22READFILE,ZSTEP
29#B          SEGENTRY K23READFILE,ZSTEPAGAIN   
29S2    #   
2=?L    #     IMPLEMENTS MACROS WHOSE ENTRY POINTS ARE AS FOLLOWS :-
2=R=    #     K1    -  'READ'   
2?=W    #     K21   -    "     (ZERO DEPTH) 
2?QG    #     K2    -  'STEP'  (GETTING A BLOCK FROM BACKING STORE  
2#=6    #     K22   -    "     (ZERO DEPTH  
2#PQ    #     K3    -  'STEPAGAIN'  
2*9B    #     K23   -      "      (ZERO DEPTH)  
2*P2    #   
2B8L    #     TO DEAL WITH COMMUNICATION AND D.C. FILES,SEGMENT COMMFILE IS 
2BN=    #     ENTERED FROM READFILE.RE-ENTRY TO READFILE IS MADE AT ENTRY PTS   
2C7W    #     K5 AND K7.
2CMG    #   
2D76    #     THE   SEGMENT IS IMPLEMENTED USING FILESTORE RINGS
2DLQ    #   
2F6B    #     ALL FILES OPEN HAVE AN FCB IN THE FILE CHAIN. NEXT TO THIS FCB
2FL2    #     THERE IS A FILE/FSTACK BLOCK CONTAINING AN ENTRY FOR EACH ACTIVITY
2G5L    #     THAT HAS THE FILE OPEN.   
2GK=    #     THIS ENTRY IS 'FELLEN'(CURRENTLY=7 WDS) LONG  
2H4W    #     EACH  ENTRY IN THE STACK IS RINGED TO THE ACTIVITY THAT IT REPRESE
2HJG    #     AND THE  NTH ELEMENT ALONG THE RING REPRESENTS THE FILE OPEN AT   
2J46    #     DEPTH N   
2JHQ    #     THE ENTRY LOOKS LIKE: 
2K3B    #     WORD 1   FPTRF      :FORWARD POINTER ALONG RING   
2KH2    #     WORD 2   BPTRF      :BACKWARD POINTER ALONG RING  
2L2L    #     WORD 3   FBACKPOINT :RELATIVE BACKWARD POINTER TO START OF FSTACK 
2LG=    #     WORD 4   FREADBLOCK :POINTER TO NUMBER OF CURRENT BLOCK BEING READ
2L^W    #     WORD 5   FREADWORD  :  "     "    "    "   "     RECORD   "    "  
2MFG    #     WORD 6   FGENERAL1  :(OLD FCA5 WORD) ALLPURPOSE WORD,BITS SET HAVE
2M^6    #     WORD 7   FGENERAL2  :SPECIAL MEANINGS FGENERAL2 IS FOR EXPANSION  
2NDQ    #   
2NYB    #     USES OF AWORK WORDS   
2PD2    #   
2PXL    #     AWORK3 : INITIALLY ZERO   
2QC=    #              USED AS SWITCH DURING CFS CODING 
2QWW    #   
2RBG    #     AWORK4 : ZERO IF STEP ENTRY   
2RW6    #              CONTAINS 1 IF READ   
2S*Q    #              CONTAINS 2 IF STEPAGAIN  
2STB    #   
2T*2    #     USES OF ACOMMUNE WORDS
2TSL    #   
2W#=    #     ACOMMUNE1 : CONTAINS FILE DEPTH FOR ENTRY TO COMMFILE 
2WRW    #     ACOMMUNE2 : CONTAINS CMOD FOR ENTRY TO COMMFILE.  
2X?G    #     ACOMMUNE3 : CONTAINS VALUE OF AWORK3 SWITCH FOR ENTRY TO COMMFILE 
2XR6    #     ACOMMUNE4 : CONTAINS FBLMOD FOR ENTRY TO COMMFILE.
2Y=Q    #   
2YQB    #    BITS IN THE FGENERAL WORDS MEAN AS FOLLOWS:-   
2^=2    # A)  FGENERAL1 
2^PL    #   B0 :             )READ MODE 
329=    #   B1 :             )READRANDOM MODE   
32NW    #   B2 :             )APPEND MODE   
338G    #   B3 :FILE OPEN IN >WRITE MODE
33N6    #   B4 :             )GENERAL MODE  
347Q    #   B5 :             )COPY MODE 
34MB    #   B6 :             )CLEAN MODE
3572    #   B7 :CURRENTLY UNUSED
35LL    #   B8 :FILE IS COMPONENT OF STREAM OR S.D.F.OTHER THAN MASTER ONE  
366=    #   B9 :TWO REELS OPEN IN GENERAL MODE,LAST AND ANOTHER 
36KW    #   B10:FILE HAS HAD RECORDS DELETED FROM IT (COMPRESS) 
375G    #   B11:OPEN FOR COMMUNICATION  
37K6    #   B12:A RECORD HAS BEEN APPENDED. 
384Q    #   B13:DIRECTORY   
38JB    #   B14:OPEN IN USERCLEAN MODE(= COMMUNICATION FOR RANDOM FILES)
3942    #   B15 TO 18:NOT SET WHEN FILE OPEN.CONCERNED WITH CLOSING FILE.   
39HL    #   B19:SOMEONE SUSIN'ED FOR A RECORD TO BE APPENDED.   
3=3=    #   B20:SOMEONE SUSIN'ED TO APPEND A RECORD.
3=GW    #   B21,B22:CURRENTLY UNUSED.   
3?2G    #   B23:SPARE FCA.  
3?G6    # B)  FGENERAL2 
3?^Q    #   B23:THIS ACTIVITY WAITING FOR THIS BLOCK
3#FB    #   B22:THIS ACTIVITY HAS GONE FOR THIS BLOCK   
3#^2    #   
3*DL    #      THE REST NOT ALLOCATED OR NOT IMMEDIATELY RELEVANT.  
3*Y=    # --------------------------------------------------------------------  
3BCW    #   
3BXG    #   
3CC6    MASK2   
3CWQ    MCOMUNI 
3DBB          #17770000 
3DW2    ZGEOER1 
3F*L          GEOERR  1,READDEEP
3FT=    ZGEOER2 
3G#W          GEOERR 1,REC BIT?            [SOMETHING ODD ABOUT RECORD HEADER   
3GSG    ZGEOER3 
3H#6          GEOERR  1,END FILE
3HRQ    ZGEOER4 
3J?B          GEOERR  1,COMMREAD
3JR2    ZGEOER5 
3K=L          GEOERR   1,FREAD             [SOMETHING ODD ABOUT READ POINTERS.  
3KQ=    ZGEOER10
3L9W          GEOERR 1,CANTREAD 
3LPG    #   
3M96          FILETRAN                [SUBROUTINES FOR SPECIAL FILESTORE
3MNQ                                       [B.S. TRANSFER ROUTINES  
3N8B    #     SFUBREAD SUBROUTINE   
3NN2    #   
3P7L    SFUBREAD
3PM=    #     LOOKS FOR A BLOCK,& READS IT DOWN IF NECESSARY
3Q6W    #     ON ENTRY X2=>FSTACK,X3=> F.C.A.   
3QLG    #     ON EXIT  X2->FSTACK,X3=> F.C.A. X1-> USAGE BLOCK  
3R66          BFCBX  1,2                   [X1 -> FCB   
3RKQ    SFUBREAD1   
3S5B          JBS      WAITDCFX1,1,BFAPPCARE   [J IF CAREFUL UPDATING BEING 
3SK2                                           [DONE BY APPEND. 
3T4L    NOWAITDC
3TJ=          SMO      FREADBLOCK(3)
3W3W          LDX   4  0(1)                [X4 = BLOCK NUMBER   
3WHG          SKIPTRACE 299,4,SFUBREAD  
3X36          SFUB     2,4,1,READFCB       [J IF USAGE BLOCK NOT THERE  
3XGQ          EXIT  5  0
3Y2B    #   WE CAN'T GET THE LAST BLOCK IF CAREFUL UPDATING IS BEING DONE   
3YG2    #   BY APPEND AS FBLMOD IS INCORRECT & THE BLOCK USUALLY IS FULL OF 
3Y^L    #   RUBBISH.THIS INTERLOCK SHOULD BY GOT ROUND EVENTUALLY.  
3^F=    WAITDCFX1   
3^YW          LDX   0  FBLMOD(1)           [J IF NOT LAST BLOCK 
42DG          ADN   0  A1-1 
42Y6          BXU   0  FREADBLOCK(3),NOWAITDC   
43CQ          SBX   5  FX1                 [DECREMENT LINK  
43XB    WAITDC  
44C2          BS       1,BFCAREW           [SET 'WAITING FOR APPEND TO FINISH   
44WL                                       [CAREFUL UPDATING' BIT.  
45B=          COOR3  #113                  [WAIT
45TW          CALL  4  ZEXTRO   
46*G          CALL  4  POINTERS 
46T6          ADX   5  FX1                 [INCREMENT LINK  
47#Q          BRN      SFUBREAD1           [TRY AGAIN.  
47SB    #   
48#2    #     READ SUBROUTINE   
48RL    #     THIS READS THE NEXT BLOCK OF THE FILE DOWN
49?=    #     WAITING IF NECESSARY  
49QW    #   
4==G    #     WAITING IS THE COMPLEX PART.WE MUST AVOID,AT ALL COSTS,   
4=Q6    #     READING THE SAME BLOCK DOWN TWICE,WHILE MAUING SURE THAT ANYONE   
4?9Q    #     WANTING A BLOCK GETS IT.  
4?PB    #   
4#92    #     THERE  ARE TWO MAIN CASES.
4#NL    # (A)  NOT LAST BLOCK' CASE 
4*8=    #     WE TEST TO SEE IF ANY OTHER READER HAS GONE FOR THIS BLOCK.   
4*MW    #   ' IF YES WE SET OURSELVES WAITING IN STYLE 7,SETTING A BIT IN   
4B7G    #     FGENERAL2.EVENTUALLY,WHEN WE WAKE UP,THE BLOCK IS THERE.  
4BM6    #   2 IF NO WE GO AND DO A BACKREAD(SETTING GONE FOR THIS BLOCK BIT)
4C6Q    #   
4CLB    # (B) LLAST BLOCK' CASE 
4D62    #   1 IF SOMEONE HAS GONE FOR LAST BLOCK,WE SET OURSELVES WAITING   
4DKL    #     IN STYLE 4,SETTING THE WAITING FOR LAST BLOCK BIT IN THE FCB. 
4F5=    #   2 IF ANYONE HAS"GONE FOR THIS BLOCK",WE SET "WAITING FOR THIS   
4FJW    #     BLOCK(FGEN.1) & WAIT IN STYLE 7   
4G4G    #   3 IF NOONE HAS GONE FOR THIS BLOCK,WE CHECK IF THE "GONE FOR NEW
4GJ6    #     BLOCK"BIT IS SET.IF IT IS NOT WE SET GONE FOR LAST BLOCK BIT ,AND 
4H3Q    #     WE ALSO SET GONE FOR THIS BLOCK BIT IN EITHER CASE
4HHB    #     THIS  IS BECAUSE WE MAY GO TO READ DOWN A LAST BLOCK JUST AFTER   
4J32    #     SOMEONE ELSE HAS GONE TO GET A NEW BLOCK;LATER SOMEONE ELSE MIGHT 
4JGL    #     COME FOR A BLOCK,AFTER THE NEW BLOCK HAS BEEN OBTAINED,AND READ   
4K2=    #     THE SAME BLOCK DOWN,APPEND WILL NOT GET A NEW BLOCK IF ANYONE 
4KFW    #     HAS GONE FOR LAST BLOCK.  
4K^G    READSTACK              [ENTRY IF NO POINTERS AT ALL 
4LF6          CALL  4  ZFSTACK  
4LYQ    READFCB                [ENTRY IF HAVE POINTERS ONLY TO FSTACK & ELEMENT 
4MDB          BFCBX  1,2                   [X1 IS POINTER TO FCB
4MY2    READ
4NCL          SBX   5  FX1     [ADJUST LINK 
4NX=          LDX   0  FREADBLOCK(3)
4PBW          SKIPTRACE 699,0,READFCB   
4PWG          BPZ   0  R1                  [J IF FILE HAS BEEN READ FROM BEFORE 
4QB6          LDN   0  FBLKS               [O/W SET TO INITIAL VALUE
4QTQ          STO   0  FREADBLOCK(3)
4R*B    R1  
4RT2          LDX   0  FBLMOD(1)           [J IF
4S#L          ADN   0  A1-1                [NOT LAST
4SS=          BXU   0  FREADBLOCK(3),NOLBLOK     [ BLOCK IN FILE
4T?W          JBS      WAITDC,1,BFAPPCARE  [J IF CAREFUL UPDATE IN PROGRESS.
4TRG          JBC      SETGONR,1,BFLAST    [J IF 'GONE FOR LAST BLOCK' BIT UNSET
4W?6          BS       1,BFLASTW           [SET 'WAITING FOR LAST BLOCK' BIT.   
4WQQ          COOR3    #4                  [WAIT
4X=B          CALL  4  ZEXTRO              [ELEMENT POINTER 
4XQ2          CALL  4  POINTERS            [FSTACK & FCB POINTERS   
4Y9L          BRN      SFUBR
4YP=    SETGONR         ["GONE FOR LAST BLOCK"BIT NOT SET   
4^8W          CALL  4  TESTLOOK            [ROUTINE TO TEST IF SOMEONE'S GONE   
4^NG          BRN      SETWAITR            [FOR THIS BLOCK.JTW"SETWAITR" IF 
5286                                       [SOMEONE IS  
52MQ          BFCBX  1,2                   [X1 -> FCB   
537B          JBS      RBACKR,1,BFNEW      [J IF 'GETTING NEW BLOCK' BIT SET.   
53M2          BS       1,BFLAST            [SET 'GONE FOR LAST BLOCK' BIT.  
546L          BRN      RBACKR   
54L=    WAITR            [SOMEONE(S)WAITING FOR THIS BLOCK  
555W          LDX   3  1                   [PICK UP FSTACK PTR AGAIN
55KG          FON   7                      [FON ALL THE WAITERS 
5656          CALL  4  POINTERS            [FSTACK & FCB
56JQ          BRN      NOWO 
574B    SETWAITR
57J2          BS       3,BAFBLKW           [SET 'WAITING FOR THIS BLOCK' BIT.   
583L          COOR3  #7                    [WAIT FOR IT 
58H=          CALL  4  ZEXTRO              [ELEMENT  PTR
592W          CALL  4  POINTERS            [FSTACK  &  FCB PTR  
59GG          BC       3,BAFBLKW           [UNSET BIT   
5=26    SFUBR   
5=FQ          SMO   FREADBLOCK(3)   
5=^B          LDX   4  0(1) 
5?F2          SFUB   2,4,1,SBFCBX          [J IF BLOCK NOT THERE TO SFCBX   
5?YL          BRN      RLINKR   
5#D=    NOLBLOK 
5#XW    #SKI  K6READFILE
5*CG          BXL   0  FREADBLOCK(3),ZGEOER3
5*X6          CALL  4  TESTLOOK            [HAS SOMEONE GONE FOR THIS BLOCK ?   
5BBQ          BRN      SETWAITR            [J IF YES
5BWB          BFCBX  1,2
5CB2    RBACKR  
5CTL          BS       3,BAFBLK            [SET 'GONE FOR THIS BLOCK' BIT.  
5D*=          LDX   2  1
5DSW          ADX   2  FREADBLOCK(3)       [GIVES PTR TO BLOCKNUMBER
5F#G          SKIPTRACE 299,0(2),BACKREAD   
5FS6          ADDSKIP I516A,ARDRD   
5G?Q          VARIADNR  1   
5GHJ ...#SKI JSKI33-1   
5GRB          FILEREAD 7
5GYJ ...#SKI JSKI33 
5H5Q ...      FILEREAD 7,FAIL   
5H?2          MHUNTW  1,BSTB,BREAD       [FIND BUFFER BLOCK 
5HQL          CALL  4  ZFSTACK             [STACK & ELEMENT 
5J==          LDX   4  BPTR(2)  
5JPW          SMO      4                   [BS HOME MAY HAVE CHANGED,SO U DATE  
5K9G          LDX   0  BSPRE               [USAGE BLOCK 
5KP6          STO   0  BACK1(1) 
5L8Q          ADX   4  FREADBLOCK(3)       [BLOCK NO.   
5LNB          SMO      4
5M82          LDX   0  0
5MML          STO   0  BACK2(1) 
5N7=          NAME   1,FILE,FURB      [RE-NAME BLOCK
5NLW          CHAIN  1,2                   [CHAIN USAGE BLOCK IN
5P6G          CALL  4  POINTERS            [STACK & FCB 
5PL6          BC       3,BAFBLK            [UNSET BIT.  
5Q5Q          LDX   0  FBLMOD(1)
5QKB          ADN   0  A1-1                [IS IT LAST BLOCK
5R52          BXU   0  FREADBLOCK(3),NOLO  [IF NOT,JUMP 
5RJL          JBC      NOFON4,1,BFLASTW    [J IF NOONE WAITING FOR LAST BLOCK.  
5S4=          FON      #4                  [WAKE UP ANYONE WAITING FOR LAST BLOK
5SHW          CALL  4  POINTERS            [X1-> FCB,X2-> FSTACK
5T3G    NOFON4  
5TH6          MBC      1,BFLAST,BFLASTW    [CLEAR 'GONE FOR LAST BLOCK' AND 
5W2Q                                       ['WAITING FOR LAST BLOCK' BITS,IF SET
5WGB                                       ['GONE FOR LAST BLOCK' BIT MAY NOT HA
5X22                                       [BEEN SET IF APPEND WAS GETTING A NEW
5XFL                                       [BLOCK ETC - MAY NOT HAVE FINISHED YE
5X^=    NOLO
5YDW          LDX   1  3                   [FOR TESTWAIT
5YYG          TESTWAIT 1,WAITR,2           [J IF ANYONE WAITING FOR THIS BLOCK  
5^D6          LDX   3  1                   [PICK UP PTR TO ELEMENT  
5^XQ    NOWO
62CB          LDX   1  FPTR(2)             [X1 -> USAGE BLOCK   
62X2    RLINKR  
63BL          ADX   5  FX1                 [ADJUST LINK 
63W=          EXIT  5  0
64*W    SBFCBX  
64TG          BFCBX  1,2
65*6          BRN      R1   
65SQ    #   
66#B    #   
66S2    ZDEEP   
67?L    #     SPECIAL ROUTINE FOR CHECKING & CONVERTING DEPTH   
67R=    #   
68=W          LDX   7  ACOMMUNE7(2)        [DEPTH   
68QG          SRA   7  15   
69=6    #SKI  K6READFILE
69PQ    (   
6=9B          FILENUMB 5                   [X5 = NO OF FILES OPEN   
6=P2          BPZ   7  P1                  [J IF DEPTH NOT <0   
6?8L          ADX   5  7
6?N=          BNG   5  ZGEOER1  
6#7W          BRN      P2   
6#MG    P1  
6*76          BXGE  7  5,ZGEOER1
6*LQ    P2  
6B6B    )   
6BL2          EXIT  6  0
6C5L    POINTERS
6CK=    #     THIS  SUBROUTINE ,GIVEN POINTER TO A FILE ELEMENT IN X3   
6D4W    #     SETS X2 -> FILE/FSTACK BLOCK & X1 -> FILE/FCB 
6DJG          PSTAC  2,3                   [X2 -> FSTACK
6F46          BFCBX  1,2                   [X1 -> FCB   
6FHQ          EXIT  4  0
6G3B    #   
6GH2    #   
6H2L    #   
6HG=    ZFSTACK 
6H^W    #     DOES AN SFSTACK ON THE FILE OPEN AT DEPTH [X7] & ALSO GIVESA'POINT
6JFG    #     ER    TO THE FSTACK BLOCK 
6J^6          SFSTACK  7,3,2
6KDQ          EXIT  4  0
6KYB    #   
6LD2    ZEXTRO  
6LXL    #     THIS ENTRY DOES AN SFSTACK ON THE FILE OPEN AT DEPTH [7]  
6MC=    #     & LEAVES THE POINTER IN X3
6MWW          SFSTACK  7,3  
6NBG          EXIT  4  0
6NW6    #   
6P*Q    #   
6PTB    #     SFUBFREE SUBROUTINE   
6Q*2    #   
6QSL    SFUBFREE
6R#=    #     THIS  SUBROUTINE LOOKS FOR A BLOCK & EXITS IF ITS NOT THERE   
6RRW    #     IF IT IS PRESENT,IT ENTERS THE VFREE SUBROUTINE   
6S?G    #     X1 MUST POINT TO FCB  
6SR6          SMO      FREADBLOCK(3)
6T=Q          LDX   4  0(1)                [X4 = BLOCK NUMBER   
6TQB          SKIPTRACE 699,4,SFUBFREE  
6W=2          SFUB  2,4,6,VEXITS           [J TO EXIT IF NOT THERE  
6WPL    #     THS BLOCK IS NOT FREED IF THERE IS AN APPENDER & IT'S THE LAST
6X9=    #     BLOCK.
6XNW          BFCBX  1,2                   [X1 -> FCB   
6Y8G    VFREE1  
6YN6          JBS      VEXITR,1,BFCORE     [J IF 'LEAVE BLOCKS IN CORE' BIT SET.
6^7Q          LDX   0  FREADBLOCK(3)
6^MB          SBX   0  FBLMOD(1)           [TEST IF LAST BLOCK  
7272          SBN   0  A1-1                [WON'T FREE LAST BLOCK IF SO 
72LL          BNZ   0  VQRST               [J IF NOT LAST BLOCK 
736=          JMBS     (5),3,BAMAPP,BAMGEN [DON'T FREE BLOCK IF CURRENT ACTIVITY
73KW                                       [HAS FILE OPEN IN APPEND OR GENERAL M
745G          LDX   0  CTOPEN(1)           [COUNT OF PEOPLE HAVING FILEOPEN 
74K6          SMO      FX1  
754Q          ANDX  0  MASK2   [= #17770000,MASKS OFF CT. OF APPENDERS  
75JB          BNZ   0  (5)             [J IF LAST BL.& 1 APPENDER.  
7642    VQRST   
76HL    #   
773=    #     FREES  USAGE  BLOCK   
77GW    #      UNLESS SOMEONE IS USING IT,IN WHICH CASE IT'S LEFT   
782G    #     IF IT'S A FUWB,IS'S WRITTEN BACK  
78G6    #     X6-> USAGE BLOCK (!),CALLED BY  X5
78^Q    #   
79FB    VFREE   
79^2          LDX   1  3                   [PRESERVE FROM TSESTUSEJ MACRO   
7=DL          TESTUSEJ   1,VUSIN,2         [JIF ANYONE USING BLOCB  
7=Y=          LDX   3  1
7?CW          SKIPTRACE 699,FREADBLOCK(3),FREEING   
7?XG          SMO      6
7#C6          LDX   0  ATYPE               [ATYPE OF USAGE BLOCK
7#WQ          BXE   0  FFSFURB,VREE        [J IF NOT WRITE BLOCK
7*BB    #SKI I516A  
7*W2    (   
7B*L          BFCBX  2,2
7BT=          VARIADNW  2   
7C#W    )   
7CSG          CHAIN 6,FX2   
7D#6          SBX   5  FX1                 [CALLING  ACCUMULATOR
7DRQ          ADDSKIP I516A,ARDWR   
7F?B          FILEAUTW 7,FAIL+FREE  
7FR2          CALL  4  ZEXTRO              [ELEMENT 
7G=L          ADX   5  FX1  
7GQ=          BRN      VEXITQ   
7H9W    VREE
7HPG          ADDSKIP  I516A,ARDFR  
7J96          FREECORE  6   
7JNQ    VEXITQ  
7K8B          CALL  4  POINTERS            [FSTACK & FCB
7KN2          EXIT  5  0
7L7L    VUSIN   
7LM=          LDX   3  1
7M6W          PSTAC    2,3                 [RESET X2
7MLG    VEXITS  
7N66          BFCBX  1,2                   [KEEP EXIT CONDITION CONSISTENT  
7NKQ    VEXITR  
7P5B          EXIT  5  0
7PK2    #   
7Q4L    #     THIS  ROUTINE EXITS  +1 IF NOONE HAS GONE FOR CURRENT BLOCK   
7QJ=    #                 NORMALLY IF SOMEONE HAS   
7R3W    #     X0,X1 OVERWRITTEN,X2 ON NORMAL EXIT   
7RHG    TESTLOOK
7S36          LDX   1  3
7SGQ          TESTLOOK  1,TESTA1,2  
7T2B          LDX   3  1
7TG2          EXIT  4  1
7T^L    TESTA1  
7WF=          LDX   3  1
7WYW          PSTAC    2,3                 [RESET X2
7XDG          EXIT  4  0
7XY6    #   
7YCQ    #   
7YXB    # --------------------------------------------------------------------  
7^C2    #     READ, STEP (READING A BLOCK DOWN) 
7^WL    #   
82B=    #     THE DEPTH IS CHECKED,AND THE FSTACK BLOCK IS SEARCHED FOR 
82TW    #     THE USAGE BLOCK NUMBER IS FOUND, THE BLOCK LOOKED FOR.
83*G    # (A) IF FOUND: 
83T6    #     IF'CURRENT'RECORD ON ENTRY WAS LAST IN BLOCK,PICK UP NEXT  NUMBER 
84#Q    #    (UNLESS 'CURRENT' BLOCK ON ENTRY WAS LAST, WHEN    GO TO SPECIAL   
84SB    #     EXIT) AND LOOK FOR THAT BLOCK. HAVING CHECKED THIS, SET UP  FRB   
85#2    #     IF IN READ,LOOK AGAIN FOR USAGE (GO TO (B) IF LOST MEANWHILE )
85RL    #     AND MOVE IN RECORD.EXIT.  
86?=    # (B) READ BLOCK DOWN,FIND POINTERS AGAIN  AND GO TO (A)
86QW    #   
86TF ...[   
86Y4 ...VSKIP                              [VSKIP - ANY DEPTH   
872M ...[   
875= ...      LDN   4  3
877T ...      BRN      SAGSTEP1 
87=G    [   
87Q6    NZREAD                             [READ - N/Z DEPTH ENTRY. 
889Q    [   
88PB          ADDSKIP  I516A,IREAD  
8992          LDN   4  1                   [MARKER  
89NL          BRN      RSTOLP   
8=8=    [   
8=MW    STEPAGAIN                          [STEPAGAIN - N/Z DEPTH ENTRY 
8?7G    [   
8?M6          LDN   4  2
8#6Q          BRN      SAGSTEP1 
8#LB    [   
8*62    STEP                               [STEP - N/Z DEPTH ENTRY. 
8*KL    [   
8B5=          LDN   4  0
8BJW    SAGSTEP1
8C4G          ADDSKIP  I516A,K2RD   
8CJ6          STO   3  ACOMMUNE7(2) 
8D3Q    RSTOLP  
8F32          STOZ     AWORK3(2)           [SHOWS WE HAVE'NOT YET COORED'-SEE   
8FGL                                       [E.O.F. COMMUNICATION CODING 
8G2=          STO   4  AWORK4(2)           [MARKER  
8GFW          CALL  6  ZDEEP               [CONVERT AND CHECK DEPTH 
8G^G          BRN      READW
8HF6    [   
8HYQ    ZREAD                              [READ - ZERO DEPTH ENTRY.
8JDB    [   
8JY2          ADDSKIP  I516A,IREAD  
8KCL          LDN   4  1
8KX=          BRN      SSTOLP   
8LBW    [   
8LWG    ZSTEPAGAIN                         [STEPAGAIN - ZERO DEPTH ENTRY.   
8MB6    [   
8MTQ          LDN   4  2
8N*B          BRN      SAGSTEP2 
8NT2    [   
8P#L    ZSTEP                              [STEP - ZERO DEPTH ENTRY 
8PS=    [   
8Q?W          LDN   4  0
8QRG    SAGSTEP2
8R?6          ADDSKIP  I516A,K2RD   
8RQQ    SSTOLP  
8SQ2          STOZ     AWORK3(2)
8T9L          STO   4  AWORK4(2)           [MARKER  
8TP=          STOZ     7                   [FOR READ/STEP,X7=DEPTH THROUGHOUT   
8W8W          BRN      READW
8WNG    [   
8X86    SHUFFLED                           [RE-ENTRY FROM COMMFILE.  BLK NOS IN 
8XMQ    [   
8Y7B                                       [FCB RESHUFFLED FOR D.C. FILES.  
8YM2    READW   
8^6L          CALL  4  ZEXTRO              [GET POINTER TO ELEMENT IN X3
8^L=          CALL  4  POINTERS            [X2 -> FSTACK,X1   FCB   
925W    #SKI  K6READFILE
92KG    (   
9356          JMBAC    ZGEOER10,3,BAMREAD,BAMAPP,BAMGEN,BAMCLEAN  [CHECK FILE OP
93JQ    )   
944B    READX   
94J2          LDX   0  FBLMOD(1)           [POINTER TO END OF BLOCKLIST IN FCB  
953L          SBN   0  AF2-A1   
95H=          BZE   0  READA1              [J IF EMPTY FILE 
962W          LDX   0  FREADBLOCK(3)       [CURRENT BLOCK POINTER   
96GG          BPZ   0  SFUB                [GO LOOK FOR USAGE BLOCK IF WE'VE
9726                                       [READ FROM FILE BEFORE.  
97FQ          LDN   0  FBLKS               [
97^B          STO   0  FREADBLOCK(3)       [FREADBLOCK POINTS TO 1ST BLOCK  
98F2          BRN      NORENDIS 
98YL    [   
99D=    WAITED                             [RE-ENTRY FROM COMMFILE AFTER HAVING 
99XW    [   
9=CG          LDX   0  ACOMMUNE3(2)        [WAITED FOR RECORD TO BE APPENDED
9=X6          STO   0  AWORK3(2)
9?BQ          CALL  4  ZEXTRO              [RESET X3,X2,X1  
9?WB          CALL  4  POINTERS 
9#B2          LDX   0  FREADBLOCK(3)
9#TL    SFUB
9**=          SBX   0  FBLMOD(1)           [ IF[F'BLOCK]=[FBLMOD]+A1, WE EITHER 
9*SW          SBN   0  A1                  [ ARE ABOUT TO READ E.O.F [F'WORD <0]
9B#G          BNG   0  NORENDIS            [ OR HAVE READ E.O.F [F'WORD =A1]
9BS6    #SKI  K6READFILE
9C?Q    (   
9CRB          LDX   0  FREADWORD(3) 
9D?2          BPZ   0  ZGEOER3  
9DQL    )   
9F==          NGN   6  1                   [SWITCH  
9FPW          BRN      READA
9G9G    NORENDIS
9GP6          CALL  5  SFUBREAD1           [SET X1->USAGE BLOCK 
9H8Q          LDX   0  FREADWORD(3)        [LOOK AT RECORD POINTER IN THIS BLOCK
9HNB          BXE   0  BSBSA1,STEPREP [J IF SPECIAL SETTING FOR STEPAGAIN   
9J82          LDX   6  1                   [PRESERVE USAGE BLOCK POINTER
9JML          BNG   0  SETA1               [J IF FIRST READ ON THIS BLOCK   
9K7=          ADX   1  0                   [X1+A1 -> RECORD HEADER  
9KLW    YDUM10  
9L6G          LDX   0  FRH(1)              [NEXT R.H
9LL6          BPZ   0  NDUM10              [J IF NOT DUMMY  
9M5Q          ANDX  0  BRHMASK  
9MKB          BNZ   0  ZGEOER2             [OR XRUPT IF FDUD.   
9N52          LDEX  0  FRH(1)              [BOTTOM 9 BITS   
9NJL    #SKI K6READFILE 
9P4=          BZE   0  ZGEOER2  
9PHW          ADX   1  0                   [STEP ON PTR 
9Q3G          ADS   0  FREADWORD(3)        [& FREADWORD 
9QH6          BRN      YDUM10   
9R2Q    NDUM10  
9RGB          BZE   0  ZAPPRECQ            [J IF ZERO RECORD AT END OF BLOCK
9S22                                       [LAST READ   
9SFL          ADX   1  0                   [UPDATE PTR TO POINT TO NEXT RECORD  
9S^=          BRN      QOLPOD   
9TDW    #     WE NOW TEST IF LAST BLOCK, FOR IF SO, WE  
9TYG    #     DON'T WANT TO THROW AWAY THE BLOCK EVERY TIME WE DO A READ IN THE 
9WD6    #     CLASSIC COMMUNICATION FILES CASE OF 'READ(ACT.1)-APPEND(ACT2)-
9WXQ    #     READ(ACT.1)-APPEND(ACT2).THAT WOULD BE TOO INEFFICIENT EVEN FOR G3
9XCB    ZAPPRECQ
9XX2          BFCBX  1,2
9YBL    #SKI  K6READFILE
9YW=    (   
9^*W          LDX   0  FBLMOD(1)
9^TG          ADN   0  A1-1 
=2*6          SBX   0  FREADBLOCK(3)
=2SQ          BNZ   0  NLASTBLK            [J IF NOT LAST BLOCK 
=3#B          SMO      FX2  
=3S2          LDX   0  AWORK4   
=4?L          SBN   0  1
=4R=          BNZ   0  STEPREP             [J IF STEP OR STEPAGAIN  
=5=W          BRN      ZGEOER3             [ERROR IF LAST BLOCK 
=5QG    NLASTBLK
=6=6          JBS      ZGEOER4,1,BFDCF     [READ E.O.F. THEREFORE ERROR IF DCF. 
=6PQ    )   
=79B          CALL  5  VFREE1   
=7P2          LDN   0  A1                  [O/W  ASSUME RECORDS HAVE
=88L          STO   0  FREADWORD(3)        [BEEN APPENDED IN A NEW BLOCK
=8N=          LDX   0  FREADBLOCK(3)       [SINCE LAST READING  
=97W          ADN   0  1                   [E.O.F. & SET POINTERS   
=9MG          STO   0  FREADBLOCK(3)       [AS IF WE'VE READ.   
==76          BRN      SFUB                [THE FIRST OF THES5& NEW RECORES 
==LQ    VRECLAST
=?6B          BFCBX    1,2                 [X1 - > FCB. 
=?L2          LDX   0  FBLMOD(1)           [END OF BLOCK NUMBERS TABLE  
=#5L          SBX   0  FREADBLOCK(3)       [IS IT   
=#K=          ADN   0  A1-1                [LAST BLOCK ?
=*4W          BZE   0  READA               [J TO EOF ROUTINE
=*JG    ZEND
=B46          JBS      RESHUFL,1,BFDCF     [J TO RESHUFFLE BLK NOS. IF DCF. 
=BHQ          JBC      XFREE,1,BFGDR       [J IF NOT GENERAL DESTRUCTIVE READ AC
=C3B          LDX   1  3                   [X1->FCA 
=CH2          TESTSLOWEST  1,SLOWGDR,2     [J IF SLOWEST GDR READER.
=D2L          LDX   3  1
=DG=          CALL  4  POINTERS 
=D^W    XFREE   
=FFG          CALL  5  VFREE1              [DEAL WITH SPENT BLOCK   
=F^6          LDN   0  1
=GDQ          ADS   0  FREADBLOCK(3)           [O/W,ADD ONE TO BLOCK POINTER
=GYB          NGS   0  FREADWORD(3)            [SET RECORD POINTER NEGATIVE 
=HD2          LDX   0  FREADBLOCK(3)
=HXL          BRN      SFUB                    [GO LOOK FOR NEXTBLOCK   
=JC=    SLOWGDR 
=JWW    #SKI  K6READFILE>159-159
=KBG          TRACE    FREADBLOCK(1),GDRSHUFL   
=KW6          FREECORE 6                   [FREE USAGE BLOCK
=L*Q          BRN      XGDRSHUFL
=LTB    RESHUFL 
=M*2    #SKI  K6READFILE>159-159
=MSL          TRACEVER FBLMOD(1),RESHUFLE   
=N#=          LDX   2  6                   [RENAME OLD BLOCK A FURB 
=NRW          NAME 2,FILE,FURB             [AND EMPTY IT
=P?G          STOZ  A1(2)   
=PR6    XGDRSHUFL   
=Q=Q          LDX   2  FX2  
=QQB          STO   7  ACOMMUNE1(2)        [STORE FILE DEPTH
=R=2          ACROSS   COMMFILE,1          [RESHUFFLE BLK NOS   
=RPL    SETA1   
=S9=          ADN   1  A1              [PTR TO 1ST REC. 
=SNW    QOLPOD  
=T8G    YDUM11  
=TN6          LDX   0  FRH(1)              [NEXT R.H
=W7Q          BPZ   0  NDUM11              [J IF NOT DUMMY  
=WMB          ANDX  0  BRHMASK  
=X72          BNZ   0  ZGEOER2             [OR XRUPT IF FDUD
=XLL          LDEX  0  FRH(1)              [BOTTOM 9 BITS   
=Y6=    #SKI K6READFILE 
=YKW          BZE   0  ZGEOER2  
=^5G          ADX   1  0                   [STEP ON PTR 
=^K6          BRN      YDUM11   
?24Q    NDUM11  
?2JB          SMO      FX2  
?342          LDX   4  AWORK4   
?3HL          SBN   4  2
?43=          BZE   4  STEPREP             [J IF STEPAGAIN  
?4GW          BZE   0  VRECLAST            [J IF RECORD LAST IN BLOCK.  
?52G          SBX   1  6
?5G6          BXGE  1  BSBSA1,ZGEOER2      [J IF GREATER THAN ONE BLOCK SIZE.   
?5^Q          ADN   4  1                   [TO XRUPT IF FDUD
?6FB          BNZ   4  STEPREP             [J IF STEP   
?6^2          STO   1  FREADWORD(3)        [UPDATE F'WORD   
?7DL          ADX   1  6
?7Y=          SKIPTRACE 199,6,READ BL   
?8CW          LDX   6  0                   [SIZE OF BLOCK WANTED
?8XG          SETUPCOR 6,1,FILE,FRB            [SET UP READ BLOCK   
?9C6          CALL  4  ZFSTACK             [POINTERS
?9WQ          CALL  5  SFUBREAD            [X1 -> USAGE BLOCK   
?=BB          MHUNTW  2,FILE,FRB
?=W2          ADX   1  FREADWORD(3)        [PTR TO RECORD   
??*L          ADN   2  A1   
??T=          SMO      FRH(1)              [MOVE IN 
?##W          MOVE  1  0                   [RECORD  
?#SG    SETREP  
?*#6          SETREP   OK                  [REPLY FOR READ  
?*RQ    UP  
?B?B          UP
?BR2    STEPREP 
?C=L          SETREP   COORED              [REPLY FOR STEP  
?CQ=          UP
?D9W    #     LAST  BLOCK   
?J6W    READA1  
?JLG          STOZ     6
?K66    READA   
?KKQ          SMO      FX2  
?L5B          LDX   0  AWORK4   
?LK2          SBN   0  2
?M4L ...      BPZ   0  STEPREP             [J IF STEPAGAIN  
?MJ=          JBC      NOAPPE,3,BACOMM     [J IF NOT OPEN IN COMMUNE MODE.  
?N3W          JBS      MORAPPE,1,BFDCF     [IF A D.C. FILE WE WISH TO GO WAITING
?NHG                                       [ANYWAY - IF NECESSARY FOR EVER - SO 
?P36                                       [ANOTHER APPENDER CAN OPEN THE FILE. 
?PGQ          LDX   0  CTOPEN(1)
?Q2B          SMO      FX1                 [MASK OUT ALL EXCEPT COUNT OF
?QG2          ANDX  0  MCOMUNI             [APPENDERS   
?Q^L          BZE   0  NOAPPE              [J IF NO APPENDERS   
?RF=          SRL   0  2
?RYW          SBN   0  #4000               [NEG IF ONLY ONE 
?SDG          BPZ   0  MORAPPE             [J IF >1 APPENDER
?SY6          JBC      MORAPPE,3,BAMAPP    [SEE IF WE'RE THE ONE(SOLE) APPENDER 
?TCQ                                       [AND J IF WE'RE NOT. 
?TXB    NOAPPE  
?WC2          SMO      FX2  
?WWL          LDX   0  AWORK4              [MARKER WORD 
?XB=          BZE   0  STEPREP             [J IF STEP   
?XTW          BNG   0  UP   
?Y*G          BNG   6  OFRI                [SPECIAL ENTRIES 
?YT6          BZE   6  NOFR1
?^#Q          CALL  5  VFREE
?^SB    NOFR1   
#2#2          LDX   0  FBLMOD(1)
#2RL          ADN   0  A1                  [EOF SETTING ,F'WORD = FBLKOD+A1 
#3?=          STO   0  FREADBLOCK(3)       [F'WORD =A1  
#3QW          LDN   0  A1   
#4=G          STO   0  FREADWORD(3) 
#4Q6          SETNCORE 1,1,FILE,FRB        [SET UP ZERO FRB 
#59Q          STOZ     A1(1)               [STOZ 1ST WORD   
#5PB          BRN      SETREP   
#692    OFRI
#6NL          CALL  5  SFUBFREE            [TRY TO FREE BLOCK   
#78=          BRN      NOFR1
#7MW    MORAPPE 
#87G    #     ENTRY IS NOW MADE TO COMMFILE TO DEAL WITH COMPLEX COMMUNICATION  
#8M6    #     FILE INTERLOCKS AT E.O.F. ONLY 'STEP' ENTRIES ALLOWED HERE.   
#96Q          LDX   2  FX2  
#9LB    #SKI  K6READFILE
#=62    (   
#=KL          LDX   0  AWORK4(2)
#?5=          BZE   0  T46  
#?JW          BPZ   0  ZGEOER4  
##4G    T46 
##J6    )   
#*3Q          STO   7  ACOMMUNE1(2)        [DEPTH   
#*HB          LDX   0  AWORK3(2)
#B32          STO   0  ACOMMUNE3(2) 
#BGL          LDX   0  CMOD(1)             [CURRENT POSN. OF APPEND POINTERS.   
#C2=          STO   0  ACOMMUNE2(2) 
#CFW          LDX   0  FBLMOD(1)
#C^G          STO   0  ACOMMUNE4(2) 
#DF6          ACROSS   COMMFILE,2          [WAIT FOR RECORD TO BE APPENDED. 
#DYQ    #   
#FDB ...#END
^^^^ ...11250114000300000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1