Trailing-Edge
-
PDP-10 Archives
-
BB-F494Z-DD_1986
-
10,7/sosini.mac
There are 3 other files named sosini.mac in the archive. Click here to see a list.
TITLE SOSINI - Initialization code
; --------------------------
;
; This file contains the following:
; 1. The initialization code
; 2. Command string parse code
; 3. Option file handler
;
SEARCH SOSTCS
$INIT
; Following symbols are defined here as global to make life with DDT
; simpler
Z=:Z
T1=:T1
T2=:T2
T3=:T3
T4=:T4
T5=:T5
ALTP=:ALTP
SINDEX=:SINDEX
P=:P
FL=:FL
FL2=:FL2
PNTR=:PNTR
C=:C
CS=:CS
; Channel assignments
TTY=:TTY
IN=:IN
OUT=:OUT
LPT=:LPT
ALTDV=:ALTDV
IND=:IND
OPT=:OPT
SUBTTL Startup Code
; This code is executed following a RUN or START command.
SOS:: TDZA T4,T4 ; Normal entry point
SETO T4, ; CCL entry
SETZM ERSW## ; not doing an Exit-Restart
SETZM TMPNAM ; No temp yet
MOVE P,[IOWD PDLSIZ,PDL]
;
; Move initial data values to the low segment
;
RESET
IFN RENTSW,<
MOVE T1,[DATAB,,DATABL]
BLT T1,ZEROB-1 ; Move down to low segment
>
SETZM ZEROB
MOVE T1,[ZEROB,,ZEROB+1]
BLT T1,IMPEND
MOVE T1,[BYTE (7) 15,15,15,15,15]
MOVEM T1,CRSX ; Put CR's in place
MOVEM T4,CCLENT## ; Remember how we started
SKIPN CCLFLG## ; User want CCL entry treated specially?
SETZM CCLENT## ; No -- forget how we came in
SKIPE CCLENT ; CCL entry?
SETZM TELFLG## ; Yes -- don't give filename on exit
;
; Setup TTY output buffer, OPEN TTY, and enable APR for PDL overflow
;
PUSHJ P,DISINT## ; Disable ^C intercept
SETZ FL, ; Clear flag register
MOVSI FL2,DFBKSW ; Setup default /BACKSPACE switch
MOVE T1,[JSR ERRHD] ; Set up UUO handler
MOVEM T1,.JB41##
MOVEI T1,PDLOV ; Set up a PDLOV trap
MOVEM T1,.JBAPR##
MOVEI T1,200000 ; Set for PDLOV only
APRENB T1,
OPEN TTY,TTDEVI ; For input only
EXIT ; You lose
PUSHJ P,CTTBFO## ; Initialize TTY output buffer
ONECHO ; Turn on the echoing and set status
SKIPN T1,TTYBA##
MOVE T1,.JBFF## ; Get current first free address
MOVEM T1,TTYBA## ; Save as TTY buffer address
MOVEM T1,.JBFF## ; Ensure .JBFF is correct
CONT.
INBUF TTY,1 ; Get 1 buffers for the teletripe
MOVE T1,.JBFF
MOVEM T1,TTYBE## ; Save ending address, needed by SOSEND
;
; See if user has more than one structure. Used only as a typeout
; criterion.
;
SETOM STRNAM ; Look at search list
SETOB T2,STRCNT## ; Clear STR name and count
;
SKIPA T1,[3,,STRNAM]
STRLUP: AOS STRCNT
JOBSTR T1, ; Get STR name
JRST GMYPPN ; Must only be one structure
SKIPE STRNAM ; Any found this pass
JRST STRLUP ; And look for more
GMYPPN: GETPPN T1, ; Get his ppn
JFCL ; in case of JACCT
MOVEM T1,MYPPN##
HRROI T1,.GTLPN ; Get logged in PPN
GETTAB T1, ; From monitor
MOVEI T1,0 ; Not implemented
MOVEM T1,LOGPPN ; Save
MOVE T1,[%CNPGS] ; Read core allocation units
GETTAB T1, ; Read from monitor
MOVEI T1,1000+IFE KIONLY,<1000> ; Assume K or P.
SOS T1 ; Make into mask
MOVEM T1,CAUNIT ; Save for COMND
IFN CCLSW,<
;
; Re-scan the input line, and save the contents of the rescanned line.
;
MOVE T1,[POINT 7,CMDBUF]
MOVEM T1,P.TEXT
RESCAN 1 ; Rescan input line
SKPINL ; Is something there?
JRST [MOVE T1,[BYTE (7) "S","O","S",12,0]
MOVEM T1,CMDBUF
JRST RPGRT0]
MOVEI T2,5*^D20
CMDL: SKPINC ; Make sure something there
JRST CMDD ; No--give up
INCHWL T3 ; Yes--get it
CAIN T3,15 ; Pitch returns
JRST CMDL
IDPB T3,T1
CAIE T3,12 ; Look for terminator
CAIN T3,33
JRST CMDD
SOJG T2,CMDL
CMDD: MOVEI T3,12
DPB T3,T1
RPGRT0: SETOM RPGSW
>
CONT.
;
; Setup default parameters, and read the option file (SWITCH.INI)
; to setup the users defaults.
;
PUSHJ P,CHKCOM## ;CHECK /COMPATIBILY AND DEFAULTS
PUSHJ P,SETDIS## ;DEFAULT /DISPLAY
IFN INFSW,<
PUSHJ P,SETINF## ; Say /INFORM
>
SETOM .BAKF## ; Set default permanent /BAK
SETOM TELFLG ; /TELL is default also
PUSHJ P,SETNUM## ; Set for line number prompting
TLZ FL2,INPARS!BELLF; Say we are starting
SETZM OPTION ; Look for default
SETOM INIFLG## ; Flag this is initial
PUSHJ P,DOOPT ; Read the option file
CAIA ; Ignore not found return
PUSHJ P,PSEOMS## ; Say %Syntax error in default options
MOVEI T1,TTYCH## ; Set up default input
MOVEM T1,CHIN## ; Set it up
MOVE T1,STDPMT ; Standard prompt
MOVEM T1,CMDPMT ; Save as command prompt
;
; Here to startup the editor. Join here from all start/restart
; commands. Includes ER and normal start.
;
STRTUP::
TRO FL,NECHO ;FAKE ECHO OFF SO ONECHO DOES ITS THING
ONECHO ; Make sure TTY status is okay
MOVE T2,[IOWD RTPLSZ,RDTPDL]
MOVEM T2,RTIPDP ; Initialize Read Teco routine PDL
MOVE P,[IOWD PDLSIZ,PDL]
SETZM IBUF+.BFCTR ; Make sure we don't have any garbage
TLZ FL2,BELLF ;BAD THINGS HAPPEN IF ITS ON
PUSHJ P,SOSINI ; Parse command, initialize files
TLZA FL2,BELLF ;ERROR--DONT SET BELLF YET!
JRST STRTP1
;
; Here on an error during startup
;
SKIPE CXFPDP ; Are we trying to co-edit?
JRST CXERTN## ; Yes, just let him try again
CLEARM <RPGSW,NEWNAM,NEWEXT,ORGNAM,ORGEXT>
CLEARM <NAMEI+.RBEXT,NAMEO+.RBEXT>
MOVEI T1,TTYCH## ; Set up default TTY input
MOVEM T1,CHIN## ; Set it up
MOVEI T1,IPATH
MOVEM T1,ORGPTH
MOVEI T1,OPATH
MOVEM T1,NEWPTH ; Set up output path
MOVE T1,TTYBE
MOVEM T1,.JBFF## ; Reset Job First free
MOVEI T1,.RBBIG ; Size of lookup block
MOVEM T1,ALTFNM## ; Setup so can read temp files
PUSHJ P,DISINT## ; Clear control-C trapping
CLRBFI ; Clear the input buffer
SETZM ERSW ; And this since we will be prompting
OCRLF
MOVE T1,[7,,[ASCIZ/File: /]]
PUSHJ P,PROMPT## ; Prompt user for file
JRST STRTUP ; Try this again
STRTP1: PUSHJ P,ENBINT## ; Enable ^C intercept
PUSHJ P,RSTSVC## ; Clear /SAVE counters
SKIPE INTFLG## ; READ XSOS.INI?
PUSHJ P,DOINI## ; YES--DO IT NOW
TRNN FL,NEWFL ; New file to create?
JRST COMND## ; No, don't find current line
SKIPE NOAINF ; /NOINSERT
JRST CRLFCM## ; CRLF, then COMND
JRST CRTINS## ; Yes, go create it
SUBTTL SOSINI -- Main Initialization for SOS
; Here to parse command and initialize the file system
SOSINI: MOVEI T1,1 ; This to initialize page counter
MOVEM T1,CPGL ; logical page to 1
MOVEM T1,LSLOPG ; for all
MOVEM T1,CURINP ; interesting places
MOVE T1,LNZERO## ; And current logical
MOVEM T1,CLN ; number to zero
MOVEM T1,CURINS ; No last insert
MOVEM T1,LSLOLN ; Last range starts at top
MOVE T1,LN100## ; Default initial increment
SKIPN INCR ; Already set from option file?
MOVEM T1,INCR ; No, set it up
MOVSI T1,1 ; Set up big page
MOVEM T1,BGPG ; With a large number for now
SETZM OPNOUF ; No output temporary yet
; Here to parse the users command string. First, the rescanned
; line is checked for a valid command. If there isn't one, then
; the user is prompted for a file-specification by with the prompt
; "File: ". He is also reprompted if any errors occur during the
; initialization phase.
NOCOM0: SKIPGE ERSW ; Doing an exit-restart?
JRST RPGRET ; Yes, skip the parse
TLO FL2,INPARS
PUSHJ P,PARSE ; Parse command
SKIPN PNAMO+NAME ; Did we get a file name?
POPJ P, ; No, try again
PUSHJ P,SETTTY## ; Set any special TTY attributes needed
IFN %UACCL,<
SKIPN TMPNAM ; Did we get the ESF file yet?
PUSHJ P,DELTMP ; No, kill it now
>
SETZM INIFLG##
; (falls thru into next section)
MOVEI T1,.RBBIG ; Length of extended lookup block
MOVEM T1,NAMEI ;
MOVEM T1,NAMEO ;
MOVEI T1,NAMEI ; Point to input lookup block
MOVEM T1,PNTNMI ; Save for later reference
MOVEI T1,NAMEO ; Same for output lookup block
MOVEM T1,PNTNMO ; Save for later reference
MOVSI T1,'TMP' ; A temp file extension
MOVEM T1,NAMEI+XRBTFX ; Save for later reference
MOVSI T1,'TEM' ; Another temp file extension
MOVEM T1,NAMEO+XRBTFX ; Save for later reference
MOVSI T3,'SOS' ; Program id for tmp file
PUSHJ P,JOBNUM ; Fill in jobnumber to T3
MOVEM T3,EDNAM ; Save as edit name
;
; Here from restart for ER command. Skip some initialization
; Note: From here on, do NOT reference the symbols NAMEI and NAMEO.
; Use the pointers in PNTNMI and PNTNMO, which are carried in T4 and T5,
; respectively.
RPGRET::TLZ FL2,INPARS ; Parse done
TLO FL2,BELLF ; Allow bells
DMOVE T4,PNTNMI ; T4:=.PNTNMI; T5:=.PNTNMO
MOVEI T1,IPATH ; Input path
MOVEM T1,.RBPPN(T4) ; Set it up
MOVEI T1,OPATH ; Output path
MOVEM T1,.RBPPN(T5) ; Set it up also
HRLI T2,.RBPPN(T4) ; Point to input PPN
HRRI T2,ORGPTH ; Point to orginal name save area
BLT T2,ORGEXT ; Save orginal file spec
HLLZS ORGEXT ; Remember the original file name
MOVE T3,EDNAM ; Get edit file temporary name
MOVEM T3,.RBNAM(T5) ; as output file name
HLLZ T1,XRBTFX(T5) ; Temporary extension
MOVEM T1,.RBEXT(T5) ; for output temporary
SKIPN T1,DEV+PNAMI
MOVSI T1,'DSK'
MOVEI T2,@CHNTAB+IN ; Point to OPEN block
MOVEM T1,.OPDEV(T2) ; And setup the device
SETZM SVWD ; Zero words waiting
SETZM OLDLIN ; Used for order checking on input
SETZM TOTCHG ; Clear total change count
SETZM CHGCNT## ; Clear change counter
CONT.
OPNDSK IN,@CHNTAB+IN ; Open the input file
POPJ P,
LUKFIL: XLOOKP IN,@PNTNMI ; Do lookup of input file
POPJ P, ; Ooops
JRST [SKIPN DFXSW ; Default extension?
JRST CREAT ; Failed -- go create new file
SETZM DFXSW ; Yes, try null next
MOVEI T1,@PNTNMI
SETZ T2, ; Set to clear
EXCH T2,.RBEXT(T1) ; Clear and save the extension
SETZM ORGEXT ; Clear input file extension
MOVEM T2,SVDFX
JRST LUKFIL] ; Try again
PUSHJ P,GINSTR ; Input device
MOVEM T1,ORGDEV ; Save it for end code
TRNE FL,READOF ; Read-only?
JRST NOENT ; Yes, skip setting up output file then
LDB T1,[POINT 9,.RBPRV(T4),8]
LSH T1,^D27
MOVEM T1,SVPBTS ; No, save them
;
MOVE T1,.RBALC(T4) ; Get blocks allocated to old file
MOVEM T1,.RBEST(T5) ; and use as estimate of new file length
MOVE T1,.RBVER(T4) ; Input version
MOVEM T1,.RBVER(T5) ; becomes output version
;
SKIPN T1,PNAMO+DEV ; Explicit output device?
MOVSI T1,'DSK' ; Assume DSK device
SKIPE NEWNAM ; Don't copy STR and PPN if new name
JRST RPGR1 ;
MOVE T1,[IPATH,,OPATH] ; Copy the input path
BLT T1,OPATH+.PTMAX-1 ; To the output block
PUSHJ P,GINSTR ; No, use input device as output
RPGR1: MOVEI T2,@CHNTAB+OUT
MOVEM T1,.OPDEV(T2)
OPNDSK OUT,@CHNTAB+OUT ; and then the output file
POPJ P,
PUSHJ P,MAKFIL ; Make a temp file
POPJ P, ; Can't, ask user to try again
SETOM OPNOUF ; Note that the output file is open
CONT.
PUSHJ P,GOUSTR ; Output structure
MOVEM T1,NEWDEV ; Save as the output device for now
SKIPE NEWNAM ; New name?
JRST NOENT ; Yes, skip protection check
LDB T1,[POINT 9,.RBPRV(T4),8] ; Input file protection
PUSH P,T1 ; First word of CHKACC block
HRRZ T1,.RBPPN(T4) ; Input file path block pointer
PUSH P,.PTPPN(T1) ; Save file PPN
PUSH P,MYPPN ; My PPN
MOVEI T1,.ACREN ; Rename code
JSP T2,CK$ACC ; Check access
JUMPGE T1,PRTOK ; If protection is Okay
MOVEI T1,.ACWRI ; Check for supersede
JSP T2,CK$ACC ; Check access
JUMPL T1,WRIPRT ; File is write protected
MOVEI T1,.ACCPR ; Can we fix the file?
JSP T2,CK$ACC ; Check access
SKIPGE T1 ; If we can fix it later
WRIPRT: OUTSTR [ASCIZ/%Input file is write protected
/]
PRTOK: ADJSP P,-3 ; Fix PDL
NOENT: SKIPE T2,WINDOW## ; Window size specified?
JRST WINDNZ ; Yes, use that
MOVE T2,.RBSIZ(T4) ; Get size of the file
IDIV T2,WINRAT ; Divide by file:window ratio
CAMG T2,WINMIN ; Skip if too small
MOVE T2,WINMIN
WINDNZ: MOVEI T1,@CHNTAB##+OUT; Output device
MOVE T1,.OPDEV(T1) ; Get the device name
PUSHJ P,CLSTSZ## ; Get the cluster size
LSH T1,B2WLSH ; Convert to words
CAMG T1,T2 ; Ensure buffer GTR cluster size
MOVE T1,T2
CAML T1,WINMAX ; See if too large
MOVE T1,WINMAX ; Else use the maximum
PUSHJ P,BUFINI## ; Initialize buffer pointers, get core
JRST [MOVEI T1,@CHNTAB##+OUT
MOVE T1,.OPDEV(T1)
PUSHJ P,CLSTSZ## ; Get this again
CAIGE T1,^D10*BLKSIZ ; Or a reasonable size
MOVEI T1,^D10*BLKSIZ ; Use that
PUSHJ P,BUFINI## ; Try with smaller buffer
ERROR NEC ; This is hopeless
JRST .+1] ; Go with the small buffers
TRNE FL,READOF
SETZM NEWPTH
SKIPE CCLENT## ; Called from a compiler?
JRST NOSV3 ; Yes, don't give filename
PUSHJ P,GINSTR
MOVEM T1,STRNAM ; Save to post
TRNE FL,READOF ; Read only
SKIPN NEWNAM ; Should not have an output file
JRST NOSV2 ; Okay
OUTSTR [ASCIZ /%Output file not written in readonly mode
/]
NOSV2: PUSHJ P,PRCOFM## ; Print 'Co-' if appropriate
TRNE FL,READOF ; Read only?
OUTSTR [ASCIZ /Examining /]
TRNN FL,READOF
OUTSTR [ASCIZ /Editing /]
PUSHJ P,GIVEI ; Type input file name
SKIPN NEWNAM ; New file name too?
JRST NONEWN ; No, skip this
OUTSTR [ASCIZ /, output as /]
PUSHJ P,GVNAM## ; Type the output file name also
NONEWN: OCRLF
NOSV3: PUSHJ P,GETPSW ; Get encryption keys
SETZM OUTSIZ## ; Set output count to zero
SETZM AUXFIL ; No second temporary in use
PUSHJ P,IREAD## ; Fill up the buffer
JRST CPOPJ1##
SUBTTL Utility Routines--RJUST, GIVEI, PDLOV and GENSTR
; Subroutine to right justify a sixbit name
RJUST: MOVE T3,ACCUM ; Get the SIXBIT
MOVEI T1,0
RJUST1: MOVEI T2,0
LSHC T2,6
CAIL T2,"0"-40 ; Check for octal digit
CAILE T2,"7"-40
POPJ P,
LSH T1,3
IORI T1,-20(T2)
JUMPN T3,RJUST1 ; Done if nulls left
AOS (P)
POPJ P, ; Skip return for all ok
; Here to print input file name {dev:}f.e{[p,pn]}
GIVEI: SKIPLE STRCNT## ; Many STR's?
PUSHJ P,GVDSTR## ; Print it
MOVE T1,PNTNMI
PJRST TYPFND ; Print name, sans device
; Here to print output file name
REPEAT 0,<
GIVEO: SKIPLE STRCNT## ; Multiple STR's
PUSHJ P,GVDSTR## ; Print it
MOVE T1,PNTNMO ; Point to output file block
PJRST TYPFND ; Type name
>
; Here for pdl overflow
PDLOV:: MOVEI T1,200000
APRENB T1, ; Reset PDL handling
NERROR STC ; Gronk user
; Here to remove unit number from a structure name
;
; Call with
; MOVE T1,strnam
; PUSHJ P,GENSTR
; <always returns here with name in T1>
;Preserves all but T1.
GINSTR::SKIPA T1,PNTNMI ; Point to input LOOKUP block
GOUSTR::MOVE T1,PNTNMO
GENST0::MOVE T1,.RBDEV(T1) ; Get the device word
;
GENSTR::JUMPE T1,CPOPJ## ; Just return if null STR
PUSH P,T1 ; Save STR
ADJSP P,4 ; Make room for call
MOVEI T1,-4(P) ; Point to block
HRLI T1,5 ; Length
DSKCHR T1, ; Ask monitor
JRST [ADJSP P,-4 ; Unwind PDL
JRST T1POPJ##]; And return str name
POP P,T1 ; Structure name from DSKCHR
ADJSP P,-4 ; Unwind PDL
POPJ P, ; and return
; CK$ACC -- Routine to perform CHKACC UUO
; Call with
; MOVEI T1,access code
; PUSH P,protection
; PUSH P,file PPN
; PUSH P,MYPPN
JSP T2,CK$ACC
; <return here with code in T1>
CK$ACC: HRLM T1,-2(P) ; Operation desired
MOVEI T1,-2(P) ; Point to CHKACC block
CHKACC T1, ; Do the UUO
SETZ T1, ; If not implemented
JRST (T2) ; Return
SUBTTL READNM -- Subroutine to Accept a Filespec from User
; Routine to read a file name. called with
;
; MOVEI T3,address-1 of 4 word block to deposit filename
; That is, it points to the .RBCNT field of an extended lookup
; block:
; len
; proj,,prog or 0,,path_pointer
; filename
; extension
; 0,,0
; PUSHJ P,READNM
; <Return here if filespec error>
; <Normal return>
;
; Also checks for /S or /R and sets device into TMPDEV if given.
; T3 is destroyed.
READNM::PUSH P,ALTP ; Save ALTP
PUSH P,FL2 ; Save flags
TLZE FL2,INPARS ; Must clear this so get type from SCAN
SETZM SAVCHR ; Clear this, left over from parse
MOVE ALTP,T3 ; We'll use altp here
SETZM .RBNAM(ALTP)
SETZM .RBEXT(ALTP)
SETZM .RBPRV(ALTP)
SETZM TMPDEV ; Clear device
IFN CRYPSW,<
SETZM TMPCOD ; And key
>
SKIPE T1,.RBPPN(ALTP) ; Get path pointer
TLNE T1,-1 ; See if pointer
JRST [SETZM .RBPPN(ALTP)
JRST NOTPTH]
HRLI T1,-.PTMAX+.PTPPN; Length to zero
SETZM .PTPPN(T1)
AOBJN T1,.-1 ; Zero the path block
;
NOTPTH: SETZM RSW ; And switch flags
SETZM SSW
SETZM DFXSW
SETZM SVDFX
TRNN FL,IDF!NUMF ; Is it an ident
JRST FAPOPJ ; Error return
PUSHJ P,SCAN ; Get the separator character
MOVE T1,ACCUM ; And the last name found by scan
CAIE C,":" ; Is it a device
JRST NOTDEV ; No:
MOVEM T1,TMPDEV ; Yes: save in correct place
PUSHJ P,SCAN## ; Get next atom
TRNN FL,IDF!NUMF ; Is it an ident
JRST FAPOPJ ; No: return
PUSHJ P,SCAN ; Get separator character
MOVE T1,ACCUM ; Fetch arg
NOTDEV: MOVEM T1,.RBNAM(ALTP) ; Store as file name
CAIE C,"."
JRST RDDFXT ; Go set default extension
PUSHJ P,SCAN ; This should be an extension
TRNN FL,IDF!NUMF
TDZA T1,T1 ; Dummy up null extension
MOVE T1,ACCUM ; Get it
HLLZM T1,.RBEXT(ALTP) ; And put it in extension field
SKIPE T1 ; If break already parsed
PUSHJ P,SCAN
JRST CKPPN ; Go look for PPN
RDDFXT: SKIPE NEWNAM ; New file name?
SKIPA T1,NEWEXT ; Use latest extension
MOVE T1,ORGEXT ; Else this as default
HLLM T1,.RBEXT(ALTP) ; Stash default in the extension word
SETOM DFXSW ; Flag that a default is in use
CKPPN: CAIE C,"[" ; Now look for ppn
JRST RDTERM
SETPPN: PUSH P,ALTP ; Save file pointer
SKIPN ALTP,.RBPPN(ALTP)
HRROI ALTP,-.PTPPN(ALTP)
PUSHJ P,SCAN
MOVEI T1,(ALTP) ; Point to path block
PUSHJ P,CHKDFP ; Default path?
JRST NOTDF2
PUSHJ P,SCAN ; Get next character
CAIN C,"]" ; Find the bracket?
JRST SETP4 ; Yes, end of path
JRST AAPOPJ ; No, bad filespec
CONT.
NOTDF2: CAIN C,"," ; See if nothing typed
JRST [HLRZ T1,MYPPN
JRST SETP1]
TRNN FL,IDF!NUMF
JRST AAPOPJ
PUSHJ P,RJUST ; Right justify it
JRST AAPOPJ ; Skip return if not octal
SETP1: HRLZM T1,.PTPPN(ALTP) ; This is project number
CAIE C,"," ; Skip if comma already scanned
PUSHJ P,SCAN
CAIE C,","
JRST AAPOPJ
PUSHJ P,SCAN
TRNE FL,TERMF ; End of line?
JRST SETP2 ; Yes, fake a right bracket
CAIE C,"]" ; Scanned closing bracket?
CAIN C,"," ; or second comma?
SETP2: JRST [HRRZ T1,MYPPN ; Use default
HRRM T1,.PTPPN(ALTP)
JRST SETP3]
TRNE FL,IDF!NUMF
PUSHJ P,RJUST
JRST AAPOPJ ; Lose
HRRM T1,.PTPPN(ALTP) ; This is programmer number
PUSHJ P,SCAN
TRNE FL,TERMF ; End of line?
JRST SETP3 ; Yes, fake a right bracket for him
CAIE C,"]"
CAIN C,","
JRST SETP3
JRST AAPOPJ
CONT.
SETP3: CAIE C,"," ; SFD names given?
JRST SETP4 ; If no
JUMPL ALTP,AAPOPJ ; If SFDs not allowed
HRLI ALTP,-SFDLIM ; Set up pointer
;
SETP3A: PUSHJ P,SCAN ; Scan for next name
TRNN FL,IDF!NUMF ; See if something typed
JRST AAPOPJ ; Null SFD name not permitted
MOVE T1,ACCUM ; Get identifier
MOVEM T1,.PTPPN+1(ALTP) ; Save SFD name
PUSHJ P,SCAN ; Get delimiter
TRNE FL,TERMF ; If end of line
JRST SETP4
CAIN C,"]" ; Closing bracket?
JRST SETP4 ; Yes, end of path spec
CAIN C,"," ; Comma?
AOBJN ALTP,SETP3A ; Loop over all
AAPOPJ: POP P,ALTP ; Restore file pointer
FAPOPJ: POP P,FL2 ; Restore flags
JRST RDNMER ; Restore ALTP, give non-skip return
SETP4: POP P,ALTP ; Restore pointer to file block
TRNN FL,TERMF
PUSHJ P,SCAN
RDTERM:
IFN CRYPSW,<
CAIE C,"(" ; Did he give an encryption key?
JRST RDTRM1
MOVE T1,[POINT 7,CODBUF] ; Where to store code
MOVEI T2,CODMAX ; Maximum permissible length
RDTRM3: PUSHJ P,GNCH## ; Read a character
CAIN C,")" ; End?
JRST RDTRM2 ; Yes, go finish up
CAIGE C,40 ; Junk?
JRST FAPOPJ ; Yes, call the command bad
IDPB C,T1 ; Stash this character
SOJG T2,RDTRM3 ; Loop over whole key
JRST FAPOPJ ; Bad key
RDTRM2: MOVEI C,0 ; Zero terminator
IDPB C,T1 ; Save it
MOVEI ALTP,TMPCOD##-CODE ; Place to put it
PUSHJ P,SETCOD ; Convert to encryption key
PUSHJ P,SCAN ; Then scan ahead
>; End of IFN CRYPSW
CONT.
RDTRM1: POP P,FL2 ; Restore flags
CAIE C,"/" ; Check for read only mode
JRST APOPJ1 ; All ok
TLNE FL2,INPARS ; In parse?
MOVEM C,SAVCHR ; So we can parse the next switch
TLNE FL2,INPARS!INOPTF ; Option or command line?
JRST APOPJ1 ; Stop scanning now
PUSHJ P,SCAN ; Look for /R or /S
TRNN FL,IDF ; Is this an identifier
JRST RDNMER ; No, junk follows slash. Bad spec.
MOVS T1,ACCUM ; Get the switch name
CAIN T1,'R ' ; R?
SETOM RSW ; Yes, set flag
CAIN T1,'S ' ; or S?
SETOM SSW ; Yes, set flag
PUSHJ P,SCAN ; Prime scanner
SKIPN RSW ; Check for one switch only
SKIPE SSW ; (either R or S)
;
; Here to restore ALTP and return
;
APOPJ1::AOSA -1(P) ; Here to cause skip return
RDNMER::SETZM .RBNAM(ALTP) ; Clear name
APOPJ:: POP P,ALTP ; Restore ALTP
POPJ P, ; Return
CHKDFP: CAIE C,"-" ; Default path?
POPJ P,
HRLI T1,'DSK' ; Device for path UUO
HLLZM T1,.PTFCN(T1) ; Stash it in the path block
HRLI T1,.PTMAX ; Length
PATH. T1,UU.PHY
JFCL
JRST CPOPJ1##
SUBTTL PSW -- Routine to get a password for a file
GETPSW: TRZN FL2,R2.PSW ; Does he want to give these?
POPJ P, ; No
MOVEI ALTP,PNAMI ; First input
MOVE T1,[^D17,,[ASCIZ/Input password: /]]
TRNN FL,NEWFL ; Skip this if creating a new file
PUSHJ P,GETCOD ;
OCRLF ; A free CRLF
GETPS1: MOVEI ALTP,PNAMO ; Then output
MOVE T1,[^D18,,[ASCIZ/Output password: /]]
TRZN FL2,R2.DSW ; If decrypting
TRNE FL,READOF ; Readonly?
POPJ P, ; Don't ask for output password
PUSHJ P,GETCOD ; Read output password
SKIPN OCODE ; Any given?
JRST GETPS2 ; No, use input password
PUSH P,OCODE ; Save it
MOVE T1,[^D18,,[ASCIZ/Output password: /]]
OUTSTR [ASCIZ/Please confirm...
/]
SETZM OCODE ; Clear this now
PUSHJ P,GETCOD ; Read it again
POP P,T1 ; Restore first try
CAMN T1,OCODE ; Ensure a match
POPJ P, ; Yes, return
OUTSTR [ASCIZ/?Codes don't match
/]
SETZM OCODE
JRST GETPS1 ; Try again
GETPS2: MOVE T1,ICODE ; Input password
MOVEM T1,OCODE ; is now output password
POPJ P,
GETCOD: OFFECHO ; Turn off echo
SKIPE CODE(ALTP) ; Already have one?
POPJ P, ; Yes, return
PUSHJ P,PROMPT##
MOVE T1,[POINT 7,CODBUF]
MOVEI T2,CODMAX ; Max length
GETCD1: PUSHJ P,GNCH## ; Get a character
CAIN C,15 ; Ignore CR's
JRST GETCD1 ;
CAIN C,12 ; Stop on 12
JRST GETCD2
IDPB C,T1 ; Stash
SOJG T2,GETCD1 ; Loop
OUTSTR [ASCIZ/?Code too long
/]
JRST GETCOD ; Try again
GETCD2: ONECHO
OCRLF
CAIN T2,CODMAX ; Did he type anything?
POPJ P, ; No, leave well enough alone
PJRST SETCOD
SUBTTL Create a New File
; Come here with T1 = failure code for lookup
CREAT:: SKIPN NEWNAM ; Shouldn't fail on copy
TRNE FL,READOF ; or if READONLY
JRST CREATX ; Go give message
;
SKIPN T1,PNAMO+DEV ; User give a device?
MOVSI T1,'DSK' ; Use 'DSK' if not
MOVEI T2,@CHNTAB+OUT ; Point to output channel
MOVEM T1,.OPDEV(T2) ; Setup the device
OPNDSK OUT,@CHNTAB+OUT
POPJ P,
MOVEI T1,@PNTNMI ; Point to input block
SKIPN T2,SVDFX ; Did we save a default extension?
JRST NODEFX ; No
HLLM T2,.RBEXT(T1) ; Yes, use it now
HLLZM T2,ORGEXT ; and input too
NODEFX: SETZM .RBEST(T1) ; Clear estimate
SETZM .RBVER(T1) ; and version
MOVE T1,[IPATH,,OPATH] ; Input path as read
BLT T1,OPATH+.PTMAX-1 ; Save for output
PUSHJ P,MAKFIL ; Make an output temporary
POPJ P, ; Can't
SETOM OPNOUF ; So file can be deleted on QUIT
MOVE T1,[OPATH,,IPATH] ; Where file ended up
BLT T1,IPATH+.PTMAX-1 ; Remember this as original path
PUSHJ P,GOUSTR ; Input structure name
MOVEM T1,ORGDEV ; Save it
SETZM STRNAM ; Delete junk structure name
PUSHJ P,PRCOFM## ; Print co- if needed
OUTSTR [ASCIZ /Creating /]
PUSHJ P,GVNAM## ; Give the file name
CONT.
HRROI T1,.GTDFL ; Get user defaults table
GETTAB T1, ; get it
JRST NOUSDP ; User could not set it
TLNE T1,(JD.SDP) ; Did he set it
JRST UDSDFP ; Yes
NOUSDP: MOVE T1,[%LDSTP] ; Get system-wide default
GETTAB T1,
MOVSI T1,057000 ; Must be Level C. Good luck
UDSDFP: TLZ T1,777 ; Clear any junk
HLLZM T1,SVPBTS ; Save as output file protection at end
IFN CRYPSW,<
SETOM T1,OBUF+3
>
PUSHJ P,GOUSTR ; Get output device name
PUSHJ P,CLSTSZ## ; Get the cluster size
SKIPN T2,WINDOW ; Window size (specified)
MOVE T2,WINMIN ; Else use the minimum
LSH T1,B2WLSH ; Convert to words
CAMG T1,T2 ; Is the cluster size the largest
MOVE T1,T2 ; No, use his setting
CAML T2,WINMAX ; SEE IF TOO BIG
MOVE T2,WINMAX ; YES, USE MORE REASONABLE SIZE
PUSHJ P,BUFINI## ; Initialize buffer pointers
EXIT ; Not enough core
PUSHJ P,IPNTRS## ; Go initialize pointers
TRO FL,EOF!NEWFL ; Set end of file so won't try to read
IFN CRYPSW,<
PUSHJ P,GETPSW ; Setup encryption key if wanted
>
JRST CPOPJ1##
; Here on a lookup error. We get here if we couldn't find the
; file but we should have either because the user specified examine
; only or copy.
CREATX: MOVEI T3,(T1) ; Setup error code
MOVE T2,PNAMI+DEV ; Get his device
MOVE T1,PNTNMI ; Point to lookup block
PJRST LKPERR ; Type the bad news
SUBTTL Parse Code
; Look for system command. may be "R SOS" or "SOS" or "EDIT"
PARSE: SKIPLE ERSW ; Did we read the /CCL file?
POPJ P, ; Yep
MOVEI ALTP,PNAMO ; Init name pntr
MOVEI T1,LDCHR ; Set up chin for parse
EXCH T1,CHIN ; Save old value
MOVEM T1,SVPCIN ; ...
SETZM PZBEG ; Clear parse area
MOVE T1,[PZBEG,,PZBEG+1]
BLT T1,PZEND
SKIPN RPGSW
JRST PARSE1
PUSHJ P,RDSKIP
PUSHJ P,RDATOM ; Get first atom
TRO FL,F.LAHD
LDB T1,[POINT 6,D,5]
CAIE T1,"R"-40 ; RUN command?
JRST PARSE1 ; No: go parse command line
PUSHJ P,RDSKIP
PUSHJ P,RDATOM ; Skip file name
CAIN C,":" ; In case device name
JRST .-3
CAIE C,"[" ; Start of PPN or PATH
JRST PARSE9 ; No
PARS10: PUSHJ P,RDSKIP ; Skip blanks and so forth
PUSHJ P,RDATOM ; Read the next atom
CAIN C,12 ; Reach the end of line yet?
JRST PARSE9 ; Yes, no command will be found
CAIE C,"]" ; We want a closing bracket
JRST PARS10 ; Not yet. Path may be quite long.
PUSHJ P,RDSKIP ; More possible blanks
PUSHJ P,RDATOM ; Fetch next separator
PARSE9: CAIN C,"-" ; Dash break?
JRST [TRZ FL,F.LAHD
JRST FIXUP]
CAIN C,12 ; End of world?
JRST [SETZI D,
JRST RDEOT] ; Yes: process
PUSHJ P,RDSKIP ; No: skip core arg
PUSHJ P,RDATOM
TRO FL,F.LAHD
FIXUP: MOVE T1,[ASCII "SOS "]
MOVEM T1,CMDBUF ; Overwrite RUN command
MOVE T1,[POINT 7,CMDBUF+1]
MOVEI C," "
FIXUP1: IBP T1
CAMN T1,P.TEXT
JRST FIXUP2
DPB C,T1
JRST FIXUP1
FIXUP2: TRNN FL,F.LAHD ; Correct # of spaces
DPB C,T1
PARSE1: PUSHJ P,RDSKIP ; Return here to skip spaces
PARSE2: PUSHJ P,RDATOM
CAIN C,"/" ; Slash
JRST RDSLSH
CAIN C,"."
JRST RDPER
CAIE C,"_"
CAIN C,"="
JRST RDEQL
CAIE C," "
CAIN C," "
JRST RDSPAC
IFN CRYPSW,<
CAIN C,"("
JRST RDLPRN
>
CAIN C,"["
JRST RDPPN
CAIN C,":"
JRST RDCOLN
CAIN C,12
JRST RDEOT
CAIN C,"<" ;START OF PROTECTION?
JRST RDPROT ;YES--GET IT
ILLCHR: MOVEI T1,[ASCIZ /Illegal char in cmd/]
JRST COMERR
; Here when colon seen
RDCOLN: TRZN FL,F.SLSH ; In switch?
JRST RDCLN1 ; No: treat as device
TRO FL,F.LAHD ; Yes: set look ahead
JRST RDSPC1 ; And look at switch
RDCLN1: JUMPE D,RDCERR ; Error if null device
TROE FL,F.COLN ; Say seen one
JRST RDCERR
MOVEM D,DEV(ALTP) ; Stash
AOS STRCNT
JRST PARSE2 ; And cont parse
RDCERR: MOVEI T1,[ASCIZ /Illegal colon/]
JRST COMERR
RDPROT: PUSHJ P,CHKFIL ;SEE IF FILE SPEC
JUMPE D,PRERR ;ERROR IF NO ATOM
JRST RDSPAC ;ELSE TREAT LIKE SPACE
TRON FL,F.PROT ;JUST ONE PER SPEC
JRST RDPRO1 ;YES
PRERR: MOVEI T1,[ASCIZ/Illegal protection specified/];
JRST COMERR ;AND GIVE ERROR
RDPRO1: MOVEI D,0 ;CLEAR PROTECTION
RDPRO2: PUSHJ P,@CHIN ;GET A CHAR
PUSHJ P,PPNUM ;SEE IF DIGIT
SKIPA ;NO
JRST RDPRO2 ;YES--LOOP
CAIG D,777 ;SEE IF TOO BIG
CAIE C,">" ;OR ENDS WRONG
JRST PRERR ;YES
LSH D,^D27 ;POSITION
MOVEM D,PRTCOD ;SAVE
JRST PARSE2 ;AND CONTINUE
; Here when space seen
RDSPAC: TRZE FL,F.SLSH
JRST RDSPC1 ; Check switch
PUSHJ P,RDPLNK ; Store descriptor
JRST PARSE1
RDSPC1: MOVEM D,ACCUM ; Stash arg for decode
PUSHJ P,DOSET## ; Call on set code
JRST SWTERR ; Error return
TRO FL,F.LAHD ; Set look ahead
SETZM SAVC ; Clear backup and...
SETZM SAVCHR ; Break character areas for scan
JRST PARSE1 ; Continue parse
SWTERR: MOVEI T1,[ASCIZ /Illegal switch/]
JRST COMERR
; Here when equal sign seen
RDEQL: CAIN ALTP,PNAMI ; Make sure first one
JRST RDEQLE
TRZN FL,F.SLSH ; Is this the end of a switch?
JRST RDEQL1 ; Yes, go handle
MOVEM D,ACCUM
MOVEI C," " ; Fake a blank
MOVEM C,SAVC ; in the scanner
PUSHJ P,DOSET## ; Set the switch
JRST SWTERR ; If error
SETZ D, ; File must have been stored
RDEQL1: PUSHJ P,CHKFIL ; See if we have a file
JUMPE D,RDEQLE ; Ok if d .ne. 0
PUSHJ P,RDPLNK ; Stash remaining atom
TRZ FL,F.PER!F.COLN!F.PPN!F.CDSN!F.LAHD!F.PROT ;
;
MOVEI ALTP,PNAMI ; Clr flags and advance pntr
JRST PARSE2 ; And continue
RDEQLE: MOVEI T1,[ASCIZ /Illegal equal sign/]
JRST COMERR
; Here when slash seen
RDSLSH: PUSHJ P,CHKFIL
JUMPE D,RDSLS1
JRST RDSPAC
RDSLS1: TRZ FL,F.LAHD ; Clear look ahead
TRON FL,F.SLSH
JRST PARSE2
MOVEI T1,[ASCIZ /Illegal slash/]
JRST COMERR
; Here when left paren seen
IFN CRYPSW,<
RDLPRN: PUSHJ P,CHKFIL
JUMPE D,RDLPER
JRST RDSPAC ; Treat as space
TRON FL,F.CDSN ; Grntee unique code
JRST RDLPR1 ; Go snarf code
RDLPER: MOVEI T1,[ASCIZ /Illegal code spec./]
JRST COMERR
RDLPR1: MOVE T1,[POINT 7,CODBUF]
MOVEI T2,CODMAX
RDLPR2: PUSHJ P,@CHIN ; Fetch a char
CAIN C,")"
JRST RDLPR3
CAIN C,12
JRST RDLPER ; Error if eot
IDPB C,T1
SOJG T2,RDLPR2
MOVEI T1,[ASCIZ /Code too long/]
JRST COMERR
RDLPR3: MOVEI C,0
IDPB C,T1
PUSHJ P,SETCOD
TRZ FL,F.LAHD
JRST PARSE1
SETCOD: PUSHJ P,SAVCRX## ; Save CRYPT AC's
MOVEI 7,CODBUF
PUSHJ P,CRASZ.##
MOVEM 5,CODE(ALTP)
SETZM CODBUF ; Clear
SETZM CODBUF+1 ; to foil
SETZM CODBUF+2 ; nosy dump readers
POPJ P,
>
; Here when period seen
RDPER: JUMPN D,RDPER1
MOVEI T1,[ASCIZ /Null name with extension/]
JRST COMERR
RDPER1: TROE FL,F.PER
JRST [MOVEI T1,[ASCIZ /Illegal period/]
JRST COMERR]
MOVEM D,NAME(ALTP)
JRST PARSE2
; Here when end of cmd seen
RDEOT: PUSHJ P,CHKFIL
JUMPE D,RDEOT0
JRST RDSPAC ; Process as space if something there
RDEOT0: SETZM SAVCHR ; Clear tty input
TRZ FL,P.FLGS ; Clear parse flags
MOVE T1,SVPCIN ; Restore chin
MOVEM T1,CHIN
SKIPN PNAMO+NAME ; Anything?
JRST [MOVEI T1,[ASCIZ/Null filename illegal/]
SKIPE PNAMO+DEV
JRST COMERR
JRST COMER1]
PUSHJ P,WRTMP ; Yes: write out temp
SKIPN T1,TECINC ; Teco increment?
JRST [MOVE T1,LN10## ;GET XSOS DEFAULT
SKIPN NEWCMD ;SEE IF /COMPATIBILITY
MOVE T1,LN100## ;YES--DEFAULT 100
JRST .+1] ;AND CONTINUE
TRNE FL,READOF ;SEE IF READONLY
MOVE T1,LN1## ;YES--DEFAULT 1
MOVEM T1,TECINC ; Set correct one up
TRNN FL,READOF ;IF READONLY, FORCE TECFST TOO
SKIPN TECFST ; Start seq # given?
MOVEM T1,TECFST ; No: use increment
;
CAIE ALTP,PNAMO
JRST RDEOT1
;
MOVE T1,PNAMO+DEV ; Get output device
MOVEM T1,PNAMI+DEV ; and make it the input device
;
DMOVE T1,PNAMO+NAME
DMOVEM T1,NAMEI+.RBNAM ; Setup input file name
;
MOVE T1,[PNAMO+PPN,,PNAMI+PPN]
BLT T1,PNAMI+PPN+SFDLIM
MOVE T1,OCODE
MOVEM T1,ICODE
;
POPJ P,
RDEOT1: DMOVE T1,PNAMI+NAME
DMOVEM T1,NAMEI+.RBNAM ; Save in input lookup block
; Save new file parameters in NEW??? variables
MOVE T1,PNAMO+NAME
MOVEM T1,NEWNAM
MOVE T1,PNAMO+EXT
MOVEM T1,NEWEXT
MOVEI T1,OPATH ; Initialize output path pointer
MOVEM T1,NEWPTH
POPJ P,
; Here to read ppn's
RDPPN: PUSHJ P,CHKFIL ; See if file spec
JUMPE D,PPERR ; Error if no atom
JRST RDSPAC ; Else treat as space
TRON FL,F.PPN ; Grntee just one per file spec
JRST RDPPN1
PPERR: MOVEI T1,[ASCIZ /Illegal PPN or Path/]
JRST COMERR
RDPPN1: MOVEI D,0 ; Init ppn
RDPPN2: PUSHJ P,@CHIN ; Get a char
CAIN C,","
JRST RDPPN3
MOVEI T1,SFD-3(ALTP) ; Point to path block
PUSHJ P,CHKDFP ; See if default path
JRST NOTDF1
PUSHJ P,@CHIN ; Next
CAIN C,"]" ; Must find this
JRST PARSE1 ; Wins
JRST PPERR
NOTDF1: PUSHJ P,PPNUM
JRST PPERR
JRST RDPPN2
RDPPN3: TLNE D,-1 ; Grntee .le. 6 digits
JRST PPERR
TRNN D,-1 ; And .gt. 0
HLRZ D,MYPPN ; Use this project number as default
HRLZM D,PPN(ALTP) ; Stash proj#
MOVEI D,0 ; Init
RDPPN4: PUSHJ P,@CHIN ; Get next character
CAIN C,12 ; End of line
JRST RDPPN5 ; will suffice for a right bracket
CAIE C,"," ; SFD to follow?
CAIN C,"]" ; End of ppn?
JRST RDPPN5
PUSHJ P,PPNUM
JRST PPERR
JRST RDPPN4
RDPPN5: TLNE D,-1 ; Grntee .le. 6 digits
JRST PPERR
TRNN D,-1 ; 0 Programmer number?
HRRZ D,MYPPN ; Yes, use default
HRRM D,PPN(ALTP) ; Stash prog #
CAIN C,12 ; End of line?
JRST RDPPNT ; Go finish up
CAIN C,"]" ; End of path
JRST PARSE1 ; Yes: ok to cont
CONT.
RDSFD: MOVSI T3,-SFDLIM ; Max depth
HRRI T3,SFD(ALTP) ; Setup pointer to PATH area
;
RDSFD1: PUSHJ P,RDATOM ; Read an SFD name
MOVEM D,(T3) ; Save it
TRZ FL,F.LAHD ; Clear lookahead flag
CAIN C,12 ; End of line forcing end of path?
JRST RDPPNT ; Go finish up
CAIN C,"]" ; End of path?
JRST PARSE1 ; Yes, continue rest of parse
CAIN C,"," ; Legal separator?
AOBJN T3,RDSFD1 ; And less than maximum depth?
JRST PPERR ; No, explain the problem
RDPPNT: SETZ D, ; Clear accumulator
JRST RDEOT ; Finish up parse
PPNUM: CAIG C,"7" ; Check legal
CAIGE C,"0"
POPJ P,
IMULI D,10
ADDI D,-60(C)
AOS (P)
POPJ P,
; Command error routine
COMERR: PUSHJ P,FAEMSG## ; Message with a ?
; Routine is in SOSSET
IFN %UACCL,<
SKIPN TMPNAM ; Have we done this yet?
PUSHJ P,DELTMP ; No, go delete the ESF file
>
IFE %UACCL,< ;
SETOM TMPNAM ;DELTMP would have done this!
> ;
COMER1: TRZ FL,P.FLGS ; Clear parse flags
SETZM PNAMO+NAME ; Zap filename if any
SKIPE RPGSW
SKIPE TMPNAM ; Here once?
SKIPA
PUSHJ P,RDTMP ; Read temp (skip if ok)
POPJ P, ; Error return
JRST PARSE
; Here to stash atom in either name or ext
RDPLNK: JUMPE D,CPOPJ## ; Done if null atom
TRZN FL,F.PER ; Period?
JRST RDPLN1 ; No: stash name
HLLZM D,EXT(ALTP) ; Yes: extension
POPJ P,
RDPLN1: SKIPN NAME(ALTP)
SKIPE EXT(ALTP) ; May not get extension yet
JRST RDPLER ; Oops
MOVEM D,NAME(ALTP)
POPJ P, ; Return
RDPLER: MOVEI T1,[ASCIZ/Multiple filenames illegal/]
ADJSP P,-1
JRST COMERR ; Zonk!
; Here to read temp file
DLESFL==PDFL1 ; Allocate a temporary flag
IFN %UACCL,<
DELTMP: TROA FL2,DLESFL
>
RDTMP: TRZ FL2,DLESFL
SETOM TMPNAM ; State that we have tried
IFN %UACCL,<
OPEN ALTDV,ALDEVI ; Open up alternate channel
JRST RDTMP0 ; Anyway you look at it, we lose
SETSTS ALTDV,.IODMP ; Set for dump mode read
MOVSI T3,'ESF' ; Temp file name
PUSHJ P,JOBNUM ; Mush with job number
MOVSI T4,'TMP' ; Extension
DMOVEM T3,ALTFNM+.RBNAM; Set up file name and ext in LKP block
MOVE T1,MYPPN ; Get my PPN (As typed to LOGIN)
MOVEM T1,APATH+.PTPPN ; Save in path block
SETZM APATH+.PTPPN+1 ; Clear first SFD name
MOVEI T1,APATH ; Point to path
MOVEM T1,ALTFNM+.RBPPN; In the lookup block
SETZM ALTFNM+.RBPRV ; Zero protection
MOVEI T1,4 ; Length of Lookup block
MOVEM T1,ALTFNM ; Set it up
XLOOKP ALTDV,ALTFNM ; Look for the file
JFCL
JRST RDESF1 ; Wasn't there, look for TMP:EDT
TRNN FL2,DLESFL ; Don't do the read if just deleting
INUUO ALTDV,ESFIOWD## ; Input old data area
DELETE ALTDV,
JRST RDESF1 ; Return file--read didn't work
TRNE FL2,DLESFL ; Just deleting the ESF file?
JRST RDESF1 ; Yes, finish up
MOVE T1,CCLVER## ; Get version from file
CAIE T1,DVNCCL## ; Must match
JRST SOS ; No, try it again from the very top
TRZ FL,READOF
IOR FL,SVFL## ; Restore flags
MOVE FL2,SVFL2## ; from both flag registers
MOVE T1,SVINDV## ; Last input device
MOVEM T1,PNAMI+DEV ; Set it up
MOVE T1,SVOUDV## ; Now the output device
MOVEM T1,PNAMO+DEV ; Set that up too
MOVEI T1,1 ; Flag type of start
MOVEM T1,ERSW## ; in Edit-Restart SWitch
JRST CPOPJ1## ; Give good return
RDESF1: CLOSE ALTDV,
RELEAS ALTDV, ;AND RELEASE IT
RDTMP0: TRZE FL2,DLESFL ; Just delete ESF file?
POPJ P, ; Yes, return now
> ; End of %UACCL conditional
MOVNI T1,20 ; Buffer size
HRLM T1,T.IOWD
IFN TEMPC,<
MOVE T1,[XWD 1,T.HEAD]
TMPCOR T1,
SKIPA ; It failed - try file
JRST RDTMP1
>
MOVSI T3,(<SIXBIT /EDS/>)
PUSHJ P,JOBNUM
MOVEM T3,NAMEI+.RBNAM ; Stash file name
MOVSI T1,(<SIXBIT /TMP/>)
MOVEM T1,NAMEI+.RBEXT ; And extension
OPEN ALTDV,ALDEVI ; Open alternate device
POPJ P,
MOVEI T1,5 ; Lookup block length
MOVEM T1,NAMEI+.RBCNT ; Set it up
XLOOKP ALTDV,NAMEI ; Is it there
POPJ P,
POPJ P,
INPUT ALTDV,T.IOWD ; Fetch file
STATZ ALTDV,740000 ; Check errors
POPJ P,
RELEAS ALTDV,
RDTMP1: MOVE T1,[POINT 7,CMDBUF]
MOVEM T1,P.TEXT
JRST CPOPJ1##
; Here to write temp file
WRTMP: HRRZ T1,P.TEXT ; Calc length of string
SUBI T1,CMDBUF-1
MOVN T1,T1 ; Neg length
HRLM T1,T.IOWD
IFN TEMPC,<
MOVE T1,[XWD 3,T.HEAD]
TMPCOR T1,
SKIPA
POPJ P,
>
INIT ALTDV,.IODMP
SIXBIT /DSK/
EXP 0
POPJ P, ; Return if INIT fails
MOVEM T1,ALTDV+.OPDEV
MOVSI T3,(<SIXBIT /EDS/>)
PUSHJ P,JOBNUM
MOVEM T3,NAMEO+.RBNAM
MOVSI T1,(<SIXBIT /TMP/>)
MOVEM T1,NAMEO+.RBEXT ; Gen file name
SETZM NAMEO+.RBPRV
SETZM NAMEO+.RBALC ; Keep the whole file!
MOVEI T1,5 ; SHORT ENTER BLOCK
MOVEM T1,NAMEO+.RBCNT ; SAVE SO ENTER SUCCEEDS
ENTER ALTDV,NAMEO
JRST WRTMP1 ; Just ignore
OUTPUT ALTDV,T.IOWD
WRTMP1: RELEAS ALTDV,
POPJ P,
; General jobnumber kludge...
JOBNUM::
PJOB T1,
JOBNM1: IDIVI T1,^D10
IORI T2,20
LSHC T2,-6
TRNN T3,77
JRST JOBNM1
POPJ P,
; Here to open up a disk structure -- call for OPNDSK UUO
OPNSTR::PUSHJ P,SAVR ; Save T3-T5
PUSH P,T2 ; Save T2
HRRZ T2,.JBUUO ; Fetch address of OPEN block
MOVE T3,.OPDEV(T2) ; Device name
DEVCHR T3, ; Get device characteristics
TLNN T3,(DV.LPT!DV.PTP!DV.PTR!DV.DTA!DV.MTA)
TLNN T3,(DV.DSK) ; Is this a disk
JRST OPNST1 ; No, don't allow this
PUSHJ P,IOEXCT## ; Execute the OPEN UUO
JRST OPNST4
T2PPJ1::POP P,T2
JRST CPOPJ1##
OPNST1: OUTSTR [ASCIZ/
?Device /]
PUSHJ P,GVDEV ; Type the device name
HRRZ T1,.JBUUO ; UUO address
MOVE T1,.OPDEV(T1) ; Device name
DEVCHR T1, ; Get device bits
JUMPE T1,OPNST2
OUTSTR [ASCIZ/ is not a disk
/]
JRST OPNST3
OPNST2: OUTSTR [ASCIZ/ does not exist
/]
OPNST3: MOVE T1,SVT1E## ; Restore T1
JRST T2POPJ## ; Restore T2 and return
OPNST4: OUTSTR [ASCIZ/
?Device not available -- /]
PUSHJ P,GVDEV
OCRLF
JRST T2POPJ##
; Routine to get the device name to T1 and type it
GVDEV: HRRZ T1,.JBUUO ; Point to open block
MOVE T1,.OPDEV(T1) ; Get device name
GVDEV1: MOVEI T3,OCHR## ; Typeout routine
PUSHJ P,GVDST1## ; Type name and a ":"
PJRST FORCE##
; Utility routines
RDSKIP: PUSHJ P,RDSKP1 ; Skip spaces
TRO FL,F.LAHD ; Set look again
POPJ P,
RDSKP1: PUSHJ P,@CHIN
CAIE C," "
CAIN C,"I"-100 ; Space or tab
JRST RDSKP1
POPJ P,
RDATOM: MOVE T1,[POINT 6,D]
MOVEI D,0 ; Init atom
RDATO1: PUSHJ P,@CHIN
PUSHJ P,CKALN ; Check alpha-numeric
JRST RDATO2
TLNN T1,770000 ; 6 yet?
JRST RDATO1
SUBI C,40
IDPB C,T1
JRST RDATO1
RDATO2: CAIE C," "
CAIN C," "
PUSHJ P,RDSKP1
PUSHJ P,CKALN
POPJ P,
MOVEI C," " ; Return a space if
TRO FL,F.LAHD ; Alpha-numeric
POPJ P,
CHKFIL: SKIPN NAME(ALTP) ; See if we got a name
JRST CHKFL1 ; No: set LAHD and return
AOS (P)
JUMPE D,CPOPJ1## ; Double skip if ok
MOVEI C," " ; Return space
CHKFL1: TRO FL,F.LAHD
POPJ P, ; Skip return if need to stash 'd'
; Here to fetch next char
LDCHR: SKIPN RPGSW ; From where
JRST LDCHR1
TRZN FL,F.LAHD
LDCHRA: IBP P.TEXT
LDB C,P.TEXT
CAIN C,15 ; Purge cr's
JRST LDCHRA
POPJ P,
LDCHR1: TRZE FL,F.LAHD
SKIPA C,SVCCIN
LDCHRB: PUSHJ P,TTYCH
CAIN C,15 ; Skip over cr's
JRST LDCHRB
MOVEM C,SVCCIN
POPJ P,
; Check if char is alpha-numeric
CKALN: CAIG C,"z"
CAIGE C,"a"
SKIPA
SUBI C,40 ; Convert to upper
CAIL C,"0"
CAILE C,"Z"
POPJ P,
CAILE C,"9"
CAIL C,"A"
AOS (P)
POPJ P,
; Special routine called from set option in initial parse
OPTSWT::TLZ FL2,INPARS ; Temp clr flag
PUSHJ P,DOOPT ; Parse option file
JRST OPTSE1 ; Say not found
JRST OPTSE2 ; Say error in file
TLO FL2,INPARS ; Turn back on
MOVEI C," " ; Pretend last char was a space
POPJ P, ; Return
OPTSE1: MOVEI T1,ONFMSG##
JRST COMERR
OPTSE2: MOVEI T1,SEOMSG##
JRST COMERR
SUBTTL Option File Handler
; Routine to eat an option file if any
; Call: PUSHJ P,DOOPT
; <option not found>
; <error in option file>
; <OK return>
; C(OPTION) = SIXBIT of desired option or zero if default
DOOPT:: TLNE FL2,INOPTF ; Trying to reenter
JRST WRAPUP ; Just give current failure
OPEN OPT,OPTDVI
POPJ P, ; Say not found
PUSH P,.JBFF ; Save this
INBUF OPT,1 ; One is enuf
SKIPN T1,LOGPPN ; Use logged in PPN if available
MOVE T1,MYPPN ; Else use pivoted PPN
MOVEM T1,OPTFIL+.RBPPN ; Use users own SWITCH.INI
SETZM OPTFIL+.RBPRV
XLOOKP OPT,OPTFIL ; Go find file
JFCL
JRST [RELEAS OPT,
POP P,.JBFF
POPJ P,] ; Not found
MOVEI T1,OPTCH ; Set up input routine
EXCH T1,CHIN ; Save current one
MOVEM T1,SVOCIN
TLO FL2,INOPTF ; Say we is in option file
SETZM SAVCHR ; Clear scanner
SETZM SAVC ; ...
RDOPT: PUSHJ P,SCAN ; Fetch first atom of line
CAIN C,177 ; Eof or error?
JRST WRAPUP ; Yes: finish up and return
MOVE T1,ACCUM ;Get what we found
CAME T1,[OPTNAM] ;"SOS" for release
JRST SKPEOL ; Not what we want - try next line
PUSHJ P,SCAN ; Fetch break char
SKIPN OPTION ; Need default?
JRST DEFOPT ; Yes:
CAIE C,":" ; Look at break char
JRST SKPEOL ; Skip line if not colon
PUSHJ P,SCAN ; Get next atom
MOVE T1,ACCUM
CAME T1,OPTION ; Is this it?
JRST SKPEOL ; No: keep looking
OPTFN0: AOS -1(P) ; All else are errors or aok
OPTFND: PUSHJ P,SCAN ; Scan next
TRNE FL,IDF ; Idents are OK
JRST OPTGOT ; Got one - use it
OPTNXT: CAIE C,"/" ; Check legal delims
CAIN C,","
JRST OPTGET ; Need to scan again
CAIE C,"-" ; Check line cont.
JRST OPTDON ; Nope - check proper EOL
PUSHJ P,SCAN ; Scan past dash
TRNN FL,TERMF ; Proper terminator?
JRST WRAPUP ; No: syntax error
JRST OPTFND ; Continue looking
OPTGET: PUSHJ P,SCAN ; Get next atom
TRNN FL,IDF ; Ident?
JRST WRAPUP ; No: lose
OPTGOT: PUSHJ P,DOSET ; Switch in "ACCUM" - call set routine
JRST WRAPUP ; Illegal entry in file
JRST OPTNXT ; Continue
OPTDON: TRNE FL,TERMF ; Ok if proper term
AOS -1(P) ; Give skip return
JRST WRAPUP ; Finish up
DEFOPT: CAIE C,":" ; If colon just skip line
JRST OPTFN0 ; Else we have correct line
SKPEOL: PUSHJ P,GNCH## ; Get a char
CAIN C,177 ; Check on eof
JRST WRAPUP ; Done if so
TLNN CS,TERM_16 ; Terminator?
JRST SKPEOL ; No: keep going
SETZM SAVCHR ; Clear scanner
JRST RDOPT ; Yes: try this line
WRAPUP: RELEAS OPT, ; Close chl
POP P,.JBFF
MOVE T1,SVOCIN ; Restore old input routine
MOVEM T1,CHIN
TLZ FL2,INOPTF
POPJ P, ; Return
; Utility routines to read option file
OPTCH: SOSG OPTBHD+2
JRST OPTINP ; Need more
OPTCH1: ILDB C,OPTBHD+1 ; Get char
JUMPE C,OPTCH ; Ignore nulls
MOVE CS,@OPTBHD+1 ; Check for seq nos
TRNN CS,1
POPJ P, ; None - return
MOVNI C,5 ; Yes: skip it
ADDM C,OPTBHD+2
AOS OPTBHD+1
CAME CS,PGMK ; Page mark?
JRST OPTCH ; No: get next char
MOVNI C,4 ; Yes: skip some more
ADDM C,OPTBHD+2
MOVSI C,(<POINT 7,0,35>)
HLLM C,OPTBHD+1
JRST OPTCH ; Try again
OPTINP: STATZ OPT,760000 ; Eof or error?
JRST OPTEOF ; Yes: return -1
IN OPT,0
JRST OPTCH1 ; Ok - return
STATZ OPT,740000 ; Error?
OUTSTR [ASCIZ /?Read error in option file/]
OPTEOF: MOVEI C,177 ; Get a rubout
RELEAS OPT,
POPJ P, ; And return
SUBTTL Register Save Routine
; Subroutine to save T3-T5
; Call with
; PUSHJ P,SAVR
; <restore on CPOPJ, CPOPJ1, or CPOPJ2 return>
SAVR:: EXCH T3,(P) ; Get PC, save T3
HRLI T3,(P) ; Point to saved contents of T3
PUSH P,T4
PUSH P,T5
PUSHJ P,[JRA T3,(T3)]
JRST SAVR0
JRST SAVR1
AOS -3(P)
SAVR1: AOS -3(P)
SAVR0: POP P,T5
POP P,T4
POP P,T3
POPJ P,
SUBTTL MAKFIL -- Subroutine to Create a Temporary File
; Call with CHNTAB+OUT and PNTNMO setup. Channel must be OPEN'ed
; PUSHJ P,MAKFIL
; <error return>
; <good return>
MAKFIL::PUSHJ P,SETTFP ; Set up protection
MOVEI T1,@PNTNMO ; Point to the block
SETZM .RBALC(T1) ; Avoid size problems
SETZM XRBMWL(T1) ; Clear maximum written length
SETZM .RBDEV(T1) ; Clear this too
SETOM XRBNOR(T1) ; Flag not open for update
SKIPN T2,NEWNAM ; Get possible name
MOVE T2,ORGNAM ; Get the input file name
MOVEM T2,.RBSPL(T1) ; Save as spooled name
XENTER OUT,@PNTNMO ; Enter the file
POPJ P, ; Lost
JRST CPOPJ1##
; Subroutine to finish making the temporary file. This subroutine
; closes the original file, then re-opens it in update mode. Called
; to rewind the last output file so that it can be read.
MAKFL1::CLOSE OUT,CL.DLL ; Tell MTR we'd like to keep
MOVEI T1,5 ; Shorter lookup block
MOVEM T1,@PNTNMO ; so can get all info from AT's
XLOOKP OUT,@PNTNMO ; Find the file again
JRST MAKFL2
JRST MAKFL2
ENTER OUT,@PNTNMO ; Enter the file so we can write it
JRST MAKFL2 ; Ooops, (probably protection failure)
MOVEI T1,.RBBIG
MOVEM T1,@PNTNMO
JRST CPOPJ1##
; Here if second LOOKUP fails
MAKFL2: MOVEI T1,.RBBIG
MOVEM T1,@PNTNMO ; Restore correct block length
POPJ P,
; Subroutine to setup temporary file protection
SETTFP::PUSH P,ALTP ; Save this
MOVE ALTP,PNTNMO ; Point to enter block
MOVSI T3,(077B8) ; Setup 077 protection
MOVE T1,[%LDFFA] ; Get full file access PPN
GETTAB T1, ; Yes
MOVE T1,[1,,2] ; Probably [1,2]
CAMN T1,MYPPN ; Is this user god?
JRST SETTF2 ; Yes, call him the owner
MOVEI T1,@CHNTAB##+OUT; Point to output OPEN block
MOVE T1,.OPDEV(T1) ; Get the device name
DEVPPN T1, ; Ask monitor for associted PPN
MOVE T1,MYPPN## ; Failed, assume mine
CAME T1,MYPPN ; Is it mine
JRST SETTF1 ; No, PPN must be forced -- use it
MOVE T2,PNTNMO ; Point to output lookup block
SKIPE T1,.RBPPN(ALTP) ; Any path or PPN specified?
TLNE T1,-1 ; Is this a path pointer
JRST SETTF1 ; No, don't get from path block
SKIPN T1,.PTPPN(T1) ; Yes, so fetch from path block
MOVE T1,MYPPN ; If none given, use default
SETTF1: MOVE T2,[%CNSTS] ; [17,,11]
GETTAB T2, ; Get monitor states word
SETZ T2, ; Assume MONGEN default
TLNN T2,(ST%IND) ; Independent PPNs
TLZA T2,-1 ; No, clear left half of mask
TLO T2,-1 ; Yes, set ones in left half
TRO T2,-1 ; Right half always ones
XOR T1,MYPPN ; Compare this PPN with our own
TDNN T1,T2 ; Same programmer number?
JRST SETTF2 ; Yes, use 077
TLO T3,(100B8)
TLNE T1,-1 ; Project match?
TLZA T3,(677B8) ; No, use 100
TLZ T3,(670B8) ; Yes, use 107
IFN %UAPRT,<
CAME T3,[107000,,0] ; Project match?
JRST SETTF2 ; No, go set
HRROI T2,.GTPRV ; Set to read privileges
GETTAB T2, ; Get em
SETZ T2,
TRNE T2,JP.LJT ; Project leader?
MOVSI T3,(077B8) ; Yes, he owns the file
>
SETTF2: MOVEM T3,.RBPRV(ALTP) ; Save it
JRST APOPJ ; Restore ALTP and return
SUBTTL Routine to perform a LOOKUP UUO.
; Subroutine to lookup a file
;
; Called from SOSERR, as a UUO handling routine
;
; XLOOKP chn,extended-lookup-block
; <serious error return>
; <file not found error>
; <good return>
XLKPFL::PUSHJ P,SAVR ; Save T3-T5
HRRZ T3,.JBUUO##
SKIPE T4,.RBPPN(T3) ; See if path given
TLNE T4,-1 ; Really a path pointer?
JRST XLKPFA ; No, continue
HRLI T1,.PTPPN(T4) ; First word of actual path spec
HRRI T1,SVPATH+.PTPPN; First word in SVPATH
BLT T1,SVPATH+.PTMAX-1; Save all
;
XLKPFA: MOVE T1,.RBCNT(T3) ; Length of lookup block
CAIL T1,.RBDEV ; Device word
SETZM .RBDEV(T3) ; Yes, clear it
PUSH P,.RBEXT(T3) ; Save extension word
LDB T1,PUUOAC## ; Fetch channel designator
HLL T3,CHNTAB##(T1) ; Load the actual channel number
TLO T3,(LOOKP.) ; Light the opcode bits
MOVEI T1,@CHNTAB##(T1); Get address of OPEN block
MOVE T2,.OPDEV(T1) ; Get device name for error printing
PUSH P,.RBPPN(T3) ; Save PPN word of LOOKUP block
TLNE T4,-1 ; PPN in T4 (not path pointer)
JRST XLKPFP ; If yes
SKIPN .PTPPN(T4) ; PPN not given?
SETZM .RBPPN(T3) ; Yes, let monitor scan
XLKPFP: XCT T3 ; Execute the UUO
JRST LKPFL1 ; Failed--go find out why
POP P,.RBPPN(T3) ; Restore PPN
ADJSP P,-1 ; Prune PDL of save EXT word
SKIPN T4,.RBPPN(T3) ; Fetch path pointer
JRST CPOPJ2 ; If field was zero
TLNE T4,-1 ; Really a path pointer?
JRST CPOPJ2 ; No, it's a PPN. Done
LDB T5,[POINT 4,T3,12]; Get the channel number
MOVEM T5,.PTFCN(T4) ; Setup for PATH. UUO
HRLI T4,.PTMAX ; Length of path block
MOVE T5,T4 ; Copy path pointer
PATH. T4, ; Read channel path
JFCL ; Non-pathing monitor
MOVE T1,.RBPPN(T3) ; Load path pointer
MOVEI T2,SVPATH ; Point to saved path
PUSHJ P,CHKFA ; Does this path match the last one?
JRST [LDB T1,PUUOAC ; Get channel designator
HLLZ T1,CHNTAB##(T1) ; Convert to channel
TLO T1,(CLOSE.) ; Convert to UUO
ADDI T1,CL.ACS ; Disregard useless access
XCT T1 ; Close out the file
HRLI T1,SVPATH+.PTPPN
HRRI T1,.PTPPN(T5) ; Point to path block
BLT T1,.PTMAX-1(T5) ; Restore the old path
SETZ T1, ; Error code
JRST CPOPJ1##] ; And give single skip return
CPOPJ2: AOS (P)
JRST CPOPJ1##
; Here if the lookup UUO fails
LKPFL1: POP P,.RBPPN(T3) ; Restore PPN word
MOVEI T1,(T3) ; Lookup block address
HRRZ T3,.RBEXT(T1) ; Get the failure code
POP P,.RBEXT(T1) ; Restore .RBEXT word
MOVE T5,[1B<ERFNF%>!1B<ERIPP%>!1B<ERSNF%>!1B<ERSLE%>]
LSH T5,(T3) ; Position mask
TLNN T5,400000 ; Non-fatal bit set?
PJRST LKPERR ; Type the error message
MOVEI T1,(T3) ; Error code
JRST CPOPJ1## ; Return it
SUBTTL Error Message Printer for LOOKUP/ENTER/RENAME UUO's
; Here to type a LOOKUP error message
; Call with T3 = error code and T1 = address of lookup block
; T2 = Device name (or 0)
LKPERR::PUSHJ P,FORCE## ; Force pending messages
OUTSTR [ASCIZ/?LOOKUP failed for /]
;
LEFERR::PUSH P,T3 ; Save error code
PUSHJ P,TYPFNM ; Type the filename as best we can
POP P,T1 ; Restore error code
OUTSTR [ASCIZ/ -- /]
OUTSTR @LEFTAB(T1) ; Type the error message
PJRST FOCRLF##
; Here to type a filename given the address of the lookup block
; Call with T1 = address of lookup block, T2 = device name
; Use TYPFND if the device should not be typed.
TYPFND: PUSH P,T1 ; Save address
JRST TYPFN1 ; Join TYPFNM after device printing
TYPFNM::PUSH P,T1 ; Save address
MOVE T3,.RBCNT(T1)
CAIGE T3,.RBDEV
JRST TYPFN0
PUSHJ P,GENST0 ; Get structure name from lookup block
SKIPN T1 ; If really found one
TYPFN0: SKIPE T1,T2 ; If zero, try using his device arg
PUSHJ P,GVDEV1 ; Type the device name
TYPFN1: MOVE T1,(P)
MOVEI T4,.RBNAM(T1)
MOVEI T5,.RBEXT(T1)
HRLI T4,(POINT 6,)
HRLI T5,(POINT 6,)
PUSHJ P,GVNAM0##
POP P,T1
MOVE T1,.RBPPN(T1)
PUSHJ P,GVDPTH## ; Type path if needed
PJRST FORCE##
SUBTTL LOOKUP/ENTER/RENAME error message table
LEFTAB::[ASCIZ/File not found/]
[ASCIZ/UFD does not exist/]
[ASCIZ/Protection failure/]
[ASCIZ/File being modified/]
[0] ; Already existing filename
[ASCIZ/Illegal UUO sequence/]
[ASCIZ/Rib error/]
[0] ; Not a save file
[0] ; Not enough core
[0] ; Device not available
[0] ; No such device
[0] ; No 2-register facility
[ASCIZ/No room or quota exceeded/]
[ASCIZ/Device is write locked/]
[ASCIZ/No Monitor free core available/]
[0] ; Partial allocation only
[ASCIZ/Specified block not free/]
[0] ; Cannot supersede existing directory
[0] ; Cannot delete non-empty directory
[ASCIZ/Subdirectory not found/]
[ASCIZ/Search list empty/]
[ASCIZ/SFDLIM exceeded/]
[ASCIZ/No writable structure/]
[0] ; Get seg from a locked low segment to
; a high segment not on the swapper
SUBTTL LOOKUP Verification Routines.
; Here to see if the path of a file matches another path.
; Call with
; MOVE T1,PPN or PATH pointer
; MOVEI T2,second path
; PUSHJ P,CHKFA
; <not a match>
; <matches>
CHKFA:: JUMPE T1,CPOPJ1## ; If zero--matches any path
TLNE T1,-1 ; Skip if path pointer
JRST [CAME T1,.PTPPN(T2)
POPJ P, ; Not a match
JRST CPOPJ1##]; Give good return
SKIPN .PTPPN(T2) ; Any path specified?
JRST CPOPJ1## ; Any file found is alright
HRLI T1,-6 ; Length of a path
;
CHKFA1: SKIPN T3,.PTPPN(T2) ; Get specification, any specified?
JRST CHKFA2 ; End of specification
CAME T3,.PTPPN(T1) ; A match?
POPJ P, ; No, give failure return
ADDI T2,1 ; Increment save-path pointer
AOBJN T1,CHKFA1 ; Increment this-path pointer
JRST CPOPJ1## ; Whole path matches
CHKFA2: SKIPE .PTPPN(T1) ; Both paths stop at the same place?
POPJ P, ; No
JRST CPOPJ1## ; Yes
SUBTTL DATA
XLIST
LIT
LIST
RELOC 0
LOGPPN: BLOCK 1
END SOS