;****************************************************************************
;*									    *
;*				   GETLOG				    *
;*		     AlphaBASIC subroutine to Get Login			    *
;*									    *
;****************************************************************************
;Copyright (C) 1988 UltraSoft Corp.  All Rights Reserved.
;
;Written by: David Pallmann
;
;Calling Format:  XCALL GETLOG, StringVar
;
;Returned: format is "Devn:[p,pn]", as in "DSK3:[100,1]"
;
;Compatibility: all releases of AMOS/L and AMOS/32
;
;Edit History:
;1.0(100)  06-Aug-88  created. /DFP

	VMAJOR=1
	VMINOR=0
	VEDIT=100.

	OBJNAM	.SBR

	ASMMSG	"== Generating GETLOG.SBR =="
	SEARCH	SYS
	SEARCH	SYSSYM

;****************************************
;*  XCALL argument list, indexed by A3  *
;****************************************

	.OFINI
	.OFDEF	COUNT,2			; number of arguments
	.OFDEF	TYPE1,2			; type of first argument
	.OFDEF	ADDR1,4			; address of first argument
	.OFDEF	SIZE1,4			; size of first argument

        STRING=2			; code for STRING argument

;*****************
;*  Entry Point  *
;*****************

GETLOG:	PHDR	-1,0,PH$REE!PH$REU	; reentrant, reusable
	CMPW	COUNT(A3),#1		; exactly one argument specified?
	JNE	CNTERR			;  no - error
	CMPW	TYPE1(A3),#STRING	; is argument a string?
	JNE	TYPERR			;  no - error
	CMP	SIZE1(A3),#16.		; is variable at least 16 bytes long?
	JLO	SIZERR			;  no - error

;**********************
;*  Set up registers  *
;**********************

SETUP:	MOV	ADDR1(A3),A2		; point A2 to argument
	JOBIDX	A4			; point A4 to Job Control Block

;********************************
;*  Save Radix and Force Octal  *
;********************************
;It is necessary to work in octal so that the OCVT call outputs PPNs in
;octal.  Save the user's original radix and restore it later to make this
;transparent.

SAVRDX:	MOVW	JOBTYP(A4),D5		; save job type word
	ANDW	#^C<J.HEX>,JOBTYP(A4)	; turn off hex bit

;************************
;*  Return Device Code  *
;************************
;A2 indexes start of return variable
;A4 indexes JCB

DEVICE:	LEA	A1,JOBDEV(A4)		; convert
	UNPACK				;  device code to ASCII
	CLR	D1			; clear all of D1
	MOVW	JOBDRV(A4),D1		; get drive number
	DCVT	0,OT$MEM		;  and output as printable decimal
	MOVB	#':,(A2)+		; output colon

;****************
;*  Return PPN  *
;****************
;A2 indexes current location in the return variable
;A4 indexes JCB

PPN:	MOVB	#'[,(A2)+		; output left bracket
	CLR	D1			; clear all of D1 again
	MOVB	JOBUSR+1(A4),D1		; get first part of PPN
	OCVT	0,OT$MEM		; output project number
	MOVB	#<',>,(A2)+		; output comma
	MOVB	JOBUSR(A4),D1		; get second part of PPN
	OCVT	0,OT$MEM		; output programmer number
	MOVB	#'],(A2)+		; output right bracket
	CLRB	@A2			; mark end of string

;****************************
;*  Restore Original Radix  *
;****************************
;D5 is original job type word

RESRDX:	MOVW	D5,JOBTYP(A4)		; back to hex or octal
	RTN				; return to BASIC program

;********************
;*  Error Handling  *
;********************

CNTERR:	TYPESP	?Argument count
	BR	ERROR
TYPERR:	TYPESP	?Argument type
	BR	ERROR
SIZERR:	TYPESP	?Argumnet size
ERROR:	TYPECR	error in GETLOG.SBR
	EXIT

	END

.