ORELEMPT70
(George Source)
Macros used: ACROSS, ALTLEN, BACKSPACE, BXE, BXL, BXU, CHAIN, GEOERR, GFCB, HUNTW, JMBS, MENDAREA, MFREEBAX, MFREEW, MHUNTW, NAME, NEXTFCB, PSTAC, REPLACE, RESQUERY, REWRITE, SEG, SEGENTRY, SETNCORE, SETREP, SETUPCORE, SHORTEN, STEP, TESTMODE, TOPFCA, TRACE, UPPLUS
- ORELEMPT70.txt
22FL [ 22^= [ 23DW [THIS IS A TIDIED-UP VERSION WITH MODETEST 6 BITSETTING MACROS 23YG [ 24D6 SEG ORELEMPT,8,JUDY BIDGOOD,OPEN 24XQ SEGENTRY K1ORELEMPT,Z1ORELEMPT 25CB [ 25X2 [THIS ROUTINE FINDS THE FCB WHOSE UNIQUE NUMBER IS IN X6 26BL XGETFCB 26W= GFCB 6,3 27*W EXIT 2 0 27TG [THIS ROUTINE IS TO FIND THE NEXT FCB AFTER A GIVEN FCB 28*6 NEXTFCB 28SQ LDX 0 FILEPLUSFCB 29#B LDX 2 BPTR(3) 29S2 XLOPE 2=?L LDX 2 FPTR(2) 2=R= SMO FPTR(2) 2?=W BXU 0 ATYPE,XLOPE 2?QGP...#SKI IFS<1$1 2#=6P...( 2#PQ BXU 2 CXFI,NBASE 2*9B LDX 2 BFILE+1 2*P2 NBASE 2B8LP...) 2BN= EXIT 1 0 2C7W [THIS ROUTINE SETS UP A FULLB FOR B.S. TO BE FREED & CHAINS IT AFTER 2CMG [RELEVANT FMAPP 2D76 XFREEBS 2DLQ LDX 4 FUSEBL(3) 2F6B ... LDN 1 FBLKS-A1 [UPDATE FUSEBL 2FL2 STO 1 FUSEBL(3) 2G5L SBN 4 FBLKS-A1 2GK= BZE 4 NOBK [IF NO B.S. IN FILE EXIT 2H4W ADN 4 2 2HJG SBX 5 FX1 2J46 SETUPCORE 4,1,BSTB,FULLB [SET UP AFULLB TO CONTAIN 2JHQ CALL 2 XGETFCB [S. BLOCKS FROM FCB 2K3B LDN 0 BSPRE(3) 2KH2 STO 4 A1(1) 2L2L ADN 1 A1+1 2LG= SMO 4 2L^W MOVE 0 511 2MFG XCHF 2M^6 TESTMODE 7,YCAR,,CAREFUL 2NDQ TOPFCA 3 [IF NOT LAREFUL CHAIN FULLB AFTER 2NYB PSTAC 3,3 [DIRS FMAPP 2PD2 XCHFB 2PXL CALL 1 NEXTFCB [IF CAREFUL FMAPP WILL BE SET UP 2QC= MHUNTW 1,BSTB,FULLB [LATER. CHAIN FULLB AFTER BLOCK 2QWW CHAIN 1,2 [AFTER WHICH FMAPP WILL BE CHAINDE 2RBG ADX 5 FX1 2RW6 NOBK EXIT 5 0 2S*Q XCHFULLB 2STB SBX 5 FX1 2T*2 BRN XCHF 2TSL YCAR CALL 2 XGETFCB 2W#= BRN XCHFB 2WRW [THIS ROUTINE CHECKS FOR ALLOCATE 2X?G XALLOC 2XR6 MHUNTW 2,FILE,ENT 2Y=Q LDX 4 EALLOC(2) 2YQB ANDN 4 #77 2^=2 BZE 4 NALLOC [EXIT IF NOT ALLOCATED 2^PL LDN 0 48 329= BXL 4 0,NALLOC [EXIT IF RESIDENCE NO. < 48 32NW RESQUERY 4,NALLOC [EXIT IF RESIDENCE DOES NOT EXIST 338G EXIT 5 1 [ALLOCATE EXIT 33N6 NALLOC 347Q EXIT 5 0 34MB XRWBLKR 3572 SBX 5 FX1 35LL SETNCORE 2,1,FILE,FWB 366= LDN 0 2 [IF THE FILE IS NOT CAREFUL & ONLINE 36KW STO 0 A1(1) [& SOME OF ITS EXISTING B.S. IS FREED 375G CALL 2 XGETFCB [THE BLOCKS RECORD MUST BE UPDATED 37K6 LDX 0 BSPRE(3) [TO SAY THERE ARE NO BLOCKS BECAUSE 384Q STO 0 A1+1(1) [THE B.S. IS FREED WHEN THE DIR IS 38JB STEP [CLOSED THE BLOCKS RECORD MUST 3942 REPLACE [NOT THEN CONTAIN FREED B.S. 39HL MFREEW FILE,FWB 3=3= BACKSPACE 3=GW MHUNTW 1,FILE,ENT 3?2G LDN 0 1 3?G6 STO 0 ECOPS(1) [ECOPS MUST REFLECT LENGTH OF BLOCKS 3?^Q NAME 1,FILE,FWB [RECORD I.E. ZERO 3#FB REWRITE 3#^2 MHUNTW 1,FILE,FWB 3*DL NAME 1,FILE,ENT 3*Y= ADX 5 FX1 3BCW EXIT 5 0 3BXG [ 3CC6 Z1ORELEMPT [ENTRY POINT 3CWQ [ 3DBB STOZ AWORK1(2) [ZEROIZE ' NO BLOCKS ALTERED' MARKER 3DW2 TESTMODE 7,NEM,NOT,EMPTY 3F*L MHUNTW 1,FILE,ENT 3FT= LDEX 0 ECOPS(1) 3G#W BZE 0 YOF [J IF FILE EMPTY & OFFLINE 3GDR ... LDCT 0 #777 3GJN ... ANDX 0 ECOPS(1) 3GNK ... BZE 0 YOF 3GSG CALL 2 XGETFCB 3H#6 TESTMODE 7,NOFF,NOT,ERASING,CAREFUL 3HRQ LDN 0 2 3J?B SMO FX2 [SET 'NO.OF BLOCKS ALTERED' MARKER 3JR2 ORS 0 AWORK1 3K=L #SKI K6ORELEMPT>100-100 3KQ= TRACE 0,ERCARE 3L9W CALL 5 XFREEBS ['FREE' B.S. IF ANY IN FILE 3LPG TESTMODE 7,NBSG,,ERASING [NO BS REQUIRED IF ERASING 3M96 HUNTW 1,BSTB,FULLB [IF NO HULLB GET NO B.S. 3MNQ BNG 1 NBSG 3N8B BRN UFULLB 3NN2 NOFF 3P7L HUNTW 1,BSTB,FULLB [IF NO FULLB GIVEN DON'T CHANGE B.S. 3PM= #SKI K6ORELEMPT>100-100 3Q6W TRACE 1,FULLBPTR 3QLG BNG 1 NOF [ALREADY ALLOCATED TO FILE 3R66 LDN 0 2 3RKQ SMO FX2 [SET 'NO.OF BLOCKS ALTERED' MARKER 3S5B ORS 0 AWORK1 3SK2 CALL 5 XALLOC [TEST IF ALLOCATED 3T4L BRN NAL 3TJ= BRN YAL 3W3W NAL [NOT ALLOCATED PATH 3WHG CALL 5 XFREEBS 3X36 CALL 5 XRWBLKR [UPDATE DIR 3XGQ UFB 3Y2B MHUNTW 1,BSTB,FULLB 3YG2 UFULLB 3Y^L #SKI K6ORELEMPT>100-100 3^F= TRACE 4,CARENALL 3^YW CALL 2 XGETFCB 42DG LDX 4 A1(1) 42Y6 ADN 4 FBLKS-A1-2 [CALCULATE REQUIRED NEW LENGTH OF 43CQ #SKI K6ORELEMPT>100-100 43XB TRACE 4,NEWFCBLN 44C2 ALTLEN 3,4 [FCB & ALTER LENGTH 44WL TESTMODE 7,NCC1,,EMPTY 45B= CALL 5 XALLOC [IF MODE IS NOT EMPTY, DIR MAY NOT 45TW BRN NCC1 [STILL BE OPEN TO THIS ACT & THUS 46*G MHUNTW 1,BSTB,FULLB [FILE COULD HAVE BEEN ALLOCATED, 46T6 BXU 4 A1+1(1),YCC [WHICH CASE OUR B.S. WRONG SO GIVE UP 47#Q BRN NCC2 47SB NCC1 48#2 MHUNTW 1,BSTB,FULLB 48RL NCC2 49?= CALL 2 XGETFCB 49QW LDX 4 ALOGLEN(3) 4==G STO 4 FUSEBL(3) [UPDATE FUSEBL 4=Q6 ADN 3 BSPRE [COPY B.S. FROM FULLB TO FCB 4?9Q LDN 2 A1+1(1) 4?PB SMO A1(1) 4#92 MOVE 2 511 4#NL MFREEW BSTB,FULLB [FREE FULLB 4*8= BRN NOF 4*MW YCC 4B7G CALL 2 XGETFCB 4BM6 LDX 4 FUSEBL(3) [IF WE HAVE DECIDED TO GIVE UP, PUT 4C6Q ALTLEN 3,4 [FCB BACK TO OLD LENGTH 4CLB BRN YFCB 4D62 YAL [ALLOCATED PATH 4DKL #SKI K6ORELEMPT>100-100 4F5= TRACE 4,NCAREALL 4FJW MHUNTW 1,BSTB,FULLB [IF FULLB GIVEN HAS B.S. ON CORRECT 4G4G LDX 5 A1(1) 4GJ6 CALL 2 XGETFCB 4H3Q SBN 5 2 4HHB LDX 0 FUSEBL(3) [CALCULATE DIFFERENCE BETWEEN NO. OF 4J32 #SKI K6ORELEMPT>100-100 4JGL TRACE 0,FCBLEN 4K2= SBN 0 FBLKS-A1 [B.S. BLOCKS ALREADY ALLOCATED TOFILE 4KFW SBX 5 0 [& NO. OF B.S. BLOCKS IN GIVEN FULLB 4K^G BZE 5 YFCB [IF NO DIFFERENCE NO CHANGE NECESSARY 4LF6 BNG 5 XCESS [J IF BLOCKS TO BE "FREED" 4LYQ LDX 4 ALOGLEN(3) 4MDB ADX 4 5 4MY2 #SKI K6ORELEMPT>100-100 4NCL TRACE 4,ALLFCBL 4NX= ALTLEN 3,4 4PBW CALL 2 XGETFCB 4PWG LDN 2 A1(3) 4QB6 ADX 2 ALOGLEN(3) 4QTQ SBX 2 5 [COPY NUMBER OF B.S. BLOCKS REQUIRED 4R*B MHUNTW 1,BSTB,FULLB [TO MAKE NUMBER IN FCG EQUAL TO 4RT2 ADN 1 A1 [NUMBER IN FULLB 4S#L ADX 1 0(1) 4SS= SBX 1 5 4T?W SMO 5 4TRG MOVE 1 0 [TAKE REQUISITE NUMBER OF BLOCKS 4W?6 CALL 2 XGETFCB [FROM END OF FULLB TO END OF FCB 4WQQ LDX 0 ALOGLEN(3) 4X=B STO 0 FUSEBL(3) 4XQ2 MHUNTW 1,BSTB,FULLB 4Y9L LDX 2 ALOGLEN(3) 4YP= SBN 2 FBLKS-A1-2 4^8W SBX 2 5 4^NG STO 2 A1(1) [RESET RECORD HEADER IN FULLB 5286 SHORTEN 1,0(2) [SHORTEN FULLB TO REFLECT NUMBER OF 52MQ MFREEBAX 537B BRN NOF 53M2 NBSG 546L CALL 2 XGETFCB 54L= LDN 1 FBLKS-A1 555W XSH STO 1 FUSEBL(3) [UPDATE FUSEBL 55KG XSHO 5656 #SKI K6ORELEMPT>100-100 56JQ TRACE 0(1),SHORTFCB 574B SHORTEN 3,0(1) [SHORTEN FCB 57J2 NOF 583L LDN 5 0 58H= CALL 2 XGETFCB 592W JMBS XACC,3,BFSER,BFMT [IF *DA : FBLMOD=FUSEBL 59GG LDX 0 FUSEBL(3) 5=26 STO 0 FBLMOD(3) 5=FQ XACC 5=^B ACROSS ORELEND,1 5?F2 XCESS 5?YL MFREEBAX 5#D= NGX 5 5 5#XW ADN 5 2 5*CG #SKI K6ORELEMPT>100-100 5*X6 TRACE 5,XCESS 5BBQ SETUPCORE 5,1,BSTB,FULLB 5BWB CALL 2 XGETFCB 5CB2 STO 5 A1(1) 5CTL SBN 5 2 [MOVE THE REQUISITE NUMBER OF B.S. 5D*= LDX 0 BSPRE(3) [FROM THE END OF THE FCB TO A FULLB 5DSW STO 0 A1+1(1) 5F#G ADN 1 A1+2 5FS6 LDX 0 FUSEBL(3) 5G?Q ADN 0 A1(3) 5GRB SBX 0 5 5H?2 SMO 5 5HQL MOVE 0 0 5J== SBS 5 FUSEBL(3) [REMOVE NUMBER OF B.S. BLOCKS FROM 5JPW CALL 5 XCHFULLB [FCB SO THST NUMBER LEFT EQUALS 5K9G CALL 5 XRWBLKR [UPDATE DIR 5KP6 CALL 2 XGETFCB [NUMBER IN FULLB. 5L8Q LDX 1 FUSEBL(3) 5LNB BRN XSHO 5M82 XGR GEOERR 1,DIRBRK 5MML TRCLU 5N7= SETREP NAME 5NLW UPF 5P6G UPPLUS 1 5PL6 YOF 5Q5Q TESTMODE 7,NOF,,ERASING [IF ERASING+EMPTY 5QKB MHUNTW 1,BSTB,FULLB [IF THERE IS A FULLB THE B.S. FROM 5R52 MHUNTW 2,FILE,FCB [IT SHOULD BE PUT INTO FCB 5RJL BNG 1 NOF 5S4= BNG 2 UFULLB [IF FCB IN ACT CHAIN THEN ONE SET 5SHW LDN 0 2 [SET 'NO.OF BS ALTERED' MARKER 5T3G SMO FX2 5TH6 ORS 0 AWORK1 5W2Q CALL 2 XGETFCB [UP BY THIS OPEN WAS NOT USED. THUS 5WGB LDX 4 FUSEBL(3) [FCB IN FILE CHAIN COULD HAVE 5X22 LDN 0 FBLKS-A1 [DIFFERENT B.S. IN IT. SINCE THE 5XFL STO 0 FUSEBL(3) [DIRENT IS MARKED AS HAVING NO 5X^= SBN 4 FBLKS-A1 [BLOCKS THIS B.S. CAN BE FREED AS 5YDW BZE 4 UFB [IT IS NOT RECORDED IN DIRENT 5YYG ADN 4 2 [AND THE B.S. IN OUR FULLB CAN BE 5^D6 SETUPCORE 4,1,BSTB,FULLB [USED 5^XQ CALL 2 XGETFCB 62CB LDN 0 BSPRE(3) 62X2 STO 4 A1(1) 63BL ADN 1 A1+1 63W= SMO 4 64*W MOVE 0 511 64TG MFREEBAX 65*6 BRN UFB 65SQ NEM 66#B MHUNTW 1,BSTB,FULLB [IF THERE IS NO FULLB THEN NO B.S. 66S2 BNG 1 NOF [SHOULD BE ADDED TO FCB 67?L LDN 0 2 67R= BXE 0 A1(1),NOF [IF FULLB IS EMPTY NO B.S. SHOULD BE 68=W CALL 5 XALLOC 68QG BRN NOA [IF MODE IS NOT EMPTY, DIR MAY NOT 69=6 MHUNTW 1,BSTB,FULLB [BE OPEN TO THIS ACT, THUS FILE COULD 69PQ BXU 4 A1+1(1),YFCB [HAVE BEEN ALLOCATED SINCE B.S. WAS 6=9B [GOT, IN WHICH CASE WE GIVE UP 6=P2 NOA 6?8L MHUNTW 2,FILE,FCB [ADDED TO FCB 6?N= BPZ 2 YFCB 6#7W CALL 2 XGETFCB [IF THERE IS AN FCB IN ACT CHAIN, OUR 6#MG LDX 0 FUSEBL(3) [FCB WAS NOT USED, THUS OUR B.S. 6*76 SBN 0 FBLKS-A1 [SHOULD NOT BE USED. IF FCB IN FILE 6*LQ ... BZE 0 UFB [CHAIN HAS B.S. ALREADY THEN OUR 6B6B YFCB [B.S. SHOULD BE FREED. 6BL2 MFREEBAX 6C5L BRN NOF 6CK= [ 6D4W MENDAREA GAPOPEN,K99ORELEMPT 6DJG #END ^^^^ ...33620740000500000000