;*************************** AMUS Program Label ******************************
; Filename: CTLJOB.M68 Date: 1/19/93
; Category: SBR Hash Code: 165-552-504-177 Version: 1.0(104)
; Initials: ML/AM Name: Steve Ash
; Company: Alpha Clean Systems, Inc. Telephone #: 5016368188
; Related Files:
; Min. Op. Sys.: 1.xD(?) Expertise Level: INT
; Special: may not assemble using pre-2.0 assembler
; Description: AlphaBASIC SBR to return AMOS job name or parent job name if
; running under MULTI; see also JOBNUM.M68/.SBR & JOBTRM.M68/.SBR
;
;*****************************************************************************;*; Updated on 19-Jan-93 at 2:12 PM by Steve Ash; edit time: 0:05:32
;CTLJOB.M68
;===========================================================================
;
; Get job name from AlphaBASIC or Parent/Control job name if running Multi
;
;===========================================================================
; Alpha Clean Systems, Inc
; 224 S Second St
; Rogers, AR 72756
; (501) 636-8188
;===========================================================================
; Usage:
;
; XCALL JOBNAM, jobnam
;
; Where:
; jobnam = AMOS job name and is a string var at least
; 6 bytes long
;
; "jobnam" will be returned with trailing spaces stripped.
;
;===========================================================================
; Revision History
; === Vers 1.0 ===
; [100] 01-Jun-85 - initial release /ACS
; [101] 03-Jul-87 - added support for MULTI spawned jobs /saa
; [102] 16-Sep-88 - fix pblm w/NULLing out 1st byte past arg if arg
; contains no spaces /saa
; [103] 16-Sep-88 - add argument checking /saa
; [104] 09-Oct-90 - add conditional assembly code for .SBR/.XBR /wda
;===========================================================================
VMAJOR = 1
VMINOR = 0
VSUB = 0
VEDIT = 104.
NVALU SELECT
IF EQ,SELECT
ASMMSG /=== Assembling .SBR version ===/
OBJNAM .SBR
ENDC
IF EQ,SELECT-1
ASMMSG /=== Assembling .XBR version ===/
OBJNAM .XBR
ENDC
;** Main Routine ***********************************************
START: PHDR -1,0,PH$REE!PH$REU
; s/b 1 string argument at least 6 bytes long
CMPW ARGCNT(A3),#1 ;is there 1 argument? [103]
BNE ARGERR ; no [103]
CMPW A1.TYP(A3),#2 ;is arg-1 a string [103]
BNE ARGERR ; no [103]
CMP A1.SIZ(A3),#6 ;is it at least 6 bytes long? [103]
BLO ARGERR ; no [103]
; get the job name
JOBIDX A6 ;index JCB
MOV JOBATT(A6),D6 ;get controller job [101]
BEQ 10$ ;none so go get JOBNAM [101]
MOV D6,A6 ;get owner job address [101]
10$: LEA A1,JOBNAM(A6) ;point A1 to RAD50 job name
MOV A1.IDX(A3),A2 ;index JOBNAM argument in BASIC
UNPACK ;unpack 1st half of job name
UNPACK ;unpack 2nd half of job name
MOVB #-1,D0 ;init space cnt to pre-increment[101]
TRIM: INCB D0 ;pre-increment space cnt [102]
CMPB -(A2),#40 ;are we at a space?
BEQ TRIM ; yes - decrement arg index
TSTB D0 ;were there any spaces? [102]
BEQ 10$ ; no - so exit [102]
