	.TITLE EFN
	.IDENT /V1.0X/
.REM |
	Program EFN --

	A program to manipulate Global (and Group Global) event flags (EFNs).
	Options include SET/CLEAR single or multiple flags, display changes
	(was set/clear) or not, display all/global/group global flag states.
	Normal output to TI:, but can be put (with timestamp) to a file.
	Can take input from indirect file (e.g., EFN @foo), but only one
	level of nesting supported. Returns exit status codes for use with
	ICP. In short, does everything but wash dishes and do windows. 
	So, use paper plates, and leavt windows to the wimpy MS-DOS jocks.


	Version: 1.0x
	File: sy42:[300,2]EFN.MAC
	Author: Jim Bostwick
	History:
	Last Edit: 3-OCT-1986 01:14:52 
|

	.ENABLE LC
	.MCALL GCMLB$,GCML$,CSI$,CSI$1,CSI$2,QIOW$,EXST$S,SETF$,CLEF$
	.MCALL RDXF$,DIR$,FDOF$L,FSRSZ$,FHDOF$,NBOFF$,NMBLK$,FDOP$A
	.MCALL ALUN$S, FINIT$,CSI$SW,CSI$SV,CSI$ND, GTIM$S
	.NLIST ME
	.NLIST BEX


	.SBTTL CONSTANTS


;;DEBUG = 0		; uncomment for debug code
;;DBDMP = 0		; uncomment (with debug) for internal Database dump


MAXFLG = 6		; number of switches per flag 
			; note: /xB allow max of MAXFLG(MOD(2))
obl = 144.		; output buffer width
nslot = 5		; is xxx messages per line - 80. col
wslot = 8.		; is xxx messages per line - 132. col

;
; PROFLG bits. These bits control which set/clear operations have
; been requested. Also, some internal control bits. 
; 

p.s = 1		; /s switch in command line
p.c = 2		; /c switch
p.d = 4		; /d switch
p.sb = 10	; /sb switch
p.cb = 20	; /cb switch
p.db = 40	; /db switch
p.rang = 1000	; 1-> doing ranges
p.ggrq = 2000	; 1-> user want's to change group globals

;
; DSPFLG bits. These bits control display options
;

d.q = 1		; /q switch (1->quiet)
d.l = 2		; /l switch (1->list defaults, 0->list nothing)
d.sy = 4	; /sy switch (1->list system flags)
d.gr = 10	; /gr switch (1->list group global flags)
d.g =  20	; /g switch (1->list user global flags)
d.ngg = 200	; 1-> no group globals
d.crt = 400	; 1-> TI: is a CRT
d.vrb = 1000	; timestamp output, print comments and command lines
d.usag = 2000	; 1-> usage message has been sent
d.lin1 = 4000	; 1-> do line one output
d.hds  = 10000	; 1-> header line printed

	.SBTTL LOCAL MACROS



	.MACRO PUSH ARGS
	.IRP ARG,<ARGS>
	MOV ARG,-(SP)
	.ENDM
	.ENDM

	.MACRO POP ARGS
	.IRP ARG,<ARGS>
	MOV (SP)+,ARG
	.ENDM
	.ENDM

	.MACRO CALL NAME,REG,ARGS
	.IF NB <REG>
	JSR REG,NAME
	.IFF
	JSR PC,NAME
	.ENDC
	.IF NB <ARGS>
	.IRP ARG,<ARGS>
	.WORD ARG
	.ENDM
	.ENDC
	.ENDM

	.MACRO RETURN REG
	.IF NB <REG>
	RTS REG
	.IFF
	RTS PC
	.ENDC
	.ENDM

;
; CALVEC sets up a call to DOVEC, and issues error message if
; DOVEC returns carry set
;
	.MACRO CALVEC LTR,msg,op,?L1
	bit 	#p.'ltr', proflg		; anything to do?
	beq	l1			; no skip
	mov	#'ltr'vec, r1
	'op'	#p.rang, proflg		; set range flag
	call	dovec
	bcc	l1
	call	err,r5,<msg>
	jmp	procer
l1:
	.endm

; 
; Cstfmt sets up and calls stfmt 
; 
	.MACRO Cstfmt LTR,?L1
	bit	#p.'ltr', proflg	; anything changed?
	beq	l1			; no, branch
	mov	#'ltr'vec, r4		; point to vector
	clr	r5			; no first flag
	call	stfmt
	bcs	psterr				
l1:
	.endm

;
; Flush sets up call to flushb
;  it defaults to OUTBUF, unless buffer parameters supplied
;  Parameters
;	adr - address of buffer to be output
;	len - **ADDRESS** which contains buffer length
;

	.macro	flush, adr, len
	.if nb	<adr>
	mov	adr, -(sp)
	.iff
	mov	#outbuf, -(sp)
	.endc
	.if nb	<len>
	mov	len, -(sp)
	.iff
	mov	#buflen, -(sp)
	.endc
	jsr	pc, flushb
	.endm
		
	.SBTTL LOCAL DATA

	.PSECT DATA
	.even
EXSTAT:	.WORD 1		; exit status - success assumed
MSSET:	.word 0		; holds address of '? set' string 
MSCLR:	.word 0		; holds address of '? clear' string
BUFADR:	.word 0		; pointer into outbuf
BUFLEN:	.word 0		; current length of outbuf
INBUF:	.BLKB	80.	; command input buffer
OUTBUF:	.BLKB obl	; general output buffer - oversize due to many
			; escape sequences in flag status display...
SLOTS:	.byte 0		; number of output slots available 
ASLOTS:	.byte 0		; slots per line (depends on ti: width)
	.EVEN
;
; GMCBUF is used in SF.GMC call to determine command terminal type and width
;
GMCBUF:	.BYTE	TC.SCP	; CRT Terminal?
	.byte	0
	.byte	TC.WID	; terminal buffer width
OBUFW:	.byte 	0
GMCLEN=.-GMCBUF

;
;** keep these together!
;
SVEC:	.BLKW	maxflg	; one word per flag to be set
	.WORD	0	; guard word
CVEC:	.BLKW	maxflg	; one word per flag to be clear
	.WORD	0	; guard word
DVEC:	.BLKW	maxflg	; one per flag to be displayed (only)
	.WORD	0	; guard word
