;SETSTS.SBR
;
; Copyright (C) 1994 by Jeff Kreider, Consultant
;
; Provided "as is" for use by AMUS members for any purpose except
; for resale. For conditions of resale, contact:
;
; Jeff Kreider, Consultant
; 210 N. Iris Ave
; Rialto, CA 92376-5727
; (909) 874-6214
;
; Permission for resale will be granted only in writting.
;
;This routine assembles on 2.x systems and the resulting SBR will run on
; any system 1.3B or later. It will not assemble properly on the 1.x
; O/S, however, due the the length of some of the symbol names. The
; can not be longer than 6 characters on the 1.x O/S
;
;Sample set up and usage within AlphaBASIC:
;
;MAP1 SET'STATUS
; MAP2 SET'RADIX,B,1,1
; MAP2 SET'ECHO,B,1,2
; MAP2 SET'DSKERR,B,1,3
; MAP2 SET'VERIFY,B,1,4
; MAP2 SET'GUARD,B,1,5
; MAP2 SET'CTRLC,B,1,6
; MAP2 SET'DIRECT,B,1,7
; MAP2 SET'LOCK,B,1,8
; MAP2 SET'RESULT,B,1 ! Returns -1 for formating error
; ! good results depend on call
; ! RADIX 0 = OCTAL
; ! 1 = HEX
; ! ECHO 0 = ECHO
; ! 1 = NOECHO
; ! THE REST
; ! 0 = NOT SET
; ! 1 = SET
;
;XCALL SETSTS,SET'ECHO,SET'RESULT
;IF SET'RESULT<0 PRINT "ERROR IN FORMAT" : END
;IF SET'RESULT = 0 THEN &
; PRINT "ECHO IS SET" &
; ELSE &
; PRINT "NOECHO IS SET"
;
;END
;
SEARCH SYS
SEARCH SYSSYM
SEARCH TRM
OBJNAM 0,0,[SBR] ; change to XBR for BASIC Plus
; or COMPLP with /S option
;
; AlphaBASIC XCALL argument block format
;
OFINI
OFDEF XC.ARG,2 ; number of args
OFDEF XC.TYP1,2 ; 1 type
OFDEF XC.ADR1,4 ; 1 address
OFDEF XC.SIZ1,4 ; 1 size
OFDEF XC.TYP2,2 ; 2 type
OFDEF XC.ADR2,4 ; 2 address
OFDEF XC.SIZ2,4 ; 2 size
OFSIZ XC.SIZ ; size of list
XC$UNF=0 ; symbol for unformatted
XC$STR=2 ; symbol for string
XC$FLT=4 ; symbol for floating point
XC$BIN=6 ; symbol for binary
;
;
VMAJOR=1
VMINOR=0
VSUB=0
VEDIT=100.
PHDR -1,PV$RSM,PH$REU!PH$REE
SETSTS: CMPW XC.ARG(A3),#2 ; enough args?
JEQ 10$ ; yes
TYPECR <?Insufficient arguments passed to SETSTS.SBR>
EXIT
10$: CMPW XC.TYP1(A3),#XC$BIN ; is parm a binary?
JEQ 20$ ; yes
15$: TYPECR <?Wrong variable type in SETSTS.SBR>
EXIT
20$: CMPW XC.TYP2(A3),#XC$BIN ; is second parm a binary?
JNE 15$ ; no
CMP XC.SIZ1(A3),#1 ; one byte?
JEQ 30$ ; yep
25$: TYPECR <?Wrong size of variable in SETSTS.SBR>
EXIT
30$: CMP XC.SIZ2(A3),#1 ; size check on second
JNE 25$ ; oops
MOV XC.ADR1(A3),A1 ; get request var
MOV XC.ADR2(A3),A2 ; get return var
CLRB @A2 ; set default
CLR D0 ; clear upper bits on request
CLR D2 ; clear upper bits on jobtyp
JOBIDX ; get JCB
MOVW JOBTYP(A6),D2 ; get job type
MOVB @A1,D0 ; get request
CMPB D0,#1 ; radix?
JEQ RADIX ; yes
CMPB D0,#2 ; echoing?
JEQ ECHO ; yes
CMPB D0,#3 ; dskerr?
JEQ DSKERR ; yes
CMPB D0,#4 ; verify?
JEQ VERIFY ; yes
CMPB D0,#5 ; guard?
JEQ GUARD ; yes
CMPB D0,#6 ; ctrlc?
JEQ CTRLC ; yes
CMPB D0,#7 ; redirection?
JEQ DIRECT ; yes
CMPB D0,#8. ; locking
JEQ LOCKING ; yes
MOVB #-1,@A2 ; format error
EXIT: RTN ; return to basic
EXIT2: MOVB #1,@A2 ;
RTN
RADIX: ANDW #J.HEX,D2 ; is hex set?
JEQ EXIT ; no, is octal (default)
JMP EXIT2 ; yes
ECHO: CLR D2 ; get rid of status
TRMRST D2 ; get terminal status word
ANDW #T$ECS,D2 ; echo suppressed?
JEQ EXIT ; no, ECHO is SET
JMP EXIT2 ; yes
DSKERR: ANDW #J.DER,D2 ; is DSKERR SET?
JEQ EXIT ; no
JMP EXIT2 ; yes
VERIFY: ANDW #J.VER,D2 ; is VERIFY SET?
JEQ EXIT ; no
JMP EXIT2 ; yes
GUARD: ANDW #J.GRD,D2 ; is GUARD SET?
JEQ EXIT ; no
JMP EXIT2 ; yes
CTRLC: ANDW #J.CCA,D2 ; is CTRLC SET?
JEQ EXIT ; no
JMP EXIT2 ; yes
;
;SET REDIRECTION and SET LOCK are supported only on 2.2 and later
; This routine checks only that the O/S supports 2.0 and later.
; If used on 2.x system prior to 2.2, these options will probably
; return a NOT SET condition.
;
DIRECT: MOV SYSTEM,D7 ; get system bit
AND #SY$EXD,D7 ; 2.x?
JNE 10$ ; yes, valid call
MOVB #-1,@A2 ; not valid call
JMP EXIT
10$: MOVW JOBTY2(A6),D2 ; Get second job type
ANDW #J2$RED,D2 ; redirection set?
JEQ EXIT ; no
JMP EXIT2 ; yes
LOCKING:
MOV SYSTEM,D7 ; get system bit
AND #SY$EXD,D7 ; 2.x?
JNE 10$ ; yes, valid call
MOVB #-1,@A2 ; not valid call
JMP EXIT
10$: ANDW #J.NLK,D2 ; locking set?
JNE EXIT ; yes
JMP EXIT2 ; no
