{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: BMINDEX866)}}
====== BMINDEX866 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BBS|BBS]], [[george:macro:BBUS|BBUS]], [[george:macro:BFCBX|BFCBX]], [[george:macro:BMINDEX|BMINDEX]], [[george:macro:BRINDEX|BRINDEX]], [[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:DELFCB|DELFCB]], [[george:macro:DOWN|DOWN]], [[george:macro:FASTREWIND|FASTREWIND]], [[george:macro:FCBNO2|FCBNO2]], [[george:macro:FFINDEXB|FFINDEXB]], [[george:macro:FREEBAX|FREEBAX]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETBAX|GETBAX]], [[george:macro:KEYREC|KEYREC]], [[george:macro:LF|LF]], [[george:macro:MBS|MBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NXFCA|NXFCA]], [[george:macro:PHOTO|PHOTO]], [[george:macro:PSTAC|PSTAC]], [[george:macro:QSTEPC|QSTEPC]], [[george:macro:REINDEX|REINDEX]], [[george:macro:RINGFILE|RINGFILE]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETBIT|SETBIT]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETREP2|SETREP2]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:STF|STF]], [[george:macro:TESTMOVE|TESTMOVE]], [[george:macro:TOPFCA|TOPFCA]], [[george:macro:TOPFCA2|TOPFCA2]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:TRACE|TRACE]], [[george:macro:TRACEIF|TRACEIF]], [[george:macro:TRACEVER|TRACEVER]], [[george:macro:TRANSFCB|TRANSFCB]], [[george:macro:UP|UP]]
22FL #SEG BMINDEX [JUDY BIDGOOD
22^= #OPT K0BMINDEX=K0FILESTORE>K0BMAP>K0RESTORE>K0ALLGEO
23DW #LIS K0BMINDEX
23YG #OPT K6BMINDEX=K6FILESTORE>K6BMAP>K6RESTORE>K6ALLGEO
24D6 8HBMINDEX
24XQ SEGENTRY K1BMINDEX,TGRINP
25CB SEGENTRY K2BMINDEX,TBMIN
25X2 SEGENTRY K3BMINDEX,TMAS
26BL ... SEGENTRY K4BMINDEX,REINDEX
26W= SEGENTRY K11BMINDEX,TGRIN
27*W #
27TG # THIS SEGMENT IS THE EARLY MORNING START ROUTINE RESPONSIBLE
28*6 # FOR CREATING AND/OR CHECKING THE INDICES OF FILES THAT HAVE
28SQ # A BUILT-IN OR SYSTEM INDEX.
29#B # THE FILE IS OPEN AT THE TOP LEVEL THROUGHOUT.
29S2 #
2=?L # INDEXED FILES CURRENTLY ARE:-
2=R= # 1) DIRECTORIES - INDEX NUMBER 1
2?=W # 2) :MASTER.DICTIONARY - INDEX NUMBER 2
2?QG # 3) :SYSTEM.SERIAL - INDEX NUMBER 3
2#=6 # 4) :SYSTEM.INCINDEX - INDEX NUMBER 4 (PERHAPS).
2#PQ # 5) :SYSTEM.OUTPUT - INDEX NUMBER 5 (PERHAPS)
2*9B # 6) :SYSTEM.JOBLIST - INDEX NUMBER 6
2*P2 # 7) USER JOBLIST - INDEX NUMBER 7
2B8L #
2BN= # THERE ARE 2 MAIN ROUTINES.
2C7W #
2CMG # THE FIRST IMPLEMENTS THE GRINDEX MACRO.
2D76 # THIS IS USED BY GENERAL RESTORE TO CREATE THE INDEX FOR A
2DLQ # DIRECTORY JUST BEFORE CLOSING IT.
2DRY ...# THIS ROUTINE HAS BEEN MODIFIED TO AVOID SETTING UP A FI+FSORT
2D^6 ...# BLOCK UNLESS THE FILE IS UNORDERED (TO AVOID COREJAMS)
2F6B # IT IS ALSO ENTERED BY BACKMAP TO INDEX THE DICTIONARY,ETC.
2FL2 #
2G5L # THERE IS A SPECIAL ENTRY TO INDEX :MASTER FOR GENERAL RESTORE
2GK= #
2H4W # THE SECOND ROUTINE STEPS THROUGH THE FILE OPEN AT THE TOP
2HJG # LEVEL CHECKING THAT THE INDEXING IS CORRECT.
2J46 #
2JHQ #
2K3B # USE OF REGISTERS
2KH2 #
2L2L # AWORK1 (A) LATEST SUB-KEY
2LG= # (B) CT. OF ENTRIES X5
2L^W #
2MFG # AWORK2 (A) LATEST KEY
2M^6 # (B) (NO.OF ELEMENTS-MESH)X5
2NDQ #
2NYB # AWORK3 (A) LATEST SUB-SUB-KEY
2PD2 # (B) MESH
2PXL # (C) OLD FBLMOD
2QC= #
2QWW # AWORK4 B0 : :MASTER BEING INDEXED
2RBG # B1 : BMINDEX ENTRY
2RW6 # B2 : FILE NOT (RPT. NOT )TRANSCRIBED TO NEW COPY
2S*Q # B3 : CAREFULLY OPENED FILE
2STB # B6 : OUT OF ORDER
2T*2 #
2TSL # B18-23 = INDEX NUMBER
2W#= #
2WRW #
2X?G # PRESETS
2XR6 #
2Y=Q ZGEOER1
2YQB GEOERR 1,WRNGFILE [WRONG FILE OPEN TO BMINDEX
2^=2 ZGEOER2
2^PL GEOERR 1,SUMS ??? [GRINDEX'S ARITHMETIC GONE WRONG
329= ZGEOER3
32NW GEOERR 1,INDEX??? [FILE OR INDEX RECORD CORRUPT.
3572 ZGEOER6
35LL GEOERR 1,NO FILE? [ NEXT FCA NOT THERE
35MW ...SFACTOR
35P6 ...[ THIS TABLE IS USED TO ESTIMATE THE SIZE OF THE FSORT BLOCK NEEDED.
35QB ...[ (EACH ENTRY IN THE FSORT IS 5 WORDS LONG). THESE NUMBERS ARE,RESPECTIV
35RL ...[ 5X THE AVERAGE NUMBER OF ENTRIES IN A) DIRECTORIES B)DICTIONARY C)SERI
35SW ...[ D)INCINDEX E) OUTPUT F)SYSTEM.JOBLIST G6USER.JOBLIST. THE FILES INDEX
35W6 ...[ NUMBER IS USED AS A MODIFIER TO PICK UP THE APPROPRIATE FACTOR. WE THE
35XB ...[ MULTIPLY BY THE FILE'S SIZE IN 1/2K WORDS TO GET THE INITIAL
35YL ...[ SIZE OF THE FSORT BLOCK.
35^W ...[
3636 ...[ FORMAT OF ENTRY IN FSORT BLOCK.
364B ...[
365L ...[ WORD 0 KEY
366W ...[ WORD 1 BLOCK POINTER
3686 ...[ WORD 2 RECORD POINTER
369B ...[ WORD 3 DESCENDING SUB-KEY.(ZERO IF NONE)
36=L ...[ WORD 4 ASCENDING SUB-KEY.(ZERO IF NONE)
36?W ... +40
36*6 ... +80
36BB ... +425
36CL ... +110
36DW ... +125
36G6 ... +50
36L^ ... +35
36RS ...MASKCOMM
36YM ... #70201041
375G MASKFCOM
37K6 #02042353 [BITS FOR FCOMM IN NEW FCB.
384Q MASKFG1
38JB #77452000 [ BITS FOR FGENERAL1 IN NEW FCA
3942 MASKFG2 [ BITS FOR FGENERAL2 IN NEW FCA.
39HL #00000014
3=3= XIX
3=GW +IDENTITEX
3?^Q XENTABLE [TABLE OF WORDS,ONE FOR EACH TYPE OF INDEXED FILE,IN
3#FB [INDEX NUMBER ORDER.SET =1 IF THAT TYPE OF FILE HAS
3#^2 [MULTI-RECORD ENTRIES
3*DL +1 [DIR.
3*Y= +0 [DICT.
3BCW +0 [SERIAL.
3BXG +0 [INCINDEX.
3CC6 +1 [SYSOUT.
3CWQ +1 [SYSTEM JOBLIST
3DBB +1 [USER JOBLIST
3DW2 #
3F*L # SUBROUTINES
3FT= #
3G#W SKEYREC
3GSG [ THIS SUBROUTINE CALCULATES THE KEY OF THE RECORD POINTED TO
3H#6 [ BY [X3],AND LEAVES THE KEY IN X5. [X2] -> FCB. EXITS+1 IF OK,
3HRQ [ OTHERWISE EXITS. CALLED BY X1,OVERWRITES GEN0,GEN1.
3J?B [ X0,X1,CORRUPTED
3JR2 STO 1 GEN1 [PRESERVE LINK
3K=L KEYREC 2,,3,(GEN1),5 [CALCULATE KEY,EXIT IF NOT KEYED
3KQ= #SKI K6BMINDEX>699$699
3L9W TRACE 5,BM KEY
3LPG LDX 1 GEN1
3M96 EXIT 1 1
3MNQ #
3N8B SETUPFINDEX
3NN2 [
3P7L [ THIS S/R SETS UP AND INITIALISES THE FINDEXF BLOCK.
3PM= [ IT EXPECTS [X3] = THE NUMBER OF BLOCKS IN THE FILE.
3Q6W [ X6=INDEXNO.
3QLG [
3R66 SBX 7 FX1
3RKQ SETNCORE INDEXREC-A1(3),1,FI,FINDEXF
3S5B #SKI K6BMINDEX>299$299
3SK2 TRACE 3,NO.ENTRS
3T4L LDN 0 INDEXREC-A1(3) [R.H.
3TJ= STO 0 A1(1)
3TWM ... LDEX 0 6
3W94 ... STO 0 INDEXNO(1) [ INDEX NUMBER OF FILE
3WHG LDCT 0 #200
3X36 STO 0 INDEXID(1) [ IDENTITY OF RECORD
3XGQ ADX 7 FX1
3Y2B EXIT 7 0
3YG2 [
3Y^L [ QUICK REWIND NOT DISCARDING BLOCKS
3^F= [
3^YW SFASTREWIND
42DG FASTREWIND 2
42Y6 EXIT 7 0
43CQ #
43XB #
44C2 SFBLOCK
44WL [
45B= [ CALLED BY X0,X2-> AN FCB, ON EXIT X2-> BLOCK OF TYPE JUST AFTER
45TW [ LINK,IF EXIT +2;IF EXIT +1,NO SUCH BLOCK;GEN0 CORRUPTED
46*G [
46T6 STO 0 GEN0 [ LINK
46Y=P...#SKI IFS
473BP... SFIBLK 2,2,XPLEJ,GEN0
476GP...#SKI IFS<1$1
479LP...(
47#Q XFLPJ
47SB LDX 2 FPTR(2)
48#2 BXE 2 CXFI,XFPLEJ
48RL LDX 0 ATYPE(2)
49?= BXE 0 FILEPLUSFCB,XFPLEJ
49QW SMO GEN0
4==G BXU 0 0,XFLPJ [ J.BACK IF NOT RIGHT BLOCK.
4=Q6 LDX 0 GEN0
4?9Q EXIT 0 2
4?PB XFPLEJ
4?^8P...)
4#92 LDX 0 GEN0
4#NL EXIT 0 1
4*8= #
4*MW NXFCB
4B7G [
4BM6 [ SET X2 -> 2ND FCB
4C6Q [
4CLB STO 0 GEN6
4D62 FCBNO2 2,2,ZGEOER6 [ ERROI IF NO 2ND FC
4DKL BRN (GEN6)
4F5= #
4FJW # THIS ENTRY POINT IS FOR BACKMAP TO CHECK THE INDEXING OF A FILE
4G4G # OPEN @ TOP LEVEL.
4GJ6 # IF THE FILE IS UNINDEXED,ENTRY IS MADE TO GRINDEX.
4H3Q # IF THE WRONG FILE IS OPEN,OR THE INDEX,OR FILE,IS CORRUPT, A
4HHB # NON-OK REPLY IS GEVEN
4J32 #
4JGL [
4K2= TBMIN
4KFW [
4K^G #SKI K6BMINDEX>99$99
4LF6 TRACE ACOMMUNE9(2),BMINDEXE
4LYQ LDX 6 ACOMMUNE9(2) [PARAMETER
4MDB ... TOPFCB2 1
4MY2 ... BXU 1 BFILE,NOTMA [J IF NOT MASTER
4NCL ... ORX 6 GSIGN [SET SWITCH
4QB6 NOTMA
4RT2 LDN 0 #77
4S#L ANDX 0 FINFC(1) [ INDEX NUMBER
4SS= BZE 0 MERGEA [ IF NONE ENTER GRINDEX
4T?W ... BXU 0 ACOMMUNE9(2),ZGEOER1
4TRG ... LDCT 0 #200 [SET BMINDEX MARKER
4W?6 ... ORX 6 0
4WQQ ... BRN MERGEA
4X=B ...[
5GRB XERUP
5GWG ... SEGENTRY K60BMINDEX
5G^L ... BRN NOQUERY [NULLED BY RTM PRQUERY SO THAT
5H4Q ... DOWN BMQUESTB,5 [WE ASK "DO YOU WANT A PM"
5H7W ...NOQUERY
5H?2 SETREP UNORDERD
5HQL ... UP
5H^# ...[
5J82 ...[ THIS ENTRY POINT IS FOR THE REINDEX MACRO WHICH PRODUCES A CORRECT
5JBN ...[ INDEX RECORD IN THE ACTIVITY CHAIN IN A FI/FINDEXF BLOCK. IF THE
5JKB ...[ FILE NEEDS SORTED,THE REPLY 'UNORDERED IS GIVEN & NO BLOCK IS LEFT
5JS4 ...[
5K2Q ...REINDEX
5K9D ...[
5KD6 ... LDCT 6 #20
5KLS ... ORX 6 ACOMMUNE9(2) [B4=>REINDEX/INDEX NO.
5KTG ... TOPFCB2 1
5L48 ... BRN MERGEA
5L=W ...[
5LFJ ...# THESE ENTRY POINTS ARE FOR THE GRINDEX MACRO.
5LNB # THIS SORTS THE TOP FILE OPEN,REWRITES THE DIRECTORY ENTRY NAME
5M82 # RECORD AND INSERTS THE INDEX RECORD.
5MML #
5N7= # THE ROUTINE BREAKS DOWN NATURALLY INTO 5 STAGES.
5N9F ...[
5N?N ...[ 0) TO AVOID SETTING UP A FSORT BLOCK WE ASSUME THE FILE TO
5N*X ...[ BE CORRECTLY ORDERED UNTIL PROVED OTHERWISE & SET UP
5ND6 ...[ THE FINDEXF DIRECTLY. IF THIS FAILS WE PROCEED AS DESCRIBED
5NG* ...[ BELOW
5NJJ ...[
5NLW #
5P6G # 1) FIRSTLY WE MAKE A PASS THROUGH THE FILE REMEMBERING THE KEY
5PL6 # AND POSITION OF EVERY ENTRY IN A THREE WORD ENTRY IN A FI/FSORT
5Q5Q # BLOCK
5QKB #
5R52 # 2) THE NEXT STAGE IS TO SORT THESE THREE WORD ENTRIES INTO
5RJL # ASCENDING KEY ORDER.THIS IS DONE USING THE SO-CALLED "SHELLSORT
5S4= # ALGORITHM DESCRIBED BY D.L.SHELL,IN THE A.C.M. COMMUNICATIONS
5SHW # VOL.2 NO.7 (1959). THIS ISSUE IS AVAILABLE FROM H.O.L.I.S. THE
5T3G # NOTATION USED IN THE COMMENTS WILL FOLLOW THAT USED IN THE
5TH6 # ARTICLE.
5W2Q #
5WGB # 3) THE NEXT STAGE IS TO SET UP A NEW FCB AND FSTACK FOR THE FILE
5X22 # AT THE TOP LEVEL.WE HAVE TO BE CAREFUL ABOUT B.S. ALLOCATION
5XFL # FOR THESE FILES.THE B.S.ALLOCATION ALGORITHM CURRENTLY ALLOWS
5X^= # US TO USE THE UNJAMMER'S "WELL" IF THE TOP FILE IS OPEN IN
5YDW # GENERAL+CAREFUL MODES. WE DO AN OPTIONAL GETBAX,AND HOPE WE
5YYG # CAN GET ENOUGH B.S. IF WE CAN'T WE GET LESS AND GIVE UP WHEN
5^D6 # THE FILE IS FULL. IN PRACTICE,WE CAN PROBABLY GET BY,BUT WE
5^XQ # WILL EVENTUALLY HAVE TO COPE WITH THIS PROPERLY.
62CB #
62X2 # 4) WE NOW MOVE ALL THE ENTRIES IN THE OLD FILE INTO THE NEW FILE
63BL # IN THE ORDER IN WHICH THEY OCCUR IN THE FSORT BLOCK, AT THE
63W= # SAME TIME SETTING UP THE INDEX RECORD IN A FINDEXB BLOCK.
64*W #
64TG # 5) THIS HAVING BEEN DONE THE OLD FCB,FSTACK,FMAPP ETC ARE FREED
65*6 # AND ITS B.S. FREEBAXED.THE DIR.ENT.IS REWRITTEN,THE FINDEXB
65SQ # INSERTED INTO THE ENTRY AND CHAINED AFTER THE NEW FSTACK.
66#B # THE ROUTINE EXITS.
66S2 #
67?L [
67R= TMAS [ENTRY TO CHECK :MASTER.
68=W [
68QG LDN 6 INDEXDIR
69=6 ORX 6 GSIGN [ SET B0 OF AWK4 & X6.
69PQ BRN MERGE
6=9B [
6=P2 TGRIN [ENTRY WITH NO PARAMETER.
6?8L [
6?N= LDN 6 INDEXDIR
6#7W BRN MERGE
6#MG [
6*76 TGRINP [ENTRY WITH A PARAMETER.
6*LQ [
6B6B LDX 6 ACOMMUNE9(2)
6BL2 MERGE
6C5L TOPFCB2 1 [ X1 -> FCB
6CK= #SKI K6BMINDEX
6D4W (
6DJG LDN 0 #77
6F46 ANDX 0 FINFC(1)
6FHQ BNZ 0 ZGEOER1 [ERROR IF ALREADY INDEXED.
6G3B )
6GH2 MERGEA
6H2L #SKI K6BMINDEX>199$199
6HG= TRACE 6,GRINDEX
6JFG STO 6 AWORK4(2) [ PRESERVE INDEX NUMBER
6JP# ...STARTAGAIN
6KDQ STOZ AWORK2(2) [ LATEST KEY FOUND REGISTER.
6KKY ... NGN 0 1
6KR6 ... STO 0 AWORK1(2) [LATEST SUB-KEY
6KY# ... STO 0 AWORK3(2) [LATEST SUB-SUB-KEY
6L5G ... LDX 0 FINFC(1)
6L=N ... LDX 6 AWORK4(2)
6LCW ... ANDN 6 #77
6LK4 ... DCH 6 0
6LQ= ... STO 0 FINFC(1) [PUT INDEX NO. IN.
6LXL LDN 0 4
6MC= ... ANDX 0 FCOMM(1) [ B3 OF AWK4 SET IF FILE ORIGINALLY
6MWW SRC 0 6 [OPENED CAREFULLY.
6NBG ORS 0 AWORK4(2)
6NW6 LDX 3 FBLMOD(1)
6P*Q SBN 3 FBLKS-A1 [ X3=NO. KLOX IN FILE
6PF2 ... BBS 6,AWORK4(2),NEEDFSORT[J IF GRINDEX & UNORDERED
6PJ= ... LDN 4 FBLKS [INITIALIZE FREADBLOCK POINTER
6PMG ... BBS 1,AWORK4(2),MPTYBMCH [J IF BMINDEX CHECK ONLY
6PQQ ... CALL 7 SETUPFINDEX
6PW2 ... BZE 3 ZENDX [J IF EMPTY
6P^= ... BRN MERGEB
6P^W ...MPTYBMCH
6Q2G ... BNZ 3 MERGEB
6Q36 ... SETREP2 OK
6Q3Q ... UP
6Q4G ...NEEDFSORT
6Q7R ... LDX 1 FX1
6QG8 ... SMO 6 [INDEX NUMBER OF FILE. MULTIPLY THE
6QSK ... MPY 3 SFACTOR-1(1) [SIZE OF FILE BY APPROPRIATE FACTOR
6R72 ... ADN 4 1 [TO GET APPROX. SIZE OF FSORT BLOCK.
6RFC ... SETUPCOR 4,1,FI,FSORT [THIS CAN BE ALTLEN'ED IF
6RRW #SKI K6BMINDEX>99-99
6S?G TRACE 4,FSORTSZE
6SR6 LDN 0 1 [ NECESSARY
6T=Q STO 0 A1(1) [ RECORD HEADER
6TGJ ...MERGEB
6TQB CALL 7 SFASTREWIND [ REWIND FILE
6W=2 NEXREC
6W=9 ... BBS 1,AWORK4(2),YBMIN
6W=D ... STEP
6W=M ... BRN NEXRECGOT
6W=W ...YBMIN
6W?7 ...[ GET PTR TO NEXT RECORD - USE QSTEPC RATHER THAN STEP SO THAT
6W## ...[ BACKMAP CAN INITIATE ITS OWN BACKING STORE TRANSFERS, AND
6W*F ...[ TAKE ITS OWN ACTION ON READ FAILS AND CORRUPTION.
6WBL ...[
6WCR ... QSTEPC ,XBACKREAD [^ IF B.S. TRANSFER REQUIRED
6WDY ... BRN NEXRECGOT
6WG5 ...XBACKREAD
6WH= ... DOWN BMCNTRL,5 [INITIATE TRANSFER
6WJC ... BRN NEXREC [OKAY - GET RECORD PTR
6WKJ ... BRN XERUP [CORRUPTION DETECTED
6WLP ... BRN XEOF [END OF FILE
6WMW ... BRN XERUP [READ FAIL
6WP3 ...XEOF STOZ 3
6WQ8 ...NEXRECGOT
6WRQ ... BBS 6,AWORK4(2),NOFINDEXUPD [J IF GRINDEX & UNORDERED
6WTW ... TOPFCA2 1
6WY2 ... BZE 3 NDFILE [
6X26 ... BXE 4 FREADBLOCK(1),MERGEC[J IF NOT END OF FILE OR NEW BLOCK
6X4= ...NDFILE
6X6B ... ADN 4 1 [INCREMENT BLOCK POINTER
6X8G ... TRACEIF K6BMINDEX,99,299,AWORK2(2),BLOCKKEY
6X=L ... BBS 1,AWORK4(2),SFINDEXB [J IF BMINDEX CHECK ONLY
6X#Q ... MHUNTW 1,FI,FINDEXF
6XBW ... SBN 1 FBLKS [COS X4 IS RELATIVE TO FBLKS
6XF2 ... LDX 0 AWORK2(2)
6XH6 ... SMO 4
6XK= ... STO 0 INDEXREC-1(1) [STORE PREVIOUS KEY IN PREVIOUS INDEX
6XMB ... BNZ 3 MERGEC
6XPG ... SETBIT 2,AWORK4(2) [FILE NOT TRANSCRIBED
6XRL ... BRN ZENDX
6XTQ ...SFINDEXB
6XXW ... FFINDEXB 1,1
6Y22 ... SBN 1 FBLKS
6Y46 ... SMO 4
6Y6= ... LDX 0 INDEXREC-1(1)
6Y8B ... BXU 0 AWORK2(2),XERUP [KEY WRONG ERROR EXIT
6Y=G ... BNZ 3 MERGEC
6Y#L ...OKUP SETREP2 OK
6YBQ ... BRN UP
6YDW ...NOFINDEXUPD
6YH2 ... BZE 3 SORT [SORT UNORDERED FILE
6YK6 ...MERGEC
6YN6 BRINDEX AWORK4(2),ZGEOER3,XIDIR,XNO,XNO,XNO,XIOUT,XNO,XNO
6^7Q XIDIR
6^MB LDX 6 EGENN(3) [CALCULATE SUBKEYS,IF ANY.
7272 LDX 7 EREELN(3)
72LL BRN XIMERGE
736= XIOUT
73KW LDX 7 GOUTKEY2-A1(3)
745G BRN XJMERGE
74K6 XNO
754Q LDN 7 0
75JB XJMERGE
7642 LDN 6 0
76HL XIMERGE
773= TOPFCB2 2 [ X2 -> FCB
77GW CALL 1 SKEYREC [ X5 =KEY, X0,1 CORRUPT.
782G BRN NEXREC [ GO FOR
787N ... LDX 2 FX2
78#W ... BBUS 6,AWORK4(2),NOFSORTUPD [J UNLESS GRINDEX & OOO
78G6 MHUNTW 1,FI,FSORT
78^Q LDN 0 5 [ UPDATE R.H.
79FB ADS 0 A1(1)
79^2 BXGE 4 A1(1),NOALTFSORT [ J IF ROOM IN FSORT FOR NEXT ENTRY
7=DL #SKI K6BMINDEX>99-99
7=Y= TRACE 4,TOOSMALL
7?CW ... ADN 4 400 [ ALTLEN BY 400 EACH TIME -IT'S
7?XG LDX 3 1 [ MORE EFFICIENT.
7#C6 ALTLEN 3,4,FI,FSORT [ LENGTHEN BLOCK.
7#WQ MHUNTW 1,FI,FSORT
7*BB NOALTFSORT
7*W2 TOPFCA 2 [X2 -> FCA
7B*L ADN 2 FREADBLOCK [-> READ PTRS
7BT= SMO A1(1) [
7C#W LDN 3 A1-5(1) [ -> START OF 3WD ELEMENT IN FSORT
7CSG STO 5 0(3) [ STORE KEY IN
7D#6 ADN 3 1 [ -> AREA FOR READ PTRS
7DRQ MOVE 2 2 [ MOVE IT IN.
7F?B LDN 0 5
7FR2 LDX 2 FX2
7G=L STO 6 2(3) [ STORE SUB-KEYS
7GQ= STO 7 3(3)
7GXD ... BRN NEXREC
7H4L ...NOFSORTUPD
7H9W BXGE 5 AWORK2(2),UPDATLAT [ J IF KEYS ASCENDING.
7HPG NOTORDX
7J96 ... BBS 1,AWORK4(2),XERUP [ERROR EXIT IF BMINDEX CHECK ONLY
7JNQ ... MFREEW FI,FINDEXF [FILE UNORDERED - SCRAP FINDEXF &
7JYJ ... BBS 4,AWORK4(2),XERUP [ERROR EXIT IF REINDEX & UNSORTED
7K8B ... SETBIT 6,AWORK4(2) [UNORDERED
7KN2 ... TOPFCB2 1
7L7L ... BRN STARTAGAIN [ START AGAIN TO DO SORT
7MLG UPDATLAT
7N66 BXU 5 AWORK2(2),STOAW31 [J IF KEYS UNEQUAL
7NKQ LDX 1 AWORK1(2) [LAST S/K
7P5B BXL 1 6,NOTORDX [J IF LESS THAN NEXT
7PK2 BXU 6 1,STOAW31 [J IF UNEQUAL
7Q4L BXL 7 AWORK3(2),NOTORDX [J IF NEW SS/K LESS THAN OLD
7QJ= STOAW31
7R3W STO 6 AWORK1(2) [UPDATE S/K & SS/K REGISTERS
7RHG STO 7 AWORK3(2)
7S36 #SKI K6BMINDEX>699-699
7SGQ TRACE 5,UPDATLAT
7T2B STO 5 AWORK2(2) [ AWK2 CONTAINS HIGHEST KEY TO DATE
7TG2 BRN NEXREC
7T^L #
8SQ2 # LAST STAGE : UPDATE DIR.ENT WITH ALL THE NEW INFORMATION
8T9L #
8TP= #
8W8W #
8WNG ZEND
8X86 MFREEW FI,FSORT
8XMQ ZENDX
8XXJ ... BBS 4,AWORK4(2),OKUP [EXIT IF REINDEX
8Y7B ACROSS BMXEND,1
8YM2 UP
8^6L CALL 7 SFASTREWIND
8^L= UP1
925W UP
92KG #
9D?2 SORT
9DQL #
9F== # THIS SECTION OF CODE SORTS THE FSORT BLOCK INTO ORDER BY ASCENDING
9FPW # KEY NUMBER.
9G9G #
9GP6 # THE METHOD USED IS A "SHELL-SORT" (SEE THE REFERENCE QUOTED AT
9H8Q # THE HEAD OF THE CHAPTER).
9HNB #
9J82 # IT IS A CROSS BETWEEN SIFTING AND MERGING BY PAIRS. IT USES LITTLE
9JML # CORE(JUST THE FSORT BLOCK),WHICH IS A CHARACTERISTIC OF SIFTING,
9K7= # AND THE TIME TAKEN TO DO THE SORTING IS PROPORTIONAL(BY EXPERIM-
9KLW # ENTAL RESULTS) TO N**1.226(I.E.N RAISED TO THE POWER OF 1.226)
9L6G # WHERE N IS THE NUMBER OF ELEMENTS TO BE SORTED.THIS SPEED IS
9LL6 # CHARACTERISTIC OF MERGING BY PAIRS.WHERE THE TIME TAKEN IS PRO-
9M5Q # PORTIONAL TO N.LOG(N).ALL OTHER SORTING METHODS TAKE A TIME
9MKB # PROPORTIONAL TO N SQUARED OR N.LOG(R) WHERE R IS THE HIGHEST KEY
9N52 # USED.THESE ARE TOO INEFFICIENT FOR US
9NJL #
9P4= # WE SORT THE LIST OF ELEMENTS IN THE FSORT BLOCK IN P PASSES,WHERE
9PHW # P IS THE SMALLEST NUMBER SUCH THAT 2**P > OR = N
9Q3G #
9QH6 # IN THE QTH PASS,WE DIVIDE THE SET OF ELEMENTS INTO Q SUBSETS EACH
9R2Q # WITH [N/2**Q] ELEMENTS,EXCEPT FOR UP-TO-Q-1 MORE,WHICH HAVE
9RGB # ANOTHER 1.
9S22 # THE U'TH SUBSET CONSISTS OF THE U'TH,U+Q'TH,U+2Q'TH,... ETC
9SFL # ELEMENTS. WE SORT THESE INTO KEY ORDER WITHIN THE SUBSET.
9S^= # HAVING SORTED EACH SUBSET,WE GO TO THE NEXT STEP-SETTING Q TO Q/2
9TDW # AND REPEATING THE PROCESS UNTIL Q=1.
9TYG #
9WD6 #
9WXQ #SKI K6BMINDEX>99$99
9XCB TRACE JTIME,START IX
9XX2 #SKI K6BMINDEX<100$100
9YBL TRACEVER JTIME,START IX
9YW= MHUNTW 3,FI,FSORT
9^*W STO 3 GEN6
9^TG LDX 2 FX2
=2*6 LDX 5 A1(3)
=2SQ SBN 5 1
=3#B STO 5 AWORK1(2)
=3S2 LDN 4 5
=4?L DVS 4 4
=4R= LDX 4 5 [ IN X4 (& ALSO IN AWORK3)
=5=W XFINERMESH
=5QG SRL 4 1 [ FINER MESH = M
=6=6 #SKI K6BMINDEX>299$299
=6PQ TRACE 4,MESH =
=79B BZE 4 SORTED [ EXIT WHEN PASS COMPLETED.
=7P2 STO 4 AWORK3(2) [ PRESERVE MESH
=88L SLL 4 2
=8N= ADX 4 AWORK3(2) [MULTIPLY BY 5
=97W LDX 0 AWORK1(2) [ NO. OF ENTRIES =N
=9MG SBX 0 4
==76 STO 0 AWORK2(2) [ =K
==LQ LDN 6 0 [ INITIAL VALUE OF J
=?6B SETITOJ
=?L2 #SKI K6BMINDEX>299$299
=#5L TRACE 6,J IS
=#K= LDX 5 6 [ SET I = J
=*4W PICKITHENT
=*JG #SKI K6BMINDEX>299$299
=B46 TRACE 5,I IS
=BHQ LDX 3 GEN6
=C3B ADX 3 5 [ (NEARLY) POINTS TO I'TH ENTRY
=CH2 SMO 4
=D2L LDX 0 A1+1(3) [ KEY OF I+M'TH ENTRY
=DG= #SKI K6BMINDEX>699$699
=D^W (
=FFG TRACE A1+1(3),I'TH KEY
=F^6 TRACE 0,I+M'TH
=GDQ )
=GYB BXL 0 A1+1(3),XCIANGE [ JIF NEYS OUT OF ORDER
=HD2 BXU 0 A1+1(3),STEPJ [ J IF KEYS NOT EQUAL
=HXL SMO 4 [ IF THEX ARE , CF DESCENDING SUB-KEY
=JC= LDX 0 A1+1+3(3)
=JWW BXL 0 A1+1+3(3),STEPJ [ JIF LESS IE ORDERED
=KBG BXU 0 A1+1+3(3),XCIANGE [ IF EQUAL,CF ASCENDING SUB-SUB-KEYS.
=KW6 SMO 4
=L*Q LDX 0 A1+1+4(3)
=LTB BXGE 0 A1+1+4(3),STEPJ
=M*2 XCIANGE
=MSL # NOW INTERCHANGE THE TWO ENTRIES.
=N#= LDN 7 A1+1(3) [ -> I'TH ENTRY
=NRW LDN 0 A1+1(3)
=P?G ADX 0 4 [ -> I+M'TH ENTRY
=PR6 LDN 1 GEN0 [ DUMP AREA
=Q=Q LDN 2 A1+1(3) [ -> I'TH ENTRY.
=QQB MOVE 0 5 [ PRESERVE I+M'TH
=R=2 MOVE 7 5 [ CHANGE I'TH TO I+M'TH
=RPL MOVE 1 5 [ MOVE OLD I+M'TH TO I'TH POSITION.
=S9= #SKI K6BMINDEX>699$699
=SNW (
=T8G TRACE 2(2),NEW I'TH
=TN6 LDX 2 0
=W7Q TRACE 2(2),NEWI+MTH
=WMB )
=X72 SBX 5 4 [ RESET I TO I-M
=XLL BPZ 5 PICKITHENT [ JUMP IF'NEW' I NOT NEGATIVE.
=Y6= STEPJ
=YKW ADN 6 5 [ STEP J
=^5G LDX 2 FX2
=^K6 BXL 6 AWORK2(2),SETITOJ [ JUMP IF J < K
?24Q LDX 4 AWORK3(2) [ PICK UP MESH
?2JB BRN XFINERMESH
?342 SORTED
?3HL #
?43= # WE NOW SET UP A DUMMY FILE IDENTICAL TO THE ONE WE ARE INDEXING
?4GW # EXCEPT FOR THE 'CAREFUL' BIT AND THE FILE & BLOCKS ALTERED BITS.
?52G #
?5G6 #SKI K6BMINDEX>99$99
?5^Q TRACE JTIME,END IX
?6FB #SKI K6BMINDEX<100$100
?6^2 TRACEVER JTIME,END IX
?7DL TOPFCB2 2 [ X2 -> FCB
?7Y= LDX 7 BSPRE(2) [ WE GET SOME BLOCKS FOR THE FILE
?8CW LDX 4 FBLMOD(2) [ ON THE SAME RESIDENCE AS IT IS
?8XG LDX 6 4 [ CURRENTLY. IF THERE ISN'T ENOUGH
?9C6 SBN 6 FBLKS-A1-2 [ WE TRY TO GET 1 LESS BLOCK,AND SO
?=BB #SKI K6BMINDEX>199-199
?=W2 TRACE 6,NO.BLOX
??*L SETUPCORE 6,3,BSTB,EMPTYB [ THIS IS NECESSARY AS WE HAVE TO PUT
??T= STO 6 A1(3) [ THE FILE ON THE SAME RESIDENCE AS
?##W STO 7 A1+1(3) [ IT MAY BE A SPECIALLY ALLOCATED FIL
?#SG ... GETBAX
?*#6 ... SETUPCOR 4,3,FILE,FCB,,1
?CQ= LDEX 5 AWORK4(2) [ INDEX NO.
?D9W TOPFCB2 2 [ FUL.WE SET UP AN FCB NEXT LOOKING
?DPG ... STOZ FBLMOD(3) [ NEARLY IDENTICAL TO THE OTHER O
?F96 NGS 7 CMOD(3)
?FNQ ... LDN 7 FBLMOD(3)
?G8B ... LDN 0 FBLMOD+1(3)
?GN2 ... MOVE 7 BSPRE-FBLMOD-1
?H7L ADN 3 FUSER1
?HM= ADN 2 FUSER1
?J6W MOVE 2 1+FVERSION-FUSER1 [ MOVE IN NAME ETC
?JLG SBN 3 FUSER1 [ X3 -> NEW FCB
?K66 SBN 2 FUSER1 [ X2 -> THE OLD FCB
?KKQ LDN 0 FBLKS-A1
?L5B STO 0 FBLMOD(3) [ EMPTY.
?LK2 LDX 0 BACK1(2) [ TRANSFER BS HOME(FCB IDENTIFIER).
?M4L STO 0 BACK1(3)
?MJ= LDX 0 BACK2(2)
?N3W STO 0 BACK2(3)
?NHG STO 4 FUSEBL(3) [ BUT BLOX ALLOCATED TO IT.
?P36 ORS 5 FINFC(3) [ SET INDEX NO.
?PGQ LDX 0 MASKCOMM(1) [ TRANSFER VITAL BITS OF COMM
?Q2B ANDX 0 COMM(2)
?QG2 STO 0 COMM(3)
?Q^L LDX 0 MASKFCOM(1) [ TRANSFER VITAL BITS OF FCOMM
?RF= ANDX 0 FCOMM(2)
?RYW STO 0 FCOMM(3)
?SDG ADN 3 BSPRE [ MOVE THE BLOCK NOS. IN
?SY6 MHUNTW 2,BSTB,FULLB [ FROM THE FULLB.
?TCQ ADN 2 A1+1
?TXB SMO 6
?WC2 MOVE 2 511 [ & THE B.S.PREFIX.
?WWL SETNCORE FELLEN,3,FILE,FSTACK,,1,FELLEN
?XB= ADN 3 A1 [ SET UP AND INITIALISE A FSTACK
?XTW NGS 3 FREADWORD(3) [ BLOCK AND ELEMENT
?Y*G NGS 3 FREADBLOCK(3)
?YT6 LDN 0 A1
?^#Q NGS 0 FBACKPOINT(3)
?^SB TOPFCA2 2 [ OLD FCA; TRANSFER APPROPRIATE
#2#2 LDX 0 FGENERAL1(2) [ BITS IN FG1 & FG2.
#2RL ANDX 0 MASKFG1(1)
#3?= STO 0 FGENERAL1(3)
#3QW LDX 0 FGENERAL2(2)
#4=G ANDX 0 MASKFG2(1)
#4Q6 STO 0 FGENERAL2(3)
#59Q RINGFILE 3 [ FCA -> TOP OF FILERING
#5PB SBN 3 A1
#5^8 ... PSTAC 2,2
#692P...#SKI IFS<1$1
#6DSP...(
#6NL XFLPK
#78= LDX 2 FPTR(2) [ SET X2 -> NEXT FCB OR BASE
#7MW BXE 2 CXFI,XEK [ OF FILE CHAIN
#87G LDX 0 ATYPE(2)
#8M6 BXU 0 FILEPLUSFCB,XFLPK
#96Q XEK
#9LB #SKI K6BMINDEX>299$299
#=62 TRACE 2,NXFCB
#=KL MHUNTW 1,FILE,FCB
#?5= STO 1 4
#?CM ... LDX 2 BPTR(2)
#?Q4 ... TRANSFCB 4,ACT,FILE,2 [X2 GIVES THE POSITION IN FILE CHAIN
##4G CHAIN 3,4 [ AFTE_GINVIOUS FCB & ITS FLOTILLA
##5XP...)
##7#P...#SKI IFS
##8PP...(
##=6P... BFCBX 2,2
##?HP...#SKI K6BMINDEX>299$299
###YP... TRACE 2,NXFCB
##B*P... STO 3 4
##CQP... MHUNTW 3,FILE,FCB [RING IN FCB,DECHAIN FROM ACT. CHAIN
##F7P... FILECHAIN 4,3,2 [& CHAIN FCB AND FSTACK TOGETHER.
##GJP...)
##J6 #
#*3Q # WE NOW SET UP A FI/FINDEXF BLOCK TO PUT THE INDEX IN AS WE
#*HB # CALCULATE IT
#B32 #
#BGL LDX 3 6
#C2= SBN 3 2 [ NO. OF BLOX IN FILE.
#CFW LDEX 6 AWORK4(2) [ INDEXNO
#C^G CALL 7 SETUPFINDEX [ SET UP THE FINDEXF
#DF6 LDN 0 FBLKS-A1
#DYQ STO 0 AWORK3(2) [ " OLD FBLMOD".
#FDB LDN 0 INDEXREC-A1
#FY2 STO 0 A1(1) [ FILE CURRENTLY EMPTY
#GCL NGN 4 4 [ PTR IN FSORT
#GX= NEXTFSORT
#HBW ADN 4 5 [ STEP FSORT PTR.
#HWG XIRSTFS
#JB6 LDX 2 FX2
#JTQ MHUNTW 1,FI,FSORT [ X1 -> FSORT.
#K*B BXE 4 A1(1),NEWFILE [ J IF REACHED END
#KT2 #SKI K6BMINDEX>299$299
#L#L TRACE 4,FSORTPTR
#LS= ADX 1 4 [ +A1 -> NEXT ENTRY.
#M?W TOPFCA2 2 [ FCA
#MRG NXFCA 2,2,ZGEOER6 [ FCA OF F^E & DEPTH 1
#N?6 LDX 0 A1+1(1) [ TABULATE IN THE INPUT FILE
#NQQ STO 0 FREADBLOCK(2) [ TO THE POSITION OF THE NEXT
#P=B LDX 0 A1+2(1) [ ENTRY TO GO TO THE OUTPUT FILE.
#PQ2 STO 0 FREADWORD(2) [ FILE.
#Q9L LDX 5 A1(1) [ KEY
#QP= SAG1
#Q^4 ... PHOTO 7
#R8W STEPAGAIN 1 [ GET PTR. TO RECORD
#RNG ...NXTAPPEND
#S86 LDX 6 3 [ PRESERVE PTR.
#SMQ #SKI K6BMINDEX>699$699
#T7B TRACE FRH(3),OUT RECH
#W6L LDEX 1 FRH(3)
#WL= STEP ,0(1) [ GET APPEND POINTER.
#X5W ... TESTMOVE 7,NXAP
#XKG ... BRN SAG1
#Y56 ...NXAP LDX 7 3
*2H= LDEX 1 FRH(3) [ DOESN'T MATTER WHICH X3 PTR
*32W MOVE 6 0(1) [ BOTH HAVE R.H. IN BOTTOM 9 BITS.
*3GG TOPFCB2 1 [ X1 -[ FCB
*426 #SKI K6BMINDEX>299$299
*4FQ TRACE CMOD(1),END ENT
*4^B MHUNTW 3,FI,FINDEXF [ X3 -> FINDEXF
*5F2 LDX 0 FBLMOD(1) [ HAS FBLMOD CHANGED ?
*5YL SBX 0 AWORK3(2) [ (OLD FBLMOD)
*6D= BZE 0 NOALTFX1 [ NO.THEN JUMP
*6XW ADS 0 AWORK3(2) [ UPDATE PREVIOUS FBLMOD.
*7CG #SKI K6BMINDEX
*7X6 BCT 0 ZGEOER2 [ ERROR IF CHANGED BY > 1
*8BQ LDX 6 A1(3)
*8WB BXL 6 ALOGLEN(3),NOALTFX [ J IF BLOCK LONG ENOUGH
*9B2 #SKI K6BMINDEX
*9TL BXU 6 ALOGLEN(3),ZGEOER2 [ ERROR IF NOT LONG ENOUGH
*=*= ADN 6 8 [ ALTLEN BY A LOT
*=SW #SKI K6BMINDEX>99$99
*?#G TRACE 6,ALT FXB
*?S6 ALTLEN 3,6
*#?Q MHUNTW 3,FI,FINDEXF [ X3 -> FINDEXF
*#RB NOALTFX
**?2 LDN 0 1 [UPDATE RECORD HEADER.
**QL ADS 0 A1(3)
*B== NOALTFX1
*BPW SMO A1(3)
*C9G STO 5 A1-1(3) [ UPDATE INDEX NO.
*CP6 #SKI K6BMINDEX>199$199
*D8Q TRACE 5,BLOCKEY
*DNB XISITKEYED
*F82 STEP [ STEP TO LAST RECORD IN O/P FILE.
*FML TOPFCB2 2 [ X2 -> FCB.
*G7= CALL 1 SKEYREC [ SET X5 = KEY OF LATEST RECORD
*GLW BRN NXINREC [ J IF NOT INDEXED.
*H6G LDN 0 #77
*HL6 ANDX 0 FINFC(2)
*J5Q ADX 1 0
*JKB LDX 0 XENTABLE(1) [ PICK UP TABLE THAT TELLS US WHICH
*K52 BZE 0 NEXTFSORT [ TYPES HAVE MULTIRECORD ENTRIES
*KJL NXINREC [ AND JUMP IF THIS FILE HASN'T
*L4= STEP 1 [ NEXT RECORD IN INPUT FILE
*LHW BZE 3 NEXTFSORT [ J IF E.O.F.
*M3G TOPFCB2 2 [ X2 -> FCB
*M*X ... PHOTO 7
*MN# ... KEYREC 2,,3,NXTAPPEND [IF NOT KEYED REC,EXIT TO APPEND THIS
*N2Q BRN NEXTFSORT [ RECORD,O/W TRY NEXT ENTRY IN FSORT.
*NGB # WE NOW HAVE AN INDEXED FILE AT TOP LEVEL AND AN OLD FILE
*P22 # TO GET RID OF AT LEVEL 1.
*PFL NEWFILE
*P^= MHUNTW 3,BSTB,FULLB
*QDW MHUFUL
*QYG CALL 0 NXFCB [ X2 -> NOXT FCB
*RD6 LDX 1 FUSEBL(2)
*RXQ SBN 1 FBLKS-A1-2 [ X1 = TOTAL NUMBER OF BLOCK TO BE
*SCB [ FREED.NB NOT NECESS SAME PREFIX.
*SX2 BXE 1 A1(3),XFULLBIG [ FCB MAY CONTARE UNUSED BLOX
*TBL #SKI K6BMINDEX>99$99
*TW= TRACE 1,BL USED
*W*W LDX 4 1
*WTG ALTLEN 3,4,BSTB,FULLB
*X*6 MHUNTW 3,BSTB,FULLB
*XSQ STO 4 A1(3)
*Y#B BRN MHUFUL
*YS2 XFULLBIG
*^?L ADN 3 A1+1
*^R= ADN 2 BSPRE
B2=W MOVE 2 511(1) [ MOVE + BSPRE
B2QG SBN 2 BSPRE
B3=6 SBN 3 A1+1 [ REDATUMISE PTRS.
B3PQ LDX 4 2 [ SAVE
B49B LDX 5 FWAITCOUNT(2)
B4P2 ... LF 2,FFAUTCLCT,6 [X6= COUNT OF AUTOCLOSES
B58L LDN 7 1 [ CT.OF FULLB'S TO BE FREEBAXED
B5N= LDCT 0 #40
B67W SMO FX2 [ J IF FILE WASN'T ORIGINALLY
B6MG ANDX 0 AWORK4 [ CAREFULLY OPENED
B776 BZE 0 XLFPM
B7LQ CALL 0 SFBLOCK [ IS THERE ANOTHER FULLB IN THE FILE
B86B #HAL BSTB+FULLB,0
B8L2 BRN NOFULLB [ CHAIN? J IF NOT.
B95L #SKI K6BMINDEX>199$199
B9K= TRACE A1(2),FULLB IS
B=4W ADN 7 1 [ 2 FULLB'S
B=JG CHAIN 2,FX2 [ CHAIN IN ACT. CHAIN
B?46 NOFULLB
B?HQ LDX 2 4 [ X2 -> FCB
B#3B CALL 0 SFBLOCK
B#H2 #HAL FILE+FMAPP,0
B*2L BRN ZGEOER1 [ ERROR IF NO FMAPP & CAREFUL
B*G= YESMAP
B*^W #SKI K6BMINDEX>199$199
BBFG TRACE FBITMOD(2),FMAPP IS
BB^6 CHAIN 2,FX2 [ CHAIN FMAPP INTO ACTIVITY CHAIN
BCDQ LDX 3 FPTR(2) [ -> FMAPP
BCYB SETMAP
BDD2 LDX 0 ALOGLEN(3) [ INITIALISE OMAPP
BDXL SBN 0 FBITS-A1
BFC= #SKI K6BMINDEX
BFWW BZE 0 ZGEOER2 [ J IF EMPTY TO ERROR
BGBG LDN 1 FBITS(3)
BGW6 XFLPL
BH*Q STOZ 0(1) [ ZEROISING LOOP
BHTB ADN 1 1
BJ*2 BCT 0 XFLPL
BJSL LDN 0 3 [ UPDATE FBCOMM
BK#= ORS 0 FBCOMM(3)
BKRW LDX 2 4 [ -> FCB
BL?G FREECORE FPTR(2) [ FREE FSTACK.
BLR6 XLFPM
BM=Q LDX 2 4 [ -> FCB
BMQB LDX 2 FPTR(2) [ BLOCK NEXT TO FCB
BN=2 BXE 2 CXFI,XSEARCHND [ EXIT FROM LOOP IF END OF CHAIN
BNPL LDX 0 ATYPE(2) [ OR FCB MET
BP9= BXE 0 FILEPLUSFCB,XSEARCHND
BPNW #SKI K6BMINDEX>199$199
BQ8G TRACE ATYPE(2),FREE BLK
BQN6 FREECORE 2 [ FREE BLOCK
BR7Q BRN XLFPM
BRMB XSEARCHND
BS72 ... DELFCB 4,FILE
BSLL LDCT 0 #40
BT6= ANDX 0 AWORK4(2) [ J IF NOT CAREFUL
BTKW BZE 0 XFREEBU
BW5G TOPFCB2 2 [ NEW FCB FOR FILE
BWK6 STO 5 FWAITCOUNT(2)
BX4Q ... STF 2,FFAUTCLCT,6 [INSERT COUNT OF AUTOCLOSES
BXJB MBS 2,BFALTB,BFALTR [SET 'FILE AND BLK NOS ALTERED' BITS.
BY42 BS 2,BFCARE [SET CAREFUL BIT
BYHL XLOADFP
B^3= LDX 4 2 [ -> FCB
B^GW CALL 0 SFBLOCK [ FREE ALL FURBS
C22G #HAL FILE+FURB,0
C2G6 BRN TRYFUWB1 [ J IF NONE LEFT
C2^Q FREECORE 2
C3FB BRN XLOADFP
C3^2 TRYFUWB1
C4DL LDX 2 4 [ X2 ->FCB
C4Y= TRYFUWB
C5CW CALL 0 SFBLOCK [ WRITE AWAY ALL FUWBS
C5XG #HAL FILE+FUWB,0
C6C6 BRN TRYFMAP [ J IF NONE
C6WQ CHAIN 2,FX2
C7BB WRITEAUT FAIL+FREE,BSBS
C7W2 TOPFCB2 2 [ X2 ->FCB
C8*L LDX 4 2 [ X4 -> FCB
C8T= BRN TRYFUWB
C9#W TRYFMAP
C9SG LDX 2 4 [ X2 -> FCB
C=#6 MHUNTW 3,FILE,FMAPP
C=RQ CHAIN 3,FPTR(2) [ CHAIN FMAPP INTO FILE CHAIN
C??B XFRLP
C?R2 MHUNTW 2,BSTB,FULLB [ CHAIN FULLB(S) INTO F.C.
C#=L CHAIN 2,3
C#Q= BCT 7 XFRLP
C*9W BRN ZEND [ GO TO FINAL STEP.
C*PG XFREEBU
CB96 FREEBAX
CBNQ MFREE BSTB,EMPTYB
CC8B BRN ZEND
CCN2 MENDAREA 1000-0?,K99BMINDEX
CD7L #END
^^^^ ...17127170000200000000