	.TITLE	LOG HANDLER FUNCTION CODE
	.IDENT	"V3.0"
	.nlist	bex,me,cnd
	.enabl	lc
	.SBTTL	AUTHOR'S CREDITS
 
;	Author:		Henry R. Tumblin
 
;	Date:		
 
;	Version:	3.0
 
;	For:		Systems - Utilities
 
;	Machine/System:	PDP-11/70 IAS V3.0
 
;	Type/Language:	Subroutines/Assembler
 
;	Residence:	DB0:[1,20]LGROOT.MAC
 
;	Abstract:	This module contains all the
;			currently supported utility
;			functions for the LG....
;			handler.
;
;	Edits:		
 
;NO.	   Date		By	Reason
;---	---------	-----	--------------------------------------------
;       03-Feb-79	HRT	Removed carriage control from LOG record.
;       03-Feb-79	HRT	Added User name lookup function.
;       04-Feb-79	HRT	Added UPF lookup function.
;       05-Feb-79	HRT	Added DAC lookup function.
;       18-Feb-79	HRT	Fixed up file open, added call to .FIND to
;	    			determine if the file exists.
;+06	28-Aug-79	HRT	Re-documented for IAS V3.0.
;+07	14-Apr-80	EAJ	Eliminated Debug statment and changed QIOW$
;				to QIO$ so CTRL/S on operators console
;				won't hang system.

	.sbttl	Mcall's, Local and Global definitions

	.mcall	FCSMC$,GTIM$S,GCOM$,ASTX$S,SPRA$
	.mcall	PUSH,POP,DIR$,C$C,MRKT$S,SVTK$
	.mcall	WTSE$S,CMKT$S,RQST$,QIO$

	.globl	TS,BUF

	FCSMC$				; Mcall FCS macros
	C$C				; define control characters
	LGLUN==2			; lun for FCS
	UP.UIC=10			; Offset to UPF UIC
	UP.USN=0			; Offset to UPF user name

	.SBTTL	MACROS
 
	.MACRO	.INH			; Inhibit task switching macro
	MOV	@#PS,-(SP)		; Save our current status
	BIS	#340,@#PS		; Change our mode to KERNAL
	.ENDM	.INH
 
	.MACRO	.ENB			; Enable task-switching macro
	MOV	(SP)+,@#PS		; Restore the prior status
	.ENDM	.ENB
 
	.MACRO	PRINT	BUFF,LENGTH,CCW	; Print data to terminal macro
	.IF	B	CCW
	CLR	-(SP)
	.IFF
	PUSH	<CCW>
	.ENDC
	PUSH	<LENGTH,BUFF>		; Get the address + length 
	CALL	$OUT			; Call common output routine
	.ENDM	PRINT

	.SBTTL	Define Handler special function codes

;	The functions described here are all the currently supported
;	functions of this handler. Each function has a macro 
;	associated with it for the user to interface to. To define
;	these symbols locally within a user program, use the
;	LGDEF$ macro.

	.MCALL	.WORD.,DEFIN$
	...gbl=0			; Define offsets globally
	.WORD.	LG.LOG,000,001		; Log record to file
	.WORD.	LG.ATT,000,003		; Attach
	.WORD.	LG.DET,000,004		; Detach
	.WORD.	LG.NAM,000,005		; Get user name subfunction(P)
	.WORD.	LG.UPF,001,005		; Get UPF record (P)
	.WORD.	LG.UIC,002,005		; Get UPF record by UIC (P)
	.WORD.	LG.DAC,003,005		; Get disk accounting info
	.WORD.	LG.ACT,004,005		; Return list of terminals

	.sbttl	FCS Stuff
	.sbttl	Log file FDB

	FSRSZ$	1			; define buffer area for FCS
 
LGFDB::	FDBDF$				; Allocate space for a File
					; Descriptor Block.
 
	FDAT$A	R.VAR,FD.CR,160.,-10.,-10. ; Record Attributes: ...
					; ...Variable Length
					; ...Implied carriage control
					; ...Maxbuf of 160. bytes
					; ...Create 10. blocks initially
					; ...Extend by 10. blocks each time
	
	FDRC$A	,BUF,BUFS		; File Access: ...
					; Input buffer is BUF
					; Input buffer size is BUFS
 
	FDOP$A	LGLUN,LGDPST,,FO.APD!FA.SHR,FA.DLK   ; File Open: ...
					; ...File lun is LGLUN
					; ...File name block pointer 
					; ...Open for append
					; ...and shared access
					; ...Don't lock file if aborted.
 
LGDPST:: .WORD	LGDEVS,LGDEV		; File name block descriptor
	.WORD	LGUICS,LGUIC		;
	.WORD	LGNAMS,LGNAM		;
 
LGDEV:	.ASCII	"LB0:"			; Output device
	LGDEVS=.-LGDEV

LGUIC:	.ASCII	"[1,2]"			; Output UIC
	LGUICS=.-LGUIC

LGNAM:	.ASCII	"       .LOG"		; Output File name
	LGNAMS=.-LGNAM


	.sbttl	UPF file FDB