SBVEC:	.BLKW	2*<maxflg/2>	; range pairs for set between
	.WORD	0	; guard word
CBVEC:	.BLKW	2*<maxflg/2>	; range pairs for clear between
	.WORD	0	; guard word
DBVEC:	.BLKW	2*<maxflg/2>	; range pairs for display between
	.WORD	0	; guard word
FLGVEC:	.BLKW	64.	; one word per flag was xxx status 
PROFLG:	.word	0	; process control flags
DSPFLG:	.word	0	; display control flags
; *** keep above lines together!!

RDXBUF:	.BLKW 	6.	; buffer for RDXF$ directive 
TIMBUF:	.blkw	8.	; buffer for GTIM$
ARGBLK:	.blkw	20.	; general use arguement block for $EDMSG

	.PSECT

	.SBTTL CSI	


; Comand line macros and data blocks

	.PSECT DATA,D,LCL,RW
GCLBLK:	GCMLB$	1,EFN,INBUF,1,,164.
	CSI$
	.EVEN
CSIBLK:	.BLKB	C.SIZE	
	.EVEN

	.PSECT
;
; CSI parser info - switch table, etc...
;

SWTAB:	CSI$SW S,p.s,proflg,SET,,pstab,EXACT
	CSI$SW C,p.c,proflg,SET,,pctab,EXACT
	CSI$SW D,p.d,proflg,SET,,pdtab,EXACT
	CSI$SW SB,p.sb,proflg,SET,,psbtab,EXACT
	CSI$SW CB,p.cb,proflg,SET,,pcbtab,EXACT
	CSI$SW DB,p.db,proflg,SET,,pdbtab,EXACT
	CSI$SW Q,d.q,dspflg,SET,NEG,,EXACT
	CSI$SW L,<d.l!d.g!d.gr>,dspflg,SET,NEG,,EXACT
	CSI$SW SY,d.sy,dspflg,SET,NEG,,EXACT
	CSI$SW GR,d.gr,dspflg,SET,NEG,,EXACT
	CSI$SW G,d.g,dspflg,SET,NEG,,EXACT
	CSI$SW V,d.vrb,dspflg,SET,NEG,,EXACT
	CSI$ND

PSTAB:	CSI$SV DECIMAL,SVEC,2
	CSI$SV DECIMAL,SVEC+2,2
	CSI$SV DECIMAL,SVEC+4,2
	CSI$SV DECIMAL,SVEC+6,2
	CSI$SV DECIMAL,SVEC+10,2
	CSI$SV DECIMAL,SVEC+12,2
	CSI$ND

PCTAB:	CSI$SV DECIMAL,CVEC,2
	CSI$SV DECIMAL,CVEC+2,2
	CSI$SV DECIMAL,CVEC+4,2
	CSI$SV DECIMAL,CVEC+6,2
	CSI$SV DECIMAL,CVEC+10,2
	CSI$SV DECIMAL,CVEC+12,2
	CSI$ND

PDTAB:	CSI$SV DECIMAL,DVEC,2
	CSI$SV DECIMAL,DVEC+2,2
	CSI$SV DECIMAL,DVEC+4,2
	CSI$SV DECIMAL,DVEC+6,2
	CSI$SV DECIMAL,DVEC+10,2
	CSI$SV DECIMAL,DVEC+12,2
	CSI$ND

PSBTAB:	CSI$SV DECIMAL,SBVEC,2
	CSI$SV DECIMAL,SBVEC+2,2
	CSI$SV DECIMAL,SBVEC+4,2
	CSI$SV DECIMAL,SBVEC+6,2
	CSI$SV DECIMAL,SBVEC+10,2
	CSI$SV DECIMAL,SBVEC+12,2
	CSI$ND

PCBTAB:	CSI$SV DECIMAL,CBVEC,2
	CSI$SV DECIMAL,CBVEC+2,2
	CSI$SV DECIMAL,CBVEC+4,2
	CSI$SV DECIMAL,CBVEC+6,2
	CSI$SV DECIMAL,CBVEC+10,2
	CSI$SV DECIMAL,CBVEC+12,2
	CSI$ND

PDBTAB:	CSI$SV DECIMAL,DBVEC,2
	CSI$SV DECIMAL,DBVEC+2,2
	CSI$SV DECIMAL,DBVEC+4,2
	CSI$SV DECIMAL,DBVEC+6,2
	CSI$SV DECIMAL,DBVEC+10,2
	CSI$SV DECIMAL,DBVEC+12,2
	CSI$ND


	.SBTTL FILE IO


; FILE I/O STUFF
;
; Reserve FCS space, for CSI use
;
	FSRSZ$ 2

;
; **** OUTPUT FILE SUPPORT NOT YET IMPLEMENTED ****
;

	.SBTTL DPBS


	.PSECT DPBS

;*** don't separate following lines ***
QIOADR=.+q.iopl			; address of buffer address in dpb
QIOLEN=qioadr+2			; address of buffer length in dpb
QIOVFC=qiolen+2			; address of vfc word in dpb
QIODPB:	QIOW$ IO.WVB,2,2,,,,<0,0,40>	;write to TI:
;*** don't separate preceeding lines ***

GMCDPB:	QIOW$ SF.GMC,2,2,,,,<GMCBUF,GMCLEN>	; get ti: characteristics
RDXDPB:	RDXF$ RDXBUF			; read extended EFNs 
SETDPB:	SETF$				; set a flag
CLRDPB: CLEF$				; clear a flag

	.PSECT

	.SBTTL MESSAGES

	.PSECT DATA
ERM1:	.asciz	/EFN -- Error reading command line/<7>
ERM2:	.ASCIZ 	/EFN -- Syntax Error/<7>
ERM3:	.asciz	/EFN -- Range flags must be in pairs!/<7>
ERM4:	.asciz	/EFN -- Illegal Flag Number/<7>
ERM5:	.asciz	/EFN -- System Flags may not be altered!/<7>
ERM6:	.asciz	/EFN -- Log File Open Failure/<7>
ERM7:	.asciz	/EFN -- Failed to Set Flag/<7>
ERM10:	.asciz	/EFN -- Failed to Clear Flag/<7>
ERM11:	.asciz	/EFN -- Error Reading Flags/<7>
ERM12:	.asciz	/EFN -- Output Error!/<7>
ERM13:	.asciz	/EFN -- Group Globals Not Available/<7>
ERM14:	.asciz	/EFN -- Error Getting Time!/<7>

