;*************************** AMUS Program Label ******************************
; Filename: JOBNUM.M68                                      Date: 1/19/93
; Category: SBR          Hash Code: 676-133-712-251      Version: 1.0(100)       
; 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; MUST be LNKLIT'd
; Description: AlphaBASIC SBR to return AMOS job & parent job names given
; the job number w/in the job table; can be used w/XLOCK.SBR to find the
; name of the job which has a lock set; see also CTLJOB.M68 & JOBTRM.M68
;*****************************************************************************
;JOBNUM.M68
;===========================================================================
;
;          Return job name & controller job for a job table entry
;
;===========================================================================
;                         Alpha Clean Systems, Inc
;                             224 S Second St
;                             Rogers, AR 72756
;                              (501) 636-8188
;===========================================================================
; Usage:
;
;	XCALL JOBNUM, jobnum, jobnam, ctljob
;
; Where:
;	jobnum = job number w/in JOBTBL and is either
;		 F,6 or B,1 or B,2
;
;	jobnam = AMOS job name and is a string var at least
;		 6 bytes long
;
;	ctlnam = AMOS job name of controller job if job is running
;		 under MULTI.  Must be a string at least 6 bytes long.
;
;	"jobnam" & "ctljob" will be returned with trailing spaces
;	stripped.  If jobnum <= 0 or is not a valid job table entry,
;	then jobnam will be returned set to null.  If job is not
;	running under MULTI, then ctljob will be set to null.
;
;===========================================================================
; Revision History
; === Vers 1.0 ===
; [100] 07-Mar-89 - adapted from "old" NUMNAM.SBR /saa
;===========================================================================

	OBJNAM	.SBR

	VMAJOR	= 1
	VMINOR	= 0
	VSUB	= 0
	VEDIT	= 100.

;== External Routines ======================================================

	SEARCH	SYS
	SEARCH	SYSSYM
	SEARCH	TRM

	EXTERN	$GTARG

;== Offsets ================================================================

;	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
.OFDEF	A2.TYP,2			; argument #2 type
.OFDEF	A2.IDX,4			; argument #2 index
.OFDEF	A2.SIZ,4			; argument #2 size
.OFDEF	A3.TYP,2			; argument #3 type
.OFDEF	A3.IDX,4			; argument #3 index
.OFDEF	A3.SIZ,4			; argument #3 size

;== Macros =================================================================

;	UNPACKs 4 RAD50 chars into 6 ASCII; nulls 1st space in string

DEFINE	DEPACK	arg
	MOV	arg(A3),A2		;index job name arg in BASIC
	LEA	A1,JOBNAM(A0)		;point A1 to RAD50 job name	
	UNPACK				;unpack 1st half of job name
	UNPACK				;unpack 2nd half of job name
	MOVB	#-1,D0			;init space cnt to pre-increment

10$$:	INCB	D0			;pre-increment space cnt
	CMPB	-(A2),#40		;are we at a space?
	BEQ	10$$			; yes - decrement arg index

	TSTB	D0			;were there any spaces?
	BEQ	20$$			;no - so go on

	CLRB	1(A2)			;yes - set 1st space to NUL
20$$:
	ENDM

;== Main Routine ===========================================================

START:	PHDR	-1,0,PH$REE!PH$REU

;	s/b 3 arguments, 1st s/b F or B,1 or B,2; 2nd & 3rd s/b min of S,6

	CMPW	ARGCNT(A3),#3		;are there 3 arguments?
	JNE	ARGERR			; no

	CMPW	A2.TYP(A3),#2		;is arg-2 a string
	JNE	ARGERR			; no

	CMP	A2.SIZ(A3),#6		;is it at least 6 bytes	long
	JLO	ARGERR			; no

	CMPW	A3.TYP(A3),#2		;is arg-3 a string
	JNE	ARGERR			; no

	CMP	A3.SIZ(A3),#6		;is it at least 6 bytes	long
	JLO	ARGERR			; no

	CMPW	A1.TYP(A3),#4		;is arg-1 floating pt.?
	BNE	10$			;no - go check for binary
	
;	arg-1 is F-type so convert to binary

	MOV	#A1.TYP,D1		;yes - so convert to
	CALL	$GTARG			;      binary in D1
	JNE	ARGERR			;error in $GTARG, go report it

	BR	JOBNUM			;go get jobnam

;	check for B,1 or B,2

10$:	MOV	A1.IDX(A3),A6		;point to argument
	CMPW	A1.TYP(A3),#6		;is arg-1 a binary?
	JNE	ARGERR			;no - go report error

	CMP	A1.SIZ(A3),#1		;is arg-1 a B,1?
	BNE	20$			;no - see if it's a B,2

	MOVB	(A6),D1			;get the value into D1
	BR	JOBNUM			;go get jobnam

20$:	CMP	A1.SIZ(A3),#2		;is arg-1 a B,2?
	JNE	ARGERR			;no - error out

	MOVW	(A6),D1			;get job number into D1

;	get the job name

JOBNUM:	MOV	A2.IDX(A3),A2		;pre-set job name
	CLRB	@A2			; to NUL
	MOV	A3.IDX(A3),A2		;pre-set ctl job
	CLRB	@A2			; to NUL
	TSTB	D1			;is job # > 0?
	BLE	EXIT			;no - get out

	MOV	JOBTBL,A0		;point A0 to the job table
	DECB	D1			;calculate offset
	MUL	D1,#4			;  into job table
	ADD	D1,A0			;    for job # per arg-1
	MOV	(A0),A0			;point A0 to the job's JCB
	MOV	A0,D0			;is it a valid JOBTBL entry?
	BLE	EXIT			;no - get out

	DEPACK	A2.IDX			;convert job name to ASCII

;	check for controller job

	MOV	JOBATT(A0),D0		;get controller job
	BEQ	EXIT			;none so exit

;	get controller job name

	MOV	D0,A0			;get controller job address
	DEPACK	A3.IDX			;convert ctl job to ASCII

EXIT:	RTN				;return to AlphaBASIC

;== Error Routines =========================================================

;	display argument error message & exit to AMOS

ARGERR:	MOVW	#<-1_8.>+37.,D1		;make sure
	TCRT				;  screen is on
	MOV	#7,D1			;ring terminal 
	TTY				;  bell
	TYPESP	<?Argument error in XCALL JOBNUM.SBR - Notify Tech Support>
	KBD				;get KBD input
	RTN				;return to AlphaBASIC

	END

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

.