1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-01 09:21:15 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1454 lines
32 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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