UPFFDB::				; Define a FDB for the UPF file
	FDBDF$				; Allocate a FDB
	FDRC$A	FD.RAN,BUF,64.		; Record access:
					; ...Random access
					; ...Input buffer is BUF
					; ...Input record size is 64. bytes
	FDOP$A	LGLUN,UPFDSD,,FO.RD!FA.SHR	; File Open:
					; ...File lun is 1
					; ...Dataset descriptor.
					; ...Readonly-shared
	FDBF$A	,,1			; Block buffer:
					; ...Multi buffer count = 1
 
UPFDSD:	.WORD	DEVS,DEV		; device
	.WORD	UICS,UIC		; uic
	.WORD	FNAMS,FNAM		; filename
 
DEV:	.ASCII	"LB00:"			; 
	DEVS=.-DEV
 
UIC:	.ASCII	"[001,100]"		;
	UICS=.-UIC
 
FNAM:	.ASCII	"PDSUPF.DAT"		;
	FNAMS=.-FNAM
	.even

	.sbttl	Impure areas
	
	.even

;	The following table is the Synchronous System Trap
;	vector table. It is used to allow the handler to
;	die gracefully in the event of an internal handler
;	error.

TRPTAB:	.WORD	TRPHND			; Odd address trap
	.WORD	TRPHND			; Segment fault
	.WORD	TRPHND			; T-bit trap
	.WORD	TRPHND			; IOT
	.WORD	TRPHND			; Reserved instruction
	.WORD	TRPHND			; Non-IAS EMT
	.WORD	TRPHND			; Trap instruction
	.WORD	TRPHND			; 11/40 flting pnt exec.
	.WORD	TRPHND			; Memory parity error
	TTSIZ=<.-TRPTAB>/2		; # of entries in table

TS:	.BLKW	10.			; Trap register save area

;	The File-ID is saved after the LOG file is initially
;	created so that all subsequent file opens can be
;	made by File-ID and reduce overhead of OPEN$

FIDADR:	.BLKW	3			; area to store filename block

;	The following buffer is used for a variety of different
;	things. It can be used by any subroutine as a record
;	buffering area, or scratch area to be used to build a
;	message, etc.

BUF:
BASEA:	.WORD	0			; IASCOM Base address
SIZE:	.WORD	0			; IASCOM size
	.BLKB	296.			; output buffer
	BUFS=.-BUF			; buffer size
	.EVEN
 
;	The following table is the dispatch table for the
;	special PDS> functions. Each entry to the table
;	consists of the	address of the subroutine to CALL.

PDSDPT:	.WORD	GETNAM			; Get User Name from IASCOM
	.WORD	GETUPF			; Get User Profile Record(Name)
	.WORD	GETUIC			; Get User Profile Record(UIC)
	.WORD	GETDAC			; Get Disk Accounting Summary
	.WORD	GETTER			; Get List of terminals specified
					;  user is active on.
	PMXFC=<.-PDSDPT>/2		; Max number of functions.
 

;	The following 4 words are used by the PDS User Profile
;	lookup routines as temporary relative record # pointers.

RECNO:	.WORD	0			; Record number in UPF file
INDXNO:	.WORD	0			; Index record # in UPF file
IEND:	.WORD	0			; Ending index record #
END:	.WORD	0			; Ending UPF record #
 
RECSIZ:	.BLKW	1			; Size of record to output to log file

	.sbttl	DPB's of interest
 
	.globl	PWRF,SVTB
 
PWRF:	SPRA$	PWRAST			; Declare power fail AST

SVTB:	SVTK$	TRPTAB,TTSIZ		; Declare SST table

GCOM:	GCOM$	IASCOM,BUF		; Get common DPB

REQDAC:	RQST$	DSKACN,,150,1,1		; Request Disk Accounting
 
$WRT:	QIO$	IO.WLB,SYLUN,10,100,,,<0,0,0> ;+07 Msgs to console.

	.SBTTL	MESSAGE STRINGS
 
CRERR:	.ASCII	"%NLG  --  Unable to open LOG file"
	.ASCII	"%N FCS Error # %D%N"
	.ASCIZ	"LG -- Continuing"
 
NEWD:	.ASCIZ	<BEL>"%NLG -- Today's date is %Y"
 
PWRFL:	.ASCII	"LG -- Power fail occurred, System restarting"
	.ASCIZ	", Time of failure = %3Z, %Y"
PWRFLS=.-PWRFL
 
TRPDMP:	.ASCII	"LG -- Aborting due to error%N"
	.ASCII	"Crashing SP = %P%N"
	.ASCII	"Crashing PC = %P%N"
	.ASCII	"Crashing PS = %P%N"
	.ASCII	"%9SR0 = %P%N"
	.ASCII	"%9SR1 = %P%N"
	.ASCII	"%9SR2 = %P%N"
	.ASCII	"%9SR3 = %P%N"
	.ASCII	"%9SR4 = %P%N"
	.ASCIZ	"%9SR5 = %P%N"
	.EVEN

	.SBTTL	Attach and Detach
 
