(George Source)
Macros used: ACROSS, BFCBX, BLOCK, BXE, BXU, CHAIN, DOWN, FREECORE, GEOERR, MENDAREA, MHUNTW, NAME, PSTAC, SEGENTRY, SETNCORE, SETREP, SFSTACK, TESTREP, TRACE, UP
22FL #SEG INSERTFR6 [ TONY HAMILTON 22^= #OPT K0INSERTFR=K0INSERT>K0ACCESS>K0FILESTORE>K0ALLGEO 23DW #LIS K0INSERTFR 23YG 8HINSERTFR 24D6 [ 24XQ SEGENTRY K1INSERTFR,X1INSERTFR 25CB SEGENTRY K2INSERTFR,SFULL 25X2 [ 26BL # ERRORS 26W= ZGEOER6 27*W GEOERR 1,MOVEZERO [UNEXPECTED ZERO MOVE IN INSERT 27TG ZGEOER7 28*6 GEOERR 1,STO ZERO [MOVE OR LESS AS ABOVE 28SQ ZGEOER8 29#B GEOERR 1,NO BLOCK [INSERT BLOCK MISSING 29S2 ZGEOER11 2=?L GEOERR 1,ENDBLOCK [INSERT REACHED E.O.B. UNEXPECTEDLY. 2=R= ZGEOER12 2?=W GEOERR 1,V SET! [CMOD UPDATED INCORRECTLY 2?QG # 2#=6 SFI1 2#PQ #HAL FI+INSERT1,0 2*9B SFI2 2*P2 #HAL FI+INSERT2,0 2B8L SFI3 2BN= #HAL FI+INSERT3,0 2C7W SFI4 2CMG #HAL FI+INSERT4,0 2D76 SFI5 2DLQ #HAL FI+INSERT5,0 2F6B # 2FL2 # SUBROUTINES 2G5L # 2GK= SFCB3 [SET X3-> FCB 2H4W SMO FX2 2HJG LDX 0 AWORK2 2J46 SFSTACK 0,3 [X3 -> FCA 2JHQ SMO FX2 2K3B STO 3 ACOMMUNE5 [STORE 2KH2 PSTAC 3,3 2L2L BFCBX 3,3 [X3 -> FCB 2LG= EXIT 6 0 2L^W # 2MFG # 2M^6 SFURB 2NDQ SMO FX2 2NYB LDX 0 AWORK2 [SET X2 - > FSTACK 2PD2 SFSTACK 0,2 [X2 -> FCA 2PXL SMO FX2 2QC= STO 2 ACOMMUNE5 2QWW SFFURB 2RBG PSTAC 2,2 2RW6 BFCBX 2,2 2S*Q BRN SFFULP 2STB SFINDFURB 2T*2 # CALLED BY X1.THE WORD AFTER THE CALL CONTAINS THE TYPE/SUBTYPE 2TSL # WANTED.X3 ->FCB,X2 WILL POINT ON EXIT TO THE BLOCK REQUIRED. 2W#= LDX 2 FPTR(3) [J OVER FSTACK BLOCK 2WRW SFFULP 2X?G LDX 2 FPTR(2) [NEXT BLOCK 2XR6 LDX 0 ATYPE(2) 2Y=Q #SKI K6INSERT 2YQB BXE 0 FILEPLUSFCB,ZGEOER8 [ERROR IF NOT FOUND 2^=2 BXU 0 0(1),SFFULP [J IF WRONG TYPE 2^PL EXIT 1 1 [EXIT ROUND TYPE-WORD 329= # 32NW # 338G # 33N6 SFCA2 347Q SMO FX2 34MB LDX 0 AWORK2 [DEPTH 3572 SFSTACK 0,2 [X2 -> FCA 35LL SMO FX2 366= STO 2 ACOMMUNE5 36KW EXIT 6 0 375G # 37K6 # 384Q # THIS S/R DOES THE CAREFUL UPDATING FOR A NEW BLOCK; A BIT HAS TO 38JB # BE INSERTED IN THE FMAP BLOCK,AND A BLOCK NO. INSERTED IN THE 3942 # FCB 39HL # 3=3= # OVERWRITES X1,X2,X3,X6,X5; X4 POINTS TO BLOCK NO. BEFORE WHICH THE 3=GW # BLOCK IS TO BE INSERTED. IN THE CASE OF NON-CAREFUL FILES,WE 3?2G # CAN USE AN UNUSED BL.NO., IF ANY;O/W WE MUST GET A NEW ONE. 3?G6 # X2 ON EXIT -> USAGE BLOCK 3?^Q SINSERT 3#FB SINSERT1 3#^2 SBX 7 FX1 3*DL DOWN INSERTBL,2 3*Y= TESTREP FILEFULL,SFULL 3BCW ADX 7 FX1 3BXG CALL 1 SFURB 3CC6 #HAL FI+INSERT3,0 3CWQ EXIT 7 0 3DBB # 3DW2 # 3F*L # THIS SEGMENT COPES WITH A RECORD WHICH INVOLVES 2 BLOX OF OVERFLOW 3FT= # 3G#W X1INSERTFR 3GSG NGN 5 1 [SET X5 -VE IF BACKWARD 3H#6 LDCT 0 #40 3HRQ ANDX 0 AWORK1(2) 3J?B BZE 0 NOTFOR [SET X5 +VE IF FORWARD 3JR2 LDN 5 1 3K=L NOTFOR 3KQ= LDCT 0 #14 [IF "EMPTY BLOCK " BITS SET WE DON'T 3L9W ANDX 0 AWORK1(2) [NEED TO SET UP AN INSERT3 BLOCK 3LPG BZE 0 NOTEMPT [THERE IS ALREADY ONE THERE 3M96 CALL 1 SFURB 3MNQ #HAL FI+INSERT3,0 3N8B LDX 3 2 [SET X3 -> INSERT3 BLOCK 3NN2 LDX 2 FX2 3P7L SMO ACOMMUNE5(2) 3PM= LDX 4 FREADBLOCK [PICK UP F'BLOCK 3Q6W BRN MHUNTW 3QLG NOTEMPT 3R66 SETNCORE GSBS,3,FI,INSERT3 [SET UP INSERT2 BLOCK. 3RKQ CALL 6 SFCA2 [X2->FCA 3S5B LDX 4 FREADBLOCK(2) 3SK2 PSTAC 2,2 [RECHA&N NEW BLOCK 3T4L CHAIN 3,2 3TJ= MHUNTW 3W3W MHUNTW 2,FILE,FWB [NEW RECO-D 3WHG LDEX 1 A1+FRH(2) [SI0E OF MOVE 3X36 ADN 2 A1 3XGQ ADN 3 A1 3Y2B #SKI K6INSERT 3YG2 TRACE 1,INTO I3 3Y^L # 3^F= MOVE 2 0(1) [MOVE IN NEW RECORD 3^YW SMO 1 42DG STOZ 0(3) [ZEROISE LAST WORD 42Y6 BNG 5 NFOR1 [WISH TO INSERT A NEW ONE 43CQ ADN 4 1 [=F'WO-D +1 IF FORWARD 43XB NFOR1 44C2 LDCT 0 #14 44WL SMO FX2 45B= ANDX 0 AWORK1 [IF"EMPTY BLOCK" BITS SET,NO NEED TO 45TW BZE 0 NEMPT [INSERT BL.NO.AS ONE ALREADY ALLOCATE 46*G LDX 2 3 [X2 -> INSERT2 46T6 SBN 2 A1 47#Q BRN NAME 47SB NEMPT 47Y? ... LDX 0 BIT9 4848 ... SMO FX2 [SET BIT TO INDICATE TWO NEW BLOCKS 4885 ... ORS 0 AWORK1 [WILL BE NEEDED TO COMPLETE INSERT. 48#2 CALL 7 SINSERT [INSERT BL.NO. 48CX ... LDX 0 BIT9 48HS ... SMO FX2 [CLEAR BIT AS ONLY ONE MORE BLOCK 48MP ... ERS 0 AWORK1 [NEEDED NOW. 48RL NAME 49?= SETNCORE GSBS,3,FI,INSERT3 [SET UP INSERT5 BLOCK 49QW CALL 6 SFCA2 [X2 -> FCA 4==G PSTAC 2,2 4=Q6 CHAIN 3,2 [CHAIN NEW LOCK IN 4?9Q BNG 5 NFOR2 [SIDE OF THE INSERT2 BLOCK FROM THE 4?PB ADN 4 1 [CURRENT BLOCK 4#92 NFOR2 4#NL CALL 7 SINSERT [INSE-T BLOCK NUMBER. 4*8= NAME 2,FI,INSERT5 [RENAME BLOCK. 4*MW STO 2 4 [X4 -> INSERT5 4B7G CALL 6 SFCA2 [X3 -> FCA 4BM6 STO 2 3 4C6Q #SKI INSB 4CLB BNG 5 MOVETOPH [J IF BACKWARDS 4D62 CALL 1 SFURB [X2 -> INERT1 4DKL #HAL FI+INSERT1,0 4F5= SMO FX2 4FJW LDEX 1 AWORK3 [AMT.USED IN INSERT1 BLOCK 4G4G SBX 1 FREADWORD(3) [AMOUNT TO BE MOVED 4GJ6 STOZ 6 4H3Q ADX 2 FREADWORD(3) [X2 -> CURRENT RECORD 4HHB SMO FX2 4J32 LDX 0 AWORK1 4JGL BPZ 0 NREP1 [J IF &NSERT 4K2= LDEX 6 FRH(2) [STEP OVER REPLACEE 4KFW ADX 2 6 [BUT -EMEMBER R.H. 4K^G SBX 1 6 [DOWNDATE AMOUNT TO BE MOVED 4LF6 #SKI K6INSERT 4LYQ BZE 1 ZGEOER6 4MDB NREP1 4MY2 LDX 3 4 4NCL ADN 3 A1 [X3 -> BEGINNING OF DATA IN INSERT5 B 4NX= #SKI K6INSERT 4PBW TRACE 1,INTO I5 4PWG MOVE 2 1(1) [MOVE ACROSS DATA+ZERO WORD 4QB6 SBX 2 6 [DEDUCT SIZE OF REPLACEE(ZERO FOR 4QTQ STOZ 0(2) [INSE-T).NEW E.O.B. ZERO WORD. 4R*B SMO FX2 [X1 -> FCA 4RT2 LDX 1 ACOMMUNE5 4S#L SBX 2 FREADWORD(1) [X2 -> INSERT1 BLOCK 4SS= SBN 3 A1 4T?W UPDATERD 4TRG LDN 0 2 [STEP ON F'BLOCK TO POINT 4W?6 ADS 0 FREADBLOCK(1) [TO INSERTS BBLOCK 4WQQ SMO FX2 4X=B LDX 0 AWORK1 [READ--ECORD PTR <VE IF REPLACE 4XQ2 BNG 0 RDWDNEG 4Y9L LDN 0 A1 [A1 FO- INSERT 4YP= RDWDNEG 4^8W STO 0 FREADWORD(1) [RD.PT-S.NOW RESET 4^NG PSTAC 1,1 5286 BFCBX 1,1 52MQ SETREP OK 537B LDX 0 FBLMOD(1) 53M2 SBX 0 FSIZE(1) 546L ADN 0 FBLKS-A1+FNEARLY 54L= BNG 0 STOK 555W SETREP FNEARLY 55KG STOK 5656 NGS 1 CMOD(1) [CRUDE. 56JQ LDN 0 #77 574B ANDX 0 FINFC(1) 57J2 BZE 0 RENAMEW [J IF NOT INDEXED 583L ACROSS INDEX,4 58H= RENAMEW 592W NAME 2,FILE,FUWB [RENAME USAGE BLOX 59GG NAME 3,FILE,FUWB 5=26 LDX 2 1 [-> FCB 5=FQ CALL 1 SFFULP [GET & RENAME OTHER BLOCK 5=^B #HAL FI+INSERT3,0 5?F2 NAME 2,FILE,FUWB 5?YL UP 5#D= #SKI INSB 5#XW ( 5*CG MOVETOPH 5*X6 #SKI K6INSERT>99-99 5BBQ TRACE 4,MOVETOPH 5BWB LDX 1 FREADWORD(3) [PICK UP FREADWORD 5CB2 STO 2 3 [X3 -> INSERT5 BLOCK 5CTL CALL 1 SFURB [SET X2 -> FI/INSERT1 BLOCK 5D*= #HAL FI+INSERT1,0 5DSW [X5 -> INSERT1 5F#G SBN 1 A1 [X1 = NO OF WORDS TO MOVE 5FS6 #SKI K6INSERT 5G?Q BZE 1 ZGEOER7 [ERROR IF NOTHING GOES TO INSERTS BL. 5GRB ADN 2 A1 5H?2 ADN 3 A1 5HQL MOVE 2 0(1) [MOVE ACROSS TOP HALF OF INSERT1 BL. 5J== SMO 1 5JPW STOZ 0(3) [SET ZERO WORD @ END 5K9G SBN 3 A1 5KP6 NAME 3,FILE,FUWB [RENAME & FORGET INSERTS BLOCK 5L8Q STOZ 4 [SIZE OF REPLA EE,ZERO FOR INSERT, 5LNB [NEE4ED FOR RE ALCULATION OF CMOD,&AL 5M82 LDX 3 2 ["TO " PTR FOR MOVE UP BLOCK 5MML ADX 2 1 ["FROM" PTR FOR INSERT 5N7= SMO FX2 5NLW LDX 0 AWORK1 [FOR REPLACE ADD IN NEXT R.H. 5P6G BPZ 0 SCHENEXRH [J IF &NSERT 5PL6 LDEX 4 FRH(2) [NEXT -.H. 5Q5Q #SKI K6INSERT 5QKB BZE 4 ZGEOER11 [! 5R52 ADX 2 4 5RJL SCHENEXRH 5S4= LDEX 0 FRH(2) [NEXT -.H 5SHW #SKI K6INSERT 5T3G BZE 0 ZGEOER11 [! 5TH6 ADX 4 1 5W2Q SMO FX2 5WGB LDEX 1 AWORK3 [AMT USED IN INSERT1 BLOCK 5X22 SBX 1 4 5XFL SBN 1 A1 [MINUS A1,GIVES AMOUNT LEFT TO MOVE U 5X^= #SKI K6INSERT 5YDW BZE 1 ZGEOER6 5YYG MOVE 2 1(1) [+1 FOR ZERO WORD 5^D6 LDN 0 A1 5^XQ LDX 2 FX2 62CB SMO ACOMMUNE5(2) 62X2 STO 0 FREADWORD 63BL SBN 3 1 63W= NAME 3,FILE,FUWB 64*W LDX 3 ACOMMUNE5(2) 64TG LDX 6 FREADBLOCK(3) [PICK UP 6'WORD 65*6 PSTAC 1,3 65SQ BFCBX 1,1 [X1 -> FCB 66#B SBX 6 FBLMOD(1) 66S2 SBN 6 A1-1 [LAST BLOCK £ 67?L BNZ 6 NOLBLO [J IF NOT 67R= SBS 4 CMOD(1) [XPDATE COMD. 68=W #SKI K6INSERT 68QG BVS ZGEOER12 [?!! 69=6 NOLBLO 69PQ UP 6=9B ) 6=P2 # 6?8L # 6?N= SFULL 6#7W # 6#MG # FILEFULL ENTRY 6*76 # 6*LQ CALL 6 SFCA2 6B6B PSTAC 3,2 6B8^ ... BFCBX 2,3 [X2->FCB 6B?J ... LDX 0 FINFC(2) 6BB7 ... ANDN 0 #77 6BDQ ... BZE 0 SLPP [J IF NOT INDEXED 6BH* ... GEOERR 1,INDXFULL 6BL2 SLPP 6C5L LDX 3 FPTR(3) 6CK= BXE 3 CXFI,SLPN 6D4W LDX 0 ATYPE(3) 6DJG BXE 0 FILEPLUSFCB,SLPN 6F46 ... BXE 0 SFI1(1),RNFUWB 6FHQ BXE 0 SFI2(1),RN 6G3B BXE 0 SFI3(1),RN 6GH2 BXE 0 SFI4(1),RN 6H2L BXE 0 SFI5(1),RN 6HG= BXE 0 FFSFURB,RN 6H^W BXE 0 FFSFUWB,SLPP 6JFG #SKI K6INSERT>199-199 6J^6 TRACE 0,ODD BLOC 6KDQ BRN SLPP 6KG# ...RNFUWB 6KHW ... LDCT 0 #100 6KKD ... SMO FX2 6KM2 ... ANDX 0 AWORK1 6KNJ ... BZE 0 RN [J IF NOT A CAREFUL FILE 6KQ6 ... NAME 3,FILE,FUWB [CAREFUL UPDATING DONE ON INSERT1 IN 6KRN ... [INSERT SEGMENT SO MUST BE WRITTEN 6KT= ... BRN SLPP [AWAY TO NEW B.S. HOME EVEN THOUGH 6KWS ... [CONTENTS UNCHANGED. 6KYB RN 6LD2 FREECORE 3 6LXL BRN SFULL 6MC= SLPN 6MWW SETREP FILEFULL 6NBG #SKI K6INSERT>99-99 6NW6 TRACE FX2,FILEFULL 6P*Q UP 6PTB # 6Q*2 MENDAREA K6INSERT/5<100>30,K99INSERTFR 6QSL # 6R#= #END ^^^^ ...73202637000400000000