;-*- Mode: Midas -*-

TITLE	LOOKUP an Inquire entry
	;CStacy, 4/26/83

SUBTTL	Basic definitions

;;; Registers.

X=0		;Super temporary register.
A=1		;General registers.
B=2
C=3
D=4
E=5
BP=6		;Byte pointer.
CHAR=7		;Character being manipulated.
T=10		;Temporary
TT=11		;Temporary+1.
OC==12		;OUT register.
U1==13		;4 UUO Registers.
U2==14
U3==15
U4==16
P=17		;Stack pointer.

;;; I/O Channels

DSKI=14		;Disk input.
TTYO=15		;TTY typeout.
TTYI=16		;TTY typein.

;;; Macros and output routines.

$$OUT==1
.INSRT KSC;MACROS >
.INSRT KSC;IVORY >
.INSRT KSC;OUT >


;;; LSR1 database routines.
$$OVLY==1
.INSRT LSRTNS >



SUBTTL	Interrupt Handler and various returns

POPJ1:	AOS (P)			   ;Skip
CPOPJ:	RET			   ;Return

SYSLOS::
AUTPSY:	0			   ;Fatal error JSR here.

DEATH:	SKIPE DEBUG		   ;Come here to log out.
	 .VALUE [0]
	.LOGOUT 1,


TMPLOC 42,{-TSINTL,,TSINT}	   ;New style interrupts.

INTACS==T_6+7			   ;T,TT, and OUT registers preserved.


TSINT:	INTACS,,P
	0 ? 1_TTYI ? 0 ? <1_TTYO>\<1_TTYI> ? CHRINT
	0 ? 1_TTYO ? 0 ? 0 ? MORINT
TSINTL==:.-TSINT

;;; Interrupt dismissal

INTRET:	SYSCAL DISMIS,[%CLBIT,,INTACS ? P]
	 JSR SYSLOS

;;; Console interrupts.

CHRINT:	MOVEI T,TTYI		   ;INTERRUPT CHAR.
	.ITYIC T,
	 JRST INTRET
	CAIE T,^S
	 CAIN T,^G
	  JRST [.RESET TTYO,
		SYSCAL TTYFLS,[	%CLBIT,,1 ? %CLIMM,,TTYI]
		 .LOSE %LSSYS
		JRST FLSIT1]
	JRST INTRET
MORINT:	OUT(TTYO,("--More--"))	   ;MORE BREAK.
	SYSCAL IOT,[%CLBIT,,%TIPEK ? %CLIMM,,TTYI ? %CLOUT,,T]
	 .LOSE %LSFIL
	CAIE T,40
	 CAIN T,177
	  .IOT TTYI,T
	CAIE T,40
	 JRST FLSIT
	OUT(TTYO,("A"))
	JRST INTRET
FLSIT:	OUT(TTYO,("Flushed"))
FLSIT1:	JRST DEATH		   ;means we are done.



SUBTTL Main program

GO:	MOVE P,[-PDLLEN,,PDL]	   ;Init the stack.
	SYSCAL OPEN,[%CLBIT,,<.UAO\%TJDIS> ? %CLIMM,,TTYO ? [SIXBIT /TTY/]]
	 .LOSE %LSFIL
	SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TTYI  ? [SIXBIT /TTY/]]
	 .LOSE %LSFIL
	SYSCAL CNSGET,[%CLIMM,,TTYO ? %CLOUT,,X ? %CLOUT,,TCMXH]
	 .LOSE %LSFIL
	SYSCAL TTYSET,[%CLIMM,,TTYI ? [222222,,222222] ? [230222,,220222]]
	 .LOSE %LSFIL
	.SUSET [.ROPTION,,A]	   ;Read job option bits.
	TLO A,%OPINT\%OPOPC	   ;Turn on winning-PC and new interrupts.
	.SUSET [.SOPTION,,A]	   ;Set option bits.
	.SUSET [.SMSK2,,[<1_TTYI>\<1_TTYO>]]	   ;Enable TTY interrupts.
	OUT(TTYO,OPEN(UC$IOT))
	OUT(,CH(TTYO))		   ;Open typeout display as default device.
	TLNN A,OPTCMD		   ;If user forgot JCL
	 JRST [	SKIPN DEBUG	   ; and we are not debugging
		 JRST NOJCL	   ;   we can't do much.
		MOVE A,[SIXBIT /TEST/]
		MOVEM A,UNAME	   ; Use TEST name for debugging.
		JRST MAPLSR ]
	.BREAK 12,[..RJCL,,JCLBUF] ;Read JCL into buffer.
	MOVE BP,[440700,,JCLBUF]
	MOVE B,[440600,,UNAME]
	MOVEI C,6
GETJCL:	ILDB CHAR,BP
	JUMPE CHAR, ENDJCL	   ;A ^@ ends JCL.
	CAIN CHAR,^M		   ;So does a ^M.
	 JRST ENDJCL
	CAIN CHAR,37		   ;So does a ^_.
	 JRST ENDJCL
	CAIN CHAR,3		   ;So does a ^C.
	 JRST ENDJCL
	CAIGE CHAR,140		   ;Convert to Sixbit.
	 SUBI CHAR,40
	IDPB CHAR,B		   ;Store as uname.
	SOJN C,GETJCL
ENDJCL:	CAIE C,6
	 JRST MAPLSR
