;<PUP>PUPPRP.MAC;13    26-SEP-82 15:14:34    EDIT BY TAFT
; Add Desired-Property property
; Directory property parser strips extraneous surrounding < >
;<PUP>PUPPRP.MAC;12     7-NOV-81 14:03:25    EDIT BY TAFT
; Fix bug in parsing of special version properties.
;<PUP>PUPPRP.MAC;11    24-APR-81 21:08:17    EDIT BY TAFT
; Add code to date property parsers to permit time zone preceded
; by space rather than hyphen (stupid Tenex restriction).
;<PUP>PUPPRP.MAC;10    29-AUG-80 15:48:10    EDIT BY TAFT
; Permit special version property values *, H, L, N.
;<PUP>PUPPRP.MAC;8    20-JAN-80 17:42:13    EDIT BY TAFT
; Permit optional ".registry" appended to User-name property
;<PUP>PUPPRP.MAC;7     2-SEP-79 16:00:50    EDIT BY TAFT
;<PUP>PUPPRP.MAC;6     2-JUN-77 21:32:49    EDIT BY TAFT
; Add "Author" and "Size" property parsers
;<PUP>PUPPRP.MAC;5    31-MAR-77 20:25:23    EDIT BY TAFT
; Put in hooks for mail server
; Make individual property interpreters conditionally external
; Reinstate forcing device and directory to upper-case.
; (I knew there was a reason.  Damn silly Tenex problem!)
;<PUP>PUPPRP.MAC;3    19-MAR-77 20:05:26    EDIT BY TAFT
; Add code to parse date properties
;<PUP>PUPPRP.MAC;2    18-MAR-77 18:14:45    EDIT BY TAFT
; Call external REFILL procedure in SCNPRP
;<PUP>PUPPRP.MAC;1    18-MAR-77 17:06:55    EDIT BY TAFT
; Modified to be usable in both server and user
; Renamed PUPPRP.MAC
; Uniformly generate "No" response before giving error return.
; Remove device/directory name check -- it will be caught later if
; actually used.
;<PUP>PFUPRP.MAC;3    15-MAR-77 18:54:26    EDIT BY TAFT
; Add Tenex-paged type
;<PUP>PFUPRP.MAC;2    10-MAR-77 14:21:00    EDIT BY TAFT
; Split out from PUPFTP.MAC

; Copyright 1979, 1980, 1981 by Xerox Corporation

	TITLE PUPPRP -- PUP FTP PROPERTY LIST PARSER
	SUBTTL E. A. Taft / March 1977

	SEARCH PUPDEF,STENEX


; Scan and interpret property list
;	A/ Source string pointer (first char expected to be "(" )
;	B/ Pointer to property list storage region
; Returns +1:  Syntax error, "No" reply already generated
;		(caller may have to supply terminating EOC)
;	+2:  Successful, A/ Pointer to matching ")"
; The external REFILL procedure is called often.  It should
; do any necessary management of the source string pointer in A.
; Clobbers C, D

SCNPRP::PUSHJ P,SAVE1##		; Protect P1
	MOVE P1,B		; Put plist pointer in protected ac
	TLC A,-1		; Convert -1 lh string ptr
	TLCN A,-1		;  to standard byte ptr
	 HRLI A,(POINT 7)
	ILDB B,A		; Check first char
	CAIE B,"("		; Good start of property list?
	 FTPM(NO,10,<Malformed property list>,1)

; Here to begin scanning new property
SCNPR1:	PUSHJ P,REFILL##	; Refill buffer if necessary
	ILDB C,A		; Get next char
	CAIN C," "		; Permit extra spaces here
	 JRST SCNPR1
	CAIN C,")"		; End of property list?
	 JRST SCNPR9		; Yes
	CAIE C,"("		; Start of new property?
	 FTPM(NO,10,<Malformed property list>,1)
	MOVE B,[-NPROPS,,PLDISP]  ; Make ptr to property name table
	PUSHJ P,FNDKEY		; Get and lookup property name
	 FTPM(NO,10,<Malformed property name>,1)
	 JRST [	HRROI B,TEMP##	; Unrecognized property, say so
		DTYPE <Unrecognized property "%2S"%/>
		MOVEI C,5000	; Max # characters to discard
		PUSHJ P,GTPVAL	; Scan and discard property value
		 FTPM(NO,10,<Malformed property>,1)
		JRST SCNPR3]	; Ignore property, on to next
	LDB C,A			; Check terminator
	CAIE C," "		; Space?
	 FTPM(NO,10,<Malformed property>,1)
	MOVE D,0(B)		; Found, get dispatch
	HLLM D,0(P)		; Save entry pointer in case error
	TRZ F,RAISEF		; Default is not to raise lower case
	PUSHJ P,0(D)		; Scan and store property value
	 POPJ P,		; Failed, return +1