;	Attach and Detach function

;	The attach and detach functions have been added
;	here for compatability with some tasks that
;	attach to the device first then start
;	up their I/O. At all times, the attach and or
;	detach will always succeed.

ATTC::	MOV	$RQIO,R1		; Get request node -> R1
	MOV	$PDPTR,R2		; Get PUD pointer -> R2
	CALL	..ATUN			; Attach the task
	MOV	#1,$STAT0		; set sucess
	JMP	IODUN			; Go do I/O done processing
 
DEAT::	MOV	$RQIO,R1		; Get Request node -> R1
	MOV	$PDPTR,R2		; Get PUD pointer -> R2
	CALL	..DTUN			; Deattach unit
	BCC	10$			; CC - then return success
	MOV	#IE.DNA,$STAT0		; Device Not Attached
10$:	JMP	IODUN			; Go do I/O Done

	.SBTTL	WRITE LOG FUNCTION

WRTLOG::
	
;	This function will output to a log file any information
;	regarding the system that is sent to it via a IO.WLB or IO.WVB
;	QIO function code.
 
;	First move the users output string into our buffer area
 
	MOV	$RQIO,R1		; R1 = QI/O request node address
	MOV	R.PB(R1),R2		; get pointer to line descriptor
	MOV	R.PB+2(R1),R3		; set length of transfer
	MOV	#BUF,R4			; set output buffer address
	CALL	..BLXI			; get user string
	BCC	CMPRS			; cc - then no errors
	CLR	$STAT0			; Clear out any junk
	MOVB	#IE.SPC,$STAT0		; error - out of address space

;	IODUN is a common return point for all function routines.
;	a JMP	IODUN is made by each function routine to allow a
;	common return point for I/O done processing.

IODUN:	CALL	$IODUN			; perform I/O done
	JMP	$WAIT			; go back to wait loop

;	Compress the record by eliminating control characters.

CMPRS:	MOV	R3,RECSIZ		; Get size of record x-ferred
	MOV	#7,$BUFF		;  ...
	PUSH	<#$BUFF,#RECSIZ,#BUF,#3> ; Set up parameter list
	MOV	SP,R5			; Point to the argument list -> R5
	CALL	KILC			; Compress the record
	ADD	#10,SP			; Clean up the stack.

	.sbttl	Append the record to the log file
	.enabl	lsb

;	Output record to CO0:
 
	PRINT	#BUF,RECSIZ,#40 	; also output to operator's console

;	If the file open fails, then try to create a new file.
;	also, let's store the file ID to allow for quicker opens

	MOV	#LGFDB,R0		; Point to the FDB
	MOV	#LGFDB+F.FNB,R1		; Point to the file name block
	CLR	N.FVER(R1)		; Find the most recent version
	CALL	.FIND			; Is it there?
	BCC	FNDOK			; CS - Then file not found.

;	Open error

13$:	CALL	OPNERR			; Go process open error
	MOV	#IE.BAD,$STAT0		; Set bad code
	BR	WREX			; Go exit function

FNDOK:	OFID$A				; open log file for append
	BCS	13$			; CS - then error

;	Now output the completed record to the output file
;
OPOK:	PUT$	R0,,RECSIZ		; output the record
	CLOSE$	R0			; close the file
 
;	Now restore the file id information to the FDB
 
	CALL	UNSFID			; restore file ID
	CLR	$STAT0			; Clear out junk
	MOVB	#IS.SUC,$STAT0		; set I/O success

WREX:	JMP	IODUN			; Go to wait loop

	.dsabl	lsb

	.sbttl	New file stuff
	.enabl	lsb
 
;	The way that this routine works, is that it is
;	initially entered when the handler is
;	loaded. It checks to see what the time is, and schedules
;	itself to be entered after midnite to print up the system
;	log for the previous day, then requests itself again.
    
NEWFIL:: CALL	$SAVAL			; Save all registers
 
;	Set up so that we will be woken up
;	at midnite.

	GTIM$S	#BUF			; Get current time
	MOV	#23.,R1			; 24-1 hours in a day
	SUB	BUF+G.TIHR,R1		; Get hours left today
	MUL	#60.,R1			; Convert to minutes
	MOV	#60.,R0			; Set up for miutes this hour
	ADD	#1,R0			; BE SURE TO GET INTO TOMORROW
	SUB	BUF+G.TIMI,R0		; Correct the minutes left
	ADD	R0,R1			; Add in minutes so far this hour
	MRKT$S	#0,R1,#3,#NEWAST	; Set up AST to create next file
 
;	Now get today's date in order to generate a
;	file name. The filename will be of the
;	general format :
;		DDMMMYY.LOG
;

;	Convert date to form DD-MMM-YY

	MOV	#$BUFF,R0		; Point to output area
	MOV	#BUF+G.TIYR,R1		; Point to input area
	CALL	$DAT			; Convert date to ascii
 
