; Filename: PROGS.SBR Date: 12/12/90

;*************************** AMUS Program Label ******************************
; Filename: PROGS.SBR Date: 12/12/90
; Category: UTIL Hash Code: 655-435-373-670 Version: 1.1(101)
; Initials: ULTR/US Name: DAVID PALLMANN
; Company: ULTRASOFT CORPORATION Telephone #: 5163484848
; Related Files:
; Min. Op. Sys.: AMOSL 1.3B/AMOS32 1.0 Expertise Level: BEG
; Special:
; Description: Return program names (and, optionally, job names) to BASIC
!*****************************************************************************
;****************************************************************************
;* *
;* PROGS.SBR *
;* AlphaBASIC XCALL to return program names of all jobs on the system *
;* *
;****************************************************************************
;Copyright (C) 1990 UltraSoft Corporation. All Rights Reserved.
;
; MAP1 JOB'COUNT, F, 6
; MAP1 PROG'NAME(x), S, 6
; MAP1 JOB'NAME(x), S, 6 <- optional
; ...
; XCALL PROGS, JOB'COUNT, PROG'NAME(1) {,JOB'NAME(1)}
;
; sets JOB'COUNT to the number of jobs on the system
; returns PROG'NAME(1) through PROG'NAME(JOB'COUNT) with program names
;
; if specified, JOB'NAME(1) through JOB'NAME(JOB'COUNT) receives the
; name of each job. This third parameter is optional.
;
;Written by: David Pallmann
;
;Edit History:
;1.0(100) 29-Aug-90 created. /DFP
;1.1(101) 12-Dec-90 add optional third argument to return job names. /DFP

VMAJOR =1
VMINOR =1
VSUB =0
VEDIT =101.
VWHO =0

OBJNAM .SBR

SEARCH SYS
SEARCH SYSSYM

;XCALL argument list - indexed by A3

.OFINI
.OFDEF X.ARGS, 2 ; number of arguments
.OFDEF X.TYP1, 2 ; arg 1 - type code
.OFDEF X.ADR1, 4 ; - address
.OFDEF X.SIZ1, 4 ; - size
.OFDEF X.TYP2, 2 ; arg 2 - type code
.OFDEF X.ADR2, 4 ; - address
.OFDEF X.SIZ2, 4 ; - size
.OFDEF X.TYP3, 2 ; arg 3 - type code [101]
.OFDEF X.ADR3, 4 ; - address [101]
.OFDEF X.SIZ3, 4 ; - size [101]

;XCALL variable types

.OFINI
.OFDEF X.UNF, 2 ; binary
.OFDEF X.STR, 2 ; string
.OFDEF X.FLT, 2 ; float
.OFDEF X.BIN, 2 ; unformatted

X.ARY =16.

;***********
;* START *
;***********

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

;check validity of arguments

CHECK: CMPW X.ARGS(A3),#2 ; 2 or more arguments supplied? [101]
JLO CNTERR ; no - error [101]
CMPW X.TYP1(A3),#X.FLT ; arg 1 floating point?
JNE TYPERR ; no - error

MOVW X.TYP2(A3),D7 ; get 2nd argument type
ANDW #^C<X.ARY>,D7 ; clear array bit
CMPW D7,#X.STR ; arg 2 string?
JNE TYPERR ; no - error

CMPW X.ARGS(A3),#3 ; are there 3 arguments?
BLO 10$ ; no
MOVW X.TYP3(A3),D7 ; get 3rd argument type
ANDW #^C<X.ARY>,D7 ; clear array bit
CMPW D7,#X.STR ; arg 3 string?
JNE TYPERR ; no - error
MOV X.ADR3(A3),A4 ; set index A4

;index job table, initialize job count, and set index to array

10$: MOV JOBTBL,A0 ; index jobn table
CLR D5 ; clear job count
MOV X.ADR2(A3),A2 ; index return array

;main loop of program

LOOP: MOV (A0)+,D7 ; get next JCB address
BEQ LOOP ; deallocated job
CMP D7,#-1 ; end of job table?
JEQ RETURN ; yes
MOV D7,A6 ;
INC D5 ; update job count

;check for job at AMOS command level

MOV A6,D4 ; save JCB address for later
MOVW JOBSTS(A6),D6 ; get job status
ANDW #J.MON,D6 ; at AMOS command level?
BNE CLRPRG ; yes - return empty string

;convert program name to ASCII

LEA A1,JOBPRG(A6) ; index program name
UNPACK ; return
UNPACK ; program name
CALL TRIM ; remove trailing spaces [101]
BR CHKJOB ; [101]

;job is at AMOS - clear program name [101]

CLRPRG: MOV #6-1,D6 ; [101]
10$: CLRB (A2)+ ; [101]
DBF D6,10$ ; [101]

;if a third argument was specified, also return job name

CHKJOB: CMPW X.ARGS(A3),#3 ; 3rd argument specified? [101]
JLO LOOP ; no [101]

;convert job name to ASCII

SAVE A2 ; save registers [101]
MOV A4,A2 ; set-up A2 for UNPACKing [101]
MOV D4,A6 ; restore JCB address [101]
LEA A1,JOBNAM(A6) ; index program name [101]
UNPACK ; return [101]
UNPACK ; program name [101]
CALL TRIM ; remove trailing spaces [101]
MOV A2,A4 ; put back in A4 so we remember [101]
REST A2 ; restore registers [101]

JMP LOOP ; [101]

;pass back job count and return to BASIC program

RETURN: MOV X.ADR1(A3),A0 ; return
FLTOF D5,@A0 ; job count
RTN ; return

;error handling

CNTERR: TYPESP ?Argument count ;
BR ERROR ;

TYPERR: TYPESP ?Argument type ;

ERROR: TYPECR error in PROGS.SBR ;
RTN ;

;**********
;* TRIM *
;**********
;remove trailing spaces from 6-character string just output to buffer @A2

TRIM: MOV #6,D6 ;
MOV A2,A6 ;
5$: CMPB -1(A6),#40 ;
BNE 7$ ;
CLRB -(A6) ;
SOB D6,5$ ;
7$: BR 30$ ;
10$: MOV #6,D6 ;
20$: CLRB (A2)+ ;
SOB D6,20$ ;
30$: RTN ;

END