; USAGE is a message with very brief syntax info
USAGE:	.ascii	<15><12>/USAGE --/<15><12>/        EFN /
	.ascii ~[outf][/switches]~
	.ascii	<15><12><12>/output filespec is log file, default=ti:/
	.ascii	<15><12>/switches -- up to 6 individual flags or 3 pairs/
	.ascii	<15><12>/      S:n[:n:n..] - set flag(s)/
	.ascii	<15><12>/      C:n[:n:n..] - clear flag(s)/
	.ascii	<15><12>/      D:n[:n:n..] - display flag(s)/
	.ascii	<15><12>/      SB:m:n[:o:p..] - /
	.ascii	/set flag(s) between m and n [and o-p]/
	.ascii	<15><12>/      CB:m:n[:o:p..] - /
	.ascii	/clear flag(s) between m and n [and o-p]/
	.ascii	<15><12>/      DB:m:n[:o:p..] - /
	.ascii	/display flag(s) between m and n [and o-p]/
	.ascii	<15><12><12>/display control -- default is "wax xxx" only/
	.ascii  <15><12>/   [-]Q - quiet (no "was xxx")/
	.ascii  <15><12>/   [-]L - list all user global, group global flags/
	.ascii  <15><12>/   [-]SY - list system global flags/
	.ascii  <15><12>/   [-]GR - list group global flags/
	.asciz 	<15><12>/   [-]G  - list user global flags/<15><12>

; IMSGx are info messages
IMS1:	.asciz	/EFN -<INFO>- Creating new log file./<7>
IMS2:	.asciz	/Group Global flags not present for this UIC/

; DMSGx are debugging and test messages
	.if df debug
DMS1:	.ASCIZ	/it is a comment/
DMS2:	.asciz	/csi$1 went OK/
DMS3:	.asciz	/csi$2 went OK/
DMS4:	.asciz	/is a CRT/
DMS5:	.asciz	/Database Dump/<12>
	.endc

;
; EDMSG input strings - used with $EDMSG to format output
; xEDn: are input strings
; xARn: are arguement blocks
;
	.if df debug
SNAM:	.asciz	/ SVEC/		; vector names in ascii
CNAM:	.asciz	/ CVEC/
DNAM:	.asciz	/ DVEC/
SBNAM:	.asciz	/SBVEC/
CBNAM:	.asciz	/CBVEC/
DBNAM:	.asciz	/DBVEC/

DED1:	.asciz	/PROFLG: %P	DSPFLG: %M/
DED2:	.asciz	/%I: %6Q/
	.endc

;
; Header formatting. If output is to a file or hardcopy terminal,
; timestamp it.  
;
;	NOTE: Use TIMBUF as ARGBLK for $EDMSG with OFHDR as input
;		string.
;

OFHDR:	.asciz	/        EFN -- %Y   %3Z/

;
; Output format strings. These are used for the flag display.
; They are copied to output buffer, then flags not set are blanked
; out. There are two sets, the xxL are 132. column format, others
; are for 80 column. 
; OFVx point to beginning of flag strings, for use by DISPLY. These
; must point to first char of ascii flag number. 

OFUG:
OFUGL:	.ascii	/global: /
OFV33=.-ofugl		; offset to flag 33
	.ascii	/33 34 35 36 37 38 39 40 41 42 43 44 /
	.asciz	/45 46 47 48 49 50 51 52 53 54 55 56/
OFL=.-OFUG
	.if lt obl-ofl
	.error ofl ;Output buffer too small!
	.endc
OFSY:
OFSYL:	.ascii	/system: /
OFV57=.-ofsyl		; offset to flag 57
	.asciz	/57 58 59 60 61 62 63 64/
OFL=.-OFSY
	.if lt obl-ofl
	.error ofl ;Output buffer too small!!
	.endc

OFGR:	.ascii	/ group: /
OFV65=.-ofgr		; offset to flag 65
	.asciz	/65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80/
OFL=.-OFGR
	.if lt obl-ofl
	.error ofl ;Output buffer too small!!
	.endc

OFGR2:	.ascii	/        /
OFV77=.-ofgr2		; offset to flag 81
	.asciz	/81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96/
OFL=.-ofgr2
	.if lt obl-ofl
	.error ofl ;Output buffer too small!!
	.endc

OFGRL:	.ascii	/ group: /
OFV65L=.-OFGRL		; offset to first flag
	.ascii	/65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 /
OFV77L=.-OFGRL		; offset to flag 81
	.asciz	/81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96/
ofl=.-ofgrl
	.if lt obl-ofl
	.error ofl ;Output buffer too small!!
	.endc

;
; IS/WAS status messages:
;  These messages are output along with set,clear,and display commands.
;  IS form is used with display commands, WAS form with set or clear.
;

ISSET:	.asciz	/is SET/
ISCLR:	.asciz	/is CLEAR/
WASSET:	.asciz	/was SET/
WASCLR:	.asciz	/was CLEAR/

;
; set, clear, display output formatting
;  if it makes sense, we put some 'is/was' messages out on same line
;  with command, first copying input command to output buffer. OFCOPY
;  does this.
; OFSTAT does message for one flag. Note: OFCOPY is not terminated,
;  so also calls OFSTAT when it is used.
;

; **** don't separate next two lines ***
OFCOPY:	.asciz	/EFN>%VA/
OFSPC:	.asciz	/%VS->/
OFSTAT:	.asciz	/%16< f%M %I%16>/

	.EVEN

	.PSECT

	.SBTTL DEBUG SUBROUTINES


	.if df debug
.rem |
	DMPVEC is a local routine which sets up the $EDMSG arguement
	block for the flag vectors, calls $EDMSG, and then outputs
	the formatted string. 

	call	jsr,pcdsarg
	input	
		r4 -> vector name string
		r5 -> vector
	output
		formatted string output using QIODPB
	registers
		uses all registers!
		ignores QIO errors!
|

DMPVEC:	
	mov	#DED2, r1
	mov	#argblk, r2
	mov	r4, (r2)+
	mov	#maxflg, r0	; value counter
