{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: PERUSFIL84)}}
====== PERUSFIL84 ======
(George Source)
**Macros used:** [[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:MBC|MBC]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:PSTAC|PSTAC]], [[george:macro:READ|READ]], [[george:macro:READAGAIN|READAGAIN]], [[george:macro:READB|READB]], [[george:macro:REWIND|REWIND]], [[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:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTLOOK|TESTLOOK]], [[george:macro:TESTUSEJ|TESTUSEJ]], [[george:macro:TESTWAIT|TESTWAIT]], [[george:macro:UP|UP]], [[george:macro:VARIADNR|VARIADNR]], [[george:macro:VARIADNW|VARIADNW]], [[george:macro:VFREE|VFREE]]
22FL ...#SEG PERUSFIL6 [M.J.VELLACOTT.
22^= #OPT K0PERUSFIL=K0ACCESS>K0FILESTORE>K0ALLGEO
23DW #LIS K0PERUSFIL
23YG #OPT K6PERUSFIL=K6ACCESS>K6FILESTORE>K6ALLGEO
24D6 8HPERUSFIL
24XQ SEGENTRY K7PERUSFIL,NGET
25CB SEGENTRY K16PERUSFIL,READB
25X2 SEGENTRY K27PERUSFIL,ZGET
26BL SEGENTRY K30PERUSFIL,REWIND
26W= SEGENTRY K31PERUSFIL,ZREWIND
27*W SEGENTRY K40PERUSFIL,NBSPACE
27TG SEGENTRY K44PERUSFIL,ZBSPACE
28*6 SEGENTRY K67PERUSFIL,ZREADB
28SQ SEGENTRY K80PERUSFIL,READAGAIN
29#B SEGENTRY K81PERUSFIL,ZREADAGAIN
29S2 SEGENTRY K82PERUSFIL,RBACK
2=?L SEGENTRY K83PERUSFIL,ZRBACK
2=HD ... SEGENTRY K84PERUSFIL,ZBSKIP
2=R= # IMPLEMENTS MACROS WHOSE ENTRY POINTS ARE AS FOLLOWS :-
2?=W # K30 - 'REWIND'
2?QG # K31 - " (ZERO DEPTH)
2#=6 # K40 - 'BACKSPACE'
2#PQ # K44 " (ZERO DEPTH)
2*9B # K16 - 'READB'
2*P2 # K67 - . " [ZERO DEPTH
2B8L # K80 - 'READAGAIN'
2BN= # K81 - " (ZERO DEPTH)
2C7W # K82 - 'READBACK'
2CMG # K83 - " (ZERO DEPTH)
2D76 # K7 - 'GETAFURB' NONZERO DEPTH
2DLQ # K27 - [ ZERO DEPTH
2F6B #
2FL2 #
2G5L #
2GK= # THE SEGMENT IS IMPLEMENTED USING FILESTORE RINGS
2H4W #
2HJG # ALL FILES OPEN HAVE AN FCB IN THE FILE CHAIN. NEXT TO THIS FCB
2J46 # THERE IS A FILE/FSTACK BLOCK CONTAINING AN ENTRY FOR EACH ACTIVITY
2JHQ # THAT HAS THE FILE OPEN.
2K3B # THIS ENTRY IS 'FELLEN'(CURRENTLY=7 WDS) LONG
2KH2 # EACH ENTRY IN THE STACK IS RINGED TO THE ACTIVITY THAT IT REPRESE
2L2L # AND THE NTH ELEMENT ALONG THE RING REPRESENTS THE FILE OPEN AT
2LG= # DEPTH N
2L^W # THE ENTRY LOOKS LIKE:
2MFG # WORD 1 FPTRF :FORWARD POINTER ALONG RING
2M^6 # WORD 2 BPTRF :BACKWARD POINTER ALONG RING
2NDQ # WORD 3 FBACKPOINT :RELATIVE BACKWARD POINTER TO START OF FSTACK
2NYB # WORD 4 FREADBLOCK :POINTER TO NUMBER OF CURRENT BLOCK BEING READ
2PD2 # WORD 5 FREADWORD : " " " " " RECORD " "
2PXL # WORD 6 FGENERAL1 :(OLD FCA5 WORD) ALLPURPOSE WORD,BITS SET HAVE
2QC= # WORD 7 FGENERAL2 :SPECIAL MEANINGS FGENERAL2 IS FOR EXPANSION
2QWW #
2RBG # BITS IN THE FGENERL WORDS MEAN AS FOLLOWS:-
2RW6 # A) FGENERAL1
2S*Q # B0 : )READ MODE
2STB # B1 : )READRANDOM MODE
2T*2 # B2 :FILE OPEN IN >APPEND MODE
2TSL # B3 : )WRITE MODE
2W#= # B4 : )GENERAL MODE
2WRW # B5 :UNUSED
2X?G # B6 :FILE OPEN IN CLEAN MODE
2XR6 # B8 :FILE IS COMPONENT OF STREAM OR S.D.F.OTHER THAN MASTER ONE
2Y=Q # B9 :TWO REELS OPEN IN GENERAL MODE,LAST AND ANOTHER
2YQB # B10:FILE HAS HAD RECORDS DELETED FROM IT (COMPRESS)
2^=2 # B11:OPEN FOR COMMUNICATION
2^PL # B12:MAGTAPE BULK FILE
329= # B13:DIRECTORY
32NW # B14:OPEN IN USERCLEAN MODE(= COMMUNICATION FOR RANDOM FILES)
338G #
33N6 # BITS 8,9,&12 ARE CURRENTLY(11/9/69) NOT USED
347Q # B15-23 USED TO BE USED TO HOLD THE "HEIGHT" OF THE FILE. CURRENTLY
34MB # DISUSED
3572 # BIT 5 UNALLOCATED
35LL # B7 USED TO BE THE END-OF-FILE BIT,BUT WE'VE DONE AWAY WITH IT
366= # (I HOPE). IT'S NOW UNALLOCATED.
36KW # B) FGENERAL2
375G # B23:THIS ACTIVITY WAITING FOR THIS BLOCK
37K6 # B22:THIS ACTIVITY HAS GONE FOR THIS BLOCK
384Q #
38JB # THE REST UNALLOCATED
3942 # -------------------------------------------------------------------
39HL #
3=3= #
3=GW MASK2
3?2G MCOMUNI
3?G6 #17770000
3?^Q ZGEOER1
3#FB GEOERR 1,READDEEP
3#^2 ZGEOER2
3*DL GEOERR 1,REC BIT?
3*Y= ZGEOER3
3BCW GEOERR 1,END FILE
3BXG ZGEOER6
3CC6 GEOERR 1,CANTBACK
3CWQ Z7
3DBB ZGEOER7
3DW2 GEOERR 1,CANTREAB
3F*L ZGEOER8
3FT= GEOERR 1,BEG FILE
3G#W Z11
3GSG ZGEOER11
3H#6 GEOERR 1,CANTREWI
3HRQ #
3J?B # SFUBREAD SUBROUTINE
3JR2 #
3K=L FILETRAN [SUBROUTINES FOR SPECIAL FILESTORE
3KQ= [B.S. TRANSFER ROUTINES.
3L9W SFUBREAD
3LPG # LOOKS FOR A BLOCK,& READS IT DOWN IF NECESSARY
3M96 # ON ENTRY X2=>FSTACK,X3=> F.C.A.
3MNQ # ON EXIT X2->FSTACK,X3=> F.C.A. X1-> USAGE BLOCK
3N8B BFCBX 1,2 [X1 -> FCB
3NN2 SFUBREAD1
3P7L JBS WAITDCFX1,1,BFAPPCARE [J IF 'CAREFUL UPDATING'
3PM= [BEING DONE BY APPEND
3Q6W NOWAITDC
3QLG SMO FREADBLOCK(3)
3R66 LDX 4 0(1) [X4 = BLOCK NUMBER
3RKQ SKIPTRACE 299,4,SFUBREAD
3S5B SFUB 2,4,1,READFCB [J IF USAGE BLOCK NOT THERE
3SK2 EXIT 5 0
3T4L #
3TJ= # WE CAN'T GET THE LAST BLOCK IF CAREFUL UPDATING IS BEING DONE
3W3W # BY APPEND AS FBLMOD WILL BE INCORRECT & THE BLOCK USUALLY IS FULL
3WHG # OF RUBBISH. THIS INTERLOCK SHOULD BE GOT ROUND EVENTUALLY.
3X36 WAITDCFX1
3XGQ LDX 0 FBLMOD(1) [J IF NOT LAST BLOCK
3Y2B ADN 0 A1-1
3YG2 BXU 0 FREADBLOCK(3),NOWAITDC
3Y^L SBX 5 FX1 [DECREMENT LINK
3^F= WAITDC
3^YW BS 1,BFCAREW [SET THE 'WAITING FOR APPEND TO
42DG [FINISH CAREFUL UPDATING' BIT.
42Y6 COOR3 #113 [WAIT
43CQ CALL 4 ZEXTRO
43XB CALL 4 POINTERS
44C2 BC 1,BFCAREW [UNSET BIT
44WL ADX 5 FX1 [INCREMENT LINK
45B= BRN SFUBREAD1 [TRY AGAIN
45TW # READ SUBROUTINE
46*G # THIS READS THE NEXT BLOCK OF THE FILE DOWN
46T6 # WAITING IF NECESSARY
47#Q #
47SB # WAITING IS THE COMPLEX PART.WE MUST AVOID,AT ALL COSTS,
48#2 # READING THE SAME BLOCK DOWN TWICE,WHILE MAUING SURE THAT ANYONE
48RL # WANTING A BLOCK GETS IT.
49?= #
49QW # THERE ARE TWO MAIN CASES.
4==G # (A) NOT LAST BLOCK' CASE
4=Q6 # WE TEST TO SEE IF ANY OTHER READER HAS GONE FOR THIS BLOCK.
4?9Q # ' IF YES WE SET OURSELVES WAITING IN STYLE 7,SETTING A BIT IN
4?PB # FGENERAL2.EVENTUALLY,WHEN WE WAKE UP,THE BLOCK IS THERE.
4#92 # 2 IF NO WE GO AND DO A BACKREAD(SETTING GONE FOR THIS BLOCK BIT)
4#NL #
4*8= # (B) LLAST BLOCK' CASE
4*MW # 1 IF SOMEONE HAS GONE FOR LAST BLOCK,WE SET OURSELVES WAITING
4B7G # IN STYLE 4,SETTING THE WAITING FOR LAST BLOCK BIT IN THE FCB.
4BM6 # 2 IF ANYONE HAS"GONE FOR THIS BLOCK",WE SET "WAITING FOR THIS
4C6Q # BLOCK(FGEN.1) & WAIT IN STYLE 7
4CLB # 3 IF NOONE HAS GONE FOR THIS BLOCK,WE CHECK IF THE "GONE FOR NEW
4D62 # BLOCK"BIT IS SET.IF IT IS NOT WE SET GONE FOR LAST BLOCK BIT ,AND
4DKL # WE ALSO SET GONE FOR THIS BLOCK BIT IN EITHER CASE
4F5= # THIS IS BECAUSE WE MAY GO TO READ DOWN A LAST BLOCK JUST AFTER
4FJW # SOMEONE ELSE HAS GONE TO GET A NEW BLOCK;LATER SOMEONE ELSE MIGHT
4G4G # COME FOR A BLOCK,AFTER THE NEW BLOCK HAS BEEN OBTAINED,AND READ
4GJ6 # THE SAME BLOCK DOWN,APPEND WILL NOT GET A NEW BLOCK IF ANYONE
4H3Q # HAS GONE FOR LAST BLOCK.
4HHB READSTACK [ENTRY IF NO POINTERS AT ALL
4J32 CALL 4 ZFSTACK
4JGL READFCB [ENTRY IF HAVE POINTERS ONLY TO FSTACK & ELEMENT
4K2= BFCBX 1,2 [X1 IS POINTER TO FCB
4KFW READ
4K^G SBX 5 FX1 [ADJUST LINK
4LF6 LDX 0 FREADBLOCK(3)
4LYQ SKIPTRACE 699,0,READFCB
4MDB BPZ 0 R1 [J IF FILE HAS BEEN READ FROM BEFORE
4MY2 LDN 0 FBLKS [O/W SET TO INITIAL VALUE
4NCL STO 0 FREADBLOCK(3)
4NX= R1
4PBW LDX 0 FBLMOD(1) [J IF
4PWG ADN 0 A1-1 [NOT LAST
4QB6 BXU 0 FREADBLOCK(3),NOLBLOK [ BLOCK IN FILE
4QTQ JBC SETGONR,1,BFLAST [J IF 'GONE FOR LAST BLOCK' BIT UNSET
4R*B BS 1,BFLASTW [SET 'WAITING FOR LAST BLOCK' BIT.
4RT2 COOR3 #4 [WAIT
4S#L CALL 4 ZEXTRO [ELEMENT POINTER
4SS= CALL 4 POINTERS [FSTACK & FCB POINTERS
4T?W BC 1,BFLASTW [UNSET BIT.
4TRG BRN SFUBR
4W?6 SETGONR ["GONE FOR LAST BLOCK" BIT IS SET
4WQQ CALL 4 TESTLOOK [ROUTINE TO TEST IF SOMEONE'S GONE
4X=B BRN SETWAITR [FOR THIS BLOCK.JTW"SETWAITR" IF
4XQ2 [SOMEONE IS
4Y9L BFCBX 1,2 [X1 -> FCB
4YP= JBS RBACKR,1,BFNEW [J IF 'GETTING NEW BLOCK' BIT SET.
4^8W BS 1,BFLAST [SET 'GONE FOR LAST BLOCK' BIT.
4^NG BRN RBACKR
5286 WAITR [SOMEONE(S)WAITING FOR THIS BLOCK
52MQ LDX 3 1 [PICK UP FSTACK PTR AGAIN
537B FON 7 [FON ALL THE WAITERS
53M2 CALL 4 POINTERS [FSTACK & FCB
546L BRN NOWO
54L= SETWAITR
555W BS 3,BAFBLKW [SET 'WAITING FOR THIS BLOCK' BIT.
55KG COOR3 #7 [WAIT FOR IT
5656 CALL 4 ZEXTRO [ELEMENT PTR
56JQ CALL 4 POINTERS [FSTACK & FCB PTR
574B BC 3,BAFBLKW [UNSET BIT.
57J2 SFUBR
583L SMO FREADBLOCK(3)
58H= LDX 4 0(1)
592W SFUB 2,4,1,SBFCBX [J IF BLOCK NOT THERE TO SFCBX
59GG BRN RLINKR
5=26 NOLBLOK
5=FQ #SKI K6PERUSFIL
5=^B BXL 0 FREADBLOCK(3),ZGEOER3
5?F2 CALL 4 TESTLOOK [HAS SOMEONE GONE FOR THIS BLOCK ?
5?YL BRN SETWAITR [J IF YES
5#D= BFCBX 1,2
5#XW RBACKR
5*CG BS 3,BAFBLK [SET 'GONE FOR THIS BLOCK' BIT.
5*X6 LDX 2 1
5BBQ ADX 2 FREADBLOCK(3) [GIVES PTR TO BLOCKNUMBER
5BWB VARIADNR 1
5CB2 SKIPTRACE 299,0(2),BACKREAD
5CTL ADDSKIP I516A,ARDRD
5D5D ...#SKI JSKI33-1
5D*= FILEREAD 7
5DGD ...#SKI JSKI33
5DML ... FILEREAD 7,FAIL
5DSW MHUNTW 1,BSTB,BREAD [FIND BUFFER BLOCK
5F#G CALL 4 ZFSTACK [STACK & ELEMENT
5FS6 LDX 4 BPTR(2)
5G?Q SMO 4 [BS HOME MAY HAVE CHANGED,SO U DATE
5GRB LDX 0 BSPRE [USAGE BLOCK
5H?2 STO 0 BACK1(1)
5HQL ADX 4 FREADBLOCK(3) [BLOCK NO.
5J== SMO 4
5JPW LDX 0 0
5K9G STO 0 BACK2(1)
5KP6 NAME 1,FILE,FURB [RE-NAME BLOCK
5L8Q CHAIN 1,2 [CHAIN USAGE BLOCK IN
5LNB CALL 4 POINTERS [STACK & FCB
5M82 BC 3,BAFBLK [UNSET BIT.
5MML LDX 0 FBLMOD(1)
5N7= ADN 0 A1-1 [IS IT LAST BLOCK
5NLW BXU 0 FREADBLOCK(3),NOLO [IF NOT,JUMP
5P6G JBC NOFON4,1,BFLASTW [J IF 'WAITING FOR LAST BLOCK' BIT UN
5PL6 FON #4 [WAKE UP ANYONE WAITING FOR LAST BLOK
5Q5Q CALL 4 POINTERS [X1-> FCB,X2-> FSTACK
5QKB NOFON4
5R52 MBC 1,BFLAST,BFLASTW [UNSET 'GETTING LAST BLOCK' AND
5RJL ['WAITING FOR LAST BLOCK' BITS,IF SET
5S4= NOLO
5SHW LDX 1 3 [FOR TESTWAIT
5T3G TESTWAIT 1,WAITR,2 [J IF ANYONE WAITING FOR THIS BLOCK
5TH6 LDX 3 1 [PICK UP PTR TO ELEMENT
5W2Q NOWO
5WGB LDX 1 FPTR(2) [X1 -> USAGE BLOCK
5X22 )
5XFL RLINKR
5X^= ADX 5 FX1 [ADJUST LINK
5YDW EXIT 5 0
5YYG SBFCBX
5^D6 BFCBX 1,2
5^XQ BRN R1
62CB #
62X2 #
63BL ZDEEP
63W= # SPECIAL ROUTINE FOR CHECKING & CONVERTING DEPTH
64*W #
64TG LDX 7 ACOMMUNE7(2)
65*6 SRA 7 15
65SQ #SKI K6PERUSFIL
66#B (
66S2 FILENUMB 5 [X5 = NO OF FILES OPEN
67?L BPZ 7 P1 [J IF DEPTH NOT <0
67R= ADX 5 7
68=W BNG 5 ZGEOER1
68QG BRN P2
69=6 P1
69PQ BXGE 7 5,ZGEOER1
6=9B P2
6=P2 )
6?8L EXIT 6 0
6?N= POINTERS
6#7W # THIS SUBROUTINE ,GIVEN POINTER TO A FILE ELEMENT IN X3
6#MG # SETS X2 -> FILE/FSTACK BLOCK & X1 -> FILE/FCB
6*76 PSTAC 2,3 [X2 -> FSTACK
6*LQ BFCBX 1,2 [X1 -> FCB
6B6B EXIT 4 0
6BL2 #
6C5L #
6CK= #
6D4W ZFSTACK
6DJG # DOES AN SFSTACK ON THE FILE OPEN AT DEPTH [X7] & ALSO GIVESA'POINT
6F46 # ER TO THE FSTACK BLOCK
6FHQ SFSTACK 7,3,2
6G3B EXIT 4 0
6GH2 #
6H2L ZINTRO
6HG= # FIRST ENTRY;TO CHECK DEPTH
6H^W CALL 6 ZDEEP [CONVERT & CHECK DEPTH
6JFG #
6J^6 ZEXTRO
6KDQ # THIS ENTRY DOES AN SFSTACK ON THE FILE OPEN AT DEPTH [7]
6KYB # & LEAVES THE POINTER IN X3
6LD2 SFSTACK 7,3
6LXL EXIT 4 0
6MC= #
6MWW #
6NBG # SFUBFREE SUBROUTINE
6NW6 #
6P*Q SFUBFREE
6PTB # THIS SUBROUTINE LOOKS FOR A BLOCK & EXITS IF ITS NOT THERE
6Q*2 # IF IT IS PRESENT,IT ENTERS THE VFREE SUBROUTINE
6QSL # X1 MUST POINT TO FCB
6R#= SMO FREADBLOCK(3)
6RRW LDX 4 0(1) [X4 = BLOCK NUMBER
6S?G SKIPTRACE 699,4,SFUBFREE
6SR6 SFUB 2,4,6,VEXITS [J TO EXIT IF NOT THERE
6T=Q # THS BLOCK IS NOT FREED IF THERE IS AN APPENDER & IT'S THE LAST
6TQB # BLOCK.
6W=2 VFREE2
6WPL BFCBX 1,2 [X1 -> FCB
6X9= VFREE1
6XNW JBS VEXITR,1,BFCORE [J IF 'LEAVE BLOCKS IN CORE' BIT SET.
6Y8G VQRST
6YN6 #
6^7Q # FREES USAGE BLOCK
6^MB # UNLESS SOMEONE IS USING IT,IN WHICH CASE IT'S LEFT
7272 # IF IT'S A FUWB,IS'S WRITTEN BACK
72LL # X6-> USAGE BLOCK (!),CALLED BY X5
736= #
73KW VFREE
745G LDX 1 3 [PRESERVE FROM TSESTUSEJ MACRO
74K6 TESTUSEJ 1,VUSIN,2 [JIF ANYONE USING BLOCB
754Q LDX 3 1
75JB SKIPTRACE 699,FREADBLOCK(3),FREEING
7642 SMO 6
76HL LDX 0 ATYPE [ATYPE OF USAGE BLOCK
773= BXE 0 FFSFURB,VREE [J IF NOT WRITE BLOCK
77GW CHAIN 6,FX2
782G SBX 5 FX1 [CALLING ACCUMULATOR
78G6 #SKI I516A
78^Q (
79FB BFCBX 2,2
79^2 VARIADNW 2
7=DL )
7=Y= ADDSKIP I516A,ARDWR
7?CW FILEAUTW 7,FAIL+FREE
7?XG CALL 4 ZEXTRO [ELEMENT
7#C6 ADX 5 FX1
7#WQ BRN VEXITQ
7*BB VREE
7*W2 ADDSKIP I516A,ARDFR
7B*L FREECORE 6
7BT= VEXITQ
7C#W CALL 4 POINTERS [FSTACK & FCB
7CSG EXIT 5 0
7D#6 VUSIN
7DRQ LDX 3 1
7F?B PSTAC 2,3 [RESET X2
7FR2 VEXITS
7G=L BFCBX 1,2 [KEEP EXIT CONDITION CONSISTENT
7GQ= VEXITR
7H9W EXIT 5 0
7HPG #
7J96 # THIS ROUTINE EXITS +1 IF NOONE HAS GONE FOR CURRENT BLOCK
7JNQ # NORMALLY IF SOMEONE HAS
7K8B # X0,X1 OVERWRITTEN,X2 ON NORMAL EXIT
7KN2 TESTLOOK
7L7L LDX 1 3
7LM= TESTLOOK 1,TESTA1,2
7M6W LDX 3 1
7MLG EXIT 4 1
7N66 TESTA1
7NKQ LDX 3 1
7P5B PSTAC 2,3 [RESET X2
7PK2 EXIT 4 0
7Q4L #
7QJ= #
7R3W # -------------------------------------------------------------------
7RHG #
7S36 RBACK [READBACK,N/Z DEPTH.
7S=Y ... STOZ AWORK1(2)
7SGQ CALL 4 ZINTRO [CHECK EVERYTHING 8 GET PTRS.
7T2B BRN RBRA
7TG2 ZRBACK [READBACK ZERO DEPTH.
7T^L STOZ 7 [DEPTH
7W9D ... STOZ AWORK1(2)
7WF= CALL 4 ZEXTRO
7WYW RBRA
7XDG LDCT 0 #20
7XY6 STO 0 AWORK4(2) [MARKER TO SHOW READBACK.
7YCQ ADDSKIP I516A,IRBCK
7YXB BRN RBACP [DO A BACKSPACE
7^C2 #
7^WL # -------------------------------------------------------------------
82B= REWIND [REWIND N/Z DEPTH.
82TW [ENTRY: REWIND NONZERO DEPTH
83*G CALL 4 ZINTRO [CHECK DEPTH & SET X3=>FCA
83T6 BRN RWIA
84#Q ZREWIND [REWIND ZERO DEPTH.
84SB STOZ 7 [DEPTH
85#2 CALL 4 ZEXTRO [X3 => F.C.A
85RL RWIA
86?= ADDSKIP I516A,IREWI
86QW CALL 4 POINTERS [X1-> F.C.B, X2-> FSTACK BLOCK
87=G #SKI K6PERUSFIL
87Q6 (
889Q JMBAC Z11,3,BAMREAD,BAMREADR,BAMAPP,BAMWRITE,BAMGEN,BAMCLEAN
88PB [CHECK FILE OPEN IN ANY MODE EXCEPT
8992 [COPY. ERROR IF NOT.
89NL )
8=8= LDX 0 FREADBLOCK(3)
8=MW BNG 0 RWIEXIT
8?7G SBN 0 FBLKS [DON'T TRY TO FREE 1ST BLOCK , NOR
8?M6 BZE 0 RWIEXIT [LOOK FOR IT IF IT'S AN EMPTY FILE.
8#6Q ADDSKIP I516A,ARWFR
8#LB CALL 5 SFUBFREE [DEAL WITH BLOCK
8*62 RWIEXIT
8*KL NGS 1 FREADBLOCK(3) [INITIALISE THE
8B5= NGS 1 FREADWORD(3) [TWO POINTERS
8BJW UP
8C4G # -------------------------------------------------------------------
8C7L ...ZBSKIP
8C=Q ... LDX 0 ACOMMUNE8(2)
8C*W ... STO 0 AWORK1(2)
8CF2 ... BRN ZBASKI
8CJ6 NBSPACE [BACKSPACE N/Z DEPTH.
8D3Q [BACKSPACE :NONZERO DEPTH
8D?J ... STOZ AWORK1(2)
8DHB CALL 4 ZINTRO [CHECK DEPTH;X3-> FCA
8F32 BRN RBAC
8FGL ZBSPACE [BACKSPACE ZERO DEPTH.
8FMS ... STOZ AWORK1(2)
8FT2 ...ZBASKI
8G2= LDN 7 0 [BACKSPACE ; ZERO DEPTH
8GFW CALL 4 ZEXTRO [X3 -> FCA
8G^G RBAC
8HF6 ADDSKIP I516A,IBACK
8HYQ SMO FX2
8JDB STOZ AWORK4 [SET B'SPACE MARKER
8JY2 RBACP
8KCL CALL 4 POINTERS [X2-> FSTACK X1-> FCB
8KX= #SKI K6PERUSFIL
8LBW (
8LWG JMBAC ZGEOER6,3,BAMREAD,BAMAPP,BAMGEN,BAMCLEAN
8MB6 [CHECK FILE OPEN IN READ,APPEND
8MTQ [GENERAL OR CLEAN MODE. ERROR IF NOT.
8N*B )
8NT2 LDX 0 FREADBLOCK(3)
8P#L BPZ 0 RBACQ [J IF FILE PREVIOUSLY ACCESSED
8PS= RBACT
8PWF ... LDX 2 FX2
8PYN ... LDX 0 AWORK1(2)
8Q2X ... BZE 0 NFH
8Q56 ... STO 0 ACOMMUNE8(2)
8Q7* ... BRN XSETRE
8Q9J ...NFH
8Q?W LDCT 0 #20
8QRG SMO FX2
8R?6 ANDX 0 AWORK4
8RQQ BZE 0 ZGEOER8 [BEG FILE IF NOT READBACK
8S2J ...XSETRE
8S=B SETREP BEGFILE [SET REPLY & UP
8SQ2 UP
8T9L RBACQ
8TP= SBX 0 FBLMOD(1) [CHECK IF ABOUT TO,OR HAVE READ
8W8W SBN 0 A1 [E.O.F
8WNG BPZ 0 RBACM [J IF SO
8X86 LDX 0 FREADWORD(3) [RECORD POINTER
8XMQ BNG 0 RBACA [J IF BACKSPACED OFF FRONT OF
8Y7B [PRESENT BLOCK
8YM2 SBN 0 A1
8^6L BZE 0 RBACB [J IF READ 1ST RECORD OF THIS BLOCK
8^L= CALL 5 SFUBREAD1 [GET X1-> USAGE BLOCK
925W RBACNEX
92KG LDN 4 A1
9356 RBACC
93JQ SMO 4
944B LDEX 0 FRH(1) [NEXT R.H.
94J2 ADX 4 0 [X4 IS FREADWORD-TYPE POINTER
953L BXU 4 FREADWORD(3),RBACC [J IF NOT YET UP TO FREADWORD
95H= SBN 4 A1
962W BNZ 4 NOTST8 [J IF NOT EMPTY BLOCK
96GG RSETNG
9726 NGS 1 FREADWORD(3)
97FQ BRN RBACN [TRY AGAIN
97^B NOTST8
98F2 SBS 0 FREADWORD(3) [IF WE ARE,GO BACK ONE
98YL SMO FREADWORD(3)
99D= LDX 0 FRH(1)
99XW BPZ 0 RBACN [J IF NOT DUMMY
9=CG LDX 0 FREADWORD(3) [J IF NOT DUMMY & FROET OF BCOLK
9=X6 SBN 0 A1
9?BQ BZE 0 RSETNG
9?WB BRN RBACNEX [J BACK & FIND NEXT ONE UP
9#B2 RBACN
9#TL LDX 0 FREADWORD(3)
9**= BPZ 0 YPOS
9*SW PSTAC 2,3 [X2->FSTACK
9B#G BFCBX 1,2 [X1->FCB
9BS6 CALL 5 SFUBFREE [DEAL WITH SPENT BLOCK.
9C?Q LDX 0 FREADBLOCK(3)
9CRB SBN 0 FBLKS
9D?2 BNZ 0 YPOS [J IF NOT 1ST BLOCK.
9DQL NGS 2 FREADBLOCK(3)
9F== YPOS
9FPW LDCT 0 #20
9G5K ... SMO FX2
9GF# ... ANDX 0 AWORK4
9H8Q BNZ 0 RAGA [J IF BACKREAD
9H=7 ... SMO FX2
9H?J ... LDX 0 AWORK1
9H#^ ... BNG 0 ZGEOER2
9HBB ... BZE 0 RBACKOUT
9HCR ... SBN 0 1
9HF8 ... SMO FX2
9HGK ... STO 0 AWORK1
9HJ2 ... BNZ 0 RBACP
9HJN ...RBACKOUT
9HKC ... SETREP OK
9HNB UP
9J82 RBACX
9JML LDX 6 1 [-> BLOCK
9K7= PSTAC 2,3
9KLW CALL 5 VFREE2 [FREE BLOCK
9L6G BRN RBACY
9LL6 RBACA
9M5Q ADDSKIP I516A,ABAFR
9MKB CALL 5 SFUBFREE [DEAL WITH SPENT BLOCK
9N52 RBACY
9NJL #SKI K6PERUSFIL [N/Z DEPTH
9P4= (
9PHW LDN 0 FBLKS [ERROR IF 1ST BLOCK
9Q3G BXE 0 FREADBLOCK(3),RBACT
9QH6 )
9R2Q LDN 0 1
9RGB SBS 0 FREADBLOCK(3) [BACK ONE BLOCK
9S22 CALL 5 SFUBREAD1 [READ DOWN BLOCK/OR FIND IT
9SFL LDN 4 A1
9S^= LDX 2 1
9TDW RBACD
9TYG SMO 4 [X4 CONTAINS THIS REC.HEADER
9WD6 LDX 0 FRH(2) [NEXT RH.
9WXQ YDUM82A [FX2 CONTAINS LAST POINTER.
9XCB BZE 0 RBACH [J IF END OF BLOCK
9XX2 BPZ 0 NDUM81 [JIF NOT DUMMY
9YBL YDUM81
9YW= LDEX 0 0 [9 BITS
9^*W #SKI K6PERUSFIL
9^TG BZE 0 ZGEOER2
=2*6 ADX 4 0 [UPDATE CT.
=2SQ SMO 4
=3#B LDX 0 FRH(2) [NEXT R.H.
=3S2 BRN YDUM82A
=4?L NDUM81
=4R= STO 4 5
=5=W ADX 2 4
=5QG LDX 4 0 [UPDATE X4
=6=6 BRN RBACD
=6PQ RBACH
=79B SBX 2 1 [DATUMISE S2
=7P2 BZE 2 RBACX [THIS IS A NULL BLOCK(FULL OF DUMMIES
=88L LDN 0 A1 [TEST FOR 1 RECORD IN BLOCK
=8N= BXE 0 2,RBACRBZ [J IF SO
=97W SBX 2 5 [O/W SUBTRACT "LAST BUT TWO"'TH R.H.
=9MG BRN RBACJ
==76 RBACRBZ
==LQ NGX 2 4 [SET F'WORD <0
=?6B RBACJ
=?L2 STO 2 FREADWORD(3) [UPDATE RECORD POINTER
=#5L BRN RBACN
=#K= RBACB
=*4W LDX 0 FREADBLOCK(3) [CHECK IF 1ST BLOCK (THIS WORKS
=*JG SBN 0 FBLKS [EVEN FOR PSEUDO-READ ON EMPTY
=B46 BNZ 0 RBACL [FILE).J IF NOT.
=BHQ LDCT 0 #20
=C3B SMO FX2
=CH2 ANDX 0 AWORK4 [J IF NOT READBACK
=D2L BZE 0 RBACS
=DG= SETREP FIRSTREC
=D^W UP
=FFG RBACS
=F^6 RBACL
=GDQ NGS 2 FREADWORD(3) [RANDOM NEGATIVE NUMBER
=GYB BRN RBACN
=HD2 RBACM
=HXL LDX 0 FREADWORD(3) [IF READ E.O.F,SET'ABOUT
=JC= BPZ 0 RBACB [TO READ EOF.
=JWW BRN RBACY
=KBG #
=KW6 #
=L*Q # -----------------------------------------------------------------
=LTB #
=M*2 # GETAFURB,WHICH GETS THE CURRENT USAGE BLOCK
=MSL #
=N#= #
=NRW NGET [N/Z DEPTH ENTRY.
=P?G CALL 4 ZINTRO
=PR6 BRN RGETAFA
=Q=Q ZGET [ZERO DEPTH ENTRY.
=QQB STOZ 7
=R=2 CALL 4 ZEXTRO
=RPL RGETAFA
=S9= ADDSKIP I516A,IGETA
=SNW CALL 4 POINTERS
=T8G LDX 0 FREADBLOCK(3) [BLOCK POINTER
=TN6 BPZ 0 RGETAFB
=W7Q LDN 0 FBLKS [IF IFLE REWOUND,READ 1ST BLOCK
=WMB STO 0 FREADBLOCK(3)
=X72 RGETAFB
=XLL #SKI K6PERUSFIL
=Y6= (
=YKW ... SBX 0 FBLMOD(1)
=^5G SBN 0 A1
=^K6 BPZ 0 ZGEOER3
?24Q )
?2JB CALL 5 SFUBREAD
?342 UP
?3HL #
?43= #
?4GW # --------------------------------------------------------------------
?52G # READB- READS DOWN THE NEXT BLOCK,RECHAINS IT NEXT TO THE ACTIVITY
?5G6 # BLOCK AS A FILE/FRB
?5^Q #
?6FB READB [N/Z DEPTH
?6^2 CALL 4 ZINTRO [CHECK DEPTH;X3 -> FCA
?7DL BRN RBIN
?7Y= ZREADB [ZERO DEPTH.
?8CW STOZ 7
?8XG CALL 4 ZEXTRO
?9C6 RBIN
?9WQ ADDSKIP I516A,IREAB
?=BB CALL 4 POINTERS [X2-> FSTACK X1-> FCB
?=W2 #SKI K6PERUSFIL
??*L (
??T= JMBAC Z7,3,BAMREAD,BAMREADR,BAMAPP,BAMWRITE,BAMGEN,BAMCLEAN
?##W [CHECK FILE OPEN IN ANY MODE EXCEPT
?#SG [COPY. ERROR IF NOT.
?*#6 )
?*RQ NGS 4 FREADWORD(3) [INITIALISE F'WORD
?B?B LDX 0 FREADBLOCK(3) [BLOCK POINTER
?BR2 BPZ 0 RBBEG [1 FIRST BLOCK NOT WANTOD
?C=L LDX 0 FBLMOD(1) [POINTS(+A1) TO LAST BLOCK
?CQ= SBN 0 AF2-A1 [IS FILE EMPTY(FBLMOD-> BSPRE)?
?D9W BNZ 0 RBFBLK [J IF NOT SO
?DPG LDN 0 FBLKS
?F96 STO 0 FREADBLOCK(3) [MOVE BLOCK PTR.
?FNQ RBCOR
?G8B SETNCORE 0,1,FILE,FRB [ZERO READ BLOCK
?GN2 UP
?H7L RBFBLK
?HM= LDN 0 FBLKS [SET FREADWORD TO 1ST BLOCK
?J6W STO 0 FREADBLOCK(3) [
?JLG BRN RBFUB
?K66 RBBEG
?KKQ SBX 0 FBLMOD(1) [TEST IF THERE ARE NO MORE BLOCKS
?L5B SBN 0 A1-1 [I.E.[FREADWORD]=[FBLMOD]+A1-1
?LK2 BZE 0 RBCOR1 [J IF SO
?M4L #SKI K6PERUSFIL
?MJ= BPZ 0 ZGEOER3
?N3W LDN 0 1
?NHG ADS 0 FREADBLOCK(3) [UPDATE F'BLOCK TO POINT TO NEXT BLK.
?P36 RBFUB
?PGQ CALL 5 SFUBREAD1 [GET BLOCK
?Q2B LDX 0 ATYPE(1) [MUSTNT REMOVE IT BEFORE IT HAS BE5N
?QG2 BXE 0 FFSFUWB,RBNEWB [MUSTN'T REMOVE IT BEFORE IT HAS
?Q^L [BEEN BACKWRITTEN.
?RF= NAME 1,FILE,FRB [RENAME IT
?RYW CHAIN 1,FX2 [RECHAIN IT
?SDG UP
?SY6 RBCOR1
?TCQ LDN 0 1 [UPDATE
?TXB ADS 0 FREADBLOCK(3) [FB'LK
?WC2 BRN RBCOR
?WWL RBNEWB
?XB= SETNCORE GSBS,2,FILE,FRB [SET UP FRB
?XTW CALL 4 ZFSTACK [-> FCA
?Y*G CALL 5 SFUBREAD [-> USAGE BLOCK
?YT6 MHUNTW 2,FILE,FRB
?^#Q LDX 0 BACK1(1) [MOVE WEVR B.S.QFME
?^SB STO 0 BACK1(2)
#2#2 LDX 0 BACK2(1)
#2RL STO 0 BACK2(2)
#3?= ADN 1 A1
#3QW ADN 2 A1
#4=G MOVE 1 0 [MOVE ACROSS DATA.
#4Q6 UP
#59Q #
#5PB #
#692 # ----------------------------------------------------------------*--*
#6NL #
#78= READAGAIN [READAGAIN N/Z DEPTH.
#7MW CALL 6 ZDEEP
#87G BRN RAGA
#8M6 ZREADAGAIN [READAGAIN ZERO DEPTH.
#96Q STOZ 7
#9LB RAGA
#=62 ADDSKIP I516A,IRDAG
#=KL LDX 3 7
#?5= STEPAGAIN 0(3) [STEP ONTO CURRENT RECORD
#?JW RAGB
##4G BZE 3 RAGG [J IF 1 WD FRB + ZERO RH
##J6 LDEX 4 FRH(3)
#*3Q RAGE
#*HB SETUPCOR 4,2,FILE,FRB [SET UP FRB
#B32 LDX 3 7
#BGL STEPAGAIN 0(3) [STEP ONTO RECORD AGAIN
#C2= BZE 3 RAGF [J IF STILL ZERO I.E,E.O.F
#CFW LDEX 0 FRH(3) [PICK UP R.H.
#C^G BXU 0 4,RAGC [J IF R.H.CHANGED
#DF6 MHUNTW 2,FILE,FRB
#DYQ STO 2 4
#FDB ADN 4 A1
#FY2 SMO FRH(3) [MOVE IN NEW RECORD
#GCL MOVE 3 0
#GX= SOK
#HBW SETREP OK
#HWG UP
#JB6 RAGC MFREEW FILE,FRB
#JTQ BRN RAGB
#K*B RAGG LDN 4 1 [1 WD FRB FOR E.O.F.
#KT2 BRN RAGE
#L#L RAGF
#LS= MHUNTW 2,FILE,FRB
#M?W STOZ A1(2) [STOZ R.H.
#MRG BRN SOK
#N?6 #
#NQQ MENDAREA 30,K99PERUSFIL
#P=B #
#PQ2 #END
#Q9L #
#QP= #
^^^^ ...45170314000300000000