;*************************** 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
; 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