10$:	mov	(r5)+, (r2)+	; copy vector to argblk
	sob	r0, 10$
	mov	#outbuf, r0
	mov	#argblk, r2	; restore argblk pointer
	call	$EDMSG
	mov	r1, qiolen	; set length
	dir$	#qiodpb
	; ignore errors!
	return
;
; local macro to ease call to DVEC
;
	.macro cdvec ltr
	mov	#'ltr'nam, r4
	mov	#'ltr'vec, r5
	call	dmpvec
	.endm

.rem  |
	DUMPDB dumps out the internal database. This is used for debugging
	only. 

	INPUT none
	OUTPUT formatted listing
	REGISTERS
		uses r0,r1,r2,r3

|

DUMPDB:
	call	err,5,<0,DMS5>
	mov	#outbuf, qioadr ; set address of output buffer
					; NOTE: this won't change 
	mov	#argblk, r2		; set up for $edmsg
	mov	proflg, (r2)		; dump proflg,dspflg value
	mov	dspflg, 2(r2)
	mov	#outbuf, r0
	mov	#DED1, r1
	call	$edmsg
	mov	r1, qiolen	; set output length
	dir$	#qiodpb
	; ignore errors!
;
; now call DVEC once per flag vector
;
	cdvec s
	cdvec c
	cdvec d
	cdvec sb
	cdvec cb
	cdvec db
	return
	.endc

	.SBTTL ERR - Print (error) message to TI:


.REM |
	ERR is the error output subroutine. It takes an exit status
	parameter. The max of this value and the current EXSTAT value
	is saved in EXSTAT. Always returns Carry SET.
	QIO error results in immediate exit with status of 4.
	Calls Flushb to flush outbuf. 

	CALL:
		JSR R5 xERR
		.WORD exstat
		.WORD <message address>

	INPUT:

	OUTPUT:
		Error message printed to TI:
		returns CARRY SET

	REGISTERS:
		all are preserved
|

ERR:	flush
	push	<r0>
	mov	(r5)+, r0		; get exit status
	cmp	r0, exstat		
	blos	err1
	mov	r0, exstat		; save new exit status
ERR1:
	mov	(r5)+, r0		; r0 -> message, adjust return PC
	mov	r0, QIODPB+Q.IOPL	; msg pointer to DPB
10$:	tstb	(r0)+			; find length of message
	bne	10$
	sub	qiodpb+q.iopl, r0	; calculate length
	mov	r0, qiodpb+q.iopl+2	; length to DPB
	dir$	#qiodpb			; send message
	bcc	20$
	exst$s	#4			; die on errors 
20$:	pop	<r0>
	sec				; set carry
	return	r5

	.SBTTL STRCPY - copy asciz string


.REM |
	STRCPY copies one ASCIZ string to another, computing length
	as it goes. 

	CALL:	jsr,r5 strcpy
		.word	str1	- input string address
		.word	str2	- output string address
	INPUT:	none
	OUTPUT: r0= next avail byte of output string (this is a null byte)
		r1= length of string (not counting terminating null)
	REGISTERS:
		uses r0,r1 others preserved
	ERRORS: none
|

STRCPY:
	mov	(r5)+, r1	; r1-> input string
	mov	(r5), r0	; r0-> output string
10$:	movb	(r1)+, (r0)+	; copy a byte
	bne	10$
	mov	r0, r1		; compute length
	sub	(r5)+, r1	; compute length
	return	r5

	.SBTTL FLUSHB - Print (or PUT$) buffer	
.REM |
	FLUSHB provides centralized buffer output for either
	terminal or (when implemented) file output. 
	When OUTBUF is being processed, does some checks and 
	formatting tricks. 
	
	CALL	jsr pc, flushb

	INPUT	 on stack:
		(sp) = return address
		2(sp) = <address of length>
		4(sp) = <address of buffer>

	OUTPUT 	buffer written to output
		SPECIAL CASE: if address=outbuf, reset bufadr, buflen
		return carry set on error (after outputting error msg)

	REGISTERS all preserved

|

FLUSHB:
	mov	4(sp), qioadr	; address to dpb
	mov	@2(sp), qiolen	; length to dpb
	beq	600$		; nothing to do - br
	cmp	4(sp), #outbuf	; working on outbuf?
	bne	500$		; no - br
	bit	#d.lin1, dspflg ; doing first line?
	beq	500$		; no - br
	bit	#d.crt, dspflg	; output to crt?
	beq	500$		; no -br
	movb	#'+, qiovfc	; set overprint
	bic	#d.lin1, dspflg	; done with line1
	br	510$

500$:	movb	#40, qiovfc	; set normal carriage control
510$:	dir$	#qiodpb		; do it
	bcc	600$
	call	err, r5,<2,erm12>	; shriek output error
	mov	(sp), 4(sp)	; adjust return address
	add	#4, sp		; clean up stack
	sec
	br	1000$

600$:	cmp	#outbuf, 4(sp)	; working outbuf?
	bne	700$
	mov	#outbuf, bufadr	; reset buffer
	clr	buflen

700$:	mov	(sp), 4(sp)	; adjust return address
	add	#4, sp		; clean up stack
	clc
1000$:	return

	.SBTTL DOHDR - Format and output Header Line 
.REM |
	DOHDR obtains date-time from system, formats and outputs
	a header line. This is always done if output is to a file,
	also if Verbose switch is true. 

	CALL	jsr pc, dohdr
	INPUT   none
	OUTPUT	none
		carry set on error (gtim$ or qio )
	REGISTERS uses r0, r1, r2

|

DOHDR:
	gtim$s	#timbuf		; get date and time
	bcc	40$
	call	err,r5,<4,erm14>	; oops - quit while behind
	br	100$
40$:	mov	#outbuf, r0	; set up for edmsg
	mov	#ofhdr, r1
	mov	#timbuf, r2
	call	$edmsg		; format header
	mov	r1, buflen	; set output length
	flush
	bis	#d.hds, dspflg		; mark did header

100$:	return

	.SBTTL CKRANG - Range Check flag vector 


.REM |
	CKRANG determines that the flags in vector pointed to by r0
	are legal. Returns CC if legal, CS if not. Range given by
	bits in r1 as follows:

		b0 = 1-> disallow system flags
		b1 = 1-> checking ranges (must be pairs of flags)
	Call
		jsr r5,ckrang
		.word vecadr
	Input
		r1 = control bits
	Output
		CS on error, else CC
		R0 points past flag list
	Registers
		uses r0, r2, r3
