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

;** External Routines ******************************************

	SEARCH	SYS
	SEARCH	SYSSYM
	SEARCH	TRM

;** Offset Definitions *****************************************

;	use .OFDEFs to eliminate need to compute each address

.OFINI
.OFDEF	ARGCNT,2 			; argument count
.OFDEF	A1.TYP,2			; argument #1 type
.OFDEF	A1.IDX,4			; argument #1 index
.OFDEF	A1.SIZ,4			; argument #1 size

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

	CLRB	1(A2)			; yes - set 1st space to NUL

10$:	RTN				;return to AlphaBASIC

;****** Error Routines *****************************************

;	display argument error message & exit to AMOS			[103]

ARGERR:	MOVW	#<-1_8.>+37.,D1		;make sure
	TCRT				;  screen is on
	MOV	#7,D1			;ring terminal 
	TTY				;  bell
	TYPE	<?Argument error in XCALL JOBNAM.>

IF EQ,SELECT
	TYPE	<SBR>
ENDC

IF EQ,SELECT-1
	TYPE	<XBR>
ENDC

	TYPESP	< - Notify Tech Support>
	KBD				;get KBD input
	RTN				;return to AlphaBASIC

	END

;===========================================================================

.