;*************************** AMUS Program Label ******************************
; Filename: PROGS.SBR                                       Date: 04/20/90
; Category: UTIL         Hash Code: 522-273-702-257      Version: 1.1(102)
; 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, and now user
; 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.
; Username code added Copyleft 1993 Bob Rubendunst, Soft Machines.
;
;       MAP1 JOB'COUNT, F, 6
;       MAP1 PROG'NAME(x), S, 6
;       MAP1 JOB'NAME(x), S, 6                  <- optional
;       MAP1 USER'NAME(x), S, 20                <- also optional
;               ...
;       XCALL PROGS, JOB'COUNT, PROG'NAME(1) {,JOB'NAME(1)} {,USER'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.
;
;       if specified, USER'NAME(1) through USER'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
;[102] 20 April 1993 15:05      Edited by Bob Rubendunst, Soft Machines.
;       Added user name array code.
;

       VMAJOR  =1
       VMINOR  =1
       VSUB    =0
       VEDIT   =102.
       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]
       .OFDEF  X.TYP4, 2               ; arg 4 - type code             [102]
       .OFDEF  X.ADR4, 4               ;       - address               [102]
       .OFDEF  X.SIZ4, 4               ;       - size                  [102]

;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
       CMPW    X.ARGS(A3),#4           ; are there 4 arguments?
       BLO     10$                     ;   no
       MOVW    X.TYP4(A3),D7           ; get 4th argument type
       ANDW    #^C<X.ARY>,D7           ; clear array bit
       CMPW    D7,#X.STR               ; arg 4 string?
       JNE     TYPERR                  ;   no - error
       MOV     X.ADR4(A3),D2           ; set index D2

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

CHKUSN: CMPW    X.ARGS(A3),#4           ; 4th argument specified?       [102]
       JLO     LOOP                    ;   no                          [102]

       SAVE    A2
       MOV     D2,A2                   ; use A2 as index
; copy user name to array [102]
       MOV     #19.,D0                 ; get max size of username field
       MOV     X.SIZ4(A3),D1           ; get size of array element
       MOV     D4,A6                   ; index jcb
       LEA     A6,JOBUSN(A6)           ; index job user name (null terminated)
20$:    MOVB    (A6)+,D7                ; get a byte
       BEQ     40$                     ;   end of username.
       MOVB    D7,(A2)+                ; copy to array
       DEC     D1                      ; count down element bytes remaining
       BEQ     40$                     ;   end of element
       SOB     D0,20$                  ; until whole name scanned or null
40$:    TST     D1                      ; room for null?
       BEQ     60$                     ;   no, done
       CLRB    (A2)+                   ;   yes, append null to terminate string
       DEC     D1                      ; count while we null & space out
       BR      40$                     ; and loop till we hit next element
60$:    MOV     A2,D2                   ; save array ptr for next elemnet
       REST    A2                      ; end [102]
       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

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.