|

CKRANG: 
	mov	(r5)+, r0	;get vector initial address
				; and clean return stack
	mov	r0, r3		; save vector pointer
	tst	(r0)		; flag specified?
	beq	550$		; nothing to do
50$:	cmp	#96., (r0)
	blo	600$		; flag too high
	cmp	#33., (r0)
	bhi	600$		; flag too low
	cmp	#64., (r0)	; check for a group global
	bhis	60$		; not group global - br
	bis	#p.ggrq, proflg	; remember asked for group globals
60$:	bit	#1, r1		; checking for system flags?
	beq	150$		; nope - branch	
	cmp	#64., (r0)	; check again
	blo	150$		; ok - branch
	cmp	#57., (r0)
	bhi	150$		; ok - branch
100$:	call	err,5,<3,ERM5>	; shriek about system flags
	br 	650$		
150$:	tst	(r0)+		; bump pointer
	tst	(r0)		; check end of list
	bne	50$		; keep checking

	; at end of list, are we checking for pairs too?
	bit	#2, r1		; want range check?
	beq	550$		; nope - all done
	sub	r3, r0		; r0 = number of words checked
	bit	#3, r0		; must be multiple of 4
	beq	200$		; ok - branch
	call	err,5,<3,ERM3>	; shriek about pairs
	br	650$

200$:	; check each pair, reversing as needed
	; all pairs end up in ascending order
	mov	r3, r0	; point at beginning of vector
210$:	cmp	(r0), 2(r0)	; test a pair
	blos	220$		; ok - skip
	mov	(r0), r2	; swap 
	mov	2(r0), (r0)
	mov	r2, 2(r0)
220$:	add	#4, r0		; point to next pair
	tst	(r0)		; done?
	bne	210$		; no - loop

	bit	#1, r1		; sys flags ok?
	beq	550$		; ok, skip check

	mov	r3, r0		; point at beginning of vector
250$:	cmp	#57., (r0)+	; 1st flag below sys flags?
	blo	450$		; no - 1st flag > sys - branch
	cmp	#57., (r0)+	; 2nd flag also below sys flags?
	blo	100$		; no - shriek about sys flags
	br	500$		; test passes, on to next pair

450$:	; 1st flag above sys, so 2nd must be too
	cmp	#65., (r0)+
	bhi	100$		; shriek about sys flags
500$:	; one pair passes
	tst	(r0)		; more pairs?
	bne	250$		; yup, branch

550$:	clc
	br	700$
600$:	call	err,5,<3,ERM4>	; shriek illegal flag number
650$:	sec
700$:	return 	r5


	.SBTTL CHKFLG -- Validate flag ranges


.REM |
	CHKFLG validates the input flags, and ranges. It required
	that all /S,/C,/SB,/CB flags lie between 33.-57. or 65.-96.
	and that all /D and /DB flags lie between 33.-96.
	Outputs error message on detecting bad flag. Aborts on first
	bad flag detected. 

	Input: NONE
	OUTPUT: error message on bad flags
	Registers: uses r0, r1, r2
	Calls CKRANG as a local subroutine
|

CHKFLG:	
	bic	#p.ggrq, proflg		; assume doesn't want ggs
	mov	#1, r1			; no system flags!
	call	ckrang,5,svec
	bcs	100$
	call	ckrang,5,cvec
	bcs	100$	
	bis	#2, r1			; ranges, no sys flags
	call	ckrang,5,sbvec
	bcs	100$
	call	ckrang,5,cbvec
	bcs	100$
50$:	clr	r1			; no ranges, allow system flags
	call	ckrang,5,dvec
	bcs	100$
	mov	#2, r1			; ranges, allow sys flags
	call	ckrang,5,dbvec
	bcs	100$

	bit	#d.ngg, dspflg		; group globals avail?
	beq	110$			; yes - br
	bit	#p.ggrq, proflg		; want to change group globals?
	beq	110$			; no - ok, br
	call	err,5,<3,erm13>		; shriek ggs not avail
	br 	100$

100$:	sec
110$:	return

	.SBTTL STFMT - Format Is/Was Status


.rem |
	STFMT fills the output buffer with 'is/was' messages.
	It processes flags until the current flag vector is exhausted.
	Caller must put appropriate pointers in MSSET, MSCLR prior
	to call. These are the messages which will be copied to output
	buffer. 

	* We examine p.rang to determine if ranges are being processed.
	* We continue formatting and printing (thru FLUSH) buffers 
	  until vector is exhausted.
	** We DO NOT flush the final buffer (unless everything comes
	   out even). 

	CALL	jsr,pc STFMT

	INPUT
		r4 -> command flag vector (SVEC, CVEC, etc.)

	OUTPUT
		carry set if error detected (by flush)
		messages formatted and printed as necessary
		possibly dirty output buffer
		r4 -> flag vector (points to null terminator) 

	REGISTERS

|

STFMT:	mov	bufadr, r0	; point to current position in outbuf
	mov	#argblk, r2	
	br	70$		; always get first flag
50$:	bit	#p.rang, proflg	; doing ranges?
	bne	100$		; yes - branch
70$:	mov	(r4)+, r5	; get next flag (or low flag of range)
	beq	700$		; no more - exit

100$:	mov	r5, r3		; copy flag #
	mov	r3, (r2)+	; stuff in argblk
	asl	r3		; *2 for byte offset
	sub	#<2*33.>, r3	; r3=offset into FLGVEC
	cmp	#is.set, flgvec(r3)	; flag set?
	beq	150$		; set - branch
	mov	msclr, (r2)+	; stuff clear string address in argblk
	br	200$

150$:	mov	msset, (r2)+	; stuff set string address in argblk

200$:	mov	#ofstat, r1	; set up $edmsg
	mov	#argblk, r2	; reset argument block pointer
	call	$edmsg		; format output
	mov	#argblk, r2	; reset argument block pointer
	add	r1, buflen	; accumulate outbuf length

; done with one flag

	decb	slots		; one less slot in outbuf
	bne	210$		; more slots avail - br
	flush			; flush buffer
	bcs	700$		; abort on error
	movb	aslots, slots	; reset slot count
	mov	bufadr, r0	; and buffer pointer

