Trailing-Edge
-
PDP-10 Archives
-
bb-x130a-sb
-
path.mac
There are 5 other files named path.mac in the archive. Click here to see a list.
TITLE PATH -- Monitor level SETSRC commands plus enhancements
SUBTTL G.M. Uhler/GMU 23-Mar-83
;COPYRIGHT (C) 1978, 1979, 1980, 1981, 1982, 1983 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SEARCH JOBDAT,MACTEN,SCNMAC,UUOSYM
.DIRECTIVE .XTABM,FLBLST
SALL ; CLEAN UP LISTING
;
;Show versions of universal files
%%JOBD==%%JOBD
%%MACT==%%MACT
%%SCNM==%%SCNM
%%UUOS==%%UUOS
PTHVER==2 ; DEC VERSION
PTHMIN==0 ; DEC MINOR VERSION
PTHEDT==16 ; DEC EDIT NUMBER
PTHWHO==0 ; WHO LAST EDITED
TWOSEG
RELOC 400000
LOC .JBVER
VRSN. (PTH) ; VERSION NUMBER TO JOB DATA AREA
RELOC
SUBTTL Revision history
COMMENT `
[1] 26-Mar-79 The sequence .PATH<CR> .CONTINUE<CR> caused
I/O to unassigned channel. Make CONTINUE act
the same as REENTER.
[2] 12-May-79 Change the logical name code to know about the
new format for the logical name block.
[3] 29-May-79 If PATH gets an error return trying to do a /CLEAR,
it loops forever retrying the UUO. Give up with
an appropriate message if the /CLEAR fails
[4] 07-Aug-79 If /PHYSICAL is applied to any component in a
logical name definition, PATH will ignore any
existing logical name in performing the substitution
for the component.
[5] 21-Aug-79 In search list switches where the user types
a * with no modifiers (e.g., NOCREATE), keep
the existing modifier bits for each structure
represented by the *.
[6] 15-Nov-79 APLSTK was AOBJNing on the wrong AC sometimes
causing a loop. Correct the AC.
[7] 06-Dec-79 "pa/mod:dskb:write" (note the lower case) would
result in "?PTHUSM Unknown structure modifier 7RITE"
Call .SIXSW instead of .SIXSC.
[10] 18-Jun-80 Change the job search list before changing the
default path so the user can do both in the same
command if the SFDs in the path only exist on the
structure being added.
[11] 18-Jun-80 Change the processing of /SEARCH and /LIB to
reflect the new monitor algorithm.
[12] 09-Jul-80 Change the search list switch processing routines
to do the REMOVEs then the ADDs and finally the
MODIFYs. This allows commands of the form
.PATH/REM:DSKG/ADD:DSKG which causes DSKG to be
moved to the end of the current search list.
;Start version 2 here
[13] 30-Sep-81 Change the definition of logical names to allow
filenames and extensions to be specified. Also
implement /OVERRIDE and /COMMAND.
[14] 30-Sep-81 If the user specifies no path in a component for
a logical name, zero the PPN word of the
component in the logical name block and let the
monitor fill it in.
;Revision history continued
[15] 01-May-82 If the user defined a logical name with the
[,...] construct, type the logical name back
at him with [,] instead of filling in the
PPN.
[16] 22-Mar-83 Remove the /COMMAND function since that is now
provided by another program.
` ; End revision history
SUBTTL Symbol definitions
;AC definitions
;
F==0 ; FLAGS
T1==1 ; FIRST OF FOUR TEMPORARIES
T2==2
T3==3
T4==4
P1==5 ; FIRST OF FOUR PRESERVED REGISTERS
P2==6
P3==7
P4==10
N==P3 ; SCAN CONVENTION
C==P4 ; SCAN CONVENTION
P==17 ; PDL POINTER
;
;Miscellaneous definitions
;
ND .PDLEN,100 ; LENGTH OF PDL
ND DEBUG$,0 ; NO DEBUG FEATURES
TTY==1 ; TTY CHANNEL
;Flag bits in F
;
FL.ERR==1B0 ; FATAL ERROR ENCOUNTERED
FL.WRN==1B1 ; WARNING MESSAGE ISSUED
FL.TEL==1B2 ; INFORMATIVE MESSAGE ISSUED
FL.SDP==1B3 ; USER TYPED SOMETHING REQUIRING NEW DEFAULT PATH
FL.SAP==1B4 ; USER TYPED SOMETHING REQUIRING NEW ADDITIONAL PATH
FL.SLN==1B5 ; USER TYPED SOMETHING REQUIRING LOGICAL NAME
FL.JSL==1B6 ; USER TYPED SOMETHING REQUIRING NEW SEARCH LIST
FL.SSL==1B7 ; USER TYPED SOMETHING REQUIRING NEW SYSTEM SEARCH LIST
FL.CPT==1B8 ; USER WANTS TO CHANGE HIS DEFAULT PATH
FL.RDP==1B9 ; PTSDP CONTAINS CURRENT DEFAULT PATH
FL.RAP==1B10 ; PTSAP CONTAINS CURRENT ADDITIONAL PATH
FL.CLN==1B11 ; USER WANTS TO CHANGE A LOGICAL NAME
FL.GSO==1B12 ; USER TYPED GLOBAL SWITHES ONLY
FL.LSN==1B13 ; USER WANTS TO LIST A LOGICAL NAME
FL.FST==1B14 ; GENERAL FLAG USED TO INDICATE 1ST TIME SOMETHING HAPPENS
FL.TOF==1B15 ; TTY OPEN FAILED, USE OUTCHRS
FL.SLS==1B16 ; USER TYPED AT LEAST ONE SYS SEARCH LIST SWITCH
FL.JLS==1B17 ; USER TYPED AT LEAST ONE JOB SEARCH LIST SWITCH
FL.CSL==1B18 ; ALREADY COPIED CURRENT SEARCH LIST INTO NEW SL
;
;The following flags are stored in L.LIST by SCAN when it processes
;the /[NO]LIST switch. They are then moved to F for processing.
;
FL.LST==1B<^D36-<LSW.L+1>> ; LIST THINGS IN CONTEXT OF COMMAND (/L)
FL.LAL==1B<^D36-LSWALL> ; LIST EVERYTHING (/L:ALL)
FL.LLN==1B<^D36-LSWNAMES> ; LIST LOGICAL NAMES (/L:NAMES)
FL.LSS==1B<^D36-LSWSSL> ; LIST SYSTEM SEARCH LIST (/L:SSL)
FL.LJS==1B<^D36-LSWJSL> ; LIST JOB SEARCH LIST (/L:JSL)
FL.LPT==1B<^D36-LSWPATH> ; LIST PATH (/L:PATH)
FL.LCG==1B<^D36-LSWCHANGE> ; LIST THOSE THINGS THAT HAVE CHANGED (/L:CHANGE)
FL.LSW==FL.LLN!FL.LSS!FL.LJS!FL.LPT!FL.LCG ; ALL LIST FLAGS MINUS FL.LST AND FL.LAL
SUBTTL Macro definitions
;The following symbols define the error option selected by the third
;argument to the ERROR, WARN, and TELL macros.
;
EO.NUL==0 ; NO OPTION GIVEN
EO.STP==1 ; STOP PROGRAM ON THIS ERROR
EO.NCR==2 ; NO CRLF AT END OF THIS MESSAGE
EO.MAX==2 ; MAX NUMBER OF ERROR OPTIONS
;Macro to type a fatal error message. The arguments are:
;
; PRFX - Error prefix, e.g., the XXX in ?PTHXXX ...
; FIRST - The message to be typed
; OPTION - Error option; may be STOP, NOCRLF, or blank
; LABEL - Label to jump to after message is issued
;
DEFINE ERROR (PRFX,FIRST,OPTION,LABEL), <
ERRFLG==EO.NUL
IFIDN <OPTION>,<STOP>, <ERRFLG==EO.STP>
IFIDN <OPTION>,<NOCRLF>, <ERRFLG==EO.NCR>
PUSHJ P,.ERR
XLIST
F..'PRFX==.
IFNB <LABEL>, <CAIA ERRFLG,[XWD ''PRFX'',[ASCIZ\FIRST\]]
JRST LABEL
>
IFB <LABEL>, <CAI ERRFLG,[XWD ''PRFX'',[ASCIZ\FIRST\]]>
LIST
> ; End DEFINE ERROR
;Macro to type a warning message. The arguments are:
;
; PRFX - Error prefix, e.g., the XXX in %PTHXXX ...
; FIRST - The message to be typed
; OPTION - Error option; may be STOP, NOCRLF, or blank
; LABEL - Label to jump to after message is issued
;
DEFINE WARN (PRFX,FIRST,OPTION,LABEL), <
ERRFLG==EO.NUL
IFIDN <OPTION>,<STOP>, <ERRFLG==EO.STP>
IFIDN <OPTION>,<NOCRLF>, <ERRFLG==EO.NCR>
PUSHJ P,.WARN
XLIST
W..'PRFX==.
IFNB <LABEL>, <CAIA ERRFLG,[XWD ''PRFX'',[ASCIZ\FIRST\]]
JRST LABEL
>
IFB <LABEL>, <CAI ERRFLG,[XWD ''PRFX'',[ASCIZ\FIRST\]]>
LIST
> ; End DEFINE WARN
;Macro to type an informative message. The arguments are:
;
; PRFX - Error prefix, e.g., the XXX in [PTHXXX ...]
; FIRST - The message to be typed
; OPTION - Error option; may be STOP, NOCRLF, or blank
; LABEL - Label to jump to after message is issued
;
DEFINE TELL (PRFX,FIRST,OPTION,LABEL), <
ERRFLG==EO.NUL
IFIDN <OPTION>,<STOP>, <ERRFLG==EO.STP>
IFIDN <OPTION>,<NOCRLF>, <ERRFLG==EO.NCR>
PUSHJ P,.TELL
XLIST
T..'PRFX==.
IFNB <LABEL>, <CAIA ERRFLG,[XWD ''PRFX'',[ASCIZ\FIRST\]]
JRST LABEL
>
IFB <LABEL>, <CAI ERRFLG,[XWD ''PRFX'',[ASCIZ\FIRST\]]>
LIST
> ; End DEFINE TELL
;Macro to type debug information on entry to a subroutine. Debugging
;information is typed if one of the following conditions is met:
;
; 1. PATH is assembled with DEBUG$ non-zero to assemble
; the debugging package.
; 2. The location DEBALL is deposited non-zero. This will
; type debugging information for all subroutines.
; 3. If information about a particular routine in desired,
; leave DEBALL zero and change the SKIPE DEBALL before
; each call to .DEBUG to a JFCL.
;
;the arguments are as follows:
;
; $NAME - NAME of the routine
; $LIST - LIST of locations to type on entry
;
;If the switch DEBUG$ is zero, this macro assembles
;nothing.
DEFINE TRACE$ ($NAME,$LIST), <
IFN DEBUG$, < ;; ASSEMBLE ONLY IF DEBUG IS ON
SKIPE DEBALL ;; TYPE ONLY IF WANTED
XLIST
PUSHJ P,.DEBUG ;; CALL DEBUG ROUTINE
CAI [SIXBIT/$NAME/ ;; GENERATE ROUTINE NAME
IFNB <$LIST>, <
IRP $LIST, < ;; FOR ALL ELEMENTS OF $LIST
EXP $LIST ;; PLUS ADDRESS
> ;; END IRP $LIST
> ;; END IFNB $LIST
XWD -1,0] ; -1,,0 TERMINATES BLOCK
LIST
> ;; END IFN DEBUG$
> ;; END DEFINE TRACE$
;Macro to generate the storage words for those switches that are
;entirely processed by SCAN, i.e., those for which SCAN doesn't call us.
;Symbols generated are as follows:
;
; S.XXXX Non-file specific switch storage
; F.XXXX File specific switch storage that will be
; moved into the scan block
; P.XXXX Sticky default storage for file-specific
; switches. (parallel table to F.XXXX)
; $SWXXX Offset of the switch relative to the start
; of the specific switch block
; $FXXXX Offset in the scan block of file-specific
; switch storage and extra word storage
;
DEFINE SWTGEN ($SLIST,$FLIST,$XLIST), <
XLIST
SW.BGN==. ;; DEFINE START OF SWITCH AREA
;;
;; GENERATE STORAGE WORDS FOR EACH SWITCH
;;
S.BGN==. ;; DEFINE START OF NON-FILE SWITCH AREA
IRP $SLIST, <
$SW'$SLIST==.-S.BGN ;; DEFINE OFFSET OF SWITCH IN AREA
S.'$SLIST: BLOCK 1 ;; LOCATION CONTAINING VALUE OF SWITCH
> ; END IRP $SLIST
S.END==.-1 ;; DEFINE END OF NON-FILE SWITCH AREA
S.LEN==S.END-S.BGN+1 ;; DEFINE LENGTH OF NON-FILE SWITCH AREA
F.PTR==.FXLEN ;; LOCAL FILE SWITCH SCAN BLOCK AREA STARTS HERE
F.BGN==. ;; DEFINE START OF FILE SWITCH AREA
IRP $FLIST, <
$SW'$FLIST==.-F.BGN ;; DEFINE OFFSET OF SWITCH IN AREA
$FX'$FLIST==F.PTR ;; DEFINE OFFSET OF SWITCH IN SCAN BLOCK
F.PTR==F.PTR+1 ;; BUMP SCAN BLOCK POINTER
F.'$FLIST: BLOCK 1 ;; VALUE OF FILE SWITCH GOES HERE
> ; END IRP $FLIST
F.END==.-1 ;; DEFINE END OF FILE SWITCH AREA
F.LEN==F.END-F.BGN+1 ;; DEFINE LENGTH OF FILE SWITCH AREA
$FXLLS==F.PTR-1 ;; DEFINE OFFSET OF LAST SWITCH IN SCAN BLOCK
SW.END==.-1 ;; DEFINE END OF SWITCH AREA
SW.LEN==SW.END-SW.BGN+1 ;; DEFINE LENGTH OF SWITCH AREA
IRP $XLIST, <
$FX'$XLIST==F.PTR ;; DEFINE EXTRA WORDS IN SCAN BLOCK
F.PTR==F.PTR+1 ;; ADVANCE POINTER
> ; END IRP $XLIST
$FXLEN==F.PTR ;; DEFINE TOTAL LENGTH OF SCAN BLOCK
P.BGN==. ;; STICKY DEFAULT SWITCH AREA STARTS HERE
;;
;; GENERATE WORDS FOR STICKY DEFAULTS
;;
IRP $FLIST, <
P.'$FLIST: BLOCK 1 ;; VALUE OF STICKY DEFAULT GOES HERE
> ; END IRP $FLIST
P.END==.-1 ;; DEFINE END OF STICKY DEFAULT AREA
LIST
> ; END DEFINE SWTGEN
;In order to process the search list switches, we define two types of
;blocks. The first, defined below, is associated with each search list
;switch and gives parameters specific to each switch.
;
; !=======================================================!
; ! PJSP T1,?SLSWT ! $SLJSP
; !-------------------------------------------------------!
;XXXBLK:!Address of first word of block containing switch values! $SLSPT
; !-------------------------------------------------------!
; ! AOBJP pointer to next free slot for switch values ! $SLSAB
; !-------------------------------------------------------!
; ! Count of structures specified by this switch ! $SLSCT
; !=======================================================!
$SLJSP==-1 ; OFFSET TO PJSP T1,?SLSWT
$SLSPT==0 ; OFFSET TO ADDR OF SWITCH VALUE BLOCK
$SLSAB==1 ; OFFSET TO AOBJP POINTER TO NEXT FREE
; SLOT IN SWITCH VALUE BLOCK
$SLSCT==2 ; OFFSET OF COUNT OF STRS IN SWITCH VALUE
; BLOCK
$SLSLN==3 ; LENGTH OF POSITIVE OFFSET BLOCK
; (I.E., NOT INCLUDING $SLJSP)
;The following block gives information about the search list (either
;job or system) that is independent of the particular switch specified.
;
; !=======================================================!
; ! Count of structures in current search list ! $SLCCT
; !-------------------------------------------------------!
; ! Address of block containing current search list ! $SLCPT
; !-------------------------------------------------------!
; ! Count of structures in new search list ! $SLNCT
; !-------------------------------------------------------!
; ! Address of block containing new search list ! $SLNPT
; !-------------------------------------------------------!
; !AOBJP pointer to next available slot in new search list! $SLNAB
; !-------------------------------------------------------!
; ! Max number of structures allowed in this search list ! $SLMAX
; !=======================================================!
$SLCCT==0 ; COUNT OF STRS IN CURRENT SEARCH LIST
$SLCPT==1 ; ADDRESS OF CURRENT SEARCH LIST BLOCK
$SLNCT==2 ; COUNT OF STRS IN NEW SEARCH LIST
$SLNPT==3 ; ADDRESS OF FIRST STR IN NEW SEARCH LIST BLOCK
$SLNAB==4 ; AOBJP POINTER TO NEXT FREE SLOT IN NEW
; SEARCH LIST
$SLMAX==5 ; MAX STRS ALLOWED IN THIS SEARCH LIST
$SLXLN==6 ; LENGTH OF THE BLOCK
SL.WLD==1B35 ; FLAG SET IN .DFJST WORD OF A SEARCH LIST BLOCK
; TO INDICATE THAT THIS STR WAS ADDED TO THE
; NEW SEARCH LIST BY A * REFERENCE.
;Macro to relocate to the high segment if not already there.
DEFINE $HIGH, <
IFL <.-400000>, <
XLIST
LIT
RELOC
LIST
>
>
;Macro to relocate to the low segment if not already there.
DEFINE $LOW, <
IFGE <.-400000>, <
XLIST
LIT
RELOC
LIST
>
>
;Macro to store a constant in consecutive memory locations (The one in
;MACTEN doesn't work right for FIRST==LAST). Note that this macro has
;the restriction that it must be called only after the locations
;specified by FIRST and LAST are defined. If this restriction is not
;met, MACRO will generate phase errors since it doesn't know how many
;words to generate on pass 1.
;The arguments are:
;
; AC - AC to use
; FIRST - FIRST location into which to store
; LAST - Last location into which to store
; CONS - Constant to store
DEFINE STORE(AC,FIRST,LAST,CONS), <
IFB <LAST>,< LAST%%==FIRST> ;; IF NO LAST, ASSUME FIRST
IFNB <LAST>,<LAST%%==LAST> ;; OTHERWISE USE LAST
IFL <LAST%%-FIRST>,<
PRINTX % FINAL LOCATION .LT. STARTING LOCATION IN STORE MACRO
>
IFE <CONS>,< SETZM FIRST> ;;IF CONS=0, CLEAR FIRST
IFE <CONS>+1,<SETOM FIRST> ;;IF CONS=-1, SET FIRST TO -1
IFN <CONS>*<<CONS>+1>, <
MOVX AC,<CONS> ;;ELSE DO IT
MOVEM AC,FIRST ;; THE HARD WAY
>
XLIST
IFG <LAST%%-FIRST>,< ;;IF MORE THAN ONE LOCATION
MOVE AC,[FIRST,,FIRST+1]
BLT AC,LAST%% ;;DISTRIBUTE THE CONSTANT
>
LIST
>
SUBTTL Path switch definitions
;Define the prefixes for all search list switches.
DEFINE SLSWCH,<
XLIST
X CR,J ;; /CREATE
X RM,J ;; /REMOVE
X AD,J ;; /ADD
X MD,J ;; /MODIFY
X CR,S ;; /SCREATE
X RM,S ;; /SREMOVE
X AD,S ;; /SADD
X MD,S ;; /SMODIFY
LIST
> ; End DEFINE SLSWCH
;Define the default maxima for each switch
DEFINE X ($PREFX,$TYPE), <
DM '$PREFX'$TYPE',0,0,0 ;; MUST SPECIFY VALUE FOR SWITCH
>
SLSWCH ; GENERATE ALL DEFAULT MAXIMA
;Define the valid switches for SCAN
DEFINE SWTCHS, <
XLIST
SP ADD,0,ADJSWT,ADJ,FS.LRG!FS.NFS!FS.VRQ ; /ADD:LIST
SS CLEAR,S.CLEAR,1,FS.NFS ; /CLEAR
SP CREATE,0,CRJSWT,CRJ,FS.LRG!FS.NFS!FS.VRQ ; /CREATE:LIST
SL *LIST,L.LIST,LSW,FL.LST,FS.NFS!FS.OBV ;/LIST:OPTIONS
SP MODIFY,0,MDJSWT,MDJ,FS.LRG!FS.NFS!FS.VRQ ; /MODIFY:LIST
SN NEW,S.NEW,FS.NFS ; /[NO]NEW
SN OVERRIDE,F.OVERRIDE ; /[NO]OVERRIDE
SP REMOVE,0,RMJSWT,RMJ,FS.LRG!FS.NFS!FS.VRQ ; /REMOVE:LIST
SP SADD,0,ADSSWT,ADS,FS.LRG!FS.NFS!FS.VRQ ; /SADD:LIST
SN SCAN,S.SCAN,FS.NFS ; /[NO]SCAN
SP SCREATE,0,CRSSWT,CRS,FS.LRG!FS.NFS!FS.VRQ ; /SCREATE:LIST
SN SEARCH,F.SEARCH ; /[NO]SEARCH
SP SMODIFY,0,MDSSWT,MDS,FS.LRG!FS.NFS!FS.VRQ ; /SMODIFY:LIST
SP SREMOVE,0,RMSSWT,RMS,FS.LRG!FS.NFS!FS.VRQ ; /SREMOVE:LIST
SN SYS,S.SYS,FS.NFS ; /[NO]SYS
LIST
> ; End DEFINE SWTCHS
;Define the valid keys for the /LIST switch
KEYS LSW,<CHANGE,PATH,JSL,SSL,NAMES,ALL>
;Generate the scan tables for SCAN
DOSCAN (PTHSW) ; GENERATE THE SWITCH TABLES
SUBTTL High segment data locations
;.ISCAN block
.ISCBK: IOWD 1,[SIXBIT/PATH/] ; IOWD TO TABLE OF LEGAL MONITOR COMMANDS
XWD OFFSET,'PTH' ; STARTING OFFSET,,SIXBIT CCL NAME
.ISBL1==.-.ISCBK ; LENGTH IF TTY OPEN FAILS
XWD 0,W.TTY ; 0,,ADDRESS OF CHARACTER OUTPUT RTN
EXP 0 ; POINTER TO INDIRECT FILE BLOCK
XWD PROMPT,XITCLS ; ADDR OF PROMPT RTN,,ADDR OF EXIT RTN
.ISCBL==.-.ISCBK
;.TSCAN block
.TSCBK: IOWD PTHSWL,PTHSWN ; IOWD TO LEGAL SWITCH NAMES
XWD PTHSWD,PTHSWM ; DEFAULT SWITCH AREA,,PROCESSOR SWITCH TABLE
XWD 0,PTHSWP ; 0,,ADDR OF SWITCH POINTERS FOR STORING
EXP -1 ; LET HELPER PROVIDE THE HELP
XWD CLRALL,CLRFIL ; CLEAR ALL ANSWERS,,CLEAR FILE ANSWER
XWD ALCINP,ALCOUT ; ALLOCATE INPUT,,ALLOCATE OUTPUT
XWD MEMSTK,APLSTK ; MEMORIZE STICKY DEFAULTS,,APPLY STICKY DEFAULTS
XWD CLRSTK,FS.MIO ; CLEAR STICKY DEFAULTS,,ALLOW MIXED SWITCHES
.TSCBL==.-.TSCBK
;.OSCAN block
.OSCBK: IOWD PTHSWL,PTHSWN ; IOWD TO LEGAL SWITCH NAMES
XWD PTHSWD,PTHSWM ; DEFAULT SWITCH AREA,,PROCESSOR SWITCH TABLE
XWD 0,PTHSWP ; 0,,ADDR OF SWITCH POINTERS FOR STORING
.OSCBL==.-.OSCBK
;Table of break characters (Carriage return intentionally left out)
BRKTBL: 1_<.CHBEL>!1_<.CHLFD>!1_<.CHVTB>!1_<.CHFFD>!1_<.CHCNZ>!1_<.CHESC>
;The following tables give the legal modifiers for search list switches
;and the corresponding flag bits to use if that modifier is seen.
SLNTAB: SIXBIT/CREATE/
SIXBIT/WRITE/
SIXBIT/NOCREA/
SIXBIT/NOWRIT/
SLNTBL==.-SLNTAB
SLITAB: 0+(FS.MNC) ; /CREATE = CLEAR NO-CREATE BIT
0+(FS.MWL) ; /WRITE = CLEAR NO-WRITE BIT
FS.MNC+(FS.MNC) ; /NOCREATE = SET NO-CREATE BIT
FS.MWL+(FS.MWL) ; /NOWRITE = SET NO-WRITE BIT
;Generate one table for each type of search list (job and system)
;giving the address of the routine to process that switch and
;the address of the switch block.
;
DEFINE X ($PREFX,$TYPE), <
IFIDN <$TYPE>,<J>, <
XWD CHK'$PREFX'X,$PREFX'$TYPE'BLK
..ZZ==..ZZ+1
>
>
..ZZ==0
JSBLST: SLSWCH ; GENERATE ONE WORD FOR EACH JOB SWITCH
JSBPTR: XWD -..ZZ,JSBLST ; AND AOBJN POINTER TO THE TABLE
DEFINE X ($PREFX,$TYPE), <
IFIDN <$TYPE>,<S>, <
XWD CHK'$PREFX'X,$PREFX'$TYPE'BLK
..ZZ==..ZZ+1
>
>
..ZZ==0
SSBLST: SLSWCH ; GENERATE ONE WORD FOR EACH SYS SWITCH
SSBPTR: XWD -..ZZ,SSBLST ; AND AOBJN POINTER TO THE TABLE
SUBTTL Low segment data locations
$LOW
;From here to Z.END zeroed on every time through PTHSCN
Z.BGN==.
GTNSAV: BLOCK 1 ; SAVE AOBJP POINTER TO SWITCH LIST HERE
; WHILE DOING CURRENT SL
SCNIFS: BLOCK 1 ; POINTER TO FIRST INPUT SCAN BLOCK
SCNILS: BLOCK 1 ; POINTER TO LAST INPUT SCAN BLOCK
SCNOFS: BLOCK 1 ; POINTER TO FIRST OUTPUT SCAN BLOCK
SCNOLS: BLOCK 1 ; POINTER TO LAST OUTPUT SCAN BLOCK
L.LIST: BLOCK 1 ; LISTING SWITCH BITS
P.LIST: BLOCK 1 ; LISTING BITS FROM COMMAND LINE
JSLBLK: BLOCK $SLXLN ; JOB SEARCH LIST PARAMETER BLOCK
SSLBLK: BLOCK $SLXLN ; SYSTEM SEARCH LIST PARAMETER BLOCK
SSWCNT: BLOCK 1 ; TOTAL STRS IN ALL SSL SWITCHES
JSWCNT: BLOCK 1 ; TOTAL STRS IN ALL JSL SWITCHES
PTHPTR: BLOCK 1 ; ADDRESS OF SIXBIT NAME PATH BLOCK
LNMPTR: BLOCK 1 ; ADDRESS OF LOGICAL NAME SUBSTITUTION BLOCK
DSCBLK: BLOCK .DCSAJ+1 ; DSKCHR BLOCK
PTSDP: BLOCK .PTMAX ; DEFAULT PATH BLOCK
PTSAP: BLOCK .PTMAX ; ADDITIONAL PATH BLOCK
PTSLN: BLOCK .PTLLB ; LOGICAL NAME BLOCK
SLBLK: BLOCK .DFGST+1 ; GOBSTR AND JOBSTR BLOCKS GO HERE
; SWTGEN (<Non-file switch list>,<File switch list>,<Extra words list>)
SWTGEN (<CLEAR,NEW,SCAN,SYS>,<OVERRIDE,SEARCH>,<LNK>)
;Define the search list switch blocks
DEFINE X ($PREFX,$TYPE), <
$PREFX'$TYPE'SWT: BLOCK 1 ;; PJST T1,?SLSWT
$PREFX'$TYPE'BLK: BLOCK $SLSLN ;; THE BLOCK
>
SLSWCH ; GENERATE ALL SWITCH BLOCKS
Z.END==.-1 ; END OF AREA TO ZERO
OFFSET: BLOCK 1 ; ENTRY POINT OFFSET
MINCOR: BLOCK 1 ; INITIAL VALUE OF .JBFF
XSLMAX: BLOCK 1 ; MAX SSL STRS,,MAX JSL STRS
MYJOB: BLOCK 1 ; NUMBER OF OUR JOB
MYPATH: BLOCK .PTMAX ; OUR CURRENT PATH
PDL: BLOCK .PDLEN ; PDL
TOBUF: BLOCK .BFCTR+1 ; TTY OUTPUT BUFFER
$HIGH
SUBTTL Initialization
PATH: PORTAL .+2 ; ALLOW PROTECTED EXECUTION
PORTAL .+2 ; DITTO FOR CCL ENTRY
TDZA T1,T1 ; CLEAR CCL ENTRY FLAG AND SKIP
MOVEI T1,1 ; INDICATE CCL ENTRY
MOVEM T1,OFFSET ; STORE ENTRY POINT OFFSET FOR SCAN
RESET ; CLEAR THE WORLD
MOVE P,[IOWD .PDLEN,PDL] ; SETUP PDL
SETZM F ; CLEAR FLAGS
MOVEI T1,PATH ; GET REENTER ADDRESS
MOVEM T1,.JBREN ; AND SAVE IN JOB DATA REGION
MOVX T1,%LDMSS ; GETTAB TO RETURN MAX STRS IN SL'S
GETTAB T1, ; GET IT
MOVE T1,[^D36,,^D10] ; USE THE DEFAULT
MOVEM T1,XSLMAX ; SAVE FOR LATER
PJOB T1, ; GET OUR JOB NUMBER
MOVEM T1,MYJOB ; AND SAVE IT FOR LATER
MOVX T1,.IOASC!UU.PHS; GET PHYSICAL DEVICE IN ASCII MODE
MOVX T2,SIXBIT/TTY/ ; DEVICE IS A TTY
MOVX T3,<TOBUF,,0> ; OUTPUT BUFFER IS TOBUF
OPEN TTY,T1 ; OPEN THE TTY
TXOA F,FL.TOF ; FAILED, SET FLAG AND SKIP OUTBUF
OUTBUF TTY,1 ; USE ONE OUTPUT BUFFER
MOVE T1,.JBFF ; GET SMALLEST CORE VALUE
MOVEM T1,MINCOR ; AND SAVE FOR LATER
MOVSI T1,.ISCBL ; GET NORMAL LENGTH OF .ISCAN BLOCK
TXNE F,FL.TOF ; TTY OPEN FAIL?
MOVSI T1,.ISBL1 ; YES, USE SHORT BLOCK
HRRI T1,.ISCBK ; MAKE IT LEN,,ADDR
PUSHJ P,.ISCAN## ; INITIALIZE SCAN
SUBTTL Main scanner loop
;Here to processes each command. Call .TSCAN to crack the command
;string and .OSCAN to get the defaults from SWITCH.INI.
PTHSCN: MOVE P,[IOWD .PDLEN,PDL] ; INSURE PDL IS IN PHASE
ANDX F,FL.TOF ; CLEAR ALL BUT TTY OPEN FLAG
STORE T1,Z.BGN,Z.END,0 ; CLEAR ALL APPROPRIATE STORAGE
PUSHJ P,INISLB ; INITIALIZE SEARCH LIST SWITCH BLOCKS
MOVE T1,MINCOR ; GET INITIAL VALUE OF .JBFF
MOVEM T1,.JBFF ; RESTORE IT
CORE T1, ; CORE DOWN TO A MINIMUM
JFCL ; DON'T CARE
PUSHJ P,GETPTH ; GET OUR CURRENT PATH
MOVE T1,[XWD .TSCBL,.TSCBK] ; POINT TO .TSCAN BLOCK
PUSHJ P,.TSCAN## ; CRACK THE COMMAND LINE
TXZE F,FL.ERR!FL.WRN ; ANY ERRORS OR WARNINGS ON THAT COMMAND?
JRST PTHSCN ; YES, GIVE UP ON IT
MOVE T1,L.LIST ; GET COMMAND STRING LIST BITS
MOVEM T1,P.LIST ; SAVE FOR LATER
SETZM L.LIST ; CLEAR BITS FOR SWITCH.INI SETTINGS
MOVE T1,[XWD .OSCBL,.OSCBK] ; POINT TO .OSCAN BLOCK
PUSHJ P,.OSCAN## ; READ SWITCH.INI
SKIPN T1,P.LIST ; SKIP IF COMMAND STRING LIST SWITCH SPECIFIED
MOVE T1,L.LIST ; ELSE USE SWITCH.INI DEFAULTS
TXZE T1,FL.LAL ; CLEAR /L:A BIT AND SKIP IF NOT SET
TXO T1,FL.LSW ; SET ALL OTHER LIST BITS
ANDX T1,FL.LSW!FL.LST; ISOLATE JUST THE BITS
IORM T1,F ; AND STORE THEM IN THE FLAG WORD
;
;SCAN has the annoying habit of giving us a free input scan block even
;though no input specifications were seen when only global switches were
;typed. This type of scan block may be distinguished by a zero device
;word. To avoid problems later, clear the input scan block pointers if
;we get one of these scan blocks and set a flag telling what happened.
MOVE T1,SCNIFS ; GET ADDRESS OF INPUT SCAN BLOCKS
JUMPE T1,CHKOUT ; IF NONE, DON'T CHANGE LIST SCNILS
CAMN T1,SCNILS ; ONLY ONE OF THEM?
SKIPE .FXDEV(T1) ; AND SCAN GIVE US A FREE ONE?
JRST CHKOUT ; NO, CONTINUE WITH THE CHECKING
SETZM SCNIFS ; PRETEND LIKE NO INPUT BLOCKS
SETZM SCNILS ; ...
TXO F,FL.GSO ; SET "GLOBAL SWITCHES ONLY" BIT
SUBTTL Command validation and error checking
;Here when SCAN has finished cracking the command line. At this point,
;we know that the command is at least superficially syntactically
;correct. We must now rigorously check it for both syntactic and
;semantic correctness before we perform any required functions. First,
;the output scan blocks...
CHKOUT: SKIPN P1,SCNOFS ; LOGICAL NAME DEFINITION SPECIFIED?
JRST CHKINP ; NO, CHECK INPUT SCAN BLOCKS
MOVX T1,FX.NDV ; GET NULL DEVICE BIT
TDNE T1,.FXMOD(P1) ; MUST HAVE SPECIFIED A LOGICAL NAME
ERROR NLN,<Null logical name illegal>,,PTHSCN
SKIPE .FXNMM(P1) ; CAN'T HAVE A FILENAME
ERROR FLD,<Filename illegal in logical name definition>,,PTHSCN
SKIPE .FXEXT(P1) ; OR AN EXTENSION
ERROR ELD,<Extension illegal in logical name definition>,,PTHSCN
MOVX T1,FX.DIR ; GET "DIRECTORY-SPECIFIED" BIT
TDNN T1,.FXMOD(P1) ; CAN'T HAVE A DIRECTORY
TDNE T1,.FXMOM(P1) ; OR [-]
ERROR DLD,<Directory illegal in logical name definition>,,PTHSCN
TXO F,FL.SLN ; LIGHT "SET LOGICAL NAME" BIT
;Here when we have validated the output scan block. We must now do the
;same for all input scan blocks.
CHKINP: SKIPN P1,SCNIFS ; GET FIST POINTER TO INPUT SCAN BLOCKS
JRST CHKZLN ; NONE THERE, CHECK /CLEAR
CHKIN1: MOVE T1,P1 ; POINT TO BLOCK
MOVX T2,$FXLEN ; AND GET LENGTH
PUSHJ P,.OSDFS## ; LET SCAN APPLY THE SWITCH.INI DEFAULTS
PUSHJ P,MOVSTK ; NOW APPLY DEFAULTS FOR OUR SWITCHES
TXNN F,FL.SLN ; DEFINING LOGICAL NAME?
JRST CHKIN4 ; NO, GO CHECK OTHER STUFF
SKIPL $FXSEA(P1) ;USER SAY /[NO]SEARCH HERE?
ERROR SIC,<SEARCH attribute illegal in logical name component>,,PTHSCN
SKIPL $FXOVE(P1) ;USER SAY /[NO]OVERRIDE HERE?
ERROR OIC,<OVERRIDE attribute illegal in logical name component>,,PTHSCN
MOVX T1,FX.DIR ; GET "DIRECTORY SPECIFIED" BIT
TDNN T1,.FXMOM(P1) ; DID HE SPECIFY ONE?
JRST CHKIN3 ; NO, SETSLN WILL HANDLE SUBSTITUTIONS
PUSHJ P,CHKWLD ; CHECK FOR WILDCARD IN THE DIRECTORY
ERROR WLC,<Wildcards illegal in directory for logical name component>,,PTHSCN
MOVE T1,.FXDIR(P1) ; GET THE PPN WORD
TLNN T1,-1 ; USER SAY [,PN]?
HRROS .FXDIR(P1) ; YES, PUT -1 IN LH
TRNN T1,-1 ; USER SAY [PN,]?
HLLOS .FXDIR(P1) ; YES, PUT -1 IN RH
CHKIN3: HRRZ P1,$FXLNK(P1) ; ADVANCE TO NEXT SCAN BLOCK
JUMPN P1,CHKIN1 ; LOOP IF NOT AT END
JRST CHKZLN ; GO CHECK FOR /CLEAR
;Here when there are no output scan blocks. We now know that the user
;either typed a new default path or an existing logical name which he
;either wants to change or list.
CHKIN4: CAME P1,SCNILS ; CAN ONLY HAVE ONE SPEC (FOR NOW)
ERROR MLN,<Multiple logical names illegal>,,PTHSCN
MOVX T1,FX.NDV ; GET NULL DEVICE BIT
TDNE T1,.FXMOD(P1) ; IF NULL DEVICE, ASSUME NEW PATH
JRST CHKIN5
SKIPE .FXNMM(P1) ; CAN'T HAVE FILENAME HERE
ERROR FLN,<Filename illegal in logical name>,,PTHSCN
SKIPE .FXEXT(P1) ; OR AN EXTENSION
ERROR ELN,<Extension illegal in logical name>,,PTHSCN
MOVX T1,FX.DIR ; GET "DIRECTORY SPECIFIED" BIT
TDNN T1,.FXMOD(P1) ; CAN'T HAVE A DIRECTORY
TDNE T1,.FXMOM(P1) ; OR [-]
ERROR DLN,<Directory illegal in logical name>,,PTHSCN
SKIPGE $FXOVE(P1) ; OR /OVERRIDE STATUS?
SKIPL $FXSEA(P1) ; USER WANT TO CHANGE SEARCH STATUS?
TXOA F,FL.CLN ; YES, SET THE BIT
TXO F,FL.LSN ; NO, LIST THIS NAME
JRST CHKZLN ; AND CONTINUE
CHKIN5: SKIPE .FXNMM(P1) ; CAN'T HAVE FILENAME HERE
ERROR FPC,<Filename illegal in default path change>,,PTHSCN
SKIPE .FXEXT(P1) ; OR AN EXTENSION
ERROR EPC,<Extension illegal in default path change>,,PTHSCN
PUSHJ P,CHKWLD ; CHECK FOR WILD CARDS IN PATH
ERROR WPC,<Wildcards illegal in default path change>,,PTHSCN
MOVE T1,.FXDIR(P1) ; GET THE PPN
TLNN T1,-1 ; PROJECT NUMBER SPECIFIED?
HLL T1,.MYPPN## ; NO, USE OURS
TRNN T1,-1 ; PROGRAMMER NUMBER SPECIFIED?
HRR T1,.MYPPN## ; NO, USE OURS
MOVEM T1,.FXDIR(P1) ; STORE IT BACK
SKIPL $FXSEA(P1) ; CAN'T HAVE /[NO]SEARCH HERE
ERROR SPC,</SEARCH illegal in default path change>,,PTHSCN
SKIPL $FXOVE(P1) ; CAN'T HAVE /[NO]OVERRIDE HERE
ERROR OPC,</OVERRIDE illegal in default path change>,,PTHSCN
TXO F,FL.CPT ; LIGHT "CHANGE PATH" BIT
;
;Check to make sure the user didn't say /CLEAR with any other logical
;name command.
;
CHKZLN: SKIPG S.CLEAR ; USER SAY /CLEAR?
JRST SETUP ; NO
TXNE F,FL.SLN!FL.CLN!FL.LSN ; ANY OTHER LOGICAL NAME COMMANDS?
ERROR CNC,</CLEAR may not be included with logical name changes>,,PTHSCN
TXNE F,FL.LCG!FL.LST ; /L OR /L:C SET?
TXO F,FL.LLN ; YES, SET /L:NAMES
SUBTTL Function setup
;Here when the command has been validated by the checks above. We must
;now setup the blocks to perform the required functions.
;
;Check for /[NO]NEW
;
SETUP: SKIPGE P1,S.NEW ; USER SAY /[NO]NEW?
JRST SETSYS ; NO
PUSHJ P,GETCAP ; INSURE CURRENT VALUES ARE SETUP
DPB P1,[POINTR PTSAP+.PTSWT,PT.SNW] ; SET NEW VALUE IN BLOCK
TXO F,FL.SAP ; LIGHT "SET ADDITIONAL PATH" BIT
TXNE F,FL.LCG!FL.LST ; /L OR /L:C SET?
TXO F,FL.LPT ; YES, SET /LIST:PATH ALSO
;
;Check for /[NO]SYS
;
SETSYS: SKIPGE P1,S.SYS ; USER SAY /[NO]SYS?
JRST SETSCN ; NO
PUSHJ P,GETCAP ; INSURE CURRENT VALUES ARE SETUP
DPB P1,[POINTR PTSAP+.PTSWT,PT.SSY] ; SET NEW VALUE IN BLOCK
TXO F,FL.SAP ; LIGHT "SET ADDITIONAL PATH" BIT
TXNE F,FL.LCG!FL.LST ; /L OR /L:C SET?
TXO F,FL.LPT ; YES, SET /L:PATH ALSO
;
;Check for /[NO]SCAN
;
SETSCN: SKIPGE P1,S.SCAN ; USER SAY /[NO]SCAN?
JRST SETPTH ; NO
PUSHJ P,GETCDP ; INSURE CURRENT VALUES ARE SETUP
ADDX P1,.PTSCN ; CONVERT 0/1 TO .PTSCN/.PTSCY
DPB P1,[POINTR PTSDP+.PTSWT,PT.SCN] ; SET NEW VALUE IN BLOCK
TXO F,FL.SDP ; LIGHT "SET DEFAULT PATH" BIT
TXNE F,FL.LCG!FL.LST ; /L OR /L:C SET?
TXO F,FL.LPT ; YES, SET /L:PATH ALSO
;
;Check for new default path
;
SETPTH: TXNN F,FL.CPT ; USER WANT TO CHANGE HIS PATH?
JRST SETSLN ; NO
PUSHJ P,GETCDP ; INSURE CURRENT VALUES ARE SETUP
MOVE T1,SCNIFS ; GET SCAN BLOCK ADDRESS
MOVX T2,<-.FXLND,,0> ; AND AOBJN POINTER TO PTSDP
SETPT1: SKIPN T3,.FXDIR(T1) ; GET NEXT WORD OF DIRECTORY
JRST SETPT2 ; FOUND ZERO TERMINATOR
MOVEM T3,PTSDP+.PTPPN(T2) ; STORE IN PATH BLOCK
ADDI T1,2 ; SKIP OVER MASK WORD IN SCAN BLOCK
AOBJN T2,SETPT1 ; BUMP PATH BLOCK INDEX AND LOOP IF MORE
SETPT2: SETZM PTSDP+.PTPPN(T2); INSURE ZERO WORD TERMINATOR IN PATH BLOCK
TXO F,FL.SDP ; LIGHT "SET DEFAULT PATH" BIT
TXNE F,FL.LCG!FL.LST ; /L OR /L:C SET?
TXO F,FL.LPT ; YES, SET /L:PATH ALSO
;Check for logical name definition
;
SETSLN: TXNN F,FL.SLN ; USER WANT TO SET A LOGICAL NAME?
JRST SETCLN ; NO
MOVE P1,SCNOFS ; GET POINTER TO OUTPUT SCAN BLOCK
PUSHJ P,SETLNF ; SETUP LOGICAL NAME FLAGS
MOVE T1,.FXDEV(P1) ; GET LOGICAL NAME
MOVEM T1,PTSLN+.PTLNM ; STORE IN THE BLOCK
MOVEI P2,PTSLN+.PTLSB-1; BUILD RH OF AOBJP POINTER TO BLOCK
HRLI P2,-<.PTLLB-.PTLSB+1> ; COMPLETE LH
SKIPN P1,SCNIFS ; SKIP IF DEFINITION
JRST [MOVX T1,PT.UDF ; GET "UNDEFINE" BIT
MOVEM T1,PTSLN+.PTLNF ; AND STORE IN BLOCK
MOVEI P1,SCNIFS-$FXLNK; MAKE HRRZ BELOW RETURN ZERO
JRST SETLN7 ; BIND OFF BLOCK
]
SETLN1: PUSHJ P,FNDPTH ; FIND PATH ASSOCIATED WITH THIS DEVICE
CAXE T1,.FPIPP ; THIS ONE HAVE AN IMPLIED PPN?
CAXN T1,.FPLNM ; OR A LOGICAL NAME?
JRST SETLN2 ; YES, ALWAYS DO THE SUBSTITUTION
MOVX T2,FX.DIR ; GET "DIRECTORY SPECIFIED" BIT
TDNN T2,.FXMOM(P1) ; USER SPECIFY ONE FOR THIS SPEC?
SETLN2: JRST @[EXP SETLN3,SETLN5,SETLN6](T1) ; DISPATCH
JRST SETLN4 ; YES, LEAVE IT ALONE
;Here if no path associated with this name. Zero the PPN word in
;the SCAN block and use that.
;
SETLN3: SETZM .FXDIR(P1) ; INSURE NO PPN
SETLN4: PUSHJ P,INSSCB ; INSERT SCAN BLOCK INTO THIS LOGICAL NAME
JRST E$$TMC ; TOO MANY FOR THIS SPEC
JRST SETLN7 ; JOIN COMMON CODE
;
;Here if the path for the device is a simple path spec.
;
SETLN5: PUSHJ P,INSPTH ; INSERT PATH INTO THIS LOGICAL NAME
JRST E$$TMC ; TOO MANY FOR THIS SPEC
JRST SETLN7 ; JOIN COMMON CODE
;
;Here if this device is really a logical name. Substitute the components
;into the logical name block.
;
SETLN6: PUSHJ P,INSLNM ; INSERT LOGICAL NAME INTO THIS SPEC
JRST E$$TMC ; TOO MANY
SETLN7: HRRZ P1,$FXLNK(P1) ; ADVANCE TO NEXT SCAN BLOCK
JUMPN P1,SETLN1 ; LOOP IF NOT AT END
AOBJP P2,E$$TMC ; INSURE NO BLOCK OVERFLOW
SETZM (P2) ; DO FINAL TERMINATOR
AOBJP P2,E$$TMC ; INSURE NO BLOCK OVERFLOW
SETZM (P2) ; AND ONE MORE TO END THE BLOCK
SUBI P2,PTSLN-1 ; CONVERT TO COUNT OF WORDS IN BLOCK
HRRZM P2,PTSLN+.PTFCN ; STORE COUNT AS ADVERTISED
TXNE F,FL.LCG!FL.LST ; /L OR /L:C SET?
TXO F,FL.LLN ; YES, SET /L:NAMES ALSO
JRST SETCLN ; SKIP THE ERROR MESSAGE
E$$TMC: ERROR TMC,<Too many logical name components>,,PTHSCN
;Check for logical name change
;
SETCLN: TXNN F,FL.CLN ; USER WANT TO CHANGE LOGICAL NAME?
JRST SETLLN ; NO
MOVE P1,SCNIFS ; GET INPUT SCAN BLOCK ADDRESS
MOVE T1,.FXDEV(P1) ; GET LOGICAL NAME
PUSHJ P,GETSLN ; READ THE INFORMATION
JRST [PUSHJ P,E$$NSL ; TELL OF NO SUCH NAME
TXZ F,FL.CLN!FL.SLN ; CLEAR LOGICAL NAME FLAGS
JRST SETJSL ; AND CONTINUE
]
PUSHJ P,SETLNF ; SETUP LOGICAL NAME FLAGS
MOVEI T1,PTSLN+.PTLSB ; POINT TO BLOCK JUST RETURNED
SETCL1: SKIPN 0(T1) ; LOOK FOR TWO ZEROS
SKIPE 1(T1) ; TERMINATING BLOCK
CAIA ; NOT FOUND, CONTINUE WITH THIS BLOCK
JRST SETCL3 ; FOUND THEM
ADDX T1,.PTLPP ; STEP TO START OF PATH BLOCK
SETCL2: SKIPE 0(T1) ; LOOK FOR ZERO TERMINATING PATH BLOCK
AOJA T1,SETCL2 ; LOOP FOR NEXT WORD
AOJA T1,SETCL1 ; STEP TO START OF NEXT GROUP
SETCL3: SUBI T1,PTSLN-2 ; COMPUTE THE NUMBER OF WORDS
HRRZM T1,PTSLN+.PTFCN ; STORE IN THE BLOCK AS ADVERTISED
TXO F,FL.SLN ; CHANGE TO SET LOGICAL NAME
TXNE F,FL.LCG!FL.LST ; /L OR /L:C SET?
TXO F,FL.LLN ; YES, SET /L:NAMES ALSO
SETLLN: TXNE F,FL.LSN ; USER WANT TO LIST THIS LOGICAL NAME?
TXO F,FL.LLN ; YES, SET /L:NAMES ALSO
;Check for new job search list
;
SETJSL: TXNN F,FL.JLS ; ANY JOB SEARCH LIST SWITCHES SPECIFIED?
JRST SETSSL ; NO, CHECK SYSTEM SEARCH LIST
MOVE P1,ADJBLK+$SLSCT ; GET COUNT OF STRS IN /ADD
ADD P1,RMJBLK+$SLSCT ; ADD TOTAL FROM /REMOVE
ADD P1,MDJBLK+$SLSCT ; ADD TOTAL FROM /MODIFY
JUMPE P1,SETJS1 ; OK IF ZERO
SKIPE CRJBLK+$SLSCT ; CAN'T HAVE ABOVE WITH /CREATE
ERROR COS,<CREATE illegal with other search list switches>,,PTHSCN
SETJS1: PUSHJ P,GETJSL ; GET CURRENT JOB SEARCH LIST
JRST SETSSL ; FAILED, FORGET IT
MOVE T1,JSLBLK+$SLMAX ; GET MAX STRS ALLOWED IN SEARCH LIST
LSH T1,1 ; TIMES 2 FOR SLOP
MOVX T2,.FSDSO ; ADDITIONAL WORDS FOR HEADER
PUSHJ P,BLDAOB ; ALLOCATE CORE AND RETURN AOBJP POINTER
MOVEM T1,JSLBLK+$SLNPT ; SAVE START ADDRESS IN BLOCK
MOVEM T2,JSLBLK+$SLNAB ; ALONG WITH AOBJP POINTER
MOVEI P2,JSLBLK ; POINT TO JSL PARAMETER BLOCK
MOVE P3,JSBPTR ; GET AOBJN POINTER TO SWITCH BLOCK TABLE
PUSHJ P,CHKSLB ; INVOKE ROUTINE FOR ALL SWITCHES WITH
; NON-ZERO STR COUNTS
TXO F,FL.JSL ; LIGHT "SET NEW JOB SEARCH LIST" BIT
TXNE F,FL.LCG!FL.LST ; /L OR /L:C SET
TXO F,FL.LJS ; YES, SET /L:JSL
;
;Check for new system search list
;
SETSSL: TXNN F,FL.SLS ; ANY SYS SEARCH LIST SWITCHES SPECIFIED?
JRST DOFNC ; NO, GO DO FUNCTIONS
MOVE P1,ADSBLK+$SLSCT ; GET COUNT OF STRS IN /SADD
ADD P1,RMSBLK+$SLSCT ; ADD TOTAL FROM /SREMOVE
ADD P1,MDSBLK+$SLSCT ; ADD TOTAL FROM /SMODIFY
JUMPE P1,SETSS1 ; OK IF ZERO
SKIPE CRSBLK+$SLSCT ; CAN'T HAVE ABOVE WITH /SCREATE
ERROR SOS,<SCREATE illegal with other search list switches>,,PTHSCN
SETSS1: PUSHJ P,GETSSL ; GET CURRENT SYSTEM SEARCH LIST
JRST DOFNC ; FAILED, FORGET IT
MOVE T1,SSLBLK+$SLMAX ; GET MAX STRS ALLOWED IN SEARCH LIST
LSH T1,1 ; TIMES 2 FOR SLOP
MOVX T2,.FSDSO ; PLUS WORDS FOR HEADER
PUSHJ P,BLDAOB ; ALLOCATE CORE AND RETURN AOBJP POINTER
MOVEM T1,SSLBLK+$SLNPT ; SAVE STARTING ADDRESS OF BLOCK
MOVEM T2,SSLBLK+$SLNAB ; ALONG WITH AOBJP POINTER
MOVEI P2,SSLBLK ; POINT TO SSL PARAMETER BLOCK
MOVE P3,SSBPTR ; GET AOBJN POINTER TO SWITCH BLOCK TABLE
PUSHJ P,CHKSLB ; INVOKE ROUTINE FOR ALL SWITCHES THAT HAVE
; A NON-ZERO STR COUNT
TXO F,FL.SSL ; LIGHT "SET NEW SYSTEM SEARCH LIST" BIT
TXNE F,FL.LCG!FL.LST ; /L OR /L:C SET?
TXO F,FL.LSS ; YES, SET /L:SSL
SUBTTL Function execution
;Here to finally perform any functions as indicated by the command.
;The code on the last few pages setup all the necessary UUO blocks so
;the only thing we should have to do is perform the appropriate UUOs.
DOFNC: TXNE F,FL.JSL ; NEED TO SET NEW JOB SEARCH LIST?
PUSHJ P,STNJSL ; YES, DO IT
TXNE F,FL.SDP ; NEED TO SET NEW DEFAULT PATH?
PUSHJ P,SETNDP ; YES, DO IT
TXNE F,FL.SAP ; NEED TO SET NEW ADDITIONAL PATH?
PUSHJ P,SETNAP ; YES, DO IT
TXNE F,FL.SSL ; NEED TO SET NEW SYSTEM SEARCH LIST?
PUSHJ P,STNSSL ; YES, DO IT
SKIPLE S.CLEAR ; NEED TO CLEAR ALL LOGICAL NAMES?
PUSHJ P,CLRLNM ; YES, DO IT
TXNE F,FL.SLN ; NEED TO SET ANY LOGICAL NAMES?
PUSHJ P,SETLNM ; YES, DO IT
JFCL ; IGNORE ERROR RETURN
SKIPN SCNIFS ; IF ANY SCAN BLOCKS,
SKIPE SCNOFS ; THEN DON'T DIDDLE WITH LIST SWITCHES
JRST DOFNC1 ; SO SKIP THE CODE
TXNN F,FL.GSO ; IF PATH <CR>
TXO F,FL.LPT ; THEN SET /L:PATH
TXNE F,FL.LST ; /L SET?
TXNE F,FL.LSW ; AND NOTHING ELSE?
CAIA ; NO
TXO F,FL.LPT ; YES, SET /L:P
DOFNC1: TXNE F,FL.LPT ; USER WANT PATH LISTED?
PUSHJ P,LSTPTH ; YES, DO IT
TXNE F,FL.LJS ; USER WANT SEARCH LIST LISTED?
PUSHJ P,LSTJSL ; YES, DO IT
TXNE F,FL.LSS ; USER WANT SYSTEM SL LISTED?
PUSHJ P,LSTSSL ; YES, DO IT
TXNE F,FL.LLN ; USER WANT LOGICAL NAMES LISTED?
PUSHJ P,LSTLNM ; YES, DO IT
JRST PTHSCN ; AND DO IT ALL OVER FOR THE NEXT COMMAND
SUBTTL Listing routines
;Routine to type the user's current path information.
;The call is:
;
; PUSHJ P,PTHLST
; <always return here>
LSTPTH: TRACE$ LSTPTH ; TYPE DEBUGGING INFO
PUSHJ P,GETCDP ; GET DEFAULT PATH IF WE DON'T ALREADY HAVE IT
PUSHJ P,GETCAP ; GET ADDITIONAL PATH FOR /LIB
MOVEI T1,[ASCIZ/Path: /] ; TELL HIM WHAT THIS IS
PUSHJ P,.TSTRG## ; PRINT IT
MOVEI T1,PTSDP+.PTPPN ; POINT TO START OF PATH
TLO T1,TS.DRP ; PATH BLOCK FLAG TO .TDIRB
PUSHJ P,.TDIRB## ; LET SCAN TYPE THE DEFAULT PATH
MOVEI T1,0 ; ZERO MESSAGE ADDRESS
LDB T2,[POINTR PTSDP+.PTSWT,PT.SCN] ; GET SCAN SWITCH
CAXN T2,.PTSCN ; /NOSCAN?
MOVEI T1,[ASCIZ\/NOSCAN\] ; YES, SETUP MESSAGE
CAXN T2,.PTSCY ; /SCAN?
MOVEI T1,[ASCIZ\/SCAN\] ; YES, SETUP THAT ONE
SKIPE T1 ; ONLY PRINT IF THERE IS A MESSAGE
PUSHJ P,.TSTRG## ; TYPE THE STRING
MOVE T2,PTSDP+.PTSWT ; GET SWITCHES FROM BLOCK
MOVEI T1,[ASCIZ\/NEW\] ; SETUP FOR /NEW TEST
TXNE T2,PT.NEW ; USER HAVE /NEW SET?
PUSHJ P,.TSTRG## ; YES, TELL HIM
MOVE T2,PTSDP+.PTSWT ; GET SWITCHES BACK
MOVEI T1,[ASCIZ\/SYS\] ; SETUP FOR /SYS TEST
TXNE T2,PT.SYS ; USER HAVE /SYS SET?
PUSHJ P,.TSTRG## ; YES, TELL HIM
SKIPN PTSAP+.PTPPN ; /LIB EXIST?
PJRST .TCRLF## ; NO, END THE LINE AND RETURN
MOVEI T1,[ASCIZ\/LIB:\] ; GET MESSAGE
PUSHJ P,.TSTRG## ; TYPE IT
MOVEI T1,PTSAP+.PTPPN ; POINT AT LIB
TLO T1,TS.DRP ; TELL SCAN IT'S A PATH BLOCK
PUSHJ P,.TDIRB## ; TYPE VALUE
PJRST .TCRLF## ; END WITH CRLF AND RETURN
;Routine to list the job search list.
;The call is:
;
; PUSHJ P,LSTJSL
; <always return here>
LSTJSL: TRACE$ LSTJSL ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE1## ; SAVE P1
STORE T1,SLBLK,SLBLK+.DFGST,0 ;CLEAR THE BLOCK
MOVEI T1,[ASCIZ/Job search list: /]
PUSHJ P,.TSTRG## ; TYPE A HEADER
SETOB P1,SLBLK+.DFJNM ; SET FIRST STR INDICATION
LSTJS1: MOVX T1,<.DFJST+1,,SLBLK> ; POINT TO BLOCK
JOBSTR T1, ; GET THE NEXT STRUCTURE
WARN RJS,<Can't read job search list>,,.POPJ##
SKIPN T1,SLBLK+.DFJNM ; HANDLE FENCE SPECIALLY
JRST [MOVEI T1,[ASCIZ/, FENCE/] ; TELL OF FENCE
AOSN P1 ; UNLESS NO SL
MOVEI T1,[ASCIZ/FENCE/] ; NO COMMA
PUSHJ P,.TSTRG## ; TYPE THE STRING
SETZM P1 ; FLAG NOT FIRST STR
JRST LSTJS1 ; AND DO PASSIVE SL
]
AOJE T1,.TCRLF## ; END WITH CRLF AND RETURN
MOVEI T1,[ASCIZ/, /] ; GET SEPARATOR
AOSE P1 ; DON'T PRINT FOR FIRST STR
PUSHJ P,.TSTRG## ; TYPE THE SEPARATOR
MOVE T1,SLBLK+.DFJNM ; GET STR NAME
PUSHJ P,.TSIXN## ; AND TYPE IN SIXBIT
PUSHJ P,.TCOLN## ; FOLLOWED BY A COLON
MOVE P1,SLBLK+.DFJST ; GET STATUS BITS FOR THIS STR
MOVEI T1,[ASCIZ\/NOWRITE\]
TXZE P1,DF.SWL ; IS IT SOFTWARE WRITE LOCKED?
PUSHJ P,.TSTRG## ; YES, TELL HIM
MOVEI T1,[ASCIZ\/NOCREATE\]
TXZE P1,DF.SNC ; HOW ABOUT NO CREATE?
PUSHJ P,.TSTRG## ; YES, TELL HIM THAT ALSO
JRST LSTJS1 ; GO GET NEXT STRUCTURE
;Routine to list the system search list.
;The call is:
;
; PUSHJ P,LSTSSL
; <always return here>
LSTSSL: TRACE$ LSTSSL ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE1## ; SAVE P1
STORE T1,SLBLK,SLBLK+.DFGST,0 ;CLEAR THE BLOCK
MOVEI T1,[ASCIZ/System search list: /]
PUSHJ P,.TSTRG## ; TYPE A HEADER
SETOB P1,SLBLK+.DFGNM ; SET FIRST STR INDICATION
LSTSS1: MOVX T1,<.DFGST+1,,SLBLK> ; POINT TO BLOCK
GOBSTR T1, ; GET THE NEXT STRUCTURE
WARN RSS,<Can't read system search list>,,.POPJ##
SKIPE T1,SLBLK+.DFGNM ; STOP ON FENCE
AOSN T1 ; OR ON LAST STRUCTURE
JRST .TCRLF## ; RETURN AFTER TYPING CRLF
MOVEI T1,[ASCIZ/, /] ; GET SEPARATOR
AOSE P1 ; DON'T PRINT FOR FIST STR
PUSHJ P,.TSTRG## ; TYPE THE SEPARATOR
MOVE T1,SLBLK+.DFGNM ; GET STR NAME
PUSHJ P,.TSIXN## ; AND TYPE IN SIXBIT
PUSHJ P,.TCOLN## ; FOLLOWED BY A COLON
MOVE P1,SLBLK+.DFGST ; GET STATUS BITS FOR THIS STR
MOVEI T1,[ASCIZ\/NOWRITE\]
TXZE P1,DF.SWL ; IS IT SOFTWARE WRITE LOCKED?
PUSHJ P,.TSTRG## ; YES, TELL HIM
MOVEI T1,[ASCIZ\/NOCREATE\]
TXZE P1,DF.SNC ; HOW ABOUT NO CREATE?
PUSHJ P,.TSTRG## ; YES, TELL HIM THAT ALSO
JRST LSTSS1 ; GO GET NEXT STRUCTURE
;Routine to list logical names based on what was typed in the Command
;string. The algorithm used is as follows:
;
;IF no input scan blocks THEN the user either typed no
; logical names or is undefining one, so list all existing names
;ELSE IF output scan block, THEN the user is defining a new
; name so just list that one
; ELSE IF FL.LSN is set, THEN the user wants a list of one
; specific name so list that one
; ELSE user typed a default path so list all existing names
;
;The call is:
;
; PUSHJ P,LSTLNM
; <always return here>
LSTLNM: TRACE$ LSTLNM,<F,SCNIFS,SCNOFS> ; TYPE DEBUGGING INFO
TXO F,FL.FST ; SET FIRST TIME FLAG
PUSHJ P,.SAVE1## ; SAVE P1
SKIPE P1,SCNIFS ; SKIP IF NO INPUT SCAN BLOCKS
TXNN F,FL.LSN ; OR IF NO LOGICAL NAMES SET
JRST LSTLN1 ; THEN LIST ALL EXISTING NAMES
SKIPE SCNOFS ; IF AN OUTPUT SCAN BLOCK
MOVE P1,SCNOFS ; THEN LIST JUST THAT ONE
MOVE T1,.FXDEV(P1) ; GET NAME TO LIST
PUSHJ P,GETSLN ; READ THAT LOGICAL NAME
CAIA ; NAME NOT THERE
PJRST LSTNAM ; LIST IT AND RETURN
E$$NSL: WARN NSL,<No such logical name >,NOCRLF
MOVE T1,.FXDEV(P1) ; GET BAD NAME
PJRST TYPNAM ; TYPE NAME AND RETURN
;
;Here to list all existing logical names
;
LSTLN1: SETZM PTSLN+.PTLNM ; SET NAME TO 0 TO GET THE FIRST ONE
LSTLN2: PUSHJ P,GETNLN ; GET THE NEXT ONE IN LINE
WARN RLN,<Can't read logical names>,,.POPJ##
SKIPN T1,PTSLN+.PTLNM ; DONE IF WE GOT BACK A ZERO
POPJ P, ; SO RETURN
PUSHJ P,LSTNAM ; LIST THIS NAME
JRST LSTLN2 ; AND GO GET NEXT ONE
;Routine to list the logical name stored at PTSLN.
;The call is:
;
; PUSHJ P,LSTNAM
; <always return here>
LSTNAM: TRACE$ LSTNAM ; TYPE DEBUGGING INFO
MOVEI T1,[ASCIZ/Logical name definitions:
/]
TXZE F,FL.FST ; FIRST TIME HERE?
PUSHJ P,.TSTRG## ; YES, TYPE THE HEADER
PUSHJ P,.SAVE1## ; SAVE P1
MOVE T1,PTSLN+.PTLNM ; GET THE LOGICAL NAME
PUSHJ P,.TSIXN## ; TYPE IT
PUSHJ P,.TCOLN## ; FOLLOWED BY A COLON
MOVE P1,PTSLN+.PTLNF ; GET THE FLAGS
MOVEI T1,[ASCIZ\/SEARCH\] ; SETUP FOR /SEARCH
TXNE P1,PT.SEA ; IS THIS ONE LIB'ED?
PUSHJ P,.TSTRG## ; YES TELL HIM
MOVEI T1,[ASCIZ\/OVERRIDE\] ; SETUP FOR /OVERRIDE
TXNE P1,PT.OVR ; IS THIS ONE?
PUSHJ P,.TSTRG## ; YES, TELL HIM
MOVEI T1,[ASCIZ/ = /] ; GET SEPARATOR
PUSHJ P,.TSTRG## ; AND TYPE IT
MOVEI P1,PTSLN+.PTLSB ; POINT TO FIRST COMPONENT
LSTNA1: SKIPN 0(P1) ; DONE WITH THE LIST YET?
SKIPE 1(P1) ; ?
CAIA ; NO, CONTINUE
JRST .TCRLF## ; YES, END WITH CRLF AND RETURN
CAIE P1,PTSLN+.PTLSB ; THIS THE FIRST ONE IN THE LIST
PUSHJ P,.TCOMA## ; NO, TYPE A COMMA
SKIPN T1,.PTNOD(P1) ; ANY NODE SPECIFIED?
JRST LSTNA2 ; NO, CONTINUE
PUSHJ P,.TSIXN## ; TYPE IT
PUSHJ P,.TCOLN## ; TYPE A COLON
PUSHJ P,.TCOLN## ; TYPE ANOTHER
LSTNA2: MOVE T1,.PTLSL(P1) ; GET SEARCH LIST OF THIS ONE
PUSHJ P,.TSIXN## ; TYPE THE SEARCH LIST
PUSHJ P,.TCOLN## ; FOLLOWED BY A COLON
SKIPN T1,.PTFIL(P1) ; ANY FILENAME SPECIFIED?
SKIPE .PTEXT(P1) ; NO, HOW ABOUT AN EXTENSION?
CAIA ; ONE OF THEM WAS SPECIFIED
JRST LSTNA4 ; NO, CONTINUE
JUMPE T1,LSTNA3 ; PRINT FILENAME ONLY IF NO EXTENSION
HLRZ T2,.PTEXT(P1) ; GET EXTENSION
CAIN T2,'UFD' ; THIS A UFD?
JUMPGE T1,[PUSHJ P,.TPPNW## ; YES, PRINT PPN IF NOT SIXBIT
JRST .+2 ; AND SKIP THE SIXBIT TYPE
]
PUSHJ P,.TSIXN## ; TYPE FILENAME
LSTNA3: MOVEI T1,"." ; GET SEPARATOR
PUSHJ P,.TCHAR## ; TYPE IT
HLLZ T1,.PTEXT(P1) ; GET EXTENSION
PUSHJ P,.TSIXN## ; TYPE IT
LSTNA4: MOVX T1,.PTLPP ; GET OFFSET TO START OF PATH
ADDB T1,P1 ; POINT TO IT
SKIPN T2,(T1) ; NO PATH AT ALL?
AOJA P1,LSTNA1 ; NO, INCREMENT POINTER AND GO ON
PUSHJ P,TDIRB ; TYPE THE PATH BLOCK
LSTNA6: SKIPE (P1) ; FIND LAST WORD IN PATH BLOCK
AOJA P1,LSTNA6 ; LOOP UNTIL FOUND
AOJA P1,LSTNA1 ; BUMP ONCE MORE AND TYPE NEXT
;Routine to type a path block and worry about the [,] case.
;The call is:
; MOVEI T1,path block address
; MOVE T2,(T1) ;Get first word
; PUSHJ P,TDIRB
; <return here always>
TDIRB: TRACE$ TDIRB,<T1,T2> ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE2## ; SAVE P1-P2
DMOVE P1,T1 ; SAVE ARGUMENTS IN P1, P2
MOVEI T1,"[" ; GET A LEFT BRACKET
PUSHJ P,.TCHAR## ; TYPE IT
HLRE T1,P2 ; GET PROJECT NUMBER
AOJE T1,TDIRB1 ; DON'T TYPE IF -1
HLRZ T1,P2 ; RETRIEVE PROJECT NUMBER
PUSHJ P,.TOCTW## ; TYPE THE PROJECT NUMBER
TDIRB1: PUSHJ P,.TCOMA## ; TYPE A COMMA
HRRE T1,P2 ; GET THE PROGRAMMER NUMBER
AOJE T1,TDIRB2 ; DON'T TYPE IF -1
HRRZ T1,P2 ; RETRIEVE PROGRAMMER NUMBER
PUSHJ P,.TOCTW## ; TYPE THE PROGRAMMER NUMBER
TDIRB2: HRLI P1,-.FXLND ; BUILD AOBJP POINTER TO PATH BLOCK
TDIRB3: AOBJP P1,.TRBRK## ; IF TOO MANY, TYPE BRACKET AND RETURN
SKIPN 0(P1) ; FIND THE END OF BLOCK?
PJRST .TRBRK## ; YES, CLOSE OFF BLOCK AND RETURN
PUSHJ P,.TCOMA## ; TYPE A COMMA
MOVE T1,0(P1) ; GET THE NEXT SFD
PUSHJ P,.TSIXN## ; TYPE IT
JRST TDIRB3 ; LOOP FOR MORE
SUBTTL Routines that perform PATH. and STRUUO functions
;Routine to set any new default path required by the command string.
;Call after setting up the default path block at PTSDP.
;The call is:
;
; PUSHJ P,SETNDP
; <return here always>
SETNDP: TRACE$ SETNDP ; TYPE DEBUGGING INFO
TXZ F,FL.RDP ; FORCE GETCDP TO REREAD BLOCK
MOVX T1,.PTFSD ; FUNCTION TO DEFINE DEFAULT PATH
MOVEM T1,PTSDP+.PTFCN ; STORE IN PATH. BLOCK
MOVX T1,PT.SCN ; GET MASK FOR /SCAN SWITCH
ANDM T1,PTSDP+.PTSWT ; CLEAR ALL BUT THE SWITCH
MOVX T1,<.PTMAX,,PTSDP> ; POINT TO PATH BLOCK
PATH. T1, ; SET NEW DEFAULT PATH
CAIA ; FAILED, ANALYZE ERROR
POPJ P, ; RETURN OK
AOSE T1 ; AC==-1 => NON-EXISTENT SFD
WARN NMS,<No monitor SFD support>,,.POPJ##
ERROR NES,<Non-existent SFD>,,.POPJ##
;Routine to set any new additional path required by the command string.
;Call after setting up the additional path block at PTSAP.
;The call is:
;
; PUSHJ P,SETNAP
; <always return here>
SETNAP: TRACE$ SETNAP ; TYPE DEBUGGING INFO
TXZ F,FL.RAP ; FORCE GETCAP TO REREAD BLOCK
MOVX T1,.PTFSL ; FUNCTION TO DEFINE ADDITIONAL PATH
MOVEM T1,PTSAP+.PTFCN ; STORE IN PATH BLOCK
MOVX T1,PT.SNW!PT.SSY ; GET MASK FOR IMPORTANT BITS
ANDM T1,PTSAP+.PTSWT ; CLEAR ALL BUT THOSE
MOVX T1,PT.DTL ; GET "DON'T TOUCH LIB" BIT
IORM T1,PTSAP+.PTSWT ; SET IT SO WE DON'T CLOBBER LIB
MOVX T1,<.PTMAX,,PTSAP> ; POINT TO BLOCK
PATH. T1, ; SET NEW ADDITIONAL PATH
WARN LNS,<Libraries not supported>,,.POPJ##
POPJ P, ; RETURN
;Routine to set a new job search list. Call with JSLBLK+$SLNCT
;containing the number of STRS in the list and JSLBLK+$SLNPT containing
;a pointer to the start of the list.
;The call is:
;
; PUSHJ P,STNJSL
; <always return here>
STNJSL: TRACE$ STNJSL ; TYPE DEBUGGING INFO
SKIPG T1,JSLBLK+$SLNCT ; MORE THAN ONE STRUCTURE?
TELL LSJ,<Removing last structure from job search list>
CAMLE T1,JSLBLK+$SLMAX ; GREATER THAN MAX ALLOWED?
PJRST E$$TMS ; YES, TELL HIM
MOVE T1,JSLBLK+$SLNPT ; GET POINTER TO START OF LIST
SUBI T1,.FSCSO ; POINT TO START OF BLOCK FOR JSL
MOVX T2,.FSSRC ; FUNCTION TO DEFINE NEW SL
MOVEM T2,.FSFCN(T1) ; STORE IN BLOCK
MOVE T2,JSLBLK+$SLNCT ; GET NUMBER OF STRS IN LIST
IMULI T2,.DFJBL ; MULTIPLY BY # WORDS PER STR
HRLI T1,.FSCSO(T2) ; ADD STARTING OFFSET AND MOVE TO T1
STRUUO T1, ; SET NEW SL
WARN JSF,<Job search list definition failed>
POPJ P, ; RETURN
;Routine to set a new system search list. Call with SSLBLK+$SLNCT
;containing the number of STRS in the list and SSLBLK+$SLNPT containing
;a pointer to the start of the list.
;The call is:
;
; PUSHJ P,STNSSL
; <always return here>
STNSSL: TRACE$ STNSSL ; TYPE DEBUGGING INFO
SKIPG T1,SSLBLK+$SLNCT ; MORE THAN ONE STRUCTURE?
TELL LSS,<Removing last structure from system search list>
CAMLE T1,SSLBLK+$SLMAX ; GREATER THAN MAX ALLOWED?
PJRST E$$TMS ; YES, TELL HIM
MOVE T1,SSLBLK+$SLNPT ; GET POINTER TO START OF LIST
SUBI T1,.FSDSO ; POINT TO START OF BLOCK FOR JSL
MOVX T2,.FSDSL ; FUNCTION TO DEFINE NEW SSL
MOVEM T2,.FSFCN(T1) ; STORE IN BLOCK
SETZM .FSDJN(T1) ; ZERO JOB NUMBER (SYS:)
SETZM .FSDPP(T1) ; AND PPN
MOVX T2,DF.SRM ; GET "REMOVE FROM SL COMPLETELY" BIT
MOVEM T2,.FSDFL(T1) ; STORE IN FLAGS WORD
MOVE T2,SSLBLK+$SLNCT ; GET NUMBER OF STRS IN LIST
IMULI T2,.DFJBL ; MULTIPLY BY # WORDS PER STR
HRLI T1,.FSDSO(T2) ; ADD STARTING OFFSET AND MOVE TO T1
STRUUO T1, ; SET NEW SL
CAIA ; FAILED, ANALYZE ERROR
POPJ P, ; RETURN
CAXN T1,FSNPV% ; NOT PRIVILEGED?
WARN NPV,<Not privileged to set system search list>,,.POPJ##
WARN SSF,<System search list definition failed>,,.POPJ##
;Routine to CLEAR the definitions of all existing logical names.
;The call is:
;
; PUSHJ P,CLRLNM
; <always return here>
CLRLNM: TRACE$ CLRLNM ; TYPE DEBUGGING INFO
CLRLN1: SETZM PTSLN+.PTLNM ; CLEAR NAME TO READ FIRST ONE
PUSHJ P,GETNLN ; READ THE NEXT DEFINED NAME
POPJ P, ; GIVE UP ON ERROR
SKIPN PTSLN+.PTLNM ; DONE IF NEXT NAME IS ZERO
POPJ P, ; SO RETURN
MOVX T1,PT.UDF ; GET "UNDEFINE" BIT
MOVEM T1,PTSLN+.PTLNF ; STORE IN FLAGS WORD
SETZM PTSLN+.PTLSB ; ZERO NEXT WORD
SETZM PTSLN+.PTLSB+1 ; AND NEXT TO INSURE DOUBLE ZERO TERMINATOR
MOVEI T1,.PTLSB+1+1 ; GET LENGTH OF BLOCK
MOVEM T1,PTSLN+.PTFCN ; STORE LENGTH FOR SETLNM
PUSHJ P,SETLNM ; UNDEFINE THIS ONE
POPJ P, ; GIVE UP IF WE GOT AN ERROR RETURN
JRST CLRLN1 ; AND LOOP FOR ALL
;Routine to define a new logical name or change and existing one. Call
;after setting up the logical name block at PTSLN and storing the length
;of the block at PTSLN+.PTFCN.
;The call is:
;
; PUSHJ P,SETLNM
; <return here if error>
; <return here if set succeeded>
SETLNM: TRACE$ SETLNM ; TYPE DEBUGGING INFO
MOVX T1,PT.SEA!PT.UDF!PT.OVR ; GET MASK FOR IMPORTANT BITS
ANDM T1,PTSLN+.PTLNF ; AND CLEAR ALL BUT THOSE BITS
MOVX T1,.PTFSN ; FUNCTION TO DEFINE LOGICAL NAME
EXCH T1,PTSLN+.PTFCN ; STORE IN BLOCK AND GET LENGTH
MOVSS T1 ; PUT INTO LEFT HALF
HRRI T1,PTSLN ; AND POINT AT THE BLOCK
PATH. T1, ; DEFINE THE NAME
CAIA ; FAILED, CHECK ERROR CODE
JRST .POPJ1## ; RETURN SUCCESSFUL
SKIPL T1 ; FOR NEGATIVE ERROR CODES
CAILE T1,PTERLN ; OR ONES GREATER THAN WE KNOW ABOUT
E$$LNF: WARN LNF,<Logical name definition failed>,,.POPJ##
JRST @PTERTB(T1) ; PRINT APPROPRIATE MESSAGE
PTERTB: EXP E$$LNF ; (0) DON'T KNOW ABOUT THIS ONE
EXP E$$TMC ; (1) TOO MANY ENTRIES IN THIS LIST
EXP E$$TMN ; (2) TOO MANY NAMES
EXP E$$NND ; (3) ATTEMPT TO UNDEFINE A NON-EXISTENT NAME
EXP E$$NFS ; (4) NO FUNNY SPACE
EXP E$$ANE ; (5) ASSIGNED NAME EXISTS
EXP E$$LNF ; (6) CAN'T GET HERE FROM THIS FUNCTION
EXP E$$LNF ; (7) DITTO
EXP E$$LNF ; (10) FILNAME REQUIRED FOR /COMMAND
PTERLN==.-PTERTB
E$$TMN: WARN TMN,<Too many defined logical names>,,.POPJ##
E$$NFS: WARN NFS,<No per-process monitor-free-core>,,.POPJ##
E$$NND: WARN NND,<Name not defined >,NOCRLF,SETLNT
E$$ANE: WARN ANE,<ASSIGNed name already exists >,NOCRLF
SETLNT: MOVE T1,PTSLN+.PTLNM ; GET THE NAME IN ERROR
PJRST TYPNAM ; TYPE NAME AND RETURN
;Routine to read the default path into the block starting at PTSDP.
;The call is:
;
; PUSHJ P,GETCDP ; To read into PTSDP
; <always return here>
;
; -or-
;
; PUSHJ P,GETPTH ; To read into MYPATH
; <always return here>
GETCDP: TRACE$ GETCDP ; TYPE DEBUGGING INFO
TXOE F,FL.RDP ; ALREADY HAVE THE INFORMATION?
POPJ P, ; YES, JUST RETURN
SKIPA T2,[PTSDP] ; PLACE TO PUT THE PATH
GETPTH: MOVEI T2,MYPATH ; ALTERNATE PLACE TO PUT IT
MOVX T1,.PTFRD ; FUNCTION TO READ CURRENT DEFAULT PATH
MOVEM T1,.PTFCN(T2) ; STORE IN BLOCK
HRLI T2,.PTMAX ; MAKE IT LEN,,ADDR
PATH. T2, ; READ THE INFO INTO THE BLOCK
ERROR DPN,<Default path not available>,,PTHSCN
POPJ P, ; AND RETURN
;Routine to read the additional path into the block starting at PRSAP.
;The call is:
;
; PUSHJ P,GETCAP
; <always return here>
GETCAP: TRACE$ GETCAP ; TYPE DEBUGGING INFO
TXOE F,FL.RAP ; ALREADY HAVE THE INFORMATION?
POPJ P, ; YES, JUST RETURN
MOVX T1,.PTFRL ; FUNCTION TO READ ADDITIONAL PATH
MOVEM T1,PTSAP+.PTFCN ; STORE IN BLOCK
MOVX T1,<.PTMAX,,PTSAP> ; POINT AT BLOCK
PATH. T1, ; READ THE INFO INTO THE BLOCK
ERROR APN,<Additional path not available>,,PTHSCN
POPJ P, ; AND RETURN
;Routine to read the definition of a specific logical name into the
;block at PTSLN. Call GETSLN to read the name in T1, GETNLN to read the
;name after the one already in the block.
;The call is:
;
; MOVE T1,logical name to read
; PUSHJ P,GETSLN
; <return here if no such name>
; <return here with block at PTSLN>
;
; -or-
;
; PUSHJ P,GETNLN
; <return here if no such name>
; <return here with block at PTSLN>
GETSLN: TRACE$ GETSLN,T1 ; TYPE DEBUGGING INFO
MOVEM T1,PTSLN+.PTLNM ; STORE NAME TO READ IN BLOCK
SKIPA T1,[PT.RCN] ; SET "READ CURRENT NAME" FLAG
GETNLN: MOVEI T1,0 ; SET NO FLAGS
MOVEM T1,PTSLN+.PTLNF ; STORE THE FLAGS IN THE BLOCK
MOVX T1,.PTFRN ; FUNCTION TO READ LOGICAL NAMES
MOVEM T1,PTSLN+.PTFCN ; STORE IN BLOCK
MOVX T1,<.PTLLB,,PTSLN> ; POINT TO THE BLOCK
PATH. T1, ; READ THE NAME
POPJ P, ; FAILED, PROPAGATE ERROR
JRST .POPJ1## ; RETURN SUCCESS
;Routine to determine if there is a path associated with the device of
;the current logical name component.
;The call is:
;
; MOVEI P1,Address of current scan block
; PUSHJ P,FNDPTH
; <always return here>
;
;Returns one of the following in T1:
.FPNON==0 ; if no path associated
.FPIPP==1 ; if device has an implied PPN (path block pointed to
; by PTHPTR)
.FPLNM==2 ; if device is a logical name and should be replaced
; with it's components (path block pointed to by LNMPTR)
FNDPTH: TRACE$ FNDPTH,P1 ; TYPE DEBUGGING INFO
PUSH P,[.FPNON] ; INITIALIZE RETURN VALUE
SKIPE T1,PTHPTR ; ALREADY HAVE SPACE?
JRST FNDPT1 ; YES
MOVX T1,.PTMAX ; AMOUNT OF SPACE WE NEED
PUSHJ P,GETCOR ; GET THAT MUCH
JRST E$$NEC ; NO CORE!!!
MOVEM T1,PTHPTR ; SAVE FOR NEXT (MAYBE) CALL
FNDPT1: MOVE T2,.FXDEV(P1) ; GET DEVICE FOR THIS COMPONENT
MOVEM T2,.PTSTR(T1) ; STORE IN PATH. BLOCK
MOVEI T2,(T1) ; COPY ADDRESS OF BLOCK
HRLI T2,.PTMAX ; MAKE IT LEN,,ADDRESS
PUSHJ P,DOPHYS ; EXECUTE .+1 WITH/WITHOUT UU.PHY
PATH. T2, ; GET PATH FOR THIS NAME
JRST T1POPJ ; NONE, RETURN .FPNON
MOVE T2,.PTSWT(T1) ; GET SWITCHES FOR THIS ONE
TXNN T2,PT.IPP ; DEVICE HAVE AN IMPLIED PPN?
JRST T1POPJ ; NO, RETURN .FPNON
AOS (P) ; YES, MAKE IT .FPIPP
MOVE T3,.FXMOD(P1) ; GET FLAG BITS FOR THIS SCAN BLOCK
TXNN T3,FX.PHY ; IF /PHYSICAL
TXNN T2,PT.DLN ; OR THIS IS NOT A LOGICAL NAME,
JRST T1POPJ ; RETURN .FPIPP
SKIPE T1,LNMPTR ; ALREADY HAVE SPACE FOR A LOGICAL NAME?
JRST FNDPT2 ; YES
MOVX T1,.PTLLB ; AMOUNT OF SPACE WE NEED
PUSHJ P,GETCOR ; GET THAT MUCH
JRST E$$NEC ; NO CORE!!
MOVEM T1,LNMPTR ; SAVE FOR NEXT (MAYBE) CALL
FNDPT2: MOVE T2,.FXDEV(P1) ; GET LOGICAL NAME TO READ
MOVEM T2,.PTLNM(T1) ; STORE IN BLOCK
MOVX T2,PT.RCN ; GET "READ CURRENT NAME" BIT
MOVEM T2,.PTLNF(T1) ; STORE IN BLOCK
MOVX T2,.PTFRN ; GET FUNCTION TO READ LOGICAL NAMES
MOVEM T2,.PTFCN(T1) ; STORE IN BLOCK
HRLI T1,.PTLLB ; MAKE IT LEN,,ADRESS
PATH. T1, ; READ THE LOGICAL NAME
JRST T1POPJ ; CAN'T???...RETURN .FPIPP
AOS (P) ; MAKE RETURN VALUE .FPLNM
T1POPJ: POP P,T1 ; RETURN VALUE IN T1 AS ADVERTISED
POPJ P, ; AND RETURN
;Routine to read the current job search list.
;The call is:
;
; PUSHJ P,GETJSL
; <return here if we can't read it>
; <return here if all OK with $SLCCT and $SLCPT OF JSLBLK setup>
;
;Note that this routine does not return a block that has the proper
;header words that will allow a STRUUO to be done directly.
GETJSL: TRACE$ GETJSL ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE1## ; SAVE P1
MOVE T1,JSLBLK+$SLMAX ; GET MAX NUMBER OF STRS IN JSL
IMULI T1,.DFJBL ; TIMES WORDS/BLOCK
PUSHJ P,GETCOR ; GET ENOUGH CORE
JRST E$$NEC ; NO CORE, DIE
MOVEM T1,JSLBLK+$SLCPT ; SAVE POINTER TO BLOCK
MOVEI P1,(T1) ; POINT TO FIRST STR BLOCK
SETOM SLBLK+.DFJNM ; SET NAME TO -1 TO GET FIRST STR
GETJS1: MOVX T2,<.DFJST+1,,SLBLK> ; POINT TO JOBSTR BLOCK
JOBSTR T2, ; GET NEXT STR IN SL
WARN RJS,<Can't read job search list>,,.POPJ##
SKIPN T2,SLBLK+.DFJNM ; STOP ON THE FENCE
JRST .POPJ1##
AOJE T2,.POPJ1## ; OR ON END OF LIST
MOVSI T2,SLBLK+.DFJNM ; GET SOURCE ADDRESS
HRRI T2,(P1) ; AND DESTINATION ADDRESS
BLT T2,.DFJBL-1(P1) ; MOVE TO STRUUO BLOCK
AOS JSLBLK+$SLCCT ; BUMP STR COUNT
ADDI P1,.DFJBL ; BUMP STRUUO POINTER
JRST GETJS1 ; AND LOOP FOR MORE
;Routine to read the current system search list.
;The call is:
;
; PUSHJ P,GETSSL
; <return here if we can't read it>
; <return here if all OK with $SLCCT and $SLCPT of SSLBLK setup>
;
;Note that this routine does not return a block that has the proper
;header words that will allow a STRUUO to be done directly.
GETSSL: TRACE$ GETSSL ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE1## ; SAVE P1
MOVE T1,SSLBLK+$SLMAX ; GET MAX NUMBER OF STRS IN SSL
IMULI T1,.DFJBL ; TIMES WORDS/BLOCK
PUSHJ P,GETCOR ; GET ENOUGH CORE
JRST E$$NEC ; NO CORE, DIE
MOVEM T1,SSLBLK+$SLCPT ; SAVE POINTER TO BLOCK
MOVEI P1,(T1) ; POINT TO FIRST STR BLOCK
SETOM SLBLK+.DFGNM ; SET NAME TO -1 TO GET FIRST STR
GETSS1: MOVX T2,<.DFGST+1,,SLBLK> ; POINT TO GOBSTR BLOCK
GOBSTR T2, ; GET NEXT STR IN SL
WARN RSS,<Can't read system search list>,,.POPJ##
SKIPN T2,SLBLK+.DFGNM ; STOP ON THE FENCE
JRST .POPJ1##
AOJE T2,.POPJ1## ; OR ON END OF LIST
MOVSI T2,SLBLK+.DFGNM ; GET SOURCE ADDRESS
HRRI T2,(P1) ; AND DESTINATION ADDRESS
BLT T2,.DFJBL-1(P1) ; MOVE TO STRUUO BLOCK
AOS SSLBLK+$SLCCT ; BUMP STR COUNT
ADDI P1,.DFJBL ; BUMP STRUUO POINTER
JRST GETSS1 ; AND LOOP FOR MORE
SUBTTL Routines that interface with SCAN
;Routine to allocate space for an input scan block for SCAN.
;The call is:
;
; PUSHJ P,ALCINP
; <always return here>
;
;Returns T1 = Address of scan block
; T2 = Length of scan block
ALCINP: TRACE$ ALCINP ; TYPE DEBUGGING INFO
MOVX T1,$FXLEN ; GET LENGTH OF A SCAN BLOCK
PUSHJ P,GETCOR ; GET THAT MUCH
JRST E$$NEC ; NO CORE, DIE
SKIPN SCNIFS ; THIS THE FIRST INPUT SPEC
MOVEM T1,SCNIFS ; YES, SAVE THE ADDRESS
SKIPE T2,SCNILS ; IF THERE WAS A PREVIOUS BLOCK,
HRRZM T1,$FXLNK(T2) ; STORE CURRENT ADDR IN LINK OF LAST
MOVEM T1,SCNILS ; SAVE AS LAST ONE ALSO
MOVX T2,<F.BGN,,0> ; GET SOURCE OF FILE SWITCHES
HRRI T2,.FXLEN(T1) ; AND DESTINATION IN SCAN BLOCK
BLT T2,$FXLLS(T1) ; MOVE THEM TO THE SCAN BLOCK
MOVX T2,$FXLEN ; RETURN LENGTH TO SCAN
POPJ P, ; AND RETURN
;Routine to allocate space for an output scan block for SCAN.
;The call is:
;
; PUSHJ P,ALCOUT
; <always return here>
;
;Returns T1 = Address of scan block
; T2 = Length of scan block
ALCOUT: TRACE$ ALCOUT ; TYPE DEBUGGING INFO
MOVX T1,$FXLEN ; GET LENGTH OF SCAN BLOCK
PUSHJ P,GETCOR ; GET THAT MUCH CORE
JRST E$$NEC ; NO CORE, DIE
SKIPN SCNOFS ; THIS THE FIRST BLOCK ALLOCATED
MOVEM T1,SCNOFS ; YES, SAVE THE ADDRESS
SKIPE T2,SCNOLS ; IF THERE WAS A PREVIOUS BLOCK,
HRRZM T1,$FXLNK(T2) ; STORE CURRENT ADDR IN LINK OF LAST
MOVEM T1,SCNOLS ; SAVE AS LAST ADDRESS ALSO
MOVX T2,<F.BGN,,0> ; GET SOURCE OF FILE SWITCHES
HRRI T2,.FXLEN(T1) ; AND DESTINATION IN SCAN BLOCK
BLT T2,$FXLLS(T1) ; MOVE THEM TO THE SCAN BLOCK
MOVX T2,$FXLEN ; RETURN LENGTH FOR SCAN
POPJ P, ; AND RETURN
E$$NEC: ERROR NEC,<Not enough core>,STOP
;Routine to memorize sticky defaults. These defaults are stored in the
;area starting at P.BGN.
;The call is:
;
; PUSHJ P,MEMSTK
; <return here always>
;
;Returns after saving sticky defaults starting at P.BGN
MEMSTK: TRACE$ MEMSTK ; TYPE DEBUGGING INFO
MOVSI T1,-F.LEN ; BUILD AOBJN POINTER TO SWITCH AREA
MEMST1: SETCM T2,F.BGN(T1) ; GET NEXT SWITCH
JUMPE T2,MEMST2 ; SKIP IF NONE SPECIFIED
SETCAM T2,P.BGN(T1) ; STORE IN STICKY DEFAULT AREA
MEMST2: AOBJN T1,MEMST1 ; LOOP FOR ALL SWITCHES
POPJ P, ; AND RETURN
;Routine to apply sticky defaults. These defaults are stored starting
;at P.BGN and transferred to the area starting at F.BGN if and only if
;the local switch is not specified and the sticky default was specified.
;The call is:
;
; PUSHJ P,APLSTK
; <return here always>
APLSTK: TRACE$ APLSTK ; TYPE DEBUGGING INFO
MOVSI T1,-F.LEN ; BUILD AOBJN POINTER TO SWITCHES
APLST1: SETCM T2,F.BGN(T1) ; GET VALUE OF NEXT SWITCH
JUMPN T2,APLST2 ; DON'T DEFAULT IF SPECIFIED
SETCM T2,P.BGN(T1) ; GET STICKY DEFAULT
JUMPE T2,APLST2 ; SKIP IF NO STICKY DEFAULT
SETCAM T2,F.BGN(T1) ; DEFAULT THE SWITCH
APLST2: AOBJN T1,APLST1 ; LOOP FOR ALL SWITCHES
POPJ P, ; AND RETURN
;Routine to apply the SWITCH.INI defaults to the scan block. The words
;in the scan block are defaulted if and only if the current value is
;unspecified and the sticky default was specified.
;The call is:
;
; MOVEI P1,address of scan block
; PUSHJ P,MOVSTK
; <return here always>
MOVSTK: TRACE$ MOVSTK ; TYPE DEBUGGING INFO
MOVSI T1,-F.LEN ; BUILD AOBJN POINTER TO SWITCHES
MOVE T2,P1 ; COPY SCAN BLOCK ADDRESS
MOVST1: SETCM T3,.FXLEN(T2) ; GET NEXT SWITCH FROM SCAN BLOCK
JUMPN T3,MOVST2 ; DON'T DO THIS ONE IF IT IS SPECIFIED
SETCM T3,P.BGN(T1) ; GET STICKY DEFAULT
JUMPE T3,MOVST2 ; DON'T DO IT IF NOT SPECIFIED
SETCAM T3,.FXLEN(T2) ; STORE STICKY DEFAULT IN BLOCK
MOVST2: AOS T2 ; BUMP SCAN BLOCK POINTER
AOBJN T1,MOVST1 ; AND LOOP FOR ALL SWICHES
POPJ P, ; RETURN WHEN DONE
;Routine to clear the sticky default area starting at P.BGN.
;The call is:
;
; PUSHJ P,CLRSTK
; <always return here>
CLRSTK: TRACE$ CLRSTK ; TYPE DEBUGGING INFO
STORE T1,P.BGN,P.END,-1 ; CLEAR ALL STICKY DEFAULTS
POPJ P, ; AND RETURN
;Routine to clear the file specific switch area starting at F.BGN
;The call is:
;
; PUSHJ P,CLRFIL
; <always return here>
CLRFIL: TRACE$ CLRFIL ; TYPE DEBUGGING INFO
STORE T1,F.BGN,F.END,-1 ; CLEAR THE SWITCH AREA
POPJ P, ; AND RETURN
;Routine to clear all switch areas.
;The call is:
;
; PUSHJ P,CLRALL
; <always return here>
CLRALL: TRACE$ CLRALL ; TYPE DEBUGGING INFO
STORE T1,SW.BGN,SW.END,-1
POPJ P,
;Common routines to process all search list switches. SCAN calls the
;switch specific routine preceding the search list block when one of
;these switches is seen and that routine in turn calls us.
;The calls are of the form:
;
; MOVEI T1,address of switch block
; PUSHJ P,?SLSWT
; <never return here>
; <always return here to prevent SCAN from storing value>
JSLSWT: TXOA F,FL.JLS ; SET JSL SWITCH SEEN FLAG
SSLSWT: TXO F,FL.SLS ; SET SSL SWITCH SEEN FLAG
SKIPA N,[JSLBLK] ; GET POINTER TO JSL PARAMETER BLOCK
MOVEI N,SSLBLK ; DITTO FOR SYSTEM SEARCH LIST
TRACE$ XSLSWT,T1 ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE2## ; SAVE P1-P2
PUSHJ P,.PSH4T## ; SAVE T1-T4
MOVEI P1,(T1) ; SAVE SWITCH BLOCK ADDRESS IN P1
MOVEI P2,(N) ; SAVE SL PARAMETER BLOCK ADDRESS IN P2
MOVEI T4,0 ; START WITH NO MODIFIER BITS
PUSHJ P,.SIXSW## ; GET STRUCTURE NAME
JUMPN N,XSLSW1 ; GO IF WE GOT A STR NAME
CAIE C,"*" ; USER WANT ALL STRS IN CURRENT SL?
JRST E$$NSI ; NO, NULL STR IS AN ERROR
MOVX N,SIXBIT/*/ ; RETURN SIXBIT STAR AS STR NAME
PUSHJ P,.TIALT## ; FLUSH THE STAR
XSLSW1: PUSH P,N ; SAVE THE STR NAME FOR LATER
XSLSW2: CAIE C,":" ; STR TERMINATED BY A COLON?
JRST XSLSW3 ; NO, CAN'T BE ANY MODIFIERS
PUSHJ P,.SIXSW## ; TRY TO GET A MODIFIER
SKIPN T2,N ; FIND ONE?
JRST XSLSW3 ; NO, MUST BE STR:,STR:,...
PUSH P,T4 ; SAVE MODIFIER BITS
MOVE T1,[IOWD SLNTBL,SLNTAB] ; IOWD TO MODIFIER TABLE
PUSHJ P,.LKNAM## ; LOOKUP NAME IN TABLE
JRST XSLSW4 ; NOT FOUND, GIVE ERROR MESSAGE
POP P,T4 ; RESTORE MODIFER BITS
MOVEI T1,-SLNTAB(T1) ; COMPUTE OFFSET IN TABLE
TSZ T4,SLITAB(T1) ; CLEAR BIT IN P2 SPECIFIED BY FLAG
TDO T4,SLITAB(T1) ; NOW SET ANY BITS NECESSARY
JRST XSLSW2 ; AND LOOP FOR NEXT
XSLSW3: POP P,N ; RESTORE STR NAME
PUSHJ P,STOXSL ; STORE NAME AND BITS
JRST E$$TMS ; BLOCK OVERFLOW
PUSHJ P,.POP4T## ; RESTORE T1-T4
PJRST .POPJ1## ; GIVE SKIP RETURN
XSLSW4: SKIPGE T1 ; T1 .GE. 0 IF AMBIGUOUS MODIFIER
ERROR USM,<Unknown structure modifier >,NOCRLF,XSLSW5
ERROR ASM,<Ambiguous structure modifier >,NOCRLF
XSLSW5: MOVE T1,N ; GET BAD MODIFIER
PUSHJ P,TYPNAM ; TYPE THE NAME IN SIXBIT
PJRST PTHSCN ; AND GIVE UP
E$$NSI: ERROR NSI,<Null structure illegal in search list switch>,,PTHSCN
E$$TMS: ERROR TMS,<Too many structures specified in search list switch>,,PTHSCN
;Routine to store a structure name and modifier bits in the next
;available slot in the block for a search list switch.
;The call is:
;
; MOVE N,str name to store
; MOVEI P1,address of switch block (XXXBLK)
; MOVEI P2,address of SL parameter block
; MOVEI T4,Bits (NOWRITE, NOCREATE,...)
; PUSHJ P,STOXSL
; <return here if block overflowed>
; <return here if all ok with name stored>
STOXSL: TRACE$ STOXSL,<N,T4,P1,P2> ; TYPE DEBUGGING INFO
SKIPE T2,$SLSAB(P1) ; ALREADY HAVE A BLOCK?
JRST STOXS1 ; YES
MOVE T1,$SLMAX(P2) ; MAX NUMBER OF STRS IN SEARCH LIST
MOVEI T2,0 ; NO HEADER WORDS NECESSARY
PUSHJ P,BLDAOB ; ALLOCATE THE CORE AND RETURN AOBJP PTR
MOVEM T1,$SLSPT(P1) ; SAVE STARTING ADDRESS OF BLOCK
STOXS1: ADDX T2,.DFJBL-1 ; INCREMENT TO NEXT BLOCK-1
AOBJP T2,.POPJ## ; PLUS ONE MORE IF NO OVERFLOW
MOVEM T2,$SLSAB(P1) ; SAVE NEW AOBJP POINTER FOR NEXT TIME
MOVEM N,.DFJNM(T2) ; SAVE STR NAME IN BLOCK
CAXN N,SIXBIT/*/ ; USER SPECIFY ALL STRUCTURES?/
TXO T4,SL.WLD ; YES, SET WILD STR FLAG
MOVEM T4,.DFJST(T2) ; PLUS MODIFIER BITS
AOS $SLSCT(P1) ; BUMP STR COUNT
PJRST .POPJ1## ; GIVE SKIP RETURN
;Routine to allocate and build an AOBJP pointer to a block of core for
;a search list switch.
;The call is:
;
; MOVEI T1,number of STR blocks needed
; MOVEI T2,number of header words
; PUSHJ P,BLDAOB
; <always return here>
;
;Returns T1=address of first STR in block
; T2=AOBJP pointer to first STR block
BLDAOB: TRACE$ BLDAOB,<T1,T2> ; TYPE DEBUGGING INFO
MOVNI T3,(T1) ; SAVE -VE BLOCK COUNT FOR LATER
IMULI T1,.DFJBL ; TIMES WORDS PER BLOCK
ADDI T1,(T2) ; PLUS NUMBER OF HEADER WORDS
PUSHJ P,GETCOR ; ALLOCATE THAT MUCH CORE
PJRST E$$NEC ; FAILED, DIE
ADDI T1,(T2) ; POINT TO FIRST STR IN BLOCK
MOVEI T2,-.DFJBL(T1) ; BUILD RH OF AOBJP POINTER
HRLI T2,-1(T3) ; PLUS -<CNT+1> TO LH
POPJ P, ; RETURN
;Routine to print the prompt character on the TTY.
;The call is:
;
; MOVX T1,prompt character or -1 for continuation
; PUSHJ P,PROMPT ; From SCAN's prompt routine
; <always return here>
PROMPT: TRACE$ PROMPT,T1 ; TYPE DEBUGGING INFO
SKPINL ; DEFEAT ^O
JFCL ; DON'T CARE ABOUT RETURN
SKIPGE T1 ; CONTINUATION?
MOVX T1,"#" ; YES, USE A "#"
PUSHJ P,W.TTY ; WRITE IT OUT
OUTPUT TTY, ; MAKE SURE HE SEES IT
POPJ P, ; AND RETURN
;Routine to close and release the TTY channel when we exit.
;The call is:
;
; PUSHJ P,XITCLS ; From SCAN's exit routine
; <always return here>
XITCLS: TRACE$ XITCLS,F ; TYPE DEBUGGING INFO
TXNE F,FL.TOF ; TTY OPEN SUCCEED?
PJRST .MNRET## ; NO, JUST RETURN
CLOSE TTY, ; CLOSE THE TTY
RELEAS TTY, ; AND RELEASE THE CHANNEL
PUSHJ P,.MNRET## ; RETURN TO SCAN
PJRST PATH ; START OVER IF CONTINUE
;Routine to output one character to the TTY. Flushes the buffer on a
;control character.
;The call is:
;
; MOVX T1,character
; PUSHJ P,W.TTY
; <always return here>
W.TTY: SOSG TOBUF+.BFCTR ; ANY ROOM LEFT IN THE BUFFER
OUTPUT TTY, ; NO, FLUSH THE BUFFER
IDPB T1,TOBUF+.BFPTR ; STORE THE CHARACTER IN THE BUFFER
PUSH P,T2 ; GET A REGISTER TO USE
MOVEI T2,1 ; GET A BIT TO SHIFT
LSH T2,(T1) ; SHIFT 1B35 BY VALUE OF CHARACTER
TDNE T2,BRKTBL ; IS THIS A BREAK CHARACTER?
OUTPUT TTY, ; YES, FLUSH THE BUFFER
POP P,T2 ; RESTORE T2
POPJ P, ; AND RETURN
SUBTTL Search list setup routines
;Routine to initialize the static data in the search list switch
;blocks.
;The call is:
;
; PUSHJ P,INISLB
; <always return here>
INISLB: TRACE$ INISLB ;TYPE DEBUGGING INFO
MOVE T1,[PJSP T1,JSLSWT] ; GET INSTRUCTION TO STORE
MOVE T2,JSBPTR ; GET AOBJN POINTER TO TABLE
INISL1: HRRZ T3,0(T2) ; GET ADDRESS OF NEXT BLOCK
MOVEM T1,$SLJSP(T3) ; SAVE INSTRUCTION
AOBJN T2,INISL1 ; LOOP FOR ALL BLOCKS
HRRI T1,SSLSWT ; NOW DO THE SAME FOR THE SYS SL
MOVE T2,SSBPTR ; GET AOBJN POINTER
INISL2: HRRZ T3,0(T2) ; GET ADDRESS OF NEXT BLOCK
MOVEM T1,$SLJSP(T3) ; SAVE INSTRUCTION
AOBJN T2,INISL2 ; LOOP FOR ALL
MOVE T1,XSLMAX ; GET MAX SSL STRS,,MAX JSL STRS
HLRZM T1,SSLBLK+$SLMAX ; SAVE SSL MAX
HRRZM T1,JSLBLK+$SLMAX ; AND JSL MAX
POPJ P, ; RETURN
;Routine to call the search list processing routine for each search list
;block that has a non-zero STR count.
;The call is:
;
; MOVEI P2,address of search list parameter block
; MOVE P3,AOBJN pointer to block address table
; PUSHJ P,CHKSLB
; <always return here>
CHKSLB: TRACE$ CHKSLB,<P2,P3> ; TYPE DEBUGGING INFO
CHKSL1: HRRZ P1,0(P3) ; GET ADDRESS OF NEXT SWITCH BLOCK
HLRZ T1,0(P3) ; AND ADDRESS OF PROCESSING ROUTINE
SKIPE $SLSCT(P1) ; THIS BLOCK HAVE A NON-ZERO COUNT?
PUSHJ P,(T1) ; YES, CALL ROUTINE
AOBJN P3,CHKSL1 ; LOOP FOR ALL BLOCKS
POPJ P, ; RETURN
;Routine to build a new job/system search list from the block built for
;the /CREATE or /SCREATE switches.
;The call is:
;
; MOVEI P1,address of switch block (XXXBLK)
; MOVEI P2,address of SL parameter block
; PUSHJ P,CHKCRX
; <always return here>
CHKCRX: TRACE$ CHKCRX,<P1,P2> ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE4## ; SAVE P1-P4
MOVN P4,$SLNCT(P2) ; GET -COUNT IN ORIGINAL BLOCK (PROBABLY 0)
MOVEI P3,0 ; INDICATE FIRST CALL FOR GTNSTR
CHKCR1: PUSHJ P,GTNSTR ; GET NEXT STR
JRST [MOVSI T1,(P4) ; -COUNT TO LH OF T1
HRR T1,$SLNPT(P2) ; MAKE AOBJN POINTER TO BLOCK
PJRST ZROCMP ; COMPRESS ANY ZERO ENTRIES
]
PUSHJ P,CHKSTR ; MAKE SURE WE CAN ADD IT
JRST CHKCR1 ; CAN'T, IGNORE IT
MOVSI T3,(P4) ; GET -COUNT OF STRS IN TOTAL BLOCK
HRR T3,$SLNPT(P2) ; MAKE AN AOBJN POINTER TO BLOCK
CHKCR2: CAME T1,.DFJNM(T3) ; ALREADY THERE?
JRST CHKCR4 ; NO, CONTINUE
HRRZ T4,.DFJST(T3) ; GET SL.WLD FOR OTHER STR
XORI T4,(T2) ; XOR WITH SL.WLD FOR NEW STR
TXNN T4,SL.WLD ; ILLEGAL IF BOTH ON OR BOTH OFF
PUSHJ P,E$$DPS ; SO TELL HIM
AND T4,.DFJST(T3) ; NOW AND WITH OLD STR BIT
TXNN T4,SL.WLD ; IF SET, CLEAR OLD AND ADD THIS ONE
JRST CHKCR1 ; SINCE OTHER ONE WAS WILD
SETZM .DFJNM(T3) ; PREVIOUS ONE WAS WILD, DELETE NAME
SOS $SLNCT(P2) ; AND DECREMENT STR COUNT
CHKCR4: ADDX T3,.DFJBL-1 ; INCREMENT TO NEXT BLOCK-1
AOBJN T3,CHKCR2 ; LOOP FOR ALL
PUSHJ P,STOSTR ; STORE IN NEXT SLOT IN NEW BLOCK
SUBI P4,1 ; DECREMENT -BLOCK COUNT
JRST CHKCR1 ; LOOP FOR NEXT
;Routine to add any new structures to the job/system search list as
;specified by the /ADD or /SADD switches.
;The call is:
;
; MOVEI P1,address of switch block (XXXBLK)
; MOVEI P2,address of SL parameter block
; PUSHJ P,CHKADX
; <always return here>
CHKADX: TRACE$ CHKADX,<P1,P2> ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE3## ; SAVE P1-P3
TXON F,FL.CSL ; ALREADY HAVE A NEW SEARCH LIST?
PUSHJ P,MOVCSL ; NO, MOVE CURRENT SL TO NEW BLOCK
MOVEI P3,0 ; INDICATE FIRST CALL TO GTNSTR
CHKAD1: PUSHJ P,GTNSTR ; GET NEXT STR IN LIST
POPJ P, ; NONE LEFT, RETURN
PUSHJ P,CHKSTR ; CHECK TO MAKE SURE WE CAN ADD IT
JRST CHKAD1 ; CAN'T, IGNORE IT
MOVN T3,$SLNCT(P2) ; GET CURRENT COUNT STRS IN SL
MOVSI T3,(T3) ; MOVE TO LH
HRR T3,$SLNPT(P2) ; MAKE AN AOBJN POINTER TO THAT
CHKAD2: CAMN T1,.DFJNM(T3) ; SAME AS THE ONE HE WANTS TO ADD?
JRST [PUSHJ P,E$$DPS ;TELL USER OF ERROR
JRST CHKAD1 ; AND IGNORE IT
]
ADDX T3,.DFJBL-1 ; BUMP BY ONE LESS THAN THE BLOCK LENGTH
AOBJN T3,CHKAD2 ; LOOP FOR NEXT EXISTING STR
PUSHJ P,STOSTR ; STORE IN NEXT SLOT IN NEW BLOCK
JRST CHKAD1 ; LOOP FOR NEXT
E$$DPS: WARN DPS,<Duplicate structure >,NOCRLF
PJRST TYPSTR
;Routine to remove any structures from the job/system search list as
;specified by the /REMOVE or /SREMOVE switches.
;The call is:
;
; MOVEI P1,address of switch block (XXXBLK)
; MOVEI P2,address of SL parameter block
; PUSHJ P,CHKRMX
; <always return here>
CHKRMX: TRACE$ CHKRMX,<P1,P2> ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE4## ; SAVE P1-P4
TXON F,FL.CSL ; ALREADY HAVE A NEW SEARCH LIST?
PUSHJ P,MOVCSL ; NO, MOVE CURRENT SEARCH LIST TO NEW BLK
MOVN P4,$SLNCT(P2) ; GET -COUNT OF STRS IN NEW SL
MOVSI P4,(P4) ; MOVE TO LH
HRR P4,$SLNPT(P2) ; MAKE IN AN AOBJN POINTER
PUSH P,P4 ; SAVE FOR LOOP
MOVEI P3,0 ; INDICATE FIRST CALL TO GTNSTR
CHKRM1: PUSHJ P,GTNSTR ; GET NEXT STR IN LIST
JRST [POP P,T1 ; GET BACK ADDRESS OF BLOCK
PJRST ZROCMP ; COMPRESS ZERO ENTRIES AND RETURN
]
PUSHJ P,CHKSTR ; MAKE SURE IT'S OK
JRST CHKRM1 ; NOT, SO IGNORE IT
MOVE P4,(P) ; REFRESH POINTER TO EXISTING LIST
CHKRM2: CAMN T1,.DFJNM(P4) ; SAME AS THIS ONE IN EXISTING LIST?
JRST [SETZM .DFJNM(P4) ; YES, ZAP THE NAME
SOS $SLNCT(P2) ; AND DECREMENT THE STR COUNT
MOVE T1,$SLNAB(P2) ; GET AOBJP POINTER FROM BLOCK
SUB T1,[1,,.DFJBL] ; BACKUP POINTER TO FIRST FREE SLOT
MOVEM T1,$SLNAB(P2) ; STORE BACK IN BLOCK
JRST CHKRM1 ; CONTINUE WITH THE NEXT
]
ADDX P4,.DFJBL-1 ; BUMP EXISTING LIST POINTER
AOBJN P4,CHKRM2 ; AND LOOP FOR ALL
PUSHJ P,E$$SNS ; NOT THERE, TELL HIM
JRST CHKRM1 ; LOOP FOR NEXT
E$$SNS: WARN SNS,<Structure not in search list >,NOCRLF
PJRST TYPSTR ; TELL OF HIS ERROR
;Routine to modify any structures in the job/system search list as
;specified by the /MODIFY or /SMODIFY switches.
;The call is:
;
; MOVEI P1,address of switch block
; MOVEI P2,address of SL parameter block
; PUSHJ P,CHKMDX
; <always return here>
CHKMDX: TRACE$ CHKMDX,<P1,P2> ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE4## ; SAVE P1-P4
TXON F,FL.CSL ; ALREADY HAVE A NEW SEARCH LIST?
PUSHJ P,MOVCSL ; NO, MOVE CURRENT SEARCH LIST
MOVN P4,$SLNCT(P2) ; GET -COUNT OF STRS IN NEW SL
MOVSI P4,(P4) ; MOVE TO LH
HRR P4,$SLNPT(P2) ; MAKE AN AOBJN POINTER
PUSH P,P4 ; SAVE FOR LOOP
MOVEI P3,0 ; INDICATE FIRST CALL TO GTNSTR
CHKMD1: PUSHJ P,GTNSTR ; GET NEXT STR
JRST T1POPJ ; FLUSH STACK AND RETURN
TXNN T2,SL.WLD ; THIS A WILD STR?
JRST CHKMD3 ; NO, CONTINUE
MOVN T3,$SLSCT(P1) ; GET -COUNT OF STRS IN THIS SWITCH
MOVSI T3,(T3) ; MOVE TO LH
HRR T3,$SLSPT(P1) ; MAKE AOBJN POINTER TO SWITCH LIST
CHKMD2: CAMN T1,.DFJNM(T3) ; WILD STR SAME AS EXPLICIT STR IN LIST?
JRST CHKMD1 ; YES, EXPLICIT STR OVERRIDES
ADDX T3,.DFJBL-1 ; INCREMENT TO NEXT BLOCK-1
AOBJN T3,CHKMD2 ; INCREMENT AGAIN AND LOOP
CHKMD3: PUSHJ P,CHKSTR ; MAKE SURE IT'S OK
JRST CHKMD1 ; BAD, IGNORE
MOVE P4,(P) ; REFRESH AOBJN POINTER TO EXISTING SL
CHKMD4: CAMN T1,.DFJNM(P4) ; MATCH WITH THIS ONE?
JRST [HRLZ T1,T2 ; GET VALID BITS FOR THIS STR
ANDCAM T1,.DFJST(P4) ; CLEAR IN THIS ENTRY
HLLZ T1,T2 ; GET BITS SPECIFIED
IORM T1,.DFJST(P4) ; AND SET IN THIS ENTRY
JRST CHKMD1 ; LOOP FOR NEXT
]
ADDX P4,.DFJBL-1 ; INCREMENT TO NEXT BLOCK-1
AOBJN P4,CHKMD4 ; INCREMENT AND LOOP IF MORE
PUSHJ P,E$$SNS ; NO SUCH STR
JRST CHKMD1 ; LOOP FOR NEXT
;Routine to get the next structure from the switch block being processed.
;If a SIXBIT * is found as a structure name, the users current search
;list is returned, one at a time in place of the *.
;The call is:
;
; MOVEI P1,address of the switch block
; MOVEI P2,address of the SL parameter block
; MOVEI P3,0 on first call, previous value of P3
; on successive calls
; PUSHJ P,GTNSTR
; <return here when list is exhausted>
; <return here with next STR>
;Returns T1=SIXBIT STR name
; T2=corresponding modifier bits
GTNSTR: TRACE$ GTNSTR,<P1,P2,P3> ; TYPE DEBUGGING INFO
JUMPN P3,GTNST1 ; GO IF NOT FIRST CALL
MOVN P3,$SLSCT(P1) ; GET -COUNT OF STRS IN INPUT BLOCK
MOVSI P3,-1(P3) ; MOVE -<CNT+1> TO LH
HRR P3,$SLSPT(P1) ; ADDRESS OF FIRST BLOCK TO RH
SUBI P3,.DFJBL ; MAKE IT AN AOBJN POINTER
GTNST1: ADDX P3,.DFJBL-1 ; INCREMENT TO NEXT BLOCK-1
AOBJP P3,GTNST2 ; GO IF END OF LIST
MOVE T1,.DFJNM(P3) ; GET NEXT STR NAME
SKIPE T2,GTNSAV ; DOING CURRENT SL NOW?
MOVE T2,.DFJST(T2) ; YES, GET MODIFIER BITS FROM *, IF ANY
TRNN T2,-1-SL.WLD ; ANY BUT SL.WLD SET?
IOR T2,.DFJST(P3) ; NO, KEEP BITS FROM EXISTING STRUCTURE
CAXE T1,SIXBIT/*/ ; WANT CURRENT SEARCH LIST?
PJRST .POPJ1## ; NO, JUST RETURN IT
MOVEM P3,GTNSAV ; SAVE CURRENT POINTER
MOVN P3,$SLCCT(P2) ; GET -COUNT OF STRS IN CURRENT SL
MOVSI P3,-1(P3) ; MOVE -<CNT+1> TO LH
HRR P3,$SLCPT(P2) ; POINT TO FIRST STR BLOCK
SUBI P3,.DFJBL ; MAKE IT AN AOBJP POINTER
JRST GTNST1 ; GET NEXT STR FROM CURRENT SL
GTNST2: SKIPN P3,GTNSAV ; DOING CURRENT SL NOW?
POPJ P, ; NO, GIVE END-OF-LIST RETURN
SETZM GTNSAV ; NO LONGER DOING CURRENT SL
JRST GTNST1 ; AND LOOP FOR NEXT
;Routine to move the current search list into the new block being
;built.
;The call is:
;
; MOVEI P2,address of SL parameter block
; PUSHJ P,MOVCSL
; <always return here>
MOVCSL: TRACE$ MOVCSL,P2 ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE3## ; SAVE P1-P3
MOVN P3,$SLCCT(P2) ; GET -COUNT OF STRS IN CURRENT SL
JUMPGE P3,.POPJ## ; DONE IF NONE THERE
MOVSI P3,(P3) ; MOVE TO LH
HRR P3,$SLCPT(P2) ; MAKE AN AOBJN POINTER
MOVCS1: MOVE T1,.DFJNM(P3) ; GET NAME OF NEXT STR
MOVE T2,.DFJST(P3) ; GET MODIFIER BITS
PUSHJ P,STOSTR ; STORE IT IN NEW BLOCK
ADDX P3,.DFJBL-1 ; INCREMENT TO NEXT BLOCK-1
AOBJN P3,MOVCS1 ; INCREMENT TO BLOCK AND LOOP
POPJ P, ; RETURN
;Routine to store a STR name and modifier bits in the next slot of
;the new search list.
;The call is:
;
; MOVE T1,STR name
; MOVE T2,modifier bits
; MOVEI P1,address of switch block
; MOVEI P2,address of SL parameter block
; PUSHJ P,STOSTR
; <always return here>
STOSTR: TRACE$ STOSTR,<T1,T2,P1,P2> ; TYPE DEBUGGING INFO
MOVE T3,$SLNAB(P2) ; GET AOBJP POINTER TO NEW BLOCK
ADDX T3,.DFJBL-1 ; INCREMENT TO NEXT BLOCK-1
AOBJP T3,E$$TMS ; GIVE ERROR IF TOO MANY BLOCKS
MOVEM T3,$SLNAB(P2) ; STORE BACK NEW POINTER
AOS $SLNCT(P2) ; BUMP STR COUNT
MOVEM T1,.DFJNM(T3) ; STORE NAME IN BLOCK
MOVEM T2,.DFJST(T3) ; STORE THOSE ALSO
POPJ P, ; RETURN
;Routine to insure that a structure is available to be added to our
;search list. Handles conversion to real structure name.
;The call is:
;
; MOVE T1,name of structure to check
; PUSHJ P,CHKSTR
; <return here if not available with message typed>
; <return here if available to be added>
;
;Uses only T1
;Returns T1=Real name of structure
CHKSTR: TRACE$ CHKSTR,T1 ; TYPE DEBUGGING INFO
PUSHJ P,.SAVE1## ; GET A REGISTER TO USE
MOVE P1,T1 ; SAVE THE STRUCTURE NAME
MOVEM P1,DSCBLK+.DCNAM ; PUT NAME INTO DSKCHR BLOCK
DEVCHR T1, ; GET THE DEVICE CHARACTERISTICS
TXNN T1,DV.DSK ; MUST BE A DISK
JRST CHKST2 ; NO, GO BITCH
TXNN T1,DV.AVL ; AND AVAILABLE TO OUR JOB
WARN SNA,<Structure not available >,NOCRLF,TYPSTR
MOVX T1,<.DCSAJ+1,,DSCBLK> ; POINT TO BLOCK
DSKCHR T1, ; GET DISK CHARACTERISTICS
JRST CHKST2 ; FAILED, GO BITCH
TXNE T1,DC.NNA ; NO NEW ACCESSES?
WARN NNA,<No new access allowed for structure >,NOCRLF,TYPSTR
TXNE T1,DC.STS ; PACK MOUNTED?
WARN UST,<Unusable structure >,NOCRLF,TYPSTR
SKIPLE T1,DSCBLK+.DCSAJ ; SINGLE ACCESS?
JRST [CAME T1,MYJOB ; YES, BY MY JOB?
WARN SAS,<Single access structure >,NOCRLF,TYPSTR
JRST .+1 ; YES, CONTINUE
]
CAMN P1,DSCBLK+.DCSNM ; THIS THE REAL STRUCTURE NAME?
JRST CHKST1 ; YES
TELL RST,< >,NOCRLF
MOVE T1,P1 ; GET NAME HE TYPED
PUSH P,T2 ; SAVE T2 ACROSS CALLS
PUSHJ P,.TSIXN## ; TYPE IN SIXBIT
MOVEI T1,[ASCIZ/ represents structure /]
PUSHJ P,.TSTRG## ; TYPE THE STRING
MOVE T1,DSCBLK+.DCSNM ; GET THE REAL NAME
PUSHJ P,.TSIXN## ; TYPE IT IN SIXBIT
MOVEI T1,[ASCIZ/]
/]
PUSHJ P,.TSTRG ; END THE LINE
POP P,T2 ; RESTORE T2
CHKST1: MOVE T1,DSCBLK+.DCSNM ; GET THE REAL NAME TO RETURN
PJRST .POPJ1## ; AND RETURN SUCCESS
CHKST2: WARN UDF,<Undefined structure >,NOCRLF,TYPSTR
SUBTTL Miscellaneous routines
;Routine to allocate a block of core.
;The call is:
;
; MOVEI T1,number of words needed
; PUSHJ P,GETCOR
; <return here if no core available>
; <return here if core allocated>
;
; Returns T1 = Address of the start of the block
GETCOR: TRACE$ GETCOR,<T1,.JBFF,.JBREL> ; TYPE DEBUGGING INFO
PUSH P,.JBFF ; SAVE CURRENT VALUE OF .JBFF
ADDB T1,.JBFF ; BUMP BY LENGTH OF REQUESTED BLOCK
CAMG T1,.JBREL ; > THAN WHAT WE HAVE?
JRST GETCO1 ; NO, GO ZERO THE BLOCK
CORE T1, ; REQUEST THE ADDITIONAL CORE
JRST [POP P,.JBFF ; CAN'T GET IT, RESTORE .JBFF
POPJ P, ; AND RETURN ERROR
]
GETCO1: SETZM @(P) ; ZERO FIRST WORD OF BLOCK
HRRZ T1,(P) ; GET ADDRESS OF FIRST WORD OF BLOCK
HRLI T1,1(T1) ; MAKE IT ADDR+1,,ADDR
MOVSS T1 ; BLT POINTER IS ADDR,,ADDR+1
BLT T1,@.JBFF ; BLT THROUGH CURRENT VALUE OF .JBFF
POP P,T1 ; RETURN ADDRESS TO USER
JRST .POPJ1## ; RETURN SUCCESS
;Routine to execute an instruction with or without UU.PHY depending
;on the state of FX.PHY in the current scan block.
;The call is:
;
; MOVEI P1,Address of current scan block
; PUSHJ P,DOPHYS
; Instruction to execute
; <Return here if instruction did not skip>
; <Return here if instruction skipped>
;Uses T3 and T4
DOPHYS: TRACE$ DOPHYS,P1 ; TYPE DEBUG INFO
MOVE T3,@0(P) ; GET INSTRUCTION TO EXECUTE
MOVE T4,.FXMOD(P1) ; GET FLAG BITS FROM SCAN BLOCK
TXNE T4,FX.PHY ; /PHYSICAL SET?
TXO T3,UU.PHY ; YES, SET PHYSICAL ONLY IN UUO
XCT T3 ; DO THE UUO
CAIA ; PROPAGATE NON-SKIP
AOS 0(P) ; INCREMENT RETURN
JRST .POPJ1## ; RETURN SKIP/NON-SKIP (AFTER INSTRUCTION)
;Routine to check for wildcards in a directory. Handles [-] correctly.
;[,] case must be handled by caller.
;The call is:
;
; MOVEI P1,Address of scan block to check
; PUSHJ P,CHKWLD
; <return here if wildcards found in directory>
; <return here if none found>
CHKWLD: TRACE$ CHKWLD,P1 ; TYPE DEBUG INFO
MOVX T1,FX.DIR ; GET "DIRECTORY SPECIFIED" BIT
TDNN T1,.FXMOD(P1) ; [-]?
JRST [AOS (P) ; YES, GIVE SKIP RETURN
PJRST SUBCDP ; AND GO HANDLE THAT CASE
]
SETCM T1,.FXDIM(P1) ; GET MASK FOR PPN
JUMPN T1,.POPJ## ; ERROR IF WILDCARDS
MOVEI T1,.FXDIR+2(P1) ; POINT TO START OF SFDS
HRLI T1,-<.FXLND-1> ; MAKE IT AN AOBJN POINTER
CHKWL1: SKIPN (T1) ; SKIP IF NOT END OF LIST
JRST .POPJ1## ; RETURN SUCCESS
SETCM T2,1(T1) ; GET MASK FOR SFD
JUMPN T2,.POPJ## ; WILDCARDS ARE ILLEGAL
ADDI T1,1 ; ADVANCE POINTER BY ONE
AOBJN T1,CHKWL1 ; BUMP AGAIN AND LOOP FOR ALL
JRST .POPJ1## ; RETURN SUCCESS
;Routine to substitute the current default path for the [-] case in the
;scan block.
;The call is:
;
; MOVEI P1,Address of scan block
; PUSHJ P,SUBCDP
; <always return here>
SUBCDP: TRACE$ SUBCDP,P1 ; TYPE DEBUGGING INFO
SETZM .FXDIR(P1) ; CLEAR FIRST WORD OF BLOCK
HRLZI T1,.FXDIR(P1) ; POINT TO FIRST WORD
HRRI T1,.FXDIR+1(P1) ; AND NEXT WORD
BLT T1,.FXDIR+<2*.FXLND>-1(P1) ; CLEAR THE BLOCK
MOVEI T1,.FXDIR(P1) ; POINT TO PLACE TO STORE
MOVEI T2,MYPATH+.PTPPN ; AND PLACE TO GET IT FROM
SUBCD1: SKIPN T3,(T2) ; SKIP IF NOT END OF LIST
POPJ P, ; RETURN WITH PATH SETUP
MOVEM T3,(T1) ; STORE THE NEXT WORD
SETOM 1(T1) ; SET MASK
ADDI T1,2 ; BUMP OUTPUT POINTER
AOJA T2,SUBCD1 ; AND INPUT POINTER AND LOOP
;Routine to setup the logical name flags in the PATH. block.
;Call with PATH. block in PTSLN.
;The call is:
; MOVEI P1,Address of scan block
; PUSHJ P,SETLNF
; <always return here>
SETLNF: TRACE$ SETLNF ; TYPE DEBUGGING INFO
SKIPGE $FXSEA(P1) ; USER TYPE /[NO]SEARCH HERE?
JRST SETLF2 ; NO, CONTINUE ON
PUSHJ P,GETCAP ; GET ADDITIONAL PATH (FOR /LIB)
SKIPE T1,$FXSEA(P1) ; IF /NOSEARCH WAS SPECIFIED
SKIPN PTSAP+.PTPPN ; OR NO /LIB EXISTS,
JRST SETLF1 ; SKIP THE MESSAGE
TELL DOL,<Deleting old-style /LIB definition>
SETZM PTSAP+.PTPPN ; CLEAR THE LIB PPN
SETLF1: DPB T1,[POINTR PTSLN+.PTLNF,PT.SEA] ; STORE THE BIT IN THE SCAN BLOCK
SETLF2: SKIPL T1,$FXOVE(P1) ; USER SAY /[NO]OVERRIDE HERE?
DPB T1,[POINTR PTSLN+.PTLNF,PT.OVR] ; YES, STORE VALUE
POPJ P, ; RETURN
;Routine to move the device and path for a logical name component from
;the current scan block to the PATH. block being built for a logical
;name definition.
;The call is:
;
; MOVEI P1,Address of scan block
; MOVE P2,AOBJP pointer to the PATH. block
; PUSHJ P,INSSCB
; <return here if AOBJP pointer runs out>
; <return here if all OK>
;
;Returns with P2 updated.
;
;Note that this routine is VERY sensitive to the order of the PATH.
;block. If the format changes, this routine must change also.
INSSCB: AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
SETZM (P2) ; CLEAR NODE WORD (.PTNOD)
MOVE T1,.FXDEV(P1) ; GET DEVICE FOR THIS COMPONENT
AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
MOVEM T1,(P2) ; STORE IN PATH. BLOCK (.PTLSL)
MOVE T1,.FXNAM(P1) ; GET FILENAME FOR THIS COMPONENT
AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
MOVEM T1,(P2) ; STORE IN PATH. BLOCK (.PTFIL)
HLLZ T1,.FXEXT(P1) ; GET EXTENSTION FOR THIS COMPONENT
AOBJP P2,.POPJ## ; CHECK AGAIN
MOVEM T1,(P2) ; STORE IN PATH. BLOCK (.PTEXT)
MOVEI T2,.FXDIR(P1) ; POINT TO INPUT BLOCK
HRLI T2,-.FXLND ; MAKE IT AN AOBJN POINTER
INSSC1: MOVE T1,(T2) ; GET NEXT WORD OF PATH
INSSC2: AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
MOVEM T1,(P2) ; STORE IN OUTPUT BLOCK (.PTLPP-.PTLEL)
ADDI T2,1 ; SKIP THE MASK WORD IN THE SCAN BLOCK
JUMPE T1,.POPJ1## ; RETURN AT END OF PATH
AOBJN T2,INSSC1 ; LOOP FOR ALL
MOVEI T1,0 ; GET A ZERO TERMINATOR FOR THE
JRST INSSC2 ; PATH BLOCK AND STORE IT
;Routine to move the device and path for a logical name component from
;the PATH. block returned by FNDPTH to the PATH. block being built for a
;logical name definition.
;The call is:
;
; MOVE P1,Address of scan block
; MOVE P2,AOBJP pointer to output block
; PUSHJ P,INSPTH
; <return here if AOBJP pointer runs out>
; <return here if all OK>
;
;Returns with P2 updated
;
;Note that this routine is VERY sensitive to the order of the PATH.
;block. If the format changes, this routine must change also.
INSPTH: AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
SETZM (P2) ; CLEAR NODE WORD (.PTNOD)
MOVE T1,.FXDEV(P1) ; GET DEVICE NAME HE SPECIFIED
PUSHJ P,DOPHYS ; EXECUTE .+1 WITH/WITHOUT UU.PHY
DEVNAM T1, ; CONVERT TO REAL NAME
MOVE T1,.FXDEV(P1) ; NONE, USE HIS
AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
MOVEM T1,(P2) ; SAVE IN OUTPUT BLOCK (.PTLSL)
MOVE T1,.FXNAM(P1) ; GET FILENAME
AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
MOVEM T1,(P2) ; STORE IN BLOCK (.PTFIL)
HLLZ T1,.FXEXT(P1) ; GET EXTENSION FROM SCAN BLOCK
AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
MOVEM T1,(P2) ; STORE IN BLOCK (.PTEXT)
MOVE T2,PTHPTR ; GET ADDRESS OF INPUT PATH. BLOCK
MOVEI T2,.PTPPN(T2) ; POINT AT INPUT PATH STORAGE
INSPT1: MOVE T1,(T2) ; GET NEXT WORD OF PATH
AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
MOVEM T1,(P2) ; STORE IN OUTPUT BLOCK (.PTLPP-.PTLEL)
JUMPE T1,.POPJ1## ; RETURN AT END OF PATH
AOJA T2,INSPT1 ; BUMP INPUT POINTER AND LOOP
;Routine to move the components of a logical name into the PATH. block
;for a new logical name being built. This is done when the user
;specifies an existing logical name as a component of one being defined.
;The call is:
;
; MOVE P1,Address of scan block
; MOVE P2,AOBJP pointer to output block
; PUSHJ P,INSLNM
; <return here if AOBJP pointer runs out>
; <return here if all OK>
;
;Returns with P2 updated
;
;Note that this routine is VERY sensitive to the order of the PATH.
;block. If the format changes, this routine must change also.
INSLNM: MOVE T2,LNMPTR ; GET ADDRESS OF INPUT PATH. BLOCK
MOVEI T2,.PTLSB(T2) ; POINT TO START OF COMPONENTS
INSLN1: SKIPN T1,0(T2) ; LOOK FOR TWO WORD TERMINATOR
SKIPE 1(T2) ; AT END OF BLOCK
CAIA ; NOT FOUND, CONTINUE WITH THIS ONE
JRST .POPJ1## ; RETURN AT END OF BLOCK
HRLI T2,-<.PTLSL-.PTNOD+1> ; MAKE AOBJN POITNER FOR 2 WORDS
INSLN2: MOVE T1,(T2) ; GET NEXT WORD
AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
MOVEM T1,(P2) ; STORE IN BLOCK (.PTNOD-.PTLSL)
AOBJN T2,INSLN2 ; LOOP FOR ALL
AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
MOVE T1,.FXNAM(P1) ; GET FILENAME FROM NEW COMPONENT
MOVE T3,(T2) ; AND FILENAME FROM EXISTING COMPONENT
PUSHJ P,OVRNAM ; FIGURE OUT WHICH ONE TO USE
MOVEM T1,(P2) ; STORE IN BLOCK
AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
HLLZ T1,.FXEXT(P1) ; GET EXTENSION FROM NEW COMPONENT
HLLZ T3,1(T2) ; AND EXTENSION FROM EXISTING COMPONTENT
PUSHJ P,OVRNAM ; FIGURE OUT WHICH ONE TO USE
MOVEM T1,(P2) ; STORE IN BLOCK
ADDI T2,<.PTEXT-.PTFIL+1> ; STEP PAST WORDS IN BLOCK
INSLN3: MOVE T1,(T2) ; GET NEXT WORD OF PATH
AOBJP P2,.POPJ## ; CHECK FOR BLOCK OVERFLOW
MOVEM T1,(P2) ; STORE IN OUTPUT BLOCK
SKIPE T1 ; END OF PATH?
AOJA T2,INSLN3 ; NO CONTINUE
AOJA T2,INSLN1 ; LOOP FOR NEXT COMPONENT
;Routine to determine which filename or extension to insert into
;the PATH. block being built if we are substituting the components
;of an existing logical name into a logical name definition. If
;the component being defined has no value specified, we always
;substitute the value from the existing logical name definition.
;If the component being defined has a value specified, we only
;overwrite it with the value from the existing definition if the
;/OVERRIDE switch was specified.
;The call is:
;
; MOVE T1,Value from component being defined
; MOVE T3,Value from existing definition
; PUSHJ P,OVRNAM
; <return here with value to be used in T1>
;Preserves T2.
OVRNAM: TRACE$ OVRNAM,<T1,T3> ; TYPE DEBUGGING INFO
JUMPE T1,OVRNA1 ; USE EXISTING VALUE IF NEW ONE NOT SPECIFIED
JUMPE T3,.POPJ## ; USE NEW VALUE IF EXISTING ONE NOT SPECIFIED
MOVE T4,PTSLN+.PTLNF ; GET FLAGS FOR THIS DEFINITION
TXNE T4,PT.OVR ; /OVERRIDE SPECIFIED?
OVRNA1: MOVE T1,T3 ; YES, FORCE EXISTING VALUE
POPJ P, ; RETURN
;Routine to type the name of the structure in error.
;The call is:
;
; PUSHJ P,TYPSTR
; <always return here>
TYPSTR: TRACE$ TYPSTR ; TYPE DEBUGGING INFO
MOVE T1,DSCBLK+.DCNAM ; GET THE NAME HE TYPED
;; PJRST TYPNAM ; FALL INTO TYPNAM
;Routine to type a name in SIXBIT followed by a CRLF.
;The call is:
;
; MOVE T1,name to type
; PUSHJ P,TYPNAM
; <always return here>
TYPNAM: TRACE$ TYPNAM,T1 ; TYPE DEBUGGING INFO
PUSH P,T2 ; SAVE T2 (.TSIXN DESTROYS IT)
PUSHJ P,.TSIXN## ; TYPE IN SIXBIT
POP P,T2 ; RESTORE T2
PJRST .TCRLF## ; END LINE AND RETURN
;Routine to compress the zero entries from a STRUUO block.
;The call is:
;
; MOVE T1,AOBJN pointer to block
; PUSHJ P,ZROCMP
; <always return here>
ZROCMP: TRACE$ ZROCMP,T1 ; TYPE DEBBUGGING INFO
MOVE T2,T1 ; COPY POINTER (USE T1 AS HOLE FINDER)
; (USE T2 AS NEXT FREE POINTER)
ZROCM1: SKIPN (T1) ; NEXT ONE EMPTY?
JRST ZROCM2 ; YES, JUST ADVANCE HOLE FINDER
HRLI T3,(T1) ; GET SOURCE ADDRESS
HRRI T3,(T2) ; AND DESTINATION ADDRESS
BLT T3,.DFJBL-1(T2) ; MOVE TO NEXT FREE BLOCK
ADDI T2,.DFJBL ; ADVANCE NEXT FREE POINTER
ZROCM2: ADDI T1,.DFJBL-1 ; ALWAYS ADVANCE HOLE FINDER
AOBJN T1,ZROCM1 ; AND LOOP FOR ALL BLOCKS
POPJ P, ; RETURN
SUBTTL Message processing routines
;Routines to print a fatal, warning, or informative message on the TTY.
;All are called as follows:
;
; PUSHJ P,.XXX
; CAI Code,[XWD Prefix,[Message]]
; <return here unless EO.STP specified>
;
;Where Code is the error option code (see EO.XXX)
; Prefix is the path error message prefix
; Message is the message to be printed
.ERR: TXO F,FL.ERR ; SET FATAL ERROR FLAG
PUSHJ P,.PSH4T## ; SAVE T1-T4
MOVX T4,"?" ; GET ERROR CHARACTER
PJRST ERRCOM ; JOIN COMMON ROUTINE
.WARN: TXO F,FL.WRN ; SET WARNING MESSAGE FLAG
PUSHJ P,.PSH4T## ; SAVE T1-T4
MOVX T4,"%" ; GET ERROR CHARACTER
PJRST ERRCOM ; JOIN COMMON ROUTINE
.TELL: TXO F,FL.TEL ; SET INFO MESSAGE FLAG
PUSHJ P,.PSH4T## ; SAVE T1-T4
MOVX T4,"[" ; GET ERROR CHARACTER
;; PJRST ERRCOM ; JOIN COMMON CODE
ERRCOM: MOVSI T1,'PTH' ; GET OUR MNEMONIC
HRRZ T2,-4(P) ; GET ADDR OF CAI WORD (OFFSET FOR .PSH4T)
MOVE T2,@(T2) ; GET PREFIX,,ADDR OF MESSAGE
HLR T1,T2 ; ADD PREFIX ERROR CODE
HRL T2,T4 ; PUT IN LEADING CHARACTER
PUSHJ P,.ERMSG## ; LET SCAN DO THE WORK
LDB T1,[POINT 4,@-4(P),12] ; GET CODE FROM AC FIELD OF CAI WORD
TXZE F,FL.TEL ; WAS IT INFORMATIVE?
CAXN T1,EO.NCR ; OR NO CRLF WANTED?
CAIA ; YES, DON'T TYPE RIGHT BRACKET
PUSHJ P,.TRBRK## ; PUT OUT A RIGHT BRACKET
LDB T1,[POINT 4,@-4(P),12] ; GET CODE BACK
CAXG T1,EO.MAX ; LARGER THAN MAX?
JUMPN T1,@[DOEXIT
ERRCO1]-1(T1) ; DISPATCH BASED ON ERROR CODE
PUSHJ P,.TCRLF## ; END MESSAGE WITH CRLF
ERRCO1: PUSHJ P,.POP4T## ; RESTORE T1-T4
PJRST .POPJ1## ; RETURN, SKIPPING CAI WORD
DOEXIT: PUSHJ P,.MONRT## ; LET SCAN KILL THE PROGRAM
JRST .-1 ; NO CONTINUE
SUBTTL Debug package
;Routine to print debug information upon entry to a subroutine.
;Assembled and called only if the switch DEBUG$ is non-zero.
;The call is:
;
; PUSHJ P,.DEBUG ; From TRACE$ macro
; CAI [SIXBIT/NAME/ ; Routine name
; EXP LOC1 ; Address of first loc
; EXP LOC2 ; Address of second loc
; :
; EXP LOCN ; Address of nth loc
; XWD -1,0] ; -1,,0 terminates block
; <always return here>
IFN DEBUG$, < ; ASSEMBLE ONLY IF DEBUGGING
.DEBUG: MOVEM 16,DEBAC+16 ; SAVE AC 16
MOVX 16,<0,,DEBAC> ; BUILD BLT POINTER
BLT 16,DEBAC+15 ; SAVE ALL AC'S
HRRZ P1,@0(P) ; GET ADDRESS OF CAI BLOCK
MOVEI T1,[BYTE (7)76,76,40,0,0] ; TWO ANGLE BRACKETS AND A SPACE
PUSHJ P,.TSTRG## ;TYPE IT
MOVE T1,(P1) ; GET SIXBIT ROUTINE NAME
PUSHJ P,.TSIXN## ; TYPE IN SIXBIT
MOVEI T1,[ASCIZ/ called from PC /]
PUSHJ P,.TSTRG## ; TYPE IT
HRRZ T1,-1(P) ; GET PC OF CALLER OF SUBROUTINE
SUBI T1,1 ; MAKE IT POINT TO THE CALLER
MOVEI P2,(T1) ; SAVE IN P2
PUSHJ P,.TOCTW## ; TYPE IN OCTAL
MOVEI T1,[ASCIZ/ = /] ; SEPARATOR
PUSHJ P,.TSTRG## ; TYPE IT
PUSHJ P,STSRCH ; FIND PC SYMBOLIC LOC AND TYPE IT
PUSHJ P,.TCRLF## ; END THE LINE
.DEBU1: SKIPGE 1(P1) ; DONE ALL OF THEM YET?
JRST .DEBU2 ; YES
MOVEI T1,[ASCIZ/ C(/] ; PREFIX FOR LOCATION NAME
PUSHJ P,.TSTRG## ; TYPE IT
MOVE P2,1(P1) ; GET ADDRESS OF LOCATION
PUSHJ P,STSRCH ; SEARCH SYMBOL TABLE FOR IT
MOVEI T1,[ASCIZ/) = /]
PUSHJ P,.TSTRG## ; TYPE SEPARATOR
CAIG P2,16 ; IS IT AN AC?
MOVEI P2,DEBAC(P2) ; YES, POINT AT AC BLOCK
MOVE T1,(P2) ; GET VALUE OF ADDRESS
PUSHJ P,.TXWDW## ; TYPE AS HALFWORDS
PUSHJ P,.TCRLF## ; END THE LINE
AOJA P1,.DEBU1 ; BUMP CAI BLOCK POINTER AND LOOP
.DEBU2: MOVX 16,<DEBAC,,0> ; SETUP BLT POINTER TO RESTORE AC'S
BLT 16,16 ; AND DO SO
PJRST .POPJ1## ; RETURN SKIPPING CAI WORD
;Routine to search the symbol table for an address and print the
;symbolic name of that address. If no exact match is found, the closest
;symbolic name plus offset from that name is printed.
;The call is:
;
; MOVEI P2,Address to find
; PUSHJ P,STSRCH
; <always return here>
STSRCH: SKIPN T2,.JBSYM ; HAVE A SYMBOL TABLE?
JRST [MOVEI T1,(P2) ; NO, GET OCTAL VALUE OF ADDRESS
PJRST .TOCTW## ; AND PRINT IT IN OCTAL
]
SETZB P3,P4 ; P3=CLOSEST ST PTR, P4=CLOSEST VALUE
STSRC1: MOVE T1,1(T2) ; GET VALUE OF NEXT SYMBOL
CAML T1,P4 ; IF LESS THAN THE CLOSEST WE'VE SEEN
CAILE T1,(P2) ; OR GREATER THAN THE ONE WE WANT,
JRST STSRC2 ; IGNORE IT
MOVEI P3,(T2) ; SAVE POINTER TO CLOSEST ONE WE'VE SEEN
MOVE P4,T1 ; PLUS VALUE OF THAT SYMBOL
STSRC2: AOBJP T2,STSRC3 ; QUIT WHEN WE RUN OUT OF SYMBOL TABLE
CAME P2,T1 ; OR IF WE FIND AN EXACT MATCH
AOBJN T2,STSRC1 ; ELSE LOOP FOR NEXT SYMBOL
STSRC3: MOVE T2,0(P3) ; GET RADIX50 NAME FOR THE SYMBOL
PUSHJ P,PRDX50 ; AND PRINT IT
MOVEI T1,(P2) ; GET ADDRESS WE WANTED TO FIND
SUB T1,P4 ; COMPUTE OFFSET FROM ADDRESS WE FOUND
JUMPE T1,.POPJ## ; IF EXACT MATCH, QUIT NOW
PUSH P,T1 ; SAVE OFFSET
MOVEI T1,"+" ; TO INDICATE OFFSET
PUSHJ P,.TCHAR## ; PRINT THE PLUS
POP P,T1 ; RESTORE THE OFFSET
PJRST .TOCTW## ; PRINT IT AND RETURN
;Routine to print a radix 50 symbol on the terminal. The
;call is:
;
; MOVE T2,Symbol to print
; PUSHJ P,PRDX50
; <always return here>
PRDX50: MOVEI T1,6 ; NUMBER OF CHARS TO PRINT
TXZ T2,17B3 ; CLEAR CODE FROM SYMBOL TABLE
MOVEI T4,0 ; T4=REGISTER IN WHICH TO BUILD SIXBIT NAME
PRDX51: IDIVI T2,50 ; GET NEXT CHAR IN T3
ROT T3,-1 ; INDEX IN RH, HALFWORD FLAG IN 1B0
SKIPGE T3 ; SKIP IF CHARACTER IN LH OF RDX50T
SKIPA T3,RDX50T(T3) ; PICK UP RH CHARACTER
MOVS T3,RDX50T(T3) ; PICK UP LH CHARACTER
LSHC T3,-6 ; SHIFT INTO ACCUMULATED SIXBIT WORD
SOJG T1,PRDX51 ; LOOP FOR NEXT CHARACTER
MOVE T1,T4 ; GET ACCUMULATED SIXBIT EQUIVALENT
PJRST .TSIXN## ; PRINT IN SIXBIT AND RETURN
;Table of SIXBIT equivalent characters indexed by the RADIX 50
;character set.
RDX50T: XWD ' ','0' ; SPACE, ZERO
XWD '1','2' ; ONE, TWO
XWD '3','4' ; THREE, FOUR
XWD '5','6' ; FIVE, SIX
XWD '7','8' ; SEVEN, EIGHT
XWD '9','A' ; NINE, A
XWD 'B','C' ; B, C
XWD 'D','E' ; D, F
XWD 'F','G' ; F, G
XWD 'H','I' ; H, I
XWD 'J','K' ; J, K
XWD 'L','M' ; L, M
XWD 'N','O' ; N, O
XWD 'P','Q' ; P, Q
XWD 'R','S' ; R, S
XWD 'T','U' ; T, U
XWD 'V','W' ; V, W
XWD 'X','Y' ; X, Y
XWD 'Z','.' ; Z, PERIOD
XWD '$','%' ; DOLLAR SIGN, PERCENT SIGN
$LOW
DEBAC: BLOCK 17 ; AC SAVE AREA
DEBALL: EXP 0 ; DEPOSIT NON-ZERO TO TYPE INFO
$HIGH
> ; END IFN DEBUG$
END PATH