(George Source)
Macros used: ACROSS, ALTLENR, BACKSPACE, CHAIN, ERASEND, GEOERR, HUNT, JBC, JBCC, LOCFCB, LONGON, MENDAREA, MHUNT, MHUNTW, NAME, OPENEND, RESTOREN, REWRITE, RINGFILE, SEG, SEGENTRY, SETNCORE, TESTOPEN, TESTRPN2, THAW, THAWSAVE, TRACEIF, UNOPCH, UP, UPPLUS
22FL SEG OPENEND,,JUDY BIDGOOD,OPEN 22^= SEGENTRY K1OPENEND,OPENEND 23DW SEGENTRY K2OPENEND,THAW 23YG SEGENTRY K3OPENEND,TESTOPEN 24D6 SEGENTRY K4OPENEND,THAWSAVE 24MY ... SEGENTRY K5OPENEND,RESTOREN 24XQ # THIS ROUTINE PUTS THE LAST LOCAL NAME OF A GIVEN FILE/FABSNB INTO A F 25CB [ 25X2 OPENEND [ENTER 26BL LDX 7 ACOMMUNE7(2) 26W= HUNT 1,FILE,FABSNB 27*W LDX 4 ALOGLEN(1) [X4 = 4+6N+R 27TG LDX 0 4 28*6 SBX 0 A1(1) [SEE IF RECORD HEADER =LOGICAL LENGTH 28SQ BZE 0 SAME [J IF SAME 29#B SBN 0 6 29S2 BNG 0 SAME [J IF DIFFERENCE IS LESS THAN SIX 2=?L LDX 4 A1(1) [OTHERWISE GO BY RECORD LENGTH 2=R= SAME 2?=W SBN 4 4 2?QG LDN 6 6 2#=6 DVS 3 6 [X3=R 2#PQ MPY 4 6 [X5=6N 2*9B TRACEIF K6OPENEND,199,299,3,OPENLAST 2*P2 SETUPCOR 6(3),2,FILE,FLOCNB [GET R+6 WORD FLOCNB 2B8L HUNT 1,FILE,FABSNB 2BN= LDX 0 ATYPE(1) 2C7W DSA 0 ATYPE(2) [TRANSFER TYPE BITS 2CMG ADN 2 A1 [POINTER TO CLOCNB 2D76 ADX 1 5 2DLQ ADN 1 A1-2 [X1 -> LAST LOCAL NAME 2F6B MOVE 1 6(3) 2FL2 ACROSS OPENREL,5 [SETTING OF X7 MATTERS. 2G5L [THIS IS THE ENTRY POINT FOR THE THAW MACRO. 2GK= THAW 2H4W LDN 6 EAUTOCOUNT 2HJG LDN 5 FREEZECOUNT 2J46 BRN MERGE 2JHQ THAWSAVE [ENTRY FOR THAW WITH 'SAVE' PARAMETER 2K3B LDN 6 ESAVECOUNT 2KH2 LDN 5 FSVCT 2L2L MERGE 2LG= MHUNTW 1,FILE,ENT 2L^W LDEX 0 ECOPS(1) [IF NO ONLINE COPIES OF FILE THE 2MFG BZE 0 NBS [DIRECTORY ALREADY POSITIONED AFTER 2M^6 BACKSPACE [NAME RECORD & THUS IS OK,OTHERWISE 2NDQ MHUNTW 1,FILE,ENT 2NYB NBS 2PD2 SMO 6 2PXL LDEX 7 0(1) [GET FREEZE OR SAVE COUNT 2QC= SBN 7 1 2QWW BNG 7 NFR [GEOERR IF WASN'T FROZEN 2RBG SMO 6 2RW6 DEX 7 0(1) [NEW COUNT 2S*Q NAME 1,FILE,FWB 2STB REWRITE 2T*2 MHUNTW 1,FILE,FWB 2TSL NAME 1,FILE,ENT 2W#= BNZ 7 NOTLONG 2WRW LONGON 6,ELOC1(1) [WAKE UP WAITERS TO EMPTY FILE 2X?G NOTLONG 2XR6 LDN 2 6 2Y=Q LOCFCB 3 2YQB TESTRPN2 OK,NOTOPEN 2^=2 SMO 5 2^PL LDEX 0 0(3) [GET FREEZE OR SAVE COUNT 329= SBN 0 1 32NW SMO 5 338G DEX 0 0(3) [NEW COUNT 33N6 ... BNZ 0 NOTOPEN 347Q LONGON 6,BACK2(3) [WAKE UP WAITERS 34CJ ... BZE 7 NOTOPEN 34MB UP 3572 UPPLUS 1 35LL NFR GEOERR 1,NOFREEZE 366= NOTOPEN 36KW BNZ 7 UP [EXIT IF STILL FROZEN 375G MHUNTW 1,FILE,ENT 379C ... JBCC NOTAB,1,BECLOSEAB 37*# ... BRN NOWERASE 37F9 ...NOTAB 37K6 JBC UP,1,BEERASE [EXIT UNLESS 'TO BE ERASED' 37SY ...NOWERASE 384Q SETNCORE 6,2,FILE,FLOCNB [TEMPORARY FRIG FOR ERASEND 38JB MHUNTW 1,FILE,ENT 3942 LDX 0 ELAN(1) 39HL STO 0 A1+5(2) 3=3= ADN 1 ELOC1 3=GW ADN 2 A1 3?2G MOVE 1 5 3?G6 ERASEND 3?^Q MHUNT 1,FILE,FLOCNB 3#FB NAME 1,FILE,ENT [TEMPORARY FRIG FOR LISTFILE 3#^2 BRN UP 3*DL [ THIS IS THE ENTRY POINT FOR THE TESTOPEN MACRO 3*Y= TESTOPEN 3BCW LOCFCB 3 [LOCATE FCB & TESTIF OPEN UNCLEANLY 3BXG TESTRPN2 OK,UP 3CC6 UNOPCH 3,UNCL [OPEN UNCLEANLY SO TAKE NO UNCLEAN 3CWQ NFCB UPPLUS 1 [OPEN PATH. 3DBB UNCL UP 3DW2 [ 3DWD ...# SPECIAL SET UP MACRO FOR GEN RESTORE 3DWW ...[ 3DX# ...RESTOREN 3DXQ ... LDX 7 ACOMMUNE1(2) [MODE 3DY8 ... LDX 3 BFILE+1 3DYL ... LDX 0 ATYPE(3) 3D^4 ... SBX 0 STACK(1) [IS THIS BLOCK A FSTACK 3D^G ... BNZ 0 STAKNTHERE [J IF NOT 3D^Y ... ALTLENR 3,4 [ADD NEW SPACE FOR ELEMENT 3F2B ... LDX 3 BFILE+1 3F2S ... BRN STACALREDI 3F3= ...STAKNTHERE 3F3N ... SETNCORE FELLEN,3,FILE,FSTACK,,1,FELLEN 3F46 ...STACALREDI 3F4J ... ADN 3 A1 [SET UP FSTACK BLOCK 3F52 ... RINGFILE 3 [RING IN ELEMENT 3F5D ... STOZ FGENERAL2(3) 3F5W ... LDN 0 A1 3F6# ... NGS 0 FBACKPOINT(3) [BACKWARD POINTER 3F6Q ... NGS 0 FREADWORD(3) [SET FILE UNACCESSED 3F78 ... NGS 0 FREADBLOCK(3) 3F7L ... LDN 0 1 3F84 ... SRC 7 9 3F8G ... SMO 7 3F8Y ... SRC 0 0 3F9B ... STO 0 FGENERAL1(3) [SET MODE BIT 3F9S ... SBN 3 A1 [X3 -> FSTACK 3F== ... LDX 2 BFILE+1 [FOR G.R. FCB LAST IN FILE CHAIN 3F=N ... CHAIN 3,2 [CHAIN IN FSTACK 3F?6 ... UP 3F?J ...STACK 3F#2 ...#HAL FILE+FSTACK,0 3F#D ...[ 3F*L MENDAREA GAPOPEN,K99OPENEND 3FT= #END ^^^^ ...66745411000200000000