{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: APPEND864)}}
====== APPEND864 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ADDSKIP|ADDSKIP]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:APPCUBS|APPCUBS]], [[george:macro:APPEND|APPEND]], [[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:COOR4|COOR4]], [[george:macro:DOWN|DOWN]], [[george:macro:FDRMAUTO|FDRMAUTO]], [[george:macro:FILEAUTW|FILEAUTW]], [[george:macro:FILENUMB|FILENUMB]], [[george:macro:FILEREAD|FILEREAD]], [[george:macro:FILETRAN|FILETRAN]], [[george:macro:FON|FON]], [[george:macro:FREEBACK|FREEBACK]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETBACK|GETBACK]], [[george:macro:GETCORE|GETCORE]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBS|JMBS]], [[george:macro:LONGON|LONGON]], [[george:macro:MAPBCH|MAPBCH]], [[george:macro:MAPBIN|MAPBIN]], [[george:macro:MAPBSE|MAPBSE]], [[george:macro:MBC|MBC]], [[george:macro:MBS|MBS]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:PSTAC|PSTAC]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SFMAP|SFMAP]], [[george:macro:SFSTACK|SFSTACK]], [[george:macro:SFUB|SFUB]], [[george:macro:SKIPTRACE|SKIPTRACE]], [[george:macro:SREP|SREP]], [[george:macro:STEP|STEP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TRACE|TRACE]], [[george:macro:TRACEVER|TRACEVER]], [[george:macro:UP|UP]], [[george:macro:UPDATE|UPDATE]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:VARIADNR|VARIADNR]], [[george:macro:VARIADNW|VARIADNW]]
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