;	Convert date to form DDMMMYY and move into filename
;	buffer.

	MOV	#$BUFF,R0		; Reset pointer
	MOV	#9.,R1			; Set counter
	MOV	#LGNAM,R2		; Set output pointer
5$:	CMPB	#40,(R0)		; Is it a blank ?
	BNE	10$			; NE - then go on.
	MOVB	#'0,(R2)+		; Replace the blank with a 0
	BR	40$			; Go to end of block
10$:	CMPB	#'-,(R0)		; Is it a hyphen ??
	BEQ	40$			; EQ - then go on.
	MOVB	(R0),(R2)+		; Move into position
40$:	INC	R0			; Point to next character
	SOB	R1,5$			; Loop till Thru.

;	Now parse the filename string and check to see
;	if the file already exists. If it doesn't, then
;	open a new file.

	MOV	#LGFDB,R0		; Set pointer to the FDB
	MOV	#LGFDB+F.FNB,R1		; Point to the filename block.
	MOV	#LGDPST,R2		; Point to the dataset descriptor.
	CLR	R3			; No default file name
	CALL	.PARSE			; Parse the input filespecs.
	CLR	N.FVER(R1)		; Clear the version #
	CALL	.FIND			; Try to find the file.
	BCC	100$			; CC - then it exists!!, save the FID
 
;	If the file doesn't exist, then create a new LOG file
;	on the LB: device under the UFD of [1,2]

	OFNB$W				; Else open a new file	
	BCC	100$			; CC - then we're ok

;	If there is an open error, then display a message to the
;	operator's console, and do I/O done processing.

	CALL	OPNERR			; Process open error
	BR	110$			; And go return to caller

;	Save the contents of the File Name Block for faster
;	opens on the log file.

100$:	CALL	SAVFID			; Save file ID for subsequent opens
	CALL	CLSFIL			; Close the file.
	CALL	UNSFID			; Unsave the file ID.

110$:	RETURN				; Return to calling proc.
	.dsabl	lsb

	.SBTTL	Special PDS related functions
	.enabl	lsb

PDSFUN::

;	Each Special routine is entered via a
;	JSR PC,addrs. This allows easy addition of
;	functions to this handler as each being a
;	subroutine. It is the responsibility of
;	each function to set the proper success/failure
;	code in $STAT0 and $STAT1. If the routine
;	returns the C-bit set, then a JMP to $ERROR is
;	made, else a JMP to IODUN is performed.

;	Verify that the subfunction code is valid.

	MOV	$RQIO,R1		; Get the Rqst node address
	MOVB	R.FC(R1),R1		; Get the sub-function code
	BIC	#<^C377>,R1		; Clear off any junk
	CMP	#PMXFC,R1		; Is it > max function code?
	BGE	30$			; GE - then ok subfunct. code
	MOV	#IE.IFC,$STAT0		; Else tell them its bad
	JMP	$ERROR			; Error - bad function code

;	Now dispatch the request to the appropriate
;	subroutine. If the C-bit is set on return,
;	then go to the error processing routine. Else
;	do normal I/O done processing.

30$:	ASL	R1			; Get offset into dsptch table
	CALL	@PDSDPT(R1)		; Go to the proper routine
	BCC	40$			; CC - Then no errors

	JMP	$ERROR			; Else go do error stuff
 
40$:	JMP	IODUN			; Go do IO-done
	
	.dsabl	lsb

	.sbttl	Subfunction 0, Get user name from IASCOM
	.enabl	lsb

;	GET_NAM - Get user name from IASCOM. 
;	
;	This function will scan IASCOM for the user name and return
;	it to the requesting task in ASCII and RAD-50.
;
;	The parameters list should be as follows:
;
;	QIOW$	LG.NAM,LUN,EF1,PRI,IOSB,AST,<BUFF>
;
;	Where:
;		LG.NAM	-	The function code to the handler
;		LUN	-	The LUN to use. Should be assigned
;				to LG0: somehow.
;		EF1	-	The event flag to use
;		PRI	-	The priority of the request
;		IOSB	-	The address of the I/O status block
;		AST	-	An AST entry point
;		BUFF	-	The address of a 10. word buffer to use.

GETNAM::
	CALL	$SAVAL			; Save our registers
 
;	Get the information from the request node.

	MOV	$RQIO,R1		; Get their RN address
	MOV	R.AT(R1),R0		; Get their ATL address
	MOV	A.TI(R0),R0		; Point to their PUD
 
;	Get the user name from IASCOM. This function
;	was made into a subroutine to allow other
;	functions to share its use.

	CALL	FNDUSR			; Get the user name
	BCS	26$			; CS - then do errors
 
;	Now convert the user name to RAD-50, so that we
;	give both back to the user.
;	We'll re-use the same buffer as GCOM$ does.(why not?)
 
;+07 One line removed.

;	The format of the returned buffer is:
;
;	*****************************************
;	*    Words 1-6: 12 character user name  *
;	*	total length - 12. bytes	*
;	*****************************************
;	*    Words 7-10: RAD-50 user name.	*
;	*	total length - 8. bytes		*
;	*****************************************
;
;		Total length of user buffer required = 20. bytes, 10. words.

