Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-12 - 43,50547/pltlib/tek/scan1.mac
There is 1 other file named scan1.mac in the archive. Click here to see a list.
UNIVERSAL	SCAN1U - Definitions for SCAN1
SUBTTL	By Joe Smith 20-Sep-77

	COMMENT	&
SCAN1 scans a file specs, converting from an ASCII string to OPEN/LOOKUP.
NACS1 does the opposite, converting OPEN/LOOKUP to an ASCII string.

  This version was written when my previous version got out-of-hand (like DEC's
version).  SCAN1 is designed to pick up one file-spec and stop at anything it
doesn't like (including "=" or "/").  This version does not care if there are
two periods, it takes the last extension as valid.  SCAN1 accepts wildcards,
but merely turns on a bit, leaving the interpretation of the question-mark or
asterisk up to the caller.  Same for the at-sign, SCAN1 decodes the indirect
file name, the caller has to read this file.  The pound-sign allows funny names
to be enterred using two octal digits per character, just like PIP.

  This code is convoluted and not very understandable, but it is small and
gets the job done.  SCAN1 is guarenteed to read:

	DEVICE:FILE.EXT<PRO>[P,PN,SFD1,...SFD5]
&  ;End COMMENT

;Global AC definitions
	T1=1			;Flag bits and last character returned here
	L=16			;Link to FORTRAN style arg list
	P=17			;PDL pointer

;Argument indices
	DEFINE PTR,<@0(L)>	;ASCII byte pointer
	DEFINE CNT,<@1(L)>	;Count of remaining chars
	DEFINE DEV,<@2(L)>	;Place to put device name
	DEFINE FIL,<@3(L)>	;4 word block for file name
		NAM==0		;File name
		EXT==1		;Extension
		PRO==2		;Protection
		PPN==3		;Directory
	DEFINE PTH,<@4(L)>	;8 word block for SFD (PATH. args)

;Scan Flags, returned in the LH of T1
	SF.SPC==1B0		;Device and/or filename found (sign bit)
	SF.DEV==1B1		;Device found
	SF.FIL==1B2		;Filename found
	SF.EXT==1B3		;Period found
	SF.PRO==1B4		;Protection found
	SF.PPN==1B5		;PPN found
	SF.SFD==1B6		;SFD's seen (PPN word points to PTH)
	SF.WLD==1B7		;Wildcards found
	SF.PP2==1B8		;PPN in front of filename
	SF.IND==1B9		;@ at-sign seen

	NOSYM			;Suppress symbol table in listing
	PRGEND			;End of UNIVERSAL SCAN1U
TITLE	SCAN1 - Small file-name scanner
SUBTTL	AC definitions

COMMENT &
	MOVEI	L,SPEC		;AC16 points to args
	PUSHJ	P,SCAN1		;Interpret the command buffer
	 *Only return*		;<flag bits,,last char> in T1
			;Preserves all other AC's, uses 12 words of stack space

	-5,,0
SPEC:	POINTR			;ASCII byte pointer to string
	ICOUNT			;Number of characters left in string
	DEVICE			;Returned as SIXBIT
	FILEXT			;Start of 4 word LOOKUP/ENTER block
	PATHB			;8 word PATH. block

&		;End of comment

	SEARCH	SCAN1U		;Get other definitions

	F=0			;Flags when in SCAN1
	T1=T1	;1		;Returned flags and last char
	T2=2			;Temp
	CH=3			;Holds char
	BP=4			;Output byte pointer
	I=5			;Index register
	L=L	;16		;Link to arg list
	P=P	;17		;PDL pointer


	TWOSEG			;Make this reentrant
	RELOC	400000		;Start in the HISEG
	XALL			;Make sure arg definitions expand nicely
SUBTTL	Entry and Exit points

ENTRY	SCAN1

	SIXBIT	/SCAN1/
SCAN1:	PUSH	P,F		;Save regs
	PUSH	P,T2
	PUSH	P,CH
	PUSH	P,BP
	PUSH	P,I
	MOVEI	I,FIL		;Point to 4-word LOOKUP block

	PUSHJ	P,SCAN2		;Go interpret the characters

	HLLZS	EXT(I)		;Only 3 letter extension
	HRRI	F," "-' '(CH)	;Convert last char back to ASCII
	SKIPE	NAM(I)		;Do we have a file name?
	 TLO	F,(SF.FIL+SF.SPC) ;Yes, flag it
	MOVE	T1,F		;Return SCAN1 flags in AC1

	POP	P,I		;Restore ACs
	POP	P,BP
	POP	P,CH
	POP	P,T2
	POP	P,F
	POPJ	P,		;Return from SCAN1