NOJCL:	OUT(,("AUsage is  :LOOKUP <user>"))
	JRST DEATH

MAPLSR:	MOVEI A,DSKI		   ;Try to map in Inquire database.
	MOVE B,[-LSRPGS,,LSRPAG]
	CALL LSRTNS"LSRMAP
	 JRST [ OUT(,("AUnable to map Inquire database."),CRLF)
		JRST DEATH ]

GETLSR:	MOVEI A,DSKI
	MOVE B,UNAME		   ;Look up luser in database.
	CALL LSRTNS"LSRUNM	   ;Get core addr of entry in B.
	 JRST [ OUT(,("ANot found"),CRLF)
		JRST DEATH ]

SHOWIT:
	SKIPN DEBUG
	 OUTCAL(,("C"))	   ;Clear screen.
	MOVSI D,-NITMS		   ;AOBJN pointer to Items.
GETITM:	HRRZ A,LSTTAB(D)	   ;Get next item description string.
	HRLI A,440700		   ;Make Bp to it.
	OUT(,TZ$(A),(" "),LPAR)	   ;Print long name of item.
	HLRZ E,LSTTAB(D)	   ;Get item number.
	CALL NAMOUT		   ;Print short name of item.
	OUT(,RPAR,(":"),CALL(PTAB))
	MOVE A,E		   ;Get item number.
	CALL LSRTNS"LSRITM	   ;Look up item in database.
	 JRST [ OUT(,CRLF)	   ; If not there skip it.
		JRST NXTITM ]
	CALL ITMOUT		   ;Type out the item's value.
NXTITM:	AOBJN D,GETITM		   ;Get another item.
	JRST DEATH		   ;All done.




SUBTTL	Additional Output routines

;;; CLEOL and move to column #o50.

PTAB:	MOVE T,[ASCIZ /LH(/]
	OUT(,TZ(T))
	RET


;;; ITMOUT types out the Inquire item pointed at by the Bp in A.
;;; Newlines get handled properly. The Bp is updated.

ITMOUT:	ILDB CHAR,A
	CAIN CHAR,^M		   ;If this is a CR
	 JRST [ ILDB CHAR,A	       ; Gobble the LF.
		OUT(,CRLF,CALL(PTAB))  ; Do a prettier CRLF.
		JRST ITMOUT ]	       ; Continue.
	SKIPN CHAR
	 JRST [ OUT(,CRLF)
		RET ]
	.IOT TTYO,CHAR
	JRST ITMOUT


;;; NAMOUT takes a LSR1 item number in E, and types out its name.

NAMOUT:	HRRZI T,ITMNAM+1(E)	   ;Get addr of item short name.
	HRLI T,440700		   ;Make Bp to it.
	MOVEI TT,5.		   ;Max five chars.
NAMOU1:	ILDB CHAR,T		   ;Get character.
	JUMPE CHAR,NAMOU2	   ;If zero, done.
	.IOT TTYO,CHAR		   ;Type it.
	SOJN TT,NAMOU1		   ;Go back for more characters.
NAMOU2:	RET			   ;Done.





SUBTTL	Storage

;;; Macro to create a table of item descriptions.

NITMS==0
DEFINE	ITEM NUM,&DESC
NITMS==NITMS+1
	NUM,,[ASCIZ DESC]
TERMIN

;;; This table is in the order we want the items listed.

LSTTAB:	ITEM LSRTNS"I$UNAM,"User-name"
	ITEM LSRTNS"I$AUTH,"Authorization"
	ITEM LSRTNS"I$NAME,"Name"
	ITEM LSRTNS"I$NICK,"Nick-name"
	ITEM LSRTNS"I$GRP,"Group"
	ITEM LSRTNS"I$REL,"Relation"
	ITEM LSRTNS"I$MITA,"MIT address"
	ITEM LSRTNS"I$MITT,"MIT phone"
	ITEM LSRTNS"I$HOMA,"Home address"
	ITEM LSRTNS"I$HOMT,"Home phone"
	ITEM LSRTNS"I$NETA,"Network mailbox"
	ITEM LSRTNS"I$BRTH,"Birthday"
	ITEM LSRTNS"I$PROJ,"Project"
	ITEM LSRTNS"I$SUPR,"Supervisor"
	ITEM LSRTNS"I$REM,"Remarks"
	ITEM LSRTNS"I$DIR,"File directories"
	ITEM LSRTNS"I$LOCL,"Local fields"
	ITEM LSRTNS"I$MACH,"Machines"
	ITEM LSRTNS"I$ALTR,"Last Alteration"

;ITEMN+N has name of n'th item, as 5 chars of ascii.
ITMNAM:	LSRTNS"ITMIRP [.1STWD ASCII/ITEM/]



PDLLEN==64.		;Stack length.
LSRPGS==220.		;Number of pages reserved for LSR1.
JCLBFL==10.		;Number of words for JCL buffer.

PDL:	BLOCK PDLLEN	;The stack.
DEBUG:	0		;-1 iff debugging.
JCLBUF:	BLOCK JCLBFL	;JCL buffer.
TCMXH:	0		;Console parameters.
UNAME:	0		;UNAME of loser to look up.


CONSTANTS
VARIABLES

VARCHK

LSRPAG==<.+1777>/2000	;Starting page of Inquire database. 
LSR1=LSRPAG*2000	;Address of database header.

END GO
