;*************************** AMUS Program Label ******************************
; Filename: JOBUSN.M68                                      Date: 4/11/90
; Category: UTIL         Hash Code: 776-245-035-570      Version: 102            
; Initials: BOB/AM       Name: BOB RUBENDUNST
; Company: SOFT MACHINES                           Telephone #: 2173517199
; Related Files: NONE
; Min. Op. Sys.:                               Expertise Level: BEG
; Special: 
; Description: Basic subroutine, returns user name
; 
; 
;*****************************************************************************
; JOBUSN.M68 - Source for BASIC XCALL to return the AMOS SYSTEM USER NAME
; in a string variable.
; Donated to AMUS by Soft Machines, P.O. Box 3701, Champaign, IL 61821
; Permission is granted to use this subroutine as long as it is provided free
; of charge.

; AMUS users: From "the dot", enter the command M68 JOBUSN to produce
; JOBUSN.SBR, and place it in DSK0:[7,6].

; Usage: XCALL JOBUSN,STRING$
; JOBUSN returns the job user name in STRING$, if it is defined.
; If O/S does not support JOBUSN, STRING$ will contain "%%%%%%%%%%%%%%%%%%%"

; edit history:
;[102] 11 April 1990 12:28	Edited by Bob Rubendunst     
;	modified max size to 19 bytes per 2.0 monitor calls manual
;	added test for proper variable type (string or unformatted)
;	included required contents of SUBR.M68
;	added simple documentation in this file
;	donated to AMUS
;[101] 22 September 1989 17:11	Edited by Bob Rubendunst
;	Added %%%%%%%%%%%%%%%%%%% message id JOBUSN not supported.
;[100] 26 April 1989 14:16	Edited by Bob Rubendunst
;	Implemented


	SEARCH	SYS
	SEARCH	SYSSYM
; layout of BASIC argument list
	ASECT
.=0
SBRCNT:	BLKW	1
TYPE1:	BLKW	1
ADDR1:	BLKL	1
SIZE1:	BLKL	1
TYPE2:	BLKW	1
ADDR2:	BLKL	1
SIZE2:	BLKL	1
TYPE3:	BLKW	1
ADDR3:	BLKL	1
SIZE3:	BLKL	1
TYPE4:	BLKW	1
ADDR4:	BLKL	1
SIZE4:	BLKL	1
TYPE5:	BLKW	1
ADDR5:	BLKL	1
SIZE5:	BLKL	1
TYPE6:	BLKW	1
ADDR6:	BLKL	1
SIZE6:	BLKL	1
TYPE7:	BLKW	1
ADDR7:	BLKL	1
SIZE7:	BLKL	1
TYPE8:	BLKW	1
ADDR8:	BLKL	1
SIZE8:	BLKL	1
.=0
PSECT


	OBJNAM	0,0,[SBR]

; header defines
;;	VMAJOR =1
;;	VMINOR =0
;;	VSUB = 'L-'@
	VEDIT = 102.
;;	VWHO =100


; At entry, A3 indexs the BASIC (or BP) argument stack
SBRUSN:	PHDR	-1,PV$RSM!PV$WSM,PH$REE!PH$REU
	MOVW	TYPE1(A3),D7		; get variable type bits
	AND	#^B1111,D7		; toss array & undefined bits
	CMPB	D7,#2			; is it a string or unformatted?
	BHI	10$			;  no, float or binary
	CMPW	SBRCNT(A3),#1		; right # of args?
	BEQ	20$			;  yes, ok
; user must have this XCALL confused with another.
10$:	TYPECR	<?JOBUSN.SBR requires ONE string argument.>
	EXIT				; drop to the dot on fatal errors

; By definition, JOBUSN is supposed to be 19 bytes max followed by a null,
; so let's limit the transfer to 19 bytes maximum.
20$:	MOV	SIZE1(A3),D0		; get size of variable
	BEQ	100$			;  nothing to write to!
	MOV	D0,D2			; dupe size for later test
	CMP	D0,#19.			; is variable larger than JOBUSN?
	BLOS	40$			;  no
	MOV	#19.,D0			;  yes-limit the transfer
40$:	MOV	ADDR1(A3),A2		; make A2 ==> BASIC string
; use %%%... message if O/S doesn't support JOBUSN
; Easy way to figure out system version to check job entry size word
; in monitor. (This word grows larger as new features are added to O/S.)
; JOBUSN is in AMOS/L 1.3 or later, or any AMOS/32 O/S.
; Thanks to Tom Faust of Software Designs for this handy idea.
	LEA	A6,NOUSN		; presume JOBUSN not supported
	CMPW	JOBESZ,#^O3546		; compare job entry size to required
	BLO	50$			;  O/S doesn't support JOBUSN
	JOBIDX				;  does support it, make A6 ==> JCB
	LEA	A6,JOBUSN(A6)		; index the user name in the JCB area
50$:	CLR	D1			; clear transfer byte count
	MOV	#1,D7			; just clear the Z flag for DBcc entry
	BR	70$

; transfer the user name to the BASIC variable, counting each byte
60$:	ADD	#1,D1			; count bytes copied
	MOVB	(A6)+,(A2)+		; copy the user name byte by byte
70$:	DBEQ	D0,60$			; stop on D0=0 or null
; adjust count if last byte xferred was a null
	BNE	80$			;  was not a null
	DEC	D1			;  was a null, adjust count,
	DEC	A2			;  and A2==> null
	BEQ	90$			;  nothing to strip
; strip trailing spaces, if any
80$:	CMPB	-(A2),#^O40		; trailing space?
	BNE	85$			;  no
	CLRB	@A2			; yes-make it a null
	DEC	D1			; yes-count down
	BNE	80$			;  more possible nulls
85$:	INC	A2			; adjust for last pre-decrement
90$:	SUB	D1,D2			; did we fill up whole BASIC string?
	BLOS	100$			;  yes, no terminator allowed
	CLRB	@A2			;  no, terminate string
100$:	RTN				; return to BASIC	


NOUSN:	ASCII	"%%%%%%%%%%%%%%%%%%%%"	; string for old O/Ss
	END END END			; easier to search for than just END