SUBTTL	Interpret command buffer

SCAN2:	SETZB	T1,DEV		;No device yet, nor PPN
	SETZB	F,NAM(I)	;No flags, no file name
	SETZM	EXT(I)		;No extension
	SETZM	PRO(I)		;No protection
	SETZM	PPN(I)		;Default directory
	MOVEI	BP,DEV		;Store the first word as the device

GETDEV:	PUSHJ	P,GETWRD	;Get a word
	CAIN	CH,':'		;Did we hit the colon?
	 JRST	GOTDEV		;Yes
	MOVSI	T1,'DSK'	;No device, assume DSK
	EXCH	T1,DEV		;Put in device name
	MOVEM	T1,NAM(I)	;Put file name in right place
	JRST	GOTNAM		;Check for extension or PPN

GOTDEV:	TLO	F,(SF.DEV+SF.SPC) ;We do have a device
	CAIN	CH,'<'		;Protection?    ;'>'
	 JRST	GETNUM		;Yes, start of number
	CAIN	CH,'['		;PPN?
	 JRST	GETPN		;Yes, get directory

;Search for file name

GETFIL:	MOVEI	BP,NAM(I)	;Point to file name
GETNXT:	PUSHJ	P,GETWRD	;Get file name or extension

;Here at the end of the current word

GOTNAM:	CAIE	CH,'<'		;Protection?    ;'>'
	CAIN	CH,'['		;Path?
	 JRST	GETNUM		;Yes, get a number
	CAIE	CH,'.'		;Period?
	 POPJ	P,		;No, illegal char, return from SCAN2
			;Note that '=', '/' and <CR> mark the end of spec

GETEXT:	TLO	F,(SF.EXT)	;We do have an extension
	MOVEI	BP,EXT(I)	;Point to the extension
	JRST	GETNXT		;Go get the extension
SUBTTL	GETNUM - Get an octal number, or PPN,SFD,SFD

GETPN:	TLNN	F,(SF.FIL+SF.EXT) ;Do we have a file name yet?
	 TLO	F,(SF.PP2)	;No, the PPN came first

GETNUM:	SETZ	T1,		;Start with zero
GETNM1:	PUSHJ	P,GETC		;Get a digit
	  JRST	GOTNUM		;No more digits
	SUBI	CH,'0'		;Convert to binary
	LSH	T1,3		;Multiply T1 by 8
	ADD	T1,CH		;Add in the number
	JRST	GETNM1		;Go for more

;'<'
GOTNUM:	CAIN	CH,'>'		;Close angle bracket?
	 JRST	GOTPRO		;Yes, protection
	CAIN	CH,']'		;End of PPN?
	 JRST	GOTPPN		;Yes
	CAIN	CH,','		;Comma?
	TLOE	F,(SF.PPN)	;Yes, first one?
	 JRST	GOTPPN		;Second comma or illegal syntax
	HRLZM	T1,PPN(I)	;Store the project number
	JRST	GETNUM		;Go for programmer number

GOTPPN:	HLL	T1,PPN(I)	;Get project number also
	GETPPN	T2,		;This will NOT skip
	TLNN	T1,-1		;Anything in the left half?
	 HLL	T1,T2		;No, insert the project number
	TRNN	T1,-1		;Anything in the right half?
	 HRR	T1,T2		;No, insert the programmer number
	MOVEM	T1,PPN(I)	;Store it
	CAIN	CH,','		;Comma after programmer?
	 JRST	GETSFD		;Yes, go for SFDs
	JRST	GETFIL		;Go for file name

GOTPRO:	LSH	T2,^D27		;Put protection into position
	MOVEM	T2,PRO(I)	;Store it
	TLO	F,(SF.PRO)	;Flag it
	JRST	GETFIL		;Look for more in file spec
SUBTTL	GETSFD and GETWRD - get SIXBIT words

GETSFD:	MOVE	T1,PPN(I)	;Get the PPN
	MOVEI	BP,PTH		;Get addr of PATH. block
	MOVEM	BP,PPN(I)	;Store for the lookup
	SETZM	0(BP)		;Clear the function word
	SETZM	1(BP)		;And the SCAN bits
	MOVEM	T1,2(BP)	;Store the PPN
	TLO	F,(SF.SFD)	;Flag SFDs seen
	ADDI	BP,3		;Point to first SFD slot

