;
; this is the command parser for fdmp -- contains all known commands
;
	.TITLE		fdmpparse -- tparse stuff
	$TPADEF
;
; define my own psect for labeled commons
;	
	.psect	mine,pic,usr,ovr,rel,gbl,shr,noexe,rd,wrt,novec,long

as_addr:
	.blkb	255			; storage for definition
mac_addr:
	.blkb	255			; storage for name
;
; another psect for search string
;
	.psect 	ser,pic,usr,ovr,rel,gbl,shr,noexe,rd,wrt,novec,long

search_addr:
	.blkb	255
;
; another psect for reversal flags
;
	.psect 	rflag,pic,usr,ovr,rel,gbl,shr,noexe,rd,wrt,novec,long
revers:
	.long	0			; reverse byte order on input
;
; define another psect for dump flags
;
	.psect 	flags,pic,usr,ovr,rel,gbl,shr,noexe,rd,wrt,novec,long

display:
	.long	1			; display on terminal is on by default
print:
	.long	0			; display on printer is off by default
summary:
	.long	0			; display of record length on terminal
					; is off by default
fullscr:
	.long	0			; display is not using a 'full-screen'
					; mode by default
readin:
	.long	0			; reading in commands from command file
					; off by default

echoon:	
	.long	0			; echoing of commands from command file
					; off by default
logging:
	.long	0			; saving things in a command file
log_open:
	.long	0			; has log file ben opened
bad_file_open:
	.long	0			; set if bad file open
variable:
	.long	0			; see if we are working with a file
					;	of type "VARIABLE"
scratch_variable:			; scratch variable area	
	.long	0
;
; and one more psect for file names
;
	.psect	files,pic,usr,ovr,rel,gbl,shr,noexe,rd,wrt,novec,long

file_name:
	.blkb	63

	.psect  reading,pic,usr,ovr,rel,gbl,shr,noexe,rd,wrt,novec,long

read_name:
	.blkb	63

	.psect 	$local,pic,usr,con,rel,lcl,noshr,noexe,rd,wrt,novec

