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