;*; Updated on 29-Nov-89 at 11:00 AM by Creed A. Erickson; edit time: 0:19:19
;
; XPPN.M68 (XPPN.SBR)
;
;	AlphaBasic XCALL subroutine which returns the user's ppn
;	and optionally the user's device, job name, and terminal name.
;	This program is called as follows:
;
;	XCALL XPPN,PPN{,DEVICE{,JOBNAM{,TRMNAM}}}
;
;	Where the arguments are set up as follows:
;
;	10	MAP1 PPN
;	20		MAP2 PROJECT,B,2
;	30		MAP2 PROGRAMMER,B,2
;	40	MAP1 DEVICE,S,6
;	50	MAP1 JOBNAM,S,6
;	60	MAP1 TRMNAM,S,6
;	70	
;	80 	XCALL XPPN,PPN,DEVICE,JOBNAM,TRMNAM
;	90 
;	100	PRINT
;	110	PRINT "   LOG: "DEVICE"["STR(PROJECT)","STR(PROGRAMMER)"]"
;	120	PRINT "JOBNAM: "JOBNAM
;	130	PRINT "TRMNAM: "TRMNAM
;	140	PRINT
;	200	END
;
;	NOTE:	The ppn numbers will be returned as decimal
;	but they will represent the octal numbers, so no conversions
;	are neccessary.
;
; Edit History (most recent first):
;
; Edit     Date		What, who, why
; ====  =========       ===================================================
; 101	28-Nov-89 	Modified to correct bugs:
;
;			1) Was not reentrant, corrected CONVRT subroutine
;				to use a stack based buffer for reentrancy.
;			2) Termination of names (job name, terminal name)
;				could walk on byte following the return
;				variable IF unpacked name was 6 bytes long.
;
;						 Creed Erickson, PACE, Inc.
;
; 100	24-Jan-83	Converted to AM100/L:
;
;			1) Added args for job name and trm name.
;			2) Correct PPN if J.HEX is correct.
;
;						John Keys, (202) 872-4538
;
; Orig	29-Jan-79	Written	by Mike Sigona for the AM100.
;


 	SEARCH SYS
	SEARCH SYSSYM

	OBJNAM	XPPN.SBR

; Version specification for the program header...
;
	VMAJOR	=	1
	VMINOR	=	0
	VEDIT	=	101.

; Handy little equates...
;
	SPACE$	=	40		; ASCII space character
	COLON$	=	72		; ASCII colon character (:).

; Define argument offsets from A3 argument list index.
;
.OFINI

.OFDEF	ARGCNT,2			; Argument count.
   
.OFDEF	A1.TYP,2			; Argument #1 type.
.OFDEF	A1.IDX,4			; Argument #1 index.
.OFDEF	A1.SIZ,4			; Argument #1 size.
.OFDEF	A2.TYP,2			; Argument #2 type.
.OFDEF	A2.IDX,4			; Argument #2 index.
.OFDEF	A2.SIZ,4			; Argument #2 size.
.OFDEF	A3.TYP,2			; Argument #3 type.
.OFDEF	A3.IDX,4			; Argument #3 index.
.OFDEF	A3.SIZ,4			; Argument #3 size.
.OFDEF	A4.TYP,2			; Argument #4 type.
.OFDEF	A4.IDX,4			; Argument #4 index.
.OFDEF	A4.SIZ,4			; Argument #4 size.

; Start of code...
;
GETPPN:	PHDR	-1,0,PH$REE!PH$REU	; Logged in, re-entrant, re-usable.
	JOBIDX	A0			; Index this job's JCB.
	MOV	A1.IDX(A3), A5		; Get argument #1's address.
	MOVW	JOBUSR(A0), D0		; Get the currently logged in PPN.
	CALL	CONVRT			;  Convert number.
	MOVW	D1, 2(A5)		;  Store in result variable.
	LSRW	D0, #8.			; Shift high byte to low byte.
	CALL	CONVRT			;  Convert number.
	MOVW	D1, @A5			;  Store in result variable.
	
