Trailing-Edge
-
PDP-10 Archives
-
cuspmar86binsrc_2of2_bb-fp63a-sb
-
10,7/setsrc/setsrc.mac
There are 3 other files named setsrc.mac in the archive. Click here to see a list.
TITLE SETSRC - CUSP TO MANIPULATE SEARCH LISTS AND DEFAULT PATHS V12B(47)
SUBTTL D BLACK/TW 19MAR79
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1974,1984,1986. ALL RIGHTS RESERVED.
;
;
;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.
VSETSR==12
VUPDATE==2
VEDIT==47
VCUSTOM==0
SEARCH MACTEN,UUOSYM ;UNIVERSAL FILES
LOC 137
<VCUSTOM>B2+<VSETSR>B11+<VUPDATE>B17+VEDIT
OCT VSETSR
RELOC
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1974,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
INTERN VSETSR
TTY==0
F=0
A=1
B=2
C=3
D=4
N=5
N1=N+1
N2=N1+1
I=N2+1
O=I+1
ICH=O+1
OCH=ICH+1
P=17
; F BITS
S.WRTL==1B0
S.NOCR==1B1
S.SWIT==1B35 ;1 IF ANY FS SWITCH SEEN
S.BITS==S.WRTL!S.NOCR!S.SWIT
F.LIB==1B2 ;/LIB
F.NLIB==1B3 ;/NOLIB
F.SYS==1B4 ;/SYS
F.NSYS==1B5 ;/NOSYS
F.NEW==1B6 ;/NEW
F.NNEW==1B7 ;/NONEW
F.SCN==1B8 ;/SCAN
F.NSCN==1B9 ;/NOSCAN
F.SLS==1B10 ;S.L. SWITCHES ARE LEGAL
F.STAR==1B11 ;'*' IS LEGAL
F.SARG==1B12 ;'*' SEEN IN ARGUMENT SCAN
F.TYO==1B13
F.SSL==1B14 ;0: JOB'S SRC.LST 1: SYS SRC.LST
F.TYPE==1B15 ;BIT USED BY TYPE
F.NORB==1B16 ;BIT USED BY GETPP
F.SL==F.LIB!F.NLIB!F.SYS!F.NSYS!F.NEW!F.NNEW
F.FS==S.BITS
F.PT==F.SCN!F.NSCN
F.COM==F.SSL!F.SLS!F.STAR!F.SARG!F.SL!F.PT
MAXFS==9 ;MAX # FILESTRUCTURES IN A S.L.
ALTMOD==.CHESC ;RECOGINIZED ALTMODE
;GETTAB CONSTANTS
MON503==2 ;MON.VERS. FOR 503 OR LATER (ST%TDS OF %CNSTS (STATES))
;PATH. CONSTANTS
SFDLEN==6 ;MAX LEVEL OF NESTED SFD'S
PT.SYS==1 ;/SYS BIT
PT.NEW==2 ;/NEW BIT
;SOME SYMOBLS NOT IN C.MAC YET (6-1-72)
IFNDEF .FSDJN,<.FSDJN==1>
IFNDEF .FSDPP,<.FSDPP==2>
IFNDEF .FSDFL,<.FSDFL==3>
SETSRC: JFCL ;IN CASE OF CCL
RESET
SETZM F
COMERR: ;HERE IF COMMAND ERROR (AFTER ERROR MSG.)
MOVE P,PDP
ST1: INIT TTY,
SIXBIT .TTY.
XWD WH.TTY,RH.TTY
EXIT ;EXIT IF NO TTY
MOVEI A,B.TTY
MOVEM A,.JBFF##
INBUF TTY,1
OUTBUF TTY,1
MOVEI I,R.TTY
SETZM ICH
MOVEI O,W.TTY
MOVX A,%CNSTS ;GET MONITOR 'VERSION'
GETTAB A,
JSP A,NEVERR
LDB A,[POINTR (A,ST%TDS)]
MOVEM A,MONVER
GETPPN A, ;GET JOBS PPN
JFCL
MOVEM A,PPN
PJOB A, ;GET JOB #
MOVEM A,JOB
LISTEN: PUSHJ P,STAR ;TELL USER WE ARE HERE
TXZ F,F.COM
MOVE C,[CAOBJ]
PUSHJ P,GETNAM
JRST [JUMPE C,NXTCOM
JUMPE A,NXTCOM
MOVEI N,[ASCIZ/?ILLEGAL COMMAND /]
PUSHJ P,MSG6BA
JRST COMERR
]
PUSHJ P,@COFSET(C)
;HERE (POPJ) ON SUCCESSFUL COMPLETION OF COMMAND
NXTCOM: PUSHJ P,EOLSKP
JRST STXERR
CAIN ICH,.CHCNZ
EXIT
SETZM ICH
JRST LISTEN
STYPE: PUSHJ P,SSLCHK
JRST TYPE
JTYPE: PUSHJ P,SLBITS ;SET F BITS ACCORDING TO S.L. SPECIFICATIONS
JRST COMERR
TXNE F,F.LIB ;PRINT BITS AS SWITCHES
PUSHJ P,[MOVEI N,[ASCIZ\/LIB:\]
PUSHJ P,MSG
MOVE B,LIBPPN
PJRST TYPPPN
]
TXNE F,F.SYS
PUSHJ P,[MOVEI N,[ASCIZ\/SYS\]
PJRST MSG
]
TXNE F,F.NEW
PUSHJ P,[MOVEI N,[ASCIZ\/NEW\]
PJRST MSG
]
TXNE F,F.LIB!F.SYS!F.NEW ;IF ANY TYPED, FOLLOW WITH SPACE
PUSHJ P,SPACE
TYPE: TXZ F,F.TYPE ;BIT TO CONTROL TYPING OF COMMAS
PUSHJ P,NEXFSI ;INIT NEXFS
PUSHJ P,NEXFS
JRST COMERR
JRST TYP4
TYP1: PUSHJ P,NEXFS ;GET NEXT FS
JRST COMERR
AOJE N,TYPEND ;JUMP IF NO MORE
SOS N
TYP4: JUMPE N,[TXNE F,F.SSL ;QUIT IF SYS.S.L.
JRST TYPEND
MOVE A,['FENCE '] ;CHECK FOR FENCE
PUSHJ P,TYPFS
JRST TYP1
]
MOVE A,N
PUSHJ P,TYPFS ;TYPE FILE STRUCTURE NAME
; MOVE B,N1 ;TYPE DIRECTORY
; PUSHJ P,TYPPPN
PUSHJ P,COLON
TXNE N2,S.WRTL ;NO SKIP IF WRITE PROTECTED
PUSHJ P,[JSP N,MSG
ASCIZ\/NOWRITE\
]
TXNE N2,S.NOCR ;NO SKIP IF NO CREATE
PUSHJ P,[JSP N,MSG
ASCIZ\/NOCREATE\
]
JRST TYP1 ;GO GET NEXT FILE STRUCTURE
TYPEND: POPJ P, ;END OF COMMAND
TYPFS: TXON F,F.TYPE ;IF NOT 1ST NAME
PJRST SIXMSG
PUSHJ P,COMMA ;TYPE PRECEEDING COMMA
PUSHJ P,SPACE
PJRST SIXMSG
;CREATE SYSTEM SEARCH LIST
SCREAT: PUSHJ P,SSLCKP ;CHECK FOR SYS.S.L. CONSTRAINTS
TXO F,F.STAR ;'*' OK
JRST CREAT
;CREATE JOB SEARCH LIST
JCREAT: TXO F,F.STAR!F.SLS ;'*' & S.L. SWITCHES OK
CREAT: PUSHJ P,FSLIST ;READ LIST
JRST COMERR
JUMPE B,CREAT9 ;JUMP IF NO F.S.'S TYPED
PUSHJ P,DEFSLI ;INIT STRUUO ARG LIST
;HERE FROM ADD COMMAND ALSO
CREAT1:
MOVNS B ;B=AOBJN IDX ON FSNAM/FSBIT
HRLZS B
; PROCESS LEADING FS'S (THOSE BEFORE '*')
CREAT2: MOVE N,FSNAM(B) ;GET NEXT FS
SETZM N1
MOVE N2,FSBIT(B)
CAMN N,['* '] ;HANDLE STAR AND FS'S AFTER STAR DIFFERNETLY
JRST CREAT4
PUSHJ P,FSADD1 ;ADD FS TO LIST & CHK FOR DUPLICATES
JRST COMERR
PUSHJ P,CREATW
AOBJN B,CREAT2 ;LOOP ON ALL FS'S IN FSNAM
JRST CREAT8
; HERE IF '*'
CREAT4: PUSHJ P,FSADD1 ;DONT CHANGE STATUS OF FS'S ALREADY LISTED
JRST COMERR
JFCL ; JUST IGNORE THEM
JRST CREAT7 ;GO LOOK FOR ANY FS'S FOLLOWING *
; PROCESS TRAILING FS'S (THEY MUST FIRST BE REMOVED)
CREAT6: MOVE N,FSNAM(B)
SETZM N1
MOVE N2,FSBIT(B)
CAMN N,['* '] ;WARN OF DUPLICAT *'S
JRST [PUSHJ P,CREATW
JRST CREAT7
]
PUSHJ P,FSSUB ;REMOVE THIS FS IF ALREADY IN LIST
JRST COMERR
JFCL
PUSHJ P,FSADD1 ;AND THEN ADD TO END
JRST COMERR
JSP A,NEVERR
CREAT7: AOBJN B,CREAT6 ;LOOP ON ALL FS'S IN FSNAM
CREAT8: PUSHJ P,DEFSL ;DEFINE THE S.L.
JRST COMERR
CREAT9: PUSHJ P,SLSWIT ;ATTEND TO S.L. SWITHCES (IN F)
JRST COMERR
POPJ P, ;END OF COMMAND
CREATW: PUSH P,A
MOVE A,N ;WARN OF DUPLICAT
MOVEI N,[ASCIZ/%DUPLICATE STRUCTURE /]
PUSHJ P,MSG6BA
POP P,A
POPJ P,
;ADD TO SYSTEM SEARCH LIST
SADD: PUSHJ P,SSLCKP
JRST ADDD
;ADD TO JOBS SEARCH LIST
JADD: TXO F,F.SLS
ADDD: TXO F,F.STAR ;'*' OK
PUSHJ P,FSLIST ;GET NEW F.S.'S
JRST COMERR
JUMPE B,[PUSHJ P,SLSWIT ;IF NO FS'S JUST DO S.L. SWITCHES
JRST COMERR
POPJ P, ;END OF COMMAND
]
PUSHJ P,DEFSLI ;INIT STRUUO ARG LIST
TXNE F,F.SARG ;IF '*' NOT TYPED:
JRST CREAT1
PUSHJ P,INSTAR ;SIMULATE ONE
JRST COMERR
JRST CREAT1
;PUT INITIAL '*' IN STRUUO ARG LIST
INSTAR: PUSHJ P,DEFSLI ;INIT STRUUO ARGLIST
MOVX N,'* '
SETZM N1
MOVX N2,0
PUSHJ P,FSADD0
POPJ P,
JSP A,NEVERR
JRST CPOPJ1
;;MODIFY SYSTEM SEARCH LIST
SMODIF: PUSHJ P,SSLCKP
JRST MODIFY
;MODIFY JOBS SEARCH LIST
JMODIF: TXO F,F.SLS
MODIFY: TXO F,F.STAR
PUSHJ P,FSLIST ;READ LIST
JRST COMERR
JUMPE B,MODIF9 ;JUMP IF NO F.S.'S TYPED
PUSHJ P,INSTAR ;SIMULATE INITIAL '*'
JRST COMERR
MOVNS B ;B=AOBJN IDX ON FSNAM/FSBIT
HRLZS B
MODIF2: MOVE N,FSNAM(B) ;GET NEXT FS
SETZM N1
MOVE N2,FSBIT(B)
PUSH P,A ;SAVE LENGTH OF CURRENT S.L.
PUSHJ P,FSADD0 ;ADD FS TO LIST & CHANGE STATUS IF ALREADY THERE
JRST [POP P,A
JRST COMERR
]
SKIPA ;OK IF ALREADY IN LIST
PUSHJ P,MODIFW ;WARN IF NOT IN LIST
POP P,A
AOBJN B,MODIF2 ;LOOP ON ALL FS'S IN FSNAM
MODIF8: PUSHJ P,DEFSL ;DEFINE THE S.L.
JRST COMERR
MODIF9: PUSHJ P,SLSWIT ;ATTEND TO S.L. SWITHCES (IN F)
JRST COMERR
POPJ P, ;END OF COMMAND
MODIFW: CAMN N,['* '] ;IF NOT IN LIST
POPJ P, ; AND NOT '*'
PUSH P,A
MOVE A,N ;ITS NOT OK--WARN USER
MOVEI N,[ASCIZ/%STRUCTURE NOT IN SEARCH LIST /]
PUSHJ P,MSG6BA
POP P,A
POPJ P,
;REMOVE FROM SYSTEM SEARCH LIST
SREMOV: PUSHJ P,SSLCKP
JRST REMOVE
;REMOVE FROM JOBS SEARCH LIST
JREMOV: TXO F,F.SLS
REMOVE: TXO F,F.STAR
PUSHJ P,FSLIST ;GET LIST OF F.S. TO REMOVE
JRST COMERR
JUMPE B,REMOV9 ;JUMP IF NONE
PUSHJ P,INSTAR ;GET CURREN S.L.
JRST COMERR
; REMOVE F.S. IN FSNAM FROM S.L. IN FSBLOK
MOVNS B
HRLZS B
REMOV2: MOVE N,FSNAM(B) ;GET NEXT FS
CAMN N,['* '] ;'*' MEANS ALL
JRST [PUSHJ P,DEFSLI
JRST REMOV6
]
PUSHJ P,FSSUB
JRST COMERR
PUSHJ P,MODIFW ;WARN USER IF NOT IN LIST
AOBJN B,REMOV2
REMOV6: PUSHJ P,DEFSL
JRST COMERR
REMOV9: PUSHJ P,SLSWIT
JRST COMERR
POPJ P, ;END OF COMMAND
;COMMANDS THAT LOOK LIKE S.L. SWITCHES
JSYS: TXOA F,F.SYS ;SYS
JNSYS: TXO F,F.NSYS ;NOSYS
JRST JSLS
JNEW: TXOA F,F.NEW ;NEW
JNNEW: TXO F,F.NNEW ;NONEW
JRST JSLS
JLIB: SETZM C ;LIB:[PPN]
PUSHJ P,LIBARG
JUMPE C,JSLS
MOVEI N,[ASCIZ/?ILLEGAL ARGUMENT/]
PUSHJ P,MSGTTY
JRST COMERR
JNLIB: TXO F,F.NLIB ;NOLIB
JSLS: PUSHJ P,SLSWIT
JRST COMERR
POPJ P, ;END OF COMMAND
;CHECK TO SEE IF OK TO DO SOMETHIN WITH SYS.SEARCH LST
;RET+1 IF OK (F.SSL SET)
SSLCKP: ;HERE TO CHECK IF NEED PRIVILEGES
;STRUUO WILL CHECK AND GIVE ERROR RETUURN
SSLCHK: MOVX A,MON503 ;5.03 OR LATER?
CAMLE A,MONVER
JRST [MOVEI N,[ASCIZ/?COMMAND REQUIRES 5.03 OR LATER/]
PUSHJ P,MSGTTY
JRST COMERR
]
TXO F,F.SSL ;YES-SET SYS.S.L BIT
POPJ P,
;INITILIZATION FOR NEXFS
NEXFSI: TXNN F,F.SSL ;SYS.SRC LST?
JRST [SETOM SLBLOK
POPJ P,
]
SETZM SLBLOK+.DFGJN ;YES-SETUP FOR GOBSTR
SETZM SLBLOK+.DFGPP
SETOM SLBLOK+.DFGNM
POPJ P,
;SUBROUTINE TO GET NEXT F.S. IN SRC.LST
;CALL F.SSL BIT=1 IF SYS.SRC.LST
;RET+1 ERROR--MESSAGE TYPED
;RET+2 N=F.S. NAME (OR -1) IF END
; N1=PPN ENTRY
; N2=STATUS BITS
; A,B,C PRESERVED
NEXFS: TXNE F,F.SSL ;SYS.SRC.LST?
JRST NEXSS ;YES
MOVE D,[.DFJST+1,,SLBLOK] ;NO--USE JOBSTR
JOBSTR D,
PJRST STRUER
MOVE N,SLBLOK+.DFJNM
MOVE N1,SLBLOK+.DFJDR
MOVE N2,SLBLOK+.DFJST
JRST CPOPJ1
NEXSS: MOVE D,[XWD .DFGST+1,SLBLOK]
GOBSTR D,
POPJ P,
MOVE N,SLBLOK+.DFGNM
MOVE N1,SLBLOK+.DFGDR
MOVE N2,SLBLOK+.DFGST
JRST CPOPJ1
;INIT FOR DEFSL
DEFSLI: TXNE F,F.SSL ;SYS.S.L.?
JRST DEFSSI ;YES
MOVX A,.FSSRC ;NO--USE .FSSRC FUNCTION
MOVEM A,FSBLOK
MOVX A,1
POPJ P,
DEFSSI: MOVX A,.FSDSL
MOVEM A,FSBLOK
SETZM FSBLOK+.FSDJN ;0 JOB# & PPN INDICATES SYS.S.L.
SETZM FSBLOK+.FSDPP
MOVX A,DF.SRM ;BIT TO CAUSE FS'S TO BE REMOVED FROM S.L.
MOVEM A,FSBLOK+.FSDFL
MOVX A,.FSDFL+1
POPJ P,
;DEFINE NEW SEARCH LIST
;CALL A=NUMBER OF WDS USED IN FSBLOK
; F.SSL=1 IF SYS.SEARCH-LIST =0 OTHERWISE
;RET+1 ERROR (MSG TYPED)
;RET+2 OK
DEFSL: MOVSS A ;MAKE STRUUO AC
HRRI A,FSBLOK
STRUUO A,
PJRST STRUER
JRST CPOPJ1
;PERFORM S.L. SWITCHES IN F (E.G. F.NEW,F.NNEW,F.LIB,ETC)
SLSWIT: TXNN F,F.SL ;IF NO S.L. SWITCHES SPECIFIED
JRST CPOPJ1 ; RETURN IMMEDIATELY
MOVE A,F ;GET CURRENT STATE OF /NEW/SYS/LIB
TXZ F,F.LIB!F.SYS!F.NEW
MOVE B,LIBPPN
PUSHJ P,SLBITS
JRST COMERR
EXCH A,F
AND A,[F.LIB!F.SYS!F.NEW] ;A=CURRENT /SYS/LIB/NEW BITS
EXCH B,LIBPPN ;B=CURRENT LIB-PPN (IF ANY)
TXNE F,F.LIB ;IF LIB-PPN TYPED
MOVE B,LIBPPN ; USE IT
IORM F,A ;OR CURRENT AND NEW SO WONT TURN ANYTHING OFF
TXNE F,F.NNEW ;UNLESS EXPLICITLY REQUESTED (E.G. /NONEW)
TXZ A,F.NEW
TXNE F,F.NSYS
TXZ A,F.SYS
TXNE F,F.NLIB
TXZ A,F.LIB
SETZB N1,N2
TXNE A,F.LIB
MOVE N2,B
TXNE A,F.SYS
TXO N1,PT.SYS
TXNE A,F.NEW
TXO N1,PT.NEW
MOVX A,N
MOVNI N,3 ;DEFINE /LIB/SYS/NEW FUNCTION
PATH. A,
PUSHJ P,[MOVEI N,[ASCIZ\%/LIB/SYS/NEW NOT SUPPORTED IN THIS MONITOR\]
PJRST MSGTTY
]
JRST CPOPJ1
;SET F.LIB,F.SYS,F.NEW BITS FOR THIS JOB
; IF F.LIB=1 PUT PPN IN LIBPPN
; PERSERVES A,B
SLBITS: MOVNI N,4
MOVEI C,N
PATH. C,
JRST CPOPJ1 ;DONT SET ANY BITS IF NO /LIB/SYS/NEW
TXNE N1,PT.SYS
TXO F,F.SYS
TXNE N1,PT.NEW
TXO F,F.NEW
JUMPE N2,CPOPJ1 ;JUMP IF NO LIB
MOVEM N2,LIBPPN
TXO F,F.LIB
JRST CPOPJ1
;TYPE DEFAULT PATH
PTYPE: MOVE A,[PTHLEN,,PTHBLK]
SETOM PTHBLK ;-1 TO READ THE CURRENT PATH
PATH. A, ;GET THE PATH
JRST ERRPTH ;OOPS
PUSHJ P,RBRAK ;TYPE "["
HLRZ N,PTHPPN ;PROJECT
PUSHJ P,OCTPRT ;TYPE IT
PUSHJ P,COMMA ;","
HRRZ N,PTHPPN ;PROGRAMMER
PUSHJ P,OCTPRT ;TYPE IT
MOVE D,[XWD -SFDLEN,PTHSFD]
PTYP1: SKIPN A,(D) ;NEXT SFD NAME
JRST PTYP2 ;DONE
PUSHJ P,COMMA
PUSHJ P,SIXMSG ;TYPE THE SFD
AOBJN D,PTYP1 ;AND GET THE NEXT
PTYP2: PUSHJ P,LBRAK ;"]"
MOVX A,3
ANDM A,PTHSSW
SOSN PTHSSW ;SCAN SWITCH=1 IF NOT SCANNING
PUSHJ P,[MOVEI N,[ASCIZ\/NOSCAN\]
PJRST MSGTTY
]
SOSN PTHSSW ;SCN SWITCH =2 IF SCANNING
PUSHJ P,[MOVEI N,[ASCIZ\/SCAN\]
PJRST MSGTTY
]
JRST TYPEND
;SCAN NOSCAN COMMANDS
PSCAN: TXOA F,F.SCN
PNSCAN: TXO F,F.NSCN
MOVE A,[PTHLEN,,PTHBLK]
SETOM PTHBLK
PATH. A,
JRST ERRPTH
JRST PCREA8
;CREATE DEFAULT PATH
PCREAT: MOVE C,PTAOBJ ;LEADING SWITCHES
MOVEI D,PTXCT
PUSHJ P,SWITCH
JRST SWIERR
TXO F,F.NORB ;TELL GETPP R.BRACKET NOT NECESSARY
PUSHJ P,GETPP ;GET PPN
JRST PTHERR
MOVEM A,PTHPPN
MOVE D,[-SFDLEN,,PTHSFD]
CAIE ICH,"," ;SFDS COMMING?
JRST PCREA6 ;NO
PCREA4: PUSHJ P,GETARG ;YES-GET NEXT ONE
JUMPE A,PTHERR ;ERROR IF NONE
MOVEM A,(D) ;STORE IT
AOBJP D,[MOVEI N,[ASCIZ/?TOO MANY SFDS/]
PUSHJ P,MSGTTY
JRST COMERR
]
CAIN ICH,"," ;MORE SFDS ?
JRST PCREA4 ;YES
CAIN ICH,"]" ;END OF PATH?
SETZM ICH ;YES-FLUSH BRACKET
PCREA6: SETZM (D) ;TERMINAL 0 TO SFD LIST
MOVE C,PTAOBJ ;LOOK FOR TERMINAL SWITCHES
MOVEI D,PTXCT
PUSHJ P,SWITCH
JRST SWIERR
PUSHJ P,EOLSKP ;END OF LINE?
JRST PTHERR ;NO--SHOULD BE
PCREA8: MOVEI A,0
TXNE F,F.SCN ;SET SCAN SWITCH
MOVEI A,2
TXNE F,F.NSCN
MOVEI A,1
MOVEM A,PTHSSW
MOVNI A,2
MOVEM A,PTHBLK
MOVE A,[PTHLEN,,PTHBLK]
PATH. A,
JRST [AOSE A
JRST ERRPTH
MOVEI N,[ASCIZ/%NON-EXISTENT SFD/]
PUSHJ P,MSGTTY
JRST COMERR
]
POPJ P, ;END OF COMMAND
PTHERR: JRST STXERR
ERRPTH: MOVEI N,[ASCIZ/?THIS MONITOR DOES NOT SUPPORT SFD'S/]
PUSHJ P,MSGTTY
JRST COMERR
;ADD ENTRY TO FSBLOK
; IF N='*' ADD ALL FS'S OF CURRENT SEARCH LIST TO FSBLOK
;CALL FSADD0: STORE NEW STATUS (N2) IF NAME ALREADY IN FSBLOK
; FSADD1: IGNORE CALL (INCLUDING STATUS) IF NAME ALREADY IN FSBLOK
; A=INDEX OF LAST ENTRY IN FSBLOK
; N=SIXBIT NAME (OR '*')
; N1=PPN ARG (UNUSED)
; N2=STATUS BITS
;RET+1 ERROR CODE IN C: (SEE FSLIST)
;RET+2 SUCCESSFUL. FS WAS ALREADY IN LIST (THIS RETURN NEVER TAKEN IF N='*')
;RET+3 SUCCESSFUL. FS WAS NOT ALREADY IN LIST
; A (IDX ON FSBLOK) IS UPDATED IF FS ADDED
; B,N,N1,N2 PRESERVED
FSADD0: SKIPA D,[1,,1] ;LH=FLAG TO INGNORE DUPLICATES
FSADD1: MOVX D,1 ;SEARCH FSBLOK FOR THIS NAME
CAMN N,['* '] ;IF '*' CALL FSTAR TO EXPAND
JRST [PUSHJ P,FSTAR
POPJ P,
JRST CPOPJ2
]
FSADD: ;ENTERED HERE BY FSTAR WITH D SETUP
FSADD2: CAIG A,(D)
JRST FSADD3
CAMN N,FSBLOK(D)
JRST [TLNN D,-1 ;ALREADY THERE--STORE STATUS?
JRST CPOPJ1
MOVX C,S.WRTL!S.NOCR ;REMOVE NON-STRUUO BITS
AND C,N2
MOVEM C,FSBLOK+2(D)
JRST CPOPJ1 ;AND RETURN
]
ADDI D,3
JRST FSADD2
FSADD3: CAIL A,FSBLKL-2 ;NOT THERE--IS THERE ROOM?
JRST [MOVEI C,7 ;ERROR CODE 7
MOVEI A,[ASCIZ/?TOO MANY FILE STRUCTURES/]
PJRST ERRM
]
MOVEM N,FSBLOK(A) ;YES-STORE 3 WORDS
SETZM FSBLOK+1(A)
MOVX C,S.WRTL!S.NOCR ;REMOVE NON-STRUUO BITS
AND C,N2
MOVEM C,FSBLOK+2(A)
ADDI A,3 ;BUMP A
CPOPJ2: AOS (P) ;RETURN + 3
JRST CPOPJ1
;EXPAND '*' (WITH JOBSTR) AND PUT ENTRIES IN FSBLOK
;CALL LH(D)=0 IF IGNORE DUPLICATE ENTRIES
; =1 TO STORE NEW STATUS FOR DUPLICATES
;RET+1 ERROR
;RET+2 SUCCESS--A UPDATED AS NECESSARY (B,N,N1,N2 PRESERVED)
FSTAR: PUSH P,N2 ;SAVE EVERYTHING
PUSH P,N1
PUSH P,N
HRRI D,1 ;SET D FOR CALL TO FSADD
PUSH P,D
PUSHJ P,NEXFSI ;INITILIZE JOBSTR ARG.
FSTAR2: PUSHJ P,NEXFS
JSP N,NEVERR
AOJE N,FSTAR8 ;RETURN IF -1 (END OF LIST)
SOJE N,FSTAR8 ;RETURN IF 0 (FENCE)
MOVX D,S.SWIT ;IF SWITCHES TYPE WITH *
TDNE D,-3(P)
MOVE N2,-3(P) ; USE THEM INSTEAD OF JOBSTR'S
MOVE D,0(P) ;GET D
PUSHJ P,FSADD ;AND STORE IN FSBLOK
JRST FSTAR9
JFCL
JRST FSTAR2 ;LOOP FOR WHOLE SEARCH LIST
FSTAR8: AOS -4(P) ;SKIP RETURN
FSTAR9: POP P,D
POP P,N
POP P,N1
POP P,N2
POPJ P,
;REMOVE ENTRY FROM FSBLOK
;CALL N=NAME OF FS TO BE REMOVED
;RET+1 ERROR
;RET+2 NAME NOT IN LIST
;RET+3 NAME FOUND AND REMOVED
; B,N,N1,N2 PRESERVED
FSSUB: MOVX C,1 ;C=INDEX ON FSBLOK
CAIGE A,4
JRST CPOPJ1 ;RET+2 IF EMPTY LIST
FSSUB2: CAME N,FSBLOK(C) ;SEARCH FSBLOK FOR NAME
JRST [ADDI C,3
CAMGE C,A
JRST FSSUB2
JRST CPOPJ1 ;NOT IN LIST--RET+2
]
SUBI A,3 ;FOUND IT--BLT OVER IT
CAMG A,C ;IS THIS LAST ENTRY?
JRST CPOPJ2 ;YES-WERE FINISHED
MOVEI C,FSBLOK(C)
HRLI C,3(C)
BLT C,FSBLOK-1(A)
JRST CPOPJ2
;READ A LIST OF FILE STRUCTURES & SWITCHES
;CALL F.STAR=1 IF '*' IS LEGAL
; F.SLS =1 IF S.L. SWITCHES ARE LEGAL
;RET+1 ERROR -- CODE IN C
; 1-4: SWITCHES (MSG TYPED)
; 7 : TOO MANY F.S.'S (MSG TYPED)
; 10 : OTHER (MSG TYPED)
;RET+2 SUCCESSFULL SCAN
; B=NUMBER OF F.S.'S (MAY BE 0)
; F= GLOBAL SWITCHES
; FSNAM(I) = 6BIT F.S. NAMES (OR '*')
; FSBIT(I) = SWITCH BITS
FSLIST: TXZ F,F.SL ;CLEAR S.L. BITS
MOVX B,0 ;INIT F.S. COUNTER
PUSHJ P,FSLIS9 ;GET INITIAL F.S.
POPJ P, ;ERRORS
JUMPE A,FSLIS6 ;NO F.S. IS OK
FSLIS1:
CAMN A,['* '] ;'*' ?
JRST FSLIS2 ;YES--DONT CHECK IT
PUSHJ P,BLESFS ;CK F.S. & GET STRUCTURE NAME
POPJ P, ;ERRORS
FSLIS2: AOS B ;BUMP COUNT
MOVEM A,FSNAM-1(B) ;STORE NAME
MOVX A,S.BITS ; AND BITS (ONLY THOSE FOR F.S.)
AND A,F
MOVEM A,FSBIT-1(B)
CAIL B,FSNAML ;REACHED LIMIT ON F.S. ?
JRST [PUSHJ P,FSLIS9 ;YES-IS THERE MORE?
POPJ P, ;ERRORS
JUMPE A,CPOPJ1 ;NO-OK RETURN
MOVX C,7 ;YES-ERROR CODE 7
MOVEI A,[ASCIZ/?TOO MANY FILE STRUCTURES/]
PJRST ERRM
]
CAIN ICH,"," ;MORE F.S.'S EXPECTED?
JRST [SETZM ICH ;YES-FLUSH DELIMITOR
PUSHJ P,FSLIS9 ;GET NEXT F.S.
POPJ P, ;ERRORS
JUMPE A,GETFS7 ;ERROR IF NONE
JRST FSLIS1 ;AND LOOP
]
FSLIS6: PUSHJ P,NELSKP ;END OF LINE?
JRST CPOPJ1 ;YES-OK RETURN
GETFS7: PUSHJ P,NELSKP ;HERE ON GARBAGE OR MISSING F.S.
JRST [MOVEI A,[ASCIZ/? MISSING FILE STRUCTURE/]
PJRST ERRM2
]
JUMPN A,GETFS8 ; IF NO NAME-TYPE OFFENDING CHARACTER
MOVEI A,-40(ICH)
ROT A,-6
GETFS8: MOVEI N,[ASCIZ/?ILLEGAL NAME OR CHARACTER /]
PJRST MSG6BA
FSLIS9: ;RETURN A F.S. IN A
TXZ F,F.FS ;CLEAR PER-F.S. BITS
PUSH P,B
PUSHJ P,GETFS ;LOOK FOR A F.S.
SOS -1(P) ;ERRORS
POP P,B
JRST CPOPJ1 ;RET+2 IF NO MORE
;CHECK NAME TO SEE IF ITS A DISK THAT USER CAN ACCESS
; ALSO MAP TO FILE STRUCTURE NAME IF NECESSARY
;CALL A=6BIT NAME
;RET+1 ERROR: C=10, MSG TYPED
;RET+2 SUCCESSFUL: (WARNING MAY HAVE BEEN TYPED)
; A=EQUIVALENT STRUCTURE NAME
BLESFS: PUSH P,A
DEVCHR A, ;WHAT IS IT?
TXNN A,DV.DSK ;DISK?
PJRST BLESF8 ;NO
TXNN A,DV.AVL ;AVAILABLE?
JRST [MOVEI N,[ASCIZ/?UNAVAILABLE /]
PJRST BLESF9
]
MOVE A,(P) ;NOW DO A DSKCHR
MOVEM A,DSKCHA+.DCNAM
MOVE A,[.DCSAJ,,DSKCHA]
DSKCHR A,
PJRST BLESF8 ;NOT A DSK?
TXNE A,DC.NNA ;ACCESS ALLOWED?
JRST [MOVEI N,[ASCIZ/?NO NEW ACCESS ALLOWED /]
PJRST BLESF9
]
TXNE A,DC.STS ;DOWN?
JRST [MOVEI N,[ASCIZ/?UNUSABLE /]
PJRST BLESF9
]
SKIPLE A,DSKCHA+.DCSAJ ;SINGLE ACCESS?
JRST [CAMN A,JOB ;YES-FOR THIS JOB?
JRST BLESF4 ;YES-OK
MOVEI N,[ASCIZ/?SINGLE ACCESS /]
PJRST BLESF9
]
BLESF4:
TXNN A,DC.HWP!DC.AWL ;WRITABLE?
JRST BLESF2 ;YES
TXNN F,S.WRTL ;NO--WAS /NOWRIT SPECIFIED?
PUSHJ P,[MOVEI N,[ASCIZ/%READ-ONLY /] ;NO WARN USER
PJRST BLESF6
]
BLESF2:
POP P,A ;GET ORIGINAL ARG
CAME A,DSKCHA+.DCSNM ;SAME AS STRUCTURE NAME?
PUSHJ P,[PUSHJ P,MSGQUO
MOVEI N,[ASCIZ/ IS NAME FOR /]
MOVE A,DSKCHA+.DCSNM
PJRST MSG6BA
]
MOVE A,DSKCHA+.DCSNM ;GET STRUCTURE NAME
JRST CPOPJ1
BLESF6: EXCH A,(P) ;GET NAME AND SAVE A
PUSHJ P,MSG6BA
EXCH A,(P)
POPJ P,
BLESF8: MOVEI N,[ASCIZ/?UNDEFINED STRUCTURE /]
BLESF9: POP P,A
MOVEI C,10
PJRST MSG6BA
;GET A FILE STRUCTURE
;CALL F.STAR=1 IF '*' IS LEGAL
; F.SLS =1 IF S.L. SWITCHES ARE LEGAL
;RET+1 ERRORS:
; C=1-4: SWITCH ERRORS (MSG TYPED)
; 10: OTHER ERROR (MSG TYPED)
;RET+2 F.S. AND/OR SWITCHES FOUND:
; A=0 IF NO F.S. FOUND (MAY BE SWITCHES)
; A=NAME (OR '*')
; ICH=DELIMITING CHARACTER
; F=BITS CORRESPONDING TO SWITCHES SEEN
GETFS: TXNN F,F.SLS ;S.L. SWITCHES OK?
JRST GETFS1 ;NO
MOVE C,CMAOBJ ; CK FOR LEADING SWITCHES
MOVEI D,CMXCT
PUSHJ P,SWITCH
JRST GETFSE
GETFS1: PUSHJ P,GETAR0 ;READ FILE STRUCTURE NAME
JUMPN A,GETFS2 ;JUMP IF NO NAME
TXNE F,F.STAR ;'*' LEGAL?
CAIE ICH,"*" ; IF SO, IS IT '*'?
JRST CPOPJ1 ;NO--RETURN
MOVX A,'* ' ;MAKE A=6BIT *
TXO F,F.SARG ;REMEMBER THAT * WAS SEEN
JRST GETFS3
GETFS2: CAIN ICH,":" ;NO PENALTY FOR :
GETFS3: SETZM ICH ; JUST FLUSH IT
PUSH P,A ;SAVE FS NAME
MOVE C,FSAOBJ ;LOOK FOR SWITCHES
TXNE F,F.SLS
MOVE C,F2AOBJ
MOVEI D,FSXCT
TXNE F,F.SLS
MOVEI D,F2XCT
PUSHJ P,SWITCH
JRST [POP P,D ;ERROR-POP A
JRST GETFSE ;SWITCH ERROR
]
POP P,A
JRST CPOPJ1
GETFSE: PJRST SWIERR ;SWITCH ERROR -- PRINT MSG & RETURN
;GET A PPN
;CALL PPN=JOBS PPN (FOR DEFAULTING)
; F.NORB=1 IF DONT REQUIRE TERMINATING RIGHT BRACKET
;RET+1 ERROR
;RET+2 A=PPN
GETPP: PUSHJ P,SST
GETPP0: CAIE ICH,"[" ;MUST BE ENCLOSED IN BRACKETS
POPJ P,
SETZM ICH ;FLUSH "["
PUSHJ P,SOCTIN ;GET PROJECT
SKIPN N ;IF 0 USE USER'S PROJ
MOVS N,PPN
HRLZ A,N
PUSHJ P,SST ;IGNORE SPACES
CAIN ICH,"]" ;IF THIS IS THE END:
JRST GETPP2 ; USE JOBS PROG.NO.
CAIE ICH,"," ;OTHERWISE MUST BE A COMMA
POPJ P,
PUSHJ P,SOCTIN ;GET PROGRAMMER
SKIPN N ;IF 0 USE JOBS PROG.
GETPP2: MOVE N,PPN
HRR A,N
PUSHJ P,SST ;IGNORE SPACES
CAIE ICH,"]" ;MUST END WITH BRACKET
JRST [TXNN F,F.NORB ;REQUIRE TERMINAL BRACKET?
POPJ P, ;YES-ERROR RET
JRST CPOPJ1 ;NO
]
SETZM ICH ;FLUSH BRACKET
JRST CPOPJ1
;TYPE PPN IN B WITH BRACKETS
TYPPPN: PUSHJ P,RBRAK ;TYPE [
HLRZ N,B
PUSHJ P,OCTPRT ;PROJECT
PUSHJ P,COMMA
HRRZ N,B
PUSHJ P,OCTPRT ;PROGRAMMER
PJRST LBRAK ;]
GETARG: PUSHJ P,SSST
GETAR0: PUSHJ P,SST
MOVE N,[POINT 6,A]
SETZ A,
JRST GETAR3 ;ALREADY HAVE A CHAR
GETAR1: PUSHJ P,(I)
POPJ P,
GETAR3: CAIL ICH,"A"
CAILE ICH,"Z"
SKIPA ;SKIP IF NOT A LETTER
JRST GETAR2
CAIL ICH,"0"
CAILE ICH,"9"
POPJ P, ;EXIT FIRST NON-ALPHANUMERIC
GETAR2: SUBI ICH,40 ;MAKE SIXBIT
TLNE N,770000
IDPB ICH,N
JRST GETAR1
SOCTIN: PUSHJ P,SSST
SETZ N,
OCTINL: CAIL ICH,"0"
CAILE ICH,"7"
POPJ P, ;EXIT FIRST NON-OCTAL DIGIT
ASH N,3
ADDI N,-60(ICH)
PUSHJ P,(I)
JRST [MOVX ICH,.CHCNZ
POPJ P,
]
JRST OCTINL
;SCAN A LIST OF SWITCHES
;CALL C=AOBJN PTR TO 6BIT NAME TABLE
; D=ADDRESS OF CORRESPONDING XCT TABLE
;RET+1 ERROR:
; C=1: NON UNIQUE SWITCH (NAME IN A)
; 2: UNDEFINED SWITCH (NAME IN A)
; 3: BLANK SWITCH (LONE '/')
; 4: SWITCH ARGUMENT ERROR
;RET+2 NO SWITCHES OR ALL OK
SWITCH: SUB D,C ;CALC. OFFSET TO XCT TABLE
PUSH P,D ; AND SAVE IT ON STAACK
PUSH P,C
SWITC2: PUSHJ P,GETSWI ;GET A SWITCH
JRST SWITC3
MOVE B,C
SETZM C ;C=0 IS OK RETURN FROM XCT BELOW
ADD B,-1(P) ;MAKE ADDRESS OF CORRESP. XCT
XCT (B)
JUMPN C,SWITC4 ;JUMP IF ERROR
MOVE C,(P) ;RELOAD C AND DO IT AGAIN
JRST SWITC2
SWITC3: SKIPN C ;IF 'NO SWITCH' RETURN
AOS -2(P) ; GIVE SKIP RETURN
SWITC4: POP P,D ;THROW AWAY TOP 2 ITEMS ON PDL
POP P,D
POPJ P,
;READ AND MATCH A SWITCH
;CALL C=AOBJN PTR TO 6BIT NAME TABLE
;RET+1 NO SWITCH OR ERRRORS
; C=0: NO SWITCH
; 1: SWITCH NOT UNIQUE (NAME IN A)
; 2: SWITCH UNDEFINED (NAME IN A)
; 3: BLANK SWITCH (LONE '/')
;RET+2 SWITCH OK: C=CORRESPONDING AOBJN PTR
GETSWI: PUSHJ P,SST ;SPACE PAST NOISE
CAIE ICH,"/"
JRST GETSW7 ;NO SLASH--NO SWITCH
SETZM ICH ;FLUSH "/"
PUSHJ P,GETNA0 ;AND LOOKUP NAME
JRST GETSW8 ;ERRORS
JRST CPOPJ1 ;GOOD RETURN
GETSW7: SETZM C ;NO SWITCH--RETURN+1 C=0
POPJ P,
GETSW8: CAIN C,0 ;NO NAME IS ERROR 3
MOVX C,3
POPJ P,
;TYPE SWITCH ERROR MESSAGES
;CALL C=1: NOT UNIQUE (NAME IN A)
; 2: UNDEFINED (NAME IN A)
; 3: BLANK (LONE '/')
; 4: ARGUMENT ERROR
SWIERR: CAIE C,3 ;BLANK?
JRST SWIER2 ;NO
MOVEI N,[ASCIZ/?BLANK SWITCH
/]
PJRST MSGTTY
SWIER2: CAIN C,1 ;GET APPROPRIATE MSG.
MOVEI N,[ASCIZ/?NON-UNIQUE/]
CAIN C,2
MOVEI N,[ASCIZ/?UNDEFINED/]
CAIN C,4
MOVEI N,[ASCIZ/?ILLEGAL ARG FOR/]
PUSHJ P,MSGTTY
MOVEI N,[ASCIZ/ SWITCH '/]
PUSHJ P,MSGTTY
PUSHJ P,SIXMSG
PUSHJ P,QUOTE
PJRST CRLF
;READ AND MATCH A NAME
;CALL C=AOBJN PTR TO 6BIT NAME TABLE
;RET+1 ERROR OR NO NAME:
; C=0: NO NAME
; 1:NOT UNIQUE
; 2:NO MATCH
;RET+2 MATCHED: C=MATCHING AOBJN PTR
GETNAM: PUSHJ P,SSST ;IGNORE NOISE
GETNA0: PUSHJ P,SST
PUSHJ P,GETAR0
JUMPN A,GETNA1 ;IF NO NAME:
SETZM C ; RETURN+1 C=0
POPJ P,
GETNA1: SETOM B ;MAKE A MASK FOR A IN B
LSH B,-6
TDNE B,A
JRST .-2
SETCMM B
SETZM N ;REMEMBER PARTIAL MATCHES IN N
GETNA3: CAMN A,(C) ;EXACT MATCH?
JRST CPOPJ1 ;YES
MOVE D,(C) ;NO-PARTIAL (MASKED) MATCH?
AND D,B
CAME D,A
JRST GETNA5 ;NO
JUMPE N,GETNA4 ;YES-1ST PARTIAL MATCH?
MOVX C,1 ;NO--ERROR 1
POPJ P,
GETNA4: MOVE N,C ;YES-REMBER ITS AOBJN
GETNA5: AOBJN C,GETNA3
SKIPE C,N ;END OF TABLE--MATCH?
JRST CPOPJ1 ;YES
MOVX C,2 ;NO--ERROR 2
POPJ P,
SSST: PUSHJ P,(I)
MOVX ICH,.CHCNZ ;EOF
SST: JUMPE ICH,SSST
CAIE ICH,11 ;TAB
CAIN ICH,40 ;OR SPACE
JRST SSST ;IGNORE
POPJ P,
OCTPRT: IDIVI N,10
HRLM N1,(P) ;SAVE NEXT DIGIT ON STACK
SKIPE N ;SKIP IF NO MORE DIGITS
PUSHJ P,OCTPRT
HLRZ OCH,(P) ;GET LAST DIGIT
ADDI OCH,"0" ;MAKE ASCII
PJRST (O) ;OUTPUT IT AND POP A LEVEL
SIXMSG: MOVE N,[POINT 6,A]
SIXMS1: ILDB OCH,N
JUMPE OCH,CPOPJ
ADDI OCH,40
PUSHJ P,(O)
TLNE N,770000
JRST SIXMS1
POPJ P,
;TYPE ERROR MSG WITH 6BIT ARGUMENT
;CALL N=ASCIZ MESSAGE ADDRESS; A=6BIT ARG
;RET+1 C PRESERVED
MSG6BA: PUSHJ P,MSGTTY
PUSHJ P,MSGQUO
PJRST CRLF
;TYPE 6BIT IN A ENCLOSED IN QUOTES
MSGQUO: PUSHJ P,QUOTE
PUSHJ P,SIXMSG
PJRST QUOTE
;RET+1 NOT END OF LINE
;RET+2 END OF LINE
EOLSKP: PUSHJ P,NELSKP
JRST CPOPJ1
POPJ P,
;RET+1 END OF LINE
;RET+2 NOT END OF LINE
NELSKP: PUSHJ P,SST
NELSK0: CAIE ICH,.CHLFD ;LF?
CAIN ICH,ALTMOD
POPJ P,
CAIN ICH,.CHCNZ ;^Z?
POPJ P,
JRST CPOPJ1
;COMMAND TABLES
DEFINE CTAB (AOBJ,OFFSET)<
XLIST
DEFINE CC (NAM,ADDR)<SIXBIT\NAM\>
CTABX==.
CLIST
AOBJ==CTABX-.,,CTABX
DEFINE CC (NAM,ADDR)<Z ADDR> ;[47]MACRO V50 COMPATIBILITY
OFFSET==.-CTABX
CLIST
LIST
>
DEFINE CLIST<
CC <C >,JCREAT
CC <R >,JREMOV
CC <A >,JADD
CC <M >,JMODIF
CC <T >,JTYPE
CC <SYS >,JSYS
CC <NOSYS >,JNSYS
CC <NEW >,JNEW
CC <NONEW >,JNNEW
CC <LIB >,JLIB
CC <NOLIB >,JNLIB
CC <CS >,SCREAT
CC <RS >,SREMOV
CC <AS >,SADD
CC <MS >,SMODIF
CC <TS >,STYPE
CC <CP >,PCREAT
CC <TP >,PTYPE
CC <SCAN >,PSCAN
CC <NOSCAN>,PNSCAN
CC <HELP >,HELPCM
>
CTAB (CAOBJ,COFSET)
;SWITCH TABLES
DEFINE STAB (AOBJ,XCTAD)<
XLIST
DEFINE SS (NAM,XCT)<XCT>
XCTAD: SLIST
AOBJ: XCTAD-.,,.+1
DEFINE SS (NAM,XCT)<SIXBIT\NAM\>
SLIST
LIST
>
; FILE STRUCTURE SWITCHES
DEFINE SLIST<
SS <CREATE>,<PUSHJ P,SWCREA>
SS <C >,<PUSHJ P,SWCREA>
SS <NOCREA>,<TXO F,S.NOCR!S.SWIT>
SS <N >,<TXO F,S.NOCR!S.SWIT>
SS <WRITE >,<PUSHJ P,SWWRIT>
SS <W >,<PUSHJ P,SWWRIT>
SS <NOWRIT>,<TXO F,S.WRTL!S.SWIT>
SS <R >,<TXO F,S.WRTL!S.SWIT>
>
STAB FSAOBJ,FSXCT;
; SEARCH LIST SWITCHES
DEFINE SLIST<
SS <LIB >,<PUSHJ P,LIBARG>
SS <NOLIB >,<TXO F,F.NLIB>
SS <SYS >,<TXO F,F.SYS>
SS <NOSYS >,<TXO F,F.NSYS>
SS <NEW >,<TXO F,F.NEW>
SS <NONEW >,<TXO F,F.NNEW>
>
STAB CMAOBJ,CMXCT
; SEARCH LIST AND FILE STRUCTURE SWITCHES
DEFINE SLIST<
SS <CREATE>,<PUSHJ P,SWCREA>
SS <C >,<PUSHJ P,SWCREA>
SS <NOCREA>,<TXO F,S.NOCR!S.SWIT>
SS <N >,<TXO F,S.NOCR!S.SWIT>
SS <WRITE >,<PUSHJ P,SWWRIT>
SS <W >,<PUSHJ P,SWWRIT>
SS <NOWRIT>,<TXO F,S.WRTL!S.SWIT>
SS <R >,<TXO F,S.WRTL!S.SWIT>
SS <LIB >,<PUSHJ P,LIBARG>
SS <NOLIB >,<TXO F,F.NLIB>
SS <SYS >,<TXO F,F.SYS>
SS <NOSYS >,<TXO F,F.NSYS>
SS <NEW >,<TXO F,F.NEW>
SS <NONEW >,<TXO F,F.NNEW>
>
STAB F2AOBJ,F2XCT
; PATH SWITCHES
DEFINE SLIST<
SS <SCAN >,<TXO F,F.SCN>
SS <NOSCAN>,<TXO F,F.NSCN>
>
STAB PTAOBJ,PTXCT;
SWCREA: TXZA F,S.NOCR
SWWRIT: TXZ F,S.WRTL
TXO F,S.SWIT
POPJ P,
LIBARG: CAIE ICH,":" ;OPTIONAL ":"?
JRST LIBAR2
PUSHJ P,(I) ;YES-FLUSH IT
MOVEI ICH,.CHCNZ
LIBAR2: PUSHJ P,GETPP0 ;GET PPN
JRST LIBAR3 ;ERROR
MOVEM A,LIBPPN
TXOA F,F.LIB ;SET BIT IN F
LIBAR3: MOVX C,4 ;RETURN ERROR 4
POPJ P,
HELPCM: MOVEI N,HELPMS
PUSHJ P,MSGTTY
JRST ST1
HELPMS: ASCIZ \Src.Lst.Commands: C M A R T LIB NOLIB SYS NOSYS NEW NONEW
Sys.Src.Lst.Commands: CS MS AS RS TS
Path Commands: CP TP SCAN NOSCAN
File Str. Switches: /WRITE /NOWRITE /CREATE /NOCREATE
Src.Lst.Switches: /LIB:[ppn] /NOLIB /SYS /NOSYS /NEW /NONEW
Path Switches: /SCAN /NOSCAN
* = Current Src.Lst.
For complete description type monitor command 'HELP SETSRC'
\
STXERR: MOVEI N,[ASCIZ/?SYNTAX ERROR /]
PUSHJ P,MSGTTY
STXER1: PUSHJ P,NELSK0
JRST COMERR
MOVE OCH,ICH
PUSHJ P,W.TTY
PUSHJ P,(I)
MOVEI ICH,.CHCNZ
JRST STXER1
STRUER: MOVE N,[IOWD STRERL,STRERM]
PJRST ERCOD1
ERRM: PUSHJ P,CRLF
ERRM2: MOVE N,A
PUSHJ P,MSGTTY
PJRST CRLF
STRERM: ;STRUUO ERROR TABLE (XWD ERROR CODE, MSG. ADDR)
; XWD FSSNF%,[ASCIZ/?FILE STRUCTURE NOT FOUND/]
; XWD FSSSA%,[ASCIZ/?FILE STRUCTURE IS SINGLE-ACCESS/]
; XWD FSTME%,[ASCIZ/?TOO MANY FILE STRUCTURES/]
XWD FSNPV%,[ASCIZ/?REQUIRES PRIVILEGED JOB/]
; XWD FSRSL%,[ASCIZ/?FILE STRUCTURE REPEATED IN LIST/]
XWD 0,[ASCIZ/?STRUUO ERROR CODE /]
STRERL==.-STRERM
NEVERR: PUSH P,A
MOVEI N,[ASCIZ/
? SYSTEM ERROR AT LOC - /]
OCTERR: PUSHJ P,MSGTTY
POP P,N ;GET ROTTEN LOCATION
HRRZS N
PUSHJ P,OCTPRT
JRST COMERR
;LOOKUP ERROR CODE MSG AND TYPE IT
;CALL A=EROR CODE
; N=AOBJ PTR TO ERROR MSG'S (XWD CODE,MSG-ADDRESSES)
; LAST ENTRY IN LIST IS TYPED IF CODE MATCH NOT FOUND
ERCOD0: PUSHJ P,CRLF
ERCOD1:
AOBJP N,ERCOD5
ERCOD2: HLRZ C,(N)
CAMN C,A
JRST [HRRZ N,(N)
PUSHJ P,MSGTTY
PJRST CRLF
]
AOBJN N,ERCOD2
ERCOD5: HRRZ N,(N)
PUSHJ P,MSGTTY
MOVE N,A
PUSHJ P,OCTPRT
PJRST CRLF
CRLF: JSP N,MSGTTY
ASCIZ .
.
COLON: JSP N,MSG
ASCIZ/:/
COMMA: MOVX OCH,<",">
PJRST (O)
RBRAK: MOVX OCH,<"[">
PJRST (O)
LBRAK: MOVX OCH,<"]">
PJRST (O)
SPACE: MOVX OCH,<" ">
PJRST (O)
QUOTE: JSP N,MSG
ASCIZ/'/
STAR: JSP N,MSGTTY
ASCIZ .
*.
QUES: MOVEI N,[ASCIZ .
?.]
; PJRST MSGTTY ;FALL INTO MSGTTY
MSGTTY: MOVEI O,W.TTY
MSG: HRLI N,440700
MSGL: ILDB OCH,N
JUMPE OCH,CPOPJ
PUSHJ P,(O)
JRST MSGL
R.TTY: TXZE F,F.TYO
OUTPUT TTY,
SOSLE RH.TTY+2
JRST TTYOKR
INPUT TTY,
STATZ TTY,20000
JRST TTYEOF
TTYOKR: ILDB ICH,RH.TTY+1
JUMPE ICH,R.TTY
CAIE ICH,.CHDEL ;DELETE?
CAIN ICH,.CHCRT ;CAR.RET?
JRST R.TTY
CAIL ICH,.CHALT ;OLD ALTMODE?
MOVX ICH,ALTMOD
CAIL ICH,140
TRZ ICH,40
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
TTYEOF: MOVX ICH,.CHCNZ
POPJ P,
W.TTY: SOSG WH.TTY+2
OUTPUT TTY,
IDPB OCH,WH.TTY+1
TXO F,F.TYO
CAIG OCH,.CHCRT ;CAR.RET?
OUTPUT TTY,
POPJ P,
JOB: 0 ;JOB NUMBER
PPN: 0 ;JOBS PPN
MONVER: 0 ;MON.'VERSION' FIELD OF STATES WORD
LIBPPN: 0 ;PPN ARG ON /LIB:
PDP: IOWD 20,.+1
BLOCK 20
WH.TTY: BLOCK 3
RH.TTY: BLOCK 3
B.TTY: BLOCK 2*26
SLBLKL==.DFGST+1
SLBLOK: BLOCK SLBLKL ;S.L. (JOBSTR/GOBSTR) ARG.LIST
FSBLKL==3*MAXFS+^D14
FSBLOK: BLOCK FSBLKL
DSKCHL==.DCSAJ+1
DSKCHA==FSBLOK ;ARG.LIST FOR DSKCHR
IFG DSKCHL-FSBLKL,<BLOCK DSKCHL-FSBLKL>
FSNAML==MAXFS+1
FSNAM: BLOCK FSNAML
FSBIT: BLOCK FSNAML
PTHBLK: 0 ;ARG (= -1 OR -2)
PTHSSW: 0 ;SCANNING SWITCH
PTHPPN: 0
PTHSFD: BLOCK SFDLEN
PTHLEN==.-PTHBLK
PATCH: BLOCK 30
SETEND: END SETSRC