210$:	bit	#p.rang, proflg	; doing ranges?
	beq	50$		; no - loop

	cmp	r5, (r4)	; at end of range?
	beq	250$		; yes - br
	inc	r5		; bump flag number
	br	100$		; and loop

250$:	tst	(r4)+		; bump vector pointer
	br	70$		; and loop

700$:	mov	r0, bufadr	; save buffer pointer
	return

	.SBTTL DOVEC - set or clear flags

.REM |
	These routines are called by PROCES to set, clear, and display
	status of flags. 
|

.REM |
	DOVEC
	This routine executes a SET or CLEAR for flags in an input 
	vector. It returns immediately on error. Flag status ($DSW)
	is saved in FLGVEC for each flag processed. 

	CALL 	jsr pc, dovec

	INPUT	r0 -> DPB  (must be SETF$ or CLEF$)
		r1 -> input vector (zero terminated)
		
	OUTPUT	r1 -> zero terminator of input vector

	ERRORS
		cc - none
		cs - directive error (error message NOT printed)

	REGISTERS
		uses R2, R3
|

DOVEC:
	mov	(r1)+, r2	; get flag
	beq	500$		; done - exit
100$:	mov	r2, s.etef(r0)	; flag number to dpb
	dir$	r0		; execute
	bcs	700$		; exit on error
	mov	r2, r3		; copy flag #
	sub	#33., r3	; make relative to FLGVEC
	asl	r3		; make word offset
	mov	$DSW, FLGVEC(r3)	; save status
	bit 	#p.rang, proflg		; doing ranges?
	beq	dovec		; nope, loop

	inc	r2		; bump flag number
	cmp	r2, (r1)	; check against high number
	blos	100$		; not done, branch
	tst	(r1)+		; bump pointer
	bne	dovec		; and loop
500$:	clc
700$:	return


	.SBTTL DSPVEC - Perform Display Command


.rem |
	DSPVEC sets up FLGVEC with current status of flags
	specified in input vector. 

	CALL	jsr pc, dodsp

	INPUT	r0 -> vector

	OUTPUT	r0 -> end of vector

	REGISTERS
		uses r1, r2, r3, r4, r5
|
	
DSPVEC:
	mov	(r0)+, r1	; get flag
	beq	500$		; done - exit

100$:	; get pointer into FLGVEC
	mov	r1, r2		; copy flag
	sub	#33., r2	; make relative to FLGVEC
	asl	r2		; make word offset

	; now convert flag number to word and bitmask

	mov	r1, r3		; compute flag word
	dec	r3		; flag 1 = bit 0
	ash	#-4, r3		; shift right 4 = div by 16.
	asl	r3		; make words
	mov	rdxbuf(r3), r3	; get flag word
	mov	r1, r4		; construct mask
	dec	r4		; flag 1 = bit 0
	bic	#^C17, r4	; bit num is low four bits
	mov	#1, r5		; r4 = bit mask
	ash	r4, r5		; finish mask
	mov	#is.clr, flgvec(r2)	; assume clear
	bit	r5, r3		; is it set
	beq	200$		; clear - br
	mov	#is.set, flgvec(r2)	; say set
200$:
	; done a flag, set up for next one

	bit	#p.rang, proflg		; doing ranges?
	beq	dspvec		; nope, loop

	inc	r1		; bump flag number
	cmp	r1, (r0)	; check against high number
	blos	100$		; not done, branch
	tst	(r0)+		; bump pointer
	bne	dspvec		; and loop

500$:	
	return

	.SBTTL DISPLAY - Do List (all) commands

.REM |
	DSPFL runs down a display buffer, blanking out flags which
	are not set. Used by DISPLY. 

	CALL	jsr pc, dspfl

	INPUT  	r0 -> display buffer
		r1 = first flag number
		r2 = number of flags to format

	OUTPUT
		r0 -> past last flag in display buffer

	REGISTERS
		r1,r2,r3,r4,r5 destroyed	

	ERRORS
		none (passes carry set from flush)
|

DSPFL:
	add	r1, r2		; r2 = hi flag number+1
	mov	r1, r5		; compute flag word
	dec	r5		; flag 1 = bit 0
	ash	#-4, r5		; shift right 4 = div by 16.
	asl	r5		; make words
	add	#rdxbuf, r5	; r5-> flag word
	mov	r1, r3		; construct mask
	dec	r3		; flag 1 = bit 0
	bic	#^C17, r3	; bit num is low four bits
	mov	#1, r4		; r4 = bit mask
	ash	r3, r4		; finish mask
	mov	(r5)+, r3	; r3 now = flag word
				; r5 -> next flag word
;
; now, successively test mask against flag word (r5), if bit
; not set, blank out 3 char in buff (@r0), else skip three char.
;
10$:	bit	r4, r3		; flag set?
	beq	30$		; no - br 
	add	#3, r0		; skip in outbuf
	br	50$
30$:	movb	#40, (r0)+	; blank out buffer
	movb	#40, (r0)+	; two char
	inc	r0		; skip blank
50$:
	inc	r1		; bump flag number
	cmp	r1, r2		; all done?
	beq	100$		; yes, br
	asl	r4		; bump mask
	bcc	10$		; not at end of flag word - loop
	mov	#1, r4		; start new mask
	mov	(r5)+, r3	; get next flag word
	br	10$		; loop

100$:	mov	r0, bufadr	; save pointer
	return

	.SBTTL DISPLY -- Format and output Flag Status 
.REM |
	DISPLY formats and prints (or PUT$s) status of all or subset
	flags. Only called if something to do. 

	CALL:	jsr pc, disply
	INPUT: none
	OUTPUT: none
		formatted output to ti: (or file)
	REGISTERS:
		uses ??? (all avail)
|

DISPLY:
	dir$	#rdxdpb		; read all flags
	bcc	10$
	call	err,r5,<2,erm11> ; shriek can't read flags
	jmp	dsperr		; and quit

10$:	bit	#d.g, dspflg	; want user globals?
	beq	100$		; nope, branch
	call	strcpy,r5,<OFUG,OUTBUF>	
	mov	#outbuf, r0
	mov	r1, buflen
	add	#ofv33, r0	; point to flag 33 in outbuf
	mov	#33., r1	; set low flag
	mov	#24., r2	; number of flags
	call	dspfl	
	flush
	bcs	dsperr		; oops
		
