;;; -*- Mode: MIDAS -*-ī
ī
TITLE	LSRRTN - LSR1 database interface.ī
	;Originally by RLB, extended by CSTACY.ī
ī
SUBTTL	Basic definitionsī
ī
.FASLī
.INSRT sys:.fasl defsī
.SXEVAL (SSTATUS FEATURE LSRRTN) ī
ī
;;; Get the system LSR1 database routines.ī
ī
lsrtns"$$ovly==1		;Map only a few pages and hack overlaying.ī
lsrtns"$$hsnm==1		;HSNAME lookup.ī
lsrtns"$$ulnm==0		;No last name searching.ī
lsrtns"$$ulnp==0		;No abbrev l.name lookups.ī
lsrtns"$$unam==0		;No name permutations.ī
ī
lsrtns"a==t			;LSRTNS requires some ACs.ī
lsrtns"b==ttī
lsrtns"c==dī
lsrtns"d==rī
lsrtns"e==f ī
.INSRT dsk:syseng;lsrtnsī
ī
;;; Random utility routines and macros.ī
ī
;;; Given a Byte pointer in D, return a list of chars in B.ī
ī
chlp0:	setz b,			;start with ()ī
chlp:	ildb tt,d		;get a charī
	jumpe tt,chlpx		;zero terminatesī
	jsp t,fxcons		;turn into fixnumī
	call 2,.function CONS	;cons onto listī
	move b,aī
	jrst chlp		;go for another charī
