Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/setln.mac
There are no other files named setln.mac in the archive.
;<SUDS.DRAW>SETLN.MAC.44, 2-Apr-80 10:34:39, EDIT BY HELLIWELL
TITLE SETLN - SETUP STANDARD LOGICAL NAMES
IFNDEF T10SW,<T10SW==0>
IFN T10SW,<
STRT: EXIT
END STRT
>;IFN T10SW
IFE T10SW,<
SEARCH MONSYM,MACSYM
.REQUIRE SYS:MACREL
EXT <JSMSG0,.JBFF,.JBREL,.JBSA>
VGROUP==1
VMAJOR==3
VMINOR==0
VEDIT==14
DEFINE DATE<ASCIZ \10-March-80\>
A=1
B=2
C=3
D=4
;16 IS USED BY MACSYM
P=17
GETPAG==677 ;USE PAGE JUST BEFORE PA1050
GETADR==GETPAG_9
MAXJFN==^D20 ;MAX 20 NESTED TAKES
MAXCHR==^D300
MAXLEN==<MAXCHR+5>/5
ABCHR==^D200
ABLEN==<ABCHR+5>/5
PDLLEN==20
DEFINE JCERR(TEXT)<
ERCAL [ JSERR<TEXT>
ret]>
DEFINE JRERR(TEXT)<
ERJMP [ JSERR<TEXT>
RET]>
DEFINE JSERR(TEXT)<
CALL ERRDO
IFB<TEXT><HRROI A,[0]>
IFNB<TEXT><HRROI A,[ASCIZ \TEXT: \]>
ESOUT
CALL JSMSG0
>
DEFINE FMSG(TEXT,FJFN)<
IFB<FJFN><HRRZ A,OJFN>
IFNB<FJFN><HRRZ A,FJFN>
HRROI B,[ASCIZ \TEXT\]
SETZ C,
SOUT
>
DEFINE FCHR(CHR,FJFN)<
IFB<FJFN><HRRZ A,OJFN>
IFNB<FJFN><HRRZ A,FJFN>
MOVEI B,CHR
BOUT
>
SUBTTL IN CORE STRUCTURE DEFINITIONS
;INDEXES INTO CORE BLOCKS
$KEY==0 ;KEY CODE INDICATING BLOCK TYPE (0 IS END BLOCK)
$NXT==1 ;LINK TO NEXT BLOCK
$VAL==2 ;LINK TO VALUE STRING, THIS BLOCK
$LOG==3 ;START OF LOGICAL NAME STRING (ASCIZ)
;LOGICAL NAME DEFINITION FOLLOWS LOGICAL NAME STRING (ALSO ASCIZ)
;KEY CODES IN $KEY WORD
%END==0 ;END OF LIST (MUST BE 0)
%STD==1 ;STANDARD LOGICAL NAME
%RDF==2 ;REDEFINE LOGICAL NAME
%DEL==3 ;DELETED ENTRY
%LGN==4 ;LOGIN LOGICAL NAME
SUBTTL MACROS
;LOAD A BLOCK WITH DATA AND ALLOCATE ENOUGH SPACE
;FOR LARGEST WORD
DEFINE LDBLK(LIST)<
..LEN==0
IRP LIST,<LDWRD(LIST)>
RELOC .+..LEN
>
;LOAD 1 WORD CHECK MAX LENGTH
DEFINE LDWRD(A)<.LDWRD(A)>
;USED TO STRIP OFF <>
DEFINE .LDWRD(A,B)<
RELOC .+A
IFB<B>,<0;>B
RELOC .-A-1
IFGE A-..LEN,<..LEN==A+1>
>
;KEYWORD TABLE MACROS
DEFINE TABLE<
...BEG==.
BLOCK 1
>
DEFINE TEND<
...LEN==.-...BEG
.ORG ...BEG
...LEN-1,,...LEN
.ORG .+...LEN
>
DEFINE T(TEXT,VALUE)< [ASCIZ \TEXT\],,VALUE>
;LOAD A FUNCTION DESCRIPTOR BLOCK
;USE FLDDB. MACRO FROM MONSYM. ARGS AS FOLLOWS:
;FLDDB.(TYP,FLGS,DATA,HLPM,DEFM,LST)
;TYP COMND FUNCTION CODE (I.E. .CMKEY)
;FLGS FLAGS (I.E. CM%SDH, SUPPRESS DEFAULT HELP)
;DATA ARG TO SPECIFIC FUNCTION (I.E. RADIX FOR .CMNUM)
;HLPM USER SUPPLIED HELP STRING (AUTOMATICALLY SETS CM%HPP)
;DEFM DEFAULT STRING (AUTOMATICALLY SETS CM%DPP)
;LST POINTER TO NEXT FUNCTION DESCRIPTOR BLOCK
;LOAD A NOISE FUNCTION DESCRIPTOR BLOCK
DEFINE NOISE(TEXT)<FLDDB.(.CMNOI,,<-1,,[ASCIZ \TEXT\]>)>
;DEFINE SINGLE DATA WORD (OR WORDS)
DEFINE DATA(ADDR,SIZE)<
ADDR: IFB<SIZE>,<BLOCK 1;>BLOCK SIZE
>
DEFINE CONFIRM(ERROR)<
CALL DOCFM
IFB<ERROR>< JRST COMERR>
IFNB<ERROR>< JRST ERROR>
>
DEFINE NIY<
TMSG <
?Not implemented yet.
>
JRST COMLOP
>
DEFINE COMINI(TEXT)<
IFNB<TEXT><HRROI A,[ASCIZ \TEXT\]>
IFB<TEXT><HRROI A,CMBUF>
CALL DOINI
>
DEFINE FIELD(FDB,ERROR)<
MOVEI B,FDB
CALL DOCOM
IFB<ERROR>< JRST COMERR>
IFNB<ERROR>< JRST ERROR>
>
DEFINE RFIELD(FDB)<
MOVEI B,FDB
MOVEI A,CMSTAT
COMND
ERJMP ERSCAN
TXNE A,CM%NOP
JRST ERSCAN
>
DEFINE GETSTR(FIELD)<
HRROI A,TMPSTR
MOVE B,IJFN
MOVE C,[FLD(1,JS%'FIELD)]
JFNS
ERMSG <JFNS FAILURE>
>
SUBTTL DATA AREA
EV: JRST STRT
JRST STRT
JOBVER: BYTE (3)VGROUP(9)VMAJOR(6)VMINOR(18)VEDIT
EVL==.-EV
PDL: BLOCK PDLLEN
CMSTAT: LDBLK(<<.CMFLG,REPARS>,<.CMIOJ,<.PRIIN,,.PRIOU>>,<.CMBFP,<-1,,CMBUF>>,<.CMPTR,<-1,,CMBUF>>,<.CMCNT,MAXCHR>,<.CMINC,0>,<.CMABP,<POINT 7,ABBUF>>,<.CMABC,ABCHR>,<.CMGJB,CMGJFN>>)
CMGJFN: BLOCK 16
CMBUF: BLOCK MAXLEN
ABBUF: BLOCK ABLEN
INIBLK: FLDDB.(.CMINI)
SETLN: FLDDB.(.CMKEY,,RESKEY)
RESKEY: TABLE
T SETLN,0
TEND
COMAND: FLDDB.(.CMKEY,,COMKEY)
COMKEY: TABLE
T CLEAR,DOFLSH
T DEFINE,DODEF
T EXIT,LEAVE
T FIND,FIND
T HELP,PNTHLP
T INITIALIZE,DOCLR
T LIST,DOLST
T LOGIN,LGNDEF
T QUIT,DOQUIT
T REDEFINE,DORDEF
T RESET,DORSET
T RUN-ON-EXIT,DORUN
T SET,DOSET
T TAKE,DOTAKE
TEND
LOGNAM: FLDDB.(.CMDEV,CM%SDH!CM%PO,,<Logical name>)
COMTXT: FLDDB.(.CMTXT,CM%SDH,,<Text of logical name>)
LGNNOI: NOISE(<Directory is>)
PRGNOI: NOISE(<Program>)
PRGFIL: FLDDB.(.CMFIL,CM%PO)
PRGBLK: LDBLK(<<.GJGEN,GJ%OFG!GJ%FLG>,<.GJEXT,<-1,,[ASCIZ /EXE/]>>,<.GJNAM,<-1,,[ASCIZ /SETLN/]>>>)
PRGLEN==.-PRGBLK
GETBLK: LDBLK(<<.GJGEN,GJ%OLD>,<1,<.NULIO,,.NULIO>>,<.GJEXT,<-1,,[ASCIZ /EXE/]>>,<.GJNAM,<-1,,[ASCIZ /SETLN/]>>,<15,0>>)
ARGNOI: NOISE(<With EXEC command line>)
ARGTXT: FLDDB.(.CMTXT)
HLPFIL: FLDDB.(.CMFIL,CM%DPP,,,<TTY:>)
HLPBLK: LDBLK(<<.GJGEN,GJ%FOU>,<.GJEXT,<-1,,[ASCIZ /HLP/]>>,<.GJNAM,<-1,,[ASCIZ /SETLN/]>>>)
HLPLEN==.-HLPBLK
TAKFIL: FLDDB.(.CMFIL,,,,,COMCFM)
TAKBLK: LDBLK(<<.GJGEN,GJ%OLD>,<.GJEXT,<-1,,[ASCIZ /CMD/]>>,<.GJNAM,<-1,,[ASCIZ /SETLN/]>>>)
TAKLEN==.-TAKBLK
COMCFM: FLDDB.(.CMCFM)
;SAMPLES OF OTHER BLOCKS
;NOISE: NOISE(<NOISE WORDS>)
;IFILE: FLDDB.(.CMIFI)
;OFILE: FLDDB.(.CMOFI)
;ARBFIL:FLDDB.(.CMFIL)
;FILBLK: LDBLK(<<.GJGEN,GJ%OLD>,<.GJEXT,<-1,,[ASCIZ /EXT/]>>,<.GJNAM,<-1,,[ASCIZ /NAME/]>>>)
;FILLEN==.-FILBLK
DATA REPPDL
DATA REPPC
DATA SYSCOM
DATA CMJFNS
DATA CMJFNP
DATA JFNSTK,MAXJFN
DATA OJFN
DATA LAST
DATA TMP
DATA TPROG,^D40
DATA PROG,^D40
DATA TARG,<ABLEN+1>
DATA ARG,ABLEN
DATA FNDLNI
DATA FNDLNT
DATA FNDPTR
DATA FNDPT1
DATA RDFFLG
SAVFF: 0
FILINI: PUSH P,A
SETZM CMGJFN
MOVE A,[CMGJFN,,CMGJFN+1]
BLT A,CMGJFN+15
POP P,A
HRRZ B,A
HRRI A,CMGJFN
BLT A,CMGJFN-1(B)
RET
SUBTTL STARTUP
STRT: RESET
MOVE P,[IOWD PDLLEN,PDL]
SKIPE SAVFF
JRST STRT1
MOVE A,.JBFF
MOVEM A,SAVFF
CALL %DOCLR
STRT1: MOVE A,[-MAXJFN,,JFNSTK-1]
MOVEM A,CMJFNP
SETOM SYSCOM
SETZM CMJFNS
SETZM OJFN
SETZ A,
RSCAN
ERJMP ERSCAN
JUMPE A,ERSCAN
COMINI()
RFIELD(SETLN) ;MUST START WITH PROGRAM NAME, OR NO ERRORS
MOVEI B,COMCFM
MOVEI A,CMSTAT
COMND
ERJMP REPAR1
TXNE A,CM%NOP
JRST REPAR1
;PROGRAM NAME<CR>, MAKE IT LOOK LIKE "R PROGRAM".
ERSCAN: SETZM SYSCOM
MOVEI A,.PRIOU
CALL VERPNT
TMSG <Type "HELP" for help.
>
COMLOP: MOVE P,[IOWD PDLLEN,PDL]
CALL CLEAN
SKIPE CMJFNS ;DON'T EXIT DURING TAKE
JRST COMLP1
SKIPE SYSCOM
JRST LEAVE1
SETZM SYSCOM
COMLP1: HRROI A,[BYTE (7) "S","E","T","L","N",76]
CALL DOINI
CALL CLEAN
REPAR1:
;SETUP COMMAND DEFAULTS
FIELD(COMAND,CMEOFC)
HRRZ B,(B)
JRST (B)
COMDON: HRRZ A,OJFN
JUMPE A,COMLOP
CLOSF
JCERR <Failed to close output file>
SETZM OJFN
JRST COMLOP
REPARS: MOVE P,REPPDL
MOVE A,REPPC
MOVEM A,(P)
RET
DOINI: MOVEM A,CMSTAT+.CMRTY
MOVE A,(P)
MOVEM A,REPPC
MOVEM P,REPPDL
SKIPN A,CMJFNS
MOVE A,[.PRIIN,,.PRIOU]
MOVEM A,CMSTAT+.CMIOJ
MOVEI A,CMSTAT
MOVEI B,INIBLK
COMND
ERJMP FATAL
TXNN A,CM%NOP
RET
FATAL: JSHLT
CMEOFC: SKIPN CMJFNS
JRST COMERR
MOVEI A,.FHSLF
GETER
ERJMP COMERR
HRRZ B,B
CAIE B,IOX4
JRST COMERR
TMSG <%End of >
MOVEI A,.PRIOU
HLRZ B,CMJFNS
SETZ C,
JFNS
JCERR<>
TMSG <
>
CALL TAKFIN
JRST COMLOP
DOCFM: MOVEI B,COMCFM
DOCOM: MOVEI A,CMSTAT
COMND
ERJMP R
TXNE A,CM%NOP
RET
RETSKP
COMERR: CALL ERRET
JRST COMLOP
ERRET: JSERR <Command error>
RET
ERRDO: SKIPN CMJFNS
RET
TMSG <%Error reading >
MOVEI A,.PRIOU
HLRZ B,CMJFNS
SETZ C,
JFNS
JCERR<>
TMSG <, command file input terminated.
>
CALL TAKFIN
JRST ERRDO
TAKFIN: HLRZ A,CMJFNS
MOVE B,CMJFNP
POP B,CMJFNS
MOVEM B,CMJFNP
CLOSF
JCERR <Error closing command file>
RET
CLEAN: MOVX A,CZ%ABT
HRR A,OJFN
TRNE A,-1
CLOSF
JFCL
SETZM OJFN
HRROI A,[0]
RSCAN
ERJMP .+1
MOVX A,CZ%NCL!FLD(.FHSLF,CZ%PRH)
CLZFF
JCERR <Failed to release unopened JFNs>
RET
VERPNT: HRROI B,[ASCIZ /SETLN version /]
SETZ C,
SOUT
LDB B,[POINT 9,JOBVER,11] ;MAJOR
MOVEI C,10
NOUT
JCERR
LDB B,[POINT 6,JOBVER,17] ;MINOR
JUMPE B,NOMINR
SUBI B,1
IDIVI B,^D26
JUMPE B,NOMINF
MOVEI B,"A"-1(B)
BOUT
NOMINF: MOVEI B,"A"(C)
BOUT
NOMINR: HRRZ C,JOBVER ;EDIT
JUMPE C,NOEDIT
MOVEI B,"("
BOUT
MOVE B,C
MOVEI C,10
NOUT
JCERR
MOVEI B,")"
BOUT
NOEDIT: LDB C,[POINT 3,JOBVER,2]
JUMPE C,NOGRP
MOVEI B,"-"
BOUT
MOVE B,C
MOVEI C,10
NOUT
JCERR
NOGRP: HRROI B,[ASCIZ /, /]
SETZ C,
SOUT
HRROI B,[DATE]
SOUT
HRROI B,[ASCIZ /
/]
SOUT
RET
SUBTTL EXIT AND QUIT COMMANDS
LEAVE: CONFIRM
LEAVE1: SETZM SYSCOM
SKIPN PROG
JRST DOEXIT
MOVEI A,GETBLK
HRROI B,PROG
GTJFN
ERJMP [TMSG <%>
TMSG <RUN-ON-EXIT ">
HRROI A,PROG
PSOUT
TMSG <" not found: >
CALL JSMSG0
JRST DOEXIT]
MOVE B,[GBEG,,GETADR]
BLT B,GETADR+GLEN-1
MOVEM A,GJFN
DVCHR
JCERR <DVCHR failed on RUN-ON-EXIT JFN>
HLRZ A,A
CAIN A,.DVDES+.DVNUL
JRST [ MOVE A,GJFN ;IF DEVICE IS NUL:, EXIT QUIETLY
RLJFN
JFCL
JRST DOEXIT]
SKIPN ARG
JRST GETCOD
HRROI A,TARG
HRROI B,ARG
SETZ C,
SOUT
MOVEI B,12
BOUT
MOVEI B,0
BOUT
HRROI A,TARG
RSCAN
ERJMP [JSERR <RSCAN failed>
JRST DOEXIT]
JRST GETCOD
GBEG:
PHASE GETADR
GJFN: 0
GSTK: 0
PMARGS: PM%CNT+GETPAG
GETCOD: MOVEI P,GSTK-1
SETO 1,
MOVSI 2,.FHSLF
MOVE 3,PMARGS
PMAP
ERCAL GERR
MOVSI A,.FHSLF
HRR A,GJFN
GET
ERCAL GERR
MOVEI A,.FHSLF
SETZ B,
SFRKV
ERCAL GERR
HALTF
GSTR: ASCIZ /Error getting next program: /
GERR: HRROI A,GSTR
ESOUT
MOVEI A,.PRIOU
HRLOI B,.FHSLF
SETZ C,
ERSTR
JFCL
JFCL
HALTF
DEPHASE
GLEN==.-GBEG
DOQUIT: CONFIRM
DOEXIT: HALTF
JRST COMLOP
SUBTTL HELP COMMAND
PNTHLP: MOVE A,[HLPBLK,,HLPLEN]
CALL FILINI
FIELD(HLPFIL)
MOVEM B,OJFN
CONFIRM
HRRZ A,OJFN
MOVX B,<FLD(7,OF%BSZ)!OF%WR>
OPENF
ERJMP [JSERR <OPENF failed for output file>
JRST COMLOP]
HRRZ A,OJFN
CALL VERPNT
HRRZ A,OJFN
HRROI B,HLPMES
SETZ C,
SOUT
JRST COMDON
HLPMES: ASCIZ \
This program is intended for use during login. It can define a large
number of logical names much faster than the EXEC can. The following
commands exist:
CLEAR
Delete all job wide logical names. This is normally done prior
to a SET to insure getting only the logical names defined in
this copy of SETLN.
DEFINE <logical name>: <definition>
Enter logical name and definition in internal list. If the
<definition> is null, any existing program definition
is deleted from the internal list.
EXIT
Exit to EXEC.
FIND <complete or initial substring of logical name>
Searches both JOB-WIDE and SYSTEM-WIDE logical names.
If the argument to the FIND command matches all or
and initial substring of any logical name definition,
that logical name and it's value are printed.
HELP
Print this list.
INITIALIZE
Remove all logical name definitions from internal list.
LOGIN (Directory is) <logical name>
This will define the specified <logical name> as your logged
in directory.
LIST
List all logical names currently in internal list.
REDEFINE <logical name>: <definition>
Same as DEFINE command with 1 exception. When executing the SET
command, no warning will be issued if this <logical name> already
has a JOB-WIDE definition.
RESET
This command is identical to saying:
CLEAR
SET
and is provided for shorthand purposes.
RUN-ON-EXIT (Program) <filespec> <command line>
The filespec is remembered exactly as typed. Upon an explicit
EXIT command or implicit exit (end of system command) an attempt
to run the specified program is made. The specified command line
is passed to the program via the rescan buffer. If the program
does not look at the rescan buffer, this information is lost.
As a special case, if the device name of the program is NUL:
then no run is attempted since this would always cause an error.
SET
Set all logical names from internal list. If any logical name
setup with the LOGIN or DEFINE commands already has a JOB-WIDE
definition, a warning message will be printed telling both the
old and new definitions.
TAKE <filespec>
Take commands from file. "TAKE" commands may be nested. When EOF
is reached, the message "%End of filespec." is printed. If you
Say "TAKE" with no filespec, input is terminated with no message.
In addition, the program may be given a command on the EXEC command line
as in:
SETLN command line
If "SETLN" is successfully parsed, the command will exit upon completion
of the command. If a TAKE is done, the program will not exit until all
take files are completed.
\
SUBTTL TAKE COMMAND
DOTAKE: MOVE A,[TAKBLK,,TAKLEN]
CALL FILINI
FIELD(TAKFIL)
HRRZ C,C
CAIN C,COMCFM
JRST DOTAK1
MOVE D,B
CONFIRM
MOVE A,CMJFNP
AOBJP A,[CALL ERRDO
TMSG <?Too many nested "TAKE" commands.
>
JRST COMLOP]
MOVE A,D
MOVX B,<FLD(7,OF%BSZ)!OF%RD>
OPENF
ERJMP [JSERR <Error opening command input file.
>
JRST COMLOP]
MOVE A,CMJFNP
PUSH A,CMJFNS
MOVEM A,CMJFNP
HRLI D,.NULIO
MOVSM D,CMJFNS
JRST COMLOP
DOTAK1: SKIPE CMJFNS
CALL TAKFIN
JRST COMLOP
SUBTTL RUN-ON-EXIT COMMAND
DORUN: FIELD(PRGNOI)
MOVE A,[PRGBLK,,PRGLEN]
CALL FILINI
FIELD(PRGFIL)
TXNE B,GJ%DEV!GJ%UNT!GJ%DIR!GJ%NAM!GJ%EXT!GJ%VER
JRST [ CALL ERRDO
HRROI A,[ASCIZ /Stars not allowed in RUN-ON-EXIT filespec.
/]
ESOUT
JRST COMLOP]
HRROI A,TPROG
HRROI B,ABBUF
SETZ C,
SOUT
FIELD(ARGNOI)
SETZM TARG
FIELD(ARGTXT)
HRROI A,TARG
HRROI B,ABBUF
SETZ C,
SOUT
CONFIRM
HRROI A,PROG
HRROI B,TPROG
SETZ C,
SOUT
SETZM ARG
HRROI A,ARG
HRROI B,TARG
SETZ C,
SOUT
JRST COMLOP
SUBTTL CLEAR COMMAND
DOFLSH: CONFIRM
CALL DOCJLN
JRST COMLOP
DOCJLN: MOVEI A,.CLNJA
CRLNM
JCERR <CRLNM error clearing all logical names>
RET
SUBTTL INITIALIZE COMMAND
DOCLR: CONFIRM
CALL %DOCLR
JRST COMLOP
%DOCLR: SETZM PROG
MOVE A,SAVFF
MOVEM A,LAST
SETZM $KEY(A)
ADDI A,$KEY
LSH A,-9
MOVEI B,1(A)
HRLI B,.FHSLF
MOVE C,.JBREL
LSH C,-9
SUB C,A
JUMPLE C,DOCLR1
TXO C,PM%CNT
SETO A,
PMAP
JCERR <PMAP to flush unused pages failed>
DOCLR1: MOVE A,LAST
ADDI A,$KEY
MOVEM A,.JBREL
ADDI A,1
MOVEM A,.JBFF
HRLM A,.JBSA
RET
SUBTTL LOGIN, DEFINE, REDEFINE COMMANDS
LGNDEF: SETZM RDFFLG
FIELD(LGNNOI)
FIELD(LOGNAM)
MOVE D,LAST
MOVEI A,%LGN
MOVEM A,$KEY(D) ;FLAG LOGIN TYPE
HRROI A,$LOG(D) ;POINT TO NAME AREA
HRROI B,ABBUF
SETZ C,
SOUT
IBP A
MOVEI A,1(A)
MOVEM A,$VAL(D) ;THIS IS WHERE NAME WILL GO
CONFIRM
HRRO A,$VAL(D)
HRROI B,[ASCIZ /<Will be set to login directory>/]
SETZ C,
SOUT
IBP A
MOVEI A,1(A)
MOVEM A,TMP
JRST DODEF1
DORDEF: SETOM RDFFLG
CAIA
DODEF: SETZM RDFFLG
FIELD(LOGNAM)
MOVE D,LAST
MOVEI A,%STD
MOVEM A,$KEY(D) ;FLAG STANDARD TYPE
HRROI A,$LOG(D) ;POINT TO NAME AREA
HRROI B,ABBUF
SETZ C,
SOUT
IBP A
MOVEI A,1(A)
MOVEM A,$VAL(D) ;THIS IS WHERE NAME WILL GO
FIELD(COMTXT)
HRRO A,$VAL(D)
HRROI B,ABBUF
SETZ C,
SETZM (A) ;IN CASE NULL NAME
SOUT
IBP A
MOVEI A,1(A)
MOVEM A,TMP
CONFIRM
DODEF1: MOVE A,TMP
MOVEM A,$NXT(D)
SETZM $KEY(A) ;MARK END BLOCK
MOVE C,LAST ;SAVE POINTER TO NEW BLOCK
MOVEM A,LAST
ADDI A,$KEY
CAMLE A,.JBREL
MOVEM A,.JBREL
ADDI A,1
MOVEM A,.JBFF
MOVE D,SAVFF ;GET POINTER TO LIST HEADER
DEFCHK: CAIN C,(D) ;END YET?
JRST DEFDON ;YES, NO MATCH FOUND
MOVE A,$KEY(D)
CAIN A,%DEL ;DELETED?
JRST DEFDEL ;YES
HRROI A,$LOG(C) ;GET NEW LOG NAME
HRROI B,$LOG(D) ;AND OLD
STCMP
JUMPE A,DEFNOK
DEFDEL: MOVE D,$NXT(D)
JRST DEFCHK
DEFDON: SKIPE @$VAL(C) ;NEW DEFINITION NULL?
JRST DEFDN1 ;NO, CHECK REDEFINE
SETZM $KEY(C) ;NULL DEF, MARK THIS END BLOCK (REMOVES)
ADDI C,$KEY
MOVEM C,LAST
ADDI C,1
MOVEM C,.JBFF
JRST COMLOP
DEFDN1: SKIPN RDFFLG ;REDEFINE COMMAND?
JRST COMLOP ;NO
MOVEI A,%RDF
MOVEM A,$KEY(C)
JRST COMLOP
DEFNOK: HRRO A,$VAL(C)
HRRO B,$VAL(D)
STCMP
JUMPE A,DEFFLU
TMSG <%Redefining program logical name ">
HRROI A,$LOG(D)
PSOUT
TMSG <:":
Old value: >
HRRO A,$VAL(D)
PSOUT
TMSG <
New value: >
HRRO A,$VAL(C)
PSOUT
TMSG <
>
DEFFLU: MOVEI A,%DEL
MOVEM A,$KEY(D)
JRST DEFDON
DOLST: CONFIRM
MOVE D,SAVFF
SKIPN $KEY(D) ;ANY NAMES?
JRST DOLST1
TMSG <Name Definition
>
SETZM TMP
DOLST2: SKIPN $KEY(D)
JRST DOLST5 ;END
MOVE A,$KEY(D)
CAIN A,%DEL ;DELETED?
JRST DOLST3 ;YES, SKIP IT
CAIE A,%RDF
JRST DOLST4
TMSG <*>
SETOM TMP
DOLST4: HRROI A,$LOG(D)
PSOUT
TMSG <: >
HRRO A,$VAL(D)
PSOUT
TMSG <
>
DOLST3: MOVE D,$NXT(D)
JRST DOLST2
DOLST5: SKIPN TMP
JRST COMLOP
TMSG <
* Indicates no checking when setting (REDEFINE command).
>
JRST COMLOP
DOLST1: TMSG <%No logical names defined yet.
>
JRST COMLOP
FIND: FIELD(COMTXT)
SETZM TARG
HRROI A,TARG
HRROI B,ABBUF
SETZ C,
SOUT
CONFIRM
SKIPN TARG
JRST [ TMSG <?Null name not allowed.
>
JRST COMDON]
MOVE A,[POINT 7,TARG]
CALL UPCASE
MOVE A,[.INLJB,,.LNSJB]
CALL FIND1
MOVE A,[.INLSY,,.LNSSY]
CALL FIND1
JRST COMDON
FIND1: HRRZM A,FNDLNT
HLLZS A,A
FNDLOP: MOVEM A,FNDLNI
HRRO B,.JBFF ;USE FREE SPACE
INLNM ;LOOKUP NAME
ERJMP [MOVEI A,.FHSLF
GETER
HRRZ B,B
CAIN B,INLNX1 ;NORMAL END?
RET ;YES
JSERR <INLNM failed>
RET]
IBP B
MOVEM B,FNDPTR ;SAVE POINTER PAST NAME
MOVE C,B
HRRO B,.JBFF
MOVE A,FNDLNT
LNMST
ERJMP [MOVEI A,.FHSLF
GETER
HRRZ B,B
CAIN B,LNSTX1
JRST FNDLP1
TMSG <%LNMST failure on ">
ESOUT
HRRO A,.JBFF
PSOUT
TMSG <": >
CALL JSMSG0
JRST FNDLP1]
MOVE A,FNDPTR
CALL UPCASE
MOVE B,FNDPTR
MOVEM B,FNDPT1
JRST FNDLP3
FNDLP2: ILDB A,FNDPT1
JUMPE A,FNDLP1 ;END, NO MATCH?
FNDLP3: MOVE B,FNDPT1
HRROI A,TARG
STCMP
JUMPE A,EXACT
TXNN A,SC%SUB ;PARTIAL MATCH BIT
JRST FNDLP2
PART: TMSG < Partial match on >
JRST EXACT1
EXACT: MOVE A,FNDPTR
CAME A,FNDPT1
JRST PART ;NOT BEGINNING, PARTIAL MATCH
TMSG < Exact match on >
EXACT1: HRROI A,[ASCIZ /SYSTEM/]
MOVE B,FNDLNT
CAIE B,.LNSSY
HRROI A,[ASCIZ /JOB/]
PSOUT
TMSG <-WIDE logical name:
>
HRRO A,.JBFF
PSOUT
TMSG <: =>
MOVEI A,76
PBOUT
TMSG < >
MOVE A,FNDPTR
PSOUT
TMSG <
>
FNDLP1: MOVE A,FNDLNI
AOJA A,FNDLOP
UPCASE: ILDB B,A
JUMPE B,R
CAIL B,"A"+40
CAILE B,"Z"+40
JRST UPCASE
SUBI B,40
DPB B,A
JRST UPCASE
SUBTTL SET COMMAND
DORSET: CONFIRM
CALL DOCJLN
JRST DOSETA
DOSET: CONFIRM
DOSETA: MOVE D,SAVFF
SKIPN $KEY(D) ;ANY NAMES?
JRST DOLST1
DOSET1: SKIPN $KEY(D)
JRST COMLOP
MOVE A,$VAL(D)
MOVEM A,TMP ;NORMAL VALUE STRING
MOVE A,$KEY(D)
CAIN A,%DEL
JRST DONSET ;DELETED ENTRY
CAIN A,%RDF ;REDEFINE?
JRST DEFNDF ;YES, BYPASS CHECK
CAIE A,%LGN ;LOGIN NAME?
JRST DOSET2
MOVNI A,1
HRROI B,C
MOVEI C,.JILNO
GETJI
ERJMP [JSERR <GETJI failed to get logged in directory number>
JRST DONSET]
HRRO A,.JBFF
HRRZM A,TMP
MOVE B,C
DIRST
ERJMP [JSERR <DIRST failed on logged in directory number>
JRST DONSET]
ADDI A,1
CAMLE A,.JBREL
MOVEM A,.JBREL
DOSET2: MOVEI A,.LNSJB
HRROI B,$LOG(D)
HRRO C,.JBFF
LNMST
ERJMP DEFNDF
MOVEI A,(C)
CAMLE A,.JBREL
MOVEM A,.JBREL
HRRO A,.JBFF
HRRO B,TMP
STCMP
JUMPE A,DONSET ;ALREADY SETUP CORRECTLY
TMSG <%Redefining JOB-WIDE logical name ">
HRROI A,$LOG(D)
PSOUT
TMSG <:":
Old value: >
HRRO A,.JBFF
PSOUT
TMSG <
New value: >
HRRO A,TMP
PSOUT
TMSG <
>
DEFNDF: MOVEI A,.CLNJB
HRROI B,$LOG(D)
HRRO C,TMP
CRLNM
ERJMP [JSERR <CRLNM error>
TMSG < Logical name = >
HRROI A,$LOG(D)
PSOUT
TMSG <
Definition = >
HRRO A,TMP
PSOUT
TMSG <
>
JRST DONSET]
DONSET: MOVE D,$NXT(D)
JRST DOSET1
END XWD EVL,EV
>;IFE T10SW