TRAPPARA3
(George Source)
Macros used: ACROSS, BRUSEN, BXU, CHAIN, CJOBLOCK, CLOSE, COMERR, COMERRX, ENDCOM, FREECORE, MENDAREA, MFREE, MHUNT, MHUNTW, MONOUT, NAMETOP, OPEN, PARAPASS, PROPUSER, READLEX, SEGENTRY, SETMODE, SETNCORE, SETREP, SPARAPAS, TESTREP, TESTREP2, UP, USERNORM
- TRAPPARA3.txt
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