100$:	bit	#d.sy, dspflg	; want system globals?
	beq	200$		; nope, branch
	call	strcpy,r5,<OFSY,OUTBUF>	
	mov	r1, buflen
	mov	#outbuf, r0
	add	#ofv57, r0	; point to flag 57 in outbuf
	mov	#57., r1	; set low flag
	mov	#8., r2		; number of flags
	call	dspfl	
	flush
	bcs	dsperr		; oops

200$:	bit	#d.gr, dspflg	; want group globals?
	beq	300$		; nope, branch
	bit	#d.ngg, dspflg	; globals avail?
	beq	210$		; yes, branch
	call	err,5,<0,IMS2>	; say no globals
	br	300$		; and skip format
210$:	cmpb	#80., obufw	; wide format?
	blo	250$		; yes - br
	; narrow (80. col) format
	call	strcpy,r5,<OFGR,OUTBUF>	
	mov	r1, buflen
	mov	#outbuf, r0
	add	#ofv65, r0	; point to flag 65 in outbuf
	mov	#65., r1	; set low flag
	mov	#16., r2	; number of flags
	call	dspfl	
	flush
	; now do second set
	call	strcpy,r5,<ofgr2,outbuf>
	mov	r1, buflen
	mov	#outbuf, r0
	add	#ofv77, r0	; point to flag 81(!) in outbuf
	mov	#82., r1	; set low flag
	mov	#16., r2	; number of flags
	call	dspfl	
	flush
	bcs	dsperr		; oops
	br	300$

	; long format
250$:	call	strcpy,r5,<OFGRL,OUTBUF>	
	mov	r1, buflen
	mov	#outbuf, r0
	add	#ofv65L, r0	; point to flag 33 in outbuf
	mov	#65., r1	; set low flag
	mov	#16., r2	; number of flags
	call	dspfl	
	; now do second set
	mov	#outbuf, r0
	add	#ofv77L, r0	; point to flag 81(!) in outbuf
	mov	#81., r1	; set low flag
	mov	#16., r2	; number of flags
	call	dspfl	
	flush
	bcs	dsperr		; oops
	br	300$

300$:	clc
DSPERR:	return

	.SBTTL PROCES - Do Set, Clear, Display Commands


.rem |
	PROCES executes any set, clear, or display commands. 
	It calls DOVEC for set and clear commands. 
	It calls DSPVEC for disply commands
	It also calls DOOUT to format and print output ("was xxx"), 
	conditionally on the D.Q bit in DSPFLG.

	CALL	jsr pc, proces

	INPUT 	none

	OUTPUT 
		cc - success
		cs - error encountered

	REGISTERS - uses all registers
|

PROCES:	
	bit	#<p.s!p.c!p.sb!p.cb>,proflg	; anything to do?
	beq	100$				; no - br
	;
	; call DOVEC once per set or clear operation
	; macro CALVEC issues error message and jumps to
	; PROCER on error from DOVEC.
	;
	mov	#setdpb, r0
	.list meb
	calvec	S,<4,ERM7>,BIC
	calvec	SB,<4,ERM7>,BIS

	mov	#clrdpb, r0
	calvec	C,<4,ERM10>,BIC
 	calvec	CB,<4,ERM10>,BIS
	.nlist meb
;
; now, we need to 'process' the display commands (/d, /db). These
; don't change flags, so all we do is pull current status out of
; rdxbuf, and dummy up IS.xxx in flgvec.
;
100$:
	bit	#<p.d!p.db>, proflg	; display commands?
	beq	500$			; no - br

	dir$	#rdxdpb		; get current flags
	bcc	110$	
	call	err,r5,<2,erm11>	; shriek can't read flags
	jmp	procer		; and quit	

110$:	bic	#p.rang, proflg	; set no ranges
	mov	#dvec, r0	; do /d switch
	call	dspvec
	bis	#p.rang, proflg	; set ranges
	mov	#dbvec, r0	; do /db switch
	call	dspvec
	
; 
; if requested, format and print "is/was" messages
;

500$:	; process status display - if requested
	bit	#d.q, dspflg	; quiet output?
	beq	510$		; no - do output
505$:	jmp	700$		; yes - skip output
510$:	bit	#<p.s!p.c!p.d!p.sb!p.cb!p.db>, proflg   ; anything to do?
	beq	505$		; no - br
;
; set up for first call to stfmt
; 
	mov	bufadr, r0
	mov	#argblk, r2
; does single-line make sense?
;;;	bit	#<d.lin1>, dspflg	; doing first line?
;;;	beq	600$			; no - br

	movb	obufw, r1		; output length
	bic	#^C377, r1		; fix sign extension of movb
	movb	#nslot, aslots		; assume 80-col output
	cmp	#80., r1		; 
	bhis	520$			
	movb	#wslot, aslots		; set up wide format
520$:	movb	aslots, slots
	mov	buflen, r3		; get current outbuf length
	add	#19., r3		; adjust for formatting, and 
					;  round to 16. char (slot width)
	bic	#15., r3		;
	sub	r3, r1			; obufw less rounded input length
	ble	525$			; no room - br
	ash	#-4, r1			; div 16 = slots left
	bne	530$			; room for statuses - br
525$:	flush				; no room - flush command line
	br	600$			
;
; compute spacing for fancy first line output
;
530$: 	movb	r1, slots		; save slot count
	sub	buflen, r3		; get number spaces to pad
	sub	#2, r3			;   less format chars
					;   * always at least 1 *
	mov	r3, (r2)+		; pad count to argblk
	mov	#ofspc, r1
	mov	#argblk, r2
	call	$edmsg			; add padding and "->"
	add	r1, buflen		; accumulate length
	mov	r0, bufadr		; save address



; continue with formatting	
;
; call stfmt for each commanded flag to show "was xxx" status
;
600$:	bic	#p.rang, proflg	; set doing individuals
	mov	#wasset, msset	; set up output strings
	mov	#wasclr, msclr	

	cstfmt s
	cstfmt c
	bis	#p.rang, proflg	; set doing ranges
	cstfmt sb
	cstfmt cb
	mov	#isset, msset	; set up for display command
	mov	#isclr, msclr	
	bic	#p.rang, proflg	; not doing ranges
	cstfmt	d
	bis	#p.rang, proflg	; doing ranges
	cstfmt	db