MORSFD:	CAIE	CH,','		;Another comma?
	 JRST	GOTNAM		;No, go see what it is
	HRRZS	BP		;Clear left half
	MOVEI	T1,PTH		;Get addr of PATH. block
	CAILE	BP,7(T1)	;Done 5 SFDs already?
	 MOVEI	BP,7(T1)	;Yes, 6th overwrites the 5th
	SETZM	(BP)		;Clear this SFD slot
	PUSHJ	P,GETWRD	;Get the SFD name
	CAIE	CH,']'		;Done yet?
	 AOJA	BP,MORSFD	;No, get next SFD name
	JRST	GETFIL		;Done with the path

;Routine to get a SIXBIT word and store it using BP as pointer

GETWRD:	HRLI	BP,(POINT 6,)	;Make a byte pointer
GETW1:	PUSHJ	P,GETC		;Get a letter or digit
	  JRST	GETW2		;Check for #
	TLNE	BP,770000	;Any room in this word?
	 IDPB	CH,BP		;Yes, stuff it in
	JRST	GETW1		;Go for 6

GETW2:	CAIE	CH,'#'		;Pound sign?
	 POPJ	P,		;No, return from GETWRD
GETODD:	PUSHJ	P,GETC		;Get a digit
	  POPJ	P,		;End of word
	CAILE	CH,'7'		;Octal digit?
	 POPJ	P,		;No, done
	MOVEI	T1,-'0'(CH)	;Save odd digit
	LSH	T1,3		;Shift over 3 places
	PUSHJ	P,GETC		;Get even digit
	  POPJ	P,		;Bad, but I won't complain
	CAILE	CH,'7'		;Octal only
	 POPJ	P,		;Also bad
	DPB	CH,[POINT 3,T1,35] ;Combine the two
	TLNE	BP,770000	;Any room in the word?
	 IDPB	T1,BP		;Insert the funny char
	JRST	GETODD		;Go for more
SUBTTL	Get a character from the buffer

;Get an uppercase character from the input string, ignoring blanks.

ATSIGN:	TLO	F,(SF.IND)	;Flag indirect char seen and get next char
GETC:	SETZ	CH,		;In case buffer empty
	SOSGE	CNT		;Any more chars in the buffer?
	 POPJ	P,		;No, give error return
	ILDB	CH,PTR		;Input a char
	CAIL	CH,"A"+40	;Lower case?
	CAILE	CH,"Z"+40	; ...
	 SKIPA			;No
	  SUBI	CH,40		;Yes, convert to upper
	CAIE	CH," "		;Space
	CAIN	CH,11		; or tab?
	 JRST	GETC		;Yes, ignore
	CAIE	CH,"?"		;Wild card?
	CAIN	CH,"*"		; ...
	 JRST	[TLO	F,(SF.WLD) ;Yes, flag it
		 JRST	CPOPJ1]	   ; and consider it legal
	CAIN	CH,"@"		;At sign?
	 JRST	ATSIGN		;Flag it and continue
	SUBI	CH," "-' '	;Convert to SIXBIT
	CAIL	CH,'0'		;Number
	CAILE	CH,'Z'		; or alpha?
	 POPJ	P,		;No, error return
	CAILE	CH,'9'		;Numbers and alpha only
	CAIL	CH,'A'		; ...
CPOPJ1:	AOS	(P)		;Yes, skip return
CPOPJ:	POPJ	P,		;Return from GETC


	PRGEND			;End of SCAN1
TITLE	NACS1 - Un-scanner
SUBTTL	AC definitions

COMMENT &
	MOVEI	L,SPEC		;Same argument block for NACS1
	PUSHJ	P,NACS1		;Unscan OPEN/LOOKUP back into string
	 *Only return*		;Preserves all ACs

	-5,,0
SPEC:	POINTR			;ASCII byte pointer to string
	ICOUNT			;Number of characters left in string
	DEVICE			;In SIXBIT
	FILEXT			;Start of 4 word LOOKUP/ENTER block
	PATHB			;8 word PATH. block

&		;End of comment

	SEARCH	SCAN1U		;Get other definitions

	F=0			;Flags when in SCAN1
	T1=T1	;1		;Returned flags and last char
	T2=2			;Temp
	CH=3			;Holds char
	BP=4			;Output byte pointer
	I=5			;Index register
	L=L	;16		;Link to arg list
	P=P	;17		;PDL pointer


	TWOSEG			;Make this reentrant
	RELOC	400000		;Start in the HISEG