SCNPR3:	LDB C,A			; Get terminator
	CAIE C,")"		; Proper end of property?
	 FTPM(NO,10,<Malformed property>,1)
	JRST SCNPR1		; Yes, on to next property

; Here when done entire property list
SCNPR9:	SKIPN P.DPRP(P1)	; Any Desired-Property properties encountered?
	 SETOM P.DPRP(P1)	; No, request all
	JRST SKPRET##		; Return +2

; Construct property name and dispatch table

DEFINE X(SYM,NAME,SIZE<1>) <
IF2,<IFNDEF PP'SYM,<EXTERN PP'SYM>>
	[ASCIZ /NAME/] ,, PP'SYM
>

PLDISP:	PNAMES

	NPROPS==.-PLDISP	; Number of properties

; Subroutines to process individual properties
; All have the following calling sequence:
;	A/ Source string ptr
;	P1/ Property list pointer
; Returns +1:  Error, reply already generated
;	+2:  Successful, A/ byte ptr to property value terminator
; May clobber B-D

; (Author <string>)

PPAUTH:	HRROI B,P.AUTH(P1)	; Where to put string
	MOVEI C,USRSTL		; Max # of characters
	PUSHJ P,GTPVAL		; Collect and store string
	 FTPM(NO,10,<Malformed property>,1)
	JRST SKPRET##		; Return +2


; (Byte-Size <decimal number>)

PPBYTE:	MOVEI C,↑D10		; Decimal radix
	NIN			; Convert number
	 FTPM(NO,16,<Malformed Byte-Size>,1)
	CAIL B,1		; Check for reasonable value
	CAILE B,↑D36
	 FTPM(NO,16,<Byte-Size not in range 1-36>,1)
	MOVEM B,P.BYTE(P1)	; Ok, store it in property list
	JRST SKPRET##		; Return +2


; (Connect-Name <directory name>) - only server should receive this

PPCNAM:	PUSHJ P,GSTDIR		; Collect string and do STDIR
	 FTPM(NO,10,<Malformed property>,1)
	 FTPM(NO,23,<Illegal Connect-Name>,1)
	HRRZM C,P.CNAM(P1)	; Store dir # in property list
	JRST SKPRET##		; Return +2


; (Connect-Password <string>) - only server should receive this

PPCPSW:	HRROI B,P.CPSW(P1)	; Where to put string
	MOVEI C,USRSTL		; Max # of characters
	TRO F,RAISEF		; Raise lower case letters
	PUSHJ P,GTPVAL		; Collect and store password string
	 FTPM(NO,10,<Malformed property>,1)
	JRST SKPRET##		; Return +2


; (Creation-Date <date>)

PPCDAT:	PUSHJ P,GETDAT		; Input date and time
	 FTPM(NO,25,<Malformed Creation-Date>,1)
	MOVEM B,P.CDAT(P1)	; Ok, store it in property list
	JRST SKPRET##

