(George Source)
Macros used: ABANDCOM, ACROSS, ADDJOB, ADDJOBJ, ADDJOBW, BUDGCHAR, BXE, CHARMOVE, CHEKLFN2, CLOSETOP, COMBRKIN, DICTJOB, DOWN, ENDCOM, ERRORX, FJOCA, FREECORE, FSHENTRY, GEOERR, HUNTW, IPBINOPID, JBC, JBS, JLADJUST, JMBAC, MBS, MFREE, MFREEALL, MHUNT, MHUNTW, MONOUT, NAMETOP, OFF, PARABEG, PARALYSX, PARANOTX, PARUNACC, REWIND, SECHECK, SEG, SEGENTRY, SETNCORE, SINM551, SINMAC2, SPARABEG, SPARANOX, SPARUNAC, SUBJOB, SUBJOBJ, SUICIDE, T, TESTHKN, TESTHOOK, TESTPRIV, TESTREP2, TESTRPN2, TRACE, UP, UPPLUS, WKPTABLE
226D ... SEG INITJOB,867,SECTION CENT,,G3UGSI,G551,G400
22=W ...[
22C# ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1982
22HQ ...[ THIS EXCLUDES CODE UNDER #SKI G551
22N8 ...[ AND UNDER #SKI G3UGSI
22SL ...[
22^= #OPT WELLTEST=0
23DW #OPT K0INITJOB=0
23YG #LIS K0INITJOB>K0ALLGEO>K0GREATGEO>K0COMMAND
244Y ...#UNS G400
249B ...# THIS CHAPTER MODIFIED FOR G3PLUS-IH
24*S ...#OPT G551 = 0
24G= ...#SKI G551&1
24LN ...# WITH G3UG EDIT M551 (SELECTIVE PASSWORD CHECKS FOR CENTRAL AND REMOTE)
24R6 ...#OPT G3UGSI = 0
24XQ [
252* ...#SKI G3UGSI
254Y ...(
257H ...[ MACRO TO PREVENT M551 AND SECURITY INTERFACE CLASH
25=6 ... SINM551
25#P ...)
25CB [ THIS SEGMENT ...
25X2 [
26BL [
26W= [ USE OF AWORK1-4 WORDS
27*W [
27TG [ AWORK1 USER CONTEXT PRIVS
28*6 [ AWORK2 COMMAND TYPE
28SQ [ AWORK3 TERMINATOR
29#B [ AWORK4 PARAM/ SHIFT MARKER /TERM/MODE PARAM NUMBER
29S2 [
2=?L [
2=R= [ ENTRY POINTS
2?=W SEGENTRY K1INITJOB [DISCONNECT
2?QG [
2#=6 CALL 7 START
2#PQ SEGENTRY K2INITJOB [LOGIN
2*9B CALL 7 START
2*P2 SEGENTRY K3INITJOB [JOB
2B8L CALL 7 START
2BN= SEGENTRY K4INITJOB [RUNJOB
2C7W CALL 7 START
2CMG SEGENTRY K9INITJOB,TIDY3 [ERROR ENTRY FROM ENWELL/DEWELL
2CX# FSHENTRY K10INITJOB,XK10,,XK10
2D39 FSHENTRY K11INITJOB,,XBIPB,XBIPB
2D4G ...#SKI G551
2D5R ... SEGENTRY K20INITJOB,PWCHECK
2D76 SEGENTRY K99INITJOB
2DLQ ...[
2F6B #DEF SIZEU=APARA+3-A1
2FL2 [
2G5L [
2GK= [
2GKG ...#SKI G551
2GKQ ...(
2GL2 ...# MEND M551 - SELECTIVE PASSWORD CHECKING
2GL= ...# COPYRIGHT (C) 1980 YORKSHIRE REGIONAL HEALTH AUTHORITY
2GLG ...# WRITTEN BY J.THOMASON FOR Y.R.H.A.
2GLQ ...#
2GM2 ...TLETQ 4H000Q
2GM= ...TLETF 4H000F
2GMG ...TLETL 4H000L
2GMQ ...#
2GN2 ... SEGENTRY K21INITJOB
2GN= ...TCENTRAL 16HNMM NMM NOF NOF
2GNG ...TREMOTE 16HNMM NMM PMF OFF
2GNQ ...)
2GP7 XBRA #30
2GT4 XSTOP #36
2GY^ XSPACE #20
2H4W PARAM 5HPARAM
2HJG MODE 4HMODE
2J46 T 4H000T
2JHQ S 4H000S
2K3B T1 4HT
2KH2 S1 4HS
2KQS XONE
2L2L XCOLON 1
2LG= 4H:
2L^W WKPTAB
2MFG WKPTABLE
2NDQ PCON #700000
2PD2 PJUSNA +JUSNA
2PXL PJJOBNA +JJOBNA
2Q=2 NOWELL 4HNOWE
2QC= [
2QWW [ SUBROUTINE TO PARABEG FOR PARAMETER BEGINNING WITH THE [X5]
2RBG [ CHARACTERS STARTING AT [X3]. EXITS AS ANNOTATED.
2RW6 [
2S*Q XPBEG NGNC 0 1
2STB XPBEGCH [ENTRY A0 XPBEGCH CHECKS PARAMETER...
2T*2 LDN 4 0 [...FOUND IS COMPOSITE (I.E. TYPE 2)
2TSL SBX 7 FX1
2W#= PARABEG 1,5,0(3),,0
2WRW MHUNT 3,CPB,CUNI
2X?G ADX 7 FX1
2XR6 LDX 5 ANUM(3)
2Y=Q STO 4 ACOMMUNE1(2)
2YQB BNZ 4 XPB1 [J IF XPBEG ENTRY
2^=2 LDX 4 JPARNUM(3)
2^PL FREECORE 3 [FREE CPB/CUNI BLOCK IF XPBEGCH
329= XPB1 BPZ 5 XPB2 [J IF PARAMETER EXISTS
32NW EXIT 7 0 [PARAMETER NON-EXISTENT
338G XPB2 BNZ 5 XPB3
33N6 XPB4 EXIT 7 1 [NULL PARAMETER (ILLEGAL IF XPBEGCH)
347Q XPB3 LDX 0 ACOMMUNE1(2)
34MB BNZ 0 XPB5 [J IF XPBEG ENTRY
3572 SRL 5 12
35LL SBN 5 2
366= BNZ 5 XPB4 [J IF NOT TYPE 2 PARAMETER
36KW XPB5 EXIT 7 2 [OK
375G [
376H [ SUBROUTINE TO SPLIT PARAMETER AND TEST REPLY
377J [ X7=LINK
378K [ X3=NO OF PARAMETER
379L [ EXIT 0 IF ERROR FOUND, EXIT 1 OTHERWISE
37=M [
37?N PARAL
37#P SBX 7 FX1
37*Q PARALYSX 4,,3
37BR ADX 7 FX1
37CS TESTRPN2 OK,PARAL10 [J IF NOT OK
37DT EXIT 7 1
37FW PARAL10
37GX EXIT 7 0
37HY [
37K6 [ SUBROUTINE TRAN SPACE-FILLS THE 3 WORD AREA FROM [X2] AND THEN
384Q [ MOVES INTO IT THE CONTENTS OF THE CPB/CUNI BLOCK AT [X3]. ENTRY
38JB [ AT TRANH HUNTS THE CPB/CUNI BLOCK FIRST.
3942 [
39HL TRANH MHUNT 3,CPB,CUNI
3=3= TRAN LDX 5 ACES
3=GW STO 5 0(2)
3?2G STO 5 1(2)
3?G6 STO 5 2(2)
3?^Q LDX 1 ANUM(3)
3#FB LDN 5 APARA(3)
3#^2 LDN 6 0(2)
3*DL MVCH 5 0(1)
3*Y= LDX 1 FX1
3BCW EXIT 7 0
3BXG [
3CC6 [ SUBROUTINE TO CHECK THAT PARAMETER HAS LOCAL FILE NAME FORMAT
3CWQ [
3DBB XCHEKLFN
3DW2 CHEKLFN2 (7),NLFN
3F*L EXIT 7 1
3FT= [
3G#W [ SUBROUTINE TO SPARABEG FOR USERNAME PARAMETER
3GSG [
3H#6 XSPCOL
3HRQ SBX 7 FX1
3J?B SPARABEG 1,XCOLON(1)
3JR2 ADX 7 FX1
3K=L EXIT 7 0
3KQ= [
3L9W [ X4USER SETS X4 TO POINT TO THE 3 WORD USERNAME. THIS IS CPREFIX
3LPG [ IN THE CPA FOR NO-USER AND JUSER IN THE JOBLOCK FOR USER.
3M96 [
3MNQ X4USER
3MNT ...#UNS G400
3MNY ...(
3MP3 ...[
3MP6 ...[ TEST FOR RJ TO ANOTHER USER
3MP9 ...[
3MP# ... HUNTW 2,IUSER,G400USER [SEE IF A USERNAME
3MPC ... BNG 2 X4HOOK [JUST AS NORMAL
3MPG ... LDN 4 A1(2) [GET ADDR OF USERNAME
3MPK ... BRN X6
3MPN ...X4HOOK
3MPR ...)
3MPY [
3MR6 [
3MS# [ TEST FOR SPECIAL DC CASE FIRST
3MTG [
3MWN HUNTW 2,JWELL,COPYSYS
3MXW BNG 2 X4ACT
3M^4 LDX 0 A1+FRH+JLUSER(2)
3N2= BZE 0 X4ACT
3N3D LDN 4 A1+FRH+JLUSER(2)
3N59 BRN X6
3N72 X4ACT
3N7N LDX 2 FX2
3N8B LDN 4 CPREFIX(2)
3NN2 LDX 0 CONTEXT(2)
3P7L ANDN 0 1
3PM= BZE 0 X4XIT
3Q6W FJOCA 2
3QLG LDN 4 JUSER(2)
3R66 X6 LDX 2 FX2
3RKQ X4XIT EXIT 7 0
3S5B [
3S5^ SETUPJW
3S6J SBX 4 FX1
3S77 LDX 2 FX2
3S7Q STO 4 ACOMMUNE1(2)
3S8* LDX 6 JOBDATASIZE
3S8Y ADN 6 JOBLISTSIZE
3S9H SETUPCOR 6,3,JWELL,COPYSYS [ INITIAL RECORD SIZE FOR SYS JOBLIST
3S=6 [
3S=P [ CLEAR TO ZERO
3S?# [
3S?X STOZ A1(3)
3S#G LDN 4 A1(3)
3S*5 LDN 5 A1+1(3)
3S*N SMO 6
3SB? MOVE 4 511 [ CLEAR TO ZERO
3SBW [
3SCF [ RECORD SIZE...
3SD4 [
3SDM STO 6 A1(3)
3SF= JLADJUST 3
3SFT STO 7 JLBUDGETS(3)
3SGD LDX 4 ACOMMUNE1(2)
3SGL MHUNTW 2,FILE,ADICTENT
3SGN JBC NFRZ,2,BFROZEN
3SGQ MBS 3,JLBFROZENNC,JLBNOTCAND
3SGS NFRZ
3SH3 CLOSETOP
3SHL ADX 4 FX1
3SJ9 EXIT 4 0
3SK2 [
3T4L [
3TJ= [
3W3W [
3WHG [
3X36 [
3XGQ [
3Y2B [ START OF MAIN SEQUENCE OF CODE
3YG2 [
3Y^L START
3^F= ANDX 7 BITS22LS [CONVERT X7 TO COMMAND MARKER...
3^YW SBN 7 K4INITJOB(1) [...DC=-2 ; LN=-1 ; JB=0 ; RJ=1
42DG BNG 7 ST1
42Y6 BZE 7 ST1 [J IF NOT FROM RUNJOB
43CQ ANDX 7 CONTEXT(2)
43XB ADN 7 1 [X7=1 FOR NO-USER RJ ;=2 FOR USER RJ
44C2 ST1 STO 7 AWORK2(2) [ COMMAND TYPE
44WL ADN 7 1
45B= BNZ 7 ST2 [J IF NOT LOGIN
45TW LDX 4 CPLEV(2)
46*G BNZ 4 XNOUGHT [ERROR IF LN NOT DIRECT FROM CONSOLE
46T6 ST2 LDX 4 ACES [SP-FILL AWORK3 LEST TERM<4 CHAS...
47#Q STO 4 AWORK3(2) [...FOUND IN JOB.
47SB STOZ AWORK4(2)
48#2 LDX 7 AWORK2(2) [ COMMAND TYPE
48RL TRACE 7,INITJOB
49?= SBN 7 2
49QW BZE 7 XRJ [J IF USER RJ
4==G ADN 7 4
4=Q6 BZE 7 XDC [J IF DC
4?9Q [
4?PB [ GET AND CHECK USERNAME PARAMETER
4#92 [
4#B8 ...#UNS G400
4#HB ...XNEWRJ
4#NL CALL 7 XSPCOL
4*8= CALL 7 XCHEKLFN
4*MW BRN NUSEN
4B7G LDX 6 JPARNUM(3)
4BM6 SBN 6 3
4C6Q BPZ 6 NUSEN [MUST BE PARAMETER 1 OR 2
4C7Y ...#UNS G400
4C96 ...(
4C=# ... LDN 7 1
4C?G ... ANDX 7 CONTEXT(2)
4C#N ... BZE 7 XNUH [J IF NO-USER
4C*W ... SETNCORE 3,2,IUSER,G400USER [BLOCK TO HOLD USER NAME
4CC4 ... LDN 2 A1(2) [ADDR OF DUMP AREA
4CD= ... CALL 7 TRANH
4CFD ... FREECORE 3
4CGL ... BRN XNUHX
4CHS ...XNUH
4CK2 ...)
4CLB LDN 2 CPREFIX(2)
4D62 CALL 7 TRAN [MOVE USERNAME TO CPAT
4DKL FREECORE 3
4F5= XRJ
4F6H ...#UNS G400
4F7S ...(
4F95 ... TESTHKN XNUHX [JUMP IF NOT IN A HOOK
4F=B ... PARUNACC
4F?M ... MHUNT 3,CPB,CUNI
4F#Y ... LDCH 0 APARA(3)
4FB9 ... SBN 0 10
4FCG ... BNZ 0 XDC
4FDR ... BRN XNEWRJ
4FG4 ...XNUHX
4FH* ...)
4FJW [
4G4G [ GET AND CHECK JOBNAME PARAMETER
4GJ6 [
4H3Q PARUNACC
4HHB XDC
4J32 CALL 7 XCHEKLFN
4JGL BRN NJOBN
4K2= LDXC 6 EXT+7(2)
4KFW BCS SPACERR [SPACE(S) FOUND IN JOBNAME
4K^G [
4LF6 [ PASS JDF PARAMETER FOR RUNJOB (NOW IN CASE IT IS PARAM...)
4LYQ [
4MDB NGX 7 AWORK2(2)
4MY2 BPZ 7 NTRJ [J IF NOT RUNJOB
4N2* SPARUNAC
4N4N MHUNT 3,CPB,CUNI
4N73 LDX 7 ANUM(3)
4N9B BZE 7 NCHSP
4N?P BNG 7 NCHSP
4NB4 ANDN 7 #7777 [(NON ZERO) CHARACTER COUNT
4NDC LDN 2 APARA(3)
4NGQ LDN 5 0 [SET "IGNORING LEADING SPACES"
4NK5 LDN 6 0
4NMD TSPLOOP
4NPR LDCH 0 0(2)
4NS6 BXE 0 XBRA(1),XOUTLOOP [J OUT IF "("
4NWF BXE 0 XSTOP(1),ZERO56 [J IF "."
4NYS BXE 0 XSPACE(1),SETSP6 [J IF SPACE
4P37 LDN 5 1 [UNSET "IGNORING LEADING SPACES"
4P5G BPZ 6 NXTCHAR [J IF NOT AFTER SPACE
4P7T ORN 6 1 [SET INTERNAL SPACE MARK
4P=8 BRN NXTCHAR
4P#H SETSP6
4PBW BZE 5 NXTCHAR [J IF IGNORING SPACES
4PF9 ORX 6 GSIGN [SET SPACE FOUND
4PHJ BRN NXTCHAR
4PKX ZERO56
4PN= LDN 5 0
4PQK LDN 6 0
4PSY NXTCHAR
4PX? BCHX 2 £
4P^L BCT 7 TSPLOOP
4Q3^ XOUTLOOP
4Q6# ANDN 6 1
4Q8M BNZ 6 SPACERR2 [J IF INTERNAL SPACE FOUND
4Q?2 NCHSP
4QB6 NAMETOP 3,FILE,FNAME
4QTQ NTRJ
4R*B [
4RT2 [ GET AND CHECK FORMAT OF 'PARAM' PARAMETER.
4S#L [ IF PRESENT
4SS= [
4T?W LDN 5 5
4TRG LDN 3 PARAM(1)
4W?6 CALL 7 XPBEGCH [LOCATE AND CHECK 'PARAM'
4WQQ BRN XMODE [NONE PRESENT
4X=B BRN PARILL [FORMAT ERROR IN 'PARAM' PARAMETER
4XQ2 DCH 4 AWORK4(2) [ REMEMBER PARAM NUMBER
4XQX [
4XRS [ CHECK PARAMETER
4XSP LDX 3 4
4XTL NGN 4 1 [SET SEPARATOR=-1
4XWH CALL 7 PARAL [SPLIT INTO "PARAM" & "PARAMETERS"
4XXD BRN PARILL [J IF ERROR
4XY* LDN 3 2
4X^= CALL 7 PARAL [SPLIT OFF OUTER BRACKETS
4Y27 BRN PARILL [J IF ERROR
4Y34 LDN 3 1
4Y3^ LDN 4 #34 [SET SEPARATOR = ","
4Y4W CALL 7 PARAL [SPLIT ACTUAL PARAMETERS
4Y5R BRN PARILL [J IF ERROR
4Y6N [ ALL OK - RELEASE THE CPB/CMULTI BLOCKS
4Y7K MFREEALL CPB,CMULTI
4Y8G [
4Y9L XMODE LDX 7 AWORK2(2)
4YP= BNZ 7 PEND1 [J UNLESS FROM JOB
4^8W [
4^NG [ FOR 'JOB' WE HAVE TO DEAL WITH THE OPTIONAL MODE AND TERMINATOR
5286 [ PARAMETERS,BEARING IN MIND THE 2 POSSIBLE FORMATS.
52MQ [ NEW FORMAT IS ASSUMED IF 'PARAM' OR 'MODE' IS PRESENT,OR IF
537B [ PARAMETER 3 IS NOT NULL/T/S.
53M2 [
546L [ GET PARAMETER NUMBER AND CHECK FORMAT OF
54L= [ 'MODE' PARAMETER,IF PRESENT
555W [
55KG LDN 5 4
5656 LDN 3 MODE(1)
56JQ CALL 7 XPBEGCH
574B BRN XTERM [NO 'MODE' PARAMETER
57J2 BRN MODILL [FORMAT ERROR IN 'MODE' PARAMETER
583L DEX 4 AWORK4(2) [REMEMBER PARAMETER NUMBER
585J [
587G [ CHECK PARAMETER
589D LDX 3 4
58?B NGN 4 1 [SET SEPARATOR =-1
58*# CALL 7 PARAL
58C= BRN MODILL [J IF ERROR
58F= MFREE CPB,CMULTI
58H= BRN XTERB [ASSUME NEW FORMAT - GO FIND TERM.
58PG XTERM
5Q5Q XTERB LDN 6 2
5QKB LDN 3 T1(1)
5R52 XTB1 LDN 5 1
5RJL CALL 7 XPBEG [PARABEG FOR T/S
5S4= BRN NONE [NO SUCH PARAMETER
5SHW BRN NULL [PRESENT BUT NULL
5T3G LDX 4 APARA(3) [TEXT OF TERM.(SP-FILLED TO 4 CHARS)
5TH6 STO 4 AWORK3(2)
5W2Q NULL ADN 6 #62
5WGB SLL 6 6
5X22 ORS 6 AWORK4(2) [REMEMBER T/S
5XFL BRN PEND
5X^= NONE FREECORE 3
5YDW LDN 3 S1(1)
5YYG BCT 6 XTB1 [IF 'T' ABSENT LOOK FOR 'S'
5^D6 BRN PEND1
5^XQ PEND FREECORE 3
62CB [
62X2 [ END OF 'JOB' SOLO. INCREMENT JOB COUNT IF POSSIBLE
63BL [
63FH PEND1
63GG LDN 5 4
63HF LDN 3 NOWELL(1)
63JD CALL 7 XPBEG [LOOK FOR NOWELL PARAMETER
63KC BRN NNWL
63LB NULL
63M* LDCT 0 #400
63N# ORS 0 AWORK1(2) [SET MARKER FOR LATER
63P? NNWL
63Q= FREECORE 3
63R9 NGX 7 AWORK2(2)
64?= #
64#4 XK10
64#W #
65*6 BCT 7 NLN [J IF NOT LN
65SQ ADDJOB UP,XCOM [INCREMENT JOB COUNT WITH MOP JOB
66#B BRN XOFFL
66C8 ...NLN
66G2 ...#SKI CASKI8214
66JS ...(
66ML ... LDX 7 AWORK1(2)
66QD ... BNG 7 NLN1 [J IF NOWELL
66T= ... ADDJOBW UP,XCOM
66Y4 ... BRN XOFFL
672W ...NLN1
675N ...)
678G ... ADDJOBJ UP,XCOM [INCREMENT JOB COUNT WITH OFFLINE JOB
67?L XOFFL
67R= [
68=W [ CHECK USER'S MONEY BUDGET AND,IF OK,INCREMENT COUNT OF HIS JOBS
68QG [ IN DICTIONARY
69=6 [
69PQ SETNCORE 3,3,FILE,ADICT
6=9B CALL 7 X4USER
6=P2 LDN 5 A1(3)
6?8L MOVE 4 3 [MOVE USERNAME INTO FILE/ADICT
6?N= DICTJOB 1 [CHECK MONEY/INCREMENT COUNT
6#7W TESTREP2 OK,XDOK,NOUSER,XNOUSE,UNJOB,UNJOB,NOTENUF,XENUF
6#MG GEOERR 1,DICTNOK
6*76 XDOK
6*LQ [
6B6B [ GET CONTEXT PRIV'S OF USER AND,IF NECESSARY,CHECK HE HAS THOSE
6BL2 [ REQUIRED. REMEMBER HIS CONTEXT PRIV'S IN AWORK1.CHECK PW IF NEC.
6C5L [
6CK= LDX 7 AWORK2(2)
6D4W SBN 7 2
6DJG BZE 7 XRJ1 [J IF USER RUNJOB
6F46 ADN 7 4
6FHQ BZE 7 XDC1 [J IF DC
6FW7 ...#UNS G400
6G8J ...XSDK1
6GH2 LDN 7 0
6H2L LDN 3 0
6H^W SETNCORE 4,1,CPB,CUNI
6JFG LDN 0 8
6J^6 STO 0 ANUM(1)
6KDQ BRN Q1A
6KYB Q1 MHUNT 1,CPB,CUNI
6LD2 Q1A SMO FX1
6LXL LDN 0 WKPTAB(3)
6MC= LDN 1 APARA(1)
6MWW MOVE 0 2 [MOVE 'CONTEXTA/B/C' INTO CPB/CUNI
6NBG REWIND
6NW6 BUDGCHAR [GET BIT PATTERN FOR GIVEN CONTEXT...
6P*Q [ [...PRIV IN JBUDGET/JLINE
6PTB TESTRPN2 OK,Q2 [JUMP ON IF NO SUCH BUDGET TYPE
6Q*2 MHUNTW 2,JBUDGET,JLINE
6QSL MHUNTW 1,FILE,ADICTENT
6R#= TESTPRIV JPATTERN(2),1 [TEST IF USER HAS CONTEXTA/B/C PRIV
6RRW BZE 0 Q3 [J IF NOT
6S6? SMO FX1
6SDN ORX 7 WKPTAB+2(3)
6SR6 Q3 FREECORE 2 [FREE JBUDGET/JLINE
6T86 Q2 ADN 3 3 [UPDATE CONTEXT C!AR. STRING MOD.
6TK6 SMO FX1
6W26 LDX 0 WKPTAB(3)
6WC6 BNZ 0 Q1
6WS6 CALL 4 SETUPJW
6X9= MFREE CPB,CUNI
6XNW LDX 5 AWORK1(2) [CONTEXT BITS OF COMMAND LEFT BY...
6Y8G [ [...COMMAND PROCESSOR.
6YN6 ANDX 5 PCON(1) [ISOLATE CONTEXT PRIV'S REQUIRED
6^7Q ANDX 5 ICONTEXT [DROP THOSE NOT CURRENTLY ENFORCED
7272 BZE 5 XCONOK [J IF NO CONTEXT PRIV'S REQUIRED
72LL ANDX 7 5
72WD ANDX 7 PCON(1)
736= ERX 7 5
73KW BNZ 7 XERPRIV [J IF USER HASN'T ALL REQUIRED
745G XCONOK
746? ...#SKI G551&1
7474 ...(
747T ...[ MEND EXCHANGE SCHEME CODE
748L ... LDCT 0 #600
749C ... ANDX 0 CONTEXT(2)
74=8 ... BNZ 0 SYSIS
74=^ ... LDN 7 2
74?Q ... ADX 7 AWORK2(2) [ 1 - LN, 2 - JB, 3 - RJ
74#H ... DOWN INITJOB,20
74*# ... BRN XBROKIN [ BREAK-IN
74B5 ... BRN MESSI [ PW INVALID
74BW ... BRN NCH [ OK
74CM ... BRN MESSH [ PW REQ'D & NOT OFFERED
74DD ...)
74F9 ...#SKI G551^G3UGSI<1$1
74G2 ...(
74GR ...[ THE NEXT BIT IS COMPILED IF NEITHER OF G3 USER GROUP
74HJ ...[ MENDS FOR SECURITY INTERFACE ENHANCEMENT NOR SELECTIVE PASSWORD
74J* ...[ CHECKING (G551) IS SWITCHED ON
74K6 MHUNTW 3,FILE,ADICTENT
74KX ...#UNS G400
74LN ...(
74MF ... HUNTW 1,IUSER,G400USER
74N= ... BPZ 1 USERLS
74P3 ... LDX 1 FX1
74PS ... LDX 4 AWORK2(2)
74QK ... SBN 4 1
74RB ... BNZ 4 NOTRJ
74S7 ... TESTHOOK USERLS
74SY ...NOTRJ SEGENTRY G400PSWD
74TP ... BRN PASSCHK
74WG ...XTYPE +0
74X? ... LDX 0 XTYPE(1)
74Y4 ... ADN 4 2
74YT ... SMO 4
74^L ... SLL 0 0
752C ... BNG 0 USERLS
7538 ...PASSCHK
753^ ...)
754Q LDCT 4 #600
75JB ANDX 4 CONTEXT(2)
7642 BNZ 4 USERLS [J IF SYSTEM ISSUED
76HL SECHECK 3,USERLS,XNOR [-> USERLS IF LOW :->XNOR IF NOR. SEC
76NS SINMAC2 MESSH
76W2 LDX 2 FX2
773= LDX 4 CONTEXT(2)
77GW ANDN 4 #60
782G BNZ 4 MESSH [J TO ERROR FLAG IF NOT MOP AND HIGH
78G6 XNOR LDX 4 CONTEXT(2)
78^Q ANDN 4 #10
79FB BZE 4 USERLS [SKIP PW CHECK IF NOT MOP
7=Y= CHEKPASW XBROKIN,MESSI [READ AND CHECK PW. N.B. CHEKPASWRD..
7?CW [ [...FREES FILE/ADICTENT
7?GN ...)
7?KG ...[
7?N# ...#SKI G3UGSI
7?R6 ...(
7?TY ...[ THIS SECTION IS COMPILED IF G3 UG SEC INTERFACE ENHANCEMENT
7?YQ ...[ IS SWITCHED ON
7#3J ... SINMAC2 XENOR,XBROKIN,2 [XENOR=ERROR, XBROKIN=BREAKIN
7#6B ...)
7#98 ...#SKI G551&1$1
7##2 ... BRN NCH
7#C6 XRJ1 [FOR RJ IN USER CONTEXT AND DC...
7#FP ...#UNS G400
7#J# ...(
7#LX ... HUNTW 3,IUSER,G400USER
7#PG ... BPZ 3 XSDK1
7#S5 ...)
7#WQ XDC1 [CONTEXT PRIV'S ARE FOUND FROM JPRIV
7*BB [ [IN THE JOB BLOCK.
7B*L FJOCA 3,2
7BN3 NGN 7 4
7C2D ANDX 7 JPRIV(3)
7C3P ...#SKI G3UGSI<1$1
7C53 JBC NSECURE,3,JBSINFACE1 [J IF NOT SECURE USER
7C5M ...[
7C6? ...#SKI G3UGSI [USER GROUP SECURITY INTERFACE
7C6X ... JMBAC NSECURE,3,JBSINFACE1,JBSINFACE2 [J IF NOT SECURE USER
7C7L ORN 7 1
7C=9 NSECURE
7C#W CALL 4 SETUPJW
7CM? ...#SKI G551&1
7C^N ...SYSIS
7D#6 MHUNTW 3,FILE,ADICTENT
7DRQ USERLS
7F?B FREECORE 3
7FR2 NCH
7G=L XACR ACROSS ENWELL,1
7G=N ...#SKI G551&1
7G=Q ...(
7G=S ...[ MEND EXCHANGE SCHEME CODE
7G=W ...#
7G=Y ...PWSTL 8,8HPASSWORD [ LONG KEY - CAN BE CHANGED IF REQ'D
7G?2 ...PWSTS 2,2HPW [ SHORT KEY - DITTO
7G?4 ...#
7G?6 ...ZQUOT #22
7G?8 ...ZCOMM #34
7G?= ...#DEF ZLBRA = XBRA
7G?# ...ZRBRA #31
7G?B ...#DEF ZSPAC = XSPACE
7G?D ...#
7G?G ...# SUBROUTINE TO FIND NEXT PARAM, LEAVING START POINT IN AWORK3,
7G?J ...# END POINT IN AWORK2, NUMBER OF CHARACTERS IN X4
7G?L ...SKPAR LDX 3 AWORK2(2) [ POSITION OF PRECEDING COMMA
7G?N ... BCHX 3 £
7G?Q ... SBN 7 1
7G?S ... STO 3 AWORK3(2) [ START OF PARAMETER
7G?W ... STO 7 GEN0
7G?Y ... BZE 7 PFIN [ IN CASE NO PW & FINAL COMMA
7G#2 ... LDN 6 0 [ -1 = QUOTES, +VE = () DEPTH
7G#4 ...SKPL LDCH 4 0(3)
7G#6 ... NGX 0 6
7G#8 ... LDXC 0 0 [ NGXC DOESN'T WORK AS REQUIRED
7G#= ... TXU 4 ZQUOT(1)
7G## ... NGN 0 0
7G#B ... ERX 0 GMINUS1 [ IF QUOTES OUTSIDE (),
7G#D ... ERX 6 0 [ SWITCH QUOTES MARKER
7G#G ... TXU 6 GZERO
7G#J ... TXU 4 ZCOMM(1)
7G#L ... BCC PFIN [ COMMA OUTSIDE QUOTES OR ()
7G#N ... LDXC 0 6
7G#Q ... TXU 4 ZLBRA(1) [ ( OUTSIDE QUOTES
7G#S ... SBN 6 0
7G#W ... LDXC 0 6 [ IGNORE ) IN QUOTES OR WITHOUT (
7G#Y ... TXU 4 ZRBRA(1)
7G*2 ... ADN 6 0
7G*4 ... BCHX 3 £
7G*6 ... BCT 7 SKPL
7G*8 ...PFIN STO 3 AWORK2(2)
7G*= ... LDX 6 GEN6
7G*# ... LDX 4 GEN0
7G*B ... ADN 6 1
7G*D ... SBX 4 7 [ NO. OF CHARS IN THIS PARAM
7G*G ... STO 6 GEN6 [ LEAVE PARAM NO. IN X6
7G*J ... EXIT 5 0
7G*L ...#
7G*N ...# TEST IF 'PASSWORD' KEY AT START OF PARAM JUST SCANNED.
7G*Q ...# ENTER WITH X1 POINTING TO KEY STRING PWSTL OR PWSTS.
7G*S ...# EXIT IF NOT MATCHED, ELSE GO AHEAD WITH PROCESSING IT.
7G*W ...TPWS STO 5 GEN0 [ LINK
7G*Y ... TXL 4 0(1)
7GB2 ... BCS NPWS [ TOO SHORT
7GB4 ... LDX 6 0(1)
7GB6 ... LDX 3 AWORK3(2)
7GB8 ... STO 1 GEN1
7GB= ...TPWSL BZE 6 YPWS
7GB# ... LDCH 5 1(1)
7GBB ... BCHX 1 £
7GBD ... SBN 6 1
7GBG ...TPWSB TXU 3 AWORK2(2) [ END OF PAR
7GBJ ... BCC NPWS
7GBL ... LDCH 0 0(3)
7GBN ... BCHX 3 £
7GBQ ... TXU 0 5
7GBS ... BCC TPWSL [ OK SO FAR
7GBW ... ERN 0 #20
7GBY ... BZE 0 TPWSB [ IGNORE SPACE
7GC2 ...NPWS LDX 1 FX1
7GC4 ... BRN (GEN0) [ EXIT - NOT MATCHED
7GC6 ...#
7GC8 ...YPWS NGN 1 3
7GC= ... ANDX 1 BITS22LS
7GC# ... SBN 4 1
7GCB ... STO 4 GEN5 [ TOTAL LENGTH OF PW PARAM -1
7GCD ... STO 7 GEN4 [ NO. OF CHARS LEFT IN COMMAND
7GCG ... TXU 3 AWORK2(2)
7GCJ ... BCC PWMVS [ EMPTY - INSERT SPACES
7GCL ... LDN 5 #20
7GCN ...YPWSK LDCH 0 0(3)
7GCQ ... BCHX 3 £
7GCS ... TXU 0 5 [ SKIP INITIAL SPACES
7GCW ... BCS PWMV
7GCY ... TXU 3 AWORK2(2)
7GD2 ... BCS YPWSK
7GD4 ...PWMVS LDN 0 #20
7GD6 ...PWMV DCH 0 8(1) [ COPY TO X5X6X7
7GD8 ... BCHX 1 £
7GD= ... BZE 1 PWMVE [ 12 CHARS DONE
7GD# ... TXU 3 AWORK2(2)
7GDB ... BCC PWMVS [ SPACES AFTER END
7GDD ... LDCH 0 0(3)
7GDG ... BCHX 3 PWMV
7GDJ ...PWMVE LDXC 0 AWORK4(2)
7GDL ... BCS ZMV [ NO WIPE REQUIRED
7GDN ... LDX 4 AWORK3(2) [ SLIDE UP ANYTHING FOLLOWING
7GDQ ... LDX 3 AWORK2(2)
7GDS ... CHARMOVE 3,GEN4
7GDW ... LDX 3 4 [ TO WIPE REST WITH SPACES
7GDY ... LDN 0 #20
7GF2 ... BCHX 4 £
7GF4 ... DCH 0 0(3)
7GF6 ... CHARMOVE 3,GEN5
7GF8 ... LDX 4 GEN5
7GF= ... SMO AWORK1(2)
7GF# ... SBS 4 ANUMCHA [ REDUCE CLB CHAR COUNT
7GFB ...ZMV LDX 4 GEN6 [ PARAMETER TO BE MARKED 'ACCESSED'
7GFD ... PARANOTX 4 [ AND TIME WE COORDINATED ANYWAY
7GFG ... MFREE CPB,CUNI
7GFJ ... MHUNTW 3,FILE,ADICTENT
7GFL ... LDN 0 1
7GFN ... ANDX 0 AWORK4(2)
7GFQ ... BZE 0 PWOK [ N OR P - NO CONTENT CHECK
7GFS ... TXU 5 CPASS(3)
7GFW ... TXU 6 CPASS+1(3)
7GFY ... TXU 7 CPASS+2(3)
7GG2 ... BCS XMESSI
7GG4 ...PWOK
7GG6 ... FREECORE 3
7GG8 ... UPPLUS 2
7GG= ...XMESSI
7GG# ... FREECORE 3
7GGB ... UPPLUS 1
7GGD ...XMESSH
7GGG ... FREECORE 3
7GGJ ... UPPLUS 3
7GGL ...#
7GGN ...# ENTRY POINT - X7 -VE IF PARAM CLEARING NOT REQUIRED
7GGQ ...# L.S. 22 BITS OF X7 IDENTIFY CALLING ROUTINE:
7GGS ...# 1 - LN / CN, 2 - JOB / INPUT, 3 - RJ
7GGW ...#
7GGY ...PWCHECK
7GH2 ... STO 7 AWORK4(2)
7GH4 ... LDN 0 3
7GH6 ... ANDX 7 BITS22LS
7GH8 ... TXU 7 0
7GH= ... SBN 0 0 [ RESET TO 2 UNLESS RJ
7GH# ... STO 0 GEN5 [ NO. OF FIXED-POSITION PARAMS
7GHB ... SBX 7 0 [ -1 - LN/CN, 0 - OTHERS
7GHD ... JBS PWCX,2,CXTMOP
7GHG ... LDN 7 1
7GHJ ... JBS PWCX,2,CXTREADER
7GHL ... LDN 7 2 [ OPERATOR CONTEXT
7GHN ...PWCX ADN 7 1 [ 0 LN/CN, 1 MOP, 2 READER, 3 OPS
7GHQ ... JBC PWCT,2,CXTREMOTE
7GHS ... ADN 7 4 [ + 4 IF REMOTE
7GHW ...PWCT MHUNTW 3,FILE,ADICTENT
7GHY ... LDX 2 CINDIC(3)
7GJ2 ... ANDN 2 3 [ SECURITY - 0 NORMAL, 1 HIGH, 2 LOW
7GJ4 ... LDN 0 1
7GJ6 ... SLL 0 22(2) [ CHAR. 0 LOW, 1 NORMAL, 2 HIGH
7GJ8 ... ADX 1 7 [ TABLE WORD POINTER
7GJ= ... ORX 1 0 [ CORRECT CHARACTER POINTER
7GJ# ... LDCH 6 TCENTRAL(1) [ TABLE CHAR F,M,N,O,P,Q
7GJB ... LDX 1 FX1
7GJD ... NGNC 5 1
7GJG ... TXL 6 TLETQ(1)
7GJJ ... BCS NTBIG [ MUST BE <= 'Q'
7GJL ...TABWR GEOERR 1,PW-TABLE [ X6 = INVALID LETTER, X2 = SECURITY LEVEL
7GJN ...# X0 = CHAR ADDR, X7 = WORD ADDR IN TABLE
7GJQ ...NTBIG TXU 6 TLETF(1)
7GJS ... BCC XMESSH
7GJW ... TXU 6 TLETQ(1) [ 'Q' - NO CHECK FOR PARAM
7GJY ... BCC PWPROMPT
7GK2 ... NGNC 5 1
7GK4 ... TXL 6 TLETL(1) [ MUST NOT BE <= 'L'
7GK6 ... BCS TABWR
7GK8 ... LDX 2 FX2
7GK= ... SBX 6 TLETL(1) [ M N O P
7GK# ... DEX 6 AWORK4(2) [ -> 1 2 3 4
7GKB ...# NOW SEEK (AND CLEAR) PASSWORD PARAMETER
7GKD ... MHUNT 3,CLB
7GKG ... STO 3 AWORK1(2)
7GKJ ... LDX 7 ANUMCHA(3)
7GKL ... ADN 3 CLBFIR [ START OF COMMAND
7GKN ... STO 3 AWORK2(2)
7GKQ ... STOZ GEN6 [ NO. OF LAST PARAM SCANNED
7GKS ...PSKIP CALL 5 SKPAR [ IGNORE COMPULSORY INITIAL PARAMS
7GKW ... BZE 7 NPW
7GKY ... TXL 6 GEN5
7GL2 ... BCS PSKIP
7GL4 ...PWSCH CALL 5 SKPAR
7GL6 ... LDN 1 PWSTL(1) [ CHECK LONG KEY FIRST
7GL8 ... CALL 5 TPWS
7GL= ... LDN 1 PWSTS(1)
7GL# ... CALL 5 TPWS
7GLB ... BNZ 7 PWSCH
7GLD ...# NO PASSWORD PARAMETER
7GLG ...NPW MHUNTW 3,FILE,ADICTENT [ FOR FREECORE
7GLJ ... LDN 0 2
7GLL ... ANDX 0 AWORK4(2)
7GLN ... BNZ 0 PWOK [ WASN'T NEEDED
7GLQ ...PWPROMPT [ TRY AND GET FROM MOP IF POSS
7GLS ... JBC XMESSH,FX2,CXTMOP
7GLW ... ACROSS ADDJOB,3 [ NORMAL PW CHECK & EXIT
7GLY ...)
7GQ= [
7H9W [ ERROR/BREAK-IN ROUTINES
7HPG [
7J96 [
7JNQ [
7K8B [ ERROR MESSAGES AND TIDY UP ROUTINES..........
7KN2 [
7L7L [
7LM= [ ADDITIONAL VALUES OF AWORK2 FOR ERRORS
7M6W [ -3 DC ENDING IN NO USER CONTEXT
7MLG [ -4 BREAKIN ON JB,RJ AT DEWELLMENT
7MW# [ -5 PERMANENT BACK WELL ABANDON
7N66 [
7NKQ [
7P5B [
7PK2 TIDY3
7Q4L XBRK
7QJ= TIDY2 SETNCORE 3,3,FILE,ADICT
7R3W CALL 7 X4USER
7RHG LDX 0 4
7S36 LDN 1 A1(3)
7SGQ MOVE 0 3 [MOVE USERNAME FROM CPAT
7T2B DICTJOB 2 [DECREMENT USER'S JOBS COUNT
7TG2 TIDY1
7XM8 LDX 7 AWORK2(2)
7XTW ADN 7 3
7Y4J BZE 7 SDC [J IF SPECIAL DC
7Y?= SBN 7 2
7YFY BNZ 7 TNLN [J IF NOT LOGIN
7YNL SDC
7YXB SUBJOB
7YY# [
7Y^= [ THE MACRO IPBINOPID TAKES CARE OF CASE WHEN
7^28 [ AUTO-ANSWER TERMINAL GOES INOPERABLE.
7^44 [
7^#G [
7^*D XIPBINOP
7^F8 IPBINOPID
7^G6 BRN TIDY0
7^JY [
7^WL TNLN SUBJOBJ
82TW [
83*G TIDY0 LDX 7 AWORK2(2) [ FOR DEWELL ERRORS
83T6 BZE 5 XBR1 [ J IF BREAKIN CASE
84#Q BPZ 5 TERR [ J IF ERROR MESSAGE
84SB LDXC 5 5 [ SEE IF ERROR MESS ALREADY DONE
85#2 BZE 5 XENDCOM
85RL ACROSS CONNECT,2 [ DC WITH EXISTING JOBNAME
86?= TERR
86QW ADN 7 4 [ ARE WE IN DC CASE
87=G BZE 7 XSU [ SUICIDE IF DEWELLMENT
87BC BXE 5 XONE(1),UP
87G# ERRORX 5,6
87Q6 UP
889Q XENDCOM
88PB ENDCOM
8992 XSU
89NL SUICIDE
8=8= XCOM
8=MW COMBRKIN
8?7G [
8?M6 [
8#6Q XBR1 ADN 7 4
8#LB BZE 7 XSU
8*62 BCT 7 XCOM
8*KL MONOUT EDCBRKIN [ DC TYPE BREAKIN
8B5= ABANDCOM [ ABANDONED
8BJW OBREAKIN
8C4G GEOERR 1,BREAKJOB [BREAK-IN FOUND ILLEGALLY
8CJ6 [
8D3Q [
8DHB MCUNI NGNC 4 1 [ 'EXITS' TO TIDY1
8F32 MCUNI1 ['EXITS' TO TIDY2
8FGL LDN 4 0
8FK9 ...#UNS G400
8FMS ...(
8FQC ... HUNTW 3,IUSER,G400USER
8FT2 ... BPZ 3 X8HOOK
8FXK ...)
8G2= LDX 0 CONTEXT(2)
8GFW ANDN 0 1
8G^G BNZ 0 MC1 [J IF USER CONTEXT
8H6N ...#UNS G400
8H?W ...X8HOOK
8HF6 CALL 7 XSPCOL
8HYQ BRN NMK
8JDB MC1 SETNCORE SIZEU,3,CPB,CUNI
8JY2 LDN 0 12
8KCL STO 0 ANUM(3)
8KX= STO 4 ACOMMUNE1(2)
8LBW CALL 7 X4USER
8LWG LDX 0 5
8MB6 LDN 5 APARA(3)
8MTQ MOVE 4 3
8N*B LDX 4 ACOMMUNE1(2)
8NT2 LDX 5 0
8P#L NMK BZE 4 TIDY2
8PS= BRN TIDY1
8Q?W XTA LDX 4 JPARNUM(3)
8QRG XTB SBX 7 FX1
8R?6 SPARANOX 4 [GET PARAMETER FOR ERRORX
8RQQ ADX 7 FX1
8S=B XTC LDN 4 TIDY0-TIDY3
8SQ2 XTC1 NGN 6 1 [INDICATES NO SUBSIDUARY MESSAGE
8T9L XTD SMO 7
8TP= LDX 5 0 [LOAD APPROPRIATE ERROR UNIVERSAL
8W8W SMO 4
8WNG BRN TIDY3 [J TO APPROPRIATE ENTRY IN TIDY...
8X86 [ [...ROUTINE.
8XMQ XTE LDN 4 TIDY2-TIDY3
8Y7B BRN XTC1
8YM2 XTF LDN 4 MCUNI-TIDY3
8^6L BRN XTC1
8^L= XTG LDN 4 MCUNI1-TIDY3
925W BRN XTC1
92KG XTH LDN 4 0
9356 BRN XTC1
93JQ NJOBN LDX 6 PJJOBNA(1)
944B BRN PMISS
94J2 PARILL
953L CALL 7 XTB
95H= +APFERR
962W XNOUGHT
96GG CALL 7 XTC
9726 +JXCONSOLE
97FQ MODILL
97^B CALL 7 XTB
98F2 +ADOCER
98YL NLFN CALL 7 XTC
99D= +JNLFNF
99XW SPACERR
9=CG CALL 7 XTA
9=X6 +JOBIN
9?BQ NUSEN LDX 6 PJUSNA(1)
9?WB PMISS LDN 4 TIDY0-TIDY3
9#B2 CALL 7 XTD
9#TL +JPARMIS
9**= XNOUSE
9*SW CALL 7 XTF
9B#G +ERNOUSER
9BS6 UNJOB CALL 7 XTF
9C?Q +ERUNJOB
9CRB XENUF CALL 7 XTF
9D?2 +ERNOTENUF
9DQL XERPRIV
9F== CALL 7 XTG
9FPW +ANOPRIV
9FTR ...[ SKIP NEXT BIT IF G3 UG SEC I/FACE IS ON
9F^N ...#SKI G3UGSI<1$1
9G5K ...(
9G9G MESSH CALL 7 XTG
9GP6 +HSECURE
9H8Q MESSI CALL 7 XTG
9HNB +IMPASSE
9HQK ...)
9HSS ...#SKI G3UGSI [USER GROUP SECURITY INTERFACE
9HX3 ...(
9H^= ...XENOR CALL 7 XTG
9J3F ... #40000000
9J5N ...)
9J82 XBROKIN
9JML LDN 5 0
9K7= BRN TIDY2
9KLW SPACERR2
9L6G CALL 7 XTC [ SPACES IN JDF NAME
9LL6 +JDFINVAL
9M5Q #END
^^^^ ...25374543000700000000