{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: TRAPPARA3)}}
====== TRAPPARA3 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BRUSEN|BRUSEN]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CJOBLOCK|CJOBLOCK]], [[george:macro:CLOSE|CLOSE]], [[george:macro:COMERR|COMERR]], [[george:macro:COMERRX|COMERRX]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FREECORE|FREECORE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPEN|OPEN]], [[george:macro:PARAPASS|PARAPASS]], [[george:macro:PROPUSER|PROPUSER]], [[george:macro:READLEX|READLEX]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SPARAPAS|SPARAPAS]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:UP|UP]], [[george:macro:USERNORM|USERNORM]]
22FL #OPT K0TRAPPARA=0
22^= #LIS K0TRAPPARA>K0TRAPGO>K0FILESTORE>K0GREATGEO>K0ALLGEO
23DW #SEG TRAPPARA3 [ TONY HAMILTON
23YG 8HTRAPPARA
24D6 [ THIS SEGMENT IMPLEMENTS THE ANALYSIS OF TRAPSTYLE PARAMETERS
24XQ [ FOR THE TRAPGO ADJUNCT & THE TRAP-GO/STOP COMMANDS.
25CB [ THE "PARAPASSING" POINTERS ARE POINTING TO THE SECOND PARAMETER
25X2 [ OF THE CALAS BLOCK IN THE COMMAND CASE,AND TO THE FIRST PARAMETER
26BL [ IN THE LOWEST CMUCTI BLOCK IN THE ADJUNCT CASE.
26W= [
27*W SEGENTRY K1TRAPPARA,XCOMMANDENT
27TG SEGENTRY K2TRAPPARA,XADJUNCTENT
28*6 ZFABS
28SQ +10
29#B 12HMASTER
29S2 12HLEXICON
2=?L +0
2=R= +1
2?=W 4HB1
2?QG PARS
2#=6 8HGROUP
2*9B #40000000
2*P2 8HALL
2BN= +CALL
2C7W 8HERASE
2D76 +CERASET
2DLQ 8HWRITE
2FL2 +CWRITE
2G5L 8HAPPEND
2H4W +CAPPEND
2HJG 8HREAD
2JHQ +CREAD
2LG= 8HEXECUTE
2MFG +CEXECUTE
2M^6 PARSEND
2NDQ
2NYB ZERNOUSER +ERNOUSER
2PD2 ZERWFTRAPS +ERWFTRAPS
2PXL ZJUNSTYLE +JUNSTYLE
2QC= ZERPSEUTRAP +ERPSEUTRAP
2QCN ...STYLECHECK
2QD6 ... STO 1 GEN1 [SAVE LINK
2QDJ ... LDX 0 5
2QF2 ... SBN 0 2
2QFD ... BNG 0 (1) [AT LEAST 2 CHARS NEEDED
2QFW ... SBN 0 6
2QG# ... BPZ 0 (1) [>7 ILLEGAL
2QGQ ... STO 2 GEN2 [SAVE CUNI POINTER
2QH8 ... STO 4 GEN4 [SAVE GEN4
2QHC ... STO 5 GEN5 [SAVE NO. OF CHARS
2QHL ... STO 7 GEN0 [SAVE X7(THERE IS NO GEN7)
2QJ4 ... LDX 1 FX1
2QJG ...NEXTSTYLE
2QJY ... STO 1 GEN3 [FOR PICKING UP MODE WORD
2QK7 ...NEXTCHAR
2QKB ... LDCH 0 PARS(1) [NEXT PRESET CHARACTER
2QKS ... LDCH 4 APARA(2)
2QL= ... BXU 0 4,UNEQUAL
2QLN ... BCHX 1 £
2QM6 ... BCHX 2 £
2QMJ ... BCT 5 NEXTCHAR [STEP POINTERS & TRY NEXT CHAR
2QN2 ... LDX 2 GEN2 [RESTORE CUNI ADDRESS
2QND ... LDX 3 GEN3
2QNW ... LDX 4 GEN4
2QP# ... LDX 7 GEN0 [ETC.
2QPK ... LDX 1 GEN1 [EXIT+1
2QPW ... EXIT 1 1
2QQ8 ...UNEQUAL
2QQL ... LDX 1 GEN3
2QR4 ... ADN 1 3 [STEP TABLE ADDRESS
2QRG ... LDX 2 GEN2 [RESTORE CUNI ADDRESS
2QRR ... LDX 5 GEN5 [RELOAD NO. OF CHARS
2QS4 ... BCT 3 NEXTSTYLE [TRY NEXT STYLE
2QSB ... LDX 4 GEN4
2QSS ... LDX 7 GEN0
2QTN ... BRN (GEN1) [EXIT
2QWW
2RBG TRAPMODES
2RW6 ORX 4 GSIGN [MARKER-NO USER PARAM
2S*Q #SKI ANOUSER
2STB BRUSEN T74 [JUMP IF NO JOBBLOCK.
2T*2 CJOBLOCK 1 [WE PICK UP PROPER USER
2TSL LDX 0 ALOGLEN(1)
2W#= SBN 0 ASTJOB
2WRW BZE 0 T74
2X?G ADN 1 JUSER [AND SHOVE THAT INTO THE
2XR6 T78
2Y=Q MHUNTW 2,FILE,FTRAP
2YQB ADN 2 ETRUSER1
2^=2 MOVE 1 3
2^PL MHUNT 2,CPB,CUNI
329= LDCT 0 #200
32NW ANDX 0 7
338G BNZ 0 TCGRUP [J IF TC.
33N6 BRN TRAPALL1
347Q T74
34MB LDCT 0 #020
3572 ANDX 0 7
35LL BZE 0 T75 [JIF NOT ADJUNCT
366= PROPUSER
36KW TESTREP2 OK,T75 [JIF [CPREFIX] IS A PROPER USER
375G LDN 1 ACOMMUNE1(2) [IF NOT USE NAME SUPPLIED BY PROPUSER
37K6 BRN T78
384Q T75
38JB LDX 1 FX2
3942 ADN 1 CPREFIX
39HL BRN T78
3=3= TCPASS
3=GW FREECORE 2 [FREE LAST CUNI
3?2G TCGRUP1
3?G6 PARAPASS [PASS NEXT PARAM
3?^Q MHUNT 2,CPB,CUNI
3#FB TCGRUP
3#^2 LDX 5 ANUM(2)
3*DL BNG 5 TCAC [JIF END
3*Y= BZE 5 TCPASS [IGNORE IF NULL
3BCW ANDN 5 #7777
3BXG ... LDN 3 1 [CHECK GROUP ONLY (1ST IN TABLE)
3CC6 ... CALL 1 STYLECHECK
3CWQ ... BRN TCSYL
3KQ= BPZ 6 TNOD
3L9W MONOUT JDUPSTYLE
3LPG MHUNT 2,CPB,CUNI
3M96 TNOD
3MNQ LDX 6 GSIGN
3N8B BRN TCPASS [GO BACK FOR ANOTHER
3NN2 TCAC
3P7L FREECORE 2 [FREE LAST CUNI
3PM= ACROSS TRAPCHEC,3 [EXIT TO TC
3Q6W [
3QLG XADJUNCTENT [ENTRY FROM ADJUNCTS (DOWN)
3R66 [
3RKQ STOZ AWORK4(2) [MARKER-NO TAB BLOCK
3S5B LDCT 7 #20 [MARKER-B4
3SK2 [
3T4L XCOMMANDENT [ENTRY FROM TRAPGO (ACROSS). WE HAVE A FABSNB CONTAINING
3TJ= [THE FILENAME & THE PARAPASSING POINTER IS AT PARAM NO.2
3W3W STOZ 6
3WHG SETNCORE ETRAP,3,FILE,FTRAP [FOR USEROPEN.TRAPGO WILL HAVE IT
3X36 LDN 0 ETRAP [RENAMED A FILE/FAPB
3XGQ STO 0 ETRAPRH(3)
3Y2B STOZ ETRAPMODES(3) [ZEROISE TRAPMODES WORD
3YG2 TOGETHER
3Y^L LDN 0 1 [FOR TRAPGO ADJUNCT-1ST PARAM
3^F= LDCT 1 #20
3^YW ANDX 1 7
42DG BNZ 1 TRADJUSN [J IF ADJUNCT
42Y6 LDN 0 2 [2ND PARAM FOR TG/TC/TS
43CQ TRADJUSN
43XB USERNORM 0 [NORMALISE USERNAME PARAM
44C2 TESTREP USERFORM,UGH1 [J IF INCORRECT FORMAT
44WL SPARAPAS [PASS PARAM FOR ERRORS OR IF NO USER
45B= TESTREP USERMIS,TRAPMODES [PARAM(WHEN EE JUMP HERE)& TO CORRECT
45CS ... BPZ 7 NOTTSCOM
45DK ... MFREE CPB,CUNI
45FB ... MHUNT 2,FILE,ADICT [FOR TS COM ONLY WE DONT CHECK
45GY ... MHUNTW 3,FILE,FTRAP [LEXICON -THIS ALLOWS REMOVAL
45JG ... ADN 2 A1 [OF TRAPS FOR DEAD USERS
45L4 ... ADN 3 A1+1
45ML ... MOVE 2 3
45P8 ... SBN 2 A1
45QQ ... BRN TSCOM
45S# ...NOTTSCOM
45TW SETNCORE 10,2,FILE,FABSNB [SET UP FABSNB FOR OPENING THE
46*G ADN 1 ZFABS [LEXICON
46T6 ADN 2 A1
47#Q MOVE 1 10
47SB OPEN XBRK,READR [OPEN LEXICON
48#2 READLEX [LOOK FOR USERNAME
48RL TESTREPN NOUSER,OUM
49?= CLOSE [CLOSE LEXICON
49QW LDCT 0 #20
4==G ANDX 0 7
4=Q6 BNZ 0 UGH [J IF ADJUNCT
4?9Q LDX 4 ZERNOUSER(1)
4?PB BRN OUTERR
4#92 OUM
4#NL CLOSE [CLOSE LEXICON ANYWAY
4*8= MFREE CPB,CUNI
4*MW MFREE FILE,FABSNB [
4B7G MHUNTW 2,FILE,ASELFLEX
4BM6 MHUNTW 3,FILE,FTRAP
4C6Q LDX 0 GSUPUSER(2)
4CLB BNG 0 PSEUDERR [J IF TEMP DIR
4D62 SLL 0 1
4DKL BNG 0 PSEUDERR [J IF PSEUDO-USER
4F5= ADN 2 GLUSER [USERNAME IN IT,THAT WE WILL PUT
4FJW ADN 3 A1+1 [INTO FTRAP BLOCK
4G4G MOVE 2 3 [MOVE IT IN
4GJ6 SBN 2 GLUSER
4GWH ...TSCOM
4H8Y ... FREECORE 2 [FREE ASELFLEX OR ADICT
4HHB SBN 3 A1+1
4J32 MHUNT 1,FILE,FABSNB
4JGL LDN 0 #200
4K2= ANDX 0 ATYPE(1)
4KFW BZE 0 YESITSADJ [J IF NOT WORKFILE
4K^G CJOBLOCK 2
4LF6 LDX 0 JUSER(2) [THE THREE PROPER USER WDS
4LYQ LDX 1 JUSER+1(2)
4MDB LDX 2 JUSER+2(2)
4MY2 TXU 0 ETRUSER1(3)
4NCL TXU 1 ETRUSER1+1(3)
4NX= TXU 2 ETRUSER1+2(3)
4PBW ... BCC YESITSADJ [J IF EQUAL TO CONVERTED USER PAR
4PWG WFCOM
4PYD ...#
4Q2B ...# A TRAP FOR ANOTHER USER TO A WORKFILE IS BEING REFERRED TO.
4Q4# ...# IF ITS AN ADJUNCT WE SET THE REPLY WFTRAP AND LET FNORM GIVE AN ERROR
4Q6= ...# IF ITS A TS OR TG COMMAND WE GIVE AN ERROR. IF ITS A TC COM WE
4Q88 ...# PRETEND THAT THE USER HAS NO ACCESS TO THE WF AS INDEED HE
4Q=6 ...# HASNT.
4Q#4 ...#
4QB6 LDCT 0 #20
4QTQ ANDX 0 7 [J IF NOT TG ADJ
4R*B BZE 0 WFC
4RT2 SETREP WFTRAP
4S#L UP
4SS= WFC
4SWF ... LDCT 0 #200
4SYN ... ANDX 0 7
4T2X ... BZE 0 NOTTCCOM
4T56 ... MONOUT CHTRAPREP2
4T7* ... BRN ZENDC
4T9J ...NOTTCCOM
4T?W SMO FX1
4TRG LDX 4 ZERWFTRAPS
4W?6 BRN OUTERR
4WQQ YESITSADJ
4X=B STOZ 4 [ SWITCH
4XQ2 LDCT 0 #200
4Y9L ANDX 0 7
4YP= BNZ 0 TCGRUP1 [J IF TC.
4^8W QLOOP
4^NG PARAPASS [PASS NEXT PARAMETER
5286 MHUNT 2,CPB,CUNI
52MQ TRAPALL1
537B LDX 5 ANUM(2)
53M2 BNG 5 QEND [JIF NO MORE
546L TRAPALL
54L= BNZ 5 T1
555W FREECORE 2
55KG BRN QLOOP [IGNORE IF NULL
5656 T1
56JQ ANDN 5 #7777
574B ... LDN 3 PARSEND-PARS/3
57J2 ... CALL 1 STYLECHECK [CHECK WHOLE TABLE
583L ... BRN RHUB
58H= ... BRN SETMODE [STYLE OK
5H?2 RHUB
5HQL LDCT 0 #20
5J== ANDX 0 7
5JPW BNZ 0 TRADJUNST [JIF ADJUNCT
5K9G TCSYL
5KP6 SMO FX1
5L8Q LDX 4 ZJUNSTYLE
5LNB BRN OUTERR
5M82 TRADJUNST
5MML ... SETREP UNSTYLE
5NLW UP
5P6G SETMODE
5PL6 FREECORE 2 [FREE CUNI
5Q5Q LDX 0 6
5QKB ... ORX 6 PARS+2(3) [OR IN MODES FOR THIS PARAM
5R52 ... ANDX 0 PARS+2(3)
5RJL BZE 0 QLOOP [JIF MODE NOT DUPLICATED
5S4= MONOUT JDUPSTYLE
5SHW BRN QLOOP
5T3G QEND
5TH6 FREECORE 2
5W2Q LDEX 0 6
5WGB BZE 0 STYLESQ [J IF NO STYLES
5X22 MHUNTW 2,FILE,FTRAP
5XFL STO 6 ETRAPMODES(2)
5X^= MHUNT 1,FILE,FABSNB
5YDW LDN 0 #200
5YYG ANDX 0 ATYPE(1)
5^D6 BZE 0 NOGWF [J IF NOT WF.
5^XQ BNG 6 TCSYL
62CB NOGWF
62X2 LDCT 0 #20
63BL ANDX 0 7
63W= BNZ 0 UPADJ [J IF ADJUNCTS
64*W NAMETOP 2,FILE,FAPB
64TG CHAIN 2,FX2
65*6 QBAC
65SQ MHUNT 1,FILE,FABSNB
66#B LDN 0 #200
66S2 ANDX 0 ATYPE(1) [J IF NOT W/F.
67?L BZE 0 ZACHARY
67R= LDN 0 1
68=W ANDX 0 ATYPE(1) [IF NON-FILESTORE I.E. WORKTAPE, TREA
68QG BNZ 0 ZACHARY [AS NON-WORKFILE
69=6 LDCT 0 #40
69PQ ORS 0 7 [SET W.F.BIT (B4)
6=9B ACROSS TRAPWORK,1
6=P2 ZACHARY
6?8L ACROSS TRAPGO,11
6?N= UPADJ
6#7W SETREP OK
6#MG UP
6*76 STYLESQ
6*LQ LDCT 0 #200
6B6B ANDX 0 7
6BL2 BNZ 0 TRAPMODES
6C5L LDCT 0 #20
6CK= ANDX 0 7
6D4W BNZ 0 STYLNADJ [J IF ADJUNCTS
6DJG COMERR JPARMIS,JTRAPST
6F46 STYLNADJ
6FHQ SETREP NOSTYLE
6G3B UP
6GH2 UGH
6H2L SETREP NOUSER
6HG= UGH1
6H^W XBRK
6JFG LDCT 0 #20
6J^6 ANDX 0 7
6KDQ BZE 0 ZENDC
6KYB UP
6LD2 ZENDC
6LXL ENDCOM
6MC= PSEUDERR
6MWW FREECORE 2 [FREE CUNI & ASELFLEX BLOX
6NBG FREECORE 3
6NW6 LDCT 0 #20
6P*Q ANDX 0 7
6PTB BNZ 0 TRPS [J IF ADJUNCT
6Q*2 LDX 4 ZERPSEUTRAP(1)
6QSL OUTERR
6R#= COMERRX 4
6RRW TRPS
6S?G SETREP PSEUTRAP
6SR6 UP
6T=Q [
6TQB MENDAREA 20,K99TRAPPARA
6W=2 #END
^^^^ ...40303063002100000000