; Check for a second argument and return device/drive if provided.
; NOTE: This code assumes the result is big enough.
;
GETDEV:	CMPW	ARGCNT(A3), #2		; Second arg provided?
	BLO	BACK			;  No, all done.
	MOV	A2.IDX(A3), A2		; Index the result variable.
	LEA	A1, JOBDEV(A0)		; Index the RAD50 device name.
	UNPACK				; Unpack to ASCII (A1 to A2).
	CLR	D1			; Preclear unit number.
	MOVW	JOBDRV(A0), D1		; Get the unit (drive) number.
	DCVT	0,OT$MEM		; Cvt to ASCII @A2.
 	MOVB	#COLON$, (A2)+		; Append a colon character.
	MOV	A2, D7			; Take string ending address.
	SUB	A2.IDX(A3), D7		;  Less string starting address.
	CMPW	D7, A2.SIZ(A3)		; Compare str size to variable size.
	BHIS	GETJOB			;  No more space left.
	CLRB	@A2			;  Space left, terminate string.

GETJOB:	CMPW	ARGCNT(A3), #3		; Third argument provided?
	BLO	BACK			;  No, all done.
 	LEA	A1, JOBNAM(A0)		; Index the JCB name.
	MOV	A3.IDX(A3), A2		; Index the result variable.
	MOVW	A3.SIZ(A3), D0		; Get the size.
	CALL	UPCKIT			; Unpack the job name.

GETTRM:	CMPW	ARGCNT(A3), #4		; 4th argument?
	BLO	BACK			;  No, all done.
	MOV	JOBTRM(A0), A1		; Index the job's TCB.
	SUB	#4, A1			; Index the job's terminal name.
	MOV	A4.IDX(A3), A2		; Index the result variable.
	MOVW	A4.SIZ(A3), D0		; Get the size.
	CALL	UPCKIT			; Unpack the terminal name.

BACK:	RTN				; Return to caller.
	
; CONVRT
;
; Subroutine to simulate octal numbers in decimal.
; Performs conversion by a) converting octal to string, b) GTDEC on string.
;
; Passed:
;
;	A0	=> This job's JCB.
;	D0	:= Byte to be converted.
;
; Returns:
;
;	D1	:= Converted value (entire longword is valid).
;
; Registers A0-A5, D0, D2-D5 are all preserved.
;
CONVRT:	SAVE	A2, D5			; Save caller's registers.
	MOVW	JOBTYP(A0), D5		; Save job type flags.
	ANDW	#^C<J.HEX>, JOBTYP(A0)	; Clear hex flag.
	PUSH	#0			; Push dummy to stack (alloc buff).
	MOV	SP, A2			;  Index the buffer.
	MOVB	D0, D1			;  Get the number to convert.
	AND	#377, D1		;  Mask off low byte.
	OCVT	3, OT$MEM		;  Output as ASCII to buffer.
	CLRB	@A2			;  Terminate the buffer.
	MOV	SP, A2			;  Reindex the buffer.
	GTDEC				;  Get as decimal number.
	POP				; Pop dummy off stack (zap buffer).
	MOVW	D5, JOBTYP(A0)		; Restore job type word.
	REST	A2, D5			; Restore caller's registers.
	RTN				; Return to caller.
	
; UPCKIT
; Subroutine to unpack a LWORD RAD50 name to ASCII.
; Result is stripped of trailing spaces.
;
; Passed:
;
;	A1	=> RAD50 LWORD value to unpack.
;	A2	=> Buffer to receive the ASCII string.
;	D0	:= Size of the destination buffer (word value).
;	
; Returned:
;
;	Buffer @A2 has been loaded with the unpacke string.
;
; All registers A0-A5, D0-D5 are preserved.
;
UPCKIT:	SAVE	A1, A2			; Save caller's registers.
	UNPACK				; Unpack to ASCII.
	UNPACK				;  Both halves of it.
	CMPW	D0, #6			; More than six characters?
	BLOS	20$			;  No.
10$:	CLRB	@A2			; Terminate the string.
20$:	CMPB	-(A2), #SPACE$		; Is last character a space?
	BEQ	10$			;  Yes, keep stripping.
	REST	A1, A2			; Restore caller's registers.
	RTN				; Return to caller.

	END	


.