APPEND864
(George Source)
Macros used: ACROSS, ADDSKIP, ALTLEN, APPCUBS, APPEND, BC, BFCBX, BS, BXE, BXGE, BXL, BXU, CHAIN, COOR3, COOR4, DOWN, FDRMAUTO, FILEAUTW, FILENUMB, FILEREAD, FILETRAN, FON, FREEBACK, FREECORE, GEOERR, GETBACK, GETCORE, JBC, JBS, JMBS, LONGON, MAPBCH, MAPBIN, MAPBSE, MBC, MBS, MHUNT, MHUNTW, NAME, PSTAC, SEGENTRY, SETNCORE, SETREP, SFMAP, SFSTACK, SFUB, SKIPTRACE, SREP, STEP, TESTREP2, TESTRPN2, TRACE, TRACEVER, UP, UPDATE, UPPLUS, VARIADNR, VARIADNW
- APPEND864.txt
22FL ...#SEG APPEND [JUDY BIDGOOD. 22^= #OPT K0APPEND=K0ACCESS>K0FILESTORE>K0ALLGEO 23DW #LIS K0APPEND 23YG #OPT K6APPEND=K6ACCESS>K6FILESTORE>K6ALLGEO 24D6 8HAPPEND 24XQ SEGENTRY K1APPEND,NAPP 25CB SEGENTRY K2APPEND,SSTEP 25X2 SEGENTRY K5APPEND,WAITCOMM 26BL SEGENTRY K8APPEND,NAPPFORCE 26W= SEGENTRY K9APPEND,NAPPANS 27*W SEGENTRY K10APPEND,NAPPBREAK 27TG SEGENTRY K11APPEND,ZAPP 28*6 SEGENTRY K12APPEND,ZAPPFORCE 28SQ SEGENTRY K13APPEND,ZAPPANS 29#B SEGENTRY K14APPEND,ZAPPBREAK 29S2 SEGENTRY K20APPEND,STEPFORCE 2=?L SEGENTRY K21APPEND,STEPANS 2=R= SEGENTRY K22APPEND,STEPBREAK 2?=W # 2?QG MCOMCOM #01000100 [WAITING BITS IN COMM 2*9B SFMAP 2*P2 #HAL FILE+FMAPP,0 2B8L SFULLB 2BN= #HAL BSTB+FULLB,0 2CMG # 2D76 FILETRAN [SUBROUTINES FOR SPECIAL FILESTORE 2DLQ [B.S. TRANSFER ROUTINES. 2F6B # THIS SEGMENT IMPLEMENTS THE ACCESS MACROS 2FL2 # APPEND (ENTRY POINTS K1 AND K11) 2G5L # STEP-PART OF THE APPEND CASE (ENTRY POINT K2) 2GK= # IN CONJUNCTION WITH THE FILESTORE RING SYSTEM 2H4W # 2HJG # USE OF AWORK WORDS 2J46 # 2JHQ # AWORK1 : CONTAINS CMOD AS ON ENTRY,FOR POSSIBLE USE IN ADJUSTING 2K3B # THE READ POINTERS AT THE END 2KH2 # AWORK2 : BI WAITED 2X - COMMUNICATION FILES 2L2L # B2 WAITED ONCE ) 2LG= # B5 EXTENDING FCB-DON'T READ DOWN USAGE BLOCK 2L^W # B15-23 :SIZE OF STEP-APPENDEE,IFZERO NOT STEP(APPEND) 2MFG # AWORK3 : DEPTH OF FILE 2M^6 # AWORK4 : G.P. WORK WORD 2NDQ # 2NYB # 2PD2 ZGEOERR 2PXL # THIS IMPLEMENTS MOST OF APPEND'S GEOERRS. IT IS CALLED BY X6 TO 2QC= # GIVE A LINK TO PART OF SEGMENT REQUESTING GEOERR. 2QWW GEOERR 1,APPEND! 2RBG # 2RW6 SFUB 2S*Q STO 0 GEN6 2STB SFUB 1,7,1,(GEN6) [X1->FURB IF THERE. 2T*2 LDX 0 GEN6 2TSL EXIT 0 1 2W#= # 2WRW SFSTACK [LONG MACRO 2X?G LDX 2 FX2 2XR6 SFSTACK AWORK3(2),2 [X2 ->FCA 2Y=Q EXIT 7 0 2YQB SFREGBAC [ENTRY TO FREE B.S. & TRY TO GET 2^=2 SBX 7 FX1 [ANOTHER BLOCK 2^PL LDX 2 FX2 329= STO 7 AWORK4(2) 32NW BRN SFREEB 338G SGETBAC 33N6 SBX 7 FX1 [DATUMISE 347Q LDX 2 FX2 [ & STORE 34MB STO 7 AWORK4(2) [ LINK 3572 RGETBACK 35LL LDX 7 ACOMMUNE1(2) [PRESERVE 2ND. PARAM. TO MACRO. 366= GETBACK 5 [ GET 1 BLOCK B.S. IN EXEC1 36KW STO 7 ACOMMUNE1(2) 375G ADDSKIP I516A,BSGET 37K6 LDX 4 ACOMMUNE7(2) [NEW B.S. BLOCK. 384Q CALL 7 SFSTACK [X2 -> FCA 38JB PSTAC 3,2 3942 BFCBX 3,3 [X3 -> FCB 39HL BXE 5 BSPRE(3),OKBSP [J IF B.S.PREFIX UNCHANGED 3=3= SFREEB 3=GW LDX 3 BSPRE(3) [PRESERNE NEW B.S.PREFIX 3?2G [ N.B IT MAY CHANGE AGAIN DURING THE FREEBACK- THO' ITS VERY 3?G6 [ UNLIKELY: HOWEVER WE'LL PICK UP THE CHANGE NEXT TIME ROUND. 3?^Q FREEBACK 5,4 [FREE B.S. 3#FB ADDSKIP I516A,ADLFBL 3#^2 LDX 5 3 [NEW B.S.P 3*DL BRN RGETBACK [TRY AGAIN 3*Y= OKBSP 3BCW SMO FX2 [PICK UP LINK AGAIN 3BXG LDX 7 AWORK4 3CC6 ADX 7 FX1 3CWQ EXIT 7 0 [EXIT 3DBB # 3DW2 SEEKFULLB [ENTRY TO SEARCH FOR FULLB FROM FCB 3H#6 LDX 1 FPTR(3) [J OVER FSTACK 3HRQ SKFULLB [ENTRY TO SEARCH FOR FULLB FROM FSTAC 3J?B LDX 1 FPTR(1) [NEXT BLOCK 3JR2 BXE 1 CXFI,(7) [EXIT,NOTFOUND,IF END OF FILE CHAIN 3K=L LDX 0 ATYPE(1) 3KQ= BXE 0 FILEPLUSFCB,(7) [EXIT,NOTFOUND,IF FCB. 3L9W SMO FX1 3LPG BXU 0 SFULLB,SKFULLB [J BACK IF NOT FULLB 3M96 LDX 0 BSPRE(3) 3MNQ BXU 0 A1+1(1),SKFULLB [J BACK IF NOT RIGHT FULLB 3NN2 EXIT 7 1 3P7L # 3PM= # 3Q6W # 3QLG SCAREGETB 3R66 # 3RKQ # THIS SUBROUTINE (CALLED BY X6) EXITS WITH X1-> THE FPTR OF THE 3S5B # LAST BLOCK IN A FURB,X2 -> FCA,X3 -> FCB.ANY CAREFUL UPDATING THAT 3SK2 # HAS TO BE DONE HAS BEEN DONE. 3T4L # IF BIT 5 OF AWORK2 IS SET THE USAGE BLOCK IS NOT READ DOWN AS WO 3TJ= # ARE EXTENDING THE FCB. 3W3W # 3WHG # X7 IS USED AS A SUBSIDIARY CALLING ACCUMULATOR,X5 CONTAINS THE 3X36 # B.S. PREFIX IF(A)THEEFILEEISSCAREFULL&(B)THE BIT FOR THE BLOCK IS 3XGQ # NOT SET. O/W IT IS ZERO 3Y2B # 3YG2 # WE EMPLOY A STANDARD LOCKOUT MECHANISM USING B0 &B12 OF FCOMM 3Y^L # AND W.S. #113 TO KEEP EVERYONE OUT WHEN WE DO THEY CAREFUL UPDAT- 3^F= # ING. 3^YW # 42DG # ON ENTRY X3 ->FFCB,X2->>FFCA. 42Y6 # 43CQ SBX 6 FX1 43XB LDN 5 0 [SWITCH 44C2 JBC NOTCAREF,3,BFCARE [J IF NOT A CAREFUL FILE. 44WL THRUAGEN 45B= LDX 4 2 [FCA 45TW LDX 0 FBLMOD(3) 46*G SBN 0 FBLKS-A1 [LAST BLOCK BIT(MAY BE UNUSED ONE @ 46T6 MAPBCH 0,3 [END,IF B5 AWORK2 SET) 47#Q LDX 2 4 47SB BNZ 0 NOTCAREF [J IF BIT SET FOR THIS BLOCK. 48#2 BS 3,BFAPPCARE [SET 'APPEND DOING CAREFUL UPDATING' 48RL JBC NEWFULLB,3,BFALTB [IF 'BLOCK NOS. ALTERED' BIT IS UNSET 49?= [WE CREATE A NEW FULLB. J IF SO. 49QW CALL 7 SEEKFULLB [LOOK FOR FULLB 4==G BRN NEWFULLB [J IF NONE 4=Q6 LDX 4 ALOGLEN(1) 4?9Q ADN 4 1 [LENGTHEN BY 1 4?PB LDX 3 1 4#92 ALTLEN 3,4 4#NL CALL 7 SFSTACK [X2 -> FCA 4*8= PSTAC 1,2 4*MW BFCBX 3,1 4B7G CALL 7 SEEKFULLB [X1 -> FULLB 4CLB CALL 6 ZGEOERR [NO FULLB! 4D62 BRN TNEXTBL 4DKL NEWFULLB 4F5= SETNCORE 3,3,BSTB,FULLB [SET UP FULLB 4FJW LDN 0 2 4G4G STO 0 A1(3) [R.HEADER 4GJ6 CALL 7 SFSTACK [X2 -> FCA 4H3Q STO 2 4 [PRESERVE 4HHB PSTAC 2,2 [X2 -> FSTACK 4J32 SLPNF 4MY2 LDX 2 FPTR(2) [NEXT BLOCK 4NCL LDX 0 ATYPE(2) 4NX= #SKI K6APPEND 4PBW ( 4PWG BXE 0 FILEPLUSFCB,ZGEOER4 4QB6 BXU 2 CXFI,XOK 4QTQ ZGEOER4 4R*B CALL 6 ZGEOERR [NO FMAPP 4RT2 XOK 4S#L ) 4SS= SMO FX1 4T?W BXU 0 SFMAP,SLPNF [J BACK IF NOT YET UP TO FMAPP 4W?6 CHAIN 3,2 [CHAIN BLOCK IN. 4WQQ LDX 1 3 [-> FULLB 4X=B LDX 2 4 [-> FCA 4XQ2 PSTAC 3,2 4Y9L BFCBX 3,3 [-> FCB 4YP= TNEXTBL 4^8W LDX 5 BSPRE(3) 4^NG STO 5 A1+1(1) [STORE IN FULLB 5286 CALL 7 SGETBAC [GET NEW BLOCK NO. 52MQ [N.B. X4 CONTAINS BLOCK NO. - WELL, 537B [SOMEWHERE TO KEEP IT- BUT MUST REMEM 53M2 NOTCAREF [BER TO CHANGE IT IF NECESSARY AFTER 546L PSTAC 1,2 [->FSTACK] [A COORDINATION. 54L= SMO FBLMOD(3) 555W LDX 7 A1-1(3) [B.N.OF USAGE BLOCK. 55KG CALL 0 SFUB [X1->USAGE BLOCK. 5656 BRN NOFURBX [J IF NONE. 56JQ YGOTBLOC 574B NAME 1,FILE,FUWB [ENSURE BLOCK GETS BACKWRITTEN. 57J2 BZE 5 SEXIT [IF NOT CAREFUL,OR IF BIT IN FUAPP 583L BXE 5 BSPRE(3),NOFREEBB [BLOCK WAS SET,GO TO EXIT 58H= CALL 7 SFREGBAC [CHECK B.S.PREFIX & IF NECESSARYYFREE 592W BRN NOTCAREF [BLOCK NUMBER & GET ANOTHER.... 59GG NOGETBL 5=26 BZE 5 SEXIT 5=FQ BRN UPDFCB 5=^B NOFREEBB [UPDATE FURB 5?F2 STO 5 BACK1(1) [B.S.PREFIX 5?YL STO 4 BACK2(1) [BLOCK NO. 5#D= UPDFCB [UPDATE FCB & FULLB 5#XW SMO FBLMOD(3) 5*CG LDX 5 A1-1(3) [OLD B.N. 5*X6 SMO FBLMOD(3) 5BBQ STO 4 A1-1(3) [STORE NEW ONE 5BWB STO 1 4 [-> USAGE BL 5CB2 [IF THERE IS ONE 5CTL CALL 7 SEEKFULLB [SET X1 -> FULLB 5D*= CALL 6 ZGEOERR [NO FULLB! 5DSW LDN 0 1 5F#G ADS 0 A1(1) [UPDATE R.H. 5FS6 SMO A1(1) 5G?Q STO 5 A1-1(1) [STORE OLD B.N. 5GRB LDX 0 FBLMOD(3) 5H?2 SBN 0 FBLKS-A1 5HQL STO 2 7 [FCA 5J== MAPBSE 0,3 [AT LAST WE CAN SET THE BIT 5JPW LDX 2 7 5K9G MBS 3,BFALTR,BFALTB [SET 'FILE AND BLOCK NOS. ALTERED' BI 5KP6 JBC NOFON113,3,BFCAREW [J IF NOONE WAITING FOR UPDATE TO FIN 5L8Q FON #113 5LNB LDX 2 7 [FCA 5M82 NOFON113 5MML MBC 3,BFAPPCARE,BFCAREW [UNSET 'DOING CAREFUL UPDATING' BIT A 5N7= [UNSET 'WAITING' BIT,IF SET. 5NLW LDX 1 4 [->FXRB ,IF THERE IS ONE 5P6G SEXIT 5PL6 ADX 6 FX1 5Q5Q EXIT 6 0 5QKB # X1 -> FURB (UNLESS R5 SET IN WHICH CASE IT'S RUBBISH 5R52 # X2 -> FCA, X3 -> FCB,X4,5,6,7 & AWORK4 OVERWRITTEN 5RJL # 5S4= NOFURBX [NO USAGE BLOCK,GET ONE 5SHW LDCT 0 #10 ["LENGTHENING FCB BLOCK"BIT 5T3G SMO FX2 5TH6 ANDX 0 AWORK2 [DON'T TRY TO READ DOWN BLOCK IF 5W2Q BNZ 0 NOGETBL [CURRENTLY UNUSED. 5WGB JBC NOGOL,3,BFLAST [J IF NOONE HAS GONE FOR LAST BLOCK. 5X22 BS 3,BFLASTW [SET 'WAITING FOR LAST BLOCK' BIT. 5XFL #SKI K6APPEND>199-199 5X^= TRACE FX2,AWT STY4 5YDW COOR3 #4 5YYG #SKI K6APPEND>199-199 5^D6 TRACE FX2,ARELSTY4 5^XQ CALL 7 SFSTACK 62CB PSTAC 3,2 62X2 BFCBX 3,3 6348 ... LDN 0 FBLKS-A1 639B ... BXE 0 FBLMOD(3),ZEMPT 63BL BRN NOTCAREF 63W= NOGOL 64*W VARIADNR 3 64TG LDX 7 FBLMOD(3) 65*6 ADN 7 A1-1 65SQ LDX 2 FX2 66#B ERX 6 AWORK3(2) [SWAP X6 & AWORK3 WVER 66S2 ERS 6 AWORK3(2) [[SO X6=DEPTH 67?L ERX 6 AWORK3(2) 67R= BS 3,BFLAST [SET 'GETTING LAST BLOCK' BIT. 6834 ... FILEREAD 6,FAIL,,7 68QG ERX 6 AWORK3(2) [SWAP X6 & AWORK3 OVER AGAIN 69=6 ERS 6 AWORK3(2) 69PQ ERX 6 AWORK3(2) 6=9B ADDSKIP I516A,APRD 6=P2 MHUNT 1,BSTB,BREAD 6?8L CALL 7 SFSTACK [X2 ] -> FCA 6?N= STO 2 7 [X7 ] 6#7W PSTAC 2,2 6#?2 ... BFCBX 3,2 [X3 -> FCB 6#B6 ... SMO FBLMOD(3) 6#F= ... LDX 0 A1-1(3) 6#JB ... STO 0 BACK2(1) [BLOCKNO OF LAST BLOCK 6#MG CHAIN 1,2 [CHAIN FURB IN 6*76 LDX 2 7 [-> FCA 6*LQ PSTAC 1,2 [-> FSTACK 6BL2 JBC NOFON,3,BFLASTW [J IF NOONE WAITING FOR LAST BLOCK. 6C5L FON 4 [FON WAITERS 6CK= CALL 7 SFSTACK [X2->FCA 6D4W PSTAC 1,2 [X1->FSTACK 6DJG NOFON 6F46 MBC 3,BFLAST,BFLASTW [UNSET 'GETTING LAST BLOCK' BIT AND 6FHQ [UNSET 'WAITING' BIT,IF SET. 6G3B LDX 1 FPTR(1) [X1 ->FURB. 6GH2 BRN YGOTBLOC 6H2L # 6HG= # 6H^W # 6JFG [ENTRY FROM STEP 6J^6 STEPBREAK [STEP PLUS BREAKIN PARAMETER 6KDQ LDCT 0 #400 6KYB BRN XLOBS3 6LD2 STEPANS [STEP PLUS ANSWER PARAMETER 6LXL LDCT 0 #200 6MC= BRN XLOBS3 6MWW STEPFORCE [STEP PLUS FORCED PARAMETER 6NBG LDCT 0 #100 6NW6 BRN XLOBS3 6P*Q SSTEP [STEP. NO 3RD PARAMETER. 6PTB LDN 0 0 6Q*2 XLOBS3 6QSL STO 0 ACOMMUNE1(2) 6R#= [ON ENTRY FROM STEP X3 CONTAINS - B0 TO B8 FILE DEPTH 6RRW [ - B9 TO B23 RECORD LENGTH TO BE APPENDED 6S?G LDX 6 3 6SR6 SRA 6 15 [PICK UP LEVEL PARAMETER IN X6 6T=Q ANDN 3 #777 [PUT LENGTH OF RECORD TO BE APPENDED 6TQB STO 3 AWORK2(2) [IN AWORK2 6W=2 ADDSKIP I516A,K2AP 6WPL BRN PARAPOINT 6X9= [ENTRY WHEN TRYING TO APPEND A RECORD TO THE TOP FILE OPEN 6XNW ZAPPBREAK [ZERO DEPTH PLUS BREAKIN PARAMETER. 6Y8G LDCT 0 #400 6YN6 BRN XLOBS1 6^7Q ZAPPANS [ZERO DEPTH PLUS ANSWER PARAMETER. 6^MB LDCT 0 #200 7272 BRN XLOBS1 72LL ZAPPFORCE [ZERO DEPTH PLUS FORCED PARAMETER. 736= LDCT 0 #100 73KW BRN XLOBS1 745G ZAPP [ZERO DEPTH. NO 2ND. PARAMETER. 74K6 LDN 0 0 754Q XLOBS1 75JB STO 0 ACOMMUNE1(2) 7642 LDN 6 0 [GIVE LEVEL PARAMETER ZERO 76HL BRN TOPAPP 773= [ENTRY WHEN TRYING TO APPEND TO FILE OPEN AT LEVEL %A 77GW NAPPBREAK [N/Z DEPTH PLUS BREAKIN PARAMETER 782G LDCT 0 #400 78G6 BRN XLOBS2 78^Q NAPPANS [N/Z DEPTH PLUS ANSWER PARAMETER 79FB LDCT 0 #200 79^2 BRN XLOBS2 7=DL NAPPFORCE [N/Z DEPTH PLUS FORCED PARAMETER 7=Y= LDCT 0 #100 7?CW BRN XLOBS2 7?XG NAPP [N/Z DEPTH. NO 2ND. PARAMETER 7#C6 LDN 0 0 7#WQ XLOBS2 7*BB STO 0 ACOMMUNE1(2) 7*W2 LDX 6 ACOMMUNE7(2) 7B*L SRA 6 15 7BT= TOPAPP 7C#W STOZ AWORK2(2) 7CSG ADDSKIP I516A,IAPPE 7D#6 PARA 7DRQ PARAPOINT 7F?B SKIPTRACE 599,6,ALEVEL 7FR2 FILENUMB 4 [X4 = NO. FILES OPEN 7G=L BPZ 6 POSLV [J IF DEPTH POSITIVE 7GQ= ADX 6 4 [IF NEGATIVE ADD NO OF FILES OPEN 7H9W #SKI K6APPEND 7HPG ( 7J96 BPZ 6 NOWP1 [ERROR IF STILL <0 7JNQ NOTENUF 7K8B CALL 6 ZGEOERR [NOPENAPP 7KN2 ) 7L7L POSLV 7LM= #SKI K6APPEND 7M6W BXGE 6 4,NOTENUF 7MLG NOWP1 7N66 STO 6 AWORK3(2) [STORE DEPTH. 7NKQ CALL 7 SFSTACK [X2 -> FCA 7P5B PSTAC 1,2 [X1 -> FSTACK 7PK2 #SKI K6APPEND 7Q4L ( 7QJ= JMBS XAPP,2,BAMAPP,BAMGEN [CHECK FILE OPEN IN APPEND OR 7R3W [GENERAL MODE. 7RHG CALL 6 ZGEOERR [CAN'TAPP 7S36 ) 7SGQ XAPP 7T2B BFCBX 3,1 [X3 -> FCB 7TG2 XMULT 7T^L JBC XLOCK,3,BFAPP [J IF NOONE APPENDING TO FILE. 7WF= BS 3,BFAPPW [SET 'WAITING FOR APPENDER TO FINISH' 7WYW [BIT AND WAIT. 7XDG COOR4 #131 [FINISH" BIT AND WAIT. 7XY6 CALL 7 SFSTACK 7YCQ PSTAC 1,2 7YXB BFCBX 3,1 7^C2 BRN XMULT 7^WL XLOCK 82B= BS 3,BFAPP [SET 'APPEND BEING DONE' BIT. 82TW SMO FX2 83*G LDEX 0 AWORK2 83T6 BNZ 0 NOTINDEX [J IF STEP(APPEND) 84#Q LDN 0 #77 [B18-23 OF FINFC NON-ZERO, 84SB ANDX 0 FINFC(3) [IMPLIES INDEXED FILE. 85#2 BZE 0 NOTINDEX [ERROR IF SO 85RL CALL 6 ZGEOERR [INDEXED! 86?= NOTINDEX 86QW BS 2,BAAPP [SET BIT TO INDICATE 'AN APPEND HAS 87=G [BEEN DONE ON FILE'. 87Q6 XCALC 889Q LDN 0 FBLKS-A1 88PB BXE 0 FBLMOD(3),ZEMPT [J IF FILE EMPTY. 8992 CALL 6 SCAREGETB [GET BLOCK + CAREFULL UPDATING IF 89NL [NECESSARY 8=8= LDX 5 CMOD(3) 8=MW BPZ 5 ONEMOREC [J IF APPEND MODIFIER NOT NEGATIVE 8?7G LDN 5 A1 8?M6 LDN 0 0 8#6Q NOTZERO 8#LB SMO FX2 [STORE FOR END [IN CASE READ PTRS 8*62 STO 5 AWORK1 [NEED ADJUSTING 8*KL SCHDUM 8B5= ADX 5 0 [RECORD IN USAGE BLOCK 8BJW SMO 5 8C4G LDX 0 FRH(1) [NEXT R.H. 8CJ6 NDUM 8D3Q BZE 0 UPDATE [J IF END OF BLOCK 8DHB BPZ 0 NOTZERO [J IF NOT DUMMY 8F32 LDCT 7 #100 [THE "UNAPPENDED RECORD BIT" 8FGL ANDX 7 0 [IT IS EQUIVALENT TO END OF FILE,BUT 8G2= BNZ 7 UPDATE [WE WANT TO OVERWRITE IT 8GFW LDEX 0 0 [BOTTOM 9 BITS 8G^G BRN SCHDUM 8HF6 UPDATE 8HYQ SMO FX2 [MUST UPDATE CMOD HERE SO NOT FOUND 8JDB LDX 0 AWORK1 [TO BE NEGATIVE AFTER COORDINATION 8JY2 STO 0 CMOD(3) [IN FDRMAUTO LATER ON. 8KCL BRN NOTHERE 8KX= ONEMOREC 8LBW SMO FX2 [STORE FOR END. 8LWG STO 5 AWORK1 8MB6 SMO 5 8MTQ LDX 0 FRH(1) [PICK UP RECORD HEADER OF LAST RECORD 8N*B LDCT 7 #100 8NT2 ANDX 7 0 8P#L BNZ 7 NOTHERE [J IF THIS IS AN UNAPPENDED RECORD. 8PS= LDEX 0 0 8Q?W ADX 5 0 8QRG NOTHERE 8R?6 #SKI K6APPEND 8RQQ ( 8S=B BXL 5 BSBSA1,RECGOOD [CHECK WORD POINTER DOES NOT POINT 8SQ2 CALL 6 ZGEOERR [DIR MESS 8T9L ) 8TP= RECGOOD 8W8W SMO FX2 8WNG LDEX 7 AWORK2 8X86 BNZ 7 STEP [J IF STEP 8XMQ NST 8Y7B MHUNTW 2,FILE,FAPB [MANDATORY HUNT FOR FAPB 8YM2 LDEX 7 A1(2) [PICK UP LENGTH OF REC TO BE APPENDED 8^6L STEP 8^L= #SKI K6APPEND 925W ( 92KG BNG 7 WRONGLTH [ERROR IF RECORD LENGTH IS NEGATIVE 9356 BZE 7 WRONGLTH [OR ZERO 93JQ BXL 7 BSBS,OKLTH [J IF REC HEADER LESS THAN BSBS 944B WRONGLTH 94J2 CALL 6 ZGEOERR [FAPBRECHD 953L ) 95H= OKLTH 962W LDX 0 5 [REC LENGTH IN BLOCK ALREADY 96GG ADX 0 7 [ADD NEW RECORD LENGTH 9726 BXGE 0 BSBSA1,NOTFIT [J IF NEW REC WON'T FIT IN BLOCK 97FQ MOVEREC 97^B LDX 0 FCOMMCT(3) 98F2 BZE 0 NOTCOMF [J IF NOT COMMUNALLY OPENED 98YL STO 1 6 [STORE PTRS TO FUWB AND FAPB SOTHAT 99D= STO 2 4 [IF FDRMAUTO DOESN'T COORDINATE,WE 99XW [DONT NEED TO REHUNT THE BLOCKS. 9=CG FDRMAUTO STEPWAIT,XGETPTRS [AUTO ALL 'SUSIN'-ERS. J IF NONE. 9=X6 CALL 7 SFSTACK [X2 _ FCA 9?BQ PSTAC 1,2 9?WB BFCBX 3,1 9#B2 LDX 0 CMOD(3) 9#TL SMO FX2 9**= BXU 0 AWORK1,XCALC [CMOD MAY HAVE CHANGED DUE TO 9*SW CALL 6 SCAREGETB [DESTRUCTIVE READERS. 9B#G SMO CMOD(3) 9BS6 LDEX 5 FRH(1) [RECALCULATE CMOD 9C?Q ADX 5 CMOD(3) 9CRB NOTCOMF 9D?2 SMO FX2 9DQL LDEX 0 AWORK2 9F== BZE 0 NOTSTEP [J IF NOT STEP 9FPW BRN STEPOUT 9G9G STEPOUTA 9GP6 NGS 2 CMOD(3) [CMOD<0 FOR STEP 9H8Q STEPOUT 9HNB SETREP COORED 9J82 BRN NOTOK1 9JML XGETPTRS 9K7= LDX 1 6 9KLW LDX 2 4 9L6G BRN NOTCOMF 9LL6 NOTSTEP 9M5Q STO 5 CMOD(3) [UPDATE CMOD 9MKB MHUNT 2,FILE,FAPB 9N52 LDEX 7 A1+FRH(2) [GICK UP R.H.OF APPENDEE 9NJL LDX 4 7 [PUT REC.LENGTH IN X4 9P4= LDN 7 A1(2) [X7 -> BEGINNING OF REC IN FAPB 9PHW SMO 5 9Q3G LDN 0 FRH(1) [X0 -> WHERE REC APPENDED TO. 9QH6 SMO 4 9R2Q MOVE 7 0 [MOVE RECORD ACROSS TO FUB 9RGB ADX 5 4 9S22 NAME 1,FILE,FUWB [ENSURE THIS IS FUWB 9SFL SMO 5 9S^= STOZ 0(1) [APPEND ZERO REC @ END OF NEW REC 9TDW SMO FX1 9TYG LDX 0 MCOMCOM 9WD6 ANDX 0 COMM(3) 9WXQ BZE 0 NOWTAPP [J IF NO ACT WAITING FOR REC TO BE 9XCB [APPENDED 9XX2 ERS 0 COMM(3) [REMOVE WAITING BIT 9YBL #SKI K6APPEND>159-159 9YW= TRACEVER FBLMOD(3),FON 5 9^*W LONGON 5,BACK2(3) [RELFASE ACTIVITIES WAITING FOR THIS 9^TG [APPEND =2*6 NOWTAPP =2SQ BS 3,BFALTR [SET 'FILE ALTERED' BIT. =3#B CALL 7 SFSTACK [X2 -> FCA =3S2 LDX 0 FBLMOD(3) =4?L ADN 0 A1 [ARE WE POSITIONED ON "SPARE" BL.NO. =4R= SBX 0 FREADBLOCK(2) =5=W BNZ 0 NOTFRIG [J IF NOT =5QG LDX 0 FREADWORD(2) =6=6 LDX 1 CMOD(3) [DEFAULT FOR"HAVE JUST READ EOF" =6PQ BPZ 0 NOTABL [J IF POS'ND "HAVE READ EOF" =79B SMO FX2 [USE OLD CMOD,LEFT BY EARLIER =7P2 LDX 1 AWORK1 [PART OF ROUTINE =88L NOTABL =8N= STO 1 FREADWORD(2) [STORE =97W LDX 0 FBLMOD(3) [UPDATE FREADBLOCK =9MG ADN 0 A1-1 ==76 STO 0 FREADBLOCK(2) ==LQ NOTFRIG =?6B SETREP OK =?L2 NOTOK1 =?R8 ... SMO FX2 =?YB ... STOZ ACOMMUNE2 [CLEAR SUBSIDUARY REPLY WORD =#5L JBS SETREPOK,3,BFDCF [J IF DCF TO SET OK REPLY. =#K= JBS SETREPOK,3,BFGDR [J IF GDR =#P7 ... LDX 5 FINFC(3) [ INDEXED IF BTM 6 BITS #0 =#T4 ... ANDN 5 #77 =#Y^ ... BZE 5 NOTINXF [ J - IF NOT INDEXED =*4W ... DOWN INDEX,8 [ CHECK FNEARLY FOR INDEXED FILES =*8R ... CALL 7 SFSTACK [ I.E. 4*FNEARLY !!!!, X2 -> FCA =*#N ... PSTAC 3,2 =*DK ... BFCBX 3,3 [ X3 -> FCB =*JG ... BRN SETREPOK =*KR ... SEGENTRY FNYBLCK [RESTORE TIME MACRO FNYLIST =*M4 ... +0 =*NC ...NOTINXF =*QT ... SEGENTRY K98APPEND [RESTORE MACRO FNYLIST =*T? ... BRN NORM2 =*XP ... [OVERWRITTEN BY FNYLIST =B27 ... SMO FX1 =B4K ... NGX 0 FNYBLCK =B73 ... ADX 0 FSIZE(3) =B9F ... SBX 0 FBLMOD(3) =B?Y ... ADN 0 AF2-A1 [ TEST FNEARLY FOR NON-INDEXED =BHQ ... BPZ 0 SETREPOK =BMM ... SREP FNEARLY2 [SETREP IF WITHIN CHOSEN LIMIT OF END =BRJ ...NORM2 =BXF ... LDX 0 FBLMOD(3) =C3B ... SBN 0 AF2-A1-FNEARLY [TEST FNEARLY FOR NON-INDEXED FILES =C7? ... SBX 0 FSIZE(3) [ARE WE NEARLY FULL =C?8 ... BNG 0 SETREPOK =CC5 ... SETREP FNEARLY [SETREP FNEARLY IF FILE NEARLY FULL =CH2 SETREPOK =D2L STOZ 6 =DG= BRN NOBRK =D^W XBRK =FFG CALL 7 SFSTACK =F^6 PSTAC 1,2 =GDQ BFCBX 3,1 =GYB NGN 6 1 =HD2 NOBRK =HXL JBC NFON,3,BFAPPW [J IF NOONE WAITING FOR APPEND TO FIN =JC= FON #131 [FON WAITERS =JWW NFON =KBG MBC 3,BFAPP,BFAPPW [UNSET 'APPEND BEING DONE' BIT AND =KW6 [UNSET 'WAITING' BIT,IF SET. =L*Q BNG 6 XBRK1 [J IF BREAKIN =LTB LDX 2 FX2 =M*2 LDEX 0 AWORK2(2) =MSL BZE 0 UP1 [J IF NOT STEP =N#= TESTREP2 GLUTTON,UP2 =NRW TESTRPN2 REFUSED,UP1 =P?G UP2 =PR6 UPPLUS 2 [EXIT PAST 2ND STEP CALL =Q=Q UP1 =QQB UPPLUS 1 =R=2 XBRK1 =RPL UP =S9= NOTFIT =SNW # =T8G # THIS SECTION DEALS WITH THE SPENT BLOCK =TN6 # =W7Q SMO 5 [IN CASE IT WAS A "NOT YET APPENDED =WMB STOZ FRH(1) [RECORD & SIZE OF STEP-APPENDEE CHANGE =X72 [SO IT DIDN'T FIT ANYMORE =XLL JBC NODCF,3,BFDCF [J IF NOT A DCF. =Y6= JBS SKCOP,3,BFVSF [J IF VITAL SYSTEM FILE =YKW BRN UFIN [OTHERWISE LEAVE USAGE BLK IN CORE. =^5G NODCF =^K6 JBS UFIN,3,BFCORE [J IF 'LEAVE BLOCKS IN CORE' BIT SET. ?24Q SKCOP ?2JB LDX 4 FBLMOD(3) ?342 ADN 4 A1-1 [PICK UP -> TO LAST BLOCK OF FILE ?3HL LDX 7 4 ?43= SBN 7 1 [X7->LAST BLOCK BUT ONE. ?4GW LDX 2 FPTR(3) [PICK UP POINTER TO FSTACK BLOCK ?52G LDEX 0 ARINGNO(2) [NO OF ELEMENTS IN FSTACK BLOCK ?5G6 SBN 0 1 ?5^Q BZE 0 ONEFCA [J IF ONLY 1 FCA IN FSTACK ?6FB ADN 0 1 ?6^2 ADN 2 A1 [X2-> FIRST RING ELEMENT ?7DL STACKLOOK ?7Y= SKIPTRACE 999,4,STACKLUK ?8CW BXE 4 FREADBLOCK(2),ZEMPT [J IF SOMEONE USING USAGE BLOCK ?8XG BXE 7 FREADBLOCK(2),ZEMPT [OR PREVIOUS USAGE BLOCK. ?9C6 ADN 2 FELLEN ?9WQ BCT 0 STACKLOOK [J IF MORE RING ELEMENTS TO LOOK AT ?=BB ONEFCA ?=W2 LDX 0 ATYPE(1) ??*L SRL 0 12 ??T= SBN 0 FILE+FUWB ?##W BZE 0 UWRITE [J IF USAGE WRITE BLOCK ?#SG SKIPTRACE 999,1,FRE APP ?*#6 ADDSKIP I516A,APFR ?*RQ FREECORE 1 [FREE THE FRB ?B?B BRN UFIN ?BR2 UWRITE ?C=L SKIPTRACE 599,BACK2(1),BLNUM ?CQ= CHAIN 1,FX2 ?D9W ADDSKIP I516A,APWR ?DPG LDX 2 FX2 ?F96 LDX 6 AWORK3(2) [FILE DEPTH ?FNQ LDX 7 FBLMOD(3) ?G8B ADN 7 A1-1 ?GN2 VARIADNW 3 ?H7L FILEAUTW 6,FAIL+FREE,,7 ?HM= UFIN ?J6W CALL 7 SFSTACK [X2 -> FCA ?JLG PSTAC 1,2 [X1 -> FSTACK ?K66 BFCBX 3,1 [X3 -> FCB ?KKQ # ?L5B # THIS SECTION CHECKS FOR FILEFULL-& IF FILEFULL&DC GOES TO A ?LK2 # WAITING ROUTINE. OTHERWISE IT EXTENDS THE FCB -EITHER BY USING ?M4L # A SPARE BLOCK @ THE END OF THE BLOCKLIST OR BY GETTING A NEW ?MJ= # BLOCK IF THERE ISN'T A SPARE ONE. ?N3W # ?NHG ZEMPT ?P36 LDX 0 FBLMOD(3) [LENGTH OF FCB BEING USED. ?PGQ SBN 0 FBLKS-A1 [NO OF BLOX IN FILE BEING USED ?Q2B BXGE 0 FSIZE(3),YESFULL [J IF FILE FULL. IN SOME D.C.FILE ?QG2 [CASES IT IS POSSIBLE FOR THE FILE ?Q^L [TO START OFF LARGER THAN ITS "MAX- ?RF= [IMUM SIZE"AS GIVEN BY[FSIZE] ?RYW [ ?SDG WAITCOMM [RE-ENTRY FROM COMMFILE AFTER WAITING ?SY6 [FOR BLOCK TO BE FREED. ?TCQ [ ?TXB CALL 7 SFSTACK [X2->FCA ?WC2 LDX 1 2 ?WWL LDX 2 FX2 ?XB= LDX 6 AWORK3(2) [DEPTH ?XTW APPCUBS XBRK,1 [ARE WE ALLOWED ANY MORE BLOCKS? ?Y*G CALL 7 SFSTACK ?YT6 PSTAC 1,2 ?^#Q BFCBX 3,1 ?^SB TESTREPN OK,SETREPOK [J IF NOT. #2#2 LDX 4 FBLMOD(3) #2RL BXGE 4 FUSEBL(3),NEWFCB #3?= # WE HAVE TO BE VERY CAREFUL OF WHEN WE UPDATE FBLMOD,AS READFILE #3QW # USES IT AS WELL,SO WE HAVE TO LOCK OUT OTHER(COMMUNAL) READERS #4=G # AND APPENDERS IF WE COORDINATE AFTER UPDATING FBLMOD BUT BEFORE #4Q6 # ACTUALLY APPENDING ANYTHING. #59Q # #5PB ADN 4 1 [ADD ONE TO LENGTH OF USED #692 STO 4 FBLMOD(3) [EXTEND FBLMOD #6NL # THIS MEANS WE HAVE TO SET "GONE FOR LAST BLOCK BIT " WHEN WE #78= # SET UP THE CORE USAGE BLOCK,TO PREVENT ANOTHER APPENDER LEAPING #7MW # IN & TRYING TO READ DOWN THE (SPURIOUS) LAST BLOCK. #87G LDCT 0 #10 [SET "DON'T READ DOWN USAGE BLOCK"BIT #8M6 SMO FX2 #96Q ORS 0 AWORK2 #9LB CALL 6 SCAREGETB [DO CAREFUL UPDATING ON BLOCK #=62 MBS 3,BFALTR,BFALTB [SET 'FILE AND BLOCK NOS. ALTERED' BI #=KL BRN UPFCB #?5= NEWFCB #?JW MBS 3,BFALTR,BFALTB,BFNEW [SET 'FILE AND BLK NOS. ALTERED' ##4G [BITS AND 'GONE FOR NEW BLK' BIT. ##J6 JBC NMBIN,3,BFCARE [J IF FILE NOT CAREFUL #*3Q LDX 0 FBLMOD(3) [SET A BIT AFTER LAST ONE IN FCB #*HB SBN 0 FBLKS-A1-1 #B32 SMO FX2 #BGL LDX 6 AWORK3 [DEPTH #C2= MAPBIN 0,6 #CFW CALL 7 SFSTACK #C^G PSTAC 2,2 #DF6 BFCBX 3,2 #DYQ NMBIN #FDB LDX 4 ALOGLEN(3) #FY2 ADN 4 1 #GCL ALTLEN 3,4 [ADD ONE TO LENGTH OF CFB #GX= CALL 7 SFSTACK [X2-> FCA #HBW PSTAC 1,2 [X1->STACK #HWG BFCBX 3,1 [X3->FCB #JB6 LDX 5 BSPRE(3) #JTQ CALL 7 SGETBAC [GET A BLOCK NUMBER #K*B BC 3,BFNEW [UNSET 'GETTING NEW BLOCK' BIT. #KH9 ... SMO FUSEBL(3) [STORE NEW B.N. AT END OF BLOCK LIST. #KP4 ... STO 4 A1(3) [NB FUSEBL USED NOT FBLMOD IN CASE TH #KWX ... [ARE NOW 'OUT OF STEP' SINCE A #L4Q ... [DESTRUCTIVE READER MAY HAVE #L=K ... [RESHUFFLED BLOCK NOS AND DECREMENTED #LDD ... [FBLMOD WHILE APPEND COORDINATING. #LL? ... [DURING ALTLEN OR GETBACK. SEE BUG NO #LS= # SEE NOTE @ "NOTFULL" #M?W LDN 0 1 #MRG ADS 0 FBLMOD(3) [EXTEND BLOCK. #N?6 ADS 0 FUSEBL(3) #NQQ UPFCB #P=B SMO FBLMOD(3) [ LAST BLOCK NUMBER #PQ2 LDX 7 A1-1(3) #Q9L PSTAC 1,2 #QP= CALL 0 SFUB [FOR D.C. FILES BLOCK MAY STILL BE #R8W BRN MUSTGETC [IN CORE. J IF NOT. #RNG CHAIN 1,FPTR(3) [CHAIN ENXT TO THE FSTACK #S86 BRN SETCMOD #SMQ MUSTGETC #T7B BS 3,BFLAST [SET 'GONE FOR LAST BLOCK' BIT. #TM2 [SEE COMMENT ABOVE. #W6L GETCORE BSBS,1 [GET CORE FOR USAGE BLOCK #WL= MHUNT 1,GCB #X5W CALL 7 SFSTACK [X2 -> FCA #XKG PSTAC 3 ,2 [X3 -> FSTACK #Y56 CHAIN 1,3 [CHAIN FUWB AFTER FSTACK BLOCK #YJQ BFCBX 3,3 [X3 -> FCB #^4B JBC NOFONN4,3,BFLASTW [J IF NOONE WAITING FOR LAST BLOC #^J2 FON 4 [FON WAITERS *23L NOFONN4 *2H= MBC 3,BFLAST,BFLASTW [UNSET 'GETTING LAST BLOCK' BIT AND *32W [UNSET 'WAITING' BIT,IF SET. *3GG LDX 0 BSPRE(3) *426 LDX 2 FPTR(3) [-> FSTACK *4FQ LDX 2 FPTR(2) [-> FURB *4^B STO 0 BACK1(2) *5F2 SMO FBLMOD(3) [UPDATE B.S HOME OF USAGE BLOCK. *5YL LDX 0 A1-1(3) *6D= STO 0 BACK2(2) *6XW SETCMOD *7CG LDX 1 FPTR(3) [X1 -> FSTACK BLOCK *7X6 LDX 1 FPTR(1) [X1 -> FUWB *8BQ NOWTNK *8WB NAME 1,FILE,FUWB *9B2 STOZ A1(1) [ZEROISE R.H OF FAPB *9TL SMO FX2 *=*= LDEX 0 AWORK2 *=SW BNZ 0 STEPOUTA [J IF STEP(APPEND) *?#G LDN 5 A1 *?S6 STO 5 CMOD(3) [UPATE CMOD *#?Q MHUNT 2,FILE,FAPB *#RB LDEX 7 A1(2) [LENGTH OF REC TO BE APPENDED **?2 BRN NOTSTEP **QL YESFULL *B== [ *BPW [ *C9G [THIS SECTION DEALS WITH THE PROCEEDURE WHEN FILE IS FULL *CP6 [ *D8Q [ *DNB JBS SDESTWT,3,BFDCF [J IF DEST. COMM. FILE *F82 JBC XFULL,3,BFGDR [J IF NOT G.D.R. *FML ... LDX 0 FCOMMCT(3) *G7= ... BZE 0 XFULL [J IF NOT COMMUNALLY OPEN *GLW LDN 0 #7777 *H6G ANDX 0 CTOPEN(3) [ANY COMMUNAL READERS? *HL6 BNZ 0 SDESTWT [J IF SO. *J5Q XFULL *JKB #SKI K6APPEND>99-99 *K52 TRACE FLOC1(3),FILEFULL *KJL SETREP FILEFULL *KQW ... LDX 0 FINFC(3) *K^6 ... ANDN 0 #77 *L7B ... BZE 0 SETREPOK *L*L ... CALL 6 ZGEOERR [ INDEXED FILE FULL *LHW SDESTWT *M3G #SKI K6APPEND>99-99 *MH6 TRACE FLOC1(3),DEST AWT *N2Q #SKI K6APPEND>159-159 *NGB TRACEVER FSIZE(3),APP WT1 *P22 LDX 2 FX2 *PFL LDX 0 AWORK3(2) *P^= STO 0 ACOMMUNE2(2) [FILE DEPTH *QDW ACROSS COMMFILE,3 [WAIT FOR BLOCK TO BE FREED *RD6 #END ^^^^ ...30776730000600000000