31$:	MOV	#4.,R4			; Set loop count
	MOV	#BUF+14,R3		; Get pointer to dst buffer
	MOV	#BUF,R0			; Set src pointer
22$:	MOV	#1,R1			; Set for proper conversion
	MOV	R0,-(SP)		; Save pointer
	CALL	$CAT5			; Convert 3 bytes to R-50
	MOV	R1,(R3)+		; Move into the buffer
	MOV	(SP)+,R0		; Restore pointer
	ADD	#3,R0			; Point to next 3 characters
	SOB	R4,22$			; Loop until thru	

;	Now move the data back to the users space.

	MOV	$RQIO,R1		; Get RN address
	MOV	R.PB(R1),R2		; Set VA of where it's going
	MOV	#24,R3			; And the # of bytes to XFER
	MOV	#BUF,R4			; And where it's coming from
	CALL	..BLXO			; Send it to the user
	BCC	40$			; CC - then X-fer successfull
 
	MOV	#IE.SPC,$STAT0		; Set error condition
	BR	26$			; And return

40$:	MOV	#1,$STAT0		; Set I/O Success

26$:	RETURN				; Return to caller
	
	.dsabl	lsb

	.SBTTL	      GET_UIC
	.enabl	lsb

; GETUIC - THIS ROUTINE SCANS PDSUPF.DAT SEQUENTIALLY
;	 - SEARCHING FOR A MATCH FOR THE UIC SPECIFIED.
;
;	The parameters list should be as follows:
;
;	QIOW$	LG.UIC,LUN,EF1,PRI,IOSB,AST,<UIC,BUFF>
;
;	Where:
;		LG.NAM	-	The function code to the handler
;		LUN	-	The LUN to use. Should be assigned
;				to LG0: somehow.
;		EF1	-	The event flag to use
;		PRI	-	The priority of the request
;		IOSB	-	The address of the I/O status block
;		AST	-	An AST entry point
;		UIC	-	The UIC of the UPF record to scan for. The
;				general format of the UIC is:
;					.BYTE	MEMBER,GROUP
;		BUFF	-	The address of a 32. word buffer to use.

;			**Note**
;		To use this function, the user much
;		be a [1,*] user or else the handler
;		will return a priviledge violation error.

GETUIC:
	CALL	$SAVAL			; Save our registers
 
;	Check to see if they are a priviledeged user.
;	If so, then continue. Else return with priv. violation
;		error.

	MOV	$RQIO,R1		; Point to the request node
	CMPB	#1,R.GC(R1)		; Are they priviledged?
	BEQ	12$			; EQ - Yup, continue
	MOV	#IE.PRI,$STAT0		; Else set error
ERET:	SEC				; Set carry
	RETURN				; And leave

;	Now set up to scan the UPF. Use GETDEF to open
;	the UPF and read the first(default) record.
;	If there is an error, then that means that we are unable to 
;	access the UPF for some reason. For now, let's die
;	instead of stalling.

12$:	MOV	R.PB(R1),R4		; Get the UIC to find -> R4
	CALL	GETDEF			; Get the default record #
	BCS	90$			; CS - Then unable to access UPF
	MOV	#BUF,R3			; Point to buffer to use
	MOV	(R3),RECNO		; RECNO has starting record #
	DEC	RECNO			; -1 for start of loop
	MOV	2(R3),END		; END has the ending record #

;	Start the main scan loop. Scan the UPF file sequentially
;	looking for the UIC that was specified. If not found, then
;	the UIC does not have a valid UPF account.

5$:	INC	RECNO			; Bump up the count to the next record
	CMP	RECNO,END		; Are we at the end yet?
	BLE	10$			; LE - Nope.

;	Can't find record for account in UPF.
;	So, Return an error of 0 to indicate UPF record not found

	CLR	$STAT0			; Set status
	BR	ERET			; Go do error stuff

10$:	GET$R	,R3,,RECNO,#0		; Get next record
	BCS	90$			; CS - then quit
	TST	UP.UIC(R3)		; Is this a null record?
	BEQ	5$			; EQ - yup, try next record

	CMP	R4,UP.UIC(R3)		; Do the UIC's match?
	BNE	5$			; NE - then check next record

90$:	CALL	CLSFIL			; Close the file
 
;	The UPF record has been found and read into the
;	buffer. Set up to transfer the record back to the
;	users buffer using the ..BLXO subroutine.
 
	MOV	$RQIO,R1		; Request node addres -> R1
	MOV	R.PB+2(R1),R2		; Set starting address of X-fer
	MOV	#64.,R3			; Length of transfer
	MOV	#BUF,R4			; Where it's coming from
	CALL	..BLXO			; Transfer it to the users area
	BCC	34$			; CC - then X-fer successfull.
 
	MOV	#IE.SPC,$STAT0		; Else set error
	BR	ERET			; Go return
 
34$:	MOV	#IS.SUC,$STAT0		; Set success
	MOV	#64.,$STAT1		; And buffer length
