(George Source)
Macros used: ADDSKIP, BC, BFCBX, BS, BXE, BXGE, BXL, BXU, CHAIN, COOR3, FILEAUTW, FILENUMB, FILEREAD, FILETRAN, FON, FREECORE, GEOERR, JBC, JBS, JMBAC, MBC, MENDAREA, MFREEW, MHUNTW, NAME, PSTAC, READ, READAGAIN, READB, REWIND, SEGENTRY, SETNCORE, SETREP, SFSTACK, SFUB, SKIPTRACE, STEPAGAIN, TESTLOOK, TESTUSEJ, TESTWAIT, UP, VARIADNR, VARIADNW, 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