(George Source)
Macros used: ACROSS, ALTLENGD, BS, BXE, BXGE, BXL, CHECKA, DOWN, FINMOVE, FOUTMOVE, FREEBAX, FREECORE, GETBAX, JBC, MBS, MENDAREA, MHUNTW, MONITOR, NAME, OLPFIN1, OPEN, PAIR, RELOFP, REPMON, SEGENTRY, SETMODE, SUBCUBS, TESTMON, TESTREP2, TOPCA, TOPCA1, TOPFCA2, TOPFCB, TOPFCB2, UP
22FL #OPT K0EDSTART=K0OLP 22^= #OPT K6EDSTART=K6OLP 23DW #LIS K0EDSTART 23YG #SEG EDSTART72 [7OPAE 24D6 8HEDSTART7 24XQ SEGENTRY K1EDSTART,Z1EDSTART 25=7 ... SEGENTRY K2EDSTART,ZINCRECUBS 25JJ ... SEGENTRY K3EDSTART,ZGETBLOCKS 25X2 # 26BL # THIS SEGMENT IMPLEMENTS THE 1ST PERI TO AN OFF-LINE DA FILE, 26W= # NON-TRANSFER MODES TO AN OFF-LINE FILE AND IS RETURNED TO AFTER AN 273D ...# ILLEGAL OR MONITOR EVENT. IT IS ALSO ENTERED (ACROSS9 FROM EDOBJ IF 278L ...[ CUBS IS TO BE INCREASED & (DOWN) IF MORE BLOCKS ARE REQUIRED 27*W 27TG # 28*6 #DEF MAXMODE=#1500 28SQ 29#B #DEF X=#100 29S2 2=?L #DEF NONE=0 [INDICATES NO MONITORING ON THIS MODE 2=R= #DEF MEXT=1 [ " MONITOR ON EXTEND 2?=W #DEF MREN=2 [ " " RENAME 2?QG #DEF MCLO=3 [ " " CLOSE 2#=6 2#PQ #DEF ORD=0 2*9B #DEF OPEN=#1 [ " THIS IS AN OPEN MODE 2*P2 #DEF OFWR=#2 [ " FILE MUST BE OPEN IN WRITE 2B8L [ MODE 2BN= ...MODETYPE 2C7W ... +NONE*X+9*X+1*X+OPEN 2CMG ... +NONE*X+9*X+1*X+OPEN 2D76 ... +NONE*X+9*X+1*X+OPEN 2DLQ ... +NONE*X+9*X+1*X+OPEN 2F6B ... +MEXT*X+9*X+4*X+OFWR 2FL2 ... +NONE*X+5*X+4*X+OPEN 2G5L ... +MREN*X+9*X+6*X+OFWR 2GK= ... +MCLO*X+5*X+3*X+ORD 2H4W ... +NONE*X+17*X+1*X+ORD 2HJG ... +NONE*X+17*X+1*X+OPEN 2J46 ... +MCLO*X+5*X+1*X+OFWR 2JHQ ... +NONE*X+8*X+7*X+ORD 2K3B ... +MEXT*X+6*X+6*X+OFWR 2KH2 2L2L MONTYPE +BBEXTEND 2LG= +BBRENAME 2L^W +BBCLOSE 2MFG 2M^6 2NDQ OBJLINK 2NYB PAIR EDOBJ,1 2PD2 STARTLINK 2PXL PAIR EDSTART,1 2P^T ...[ 2Q44 ...TOPCA [CHANGE TO APET LEAVING LINK TO K1EDSTART 2Q6? ...[ LINK X4; EXPECTS X1=FX1; NO COOR 2Q8G ... TOPCA1 STARTLINK(1) 2Q=P ... EXIT 4 0 2Q#Y ...[ 2QC= 2QWW Z1EDSTART [ENTRY ON 1ST PERI & AFTER MONITOR OR 2RBG [ ILLEGAL 2RW6 LDX 0 EDPTIME(2) 2S*Q BPZ 0 NOT1ST 2STB LDX 0 CLEANCT 2T*2 STO 0 EDPTIME(2) [INITIALISE PERI TIMER WD 2TSL NOT1ST 2W#= ... LDX 3 EVENT4(2) [TYPE-MODE WORD 2XR6 LDCH 4 3 [B18-23 OF MODE 2Y=Q SRL 3 6 2YQB LDX 6 3 2^=2 ANDN 3 #17 [B14-17 OF MODE 2^PL BNZ 3 NOTRAN [JIF NOT A TRANSFER MODE 329= ... ACROSS EDOBJ,1 32NW NOTRAN 34MB LDN 0 MAXMODE/#100 3572 BXL 0 3,NOTMODE [JIF NOT A VALID MODE 35LL BNZ 4 NOTMODE [ DITTO 366= SBN 3 1 36KW LDX 4 3 375G SMO FX1 37K6 LDCH 7 MODETYPE(3) 384Q BZE 7 NOMON [JIF NO MONITORING ON THIS MODE 38JB SMO 7 3942 LDX 5 MONTYPE-1(1) [GET MONITORING TYPE 39HL TESTMON APETADDR(2),5,FTYPNO(2),MONITOR 3=3= NOMON 3=GW ANDN 6 #700 3?2G BNZ 6 MODERR [JIF INVALID ADDITIVE MODE 3?G6 SMO FX1 3?^Q LDX 7 MODETYPE(3) 3#FB ANDN 7 OPEN 3#^2 BZE 7 NOTOPEN [JIF NOT AN OPEN MODE 3*DL LDXC 0 ALTMARK(2) 3*Y= BCS OPALRDY [JIF AN OPEN MODE & FILE ALREADY OPEN 3BCW NOTOPEN 3BXG BCHX 3 £ 3CC6 SMO FX1 3CWQ LDCH 7 MODETYPE(3) [CA LENGTH 3DBB ... CHECKA ACAP(2),7,RVCA,APETADDR(2),,OKCA,,,K1EDSTART 3DW2 OKCA 3KQ= ... BCHX 3 £ 3L9W ... SMO FX1 3LPG ... LDCH 7 MODETYPE(3) 3MNQ LDX 5 ACAP(2) 3N8B LDN 6 ACA1(2) 3NN2 FOUTMOVE APETADDR(2),5,6,7,HLOCK1,2 [MOVE REQD CA TO AOLPT 3PM= STOZ ACA2(2) 3PPF ... SMO FX1 3PRN ... LDX 7 MODETYPE(3) 3PTX ... ANDN 7 OFWR 3PY6 ... BZE 7 NOCHWR [JIF FILE DOESN'T HAVE TO BE OFW 3Q2* ... JBC NOTWRITE,FILERING(2),BAMWRITE [J IF FILE NOT OPEN FOR WRI 3Q4J ...NOCHWR 3Q6W TOPFCB2 1 3QLG ADX 4 FX1 3R66 EXIT 4 £ [EXIT TO JUMP TO APPROPRIATE ROUTINE 3RKQ BRN M100 3S5B BRN M200 3SK2 BRN M300 3T4L BRN M400 3TJ= BRN M500 3W3W BRN M600 3WHG BRN M700 3X36 BRN M1000 3XGQ BRN M1100 3Y2B BRN M1200 3YG2 BRN M1300 3Y^L BRN M1400 3^F= BRN M1500 3^YW 42DG M100 [OPEN IN OVERLAY MODE 42Y6 M200 [OPEN IN READ MODE 43CQ M300 [OPEN IN WRITE MODE 43XB M400 [OPEN IN OFFSET (AT END OF FILE) MODE 44C2 LDX 0 AEFLOW(2) 44WL STO 0 ACA6(2) [2ND LEVEL O'FLOW BKT 45B= LDX 0 AEORG(2) 45TW STO 0 ACA8(2) [FILE ORGANISATION 46*G LDX 0 AEKEY(2) 46T6 STO 0 ACA9(2) [KEY DETAILS 47#Q LDN 7 9 [LENGTH OF CA TO BE MOVED TO OBJ PROG 47SB NAME 48#2 LDN 4 FLOC1(1) 48RL LDN 5 ACA3(2) 49?= MOVE 4 3 [FILENAME 49QW LDX 0 FGEN(1) 4==G SLL 0 12 4=Q6 ORX 0 FVERSION(1) 4?9Q STO 0 ACA7(2) [GENERATION & VERSION 4?PB BRN REPLY 4#92 4#NL M700 [RENAME 4*8= LDN 7 7 4*MW BRN NAME 4B7G 4BM6 M1100 [READ FILE SPEC 4C6Q LDCT 0 #200 4CLB STO 0 ACA2(2) [UDAS INDICATOR IN REPLY 4D62 4DKL M1200 [CREATE & OPEN 4F5= LDX 0 AEFLOW(2) 4FJW STO 0 ACA6(2) [2ND LEVEL O'FLOW BKT 4G4G LDX 0 AEINF3(2) 4GJ6 LDX 4 FSIZE(1) 4H3Q BZE 4 NOAREA 4HHB ORN 0 1 [1 FILE AREA IF FILE NOT EMPTY 4J32 NOAREA 4JGL STO 0 ACA8(2) [INT. CODE & NO. OF FILE AREAS 4K2= LDX 0 AEWRITDAY(2) 4KFW STO 0 ACA9(2) [DATE WRITTEN 4K^G LDX 0 FENDBUCK(1) 4LF6 ADN 0 1 4LYQ STO 0 ACA13(2) [END OF FILE BKT 4MDB STOZ ACA14(2) 4MY2 STOZ ACA15(2) 4NCL STOZ ACA16(2) 4NX= STOZ ACA17(2) 4PBW LDN 7 17 4PWG BRN NAME 4QB6 4QTQ M500 [EXTEND/CONTRACT 4R*B LDN 7 0 [INDICATE #500 (AS OPPOSED TO #1500) 4RT2 LDX 4 ACA4(2) [NO. H/W BLOX 4S#L SRA 4 1 [ 4SS= SRA 4 1 [ROUND TO MULTIPLE OF 8 4T?W SRA 4 1 [ 4TRG SLL 4 3-BLS [ & CONVERT TO BS BLOX 4W?6 BPZ 4 NOTCONTRACT [JIF NOT CONTRACT 4WQQ ADX 4 FSIZE(1) 4X=B SMO FILERING(2) 4XQ2 LDX 5 FREADWORD 4Y9L SMO ALOG(2) 4YP= SLL 5 0 4^8W SRL 5 GSBSLOG 4^NG SBX 4 5 [CAN'T LOSE E.O.F. BKT IF OFFSET 5286 BPZ 4 NOTNEG 52MQ LDN 4 0 [FSIZE CAN'T BECOME -VE 537B NOTNEG 53M2 ADX 4 5 [X4=RESULTANT FILE SIZE IN BS BLOX 546L LDX 5 4 54L= ADN 5 FBLKS-A1 555W SBX 5 FBLMOD(1) 55KG BPZ 5 NOTFBLMOD [JIF FREEING PART OF FILE NOT WRITTEN 5656 NGX 5 5 56JQ SUBCUBS ,5,JOB,DEPTH [REDUCE "CURRENT USED B.S." 574B TOPFCB2 3 57J2 SBS 5 FBLMOD(3) [RESET FBLMOD 583L # 58H= # FREE ANY USAGE BLOX FOR THE BS BLOX FREED. 592W # 59GG LDX 1 FPTR(3) [SKIP FSTACK 5=26 SBUFFS 5=FQ LDX 1 FPTR(1) 5=^B SBUFFT 5?F2 BXE 1 CXFI,NOBUFF [JIF END OF FILE CHAIN 5?YL LDX 0 ATYPE(1) 5#D= SRL 0 12 5#XW ERN 0 FILE+FCB 5*CG BZE 0 NOBUFF [JIF NEXT FILE'S FCB 5*X6 ERN 0 FEXTRA$FCB 5BBQ BZE 0 NOBUFF [JIF THIS WORKFILE'S FEXTRA 5BWB ERN 0 FURRB$FEXTRA 5CB2 BZE 0 YBUFF [JIF A FURRB 5CTL ERN 0 FURWB$FURRB 5D*= BNZ 0 SBUFFS [JIF NOT A FURWB 5DSW YBUFF 5F#G BZE 4 RIDBUFF [JIF WHOLE FILE FREED 5FS6 LDX 0 BACK2(1) 5G?Q ORN 0 BLN-1 5GRB ERN 0 BLN-1 [CLEAR BLT NO. 5H?2 LDX 5 4 5HQL STILLQ 5J== SMO 5 5JPW TXU 0 FBLKS-1(3) 5K9G BCC SBUFFS [JIF BLK STILL IN FILE 5KP6 BCT 5 STILLQ 5L8Q RIDBUFF 5LNB LDX 5 FPTR(1) [KEEP PTR. TO NEXT BLK 5M82 FREECORE 1 [FREE BUFFER 5MML LDX 1 5 5N7= BRN SBUFFT 5NLW NOBUFF 5P6G LDX 1 3 [RESTORE PTR. TO FCB 5PL6 NOTFBLMOD 5Q5Q NGX 5 FSIZE(1) [OLD FILE SIZE 5QKB STO 4 FSIZE(1) [NEW FILE SIZE 5R52 BRN SHRUNK 5RJL NOTCONTRACT 5S4= BNZ 4 XTEND [JIF NOT DUMMY EXTEND 5SHW LDX 4 FSIZE(1) [NEW FILE SIZE 5T3G NGX 5 4 [OLD FILE SIZE (I.E. NO CHANGE) 5TH6 BRN ZERO 5W2Q 5WGB M1500 [EXTEND INTO AREA 5X22 LDN 7 4 [#1500 INDICATOR & REPLY LENGTH 5XFL LDXC 3 ACA6(2) [END SEG 5X^= BCS XTERR 5YDW LDXC 4 ACA5(2) [START SEG 5YYG BCS XTERR 5^D6 SRA 3 1 [ 5^XQ SRA 3 1 [ROUND UP END SEG 62CB SRA 3 1 62X2 SRL 4 3 [ROUND DOWN START SEG 63BL SBX 3 4 [GIVING NO. SEGS PER CYL /8 63W= BNG 3 XTERR 64*W BZE 3 XTERR 64TG SLL 3 3-BLS [CONVERT TO BS BLOX PER CYL 65*6 LDX 5 GSIGN 65SQ ORS 5 ACA4(2) [SET "NOT FULL CYL" REPLY 66#B ERX 5 ACA4(2) [END CYL 66S2 NGNC 4 1 67?L ANDX 4 ACA3(2) [START CYL 67R= SBX 5 4 68=W BNG 5 XTERR 68QG ADN 5 1 [NO. OF CYLS 69=6 MPY 3 5 [X4=TOTAL NO. BS BLOX 69PQ BNZ 3 XTERR 6=9B XTEND 6=P2 ADX 4 FSIZE(1) 6?8L SBN 4 FILESIZE 6?N= LDN 0 FILESIZE 6#7W BNG 4 NUFF [JIF WOULDN'T BE > MAX FILE SIZE 6#MG BZE 4 NUFF 6*76 BNZ 7 XTERR [JIF #1500 6*LQ SBX 0 FSIZE(1) [GIVING AMOUNT AVAILABLE 6B6B SRL 0 3-BLS [CONVERT TO H/W BLOX 6BL2 SLL 0 3 [ & ROUND TO MULTIPLE OF 8 6C5L BNZ 0 REPFAIL 6CK= LDN 0 1 [NONE AVAILABLE REPLY 6D4W BRN REPFAIL 6DJG NUFF 6F46 ADX 0 4 6FHQ LDX 4 FSIZE(1) 6G3B STO 0 FSIZE(1) [NEW FILE SIZE 6GH2 NGX 5 4 [OLD FILE SIZE 6H2L SHRUNK 6HG= ... MBS 1,BFALTR,BFALTB 6JFG BNZ 7 REPLY [JIF #1500 6J^6 ZERO 6KDQ SLL 4 GSBSLOG 6KYB SMO ALOG(2) 6LD2 SRL 4 0 [CONVERT REPLY TO BKTS 6LXL SMO FILERING(2) 6MC= SBX 4 FREADWORD [ZERO UNLESS OFFSET 6MWW STO 4 ACA2(2) [MAIN REPLY 6NBG ADX 5 FSIZE(1) [GIVING NO. BLOX EXTENDED BY (WILL BE 6NW6 SLL 5 GSBSLOG [ -VE FOR CONTRACT) 6P*Q SMO ALOG(2) 6PTB SRA 5 0 [CONVERT TO BKTS 6Q*2 STO 5 ACA3(2) [SUBSIDIARY REPLY 6QSL STOZ ACA5(2) [CSN REPLY 6R#= LDN 7 5 6RRW BRN REPLY 6S?G 6SR6 M600 [OPEN SCRATCH FILE 6T=Q LDX 5 AEORG(2) 6TQB ANDN 5 #77 [BKT SIZE OF FILE 6W=2 LDX 6 FSIZE(1) 6WPL SLL 6 BLS [SIZE OF FILE IN H/W BLOX 6X9= LDX 0 ABITS(2) 6XNW BZE 0 NMAYB [JIF 'MAYBE' NOT GIVEN 6Y8G BXE 5 ACA3(2),OKBUCK [JIF BKT SIZE CORRECT 6YN6 LDN 6 1 6^7Q TOOSMALL 6^MB ORX 6 GSIGN 7272 STO 6 ACA2(2) 72LL LDN 7 2 736= BRN NOTOPEND 73KW OKBUCK 745G BXL 6 ACA4(2),TOOSMALL [JIF FILE TOO SMALL 74K6 NMAYB 754Q STO 5 ACA3(2) [BKT SIZE REPLY 75JB STO 6 ACA4(2) [FILE SIZE REPLY 7642 SLL 6 GSBSLOG-BLS 76HL SMO ALOG(2) 773= SRL 6 0 77GW STO 6 ACA2(2) [LAST BKT NO. IN FILE 782G STOZ ACA5(2) [CSN REPLY 78G6 LDN 7 5 78^Q BRN REPLY 79FB 79^2 M1000 [CLOSE 7=DL LDX 4 ACA3(2) 7=Y= BZE 4 REL [JIF E.O.F. BKT NOT TO BE UPDATED 7?CW ... TOPFCA2 3 7?XG ... JBC REL,3,BAMWRITE [CAN'T UPDATE EOF BUCKET IF READ 7*BB BPZ 4 TAG [ALWAYS UPDATE IF +VE 7*W2 SETMODE 0,OFFSET 7B*L ANDX 0 FSCMODE(2) 7BT= BNZ 0 REL [CAN'T REDUCE E.O.F. BKT IF OFFSET 7C#W TAG 7CSG ADS 4 FENDBUCK(1) 7D#6 ... BS 1,BFALTR 7F?B REL 7FR2 RELOFP FTYPNO(2) 7G=L 7GQ= M1300 [CLOSE & DELETE FILE 7H9W SETMODE 0,OFFSET 7HPG ANDX 0 FSCMODE(2) 7J96 BNZ 0 NOTWRITE [CAN'T IF OFFSET 7JNQ LDX 0 FSIZE(1) 7K8B BNZ 0 NOTEMPTY [CAN'T IF NOT EMPTY 7KN2 LDN 7 2 7L7L CALL 6 REPMOVE [SET REPLY 7LM= BRN REL 7M6W 7MLG M1400 [DESCRIBE FILE AREA 7N66 LDX 0 ACA7(2) 7NKQ SBN 0 1 7P5B BNG 0 OUTRANGE [JIF BKT NO. -VE OR ZERO 7PK2 SMO FILERING(2) 7Q4L ADX 0 FREADWORD [ZERO UNLESS OFFSET 7QJ= LDX 4 FSIZE(1) 7R3W SLL 4 GSBSLOG 7RHG SMO ALOG(2) 7S36 SRL 4 0 7SGQ BXGE 0 4,OUTRANGE [JIF BKT NO. OUT OF RANGE 7T2B LDCT 0 #200 7TG2 STO 0 ACA2(2) [UDAS INDICATOR REPLY 7T^L STOZ ACA3(2) 7WF= LDCT 0 #400 7WYW STO 0 ACA4(2) ["NOT FULL CYL" REPLY 7XDG STOZ ACA5(2) 7XY6 STOZ ACA6(2) 7YCQ SMO FILERING(2) 7YXB SBX 4 FREADWORD 7^C2 ADN 4 1 [GIVING LAST BKT NO. +1 7^WL STO 4 ACA7(2) 82B= LDCT 0 #40 82TW STO 0 ACA8(2) [G3 FILESTORE FILE INDICATOR 83*G LDN 7 8 83T6 BRN REPLY 84#Q 84SB NOTWRITE 85#2 LDN 0 5 [FILE NOT OPEN FOR WRITING REPLY 85RL BRN REPFAIL 86?= XTERR 86QW LDN 0 4 [INVALID #1500 REPLY 87=G BRN REPFAIL 87Q6 NOTEMPTY 889Q LDN 0 1 [#1300 FILE NOT EMPTY REPLY 88PB BRN REPFAIL 8992 OUTRANGE 89NL LDN 0 0 [#1400 BKT OUT OF RANGE REPLY 8=8= REPFAIL 8=MW ORX 0 GSIGN [FAIL BIT 8?7G STO 0 ACA2(2) 8?M6 LDN 7 2 8#6Q 8#LB REPLY 8*62 LDX 0 GSIGN 8*KL ORS 0 ALTMARK(2) [SET FILE OPEN MARKER 8B5= NOTOPEND [FAILED #600. FILE NOT OPENED 8BJW CALL 6 REPMOVE [SET REPLIES 8C4G LDX 1 FX1 8CJ6 OLPFIN1 OBJLINK(1) 8D3Q 8DHB REPMOVE 8F32 LDN 4 ACA1(2) 8FGL LDX 5 ACAP(2) 8G2= FINMOVE APETADDR(2),5,4,7,HLOCK1,2 8GFW EXIT 6 0 8G^G 8HF6 NOTMODE 8HYQ LDN 3 FYMNOTREC 8JDB BRN XILL 8JY2 MODERR 8KCL LDN 3 FYMODE 8KX= BRN XILL 8LBW OPALRDY 8LWG LDN 3 FYALLOC 8MB6 BRN XILL 8MTQ RVCA 8N*B LDN 3 FYNOCA 8NT2 8P#L 8PS= XILL 8Q?W ACROSS OLPODD,5 [FOR TOPCA1,UNPLUG,ILLEGAL 8QRG 8R?6 MONITOR 8RQQ LDX 6 FTYPNO(2) 8S=B LDX 7 ACAP(2) 8SQ2 ... CALL 4 TOPCA [CHANGE TO APET 8T9L REPMON 1 8T9T ...[ 8T=4 ...[ 8T=? ...ZINCRECUBS [ENTRY FROM EDOBJ(ACROSS) TO INCREASE CUBS BY [X6] 8T=G ...[ 8T=P ... INCRECUB ANSWER,,6 8T=Y ... TESTREP2 REFUSED,REFUSED 8T?7 ... ACROSS EDOBJ,2 [OK - RETURN 8T?B ...[ 8T?K ...[ 8T?S ...REFUSED 8T#3 ... CALL 4 TOPCA [CHANGE TO APET 8T#= ... ACROSS OLPODD,3 [ASK FOR MORE 8T#F ...[ 8T#N ...[ 8T#X ...ZGETBLOCKS [ENTRY DOWN FROM EDOBJ TO GET MORE BLOCKS 8T*6 ...[ 8T** ...# 8T*J ...# THE NEXT SECTION GETS MORE BLOX FOR THE FILE WHEN THERE ARE NOT 8T*R ...# ENOUGH FOR THIS PERI. 8TB2 ...# 8TB9 ... TOPFCB2 1 8TBD ... SBN 3 FBLKS-A1-10 [TRY TO GET 10 MORE THAN REQD 8TBM ... BXL 3 FSIZE(1),NOTMAX 8TBW ... LDX 3 FSIZE(1) [TOO MUCH - GET AS MUCH AS POSS 8TC5 ... SBN 3 1 8TC# ...NOTMAX 8TCH ... ADN 3 FBLKS-A1 8TCQ ... LDX 5 FUSEBL(1) [REMEMBER END OF BLK NOS. IN FCB 8TC^ ... BXL 3 ALOGLEN(1),NOALTLEN 8TD8 ... LDX 4 1 8TDC ... ALTLENGD 4,1(3),REFINDFCB 8TDL ...NOALTLEN 8TDT ... ADN 3 3 [GIVING NEW FCB SIZE +2 8TF4 ... SBX 3 5 [NOW = NO. OF XTRA BLOX +2 8TF? ... SETUPCOR 3,1,BSTB,EMPTYB [FOR XTRA BLOX 8TFG ... STO 3 A1(1) [REC. HEADER 8TFP ...NEWBLOX 8TFY ... TOPFCB2 2 8TG7 ... LDX 4 BSPRE(2) 8TGB ... STO 4 A1+1(1) [RESIDENCE (LOG. FILE) 8TGK ... GETBAX [GET NEW BLOX 8TGS ...[ 8TH3 ... SEGENTRY BSCLEARZ [UNIVERSAL FOR BSCLEAR MACRO 8TH= ... BRN XRES [NULLED BY BSCLEAR MACRO 8THF ... DOWN CREATE,3 [TO ZEROIZE NEW BS 8THN ...XRES 8THX ... CALL 1 REFINDFCB 8TJ6 ... BXE 4 BSPRE(2),NCOPIED [JIF RESIDECE NOT CHANGED (COPYFILE) 8TJ* ... FREEBAX [FREE NEW BLOX ON OLD RESIDENCE 8TJJ ... MHUNTW 1,BSTB,EMPTYB 8TJR ... BRN NEWBLOX [J TO GET BLOX ON NEW RESIDENCE 8TK2 ... 8TK9 ...REFINDFCB 8TKD ... TOPFCB 2 [RELOCATE FCB FOR ALTLENG 8TKM ... EXIT 1 0 8TKW ... 8TL5 ...NCOPIED 8TL# ... MHUNTW 1,BSTB,FULLB 8TLH ... LDN 4 A1+2(1) [-> BS BLK NOS. 8TLQ ... ADN 5 A1(2) [-> END OF FCB 8TL^ ... SBN 3 2 [GIVING NO. OF NEW BLOX 8TM8 ... MOVE 4 0(3) [BUNG 'EM IN 8TMC ... ADS 3 FUSEBL(2) [UPDATE NO. OF BLOX THE FILE HAS 8TML ... FREECORE 1 [FREE FULLB 8TMT ... UP 8TN4 ...[ 8TN? ...[ 8TP= MENDAREA AOLPGAP,K99EDSTART 8W8W #END ^^^^ ...26231752000200000000