36$:	RETURN				; Return to caller
 
	.dsabl	lsb

	.sbttl	GET_UPF Find user profile record by user name
	.enabl	lsb
 
;	GET_UPF - Get user profile record
;	
;	This function will scan PDSUPF for the user profile record
;	for the user name specified. 

;	The parameters list should be as follows:
;
;	QIOW$	LG.UPF,LUN,EF1,PRI,IOSB,AST,<UNM1,UNM2,UNM3,UNM4,BUFF>
;
;	Where:
;		LG.NAM	-	The function code to the handler
;		LUN	-	The LUN to use. Should be assigned
;				to LG0: somehow.
;		EF1	-	The event flag to use
;		PRI	-	The priority of the request
;		IOSB	-	The address of the I/O status block
;		AST	-	An AST entry point
;		UNM1-4	-	The Rad-50 User name.
;		BUFF	-	The address of a 32. word buffer to use.

GETUPF::				; Define global entry point
	CALL	$SAVAL			; Save our registers
 
;	Get a pointer to the User name to lookup.

	MOV	$RQIO,R4		; Point to the request node
	ADD	#R.PB,R4		; Point to the requested user name

;	Use GETDEF to open the UPF file and read the default record.

	CALL	GETDEF			; Get the default record
	MOV	#BUF,R3			; Point to the input buffer
	MOV	(R3),RECNO		; Get the first profile record #
	MOV	(R3),IEND		; The last index Record #
	MOV	2(R3),END		; The last record # in the UPF
	MOV	#2,INDXNO		; Set current index record number to 2
 
F001:	GET$R	,R3,,INDXNO,#0		; Read next index record
	BCS	RET001			; CC - then no errors
 
30$:	MOV	#8.,R1			; Set counter in R1

F002:	CMP	(R4),(R3)		; Does the 1st word match?
	BNE	F003			; NE - nope, check next index entry
	CMP	2(R4),2(R3)		; Does the second word match?
	BNE	F003			; NE - nope, check next index entry
	CMP	4(R4),4(R3)		; Does the 3rd word match?
	BNE	F003			; NE - nope, check next index entry
	CMP	6(R4),6(R3)		; Does the last word match?
	BEQ	F004			; Eq - then we've found it!

F003:	ADD	#8.,R3			; Point to next index entry
	INC	RECNO			; Bump up profile record count
	SOB	R1,F002			; Loop till thru

	MOV	#BUF,R3			; Point to the input buffer
	INC	INDXNO			; Point to next index record
	CMP	INDXNO,IEND		; Are we at the end of the index ?
	BLT	F001			; LT - then get next index record

	SEC				; Set carry on error
	BR	RET001			; Go return
 
F004:	MOV	#BUF,R3			; Point to the input buffer
	GET$R	,R3,,RECNO,#0		; Read the proper UPF record
	BCS	RET001			; CS - then error
	CLC				; Else clear carry bit
 
;	Set up to transfer the UPF record back to the users buffer.
 
	MOV	$RQIO,R1		; Point to the request node
	MOV	10(R4),R2		; Set the program buffer VA
	MOV	#64.,R3			; Length of transfer
	MOV	#BUF,R4			; Source buffer address
	CALL	..BLXO			; Transfer the record.
	BCC	RET001			; CC - then transfer successfull.

	 
RET001:	CALL	CLSFIL			; Close the input file
 
	RETURN				; Return to who called us
	.dsabl	lsb

	.sbttl	Support Subroutines
	.sbttl	1) Open UPF file and read default record.
	.enabl	lsb

;	This module will open the UPF file and
;	return the address of the FDB in R0.
;
;	Inputs are:
;
;		
 
;	Outputs are:	
;
;		CC - Then file open was successfull.
;		CS - Then unable to access file.

GETDEF::				; 
	MOV	#UPFFDB,R0		; Set FDB address in R0
	MOV	#UPFFDB+F.FNB,R1	; Point to the FNB
	TST	N.FNAM(R1)		; Has .PARSE been called?
	BNE	10$			; NE - Yup, skip other calls
	MOV	#UPFDSD,R2		; Point to the DSD
	CLR	R3			; No Default name block
	CALL	.PARSE			; Parse the file specs.

10$:	MOV	#-1,N.FVER(R1)		; Set to get most recent #
	CALL	.FIND			; Find the file.
	BCS	100$			; CS - then file not found
 
	OFNB$R				; Else open the UPF file read.
	BCS	100$			; CS - then unable to access 
 
	GET$R	,#BUF,,#1,#0		; Read the default record
	BCS	100$			; CS - then bad record #
 
	CLC				; Else clear carry
 
100$:	RETURN				; Return to calling prog.
 
 
	.sbttl	2) Close file.
 
;	This subroutine will close the file whose
;	FDB address is in R0.

CLSFIL:	TST	F.BDB(R0)		; Is the file already open ?
	BEQ	11$			; EQ - no
	CLOSE$	R0			; Close the file
