.TITLE	SYMBOL			; command parser and dispatcher
	.IDENT	"SYMBOL V3%4.091"	; internals demo program...
;--
; Copyright © 1993, 1994 by Brian Schenkenberger and TMESIS Consulting
;                            All rights reserved.                            
;                         -------------------------
; This software is provided "as is" and is supplied for informational purpose
; only.  No warranty is expressed or implied and no liability can be accepted
; for any actions or circumstances incurred from the use of this software or 
; from the information contained herein.  The author makes no claim as to the
; suitablility or fitness of this software or information contain herein for a
; particular purpose.
;                         -------------------------
; This software may be copied and distributed only with the inclusion of this
; copyright notice.
;----------------------------------------------------------------------------
; Modifications:
; 04-JAN-1994: 	Created this file.
; 20-JAN-1994:	added message handling capabilites to prefix error's with
;		SYMBOL as the facility name.  error condition is returned
;		to $STATUS with bit 28 set for conditional statement uses
;		in DCL procedures. 
; 25-JAN-1994:	add hack to fix accvio when CLI$DCL_PARSE chokes on invalid
;		expression syntaxes.
; 02-MAR-1994:	remove above hack.  disallow expressions, only numerics
;--
	$CHFDEF			; condition handling facility def's
	$DSCDEF			; VMS descriptor class/type def's
	$PRVDEF			; VMS privilege quadword def's
	$STSDEF			; message code field definitions

;----------------------------------------------------------------------------
	.NTYPE	...ON_ALPHA...,R31
	.IIF EQ,<...ON_ALPHA...@-4&^XF>-5,	ALPHA=0
	.IIF DF,ALPHA,	.DISABLE FLAGGING
;----------------------------------------------------------------------------

	.PSECT	$$DATA,WRT,NOEXE,LONG

CMD_LINE:	.LONG	<DSC$K_CLASS_D@24>!<DSC$K_DTYPE_T@16>,0
PREFIX:		.LONG	<DSC$K_CLASS_S@24>!<DSC$K_DTYPE_T@16>!6
		.ADDRESS	SYMSTR
VERB:		.LONG	<DSC$K_CLASS_S@24>!<DSC$K_DTYPE_T@16>!7
		.ADDRESS	SYMSTR
SYMSTR:		.ASCII	/SYMBOL  /
;----------------------------------------------------------------------------
	.PSECT	$$CODE_RO,PIC,GBL,SHR,NOWRT,EXE,LONG
	.ENTRY	SYMBOL,^M<>

	MOVAB	SYMBOL_MSG_HNDLR,(FP)	; estab. CHF for symbol command

	PUSHAB	CMD_LINE		
	CALLS	#1,G^LIB$GET_FOREIGN	; get the command line
	BLBC	R0,10$

	PUSHAB	VERB			; prepend the foreign command line
	PUSHAB	CMD_LINE		; with the verb before parsing
	CALLS	#2,G^STR$PREFIX
	BLBC	R0,10$

	PUSHAB	G^LIB$GET_INPUT
	PUSHAB	SYMBOL_CLITABLE		; SYMBOL symbol table
	PUSHAB	CMD_LINE		; the command to be parsed
	CALLS	#3,G^CLI$DCL_PARSE	; parse it.
	BLBC	R0,20$

	CALLS	#0,G^CLI$DISPATCH	; dispatch to service routine
	BLBS	R0,30$
;++
; If an error is returned through CLI$DISPATCH have it formatted the same
; way as a signalled error.  The following 'fakes' the format of a signal
; argument array so that the condition handler can be used/called.  
; 
; Create the following on the stack:
; 
;	.--------.--------.--------.--------. :AP points to stack by CALLS
;       |                          |   #1   |<--- pushed on stack by CALLS
;	|--------+--------+--------+--------| :SP
;	| address of the faked SIGNAL array |----.
;       |--------+--------+--------+--------|    |
;       |                          |   #1   | <--'
;       |--------+--------+--------+--------|
;       | returned status from CLI$DISPATCH |
;       `-----------------------------------'
;--
	ASSUME	CHF$L_SIGARGLST EQ 4	; assumption for fake sig array

10$:	PUSHL	R0			; fake a signal arg array
	PUSHL	#1			; so that the condition handler
	PUSHAB	(SP)			; can be CALL(S)ed

	CALLS	#1,SYMBOL_MSG_HNDLR	; call CHF to report error

20$:	BBSS	#STS$V_INHIB_MSG,R0,30$	; set the 'no-signal' bit
30$:	RET				; bye-bye

;++
; Condition handler.  Changes facility string to SYMBOL in error messages.
; Assume that the AP point to an array which points to the signal array.
;
;
;	.--------.--------.--------.--------.
;       |                          | 1 or 2 | :AP
;	|--------+--------+--------+--------| 
;	|      address of SIGNAL array      |----.
;       |--------+--------+--------+--------|    |
;       | adr of MECHANISM array (not used) |    |
;       |--------+--------+--------+--------|    |
;       ~                                   ~    |
;       ~                                   ~    |
;       |--------+--------+--------+--------|    |
;       |                          | # args |<---'
;       |--------+--------+--------+--------|
;       |           condition code          | 
;       |--------+--------+--------+--------|
;       ~      optional condition code      ~
;       ~         related arguments         ~
;       |--------+--------+--------+--------|
;       |          program counter          |
;       |--------+--------+--------+--------|
;       |     processor status longword     |
;       `-----------------------------------'
;
;--
	.ENTRY	SYMBOL_MSG_HNDLR,0

	MOVL	CHF$L_SIGARGLST(AP),R11		; get adr of signal arg array

	CMPZV	#STS$V_FAC_NO,-			; is this an error from CLI?
		#STS$S_FAC_NO,-
		CHF$L_SIG_NAME(R11),-
		#CLI$_FACILITY
	BNEQ	10$				; NO?  branch to 10$

	MOVL	#1,CHF$L_SIG_ARGS(R11)		; limit CLI errors to 1 args

10$:	$PUTMSG_S	MSGVEC=(R11),-		; output the message
			FACNAM=PREFIX		; prefixed with SYMBOL

	BLBC	CHF$L_SIG_NAME(R11),20$		; exit if an error?
	MOVL	#SS$_CONTINUE,R0		; informational... continue
	RET

20$:	BBSS	#STS$V_INHIB_MSG,-		; set the 'no-signal' bit
		CHF$L_SIG_NAME(R11),30$
30$:	$EXIT_S	CHF$L_SIG_NAME(R11)		; exit
	.END	SYMBOL