SUBTTL	Entry and Exit points

ENTRY	NACS1

	SIXBIT	/NACS1/
NACS1:	PUSH	P,F		;Save regs
	PUSH	P,T1
	PUSH	P,T2
	PUSH	P,CH
	PUSH	P,BP
	PUSH	P,I
	MOVEI	I,FIL		;Point to 4-word LOOKUP block

	PUSHJ	P,NACS2		;Go interpret the binary data

	POP	P,I		;Restore ACs
	POP	P,BP
	POP	P,CH
	POP	P,T2
	POP	P,T1
	POP	P,F
	POPJ	P,		;Return from NACS1
SUBTTL	Unscan file specs

NACS2:	SKIPN	T2,DEV		;Get the device
	 JRST	NODEV		;Don't output anything if blank
	PUSHJ	P,OUTSIX
	MOVEI	T1,":"		;Now a colon
	PUSHJ	P,OUTASC

NODEV:	MOVE	T2,NAM(I)	;Get the file name
	PUSHJ	P,OUTSIX
	MOVEI	T1,"."		;Now a period
	PUSHJ	P,OUTASC
	HLLZ	T2,EXT(I)	;Get extension
	SKIPE	T2		;Skip it if blank
	 PUSHJ	P,OUTSIX
	SKIPN	T1,PPN(I)	;Get directory
	 JRST	OUTNUL		;Done if zero
	TLNN	T1,-1		;Anything in LH?
	 JRST	OUTSFD		;Yes, type SFDs
	PUSHJ	P,OUTPPN	;Output "[p,pn"

OUTBKT:	MOVEI	T1,"]"		;Finish off the PPN
	PUSHJ	P,OUTASC
OUTNUL:	MOVE	T2,PTR		;Get byte pointer
	MOVEI	T1,0		;Null
	IDPB	T1,T2		;Store null at end of ASCIZ string
	POPJ	P,		;All done

OUTPPN:	JUMPL	T1,OUTDEF	;Output "[-" if PPN is negative
	PUSH	P,T1		;Save programmer
	MOVEI	T1,"["
	PUSHJ	P,OUTASC
	HLRZ	T1,(P)		;Only the project
	PUSHJ	P,OUTOCT
	MOVEI	T1,","		;Now a comma
	PUSHJ	P,OUTASC
	POP	P,T1		;Get PPN back
	HRRZS	T1		;Only the programmer
				;Fall into OUTOCT and return

OUTOCT:	IDIVI	T1,10		;Get a digit
	HRLM	T2,(P)
	SKIPE	T1		;If not done,
	 PUSHJ	P,OUTOCT	;Do it again
	HLRZ	T1,(P)		;Get a digit
	ADDI	T1,"0"		;Fall into OUTASC and return
;Routine to output a single ASCII character in T1

OUTASC:	SOSL	CNT		;Decrement counter
	 IDPB	T1,PTR		;Store char
	POPJ	P,

;Routine to output a SIXBIT word in T2

OUTSIX:	SETZ	T1,		;Clear junk
	ROTC	T1,6		;Shift in a char from top of T2
	ADDI	T1,40		;Convert to ASCII
	PUSHJ	P,OUTASC
	JUMPN	T2,OUTSIX	;Loop until done
	POPJ	P,

OUTSFD:	MOVE	BP,T1		;Copy pointer to PATH
	MOVE	T1,2(BP)	;Get PPN
	PUSHJ	P,OUTPPN
	ADDI	BP,3		;Point to first SFD slot
	HRLI	BP,-5		;Make into AOBJN pointer

OUTSF1:	SKIPN	(BP)		;Check SFD
	 JRST	OUTBKT		;Done, output "]"
	MOVEI	T1,","		;Get a comma
	PUSHJ	P,OUTASC
	MOVE	T2,(BP)		;SFD name
	PUSHJ	P,OUTSIX
	AOBJN	BP,OUTSF1	;Do up to 5 of them
	JRST	OUTBKT		;Only if all 5 are non-zero

OUTDEF:	MOVEI	T1,"["		;Default directory if PPN is negative
	PUSHJ	P,OUTASC
	MOVEI	T1,"-"
	JRST	OUTASC		;Output it and return

	END			;Of NACS1