{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: TRAPGO864)}}
====== TRAPGO864 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BBS|BBS]], [[george:macro:BXU|BXU]], [[george:macro:CATMASK|CATMASK]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMERR|COMERR]], [[george:macro:DELETE|DELETE]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FNORM|FNORM]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FREETAB|FREETAB]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:FSHENTRY|FSHENTRY]], [[george:macro:FSHSKIP|FSHSKIP]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT|HUNT]], [[george:macro:HUNTW|HUNTW]], [[george:macro:INSERT|INSERT]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:LOGACCESS|LOGACCESS]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPENDIR|OPENDIR]], [[george:macro:REPALLER|REPALLER]], [[george:macro:REWRITE|REWRITE]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETREP|SETREP]], [[george:macro:SETREP2|SETREP2]], [[george:macro:SETUPTAB|SETUPTAB]], [[george:macro:SIX|SIX]], [[george:macro:SKIP|SKIP]], [[george:macro:STEP|STEP]], [[george:macro:TABRESET|TABRESET]], [[george:macro:TABSET|TABSET]], [[george:macro:TABULATE|TABULATE]], [[george:macro:TESTRACE|TESTRACE]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:TRACE|TRACE]], [[george:macro:TRANSBEG|TRANSBEG]], [[george:macro:TRANSFIN|TRANSFIN]], [[george:macro:TRAPADD|TRAPADD]], [[george:macro:UP|UP]]
2278 ... SEG TRAPGO,,MIKE PUTNAM,COMMAND
22#B ...#
24XQ # THIS SEGMENT IMPLEMENTS THE TRAPGO AND TRAPSTOP COMMANDS. IT ALSO
25CB # INCLUDES ENTRIES FROM THE TRAPCHEC CHAPTER
25X2 # THE IDENTIFIERS USED IN THIS SEG FOR TRAP RECORD ARE DEFINED IN
26BL # FILECOMPS.THOSE FOR TRAP STYLES IN MACROS RM59B
26W= [
27*W SEGENTRY K1TRAPGO,TRAPGO
27TG SEGENTRY K2TRAPGO,TRAPSTOP
28*6 SEGENTRY K5TRAPGO,TRAPCHECK
28SQ SEGENTRY K7TRAPGO,TRAPADD
29#B SEGENTRY K11TRAPGO,PARAMSDONE
29FJ ...[
29LQ ... FSHENTRY K12TRAPGO,SENTFROMB,,SENTFROMB
29S2 [
2LG= MOGGIE
2L^W CATMASK FILES,COMMENT
2MFG XCOM6
2M^6 ... MONOUT JMTRACE1 [BUG 3957
2NYB BRN NMEET
2PD2 XENERR
2QC= MHUNT 2,FILE,FNAME
2QWW NAMETOP 2,CPB,CUNI
2RBG ... COMERR ERXENOSER
2S*Q ONE +1
2STB 4H:
2T*2 SIX +6
2TSL # X7 IS USED TO INDICATE WHICH COMMAND
2W#= # X7=0 DENOTES TRAPGO
2WRW # X7 WITH B0=1 DENOTES TRAPSTOP
2X?G # X7 WITH B0=0 AND B1AND/ORB2=1 INDICATES ENTRY FROM TRAPCHEC
2XR6 # X7,B4=1 IMPLIES USEROPEN PROCESSING THE TRAPGO ADJUNCT
2Y=Q [
2YQB TRAPCHECK
2^=2 [
2^PL #SKI K6TRAPGO>99-99
329= TRACE JOBNO(2),TRAPCHEC
32NW LDCT 7 #200 [MARKER,INDICATING TRAPCHECK COMMAND
338G TESTRACE MOGGIE(1),XCOM6 [J IF NO FILES OR COMMENT OUTPUT
33N6 BRN NMEET
347Q [
34MB TRAPSTOP
3572 [
35LL #SKI K6TRAPGO>99-99
366= TRACE JOBNO(2),TRAPSTOP
36KW LDX 7 GSIGN
375G BRN NMEET
37K6 [
384Q TRAPGO
38JB [
3942 #SKI K6TRAPGO>99-99
39HL TRACE JOBNO(2),TRAPGO
3=3= STOZ 7 [X7 IS ZERO FOR TRAPGO ENTRY
3=GW # THE FIRST PARAMETER(ENTRANT DESCRIPTION)IS ANALYSED THEN THE
3?2G # ROUTINE GOES ACROSS TO CHECK THE USERNAME PARAM(X4 SET NEGATIVE
3?G6 # IF NONE) AND THE TRAPMODES IN TRAPPARA
3?^Q NMEET
3#3F ... FSHCODE B,SKIPINA1
3#58 ...(
3#6X ... TRANSBEG FSHTRAPID,TRAPGO,12,CLB,,ACOMMUNE1
3#8L ... BRN NCOM
3#=* ... ACROSS TRAPCHEC,8
3##4 ...SKIPINA1
3#*R ...)
3#CG ...SENTFROMB
3#FB STOZ AWORK4(2)
3#^2 SPARAPASS [PASS ENTRANT PARAMETER
3*DL MHUNT 2,CPB,CUNI
3*Y= NGX 0 ANUM(2)
3BCW BNG 0 YESENTR [J.IF THERE IS A PARAMETER
3BXG ... COMERR JPARMIS,JFENTRANT [FILENAME PARAM MISSING
3DW2 YESENTR
3F*L NAMETOP 2,FILE,FNAME [FOR FNORM
3FT= ... FNORM 9
3G#W ... TESTRPN2 NAMEFORM,NORMALOK [J IF NO ERROR
3GDR ... FSHCODE AORB
3GJN ... BRN NCOM
3GNK ... FSHSKIP
3GSG ENDCOM
3H#6 NORMALOK
3HRQ MHUNT 2,FILE,FABSNB [CHECK NOT XENOTAPE
3J?B LDN 0 2 [SET "EITHER TYPE OF ENTRANT"
3JR2 ORS 0 ATYPE(2) [BIT IN ATYPE
3K=L LDN 0 #2000 [B14 OF ATYPE SET IF SERIAL NO GIVEN
3KQ= ANDX 0 ATYPE(2)
3L9W BZE 0 NOXENOT [J IF NOT SET
3LPG ADX 2 A1(2)
3M96 LDX 0 A1+1(2) [SERIAL NO. IN X0
3MNQ BNG 0 XENERR [J IF -VE (XENOTAPE)
3N8B NOXENOT
3NN2 ACROSS TRAPPARA,1 [PROCESS OTHER PARAMS
3P7L [ TRAPPARA IS SHARED CODE WITH ADJCHECK FOR ANALYSIS OF TRAPSTYLE
3PM= [ PARAMETERS ENTRY AT K4TRAPGO IS IMMEDIATE.THE FILE/FAPB WILL HAVE
3Q6W [ THE MODE WORD UPDATED.ERRORS WILL HAVE BEEN REPORTED DIRECTLY BY
3QLG [ TRAPPARA,AND NO REENTRY MADE
3R66 [
3RKQ PARAMSDONE
3S5B [
3SK2 #SKI K6TRAPGO>99-99
3T4L TRACE 6,TRAPPARA
3TJ= OPENDIR XBRK,GENERAL,QUERY [OPEN DIRECTORY ABOVE
3W3W TESTREP2 OK,OKDIROP [JIF OK
3W?N ...RPERR [REPORT ERROR
3WHG MHUNT 3,FILE,FNAME
3X36 NAMETOP 3,CPB,CUNI [FOR ERROR REPORTING
3X73 ... TESTRPN2 NOTOWNER,NNO [TRANSLATE NOTOWNER INTO NOTOWN
3X=Y ... SETREP2 NOTOWN [TO ACHIEVE CORRECT MESSAGE IN REPALL
3XBT ...NNO
3XGQ ... REPALLER
3Y2B ... BRN NCOM
44C2 # DIRECTORY OPENED OK.
44WL OKDIROP
44X9 ...#UNS FTS1
44XS ...(
44Y= ... LDCT 0 #200
44YN ... ANDX 0 7
44^6 ... BNZ 0 NOTFREZ [DONT CHECK FREEZING IF TC COM
44^K ... TOPFCB2 3
4528 ... JBS YFREZ,3,BFUSERFREZ [J IF DIR FROZEN
452R ... MHUNT 3,FILE,ENT
453B ... JBC NOTFREZ,3,BEUSERFREZ[J IF FILE NOT FROZEN
453^ ...YFREZ
456Y ... DOWN USEREXCP,1 [CAN ACCESS PROCEED REGARDLESS
459X ... BRN RPERR [NO!! (ERROR REPLY SET UP)
45#W ...NOTFREZ [YES
45*F ...)
45TW OWNERCHECK [TEST IF OWNER
46*G ... TESTRPN2 OK,RPERR
46T6 ... MFREE FILE,FNAME
47#Q ... BRN SETTAB
48#2 [ THIS ENTRY POINT IS FOR USEROPEN WHEN
48RL # ONE OR MORE FTRAP BLOCKS HAVE BEEN SET UP THE FIRST HAS BEEN
49?= # RENAMED A FAPB & CHAINED NEXT TO THE ACTIVITY BLOCK
49QW [ WE SET A TAB AT THE START OF THE DIR ENTRY FIRST
4==G [ A TRAPGO ADJUNCT HAS BEEN GIVEN.B4(CT.OF #20) OF X7 IS SET
4=Q6 # ENT BLOCK IN CORE. FOR W/FILES A FABSNB TOO
4?9Q [
4?PB TRAPADD
4#92 [
4#NL STOZ AWORK4(2)
4*8= HUNT 1,FILE,FAPB
4*MW LDX 6 ETRAPMODES(1)
4B7G LDCT 7 #20 [B4 SET FOR THIS ENTRY
4BM6 LDCT 0 #200
4C6Q ANDX 0 ETRAPMODES(1)
4CLB SLL 0 1 [ SET'TS' BIT IF TS ADJUNCT
4D62 ORX 7 0
4DKL MHUNT 1,FILE,FABSNB
4F5= LDN 0 #200
4FJW ANDX 0 ATYPE(1)
4G4G BZE 0 NOTWF4 [J IF NOT W/F
4GJ6 LDN 0 1
4H3Q ANDX 0 ATYPE(1) [IF NON-FILESTORE I. E. WORKTAPE, TRE
4HHB BNZ 0 NOTWF4 [AS NON-WORKFILE
4J32 ACROSS TRAPWORK,2
4JGL NOTWF4
4K2= #SKI K6TRAPGO>99-99
4KFW TRACE 7,TRAPADJ
4K^G SETTAB
4LF6 LDX 0 AWORK4(2)
4LYQ BNZ 0 NOSET [SWITCH,=0 IF NO FTAB BLOCK
4MDB SETUPTAB [SET UP FTAB BLOCK
4MY2 LDN 0 1
4NCL STO 0 AWORK4(2)
4NX= NOSET
4PBW TABSET
4PWG # THIS SECTION STEPS THRU' THE DIRECTORY,UNTIL'-
4QB6 #
4QTQ # 1. END OF ENTRY, INSERT NEW RECORD,EXIT UNLESS ADJUNCT.IF THERE'S
4R*B # ANOTHER FTRAP BLOCK,RESET TAB,TABULATE & BACK THR
4RT2 # 2. MATCHING TRAP,DROP THRU' TO S40 & REWRITE TRAP.
4S#L # IN THIS CASE WE UPDATE THE TRAPS RECORD, AND IF EMPTY THEN, GO TO
4SS= # LABEL'S10' TO DELETE IT & UPDATE THE COUNT OF USER TRAPS.
4T?W NEXTONE
4TRG #SKI K6TRAPGO>599-599
4W?6 TRACE K7,TRAPJ
4W?Y ...#UNS ILOGACC
4W#Q ...(
4W*J ... HUNT 1,FILE,FAPB
4WBB ... LDX 4 ETRAPMODES(1)
4WC8 ... SLL 4 2
4WD2 ... BNG 4 NOLOG
4WDS ... NAME 1,FILE,FTRAP
4WFL ... LDN 4 0
4WGD ... BPZ 7 NTSTOP [J IF NOT TRAPSTOP
4WH= ... LDCT 4 #200 [TS BIT FOR FTRAP BLOCK
4WJ4 ...NTSTOP
4WJW ... ORS 4 ETRAPMODES(1)
4WKN ... LOGACCESS 10
4WLG ... HUNT 1,FILE,FTRAP
4WM# ... ERS 4 ETRAPMODES(1)
4WN6 ... NAME 1,FILE,FAPB
4WNY ...NOLOG
4WPQ ...)
4WQQ MHUNTW 1,FILE,ENT
4X=B ... JBC NOINDX,1,BEINDEX
4YP= STEP
4^8W NOINDX
4^NG S2 STEP [TO LOOK AT CURRENT USER TRAPS
5286 PORT BZE 3 S3 [JUMP IF END OF FILE
52MQ ... LDX 0 ERESN(3)
537B BZE 0 S4 [J IF END OF DIRECTORY ENTRY
53M2 S6 HUNT 2,FILE,FAPB
546L LDN 0 3 [THIS SEQUENCETESTS FOR SAME NAME IN
54L= REPT SMO 0
555W LDX 4 A1(2) [GET NAME IN FAPB WORD BY WORD
55KG SMO 0
5656 TXU 4 ETRAPRH-A1(3)
56JQ BCS S2 [IF DISSIMILAR LOOK AT NEXT
574B BCT 0 REPT [GET NEXT WORDS
57J2 LDX 2 4(3) [STYLES WORD
583L ERX 2 6
58H= BNG 2 S2 [GET NEXT IF NOT BOTH GROUPS OR BOTH
592W # THIS SECTION DEALS WITH THE CASE WHERE AN EXISTING TRAP R
59GG # IS FOUND
5=26 S40
5=FQ HUNT 2,FILE,FAPB
5=^B LDX 4 ETRAPMODES-A1(3) [ OLD STYLES
5?F2 BPZ 7 S5 [J IF TRAPGO
5?YL LDCT 0 #200 [ UNSET TS ADJUNCT BIT, IF THERE
5#D= ORX 6 0
5#XW ERX 6 0
5*CG ERN 6 CALL
5*X6 ANDX 4 6 [NEW STQLES FOLLOWING TRAPSTOP COMMAN
5BBQ BRN S33
5BWB S5 ORX 4 6 [NEW STYLES FOLLOWING TRAPGO COMMAND
5CB2 S33
5CTL BXU 4 ETRAPMODES-A1(3),S333[ J IF TS && MODES NOT SAME,O/W SET
5D*= ORN 7 1
5DSW S333
5F#G STO 4 ETRAPMODES(2) [NEW STYLES.
5FS6 ANDN 4 CALL
5G?Q BZE 4 S10 [JUMP IF NO TRAP LEFT-WE'LL REMOVE IT
5GRB NAME 2,FILE,FWB
5H?2 REWRITE
5HQL MFREE FILE,FWB [FREE BLOCKS LEFT OVER
5J== LDXC 7 7
5JPW BCC S3333 [ J IF TRAPGO & NO CHANGE
5K9G LDEX 0 7 [IF NONZERO TRAP FOUND
5KP6 BNZ 0 S24
5L8Q S3333
5LNB LDCT 0 #20
5M82 ANDX 0 7
5MML BNZ 0 OTHERWHERE [ J IF ADJUNCT
5N7= #SKI K6TRAPGO>99-99
5NLW TRACE 4,TRAPENDA
5P6G # END OF COMMAND
5PL6 ZENDC
5Q5Q CLOSETOP
5Q*J ...NCOM
5QBT ... FSHCODE A,SKIPINB1
5QD6 ...(
5QFC ... TRANSFIN ,,ALIEN
5QGN ...SKIPINB1
5QH^ ...)
5QKB ENDCOM
5RJL # GIVES COMMENT FOR TS & NO TRAP TO THAT USER.
5S4= S4
5SHW S3
5T3G BPZ 7 S12 [J IF NOT TS
5TH6 MFREEW FILE,FAPB
5W2Q S24
5WGB BBS 4,7,NOMESS [J IF ADJUNCT
5X22 #SKI K6TRAPGO>99-99
5XFL TRACE FX2,N0SUCHTR
5X^= MONOUT HAVNOTRAP
5YDW NOMESS
5YYG BRN S3333
5^D6 S12
5^XQ TABULATE
62CB MHUNTW 2,FILE,ENT
62X2 LDEX 4 ECOPS(2) [J IF READ PTRS @ NAME RECORD
63BL BZE 4 NOBAK [O/W BACKSPACE
63W= BACKSPACE [O/W BACKSPACE
64*W MHUNTW 2,FILE,ENT
64TG NOBAK
65*6 LDN 0 1
65SQ #SKI K6TRAPGO>599-599
66#B TRACE K7,TRAPC
66S2 ADS 0 ENUSE(2) [UPDATE TRAPS COUNT
67?L NAME 2,FILE,FWB
67R= REWRITE [REWIITE DIR ENT
68=W MHUNTW 1,FILE,FWB
68QG NAME 1,FILE,ENT
69=6 ... LDX 5 4
6=9B ADN 5 1
6=*? ... JBC NOINDX2,1,BEINDEX
6=F8 ... ADN 5 1
6=K5 ...NOINDX2
6=P2 LDX 3 5
6?8L SKIP ,0(3) [SKIP TO 1ST TRAPS RECORD
6?N= MHUNTW 1,FILE,FAPB
6#7W NAME 1,FILE,FWB
6#MG INSERT [INSERT NEW TRAPS RECORD
6*76 MFREE FILE,FWB
6*LQ #SKI K6TRAPGO>99$99
6B6B TRACE 7,TRAPEOF
6BL2 ZENDCH
6C5L LDCT 0 #20
6CK= ANDX 0 7
6D4W BNZ 0 OTHERWHERE1 [J IF ADJUNCT
6DJG BRN ZENDC
6F46 # CLEARS EMPTY TRAP FROM DIRECTORY
6FHQ S10
6G3B FREECORE 2 [FREE READ BLOCK
6GH2 DELETE [DELETE TRAPS RECORD
6H2L TABULATE [BACK TO 1ST TRAPS RECORD
6HG= MHUNTW 3,FILE,ENT
6H^W LDN 0 1
6JFG SBS 0 ENUSE(3) [UPDATE CT. OF TRAPS
6J^6 NAME 3,FILE,FWB
6KDQ LDEX 6 ECOPS(3)
6KYB BZE 6 NOBAK1
6LD2 BACKSPACE [REWRITE NAME RECORD
6LXL NOBAK1
6MC= REWRITE
6MWW LDCT 0 #20
6NBG ANDX 0 7
6NW6 BNZ 0 OTHERPLACE [ J IF ADJUNCT
6P*Q #SKI K6TRAPGO>99-99
6PTB TRACE 4,TSDELETE
6Q*2 BRN ZENDC
6QSL # ALL THE BITS FOR TG/TS ADJUNCT.
6R#= OTHERPLACE [TRAP DELETED
6RRW BZE 6 NOST1
6S?G STEP
6SR6 NOST1
6T=Q MHUNTW 1,FILE,FWB
6TQB NAME 1,FILE,ENT
6W=2 #SKI
6WPL (
6X9= HUNT 1,FILE,FTRAP
6XNW BNG 1 NOMORE
6Y8G STEP
6YN6 HUNT 1,FILE,FTRAP
6^7Q )
6^MB BRN NOTABULE
7272 OTHERWHERE1
72LL ADN 5 1
736= SBX 5 4
73KW # NEW TRAP INSERTED
745G ZZ8
74K6 BACKSPACE
754Q BCT 5 ZZ8
75JB TABRESET
7642 BRN NOTABULE
76HL # NORMAL SEARCH FOR NEW FTRAP ETC
773= OTHERWHERE
77GW TABULATE [BACK TO START OF TRAPS(OR INDEX REC)
782G NOTABULE
78G6 HUNTW 1,FILE,FTRAP
78^Q BNG 1 NOMORE [EXIT IF END
79FB NAMETOP 1,FILE,FAPB
79^2 LDX 6 ETRAPMODES(1)
7=DL LDCT 0 #200
7=Y= LDXC 7 7 [CLEAR TS BIT
7?CW ANDX 0 6
7?XG SLL 0 1
7#C6 ORX 7 0 [& PUT BACK IF APPROPRIATE
7#WQ ORN 7 1
7*BB ERN 7 1
7*W2 CHAIN 1,FX2
7B*L BRN NEXTONE
7BT= NOMORE
7C#W FREETAB
7CSG SETREP OK
7D#6 UP
7DRQ XBRK GEOERR 1,BROKENIN
7F?B [
7FR2 MENDAREA 25,K99TRAPGO
7G=L #END
^^^^ ...07226722000200000000