; Property value processing routines (cont'd)

; (Desired-Property <property>)

PPDPRP:	MOVE B,[-NPROPS,,PLDISP]  ; Make ptr to property name table
	PUSHJ P,FNDKEY		; Get and lookup property name
	 FTPM(NO,10,<Malformed property name>,1)
	 JRST [	HRROI B,TEMP##	; Unrecognized property, say so if debugging
		DTYPE <Unrecognized property "%2S"%/>
		JRST SKPRET##]	; Just ignore
	SUBI B,PLDISP		; Index of property name
	MOVNI B,0(B)
	MOVSI C,(1B0)		; Set desired-property bit
	LSH C,0(B)
	IORM C,P.DPRP(P1)
	JRST SKPRET##


; (Device <device name>)

PPDEVI:	TRO F,RAISEF		; Raise lower case letters
	HRROI B,P.DEVI(P1)	; Where to put string
	MOVEI C,USRSTL		; Max length
	PUSHJ P,GTPVAL		; Collect and store device name
	 FTPM(NO,10,<Malformed property>,1)
	JRST SKPRET##		; Return +2


; (Directory <directory name>)

PPDIRE:	TRO F,RAISEF		; Raise lower case letters
	HRROI B,P.DIRE(P1)	; Put property value here
	MOVEI C,USRSTL		; Max # characters
	PUSHJ P,GTPVAL		; Get property value string
	 FTPM(NO,10,<Malformed property>,1)

; Strip extraneous < > off directory name, since this is a common user error.
	MOVEI D,P.DIRE(P1)
	HRLI D,(POINT 7)
	ILDB C,D		; If string empty then just return
	JUMPE C,SKPRET##
	ADD B,[7B5]
	LDB C,B			; Last real char of string
	CAIE C,">"		; If it is ">" then smash it with null
	 JRST .+3
	SETZ C,
	DPB C,B
	LDB C,D			; First char of string
	CAIE C,"<"
	 JRST SKPRET##
	MOVEI B,P.DIRE(P1)	; Strip "<" by sliding string down one char
	HRLI B,(POINT 7)
	ILDB C,D
	IDPB C,B
	JUMPN C,.-2
	JRST SKPRET##		; Return +2


; (End-Of-Line-Convention CR|CRLF|Transparent)

PPEOLC:	MOVE B,[-3,,EOLTAB]	; Set pointer to keyword table
	PUSHJ P,FNDKEY		; Get and lookup keyword
	 FTPM(NO,17,<Illegal End-of-Line-Convention>,1)
	 FTPM(NO,17,<Illegal End-of-Line-Convention>,1)
	HRRZ B,0(B)		; Succeeded, get entry value
	MOVEM B,P.EOLC(P1)	; Store in property list
	JRST SKPRET##		; Return +2

EOLTAB:	[ASCIZ /CR/] ,, 0
	[ASCIZ /CRLF/] ,, 1
	[ASCIZ /TRANSPARENT/] ,, 2

; Property value processing routines (cont'd)


; (Name-Body <name.extension>)

PPNAMB:	MOVE B,[POINT 7,P.NAMB(P1)]  ; Init byte ptr
	MOVEI C,NAMSTL		; Max length
	TRZ F,RAISEF		; Use this as period seen flag
PPNAM1:	ILDB D,A		; Get char from property value
	JUMPE D,[FTPM(NO,10,<Malformed property>,1)]
	CAIN D,PQUOTE		; Character quote?
	 JRST [	ILDB D,A	; Yes, get next literally
		JUMPE D,[FTPM(NO,10,<Malformed property>,1)]
		JRST .+3]
	CAIN D,")"		; End of property value?
	 JRST PPNAM4		; Yes
	SOJL C,[FTPM(NO,13,<Name-Body too long>,1)]  ; Check length
	CAIN D,"."		; Period?
	 JRST [	TRON F,RAISEF	; Yes, seen one already?
		 JRST PPNAM3	; No, store literally
		JRST PPNAM2]	; Yes, quote it
	PUSH P,D+1		; Get another ac
	IDIVI D,↑D36		; Compute index into bit table
	MOVE D,FILQUO(D)	; See if need to quote character
	LSH D,(D+1)		; Set sign if so
	POP P,D+1
	JUMPGE D,PPNAM3		; Jump if not
PPNAM2:	MOVEI D,"V"-100		; Insert a control-V
	IDPB D,B
	SOJL C,[FTPM(NO,13,<Name-Body too long>,1)]  ; Check length
PPNAM3:	LDB D,A			; Recover character
	IDPB D,B		; Store it
	JRST PPNAM1		; Back for more

PPNAM4:	SETZ D,			; Done, append null
	IDPB D,B
	JRST SKPRET##		; Return +2

; Bit table of characters that must be quoted with ↑V for GTJFN
FILQUO:	777777777770		; 000-043
	001200035600		; 044-107
	000000014000		; 110-153
	000007600000		; 154-177

; Property value processing routines (cont'd)

; (Read-Date <date>)

PPRDAT:	PUSHJ P,GETDAT		; Input date and time
	 FTPM(NO,27,<Malformed Read-Date>,1)
	MOVEM B,P.RDAT(P1)	; Ok, store it in property list
	JRST SKPRET##


; (Server-Filename <filename>)

PPSFIL:	HRROI B,P.SFIL(P1)	; Where to put name string
	MOVEI C,SFNSTL		; Maximum length
	PUSHJ P,GTPVAL		; Get property value string
	 FTPM(NO,10,<Malformed property>,1)
	JRST SKPRET##		; Succeeded, return +2


; (Size <decimal number>)

PPSIZE:	MOVEI C,↑D10		; Decimal radix
	NIN			; Convert number
	 FTPM(NO,10,<Malformed size>,1)
	MOVEM B,P.SIZE(P1)	; Store in property list
	JRST SKPRET##		; Return +2


; (Type Text|Binary|Tenex-Paged)

PPTYPE:	MOVE B,[-3,,TYPTAB]	; Set pointer to keyword table
	PUSHJ P,FNDKEY		; Get and lookup keyword
	 FTPM(NO,15,<Illegal Type>,1)
	 FTPM(NO,15,<Illegal Type>,1)
	HRRZ B,0(B)		; Succeeded, get entry value
	MOVEM B,P.TYPE(P1)	; Store in property list
	JRST SKPRET##		; Return +2

TYPTAB:	[ASCIZ /BINARY/] ,, 2
	[ASCIZ /TENEX-PAGED/] ,, 3
	[ASCIZ /TEXT/] ,, 1


; (User-Name <username>) - only server should receive this

PPUNAM:	PUSHJ P,GSTDIR		; Collect string and do STDIR
	 FTPM(NO,10,<Malformed property>,1)
	 FTPM(NO,20,<Illegal User-Name>,1)
	SKIPGE C		; Make sure not files-only
	 FTPM(NO,20,<Files-only directory illegal as User-Name>,1)
	HRRZM C,P.UNAM(P1)	; Store dir # in property list
	JRST SKPRET##		; Return +2


; (User-Password <string>) - only server should receive this

PPUPSW:	HRROI B,P.UPSW(P1)	; Where to put string
	MOVEI C,USRSTL		; Max # of characters
	TRO F,RAISEF		; Raise lower case letters
	PUSHJ P,GTPVAL		; Collect and store password string
	 FTPM(NO,10,<Malformed property>,1)
	JRST SKPRET##		; Return +2

; Property value processing routines (cont'd)

; (User-Account <string>) - only server should receive this

PPUACT:	HRROI B,P.UACT+1(P1)	; Where to put string
	MOVEI C,USRSTL		; Max # of characters
	TRO F,RAISEF		; Raise lower-case letters
	PUSHJ P,GTPVAL		; Collect and store account string
	 FTPM(NO,10,<Malformed property>,1)
	MOVE D,A		; Preserve source string ptr
	HRROI A,P.UACT+1(P1)	; See if account is numeric
	MOVEI C,↑D10
	NIN
	 JRST PPUAC1		; No, assume string
	TLNE B,(7B2)		; Yes, make sure in range
	 FTPM(NO,22,<Illegal User-Account>,1)
	TLOA B,(5B2)		; Flag numeric account
PPUAC1:	 HRROI B,P.UACT+1(P1)	; Here if string account
	MOVEM B,P.UACT(P1)	; Store account designator
	MOVE A,D		; Restore source string ptr
	JRST SKPRET##		; Return +2


; (Version <decimal number>)

PPVERS:	ILDB C,A		; First, see if special version *, H, L, N
	SETO B,
	CAIN C,"*"
	 MOVEI B,-3		; All versions
	ANDCMI C,40
	CAIN C,"H"
	 MOVEI B,0		; Highest existing version
	CAIN C,"L"
	 MOVEI B,-2		; Lowest existing version
	CAIN C,"N"
	 MOVEI B,-1		; Next higher version
	JUMPGE B,[IBP A		; Jump if ok special version
		JRST PPVER1]
	ADD A,[7B5]		; Not special, back up pointer and try number
	MOVEI C,↑D10		; Decimal radix
	NIN			; Convert number
	 FTPM(NO,14,<Malformed Version>,1)
	CAML B,[-2]		; Check for reasonable value
	CAILE B,777774
	 FTPM(NO,14,<Illegal Version>,1)
PPVER1:	MOVEM B,P.VERS(P1)	; Ok, store it in property list
	JRST SKPRET##		; Return +2


; (Write-Date <date>)

PPWDAT:	PUSHJ P,GETDAT		; Input date and time
	 FTPM(NO,26,<Malformed Write-Date>,1)
	MOVEM B,P.WDAT(P1)	; Ok, store it in property list
	JRST SKPRET##

; Collect property value and do STDIR on it
;	A/ Source string ptr
; Returns +1:  Illegal format property value
;	+2:  STDIR failed
;	+3:  A/ Updated pointer, C/ flags,,dir# from STDIR
; Clobbers B, C
; Note: ignores ".registry" appearing at the end of the name, if any

GSTDIR:	HRROI B,TEMP		; Buffer property value here
	MOVEI C,USRSTL		; Max # characters
	PUSHJ P,GTPVAL		; Get property value string
	 POPJ P,		; Failed, return +1
	MOVE C,A		; Ok, save source string ptr
	MOVE A,[POINT 7,TEMP]	; Look for "."
GSTDI1:	ILDB B,A
	JUMPE B,GSTDI2
	CAIE B,"."
	 JRST GSTDI1
	SETZ B,			; Found one, smash with null
	DPB B,A
GSTDI2:	SETZ A,			; Exact match required
	HRROI B,TEMP##		; Where the name string is
	STDIR			; Look up directory
	 JRST SKPRET##		; Not found, return +2
	 JRST SKPRET##		; Ambiguous, return +2
	EXCH C,A		; Ok, result to C, string ptr to A
	JRST SK2RET##		; Return +2


; Get property value string (up to ")" )
;	A/ Source string ptr
;	B/ Destination string ptr
;	C/ Max # of characters permitted
; Returns +1:  Error, overflowed or no terminating ")"
;	+2:  Successful, A/ byte ptr to terminating ")",
;		B/ byte ptr to terminating null in destination.
; Terminates destination string with null.
; Converts lower case to upper if RAISEF is set
; Clobbers B-D

GTPVAL::TLC B,-1		; If lh is -1, convert to byte ptr
	TLCN B,-1
	 HRLI B,(POINT 7)
GTPVA1:	ILDB D,A		; Get char from source
	JUMPE D,CPOPJ##		; Fail if end of source string
	CAIN D,PQUOTE		; Character quote?
	 JRST [	ILDB D,A	; Yes, get next literally
		JUMPE D,CPOPJ##	; But don't allow null
		JRST GTPVA2]
	CAIN D,")"		; End of property value?
	 SETZ D,		; Yes, remember so
	CAIL D,"a"		; Lower case?
	CAILE D,"z"
	 JRST GTPVA2		; No
	TRNE F,RAISEF		; Yes, want to raise it?
	 SUBI D,40		; Yes, do so
GTPVA2:	SOJL C,CPOPJ##		; Fail if overflowing destination
	IDPB D,B		; Store byte in destination
	JUMPN D,GTPVA1		; Repeat if not end of property
	JRST SKPRET##		; Done, return +2

; Get date property
;	A/ Source string ptr
; Returns +1:  Error
;	+2:  Successful, A/ byte ptr to terminating ")",
;		B/ date/time word in internal format
; Clobbers B-D

GETDAT:	SETZ B,			; Arbitrary input format
	IDTNC			; Input date without conversion to internal
	 POPJ P,		; Illegal date format
	PUSH P,B		; Save results
	PUSH P,C
	LDB B,A			; More to come?
	CAIE B," "
	 JRST GETDA9		; No, just convert what IDTNC gave us

; Accept time zone of the form {A|E|C|M|P|Y|H}{S|D}T | GMT | {+|-}hh[:mm]
	HRLI D,(1B0+1B2)	; Use DST as specified by B1; use zone given
	ILDB B,A		; Char after space
	CAIE B,"+"
	CAIN B,"-"
	 JRST GETDA4		; Numeric time zone
	ANDI B,137		; Convert char to upper-case
	CAIN B,"G"
	 JRST GETDA7		; Probably GMT
	MOVSI C,-7		; Try all American time zones
	CAME B,[EXP "A","E","C","M","P","Y","H"](C)
	 AOBJN C,.-1
	JUMPGE C,GETDAE		; Jump if no match
	TLO D,4(C)		; Matched, set zone (Atlantic = 4)
	ILDB B,A		; Next char
	ANDI B,137
	CAIN B,"S"
	 JRST GETDA2		; Standard, no adjustment
	CAIE B,"D"
	 JRST GETDAE		; Failed
	TLO D,(1B1)		; Use daylight savings time
GETDA2:	ILDB B,A
	ANDI B,137
	CAIN B,"T"
	 JRST GETDA8		; Ended with "T", successful
GETDAE:	SUB P,[2,,2]		; Failed, return +1
	POPJ P,

; Here for numeric zone.
GETDA4:	ADD A,[7B5]		; Back up string ptr to include sign
	MOVEI C,↑D10
	NIN
	 JRST GETDAE
	ANDI B,77		; Sign-extended 6-bit zone
	TLO D,0(B)		; Insert zone in control word
	LDB B,A			; Check terminator
	CAIE B,":"
	 JRST GETDA8		; No more
GETDA5:	ILDB B,A		; More to come, skip over digits
	CAIL B,"0"
	CAILE B,"9"
	 JRST GETDA8
	JRST GETDA5

; Here for possible GMT
GETDA7:	ILDB B,A
	ANDI B,137
	CAIN B,"M"
	 JRST GETDA2		; Ok, now look for "T"
	JRST GETDAE

GETDA8:	IBP A			; Point to terminator
GETDA9:	POP P,C
	POP P,B
	IDCNV			; Convert to internal
	 POPJ P,		; Failed ??
	JRST SKPRET##		; Successful

; Get and lookup name keyword string
;	A/ Source string ptr
;	B/ -length ,, address of lookup table (see NAMSRC)
; Returns +1:  Error, improper format
;	+2:  Name not found
;	+3:  Successful, B/ pointer to matching entry
; Clobbers B-D;  updates A appropriately on +2 and +3 returns

FNDKEY::PUSH P,B		; Save table pointer
	HRROI B,TEMP##		; Where to buffer string
	PUSHJ P,GETNAM		; Input the name
	 JRST [	POP P,B		; Failed, return +1
		POPJ P,]
	EXCH A,0(P)		; Ok, save string, get table
	HRROI B,TEMP##		; Where the name is now
	PUSHJ P,NAMSRC		; Look it up
	 JRST [	POP P,A		; Not found, recover string ptr
		JRST SKPRET##]	; Return +2
	MOVE B,A		; Ok, copy entry pointer
	POP P,A			; Recover string ptr
	JRST SK2RET##		; Return +3


; Get name keyword string
;	A/ Source string ptr
;	B/ String ptr to temp region in which to store name
; Ignores leading blanks.  Converts lower to upper case.
; Terminates on any character besides alphanumeric and "-".
; Terminates temp string with null (for NAMSRC).
; Returns +1:  Error, first char not keyword constituent
;	+2:  Ok, A/ Byte ptr to terminator
; Clobbers B-D

GETNAM::TLC B,-1		; If lh is -1, convert to byte ptr
	TLCN B,-1
	 HRLI B,(POINT 7)
	SETZ D,			; Init counter
GETNA1:	ILDB C,A		; Get char from source
	CAIL C,"A"		; Alphabetic?
	CAILE C,"Z"
	 CAIN C,"-"		; Hyphen?
	  JRST GETNA2		; Yes, append to string
	CAIL C,"0"		; Numeric?
	CAILE C,"9"
	 CAIA
	  JRST GETNA2		; Yes, append to string
	CAIL C,"a"		; Lower case?
	CAILE C,"z"
	 JRST GETNA3		; No, terminator
	SUBI C,40		; Yes, capitalize
GETNA2:	IDPB C,B		; Store in temp buffer
	AOJA D,GETNA1		; Count and loop

; Here when hit terminator
GETNA3:	CAIN C," "		; Blank?
	 JUMPE D,GETNA1		; Yes, ignore if leading
	JUMPE D,CPOPJ##		; Fail if string empty
	SETZ C,			; Append null to temp string
	IDPB C,B
	JRST SKPRET##		; Return +2

; Lookup name in table
;	A/ -length ,, address of table to search
;	B/ String ptr to name string (all letters must be capitals)
; Returns +1: Not found, A points to smallest entry > key
;	+2: Found, A points to matching entry
; In both cases, A is still in AOBJN pointer format.  In the
;  +1 return, the lh is positive if A points past end of table.
; Table entry format:
;	[ASCIZ /NAME/] ,, value
; Clobbers A-D

NAMSRC::TLC B,-1		; If lh is -1, convert to byte ptr
	TLCN B,-1
	 HRLI B,(POINT 7)
	JSP C,BINSRC		; Call binary search


; Name comparison routine for binary search
;	A/ Address of table entry to compare in rh
;	B/ Search key (as passed to BINSRC)
; Returns +1: Key < Entry
;	+2: Key > Entry
;	+3: Key = Entry
; Additionally, if the key is an initial substring of the entry
; (+1 return only), returns D/ string ptr to tail (else 0)
; Clobbers C, D

NAMCMP::PUSH P,A		; Save args
	PUSH P,B
	HLRZ A,0(A)		; Make string ptr to table entry
	HRLI A,(POINT 7)
NAMCM1:	ILDB C,A		; Get char from table entry
	ILDB D,B		; Get char from search key
	CAIGE D,(C)		; Compare
	 JRST [	JUMPN D,NAMCM3	; Key < entry; if not end return +1
		MOVSI D,(7B5)	; If end of key make string ptr
		ADD D,A		;  to tail of entry
		JRST NAMCM4]	; Also return +1
	CAILE D,(C)
	 JRST NAMCM2		; Key > entry, return +2
	JUMPN D,NAMCM1		; Key char = entry, look at next
	AOS -2(P)		; End, key = entry, return +3
NAMCM2:	AOS -2(P)
NAMCM3:	SETZ D,			; Note not substring match
NAMCM4:	POP P,B			; Restore args
	POP P,A
	POPJ P,

; Perform binary search
;	A/ -length ,, address of table to search
;	B/ Search key
;	C/ Routine to call to compare key to entry
; Returns +1: Not found, A points to smallest entry > key
;	+2: Found, A points to matching entry
; In both cases, A is still in AOBJN pointer format.  In the
;  +1 return, the lh is positive if A points past end of table.
; Clobbers A-D

; The comparison routine must operate as follows:
;	A/ Address of table entry to compare in rh
;	B/ Search key (as passed to BINSRC)
; Returns +1: Key < Entry
;	+2: Key > Entry
;	+3: Key = Entry
; C and D may be clobbered freely, others must be protected

BINSRC::PUSHJ P,SAVE2##		; Need more temps
	MOVE P2,C		; Save routine to call
	HLRE C,A		; Get negative table length
	MOVN C,C		; Make positive
	JFFO C,.+2		; Find position of first 1
	 POPJ P,		; Empty table, fail
	MOVN D,D		; Compute largest power of 2
	MOVSI P1,(1B0)		;  <= table length
	LSH P1,(D)
	HRLI P1,(P1)		; Put in both halves
	SUB A,[1,,1]		; Backup ptr to one before table
BINSR1:	ADD A,P1		; Add increment to table pointer
BINSR2:	LSH P1,-1		; Halve increment (both halves)
	TRZ P1,400000
	JUMPGE A,BINSRL		; Jump if off end of table
	PUSHJ P,0(P2)		; Call routine to do compare
	 JRST BINSRL		; Key < entry
	 JRST BINSRG		; Key > entry
	JRST SKPRET##		; Key = entry, return +2

; Here if key > entry: advance table pointer
BINSRG:	JUMPN P1,BINSR1		; Loop if increment nonzero
	AOBJN A,CPOPJ##		; Set pointer and fail if zero

; Here if key < entry, or past end: backup table pointer
BINSRL:	JUMPE P1,CPOPJ##	; Fail if increment zero
	SUB A,P1		; Backup table pointer
	JRST BINSR2		; Try again


	END