fail_msg:
	.ascid	/*** Spawn failed -- unable to execute command/

laugh_msg:
	.ascid  /You expect me to read your mind??? Give me a command/
	
com_prompt:
	.ascid	/command>/

com_descr:
	.long	0
	.long 	com_addr

com_addr:
	.blkb	255

ibeg1:	.blkl	1
iend1:	.blkl	1

ser_descr:
	.long	0
	.long 	search_addr

ser_flags:
	.blkl	1

ser_complete:
	.blkl	1

convert_flag:
	.blkl	1
length_fixed:
	.blkl	1
read_descr:
	.long	0
	.long	read_name

help_descr::
	.long 	0			; initial length 0
	.long	help_addr
help_addr:
	.blkb	63


alldef:	.long	0			; dump all macro definitions
					; initially no

zeroes:
	.blkb	63			; zero storage


file_descr:
	.long	0			; initial length 0
	.long	file_name

as_descr:
	.long	0			; initial length 0
	.long	as_addr

;
; various descriptors for macro names and values
;
mac_descr:
	.long	0			; initial length 0
	.long	mac_addr
as_count:	
	.blkl	1

ambmsg:	.ascid		/Ambiguous command -- reenter/

;
; stuff for doing dump
;
lowrec:	.blkl	1					; low record to dump
hirec:	.blkl	1					; high record to dump
irec1:	.blkl	1					; record to edit
irec2:	.blkl	1
;
; stuff for manipulating flags and still be PIC
;
dis:	.address	display
pri:	.address	print
sum:	.address	summary
ful:	.address	fullscr
ech:	.address	echoon	
log:	.address	logging
rev:	.address	revers

	$hlpdef					; help file definitions

output_routine:
	.address	lib$put_output
output_width:
	.long		80
library_name:
	.ascid		/SYS$HELP:FDMPHELP.HLB/
help_flags:
	.long		<hlp$m_prompt!hlp$m_help>
input_routine:
	.address	lib$get_input

help_fail:
	.ascid		/Error in HELP processing -- see Ken/

	$init_state	fishsta,fishkey

	$state 	start
	$tran		'CLEAR',tpa$_exit,clear_screen
	$tran		'CONVERT',convert_state
	$tran		'DCL',tpa$_exit,call_dcl
	$tran		'DEFINE',define_state
	$tran		'DISPLAY',display_state
	$tran		'DO',do_state
	$tran		'DUMP',dump_state
	$tran		'ECHO',echo_state
	$tran		'EDIT',edit_state
	$tran		'EXIT',tpa$_exit,exit_editor
	$tran		'FULLSCR',full_state
	$tran		'HELP',help_state
	$tran		'LOGGING',log_state
	$tran		'OPEN',open_state,clr_s
	$tran		'PRINT',print_state
	$tran		'QUIT',,quit
	$tran		'READ',read_state
	$tran		'REMOVE',remove_state
	$tran		'REVERSE',reverse_state
	$tran		'SEARCH',search_state
	$tran		'SHOW',show_state
	$tran		'SUMMARY',summary_state
	

	$state	define_state
	$tran		'MACRO',name_state

	$state	name_state
	$tran		tpa$_symbol,as_state,save_name

	comma=^a','

	$state	as_state
	$tran		tpa$_string,as_state,save_def
	$tran		comma,as_state
	$tran		'(',as_state,save1_def
	$tran		')',as_state,save1_def
	$tran		tpa$_eos,tpa$_exit,store_def

	$state 	help_state
	$tran		tpa$_any,help_state,add_help
	$tran		tpa$_eos,tpa$_exit,get_help

	$state	dump_state
	$tran		tpa$_digit,dump_state,save1
	$tran		':',dump1_state
	$tran		'USING',get_macro
	$tran		tpa$_eos,tpa$_exit,do_dump
	
	$state  dump1_state
	$tran		tpa$_digit,dump1_state,save2
	$tran		'USING',get_macro
	$tran		tpa$_eos,tpa$_exit,do_dump

	$state	get_macro
	$tran		tpa$_symbol,tpa$_exit,fetch_macro
	$tran		tpa$_eos,tpa$_exit,do_dump

true  = 1
false = 0

	$state	display_state
	$tran		'OFF',tpa$_exit,offit,,,dis
	$tran		'ON',tpa$_exit,onit,,,dis

	$state	print_state
	$tran		'OFF',tpa$_exit,offit,,,pri
	$tran		'ON',tpa$_exit,onit,,,pri
	
	$state	summary_state
	$tran		'OFF',tpa$_exit,offit,,,sum
	$tran		'ON',tpa$_exit,onit,,,sum

	$state	full_state
	$tran		'OFF',tpa$_exit,offit,,,ful
	$tran		'ON',tpa$_exit,onit,,,ful

	$state	echo_state
	$tran		'OFF',tpa$_exit,offit,,,ech
	$tran		'ON',tpa$_exit,onit,,,ech

	$state	log_state
	$tran		'OFF',tpa$_exit,offit,,,log
	$tran		'ON',tpa$_exit,onit,,,log

	$state	reverse_state
	$tran		'OFF',tpa$_exit,offit,,,rev
	$tran		'ON',tpa$_exit,onit,,,rev
;
; define semi-colon since assembler won't take it
;
	semi_colon = 59

	$state	read_state
	$tran		tpa$_alpha,read_state,read_it
	$tran		tpa$_digit,read_state,read_it
	$tran		':',read_state,read_it
	$tran		comma,read_state,read_it
	$tran		'[',read_state,read_it
	$tran		']',read_state,read_it
	$tran		semi_colon,read_state,read_it
	$tran		'.',read_state,read_it
	$tran		'-',read_state,read_it
	$tran		'$',read_state,read_it
	$tran		'_',read_state,read_it
	$tran		tpa$_eos,tpa$_exit,open_file

	$state	open_state
	$tran		'/',variable_state
	$tran		tpa$_alpha,open_state,file_it
	$tran		tpa$_digit,open_state,file_it
	$tran		':',open_state,file_it
	$tran		comma,open_state,file_it
	$tran		'[',open_state,file_it
	$tran		']',open_state,file_it
	$tran		semi_colon,open_state,file_it
	$tran		'.',open_state,file_it
	$tran		'-',open_state,file_it
	$tran		'$',open_state,file_it
	$tran		'_',open_state,file_it
	$tran		tpa$_eos,tpa$_exit,check_file

	$state	variable_state
	$tran		'VARIABLE',open_state,,true,scratch_variable

	$state	show_state
	$tran		'ALL',tpa$_exit,dump_all_def
        $tran           'CURRENT',tpa$_exit,show_current
	$tran		'FILE',tpa$_exit,out_file
	$tran		'FLAGS',tpa$_exit,show_flags
	$tran		'MACRO',get_mac

	$state	get_mac
	$tran		tpa$_symbol,tpa$_exit,fetch_def
	$tran		tpa$_eos,tpa$_fail

	$state	remove_state
	$tran		'ALL',tpa$_exit,remove_all
	$tran		'MACRO',get_mac1
	
	$state	get_mac1
	$tran		tpa$_symbol,tpa$_exit,remove_mac
	$tran		tpa$_eos,tpa$_fail

	$state	edit_state
	$tran		tpa$_decimal,edit_state,,,irec1
	$tran		':',edit1_state
	$tran		'USING',geta_macro
	$tran		tpa$_eos,tpa$_exit,call_edit
	
	$state  edit1_state
	$tran		'USING',geta_macro
	$tran		tpa$_eos,tpa$_exit,call_edit
	$tran		':',edit1_state
	$tran		tpa$_decimal,edit1_state,,,irec2

	$state	geta_macro
	$tran		tpa$_symbol,geta_macro,fetcha_macro
	$tran		tpa$_eos,tpa$_exit,call_edit

	$state	search_state
	$tran		'/',serl_state
	$tran		'FOR',for_state
	$tran		tpa$_decimal,ser1_state,,,ibeg1

ascii  =	1
octal  = 	2
long   =	3
word   =	4
byte   =	5
float  =	6
double =	7
hex    =	8
	
	$state	serl_state
	$tran		'COMPLETE',search_state,,true,ser_complete

	$tran		'ASCII',ser2_state,ch1,ascii,ser_flags
	$tran		'BYTE',ser2_state,ch1,byte,ser_flags
	$tran		'DOUBLE',ser2_state,ch1,double,ser_flags
	$tran		'FLOAT',ser2_state,ch1,float,ser_flags
	$tran		'HEX',ser2_state,ch1,hex,ser_flags
	$tran		'LONG',ser2_state,ch1,long,ser_flags
	$tran		'OCTAL',ser2_state,ch1,octal,ser_flags
	$tran		'WORD',ser2_state,ch1,word,ser_flags	

	$state	ser2_state
	$tran		'FOR',for_state
	$tran		tpa$_decimal,ser1_state,,,ibeg1

	$state	ser1_state
	$tran		':',ser1_state
	$tran		tpa$_decimal,ser1_state,,,iend1
	$tran		'FOR',for_state
	$tran		tpa$_eos,tpa$_fail

	$state	for_state
	$tran		tpa$_eos,tpa$_exit,do_search
	$tran		tpa$_any,for_state,get_ser

	$state	do_state
	$tran		tpa$_eos,tpa$_exit,call_spawn
	$tran		tpa$_any,do_state,get_com

	$state	convert_state
	$tran		tpa$_eos,tpa$_fail
	$tran		'TO',convertto_state

fixed     	 = 0
segmented 	 = 1
variable_length  = 2

	$state	convertto_state
	$tran		tpa$_eos,tpa$_fail
	$tran		'FIXED',get_length,,fixed,convert_flag
	$tran		'SEGMENTED',do_con,,segmented,convert_flag
	$tran		'VARIABLE',do_con,,variable_length,convert_flag

	$state	get_length
	$tran		tpa$_eos,tpa$_fail
	$tran		tpa$_decimal,do_con,,,length_fixed

	$state	do_con
	$tran		tpa$_eos,tpa$_exit,do_convert

	$end_state

	.psect		$code,pic,con,rel,lcl,shr,exe,rd,nowrt,long

	.entry		comscan,^m<r2,r3,r4,r5,r6,r7>
;
; set length of characters in macro definition to 0
;
	clrl	read_descr				; clear read file name
	clrl	as_count				; clear no of mac defs
	clrl	mac_descr				; clear mac name desc
	clrl	as_descr				; clear mac descriptor
	clrl	lowrec					; clear low rec to dump
	clrl	hirec					; clear hi rec to dump
	clrl	file_descr				; clear # of file name
	clrl	help_descr				; clear help descr
	clrl	irec1
	clrl	irec2
	clrl	ser_flags
	clrl	ser_complete
	clrl 	ser_descr
	clrl	ibeg1
	clrl	iend1
	clrl	com_descr
	clrl	convert_flag
	clrl	length_fixed
;
; Create the parameter block for LIB$TPARSE
;-
	subl2	#tpa$k_length0,sp
	moval	(sp),r2
	movl	#tpa$k_length0,tpa$l_count(r2)
	movl	#tpa$m_abbrev,tpa$l_options(r2)
	clrb	tpa$b_mcount(r2)
	movaq	@4(ap),r0
	cvtwl	(r0),tpa$l_stringcnt(r2)
	moval	@4(r0),tpa$l_stringptr(r2)
;+
;	Call LIB$TPARSE to process the data and return
;-
	pushal	fishkey
	pushal	fishsta
	pushal	(r2)
	calls	#3,g^lib$tparse
;
; check for ambiguity
;
	bbc	#<tpa$v_ambig>,tpa$l_options(r2),15$	; ambiguous?
	pushaq	ambmsg					; yes, tell user
	calls	#1,g^lib$put_output
15$:	movl	tpa$l_stringcnt(r2),@8(ap)
	ret
;
	.entry	quit,0
	calls	#0,clean_up				; clean up stuff
	movl	#1,r0
	$exit_s	r0	

	.entry	save_name,^m<r2,r3,r4,r5>
	movc3	tpa$l_tokencnt(ap),@tpa$l_tokenptr(ap),-
		mac_addr
	movl	tpa$l_tokencnt(ap),mac_descr
	movl	#1,r0
	ret

	.entry	save_def,^m<r2,r3,r4,r5>
	incl	as_count				; increment count
							; of known macros
	moval	as_addr,r5
	addl2	as_descr,r5
	movc3	tpa$l_tokencnt(ap),@tpa$l_tokenptr(ap),-
		(r5)
	addl2	tpa$l_tokencnt(ap),as_descr
	movl	#1,r0
	ret

	.entry	add_help,^m<r2,r3,r4,r5>
        tstl    help_descr                  ; check for length
        bneq    10$
        bbss    #tpa$v_blanks,tpa$l_options(ap),10$ ; blanks on
10$:
	moval	help_addr,r5
	addl2	help_descr,r5
	movb	tpa$b_char(ap),(r5)
	incl	help_descr
	ret

	.entry	get_help,^m<r2,r3,r4,r5>
	pushl	input_routine
	pushal	help_flags
	pushaq	library_name
	pushaq	help_descr
	pushal	output_width
	pushl	output_routine
	calls	#6,g^lbr$output_help
	blbs	r0,400$
	pushaq	help_fail
	calls	#1,g^lib$put_output
400$:	movl	#1,r0
	ret

	.entry 	call_dcl,^m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
	chms	#1					; call up DCL
	movl	#1,r0
	ret
	
	.entry	save1_def,^m<r2,r3,r4,r5>
	moval	as_addr,r5				; get address
	addl2	as_descr,r5				; add offset
	movb	tpa$b_char(ap),(r5)			; store 1 char
	incl	as_descr
	ret

	.entry	store_def,^m<r2,r3,r4,r5>		; save macro in common
	pushal	mac_descr				; save name length
	pushal	as_descr				; save def length
	calls	#2,store_macro
	movl	#1,r0
	ret

	.entry	save1,^m<r2,r3,r4,r5>
	subl3	#48,tpa$b_char(ap),r2			; save low rec
	mull3	#10,lowrec,lowrec
	addl2	r2,lowrec
	movl	#1,r0
	ret

	.entry	save2,^m<r2,r3,r4,r5>
	subl3	#48,tpa$b_char(ap),r2			; save hi rec
	mull3	#10,hirec,hirec
	addl2	r2,hirec
	movl	#1,r0
	ret
;
; do actual dump routine
;
; good luck
;
	.entry  do_dump,^m<r2,r3,r4,r5>
		
	cmpl	#0,lowrec				; see if zero
	bneq	5$					; no
	movl	#1,lowrec				; change to one
	movl	#999999,hirec				; set hirec high
 5$:	cmpl	#0,hirec				; see if hirec is 0
	bneq	10$					; no
	movl	lowrec,hirec				; yes, set to lorec
 10$:	pushal	hirec
	pushal	lowrec
	calls 	#2,dump					; do dump
	movl	#1,r0
	ret

	.entry	file_it,^m<r2,r3,r4,r5>
	cmpl	#63,file_descr				; see if too big
	bleq	10$
	cmpb	#0,file_name				; see if prev. defined
	beql	20$					; no
	cmpl	#0,file_descr
	bneq	20$
	movc3	#63,zeroes,file_name			; yes, clear old file
	clrl	variable				; clear variable flag
20$:	moval	file_name,r5				; get address
	addl2	file_descr,r5				; add offset
	movb	tpa$b_char(ap),(r5)			; store 1 char
	incl	file_descr
10$:	movl	#1,r0
	ret

	.entry	fetch_macro,^m<r2,r3,r4,r5>		; get name of desired
	movc3	tpa$l_tokencnt(ap),@tpa$l_tokenptr(ap),-
		mac_addr				; macro
	movl	tpa$l_tokencnt(ap),mac_descr
	pushal	mac_descr
	calls	#1,get_def				; get definition
	calls	#0,do_dump				; do dump
	movl	#1,r0
	ret

	.entry	fetcha_macro,^m<r2,r3,r4,r5>		; get name of desired
	movc3	tpa$l_tokencnt(ap),@tpa$l_tokenptr(ap),-
		mac_addr				; macro
	movl	tpa$l_tokencnt(ap),mac_descr
	pushal	mac_descr
	calls	#1,get_def				; get definition
	movl	#1,r0
	ret

	.entry	fetch_def,^m<r2,r3,r4,r5>		; get name of desired
	movc3	tpa$l_tokencnt(ap),@tpa$l_tokenptr(ap),-
		mac_addr				; macro
	movl	tpa$l_tokencnt(ap),mac_descr
	clrl	alldef					; set to dump one def
	pushal	alldef
	pushal	mac_descr
	calls	#2,show_def				; get definition
	movl	#1,r0
	ret

	.entry	dump_all_def,^m<r2,r3,r4,r5>
	movl	#1,alldef				; set to dump all
	pushal	alldef
	pushal 	mac_descr
	calls	#2,show_def
	movl	#1,r0
	ret

	.entry	remove_mac,^m<r2,r3,r4,r5>		; remove macro def
	movc3	tpa$l_tokencnt(ap),@tpa$l_tokenptr(ap),-
		mac_addr				; macro
	movl	tpa$l_tokencnt(ap),mac_descr
	clrl	alldef
	pushal	alldef
	pushal	mac_descr
	calls	#2,remove_macro
	movl	#1,r0
	ret

	.entry	remove_all,^m<r2,r3,r4,r5>
	movl	#1,alldef				; set to remove all
	pushal	alldef					; definitions
	pushal	mac_descr
	calls	#2,remove_macro
	movl	#1,r0
	ret

	.entry	clear_screen,^m<r2,r3,r4,r5>
	pushl	#1
	pushl	#1
	calls	#2,g^scr$erase_page			; clear screen
	movl	#1,r0
	ret

	.entry	read_it,^m<r2,r3,r4,r5>
	cmpl	#63,read_descr				; see if too big
	bleq	10$
	cmpb	#0,read_name				; see if prev. defined
	beql	20$					; no
	cmpl	#0,read_descr
	bneq	20$
	movc3	#63,zeroes,read_name			; yes, clear old file
20$:	moval	read_name,r5				; get address
	addl2	read_descr,r5				; add offset
	movb	tpa$b_char(ap),(r5)			; store 1 char
	incl	read_descr
10$:	movl	#1,r0
	ret

	.entry	call_edit,^m<r2,r3,r4,r5>
	
	tstl	irec1					; test 1st record
	bneq	10$
	clrl	r0
	ret
10$:	tstl	irec2
	bneq	20$
	movl	irec1,irec2
20$:	pushal 	irec2
	pushal	irec1
	calls	#2,edit
	movl	#1,r0
	ret

	.entry	onit,^m<r2,r3,r4,r5>
	
	movl	@tpa$l_param(ap),r2
	movl	#1,(r2)
	ret

	.entry	offit,^m<r2,r3,r4,r5>
	
	movl	@tpa$l_param(ap),r2
	clrl	(r2)

	ret

	.entry	ch1,^m<r2,r3,r4,r5>			; check options -- we
							; can only handle one
	movl	#1,r0					; assume okay
	tstl	ser_flags				; should be zero
							; if only 1 selected
	beql	10$
	clrl	r0
10$:	ret

	.entry	do_search,^m<r2,r3,r4,r5>
	
	tstl	ser_flags				; check options set
	bneq	10$
	movl	#ascii,ser_flags			; use ascii if none set

10$:	tstl	ibeg1					; check for 0
	bneq 	20$					; if so, make 1
	movl	#1,ibeg1
	movl	#999999,iend1
20$:	tstl	iend1
	bneq	30$
	movl	ibeg1,iend1

30$:	pushal	ser_descr
	pushal	ser_complete
	pushal	ser_flags
	pushal	iend1
	pushal	ibeg1

	calls	#5,search

	movl	#1,r0
	ret

	.entry	get_ser,^m<r2,r3,r4,r5>			; get search string
	tstl	ser_descr				; see if first char
	bneq	10$					; 
	bbss	#tpa$v_blanks,tpa$l_options(ap),10$	; if so, turn on blanks

 10$:	moval	search_addr,r2
	addl2	ser_descr,r2
	movb	tpa$b_char(ap),(r2)			; store character
	incl	ser_descr
	ret

	.entry	get_com,^m<r2,r3,r4,r5>
	tstl	com_descr
	bneq	10$
	bbss	#tpa$v_blanks,tpa$l_options(ap),10$	; if so, turn on blanks

 10$:	moval	com_addr,r2
	addl2	com_descr,r2
	movb	tpa$b_char(ap),(r2)
	incl	com_descr
	ret

	.entry	call_spawn,^m<r2,r3,r4,r5>
	
	tstl	com_descr				; if no command, laugh
	bneq	5$					; at him
	pushaq	laugh_msg
	calls	#1,g^lib$put_output
	movl	#132,com_descr
	pushaq	com_prompt				; get the command
	pushaq	com_descr
	calls	#2,g^lib$get_input

 5$:	pushaq	com_descr
	calls	#1,g^lib$spawn				; do command, wait
							; until done...all
							; defaults
	blbs	r0,10$
	pushaq	fail_msg
	calls	#1,g^lib$put_output
 10$:	movl	#1,r0
	ret

	.entry	clr_s,^m<r2,r3>				; clear out scratch
	clrl	scratch_variable			;  	variable
	movl	#1,r0
	ret

	.entry	do_convert,^m<r2,r3>
	pushal	length_fixed
	pushal	convert_flag
	calls	#2,file_convert
	movl	#1,r0
	ret

	.end