
;;; INSERT FILE LSRTNS >			-*-MIDAS-*-

IFN 0,.LIBFIL			;Don't process this file in @ unless it's being listed.

;******* If you modify this, inform TAA @ dm, who maintains *******
;******* the corresponding routines for muddle.             *******

subttl LSRTNS Definitions

;Assumes ACs A,B,C,D,E in that order, and P.
;Clobbers no ACs except those documented in the front of the routine.
;Always skip-returns unless error.
;Is pure.  Assumes no external locations (not even CPOPJ).

	.AUXIL			;cref control

	;PRINT VERSION NUMBER
	.TYO6 .IFNM1
	.TYO 40
	.TYO6 .IFNM2
	PRINTX/ included in this assembly.
/

.BEGIN LSRTNS

;;; Conditional assembly switches
;   The default is to assemble almost everything

IFNDEF $$DEFS, $$DEFS==0	;Assemble no routines, only definitions!
IFNDEF $$ULNM, $$ULNM==1	;Assemble LSRLNM routine
IFNDEF $$ULNP, $$ULNP==1	;Assemble last-name-prefix matcher
IFNDEF $$UNAM, $$UNAM==1	;Assemble LSRNAM routine
IFNDEF $$OVLY, $$OVLY==1	;Do overlaying (don't map in whole LSR1 file at once).
IFNDEF $$HSNM, $$HSNM==0	;Assemble HSNAME routines.

 ;the rest of the routines you probably always want.


;;; SYMBOLS FOR FORMAT OF THE INQUIR;LSR1 > FILE. 

;;; The LSR1 database begins with pointers to various tables
;;; and the data area.  These areas are described (in order) below.

HDRLEN==8.	;Number of words in the following header area.

HDRSID==0	; wd 0	SIXBIT /LSR1!!/
HDRDAT==1	; wd 1	Date of compilation as sixbit YYMMDD
HDRTIM==2	; wd 2	Time of compilation as sixbit HHMMSS
HDRUNM==3	; wd 3	Address in file of UNAME table. 
HDRLNM==4	; wd 4	Address in file LASTNAME table. 
HDRDTA==5	; wd 5  Address in file of start of data area. 
		;	The data area must start on a page boundary,
		;	and it must be the last thing in the file. 
HDRHSN==6	; wd 6	Address in file of HSNAME table.
HDRVER==7	; wd 7  Format version of the LSR1 database.
		;       Before 3/15/83, this word was data!


COMMENT |


			   The UNAME table:
Word 0 contains the number of entries in this table.
Next come the entries, one per page of data area, each containing the
sixbit UNAME of the first data area entry which begins on that page.
The sign bit of each UNAME is complemented to speed up the search.

			 The LASTNAME table:
Word 0 contains the number of entries in this table.
Next come the entrie, in order by last name.
Each entry looks like:
	RH  addr in file of entry 
	LH  addr in file of Last-name string

The lastname strings are word-aligned upper-case ASCIZ strings, and
they follow the LASTNAME table. 

			  The HSNAME table:
Currently this table is simply snarfed from the file INQUIR;DIRS BIN
and the format is documented in the source of the "program" that
creates it, namely INQUIR;DMUNCH >.

			    The DATA Area
The data area starts on a page boundary.  It is made up of consecutive
entries, in order by ascii UNAME.  Each entry is a header word,
followed by some items strings.  The entire entry is then padded to a
word boundary with nulls.

The header word looks like:  LENGTH,,-1 where LENGTH is the number of
words the item strings use.  The next entry header can be found at (+
THIS-HEADER-ADDR LENGTH).  Note that entry header words are the *only*
words in the DATA area which have their low bits set.

An item string is unaligned ASCIZ, separated only by the single ^@
that ends the ASCIZ.  The strings are associated with their meanings
according to their numerical position in the entry.

The end of the data area is marked by   0,,-1.
This is tantamount to an entry 0 words long. That word is also the
last word of the file. 

|;TNEMOC


;;; Symbols for fields of an entry.  
;   I$ prefix is for the sake of bit-typeout mode

I$==0,,-1
I$UNAM==0	;UNAME
I$NAME==1	;FULL NAME
I$NICK==2	;NICKNAME
I$LOCL==3	;LOCAL ITEMS
I$MITA==4	;MIT ADDRESS
I$MITT==5	;MIT TELEPHONE NUMBER
I$HOMA==6	;HOME ADDRESS
I$HOMT==7	;HOME TELEPHONE NUMBER
I$SUPR==10	;SUPERVISOR(S)
I$PROJ==11	;PROJECT
I$DIR==12	;FILE DIR NAMES
I$AUTH==13	;AUTHORIZATION
I$GRP==14	;GROUP AFFILIATION
I$REL==15	;RELATION TO GROUP
I$BRTH==16	;BIRTHDAY
I$REM==17	;REMARKS
I$NETA==20	;NETWORK ADDRESS
I$ALTR==21	;USER &TIME OF LAST ALTERATION
I$MACH==22	;SUNAME@MACHINE PAIRS

NFILDS==19.	;How many fields there are.

;Provide names of all items, for INQUIR and INQUPD, etc.
DEFINE ITMIRP FORM
IRPS ITEM,,[SUNAM UNAME NAME NICK LOCAL MITAD MITTE HOMAD
	  HOMTE SUPER PROJE FILDI AUTHO GROUP RELAT BIRTH
	  REMAR NETAD ALTER MACHI]
 FORM
TERMIN TERMIN


;;; User programs generally do not need to read in an entire
;;; entry or know the entry lengths, but here they are.
;;; This code fragment is from INQUPD, the deamon which updates
;;; the database:
;;;
;;;
;;; %UNAME:	BLOCK 2		;UNAME
;;; %NAME:	BLOCK 20	;FULL NAME
;;; %NICK:	BLOCK 10	;NICKNAME
;;; %LOCAL:	BLOCK 10	;LOCAL INQUIRE ITEMS
;;; %MITAD:	BLOCK 40	;MIT ADDRESS
;;; %MITTE:	BLOCK 20	;MIT TELEPHONE NUMBER
;;; %HOMAD:	BLOCK 40	;HOME ADDRESS
;;; %HOMTE:	BLOCK 20	;HOME TELEPHONE NUMBER
;;; %SUPER:	BLOCK 40	;SUPERVISOR(S)
;;; %PROJE:	BLOCK 40	;PROJECT
;;; %FILDI:	BLOCK 20	;FILE DIR NAMES
;;; %AUTHO:	BLOCK 10	;AUTHORIZATION
;;; %GROUP:	BLOCK 1		;GROUP AFFILIATION
;;; %RELAT:	BLOCK 1		;RELATION TO GROUP
;;; %BIRTH:	BLOCK 10	;BIRTHDAY
;;; %REMAR:	BLOCK 200	;REMARKS
;;; %NETAD:	BLOCK 20	;NETWORK ADDRESS
;;; %ALTER:	BLOCK 10	;USER &TIME OF LAST ALTERATION
;;; %MACHI:	BLOCK 40	;SUNAME/MACHINES TO BE UPDATED


;;; Constant Parameters
LSRFID:	SIXBIT /LSR1!!/		; File identifier word (what HDRID should be)
LSRFN1:	SIXBIT /LSR1/		; File name for LSR data
LSRFN2:	SIXBIT />/
LSRDIR:	SIXBIT /INQUIR/		; Directory to find file on.


;;; Useful macros

DEFINE SYSCAL A,B
.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN

;;; Variables

.SCALAR LSRADR	;Core address where first part of file is mapped in
.SCALAR DATFPG	;Page number in file of first data page
.SCALAR SCMPRT	;String compare routine to use LSRLNM and LSRLNP

.SCALAR DATADR	;Core address of two pages for mapping in data pages of file
.SCALAR DATPAG	;DATADR/2000
.SCALAR PAGEIN	;Page number in file of page currently mapped in at DATPAG
		;The page after that maps the next sequential file page.
		;This is negative if no page is currently mapped in.

IFE $$DEFS,[


SUBTTL LSRMAP

;LSRMAP takes in A a channel number, and in B an AOBJN pointer to a
;range of free pages, and maps in the data base.  If successful, it
;returns in B an updated pointer indicating which pages were not
;needed, and leaves the file STILL OPEN on the given channel.  
;Pages which might be needed later for mapping in an entry are 
;remembered internally and marked off as "used".  No skip can 
;either be due to trouble opening or mapping the file, or due 
;to a clobbered file, or due to needing more pages than are offered. 

;In non-overlay mode, the entire LSR1 file is mapped in,
;and the channel is closed.

LSRMAP:	PUSH P,C
	PUSH P,D
	PUSH P,E
	SYSCAL OPEN,[5000,,.UII	; Open the file
		MOVEI (A) ? [SIXBIT/DSK/]
		LSRFN1 ? LSRFN2 ? LSRDIR]
	 JRST LSRMPL		;Fail
IFN $$OVLY,[
;If doing overlaying, map in just the tables at the front, and leave
;2 pages of space to hold 2 consecutive data pages at any time.
	SYSCAL CORBLK,[		;Map in the first page of the file
		MOVEI %CBNDR	;Read-only, must be present
		MOVEI %JSELF
		MOVEI (B)
		MOVEI (A) ]
	 JRST LSRMPL
	HRRZ C,B		;Get address of start of file
	LSH C,10.
	MOVE D,HDRSID(C)	;Verify that file is really LSR1.
	CAME D,LSRFID		;Compare with file identifier word.
	 JRST LSRMPL		;no good
	AOBJP B,LSRMPL		;Advance B over first page
	MOVE D,HDRDTA(C)	;Number of words always to be mapped
	TRNE D,1777		;Must be multiple of 1 page
	 JRST LSRMPL
	LSH D,-10.		;Get number of pages
	MOVEM D,DATFPG
	;D has the number of pages in the fixed front part of the file.
	;In addition, we need two more pages to window into the data
	;part of the file, but, also, B has already been advanced one
	;page, and we want to stop one page short so we can test
	;for not enough core.  These cancel out and D contains the right value.
	MOVEI E,-1(D)		;Save number of pages in fixed part yet to be mapped.
	HRLS D
	ADD D,B			;Compute final aobjn pointer less one
	AOBJP D,LSRMPL		;Not enough core supplied
	MOVNS E
	HRL B,E			;Aobjn pointer to always-mapped pages
	SYSCAL CORBLK,[MOVEI %CBNDR
		MOVEI %JSELF
		MOVE B
		MOVEI (A) ]
	 JRST LSRMPL
	;It's successfully mapped in, save pointers for later calls.
	MOVE B,D		;Return aobjn pointer to pages not used
	MOVE E,C
	ADD E,HDRDTA(C)		;Set up pointer to data pages
	MOVEM E,DATADR
	LSH E,-10.
	HRRZM E,DATPAG
	SETOM PAGEIN		;No page is mapped in yet
]
IFE $$OVLY,[
	SYSCAL FILLEN,[A ? MOVEM E]	; Get file length in wds
	 JRST LSRMPL
	ADDI E,1777
	LSH E,-10.		;get length in pages.
	MOVEI D,(E)
	MOVNS E
	HRLZS E
	HRR E,B			;Aobjn pointer to range of pages to fill with file.
	HRRZ C,B		;remember address in core of the first page.
	LSH C,10.
	HRLS D
	ADDM D,B		;advance the supplied pointer past them.
	JUMPGE B,LSRMPL		;jump if not enough core supplied
	SYSCAL CORBLK,[	MOVEI %CBNDR
		MOVEI %JSELF
		MOVE E
		MOVEI (A) ]
	 JRST LSRMPL
	MOVE D,HDRSID(C)	;Verify that file is really LSR1.
	CAME D,LSRFID		;Compare with file identifier word.
	 JRST LSRMPL		;no good
]
;C now has core address of the first word of the file.
	MOVEM C,LSRADR		;good;  save core addr of file, thus marking it "in".
	MOVE C,HDRDTA(C)
	LSH C,-10.
	MOVEM C,DATFPG		;Store # of file pages before start of data area.
IFN $$HSNM, PUSHJ P,LSRHIN	; Initialize HSNAME cruft.
	AOS -3(P)		;Take success return
LSRMPL:	POP P,E
	POP P,D
	POP P,C
	POPJ P,




SUBTTL LSRNXT

;Given in B the core address of an entry, returns in B the
;core address of the next sequential entry in the database.
;Wants the LSR1 file channel number in A, as in LSRGET.


;(DEFUN FILE-ADDR (B) ;An entry core address.
;  (+ (* 2000 (+ PAGEIN (- DATPAG B)))  (- B DATADR)))


LSRNXT:	PUSH P,A
	PUSH P,C
	PUSH P,D
	SKIPN C,LSRADR		;Header file address.
	 JSP B,LSRUNX		;Oops - user forgot to map in database.
	MOVE C,B
	LSH C,-10.		;Core page number.
	MOVE D,DATPAG
	SUB D,C
	ADD D,PAGEIN		;File page of entry.
	IMULI D,2000		;File address of entry's page.
	HLRZ C,(B)		;Length of entry.
	JUMPE C,LSRNX9		;Zero length entry terminates the database.
	SUB B,DATADR		;Offset of entry on the page.
	ADD D,B			;File address of entry.
	ADD D,C			;File address of next entry.
	MOVE B,D		;Return result here.
	PUSHJ P,LSRGET		;Map it and get its core address.
	 CAIA
	AOS -3(P)		;Skip if successful.
LSRNX9:	POP P,D
	POP P,C
	POP P,A
	POPJ P,




SUBTTL LSRUNM

;LSRUNM takes in A a channel number, on which the LSR1 file is
;assumed to be open, and in B a UNAME as a word of SIXBIT,
;and returns in B the address, in core, of the entry for that UNAME.
;Such entries are mapped in by LSRUNM and will not
;necessarily remain in core if another LSRUNM or LSRLNM is done.
;No skip implies there is no entry for that UNAME if B is zero
;or a system error if B is non-zero.

LSRUNM:	PUSH P,A
	TLC B,(SETZ)		;complement high bit in sixbit to get ascii order
	PUSH P,C
	PUSH P,D
	PUSH P,E
	SKIPN C,LSRADR		;Address file header
	 JSP B,LSRUNX		;you forgot to map it in
;Linear search the Uname table to find what page the desired entry starts on
;No reason to do a binary search since only 80 or a 100 entries.
	MOVEI D,1(C)
	ADD D,HDRUNM(C)		;-> Uname table first uname
	CAMGE B,(D)		;Check for fencepost bug in code below
	 JRST LSRUNL		;This indicates the entry does not exist
	MOVN E,-1(D)		;Set up aobjn pointer
	HRL D,E
LSRUN1:	CAML B,(D)		;Skip if this is too far down the file
	 AOBJN D,LSRUN1
	SUB D,HDRUNM(C)		;Compute the desired page number
	SUBI D,2(C)
	HRRZS D
	ADD D,DATFPG
	EXCH B,D		;Map it and the page after it in
	LSH B,10.
	HRRO A,-3(P)
	PUSHJ P,LSRGET
	 JSP B,LSRUNX		;Lost
	MOVE E,B		;core address of the page.
	MOVE B,D		;Restore uname being searched for
;Now linearly search for the start of an entry, and compare Unames.
;This code assumes the Uname is the first item in an entry.
	HRLI E,-2000		;The header is known to be on the first page
LSRUN3:	MOVEI D,1		;Search for a header (bit 1.1 turned on)
	TDNN D,(E)
	 AOBJN E,.-1
	JUMPGE E,LSRUNL		;Not found
	HLRZ D,(E)		;Get word count
	JUMPE D,LSRUNL		;0 => EOF => not found
	PUSH P,B		;Extract uname and convert to sixbit
	PUSH P,C
	PUSH P,E
	MOVEI D,0		;Accumulate sixbit in D
	HRLI E,010700		;using byte pointer in E to load
	MOVE B,[440600,,D]	;and byte pointer in B to store
LSRUN4:	ILDB C,E
	JUMPE C,LSRUN5
	CAIGE C,140
	 SUBI C,40
	TLNE B,770000
	 IDPB C,B
	JRST LSRUN4

LSRUN5:	POP P,E
	POP P,C
	POP P,B
	TLC D,(SETZ)
	CAMLE B,D
	 AOBJN E,LSRUN3		;not found yet, scan more
	CAME B,D
	 JRST LSRUNL		;got past where it should be => doesn't exist
	HRRZ B,E		;Found it.  Get address of header of entry
	AOSA -4(P)		;and take success return
LSRUNL:	 MOVEI B,0		;doesn't exist
LSRUNX:	POP P,E
	POP P,D
	POP P,C
	POP P,A
	POPJ P,

SUBTTL LSRLNM

;LSRLNM is like LSRUNM but expects in B the address of
;an all-caps last name, as an ASCIZ string, instead
;of a UNAME, and returns in B an aobjn pointer to the
;LASTNAME table words whose Lastname match the argument.
;Note that the argument must end with null all the way to
;the end of the word, not just a single null character.  This
;is so that it can compare strings a word at a time.

;LSRLNP is similar to LSRLNM but returns an aobjn pointer
;to all the lastname table entries for which the argument
;in B is a prefix of their last name.  It works by using
;a different STRCMP routine.

IFN $$ULNP,[
LSRLNP:	PUSH P,A
	MOVEI A,STRPRC
	JRST LSRLN0
];$$ULNP

IFN $$ULNM,[

LSRLNM:	PUSH P,A
	MOVEI A,STRCMP
];$$ULNM

IFN $$ULNM\$$ULNP,[
LSRLN0:	MOVEM A,SCMPRT
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,E
	SKIPN C,LSRADR
	 JRST LSRLNL		;you forgot to map in the file
	MOVEI E,1(C)
	ADD E,HDRLNM(C)		;-> Lastname table first entry
	MOVE D,E
	ADD E,-1(E)
;Binary Search.
;-3(P) initial byte pointer to lastname being searched for
;A  points to current entry in Lastname table
;B  byte pointer to argument name
;C  byte pointer to name in table
;D  points to first possible entry in Lastname table
;E  points after last possible entry in Lastname table
LSRLN1:	CAMG E,D		;Skip if any possibilities left
	 JRST LSRLNL		;no match, lose
	MOVE A,E		;Generate probe point in center
	SUB A,D
	LSH A,-1
	ADD A,D
	HLRZ C,(A)		;Get address in file of that lastname
	ADD C,LSRADR		;Relocate to core address
	MOVE B,-3(P)		;Get address of name being searched for
	PUSHJ P,@SCMPRT		;Compare the strings
	 JRST [ MOVEI D,1(A) ? JRST LSRLN1 ]	;B>C, move up
	 JRST [ MOVE E,A ? JRST LSRLN1 ]	;B<C, move down
	;Equal.  Now narrow [D,E) to range of equality (may be more than one.) ;] match []'s.
	;First back up to first
LSRLN4:	CAMG A,D
	 JRST LSRLN5		;Don't back up past D
	HLRZ C,-1(A)		;Get address in file of previous lastname
	ADD C,LSRADR		;Relocate to core address
	MOVE B,-3(P)		;Get address of name being searched for
	PUSHJ P,@SCMPRT
	 JRST LSRLN5		;B>C
	 JRST LSRLN5		;B<C (shouldn't happen)
	SOJA A,LSRLN4		;B=C, back up more

	;Now run forward to last
LSRLN5:	MOVNI D,1		;Keep negative count of entries in RH
	HRL D,A			;Keep address of first entry in LH
LSRLN6:	CAIL A,-1(E)
	 JRST LSRLN7		;Don't run forward past E
	HLRZ C,1(A)		;Get address in file of next lastname
	ADD C,LSRADR		;Relocate to core address
	MOVE B,-3(P)		;Get address of name being searched for
	PUSHJ P,@SCMPRT
	 JRST LSRLN7		;B>C (shouldn't happen)
	 JRST LSRLN7		;B<C 
	SUBI D,1		;B=C, forward more
	AOJA A,LSRLN6

LSRLN7:	MOVS B,D		;Return aobjn pointer
	AOS -5(P)		;Take success return
LSRLNL:	POP P,E
	POP P,D
	POP P,C
	POP P,A			;was saved B, but we're returning something
	POP P,A
	POPJ P,
];$$ULNM+$$ULNMP

IFN $$ULNM,[
;Asciz string compare.  B and C are byte pointers to the two upper-case strings.
;Clobbers only B and C
;Skip twice if equal, once if B<C, no skip if B>C
;Does assume that both strings are nulled out to word boundaries.
STRCMP:	PUSH P,D
	PUSH P,E
STRCM1:	MOVE D,(B)
	LSH D,-1
	MOVE E,(C)
	LSH E,-1
	CAMLE D,E
	 JRST STRCM3		;B>C
	CAME D,E
	 JRST STRCM2		;B<C
	TRNN E,177
	 JRST STRCM4		;Compared all, they are equal
	ADDI B,1
	AOJA C,STRCM1		;Equal so far, compare more

STRCM4:	AOS -2(P)		;Reached end, B=C
STRCM2: AOS -2(P)
STRCM3:	POP P,E
	POP P,D
	POPJ P,
];$$ULNM

IFN $$ULNP,[
;Asciz string compare.  B and C are byte pointers to the two upper-case strings.
;Clobbers only B and C.
;Skip twice if equal, once if B<C, no skip if B>C
;Here they are considered equal if B is a valid prefix of C.
STRPRC:	HRLI B,440700
	HRLI C,440700
	PUSH P,D
	PUSH P,E
STRPR1:	ILDB D,B
	JUMPE D,STRPR4		;Equal
	ILDB E,C
	JUMPE E,STRPR3		;B>C
	CAMN D,E
	 JRST STRPR1		;equal so far, test more
	CAMG D,E
STRPR2:	 AOS -2(P)		;B<C
STRPR3:	POP P,E
	POP P,D
	POPJ P,

STRPR4:	AOS -2(P)		;B=C
	JRST STRPR2
];$$ULNP

SUBTTL LSRGET

;LSRGET takes in A a channel number and in B the file address of an entry.
;It maps in the appropriate pages (unless the whole file is in core)
;and returns in B the core address.  Fails to skip if the map fails or
;if the given address does not point at the header of an entry, or at eof.
;Use this after calling LSRLNM.
;Also used internally, in which case the sign bit of A is set
;to indicate that it shouldn't check whether B points to a valid entry.

LSRGET:	PUSH P,D
	PUSH P,E
;If not all of the file is in core, we must map in the needed page.
IFN $$OVLY,[
	LDB D,[121000,,B]
	CAMN D,PAGEIN		;Is it in already?
	 JRST LSRGT1		;Yes, don't bother mapping again
	HRROM D,PAGEIN		;Save page, but leave negative in case CORBLK fails
	MOVE E,DATPAG		;Map in that and the following page
	HRLI E,-2
	SYSCAL CORBLK,[MOVEI %CBRED	;2nd page may not exist, so don't require access
		MOVEI %JSELF
		MOVE E
		MOVEI (A)
		D ]
	 JRST LSRGTL		;Any failure is an error
	;At this point, the 2 map pages each either point to the appropriate
	;file page or are non-existent memory, in the case where the file is
	;not that long.  In any case, the system will have counted out
	;the AOBJN pointer in E.  If only one page was valid, hopefully we
	;will not try to reference off the end of the file and so will not
	;reference that page.  If neither page was valid, we have a bug and
	;will find out about it by getting an MPV in about five instructions.
	HRRZS PAGEIN		;OK page is really in now
LSRGT1:	ANDI B,1777		;Make core address
	ADD B,DATADR
] ;end IFN $$OVLY

;If whole file is in core, just convert file address to core address.
IFE $$OVLY, ADD B,LSRADR
	JUMPL A,LSRGT2		;Sign(A) => don't check address for validity.
	HRRO D,(B)		;Else verify that B points at a valid item header
	AOJN D,LSRGTL		;Barf if no -1 in RH
	HLRE D,(B)
	JUMPL D,LSRGTL		;Barf if LH negative - 0 (EOF) is ok.
IFN $$OVLY,[
	ADD D,B
	SUB D,DATADR
	CAIG D,4000		;Barf if entry not entirely in core
]
LSRGT2:	 AOS -2(P)		;Success return
LSRGTL:	POP P,E
	POP P,D
	POPJ P,

SUBTTL LSRITM

;LSRITM takes in A an item number and in B the address in core
;of a LSR entry, and returns in A a b.p. to the specified item.
;No skip => this entry lacks that item, meaning either that there
;are not <item number> items in this entry or that the item is the
;null string.

LSRITM:	PUSH P,C
	PUSH P,D
	PUSH P,E
	HRRO C,(B)		;Verify that B points at a valid item header
	AOJN C,LSRITL		;Barf if no -1 in RH
	HLRE C,(B)
	JUMPLE C,LSRITL		;Barf if LH 0 or negative
	MOVE E,A		;Save item number (i.e. number of items to skip)
	MOVE A,B		;Set up byte pointer
	HRLI A,010700
	JUMPE E,LSRIT9		;Got the desired item
LSRIT1:	ILDB C,A		;Skip over this item
	JUMPN C,LSRIT1
	MOVEI C,1		;Check for end of entry
	MOVE D,A
	IBP D
	TDNE C,(D)
	 JRST LSRITL		;End of entry, item not found
	SOJG E,LSRIT1		;Search more unless next item is it
LSRIT9:	MOVE C,A		;Next item A-> is it
	ILDB C,C
	JUMPE C,LSRITL		;Null string, non-skip return
	AOS -3(P)
LSRITL:	POP P,E
	POP P,D
	POP P,C
	POPJ P,

SUBTTL LSRNAM

;LSRNAM takes in A a b.p. to a Name item, and in B a b.p. to
;storage, and IDPBs down B the name, canonically permuted into
;Firstname Lastname Suffix order.

;If the input name contains no comma, leave it alone.
;If it contains one comma, it is Lastname comma spaces Firstname
; which we change into Firstname space Lastname
;If it contains more than one comma,
; it is Lastname comma spaces Firstname comma additionalcruft
; which we change into Firstname space Lastname comma additionalcruft
;The Middle name is treated as part of the first name.

IFN $$UNAM,[

LSRNAM:	PUSH P,A
	PUSH P,C
	PUSH P,D
LSRNM1:	ILDB C,A		;First, look for a comma
	JUMPE C,LSRNM8		;No comma, go copy it straight across
	CAIE C,",
	 JRST LSRNM1
LSRNM2:	ILDB C,A		;Found comma, skip spaces after it if any
	CAIN C,40
	 JRST LSRNM2
LSRNM3:	IDPB C,B		;Copy first name
	ILDB C,A
	CAIE C,",
	 JUMPN C,LSRNM3
	MOVEI D,40		;Put a space after the first name
	IDPB D,B
	JUMPE C,LSRNM8		;If no additionalcruft, go copy last name
	MOVE D,A		;Save pointer to addtionalcruft
	SKIPA A,-2(P)		;Get back pointer to last name
LSRNM4:	 IDPB C,B
	ILDB C,A		;Copy it over
	CAIE C,",
	 JRST LSRNM4
	MOVE A,D		;Then copy over the additionalcruft
	JRST LSRNM9		;preceded by the comma that is in C

LSRNM8:	SKIPA A,-2(P)		;Copy the last name (or sometimes other things)
LSRNM9:	 IDPB C,B
	ILDB C,A
	CAIE C,",		;Stop on comma or null
	 JUMPN C,LSRNM9
	MOVEI C,0		;Terminate Asciz string with a null
	IDPB C,B
	AOS -3(P)		;Success return
	POP P,D
	POP P,C
	POP P,A
	POPJ P,
];$$UNAM

SUBTTL HSNAME Routines

IFN $$HSNM,[

.SCALAR HSNADR	; Address in core of HSNAME table base.
.SCALAR HSNPTR	; AOBJN ptr to HSNAME table entries.
.SCALAR HSNLN1	; Length-1 of an entry in HSNAME table.
.SCALAR LMCHNM	; Local machine name, as returned by SSTATU.

	; HSNAME table indices (later maybe .INSRT these)
HX$MCH==0	; Machine name, as returned by SSTATU call.
HX$HST==1	; ARPAnet host #.
HX$NRM==2	; Pointer to "normal" subtable
HX$TUR==3	; Pointer to "tourist" subtable
HX$AIL==4	; On MC and ML, AI people have a set of dirs.

	; Sub-table indices
HS$UNM==0	; UNAME, with sign bit complemented.
HS$HSN==1	; HSNAME for this entry's range.  Range of an entry
		; extends from its UNAME (incl) to next entry's UNAME (excl).

; LSRHIN - HSNAME initialization at LSRMAP time.
;	Internal rtn, clobbers C,D.

LSRHIN:	SYSCAL SSTATU,[
		REPEAT 5,MOVEM C
		MOVEM LMCHNM]	; Set local machine name.
	 POPJ P,
	SETZM HSNPTR
	SKIPN D,LSRADR
	 POPJ P,
	ADD D,HDRHSN(D)		; Get abs addr of HSNAME table in core.
	MOVEM D,HSNADR		; Save
	SKIPL C,(D)		; Get -<# entries>,,<# wds/entry>
	 POPJ P,
	SUBI C,1		; Get entry length-1
	HRRZM C,HSNLN1		; Save.
	HRRI C,1(D)		; Now make AOBJN to table entries
	MOVEM C,HSNPTR		; And save, all done.
	POPJ P,


; LSRTUR - Test entry for touristness.
;	B/ <LSR entry addr>
; Skips if tourist ("Group" field T or non-existent)

LSRTUR:	PUSH P,A
	MOVEI A,I$GRP
	PUSHJ P,LSRITM	; Find item
	 TDZA A,A	; If none, use zero char.
	  ILDB A,A	; Get char of field
	JUMPE A,LSRTRW	; Null implies tourist
	CAIE A,"S	; Students are tourists.
	 CAIN A,"T	; Tourists are tourists.
LSRTRW:	  AOS -1(P)	;skip on return.
	POP P,A
	POPJ P,


;;; LSRHTB - Find luser's HSNAME table index.
;;;  Check's the luser's entry and determines which HSNAME table is
;;;  appropriate to use.    (Looks at the group field.)
;;;
;;; B/ <LSR entry addr>
;;; C/ <site>
;;; Returns the HSNAME table number in B.

LSRHTB:	PUSH P,A
	PUSH P,C
	SKIPN C			; If no site specified
	MOVE C,LMCHNM		;  use the local machine.
	JUMPE B,LSRHB1		; No INQUIR entry means tourist.
	MOVEI A,I$GRP		; Want luser's group info.
	PUSHJ P,LSRITM		; Look up the item.
	 TDZA A,A		; If none, use zero char.
	  ILDB A,A		; Get char of field
	MOVEI B,HX$NRM		; Assume normal table to start.
	SKIPN A			; People with null groups
LSRHB1:	 MOVEI B,HX$TUR		;  are tourists.
	CAIE A,"T		; Tourists always use the tourist dirs.
	 CAIN A,"S		; Students always use the tourist dirs.
	  MOVEI B,HX$TUR
	CAME C,[SIXBIT /ML/]	; Mathlab has special provisions.
	 CAIN C,306
	  JRST LSRHMC
	CAMN C,[SIXBIT /MC/]	; Macsyma Consortium has special provisions.
	 JRST LSRHMC
	CAIE C,354
	 JRST LSRHB9
LSRHMC:	CAIN A,"A		; On MC and ML, AI people get special dirs.
	 MOVEI B,HX$AIL		; Isn't that a nice kludge!
LSRHB9:	POP P,C
	POP P,A
	POPJ P,



;;; LSRHLK - HSNAME table lookup
;;; LSRHTL - Same lookup, but arg B/ HSNAME table index #.
;;;	A/ UNAME
;;;	B/ <LSR entry addr> or 0 if none.
;;;	C/ <site>  sixbit name ala SSTATU, 0 for local, else ARPAnet host #.
;;;
;;; Skip returns with HSNAME in B.
;;; If failure (bad args or no table) does not skip.

LSRHLK:	PUSHJ P,LSRHTB	; Get table to use in B.
LSRHTL:	SETOM HRETRY	; Standard entry point will re-try on failure,
	CAIN B,HX$NRM	; unless already asking for "normal" table.
LSRHTX:	 SETZM HRETRY	; This entry point never retries.
	CAIL B,		; Make sure that table index is OK.
	 CAMLE B,HSNLN1
	  POPJ P,	; Ugh.
	PUSH P,C
	PUSH P,D
	SKIPL D,HSNPTR	; Get aobjn to HSNAME table
	 JRST LSRHT9	; Not mapped in or no table.
	CAIN C,0
	 MOVE C,LMCHNM	; If site 0, use local mach.
LSRHT2:	CAME C,HX$MCH(D)	; Compare spec'd site with entry's sitename
	 CAMN C,HX$HST(D)	; and host #.
	  JRST LSRHT3		; Win for either.
	ADD D,HSNLN1	; Add entry length-1
	AOBJN D,LSRHT2
	JRST LSRHT9	; Didn't find site.

LSRHT3:	ADDI D,(B)	; Add in index to point at right table.
	SKIPN D,(D)	; Pluck out rel addr of table to use.
	 JRST LSRHT9
	ADD D,HSNADR	; Make abs.
	SKIPL C,(D)	; Get -<# entries>,,<# wds/entry>
	 JRST LSRHT9
	HLL D,C
	ADDI D,1	; Now have aobjn pointing at 1st entry in table.
	TLC A,(SETZ)	; For proper ordering must flip sign.
LSRHT5:	CAMGE A,HS$UNM(D)	; Compare unames,
	 JRST LSRHT6		; and jump out when entry greater (over-run)
	ADDI D,-1(C)
	AOBJN D,LSRHT5

LSRHT6:	TLC A,(SETZ)		; Restore UNAME...
	SUBI D,(C)		; Hit entry+1, point back at previous.
	MOVE B,HS$HSN(D)	; and that's the HSNAME to use.

	AOS -2(P)
	SETZM HRETRY	; Won, so no retry of course.
LSRHT9:	POP P,D
	POP P,C
	SKIPN HRETRY	; See if should re-try...
	 POPJ P,	; Nope, just return.
	MOVEI B,HX$NRM	; Yes, re-try for "normal".
	JRST LSRHTX

.SCALAR HRETRY	; Switch for re-trying with HX$NRM if HX$TUR (or other) fails.

] ;IFN $$HSNM

IFN $$HSNM,[

; LSRHSN - Find HSNAME for entry, given:
;	A/ UNAME of entry
;	B/ <LSR entry addr> or 0 if none.
;	C/ <site> - as per SSTATU call, or host #, or 0 for local site.
;	D/ <channel #> to use for disk opens (if -1, don't use any.)
; Skips if successful, with
;	D/ HSNAME
; Uses the following algorithm:
;	If no entry address given,
;		If directory for that UNAME exists, return that as HSNAME
;		Else assume tourist and use tables.
;	Else if "Fildir" entry exists, and a valid dir is specified for
;		local site, return that.
;	Else if directory for that UNAME exists, return that as HSNAME
;	Else determine HSNAME using tables, plus touristness.

.SCALAR LSRCHN	; Holds # of temp channel to use.
.SCALAR MNAME	; "Canonical" machname of site specified.
.SCALAR MNAME1	; "MIT-**" version of machname.

LSRHSN:	MOVEM D,LSRCHN
	PUSHJ P,MCHFIX	; Canonicalize site arg & set MNAME, MNAME1.
	PUSH P,A
	PUSH P,B
	PUSH P,C
	jumpe b,lsrhn1	; If no entry given, maybe use UNAME, else tables

	MOVE D,A		; Save UNAME in D.
	PUSHJ P,LSRDRX		; Find & parse FILDIR field.
	 SKIPA A,D		; Didn't find anything, restore uname.
	  JRST LSRHN8		; Aha, found it.
	
lsrhn1:	skipge lsrchn
	  jrst lsrhn5			; if channel -1, skip it.
	SYSCAL OPEN,[LSRCHN ? MNAME	; See if UNAME has a directory.
		[SIXBIT /.FILE./] ? [SIXBIT /(DIR)/] ? A
		%CLERR,,D]
	 JRST LSRHN2		; Failed.
	SYSCAL CLOSE,[LSRCHN]
	 JFCL
	JRST LSRHN8		; Won, return UNAME as HSNAME.

LSRHN2:	CAIE D,%ENSDR	; If error not "no such directory",
	 JRST LSRHN9	; then fail.

LSRHN5:	PUSHJ P,LSRHLK		; Look up in tables.
	 JRST LSRHN9
	SKIPA D,B		; Return HSNAME in D.
LSRHN8:	 MOVE D,A
	AOS -3(P)
LSRHN9:	POP P,C
	POP P,B
	POP P,A
	POPJ P,

; LSRDRX - (internal) Read File-Directory field & scan for dir names.
;	B/ <LSR entry addr>
;	MNAME/ <site>  (must be canonical 6bit)
; Skip returns with A/ <6bit dir name> if finds a spec for given site.

lsrdrx:	push p,b
	push p,c
	push p,d	
	movei a,lsrtns"i$dir
	pushj p,lsrtns"lsritm	; find the FILDIR item in it.
	 jrst rdirx9		; none, lose.

	move d,a
	movei c,100	;tell 1st 6READ we are not at end of command string.
rdirx2:	pushj p,6read	;read a sixbit word into A;  terminating char in C.
	 jrst rdirx9	; end of item, lose.
	caie c,"@	; does this item apply only on one machine?
	  cain c,"%
	    caia
	      jrst rdirx5	;No, so try it out
	push p,a
	pushj p,6read	; read which machine.
	 jrst rdirx9	; ran out, lose.
	move b,a
	pop p,a
	came b,mname	;if we aren't on that machine, look at next entry.
	 camn b,mname1	;  check both forms for the name
rdirx5:	  cain a,0	;   ignore null names
	   jrst rdirx2
	skipge lsrchn
	 jrst rdirx8
	syscal open,[lsrchn ? mname	; on whatever machine we're hacking
		[sixbit /.FILE./] ? [sixbit /(DIR)/] ? A
		%clerr,,b]		;and get the error code
	 jrst [	caie b,%ensdr		; no such directory?
		 jrst rdirx8		; No, can't check, so return it.
		jrst rdirx2]		; Doesn't exist, try another.
	SYSCAL CLOSE,[LSRCHN]		; Won, close & drop thru.
	 JFCL

rdirx8:	aos -3(p)	; won, A has HSNAME.
rdirx9:	pop p,d
	pop p,c
	pop p,b
	popj p,


; Read into A a sixbit word, from the ascii b.p. in D.
; The terminating character is left in C.
; No skip => end of command string and word is null.
6read:	caige c,40
cpopj:	 popj p,
	setz a,
	move b,[440600,,a]
6readl:	ildb c,d
	cain c,40
	 jrst 6readl		; spaces are ignored.
	cain c,"%		; % is a terminator
	  jrst mpopj1
	caie c,"@		; @, comma are terminators
	 cain c,",
	  jrst mpopj1
	cain c,^Q		; let ^Q quote a character.
	 ildb c,d
	caige c,40
	 jrst mpopj1		; control chars terminate even if ^Q'd
	cail c,140
	 subi c,40
	subi c,40
	tlne b,770000
	 idpb c,b
	jrst 6readl

mpopj1:	skipe a			;unless this is a null entry
popj1:	aos (p)
	popj p,

; MCHFIX - canonicalize site argument into MNAME and MNAME1.
;	C/ <site> - sixbit or site # or 0 for local.

mchfix:	cain c,		; if 0,
	 move c,lmchnm	; use local name.
	push p,d
	skipl d,hsnptr
	 jrst mchfx9
mchfx2:	camn c,hx$hst(d)	; see if a host #.
	 jrst [	move c,hx$mch(d)	; If so, cvt to name.
		jrst mchfx3]
	add d,hsnln1
	aobjn d,mchfx2
mchfx3:	movem c,mname
	ldb d,[301400,,c]	; right-justify in D
	ior d,[sixbit /MIT-/]
	tdne c,[77,,777777]	; was orig name 2 chars long?
	 move d,c		; no, so don't hack mname1.
	movem d,mname1
mchfx9:	pop p,d
	popj p,

] ;IFN $$HSNM

] ;IFE $$DEFS

.END LSRTNS

;;; Local Modes:
;;; Mode:MIDAS
;;; Comment Column:32
;;; compile command: :midas 1 M
;;; End:
