;*************************** AMUS Program Label ******************************
; Filename: CTRLC.M68                                       Date: 11/29/89
; Category: SBR          Hash Code: 575-613-233-520      Version: 1.0(102)
; Initials: AMI/AM       Name: AMI BAR-YADIN
; Company: UNITED FASHIONS OF TEXAS, INC.          Telephone #: 5126312277
; Related Files:
; Min. Op. Sys.:                               Expertise Level: BEG
; Special:
; Description: BASIC subroutine to enable or disable Control-C on any or
; all jobs.
;
;*****************************************************************************
; (c) 1989 by Ami Bar-Yadin     AMI/AM
;
;
; Calling syntax:
; ---------------
;
; a)    XCALL CTRLC,<flag>
;====
;       This call enables or disables ctrl-c for the current job
;
; where:
;       <Flag> can be any numeric expression (float or B,1 thru B,4.  B,5 is not accepted)
;
;       If <Flag> is zero, ctrl-c is disabled for the current job,
;       otherwise ctrl-c is enabled
;
;
; b)    XCALL CTRLC,<flag>,<which'job>
;====
;       This call is where the fun begins.
;
; where:
;       <Flag> can be any numeric expression (float or B,1..B,5)
;
;       If <Flag> is zero, ctrl-c is disabled for the specified job(s)
;       otherwise ctrl-c is enabled.
;
;       <Which'job> is any string expression which selects the job to be
;       effected.  Case is not important as the string is converted to
;       uppercase.
;
;  NOTE:
;       <Which'job> must be null-terminated or at least 6 charaters
;       long.  A string can be forced to be null-terminated by using
;       the following syntax:
;               XCALL CTRLC,I,JOB'NAME+""
;
;       <Which'job> may be null (or contain only spaces),  the word ALL
;       or the name of a job.
;
;       If <which'job> is null the current job is selected, which is the
;       same as the first calling syntax.
;
;       If <which'job> is "ALL", all jobs on the system are effected.
;
;       Otherwise the job named by <which'job> is selected.
;       If <which'job> does not match any job in the system, nothing will
;       happen.
;
;
;
; Edit History:
; -------------

VMAJOR=1
VMINOR=0
VEDIT=102.

;
; [102] 29-Nov-89 Ami Bar-Yadin
;       Was not checking for a null string when using second format
;
; [101] 20-Nov-89 Ami Bar-Yadin
;       Created for ELEC/AM for release on AMUS network.
;
;
       SEARCH  SYS
       SEARCH  SYSSYM

       RADIX   16.             ; I LIKE HEX

       OBJNAM  .SBR

       DEFAULT $$MFLG,PV$RSM
       PHDR    -1,0,PH$REE!PH$REU      ; define header
                                       ; sbr is reentrant and reusable

;
; Register usage:
;       D0 =  <flag>, 0 to disable, non-zero to enable ctrl-c
;       A0 -> JCB of job to be effected
;       A2 -> <which'flag> string, if specified
;       D1 =  name of job in RAD50

;
; Define XCALL parameters block offsets
;
       .OFINI
       .OFDEF  COUNT,2
       .OFDEF  TYPE1,2
       .OFDEF  ADDR1,4
       .OFDEF  SIZE1,4
       .OFDEF  TYPE2,2
       .OFDEF  ADDR2,4
       .OFDEF  SIZE2,4


;
;=======
; start of executable code
;
CTRLC:
       CMPW    COUNT(A3),#1    ; check number of parameters in XCALL
       BLO     ERR1            ; need at least one parameter

       CALL    GETFLG          ; get value of flag into D0

       JOBIDX  A0              ; default to current job

       CMPW    @A3,#2          ; if <which'job> was not specified,
       BLO     DOJOB           ; just change the current job

