mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-01 09:21:15 +00:00
418 lines
13 KiB
Plaintext
418 lines
13 KiB
Plaintext
TITLE WLDSCN - Wildcard file scanner for GLXLIB
|
||
;
|
||
; Written by Sven Erik Enblom in December 1985
|
||
;
|
||
; This is really the pre-first version, without documentation,
|
||
; but it should at least be safe to use.
|
||
;
|
||
SEARCH GLXMAC,WLDMAC,WLDINT
|
||
PROLOG WLDSCN
|
||
|
||
.REQUI FDCOPY
|
||
EXTERN FD2FOP
|
||
|
||
.TEXT "/LOCALS/SYMSEG:LOW"
|
||
|
||
; Entry points in this module
|
||
;
|
||
ENTRY W$NEW ; Create a scanner given an FD
|
||
ENTRY W$NEXT ; Get next FD from scanner
|
||
ENTRY W$KILL ; Kill a scanner
|
||
|
||
$DATA PTHBLK,.PTMAX ; PATH. argument block
|
||
$DATA FOPBLK,.FOLEB+1 ; FILOP. argument block
|
||
LUPBLK: EXP .RBSIZ ; LOOKUP argument block
|
||
BLOCK .RBSIZ
|
||
UFDFD: $BUILD FDMSIZ
|
||
$SET .FDLEN,FD.LEN,FDMSIZ
|
||
$SET .FDEXT,LHMASK,'UFD'
|
||
$EOB
|
||
SUBTTL W$NEW - Create a new wildcard scanner
|
||
;
|
||
; Accepts in S1/ Address of a wild FD
|
||
; S2/ Flags (see WF$???)
|
||
;
|
||
; Returns in S1/ Address of the wildcard scanner
|
||
;
|
||
W$NEW: $SAVE <P1,P2>
|
||
DMOVE P1,S1 ; Save FD address and flags
|
||
MOVEI S1,WS$SIZ ; Get size of a WS
|
||
$CALL M%GMEM ; Allocate a chunk
|
||
HRL T1,P1 ; Copy from given FD...
|
||
HRRI T1,WS$OFD(S2) ; ...to FD space in WS
|
||
BLT T1,WS$OFD+FD$SIZ-1(S2)
|
||
MOVE T1,FD$FLG(P1) ; Get FD flags
|
||
MOVEM T1,WS$FLG(S2) ; Put them in flag word
|
||
MOVEM P2,WS$AFL(S2) ; Store argument flags too
|
||
MOVE T1,[IOWD FPLSIZ,WS$FPL]
|
||
ADD T1,S2
|
||
MOVEM T1,WS$FPP(S2) ; Store channel PDL pointer
|
||
MOVE T1,[IOWD PDLSIZ,WS$PDL]
|
||
ADD T1,S2 ; Make local stack pointer
|
||
PUSH T1,[EXP SCAN] ; Set up "activation point"
|
||
MOVEM T1,WS$P(S2)
|
||
MOVEI T1,FDXSIZ
|
||
STORE T1,WS$CFD+.FDLEN(S2),FD.LEN
|
||
MOVE S1,S2 ; Get WS address...
|
||
$RETT ; ...and return
|
||
SUBTTL W$NEXT - Get next file spec from wildcard scanner
|
||
;
|
||
; Accepts in S1/ Address of the WS
|
||
;
|
||
; Returns in S1/ Address of a full FD
|
||
; S2/ Some flags, perhaps? Or an IFN or channel number?
|
||
;
|
||
W$NEXT: $SAVE WS
|
||
MOVE WS,S1 ; Get WS address
|
||
JSP T1,.EXCH
|
||
$RET ; Reenter scanner
|
||
|
||
.EXCH: EXCH F,WS$FLG(WS) ; Get flag word
|
||
EXCH FP,WS$FPP(WS)
|
||
EXCH P,WS$P(WS) ; Switch PDLs
|
||
JRST (T1) ; Return
|
||
|
||
RETFIL: MOVE T1,WS$AFL(WS) ; Get argument flags
|
||
TXNE T1,WF$DIR ; Are we allowed to return directories?
|
||
JRST RETFI0 ; Yes, skip this test
|
||
HLRZ T2,WS$CFD+.FDEXT(WS) ; No, get extension
|
||
CAIE T2,'UFD'
|
||
CAIN T2,'SFD'
|
||
$RET ; ...ignore this directory
|
||
;
|
||
RETFI0: TXNN T1,WF$FOB ; Is there a FOB to use?
|
||
JRST RETFI1 ; No, continue...
|
||
MOVEI T2,WS$CFD(WS) ; Yes, get address of FD...
|
||
MOVEM T2,FOB.FD(T1) ; ...and store it in FOB
|
||
MOVEI S1,FOB.SZ ; Get FOB size...
|
||
HRRZ S2,T1 ; ...and address
|
||
$CALL F%IOPN ; Try to open the file
|
||
JUMPT[ MOVE S2,S1 ; If success, get IFN...
|
||
JRST RETFI4] ; ...and return
|
||
$RET ; Else just ignore it (for now)
|
||
;
|
||
RETFI1: TXNN T1,WF$LUP ; Should we do a LOOKUP?
|
||
JRST RETFI2 ; No, continue...
|
||
MOVEI S1,WS$CFD(WS) ; Yes, so get address of FD...
|
||
HRRZ S2,T1 ; ...and of FILOP. block
|
||
$CALL FD2FOP ; Copy data
|
||
SKIPT
|
||
$FATAL <FD2FOP says "^T/(S1)/" at RETFI1>
|
||
HRRZ T1,WS$AFL(WS) ; Get address of FILOP. block...
|
||
HRLI T1,.FOMAX ; ...and insert max. size
|
||
FILOP. T1, ; Try to do the FILOP.
|
||
$RET ; Ignore errors (for now)
|
||
LOAD S2,.FOFNC(T1),FO.CHN ; Extract channel number...
|
||
JRST RETFI4 ; ...and return
|
||
;
|
||
RETFI2: TXNN T1,WF$RBC ; Should we return a RIB copy?
|
||
JRST RETFI3 ; No, continue...
|
||
MOVEI T2,PTHBLK ; Yes, get address of path block...
|
||
MOVEM T2,.RBPPN(T1) ; ...and store it in LOOKUP block
|
||
HRRZM T1,FOPBLK+.FOLEB ; Point at supplied block
|
||
MOVEI S1,WS$CFD(WS) ; Get address of FD...
|
||
MOVEI S2,FOPBLK ; ...and of FILOP. block
|
||
$CALL FD2FOP ; Copy data
|
||
SKIPT
|
||
$FATAL <FD2FOP says "^T/(S1)/" at RETFI2>
|
||
$CALL LUPFIL ; Do a LOOKUP
|
||
JUMPF .POPJ ; Ignore errors (for now)
|
||
$CALL CLSFIL ; Close the file again...
|
||
JRST RETFI4 ; ...and return
|
||
;
|
||
RETFI3: TXNE T1,WF$VER ; Should we verify the file?
|
||
TXNE F,F$FVER ; Yes, is it already verified?
|
||
JRST RETFI4 ; Don't verify it now
|
||
MOVEI S1,WS$CFD(WS) ; Get address of FD
|
||
$CALL OPNFIL ; Try to open the file
|
||
$RETIF ; Couldn't, ignore it
|
||
$CALL CLSFIL ; We could, just close it again
|
||
;
|
||
RETFI4: MOVEI S1,WS$CFD(WS) ; Get address of current FD
|
||
JSP T1,.EXCH ; Switch context
|
||
$RETT
|
||
SUBTTL SCAN - Top level of wildcard scanner
|
||
|
||
SCAN: LOAD T1,F,F$SLT ; Get search list type
|
||
JRST @[EXP SCNSLN,SCNSLJ,SCNSLA,SCNSLS](T1)
|
||
|
||
SCANZ: PUSH P,[EXP .] ; Make sure we stay here
|
||
JSP T1,.EXCH ; Switch context
|
||
$RETF ; Return false
|
||
|
||
SCNSLN: MOVE T1,WS$OFD+.FDSTR(WS) ; Get structure name
|
||
MOVEM T1,WS$CFD+.FDSTR(WS) ; ...
|
||
$CALL SCNSTR ; Scan just this structure
|
||
JRST SCANZ
|
||
|
||
SCNSLJ: SETOM WS$CFD+.FDSTR(WS) ; Start from beginning
|
||
MOVEI T1,WS$CFD+.FDSTR(WS) ; Point at structure word
|
||
HRLI T1,1 ; We use only one word
|
||
JOBSTR T1, ; Get next structure
|
||
$FATAL <JOBSTR error ^O/T1/>
|
||
SKIPN WS$CFD+.FDSTR(WS) ; Fence reached?
|
||
JRST SCANZ ; Yes, stop this
|
||
$CALL SCNSTR ; No, scan this structure
|
||
JRST SCNSLJ+1
|
||
|
||
SCNSLA: SETZ T1,
|
||
SYSSTR T1, ; Get first structure in system
|
||
$FATAL <SYSSTR failed>
|
||
JUMPE T1,SCANZ ; All structures scanned?
|
||
MOVEM T1,WS$CFD+.FDSTR(WS) ; No, store this name...
|
||
$CALL SCNSTR ; ...and scan it
|
||
MOVE T1,WS$CFD+.FDSTR(WS)
|
||
JRST SCNSLA+1 ; Loop for more
|
||
|
||
SCNSLS: SETOM WS$CFD+.FDSTR(WS) ; Start from beginning
|
||
MOVE T1,[3,,T2]
|
||
MOVE T4,WS$CFD+.FDSTR(WS) ; Get previous structure
|
||
SETZB T2,T3 ; Job 0 means SSL
|
||
GOBSTR T1, ; Get next structure
|
||
$FATAL <GOBSTR error ^O/T1/>
|
||
JUMPE T4,SCANZ ; Reached fence?
|
||
MOVEM T4,WS$CFD+.FDSTR(WS) ; No, store structure name...
|
||
$CALL SCNSTR ; ...and scan it
|
||
JRST SCNSLS+1
|
||
|
||
; SCNSTR - Scan one specific structure only
|
||
;
|
||
; Assumes that WS$CFD+.FDSTR is correct
|
||
;
|
||
SCNSTR: SKIPN WS$MSK+.FDPPN(WS) ; Wild PPN?
|
||
JRST[ MOVE T1,WS$OFD+.FDPPN(WS) ; No, get PPN...
|
||
MOVEM T1,WS$CFD+.FDPPN(WS) ; ...put it in current FD...
|
||
PJRST SCNPPN] ; ...and scan it
|
||
SETZ S1, ; Yes, we have to read the MFD
|
||
$CALL .SUFD ; For each UFD...
|
||
$RETIF
|
||
CAME S2,[SIXBIT/UFD/] ; Is this really an UFD?
|
||
$RET ; No, ignore it
|
||
MOVEM S1,WS$CFD+.FDPPN(WS) ; Yes, put PPN away for a while
|
||
XOR S1,WS$OFD+.FDPPN(WS)
|
||
ANDCM S1,WS$MSK+.FDPPN(WS)
|
||
JUMPE S1,SCNPPN ; Scan matching PPN
|
||
$RET
|
||
|
||
SCNPPN: SETZM WS$LEV(WS) ; Reset SFD level
|
||
|
||
SCNDIR: LOAD T1,F,F$LEV0 ; Get first "return level"
|
||
CAMLE T1,WS$LEV(WS) ; Can we return files from here?
|
||
JRST SCNDI2 ; No, continue...
|
||
TXNE F,F$WFIL ; Yes, is file name wild?
|
||
JRST SCNDI1 ; Yes, scan for it in directory
|
||
DMOVE T1,WS$OFD+.FDNAM(WS) ; No, get name and extension
|
||
DMOVEM T1,WS$CFD+.FDNAM(WS) ; Store them in current FD
|
||
TXZ F,F$FVER ; File is not verified
|
||
$CALL RETFIL ; Return this file
|
||
JRST SCNDI2 ; Now check for more SFDs
|
||
;
|
||
; Come here when file name is wild
|
||
;
|
||
SCNDI1: $CALL .SCDIR ; For each entry...
|
||
JUMPF SCNDI2 ; End of directory?
|
||
DMOVEM S1,WS$CFD+.FDNAM(WS) ; Save name and extension
|
||
XOR S1,WS$OFD+.FDNAM(WS) ; Test file name
|
||
ANDCM S1,WS$MSK+.FDNAM(WS)
|
||
JUMPN S1,.POPJ ; Matching file name?
|
||
XOR S2,WS$OFD+.FDEXT(WS) ; Yes, now test extension
|
||
ANDCM S2,WS$MSK+.FDEXT(WS)
|
||
JUMPN S2,.POPJ ; Matching extension too?
|
||
TXO F,F$FVER ; Yes, we have a verified file
|
||
PJRST RETFIL ; Return it and loop
|
||
;
|
||
; Come here to check if more SFDs are needed
|
||
;
|
||
SCNDI2: LOAD T1,F,F$LEV1 ; Get max. SFD level
|
||
CAMG T1,WS$LEV(WS) ; Do we need more SFDs?
|
||
$RET ; No, return now
|
||
MOVE T1,WS ; Yes, get WS address...
|
||
ADD T1,WS$LEV(WS) ; ...and add current level
|
||
SKIPE WS$MSK+.FDPAT(T1) ; Is next SFD name wild?
|
||
JRST SCNDI4 ; Yes, we have to scan for it
|
||
MOVE T2,WS$OFD+.FDPAT(T1) ; No, get name...
|
||
MOVEM T2,WS$CFD+.FDPAT(T1) ; ...and pretend it's there
|
||
SCNDI3: AOS WS$LEV(WS)
|
||
$CALL SCNDIR
|
||
SOS T1,WS$LEV(WS)
|
||
ADD T1,WS
|
||
SETZM WS$CFD+.FDPAT(T1)
|
||
$RET
|
||
;
|
||
; Come here when next SFD name is wild
|
||
;
|
||
SCNDI4: $CALL .SCDIR ; Scan current directory
|
||
$RETIF ; End of directory
|
||
CAME S2,[SIXBIT/SFD/] ; Is this a directory?
|
||
$RET ; No, ignore it
|
||
MOVE T1,WS
|
||
ADD T1,WS$LEV(WS)
|
||
MOVEM S1,WS$CFD+.FDPAT(T1) ; Yes, store it
|
||
XOR S1,WS$OFD+.FDPAT(T1)
|
||
ANDCM S1,WS$MSK+.FDPAT(T1)
|
||
JUMPE S1,SCNDI3 ; If match, scan it
|
||
$RET
|
||
|
||
; .SUFD - Scan a UFD file on current structure
|
||
;
|
||
; Accepts in S1/ PPN (zero mean MFD PPN)
|
||
;
|
||
; Returns in S1, S2/ Name and extension
|
||
;
|
||
.SUFD: SKIPE UFDFD+.FDPPN ; Do we have the MFD PPN?
|
||
JRST .SUFD1 ; Yes, continue
|
||
MOVX T1,%LDMFD
|
||
GETTAB T1, ; Ask monitor
|
||
MOVE T1,[1,,1] ; ...usual default
|
||
MOVEM T1,UFDFD+.FDPPN ; Store it for later use
|
||
.SUFD1: SKIPN S1 ; Scan the MFD?
|
||
MOVE S1,UFDFD+.FDPPN ; Yes, get MFD PPN again
|
||
MOVEM S1,UFDFD+.FDNAM ; Store PPN
|
||
MOVE T1,WS$CFD+.FDSTR(WS) ; Get structure name
|
||
MOVEM T1,UFDFD+.FDSTR
|
||
MOVEI S1,UFDFD ; Get FD address
|
||
$CALL OPNFIL ; Try to open the file
|
||
$RETIF ; Propagate error...
|
||
PJRST .SDIR ; Scan directory and return
|
||
|
||
; .SCDIR - Scan current directory
|
||
;
|
||
;
|
||
.SCDIR: SKIPN T1,WS$LEV(WS) ; Get current directory level
|
||
JRST[ MOVE S1,WS$CFD+.FDPPN(WS)
|
||
PJRST .SUFD]
|
||
ADD T1,WS
|
||
MOVE T2,WS$CFD+.FDPAT-1(T1) ; Get last SFD name
|
||
MOVSI T3,'SFD'
|
||
DMOVEM T2,WS$CFD+.FDNAM(WS)
|
||
SETZM WS$CFD+.FDPAT-1(T1) ; Remove name from path
|
||
MOVEI S1,WS$CFD(WS) ; Get FD address
|
||
$CALL OPNFIL ; Try to open the file
|
||
MOVE T1,WS
|
||
ADD T1,WS$LEV(WS)
|
||
MOVE T2,WS$CFD+.FDNAM(WS)
|
||
MOVEM T2,WS$CFD+.FDPAT-1(T1) ; Put last SFD name back
|
||
$RETIF ; Could we open the file?
|
||
PJRST .SDIR ; Yes, go scan it
|
||
|
||
; .SDIR - Scan currently open directory file
|
||
;
|
||
; Returns in S1, S2/ Name and extension
|
||
;
|
||
.SDIR: SKIPN S1,LUPBLK+.RBSIZ ; Anything written in directory?
|
||
JRST[ $CALL CLSFIL ; No, so close it immediately
|
||
$RETF]
|
||
ADDI S1,1 ; Reserve space for buffer pointer
|
||
$CALL M%GMEM ; Allocate the directory buffer
|
||
PUSH FP,S2 ; Save buffer address...
|
||
HRLM S1,(FP) ; ...and length
|
||
MOVEI T1,1(S2) ; Get address + 1...
|
||
MOVN T2,LUPBLK+.RBSIZ ; ...negated word count...
|
||
HRL T1,T2 ; ...and make a buffer pointer
|
||
MOVEM T1,(S2) ; Put it first in buffer
|
||
MOVEI T1,.FOINP ; Function code 'input'...
|
||
STORE T1,FOPBLK+.FOFNC,FO.FNC
|
||
MOVEI T1,T2 ; Address of I/O list...
|
||
MOVEM T1,FOPBLK+.FOIOS
|
||
HLL T2,(S2) ; Get length...
|
||
HRR T2,S2 ; ...and address
|
||
SETZ T3, ; Mark end of list
|
||
MOVE T1,[.FOIOS+1,,FOPBLK]
|
||
FILOP. T1, ; Read the directory file
|
||
JRST[ $WARN <FILOP. function .FOINP error ^O/T1/>
|
||
$CALL CLSFIL ; Release the channel...
|
||
JRST .SDIR4] ; ...and the buffer space
|
||
$CALL CLSFIL ; Close it
|
||
HRRZ T1,(FP) ; Get address of directory buffer
|
||
MOVE T2,(T1) ; Get buffer pointer
|
||
;
|
||
; Loop here for each two-word entry in directory file
|
||
;
|
||
.SDIR2: SKIPN S1,0(T2) ; Blank entry?
|
||
JRST .SDIR3 ; Yes, skip it
|
||
HLLZ S2,1(T2) ; No, get extension too
|
||
MOVEM T2,(T1) ; Put buffer pointer back in buffer
|
||
SETO TF, ; Say that we have something...
|
||
$CALL @(P) ; ...and give it to the caller
|
||
HRRZ T1,(FP) ; Get address of directory buffer
|
||
MOVE T2,(T1) ; Get buffer pointer
|
||
.SDIR3: ADD T2,[2,,2] ; Increment pointer
|
||
JUMPL T2,.SDIR2 ; More left in buffer?
|
||
.SDIR4: HLRZ S1,(FP) ; No, get length...
|
||
HRRZ S2,(FP) ; ...and address
|
||
$CALL M%RMEM ; Release buffer space
|
||
SETZM (FP) ; Remove old data...
|
||
SUB FP,[1,,1] ; ...and pop the word
|
||
$RETF
|
||
|
||
; OPNFIL - Open a file for dump mode input
|
||
;
|
||
; Accepts in S1/ Address of FD
|
||
;
|
||
OPNFIL: MOVEI T1,PTHBLK
|
||
MOVEM T1,LUPBLK+.RBPPN ; Set pointer to path block
|
||
MOVEI T1,LUPBLK
|
||
MOVEM T1,FOPBLK+.FOLEB ; Set pointer to lookup block
|
||
MOVEI S2,FOPBLK ; Get address of filop block
|
||
$CALL FD2FOP ; Copy FD contents
|
||
SKIPT
|
||
$FATAL <FD2FOP says "^T/(S1)/" at OPNFIL>
|
||
;
|
||
; RETFIL calls LUPFIL to obtain a RIB copy
|
||
;
|
||
LUPFIL: MOVX T1,FO.PRV!FO.ASC+.FORED ; Flags and function...
|
||
MOVEM T1,FOPBLK+.FOFNC
|
||
MOVEI T1,.IODMP ; Dump mode I/O...
|
||
MOVEM T1,FOPBLK+.FOIOS
|
||
SETZM FOPBLK+.FOBRH ; No buffers...
|
||
SETZM FOPBLK+.FONBF ; ...
|
||
MOVEI T1,.PTSCN ; /NOSCAN
|
||
MOVEM T1,PTHBLK+.PTSWT
|
||
MOVE T1,[.FOLEB+1,,FOPBLK]
|
||
FILOP. T1, ; Try to read the file
|
||
JRST[ $CALL RELFIL ; Failed, release the channel
|
||
$RETF]
|
||
MOVX T1,FO.CHN ; Get channel number mask
|
||
ANDM T1,FOPBLK+.FOFNC ; Remove flags and function
|
||
$RETT
|
||
|
||
; CLSFIL - Close and release channel in FOPBLK
|
||
;
|
||
CLSFIL: MOVEI T1,.FOCLS ; Get function 'close'
|
||
STORE T1,FOPBLK+.FOFNC,FO.FNC
|
||
MOVX T1,CL.ACS ; Don't update access date
|
||
MOVEM T1,FOPBLK+.FOIOS
|
||
MOVE T1,[.FOIOS+1,,FOPBLK]
|
||
FILOP. T1, ; Close the file
|
||
$WARN <FILOP. function .FOCLS error ^O/T1/>
|
||
;
|
||
; Come here to release channel in filop block
|
||
;
|
||
RELFIL: MOVEI T1,.FOREL ; Get function 'release'
|
||
STORE T1,FOPBLK+.FOFNC,FO.FNC
|
||
SETZM FOPBLK+.FOIOS
|
||
MOVE T1,[.FOIOS+1,,FOPBLK]
|
||
FILOP. T1, ; Release the channel
|
||
$WARN <FILOP. function .FOREL error ^O/T1/>
|
||
$RET
|
||
SUBTTL W$KILL
|
||
|
||
; W$KILL - Deallocate a wildcard scanner block
|
||
;
|
||
; Accepts in S1/ Address of scanner block
|
||
;
|
||
W$KILL: MOVE T2,S1 ; Save block address
|
||
MOVE T1,S1
|
||
HRLI T1,-FPLSIZ ; Insert length of file buffer PDL
|
||
KILL.1: SKIPN S2,WS$FPL(T1) ; Is there an allocated buffer?
|
||
JRST KILL.2 ; No, go loop
|
||
HLRZ S1,S2 ; Yes, so get length...
|
||
ANDI S2,-1 ; ...and extract address
|
||
$CALL M%RMEM ; Deallocate the buffer
|
||
KILL.2: AOBJN T1,KILL.1 ; Loop thru the file buffer PDL
|
||
MOVEI S1,WS$SIZ ; Now get length...
|
||
MOVE S2,T2 ; ...and address of scanner block
|
||
PJRST M%RMEM ; Deallocate it and return
|
||
|
||
END
|