{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: ORELEMPT70)}}
====== ORELEMPT70 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BXE|BXE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GFCB|GFCB]], [[george:macro:HUNTW|HUNTW]], [[george:macro:JMBS|JMBS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEBAX|MFREEBAX]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:NEXTFCB|NEXTFCB]], [[george:macro:PSTAC|PSTAC]], [[george:macro:REPLACE|REPLACE]], [[george:macro:RESQUERY|RESQUERY]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SHORTEN|SHORTEN]], [[george:macro:STEP|STEP]], [[george:macro:TESTMODE|TESTMODE]], [[george:macro:TOPFCA|TOPFCA]], [[george:macro:TRACE|TRACE]], [[george:macro:UPPLUS|UPPLUS]]
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