; at this point we know that <which'job> was specified in the XCALL

       CMPW    TYPE2(A3),#2    ; make sure <which'job> is a string
       BNE     ERR2            ; if not give an error message

       MOV     ADDR2(A3),A2    ; get address of string from XCALL parameters
                               ; block into A2

       MOV     A4,A1           ; we'll use the free area BASIC gives us
                               ; and ASSUME it is a least 4 bytes long

       PACK                    ; convert ASCII string from @A2 to RAD50
       PACK                    ; RAD50 (2 words) and place at @A1

       MOV     @A4,D1          ; get the RAD50 job name
       BEQ     DOJOB           ; if job name is null, do current job   [102]

       CMP     D1,#[ALL]_16.   ; is it "ALL___"?
       BEQ     DOALL           ; YES, do all jobs

; at this point we have a job name in D1 which we need to locate

; search the system's job table for the named job
       MOV     JOBTBL,A6       ; get address of the job table
NXTJOB: MOV     (A6)+,D7        ; get address of JCB of next job
                               ; (use a data register so we can easily
                               ;  check for a null address)
       BEQ     NXTJOB          ; no job allocated here, get another
       CMP     D7,#-1          ; check for end of job table
       BEQ     EXIT            ; end of table, named job was not found
                               ; return to BASIC without doing a thing
       MOV     D7,A0           ; put address of JCB where we need it
       CMP     D1,JOBNAM(A0)   ; compare job's name to named job
       BNE     NXTJOB          ; if no match, try the next job

; at this point we have the <flag> value in D0 and the address of the
; JCB of the job to effect in A0
; (This is the only part of the whole routine that actually does anything)
DOJOB:
       MOVW    JOBTYP(A0),D6   ; get the job's "type" flags
       TST     D0              ; enable or disable ctrl-c?
       BNE     ENABLE          ; if <flag> is not zero, enable
       ANDW    #^CJ.CCA,D6     ; disable ctrl-c
       BR      UPDATE
ENABLE: ORW     #J.CCA,D6       ; enable ctrl-c
UPDATE: MOVW    D6,JOBTYP(A0)   ; update the JOB's type flags
EXIT:   RTN                     ; return to BASIC
                               ; (or the DOALL routine)

; the following routine is used when all jobs are to be effected

DOALL:
; scan the system's job table
       MOV     JOBTBL,A6       ; get address of the job table
1$:     MOV     (A6)+,D7        ; get address of JCB of next job
                               ; (use a data register so we can easily
                               ;  check for a null address)
       BEQ     1$              ; no job allocated here, get another
       CMP     D7,#-1          ; check for end of job table
       BEQ     EXIT            ; end of table, we're done
       MOV     D7,A0           ; put address of JCB where we can use it
       CALL    DOJOB           ; enable/disable ctrl-c for this job
       BR      1$

ERR1:
       TYPE    <?Missing parameter in>
       BR      ERROR
ERR2:
       TYPE    <?Type mismatch in 2nd parameter for>
       BR      ERROR
ERR3:
       TYPE    <?Type mismatch in 1st parameter for>
       BR      ERROR

ERROR:
       TYPECR  < XCALL CTRLC>  ; finish the error message
       EXIT                    ; and abort the running BASIC program


; this routine get the value of the first paramter
; and puts it in D0

GETFLG:
       MOV     ADDR1(A3),A6    ; get address of <flag> paramter
       CMPW    TYPE1(A3),#4    ; check if parameter is floating point
       BNE     1$
       FFTOL   @A6,D0          ; convert floating point parameter
       RTN
1$:     CMPW    TYPE1(A3),#6    ; check if parameter is binary
       BNE     ERR3            ; type mismatch on 1st parameter, not numeric
       MOV     SIZE1(A3),D6    ; get size of 1st paramter
       CMP     D6,#5           ; check length of parameter in bytes
       BHIS    ERR3            ; type mismatch on 1st parameter, a B,5 is not accepted
       ADD     D6,A6           ; compute pointer to byte past parameter
       CLR     D0              ; clear destination
       DEC     D6
2$:     LSL     D0,#8           ; prepeare for next byte
       MOVB    -(A6),D0        ; load next byte
       DBF     D6,2$           ; loop until done
       RTN


       END