700$:	flush
psterr: 
procer:	return

	.SBTTL MAIN LOOP

.REM |
	Main logic is simple - get a command line (may be continued, or 
	specify indirect file), parse it out, execute it, try again.
	Execute has three phases:
		1. Set/Clear flags as required
		2. Dump 'was foo' messages, unless suppressed
		3. Dump all flag status, if requested.
|
START:	;
	; initialize file system, luns, assorted other stuff
	;
	finit$			; initialize FCS
	alun$s	#1,#"TI
	alun$s	#2,#"TI
	mov	#outbuf, bufadr
	clr	buflen
	bicb	#<ge.com!ge.clo>, <gclblk+g.mode>
				; return comments to us, keep @ file open
	dir$	#gmcdpb		; find out about ti:
	bcc	10$
	call	err,5,<3,erm1>	; command input error
	jmp	xit		; and exit
10$:	bic	#<d.crt!d.hds>, dspflg	; assume TI: not a CRT
					; haven't printed header line yet
	bis	#d.vrb, dspflg	; assume verbose output
	tstb	gmcbuf+1	; is it CRT?
	beq	reinit		; br if not
	bis	#d.crt, dspflg	; set crt ti: 
	bic	#d.vrb, dspflg	; set no verbose output
	.if df debug
	call	err,5,<0,dms4>
	.endc
	br	reinit

60$:	jmp	xit
		
REINIT:	; 
	; (re)initialize flag words, vectors, etc..
	; do this once per command line
	;
	; we don't reinit DSPFLG, making display switches 'sticky'
	;   however, we do reset the 'first line output' bit
	;
	bic	#d.lin1, dspflg	; say first line not output
	mov	#svec, r0	; clear prev vectors, and old PROFLG
100$:	clr	(r0)+		; clear a word
	cmp 	r0, #dspflg	; at end?
	bne	100$		; nope, keep clearing	

	bic	#d.ngg, dspflg	; assume group globals available
	dir$	#rdxdpb		; check group globals
	bcc	150$
	call	err,r5,<3,erm11>	; shriek can't read flags

150$:	cmp	#is.clr, $dsw	; group globals avail?
	bne	200$		; yes, br
	bis	#d.ngg, dspflg	; remember no group globals


	; reinit done, get command line	
200$:	gcml$	#gclblk		; get command line
				; NOTE: r0 -> gclblk
	bcc	300$		; br if got one
	tstb	g.err(0)	; input errors?
	beq	300$		; br if none
	cmpb	g.err(0), #ge.eof	; end of file?
	beq 	250$		; br if EOF
	call	err,5,<3,erm1>	; 
250$:	jmp	xit		; all done

300$:	tst	g.cmld(0)	; got anything?
	beq 	200$		; no - try again

; we have a command line to process
; is command line a comment or help request?
;
	mov	g.cmld+2(r0),r1	; point at command line
	mov	g.cmld(r0), r2	; get length
310$:	cmpb	#40, (r1)	; space?
	beq	330$		; yes - br
	cmpb	#11, (r1)	; tab?
	beq	330$		; yes - br
	br	340$		; not space or tab
330$:	inc	r1		; bump pointer
	sob	r2, 310$	; loop
	jmp	jimb		; nothing there - skip it
	
340$:	cmpb	#'?, (r1)	; help request?
	bne	345$		; no - br
	call	err,5,<0,usage>	; print out help
	jmp 	jimb		; skip processing
	
345$:	cmpb	#';,(r1)	; usual comment?
	beq	350$
	cmpb	#'!,(r1)	; check for other kind of comment
	bne	400$		; not a comment, go parse it
350$:
	bit	#d.vrb, dspflg	; do header?
	beq	360$		; no - ignore comment
	bit	#d.hds, dspflg	; header sent out yet?
	bne	355$		; yes, skip
	push	<r0>
	call	dohdr		; output header
	pop	<r0>
;**MARK**
355$:	add	#g.cmld, r0	; point to command line length
	.list me
	flush 	2(r0),r0		; print out comment
	.nlist me
	bcc	360$
	jmp	xit		; die on stupid errors
360$:	jmp 	JIMB		; loop

; parse out command line
400$:	csi$1	#csiblk,<gclblk+g.cmld+2>,<gclblk+g.cmld>	; syntax check
	bcc	600$
	call	err,5,<3,erm2>
	jmp	JIMB

600$:	csi$2	r0,OUTPUT,#swtab
	bcc	700$
	call	err,5,<3,erm2>
	br	JIMB

700$:
	; if header hasn't been done, do it now
	bit	#d.vrb, dspflg	; do header?
	beq	720$		; no - br
	bit	#d.hds, dspflg	; header done?
	bne	720$		; done - br
	call	dohdr		; print header

720$:	; if in verbose mode, print out command line
	; if in CRT mode, echo anyway, using overprint
	bit	#<d.vrb!d.crt>, dspflg	; echo command line?
	beq	1000$		; no - br

	mov	#ofcopy, r1
	mov	#argblk, r2
	mov	<gclblk+g.cmld>, (r2)+	; command line address
	mov	<gclblk+g.cmld+2>, (r2)+
	mov	#outbuf, r0		; set up edmsg
	mov	#argblk, r2	
	call	$edmsg			; format line
	mov	r0, bufadr	; save address
	mov	r1, buflen	; length to dpb
	bis	#d.lin1, dspflg	; say doing line 1
	
1000$:	call	chkflg		; check flag ranges and values
	bcs 	jimb		; die on error

	.if df debug&DBDMP
	call	dumpdb		; dump out switches and vectors
	.endc	

	bit	#<p.s!p.c!p.d!p.sb!p.cb!p.db>, proflg	
				; any flags to be changed (displayed)?
	beq	dodsp		; br if not
	call	proces		; go do it
	bcs	jimb		; quit on error

dodsp:	flush			; in case process left dirty buffer
	bit	#<d.sy!d.g!d.gr>, dspflg	; any display?
	beq	jimb		; nope, branch
	call	disply
	
jimb:	jmp	reinit		; do it all again

xit:	exst$s	exstat		;all done

	.END	START
