{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: WHATGENS867)}}
====== WHATGENS867 ======
(George Source)
**Macros used:** [[george:macro:BCONTEXT|BCONTEXT]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:ELSE|ELSE]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERRORX|ERRORX]], [[george:macro:FI|FI]], [[george:macro:FNORM|FNORM]], [[george:macro:FREECORE|FREECORE]], [[george:macro:HUNT|HUNT]], [[george:macro:IF|IF]], [[george:macro:JANAL|JANAL]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:REPALLER|REPALLER]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:STEP|STEP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:THEN|THEN]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|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