chlpx:	popj p,			;all done.ī
ī
ī
;;; Item numbers.ī
ī
.SXEVA (SETQ I$UNAM #0 )	;UNAMEī
.SXEVA (SETQ I$NAME #1 )	;FULL NAMEī
.SXEVA (SETQ I$NICK #2 )	;NICKNAMEī
.SXEVA (SETQ I$LOCL #3 )	;LOCAL ITEMSī
.SXEVA (SETQ I$MITA #4 )	;MIT ADDRESSī
.SXEVA (SETQ I$MITT #5 )	;MIT TELEPHONE NUMBERī
.SXEVA (SETQ I$HOMA #6 )	;HOME ADDRESSī
.SXEVA (SETQ I$HOMT #7 )	;HOME TELEPHONE NUMBERī
.SXEVA (SETQ I$SUPR #10 )	;SUPERVISOR(S)ī
.SXEVA (SETQ I$PROJ #11 )	;PROJECTī
.SXEVA (SETQ I$DIR  #12 )	;FILE DIR NAMESī
.SXEVA (SETQ I$AUTH #13 )	;AUTHORIZATIONī
.SXEVA (SETQ I$GRP  #14 )	;GROUP AFFILIATIONī
.SXEVA (SETQ I$REL  #15 )	;RELATION TO GROUPī
.SXEVA (SETQ I$BRTH #16 )	;BIRTHDAYī
.SXEVA (SETQ I$REM  #17 )	;REMARKSī
.SXEVA (SETQ I$NETA #20 )	;NETWORK ADDRESSī
.SXEVA (SETQ I$ALTR #21 )	;USER AND TIME OF LAST ALTERATIONī
.SXEVA (SETQ I$MACH #22 )	;SUNAME@MACHINE PAIRSī
ī
ī
SUBTTL	Mapping the database.ī
ī
;;; (LSRMAP <number of pages to use>)ī
;;; opens up and maps in the inquir database for looking up people.ī
;;; Returns a file object to be passed to other routines.ī
;;; Uses GETCOR to reserve address space.  Don't try this too many timesī
;;; since the addr space isn't reused.ī
ī
.ENTRY LSRMAP SUBR 1+1ī
	jsp t,fxnv1			;get & save # pages to use, a->ttī
	push fxp,ttī
;; (OPEN '|INQUIR;LSR1 >| '(IN))ī
	movei a,.atom INQUIR/;LSR1/ >ī
	movei b,.sx (IN)ī
	call 2,.function OPENī
	push p,aī
;; extract I/O channel number from the file array, into TTī
	movei tt,f.chanī
	move tt,@ttsar(a)ī
	push fxp,ttī
;; get pages via getcorī
	move tt,-1(fxp)		;# pagesī
	pushj p,getcor		;request addr space from Lispī
	jumpe tt,corlos		;its addr is returned zero if none avblī
	idivi tt,2000		;cvt to page numberī
	movn d,-1(fxp)		;get number of pages requested to constructī
	hrl tt,d		;aobjn to themī
;; construct args for lsrmapī
	move lsrtns"b,tt	;aobjn to free page rangeī
	move lsrtns"a,(fxp)	;disk channel numberī
;; Get the INQUIR data base mapped inī
	pushj p,lsrtns"lsrmap	;try to map in the data baseī
	 jrst lsrluz		;no skip if it lostī
;; I guess we won, clean up and return the file object.ī
opnbye:	sub fxp,[2,,2]ī
	pop p,aī
	popj p,ī
ī
;;; Return () instead of file obj.ī
corlos:ī
lsrluz:	move a,(p)		;get the file objī
	call 1,.function CLOSE	;close itī
	setzm (p)		;return ()ī
	jrst opnbyeī
ī
ī
SUBTTL	Stepping through the database.ī
ī
;;; The screw with stepping through the database is thatī
;;; LSRDTA and LSRNXT return a core address, not a file address.ī
;;;ī
;;; For example, you can not search by stepping through the database andī
;;; storing the addresses of the found entries, because succesive LSRNXTsī
;;; will not necessarily leave the entries mapped.  Instead, you mustī
;;; process each entry as you find it, and then call LSRNXT.ī
ī
ī
;;; (LSRDTA <file-object>ī
;;;ī
;;; Returns the core address of the first data entry.ī
;;; This can be used to get an initial pointer for LSRNXT.ī
;;; Returns -1 if the LSR1 database does not appear to be mapped.ī
ī
.ENTRY LSRDTA SUBR 1+1ī
	push p,[fix1]		;Ncallable: (declare (fixnum (lsrnxt ...)))ī
				; so return machine number in TT.ī
	movei tt,f.chan		;Pick up disk channel number.ī
	move lsrtns"a,@ttsar(a)ī
	move lsrtns"b,lsrtns"datfpgī
	imuli lsrtns"b,2000     ;File data page => addr first entryī
	pushj p,lsrtns"lsrget	;Map it and get core addr.ī
	 movni lsrtns"b,1	; Say -1 for lossage.ī
	move tt,lsrtns"b	;Return value.ī
	popj p,ī
ī
;;; (LSRNXT <file-obj> <core address>)ī
;;;ī
;;; Given the core address of an entry, returns the core address of theī
;;; next sequential entry in the LSR1 database.  Returns -1 iff thereī
;;; are no more entries.ī
ī
.ENTRY LSRNXT SUBR 2+1ī
	push p,[fix1]		;Ncallable: (declare (fixnum (lsrnxt ...)))ī
				; so return machine number in TT.ī
	movei tt,f.chan		;Pick up disk channel number.ī
	move lsrtns"a,@ttsar(a)ī
	move lsrtns"b,(b)ī
	pushj p,lsrtns"lsrnxt	;Get entry into lsrtns"b.ī
	 movni lsrtns"b,1	; Say -1 for lossage.ī
	move tt,lsrtns"b	;Return value.ī
	popj p,ī
ī
ī
SUBTTL	Looking up a user.ī
ī
;;; (LSRUNM <file obj returned by LSRMAP> <uname>)ī
;;; Returns a magic number to be passed to LSRITM, etc., or -1 if uname unknown.ī
;;; Actually, the "magic number" is the entry's core address returnedī
;;; by the lib subr.ī
ī
.ENTRY LSRUNM SUBR 2+1ī
	push p,cfix1		;NCALLable!ī
	movei tt,f.chan		;pick up disk channel numberī
	move tt,@ttsar(a)ī
	push fxp,tt		;and save itī
	move a,b		;(car (pnget <uname> 6))ī
	movei b,.atom #6.ī
	call 2,.function PNGETī
	hlrz a,(a)ī
	move lsrtns"b,(a)	;set up uname in 6bit for lsrunmī
	pop fxp,lsrtns"a	;the channelī
	pushj p,lsrtns"lsrunm	;get entry addr in lsrtns"bī
	  movni lsrtns"b,1	;-1 for lossī
	move tt,lsrtns"b	;move to where Lisp wants it.ī
	popj p,ī
ī
ī
SUBTTL	Fetching an item.ī
ī
;;; (LSRITM <item number> <magic number>)ī
;;; returns the <item number> slot of the entry <magic number>ī
;;; returned by LSRUNM.ī
;;; This file sets the symbols I$UNAM etc to the correct values.ī
;;; Look after this function, and in :INFO LIB LSRTNS .ī
ī
.ENTRY LSRITM SUBR 2+1ī
	jsp t,fxnv1		;item number, a->ttī
	jsp t,fxnv2		;address, b->dī
	push fxp,d		;save so we don't have to worry about ac corresī
	movem tt,lsrtns"aī
	pop fxp,lsrtns"bī
	pushj p,lsrtns"lsritm	;returns bp in lsrtns"aī
	 skipa d,[440700,,[0]]	;unless there was no skip: use null string thenī
	  move d,lsrtns"a	;d is input bpī
	pushj p,chlp0ī
	move a,b		;reverse the list and atomifyī
	call 1,.function NREVERSEī
	jcall 1,.function IMPLODE	;Return the symbol!ī
ī
ī
SUBTTL	HSNAME hackery.ī
;;; Most often you want (STATUS HSNAME user) and not LSRHTL.ī
ī
;;; (LSRHTL <file object> <uname>)ī
;;; Returns a symbol which is the hsname of the argument uname.ī
;;; Returns NIL if unknown.ī
ī
.ENTRY LSRHTL SUBR 2+1ī
	push p,cfix1		;NCALLable!ī
	movei tt,f.chan		;pick up disk channel numberī
	move tt,@ttsar(a)ī
	push fxp,tt		;and save itī
	move a,b		;(car (pnget <uname> 6))ī
	movei b,.atom #6.ī
	call 2,.function PNGETī
	hlrz a,(a)ī
	move lsrtns"a,(a)	;set up uname in 6bit for lsrunmī
	pop fxp,lsrtns"b	;the channelī
	movei c,lsrtns"hx$nrm	;use the normal table.ī
	setz lsrtns"c,		;use the local site.ī
	pushj p,lsrtns"lsrhtl	;get entry addr in lsrtns"bī
	 jrst [	move d,[440700,,[0]] ;  use null string for pretend resultī
		jrst lsrht1 ]ī
	move r,lsrtns"b		;get Bp to user's directory nameī
	move d,[440600,,r]ī
lsrht1:	pushj p,chlp0		;CONS up list of letters symbol from Bp in Dī
	move a,b		;reverse the list and atomifyī
	call 1,.function NREVERSEī
	jcall 1,.function IMPLODE	;Return the symbol!ī
ī
FASENDī