11$:	RETURN				; Return to user prog.

	.dsabl	lsb

	.SBTTL	3) GET DAC Record for user.

;
;	This function still has to be written.
 
GETDAC::				; Define entry point
	MOV	#IE.IFC,$STAT0		; Make it a bad function code
	SEC				; Set carry for error
	RETURN				; Return to caller


	.sbttl	4) GET_TERminals

;	This function will return a list of terminals that the
;	user specified is active on. If not specified, then
;	an error return will occur.
 
;	this function still needs to be written.

GETTER::
	MOV	#IE.IFC,$STAT0		; Make it a bad function code
	SEC				; Set carry for error
	RETURN				; Return to caller

	.sbttl	4) New file AST routine.
	.ENABL	LSB 
;	This AST is entered at MIDNITE each day. The
;	purpose of this routine is to create a new log
;	file for that particular day. This AST is queued by 
;	the NEWFIL routine.
 
NEWAST::
	TST (SP)+			; Clear off event flag info
	GTIM$S	#BUF			; Get today's date
	PUSH	<R0,R1,R2>		; Save work registers
	MOV	#BUF+16.,R0		; Point to output area
	MOV	#NEWD,R1		; Point to format string -> R1
	MOV	#BUF+G.TIYR,R2		; Point to input date
	CALL	$EDMSG			; Format the message
	PRINT	#BUF+16.,R1,#40		; Print newday message
	POP	<R2,R1,R0>		; Restore Registers
	CALL	NEWFIL			; Create a new file
	DIR$	#REQDAC			; Request disk accounting
	ASTX$S				; Exit the AST
 
	.sbttl	5) Power Fail AST
 
;	On power fail, let's log the power-out
;	to the log file, and also to the Operator's 
;	console. There isn't really much more that 
;	is really needed to do in the event of a power fail.
;	And wait for 3 minutes before servicing a request. This
;	is to insure that the time has been correctly set
;	by the operator and we can start up or create a new file.
 
PWRAST::				; Declare entry point
 
	PRINT	#PWRFL,#PWRFLS		; Output message to operator's console
	CMKT$S				; Cancel any outstanding MRKTS
	TST	LGFDB+F.FNB+N.FNAM	; Is there a filename?
	BNE	12$			; NE - Yes, ignore waitfor
	MRKT$S	#10,#3,#3		; Wait 5 minutes
	WTSE$S	#10			; Wait for timeout
12$:	CALL	NEWFIL			; Check the file
	CALL	UNSFID			; Restore the file name block
	OFNB$A	#LGFDB			; Open the output file
	PUT$	R0,#PWRFL,#PWRFLS		; Output power-fail message
	CALL	CLSFIL			; Close the file
	ASTX$S				; Exit the AST
 
	.dsabl	lsb

	.sbttl	7) Find user name in IASCOM
	.enabl	LSB

;	This subroutine picks up the users User Terminal Node
;	address from the PUD, remaps APR3 to IASCOM, then returns
;	the user name as it exists in IASCOM.
;
;	This has been completely re-written from version 2.

;	Input arguments are :
 
;	R0 - Pointer to PUD that user is on
;
;	Outputs:
;
;	BUFF - Contains the user name
;	R0	-	Destroyed
;	R1	-	Destroyed
;	R5	-	Destroyed

;	CC - Successfull
;	CS - Error - User name not found.
 
FNDUSR::
	DIR$	#GCOM			; Get APR info for IASCOM
	TST	@#$DSW			; Was the common area there?
	BPL	10$			; MI - then directive error
	MOV	@#$DSW,$STAT0		; Set return status
	SEC				; Set error indicator
	BR	50$			; And leave

10$:	MOV	U.ACP(R0),R0		; Point to our UTN
	BNE	15$			; NE - Then OK
	MOV	#IE.PRI,$STAT0		; Set error
	SEC				;  ...
	BR	50$			; And leave

15$:	SUB	#40000,R0		; Get rid of APR2 mapping
	CMP	#20000,R0		; Is UTN mapped thru APR3 ?
	BHIS	20$			; HIS - no
	SUB	#20000,R0		; Get rid of additional APR mapping
	ADD	#200,BASEA		; Point to next 4k of IASCOM

20$:	PUSH	<#77406,BASEA>		; Set up access PDR,PAR Pair
	CALL	..SPD3			; Map into IASCOM

	ADD	#I.UN+60000,R0		; Point to the user name -> R0

	MOV	#BUF,R5 		; Get pointer of dest. buff
	MOV	#12.,R1			; Length of user name

;	Now move the user name into the buffer. If any nulls are encountered
;	in the user name, they are converted to blanks.

30$:	MOVB	(R0)+,(R5)		; Move into place
	BNE	40$			; NE - then valid char
	MOVB	#' ,(R5)		; If null, blank substitute
40$:	TSTB	(R5)+			; Bump up pointer
	SOB	R1,30$			; Loop till thru

	CALL	..SPD3			; Map back to my task
	CMP	(SP)+,(SP)+		; Get rid of PDR,PAR pair
	CLC				; Clear error indicator

