{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: READFILE84)}}
====== READFILE84 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ADDSKIP|ADDSKIP]], [[george:macro:BC|BC]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:COOR3|COOR3]], [[george:macro:FILEAUTW|FILEAUTW]], [[george:macro:FILENUMB|FILENUMB]], [[george:macro:FILEREAD|FILEREAD]], [[george:macro:FILETRAN|FILETRAN]], [[george:macro:FON|FON]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBAC|JMBAC]], [[george:macro:JMBS|JMBS]], [[george:macro:MBC|MBC]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:PSTAC|PSTAC]], [[george:macro:READ|READ]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:SFUB|SFUB]], [[george:macro:SKIPTRACE|SKIPTRACE]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTLOOK|TESTLOOK]], [[george:macro:TESTSLOWEST|TESTSLOWEST]], [[george:macro:TESTUSEJ|TESTUSEJ]], [[george:macro:TESTWAIT|TESTWAIT]], [[george:macro:TRACE|TRACE]], [[george:macro:TRACEVER|TRACEVER]], [[george:macro:UP|UP]], [[george:macro:VARIADNR|VARIADNR]], [[george:macro:VARIADNW|VARIADNW]], [[george:macro:VFREE|VFREE]], [[george:macro:VSKIP|VSKIP]]
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