(George Source)
Macros used: BCONTEXT, CLOSETOP, COMBRKIN, ELSE, ENDCOM, ERRORX, FI, FNORM, FREECORE, HUNT, IF, JANAL, JBC, JBS, MHUNT, MONOUT, NAMETOP, OPENDIR, OUTPARAM, REPALLER, SEG, SEGENTRY, STEP, TESTREP2, TESTRPN2, THEN, UP, UPPLUS
22FL SEG WHATGENS,867,SECT.FILE,,G262 22^= #LIS K0WHATGENS 23DW # FOR UGUG MEND M262 (WHATGENS COMMAND) 23YG SEGENTRY K1WHATGENS,START 24D6 SEGENTRY K2WHATGENS,SPENT 24XQ # 25CB # WHATGENS (WG) COMMAND - GIVEN AN ENTRANT DESCRIPTION AS %A, 25X2 # RETURNS HIGHEST AND LOWEST F.G.N. OF ANY ENTRANT MATCHING 26BL # THAT DESCRIPTION, IN FORMAT $3ZD",",3ZD$ . 26W= # 27*W # RESTRICTIONS - WORKTAPES AND WORKFILES NOT ALLOWED (COMMAND 27TG # IS POINTLESS IN THESE CASES, EXCEPT TO CHECK EXISTENCE), 28*6 # DIRECTORIES SIMILARLY (ALSO TECHNICALLY INCONVENIENT); 28SQ # MAGNETIC TAPE DESCRIPTIONS NOT ALLOWED IF A T.S.N., R.S.N. 29#B # OR R.P. IS INCLUDED, BUT HANDLED CORRECTLY OTHERWISE (THIS 29S2 # COULD BE RELAXED, BUT CODING EFFORT WOULD BE DISPROPORTIONATE 2=?L # TO USEFULNESS). SIMILARLY, A CHECK THAT ANY GIVEN QUALIFIERS 2=R= # WERE MATCHED WOULD BE A LOT OF EFFORT; TO AVOID MISLEADING 2?=W # USERS, ADJUNCTS ARE CHECKED FOR, AND ERROR "AN ILLEGAL 2?QG # QUALIFIER HAS BEEN GIVEN" OCCURS IF ANY QUALIFIERS AT ALL WERE 2#=6 # SUPPLIED. 2#PQ # ERROR : "FILE NAME PARAMETER NOT APPROPRIATE TO THIS COMMAND" 2*9B # IF ONE OF THE RESTRICTIONS IS VIOLATED, OTHERWISE STANDARD 2*P2 # ERROR MESSAGES RELEVANT TO ENTRANT DESCRIPTIONS. 2B8L # 2BN= TEN +10 2C7W XBCH +0.1 2CMG ZCOMM 4H , 2D76 # 2DLQ # ERROR MESSAGES 2F6B ZFNAPP +FNAPP [ NOT APPROPRIATE 2FL2 ZJPARMIS +JPARMIS [ PARAMETER MISSING 2G5L ZALQUAL +ALQUAL [ ILLEGAL QUALIFIER 2GK= ZAMISS +AMISS [ .... MISSING 2H4W ZUSNA +JUSNA [ USER NAME 2HJG ZGENERR +GENERR [ ERROR ... %C 2J46 # 2JHQ START 2K3B SPARAPASS 2KH2 NGNC 0 1 2L2L SPENT NGN 0 0 [ SIDE-ENTRY FROM SETPARAM 2LG= STO 0 AWORK4(2) 2L^W MHUNT 3,CPB,CUNI 2MFG NGX 6 ANUM(3) 2M^6 LDX 7 ZJPARMIS(1) 2NDQ BPZ 6 PERR [ NO PARAMETER OR 1ST PARAMETER NULL 2NYB LDX 7 ZAMISS(1) 2PD2 BCONTEXT USER,2,USER 2PXL LDCH 0 APARA(3) [ NO USER CONTEXT - 2QC= ERN 0 #12 [ FAIL IF NOT ABSOLUTE NAME 2QWW LDX 6 ZUSNA(1) 2RBG BNZ 0 PERR2 2RW6 USER NAMETOP 3,FILE,FNAME 2S*Q FNORM 1 2STB MHUNT 3,FILE,FNAME 2T*2 NAMETOP 3,CPB,CUNI 2TSL TESTREP2 NAMEFORM,XIT [ FNORM FAIL - ERROR MESSAGE IN FNORM 2W#= LDX 7 ZFNAPP(1) [ 'FILE NAME NOT APPROPRIATE' 2WRW HUNT 3,FILE,FABSNB 2X?G BNG 3 PERR [ FNORM GROSS ERROR 2XR6 LDN 0 #2600 2Y=Q ANDX 0 ATYPE(3) 2YQB BNZ 0 PERR [ *MT OR WORKFILE 2^=2 LDN 0 4 2^PL TXL 0 ALOGLEN(3) 329= BCC PERR [ USERNAME ONLY - NOT CATERED FOR 32NW LDX 7 ZGENERR(1) 338G LDX 6 ZALQUAL(1) [ ALL ACTUAL ADJUNCTS ARE ILLEGAL 33N6 TESTREP2 ADJUNCTS,PERR2 [ BUT ! FILES GIVE 'ADJUNCTS' REPLY 347Q LDX 7 ZFNAPP(1) 34MB TESTRPN2 OK,PERR [ ANY POSSIBLE NASTIES 3572 LDX 6 ATYPE(3) [ TO CHECK IF LANG PRESENT LATER 35LL LDN 0 2 366= ORS 0 ATYPE(3) [ TO ACCEPT FILE OR *MT IN OPENDIR 36KW ADX 3 A1(3) [ NOW = WORD AFTER LOCAL NAME DETAILS 375G LDN 5 0 37K6 LDX 4 A1-2(3) [ FGN GIVEN - FIDDLE TO CHECK 384Q BNZ 4 RIGF [ EXISTENCE BUT AVOID SEARCH 38JB ANDN 6 #100 3942 BZE 6 NLANG [ LEAVE X4 ZERO IF NO LANG GIVEN 39HL LDX 4 A1-1(3) [ LANGUAGE 3=3= NLANG LDX 5 A1-6(3) [ LOCAL NAME 3=GW RIGF LDX 6 A1-5(3) 3?2G LDX 7 A1-4(3) 3?G6 LDN 1 A1-6(3) 3?^Q SUM 0 3 [ INDEX KEY IN DIRECTORY 3#FB STO 0 AWORK3(2) 3#^2 OPENDIR XBRK,READ,QUERY 3*DL # NOW HAVE DIRECTORY OPEN, FIRST RELEVANT NAME RECORD IN A 3*Y= # FILE/ENT, AND DIRECTORY POSITIONED JUST AFTER IT. 3B84 ... TESTREP2 OK,OK 3BCW ... JANAL XIT 3BMN ... REPALLER 3BXG XIT IF +AWORK4(2),PZ 3CC6 THEN 3CWQ UP 3DBB ELSE 3DW2 ENDCOM 3F*L FI 3FT= OK MHUNT 1,FILE,ENT 3G#W LDX 3 EGEN(1) 3GSG STO 3 AWORK2(2) [ LOWEST FGN SO FAR 3H#6 JBC NMDF,1,BEMDF [ = HIGHEST UNLESS MDF 3HRQ BZE 5 NMDF [ MDF WAS SPECIFIED EXPLICITLY 3J?B LDEX 3 ESTREND(1) [ NO. OF ELTS = TOP FGN 3JR2 LDN 5 0 [ TO AVOID SCANNING 3K=L NMDF STO 3 AWORK1(2) [ HIGHEST FGN 3KQ= FREECORE 1 3L9W BZE 5 STOP [ FGN WAS GIVEN BY USER 3LPG # 3M96 SRCH [ LOOK FOR OTHER FILES MATCHING %A 3MNQ STEP 3N8B BZE 3 STOP [ END OF DIRECTORY 3NN2 LDX 0 FRH+1(3) 3P7L BNZ 0 SRCH [ NOT NAME RECORD 3PM= TXU 5 ELOC1N(3) 3Q6W TXU 6 ELOC2N(3) 3QLG TXU 7 ELOC3N(3) 3R66 BCS XNAME [ DIFFERENT NAME - CHECK IF SAME KEY 3RKQ JBS SRCH,3,BNERASE [ IGNORE IF TO-BE-ERASED 3S5B BZE 4 XLANG 3SK2 TXU 4 ELANN(3) [ CHECK LANG IF GIVEN 3T4L BCS SRCH 3TJ= XLANG LDX 0 EGENN(3) [ NEW LOWEST FGN 3W3W STO 0 AWORK2(2) 3WHG BRN SRCH [ SEE IF ANY MORE 3X36 # 3XGQ XNAME LDN 1 ELOC1N(3) 3Y2B SUM 0 3 3YG2 TXU 0 AWORK3(2) [ IF NAME HAS SAME KEY, 3Y^L BCC SRCH [ KEEP ON TRYING 3^F= # 3^YW STOP CLOSETOP [ FREE DIRECTORY A.S.A.P. 42DG IF +AWORK4(2),PZ 42Y6 THEN 43CQ LDX 5 AWORK1(2) 43XB LDX 6 AWORK2(2) 44C2 STO 5 ACOMMUNE1(2) 44WL STO 6 ACOMMUNE2(2) 45B= UPPLUS 2 45TW FI 46*G LDN 6 0 [ FIRST TIME 46T6 LDX 5 AWORK1(2) 47#Q NUM LDX 7 ACES [ EASY 4-CHAR NUMBER CONVERSION 47SB LDCT 3 #600 48#2 NDIG DVS 4 TEN(1) 48RL DCH 4 7(3) 49?= SBX 3 XBCH(1) 49QW BNZ 5 NDIG 4==G BVSR £ [ THE SBX MAY HAVE SET OVERFLOW 4=Q6 BNZ 6 PRINT 4?9Q LDX 6 7 4?PB LDX 5 AWORK2(2) 4#92 TXU 5 AWORK1(2) [ ONLY NEED TO CONVERT 2ND NUMBER 4#NL BCS NUM [ TO CHARS IF DIFFERENT 4*8= # 4*MW PRINT MHUNT 3,CPB,CUNI [ MUST BE >= 3 WORDS LONG 4B7G STO 6 A1(3) 4BM6 LDX 6 ZCOMM(1) 4C6Q SLC 67 18 4CLB STO 6 A1+1(3) 4D62 STO 7 A1+2(3) 4DKL LDN 4 9 4F5= OUTPARAM 4,A1,CPB,CUNI 4FJW MONOUT AWSNAME 4G4G ENDCOM 4GJ6 # 4H3Q XBRK IF +AWORK4(2),PZ 4HHB THEN 4J32 UPPLUS 1 4JGL ELSE 4K2= COMBRKIN 4KFW FI 4K^G # 4LF6 PERR NGN 6 1 4LYQ PERR2 ERRORX 7,6 4MDB IF +AWORK4(2),PZ 4MY2 THEN 4NCL UP 4NX= ELSE 4PBW ENDCOM 4PWG FI 4QB6 # 4QTQ #END 4R*B ... ^^^^ ...744345250003