50$:	RETURN				; Return to calling proc.

	.DSABL	LSB

	.sbttl	8) SAVFID  -- Save file ID
	.enabl	lsb
 
;	This routine saves the file name block information
;	in the FDB so that it can be restored when the
;	file is subsequently re-opened.
 
SAVFID::
	MOV	R0,-(SP)		; Save work register
	MOV	#LGFDB+F.FNB,R0		; Point to file name block in FDB
	MOV	N.FID(R0),FIDADR	; Save File-ID
	MOV	N.FID+2(R0),FIDADR+2	;  ...
	MOV	N.FID+4(R0),FIDADR+4	;  ...
	MOV	(SP)+,R0		; Restore R0
	RETURN				; Return to calling proc.
 
	.sbttl	9) UNSFID  -- Unsave file ID
 
;	This routine takes the file name block information
;	and restores it to the File Descriptor Block

UNSFID::
	MOV	R0,-(SP)		; Save work register
	MOV	#LGFDB+F.FNB,R0		; Point to file name block in FDB
	MOV	FIDADR,N.FID(R0)	; Restore File-ID
	MOV	FIDADR+2,N.FID+2(R0)	;  ...
	MOV	FIDADR+4,N.FID+4(R0)	;  ...
	MOV	(SP)+,R0		; Restore R0
	RETURN
 
 
	.sbttl	10) MOVDAT  --  Move data routine
 
;	This routine will move a block of data from a location
;	referenced by r0 to the location referenced by r2
;	for a length specified by r1.
;	NOTE: This routine performs a word move. All data
;	that is to be moved must be aligned on a fullword
;	boundary, else the program will trap out.
 
MOVDAT:: MOV	(R0)+,(R2)+		; Move a word of data
	SOB	R1,MOVDAT		; Loop till thru
	RETURN				; Return to calling proc.
 
	.sbttl	11) $OUT  --  Output data to the terminal.
 
	BUFF	=	2
	LENGTH	=	4
	CCW	=	6

$OUT::	MOV	LENGTH(SP),$WRT+Q.IOPL+2  ; Set buffer length
	BEQ	90$			; EQ - then quit
	MOV	BUFF(SP),$WRT+Q.IOPL	; Set the buffer length
	MOV	CCW(SP),$WRT+Q.IOPL+4	; Set Format control
	DIR$	#$WRT			; Output the message

90$:	MOV	(SP),CCW(SP)		; Restore return address
	ADD	#CCW,SP			; Clean stack
	RETURN				; Return to call site

	.dsabl	lsb

	.Sbttl	12) Trap handling module.
	.enabl	lsb
 
;	This module attempts to save the handler and allows
;	it to to a gracefull exit in the event of an
;	internal error. This will hopefully keep
;	the system from crashing in the event of a
;	handler abort. Currently, the old SP is restored,
;	all registers are dumped and output to the log
;	file, the handler declares itself non-resident,
;	and does a normal exit.
 
TRPHND::
	MOV	SP,TS+2			; Save the current SP
	BMI	12$			; MI - then bad stack
	MOV	(SP)+,TS+4		; Start to save crash info
	MOV	(SP)+,TS+6		; save old PC and PSW
12$:	MOV	TS,SP			; Reset the stack
	MOV	R0,TS+10		; Save the general registers
	MOV	R1,TS+12		; ...
	MOV	R2,TS+14		; ...
	MOV	R3,TS+16		; ...
	MOV	R4,TS+20		; ...
	MOV	R5,TS+22		; ...

;	Now set up to call $EDMSG to format the
;	output string for us.
 
	MOV	#BUF,R0			; Point to the output area
	MOV	#TRPDMP,R1		; Point to the format string
	MOV	#TS+2,R2		; Point to the parameter block
	CALL	$EDMSG			; Format the message
 
	CALL	UNSFID			; Restore the file ID
	OFNB$A	#LGFDB			; Open the output file
	PUT$	,#BUF,R1		; Output the crash string
	CALL	CLSFIL			; Close the output file
 
;	Now declare ourselves non-resident and exit
	
	JMP	$EXIT			; Go to exit code
	.dsabl	lsb
 
	.sbttl	13) OPNERR	--	Display file open error message
 
;	This routine assumes that R0 contains the address
;	of the FDB that has the error. No registers are
;	destroyed by this routine.
 
OPNERR:	PUSH	<R0,R1,R2>		; Save work registers
	CLR	R1			; Clear out junk
	MOVB	F.ERR(R0),R1		; Get Error code -> R1
	PUSH	R1			; Set up argument list
	MOV	#BUF,R0			; Point to output area -> R0
	MOV	#CRERR,R1		; Point to format string -> R1
	MOV	SP,R2			; Point to argument list -> R2
	CALL	$EDMSG			; Format string
	TST	(SP)+			; Clear off argument list
	PRINT	#BUF,R1,#40		; Output error message to CO:
	POP	<R2,R1,R0>		; Retore registers
	RETURN				; Return to caller

	.END
