;
; Davex by David A. Lyons
;
; Begun 31-Aug-85
;
;***********************************************
;
; Converted to ca65 09/2011 (from 1.30 source)
;  -Tabs set at 8 characters
;  -Refactored to run on SOS as well as ProDOS
;
; Davex 1.30 2-Dec-99
;  -Changed shareware notice to Freeware notice.
;  -Removed serial number support.
;  -Y2K compliant
;  -Prints a warning if the clock's year number is >99.
;  -Help mentions "?topics".
;  -Command line: Apple-left, Apple-right, Control-A.
;  -Yes/No questions: Q = abort (like Esc/Cmd-Period).
;
; Converted to MPW IIgs 13-Sep-92 DAL (from 1.27 source)
;  asmiigs davex.aii
;  linkiigs davex.aii.obj -o davex
;  makebiniigs davex -org $2000
;  setfile davex -c pdos -t PSYS
;  dup Davex :
;
;***********************************************

; Message with string
.macro	message_cstr Arg
	jsr mess
	cstr Arg
.endmacro

; Message with string, trailing Return
.macro	message_cstr_cr Arg
	jsr mess
	cstr_cr Arg
.endmacro

;***********************************************
copyright:
	jsr crout
	jsr pDavexVer
	jsr mess
dollar:	asc "Copyright (c) 1988-1990, 1999-2011"
	.byte cr
	asc "by David A. Lyons"
	.byte cr,cr 
	asc "  https://github.com/david-schmidt/Davex"
	.byte cr,cr
	asc "Davex is Freeware.  If you find it useful, please let me know."
	.byte cr
	asc "If you want to send money or M&Ms I won't argue with you, but it's"
	.byte cr
	asc "not necessary."
	.byte cr,cr
	asc "Davex is Y2K compliant if you use ProDOS 8 2.0.3 or later."
.if  Proto 
	.byte cr,cr
	asc "PROTOTYPE VERSION FOR TESTING ONLY - NOT A STABLE RELEASE."
.endif
	.byte cr,0
	rts

;***********************************************
;
; RESTART (come here on RESET or Ctrl-Y or whatever)
;
restart:
	lda #0
	sta remslot	; %%% ?
.if IsDavex3
	; Respond to the configuration setting of column numbers
	lda cfg40
	jsr config_set_columns
.else ; IsDavex2
	jsr on80
.endif ; IsDavex3
	jsr finish_oredir

	lda #0
	sta fudgeCR
	sta redir_susplv
	sta redir_out
	sta redir_in
	SET_LEVEL
	jsr close
	jsr finish_iredir

	jsr spool_zap
	lda #0
	ldx #6
prclz:	sta SlotsOpen,x
	dex
	bpl prclz

	lda #<-1
	sta dir_level
	lda #>dirstack
	ldy #<dirstack
	sta dstk_ptr+1
	sty dstk_ptr
;
; 1st time ONLY, 'exec %autoexec'
;
aexec:	jsr do_autoexec	;opcode MODIFIED below
	lda #$ad	;lda abs
	sta aexec
;
; Welcome msg
;
	jsr f8rom_init	; $fb2f	;F8ROM:INIT
	start_normal
	jsr clear_sc
wCheat:	jsr welcome
	lda #>wNotQuiet
	ldy #<wNotQuiet
	sta wCheat+2
	sty wCheat+1
	jmp prompt

time_pr:
	lda #0
	jsr redirect
	bvs prompt
	bit fudgeCR	;5-Feb-90
	bpl noFudge	;5-Feb-90
	lsr fudgeCR	;5-Feb-90
	bpl prompt	;5-Feb-90
noFudge:
	jsr print_time
prompt:
	clc
	lsr stepping
	lda #0
	jsr redirect
	bvs no_cont
	jsr TalkCont	;turn voice back on (clear Ctrl-X)
	jsr restore80
no_cont:
	jsr finish_oredir
	lda #close_level
	SET_LEVEL
	lda #0
	sta rep_count+1
	sta rep_count
	jsr close	;a=0
	lda #stdlevel
	SET_LEVEL
	lda #<-1
	sta dir_level
	jsr save_config
	cli	;for IIgs users
	lda #0
	sta $48	;mon P
	lda #0	;27-Jan-90
	jsr redirect
	and #%11000000
	bne noGetlnCR
	jsr crout	;13-Jun-87
noGetlnCR:
	jsr getln
	cpx #0
	beq time_pr

	ldx #0
	stx parse_index

nextcmd:
	ldx #mli_close
	jsr mmgr

	jsr munch_space
prompt0:
	beq prompt
	cmp #$80+';'
	beq FoundSemi

	lda #10
	sta ExpandCount
ExpAgain:
	lda #>string
	ldy #<string
	jsr exp_alias
	php
	jsr munch_space
	plp
	bcs Expanded
	dec ExpandCount
	bne ExpAgain
Expanded:

	jsr parse_exec

	jsr chrgot
	beq prompt0
	cmp #$80+';'
	beq FoundSemi

	lda #der_semiexp
	jmp ProDOS_err
;
; Found a semicolon; munch text of first command and
; loop back for the next one
;
FoundSemi:
	jsr ms0
	ldx parse_index
	ldy #0
ShiftCmd:
	lda string,x
	sta string,y
	iny
	inx
	cpx string-1
	bcc ShiftCmd
	beq ShiftCmd
	lda string-1
	sec
	sbc parse_index
	sta string-1
	ldx #0
	stx parse_index
	jmp nextcmd

ExpandCount:
	.byte 0

;***********************************************
main_err:
	jsr finish_oredir
	jsr finish_iredir
	lda #0
	sta redir_susplv
	jsr bell
	jmp fix_stack

chrget:	inc parse_index
chrgot:	ldx parse_index
	lda string,x
	rts

;***********************************************
;
; parse_cmd -- parse a cmd word from command line
;              return CLC and cmd_addr if OK;
;              otherwise SEC
;
parse_cmd:
	lsr externalc
	lda #>command
	ldy #<command
	jsr parse_word
	sty command-1
	jsr point_cmdtbl
pc1:	jsr cmp_cmd
	clc
	beq found_cmd
	jsr point_nxtcmd
	bne pc1
;
; scan for BIN,SYS,S16,EXE,DIR... file with given name
;
	lda #>(command-1)
	ldy #<(command-1)
	jsr fixup_path_ay
	lda #>(command-1)
	ldy #<(command-1)
	jsr scanall
	bcs huh
;
; HERE IS WHERE TO DO "APPL" STUFF.
;
	cmp #tDIR
	beq gotoDIR
	jsr run_something
	sec
	ror externalc
	clc
found_cmd:
	rts

gotoDIR:
	CALLOS mli_setpfx, gdParms
	CALLOS_BRANCH_POS wentD
	jmp ProDOS_err
wentD:
	lda #>nullcmd
	ldy #<nullcmd
	sta cmd_addr+1
	sty cmd_addr
	lda #>nullentr
	ldy #<nullentr
	sta cmd_ptr+1
	sty cmd_ptr
	clc
nullcmd:
	rts
nullentr:
	.byte $80+'x',0
	.addr nullcmd
	.byte 0,0	;no parms

gdParms:
	.byte 1
	.addr cmdpath
;
; huh?
;
huh:	jsr print_cmd
	message_cstr_cr ": huh?"
	jmp main_err

;
; parse a word (up to blank, semi, eol) to AY
;
parse_word:
	sta p+1
	sty p
	ldy #0
parsew1:
	jsr chrgot
	beq pw_x
	cmp #$80+' '
	beq pw_x0
	cmp #$80+';'
	beq pw_x
	jsr downcase
	sta (p),y
	iny
	cmp #$80+'?'
	beq pw_x2
	cmp #$80+'-'
	beq pw_x2
	jsr chrget
	jmp parsew1
pw_x2:	jsr chrget
pw_x0:	jsr munch_space
pw_x:	lda #0
	sta (p),y
	rts
;
; set cmd_ptr = cmdtbl
;
point_cmdtbl:
	lda #>cmdtbl
	ldy #<cmdtbl
	sta cmd_ptr+1
	sty cmd_ptr
	rts
;
; advance cmd_ptr to next command
; return BEQ if no more commands in table
;
point_nxtcmd:
	jsr adv_cmdptr
	bne point_nxtcmd
	jsr adv_cmdptr	;pointing at addr
skipparm:
	jsr adv_cmdptr	;pointing at addr+1
	jsr adv_cmdptr	;pointing at parm1
	iny
	ora (cmd_ptr),y
	bne skipparm
	jsr adv_cmdptr
;
; fall into adv_cmdptr
;
adv_cmdptr:	inc cmd_ptr
	bne cp_ok
	inc cmd_ptr+1
cp_ok:	ldy #0
	lda (cmd_ptr),y
	rts
;
; print command word
;
print_cmd:
	lda #>(command-1)
	ldy #<(command-1)
	jmp print_path
;
; compare command string with cmd_ptr^
;
cmp_cmd:
	ldy #0	;points into cmd_ptr^
	ldx #0	;points into command
compcmd1:
	lda command,x
	cmp (cmd_ptr),y
	bne no_match
	cmp #0
	beq yes_match
	inx
	iny
	bne compcmd1
no_match:
	rts

yes_match:
	iny
	lda (cmd_ptr),y
	sta cmd_addr
	iny
	lda (cmd_ptr),y
	sta cmd_addr+1
	lda #0	;BEQ
	rts
;
; munch up to a nonspace or end of line
;
ms0:	jsr chrget
munch_space:
	jsr chrgot
	beq :+
	cmp #$80+' '
	beq ms0
:	jmp chrgot

parse_exec:
	jsr parse_cmd
	bcc execit
	jmp fix_stack

execit:	jsr parse_parms
;
; expand wildcards here & call routine
; until there are no more expandions
;
	lsr some_flag
	jsr wild_begin
wild_again:
	jsr wild_next
	bcs wild_done
	sec
	ror some_flag
;
; repeat command rep_count times (0 ==> 1)
; Note:  the REP command has to cheat to avoid
; an infinite loop; it changes the return address
; from JSR JMPCMD to return to REPEATED
;
rep_again:
	lda #stdlevel
	SET_LEVEL
	lda #0
	jsr getparm_n
	jsr jmpcmd
	jsr check_wait
	bcc rep_noAbort
	jmp yn_abort
rep_noAbort:
	lda #stdlevel
	SET_LEVEL
	lda #0
	jsr close
	jsr restore80
;
; repeat until rep_count == 0
;
	lda rep_count+1
	ora rep_count
	beq repeated
	lda rep_count
	bne :+
	dec rep_count+1
:	dec rep_count
	jmp rep_again
repeated:
;
; repeat cmd with next wildcard expansion
;
	jmp wild_again

wild_done:
	bit some_flag
	bmi did_some
	message_cstr_cr "(no files matched)"
did_some:
	rts

jmpcmd:	jmp (cmd_addr)

;***********************************************
;
; parse_parms -- parse command's parameters from
; command line into PARMS.
;
; cmd_ptr points to the command's name
;
parse_parms:
	bit externalc
	bmi parseparms2	;already found

find_parms:
	jsr adv_cmdptr
	bne find_parms
	jsr adv_cmdptr	;pt at addr
	jsr adv_cmdptr	;pt at addr+1
	jsr adv_cmdptr	;pt at parm1

parseparms2:
	lda #0
	sta num_parms
	lda #<-1	;don't confuse wildcards
	sta parmtypes
	sta parmtypes+1

	lda #>string_buffs
	ldy #<string_buffs
	sta strbuf+1
	sty strbuf

another:
	jsr one_parm
	bcc another
	jsr chrgot
	beq sortprm
	cmp #$80+';'
	beq sortprm
	lda #der_toomany	;too many parameters
	jmp der
sortprm:
	jsr bubble_parm
	bcc sortprm
	rts
;
; bubble_parm:  bubble a positional parameter
;    closer to beginning of list and return
;    CLC, or do nothing and return SEC
;
bubble_parm:
	lsr bub_flag
	ldy num_parms
	beq bubb_x
	dey
	beq bubb_x
	sty bub_count
	ldy #0
	ldx #0
bubb1:	lda parms,y
	beq no_bubb	;pos parm first is ok
	lda parms+4,y
	bne no_bubb
	jsr bub_swap
	sec
	ror bub_flag
no_bubb:
	inx
	iny
	iny
	iny
	iny
	dec bub_count
	bne bubb1
	bit bub_flag
	bpl bubb_x
	clc
	rts
bubb_x:	sec
	rts
bub_flag:	.byte 0
bub_count:	.byte 0

;
; swap parm x with parm x+1 (y=4x)
;
bub_swap:
	lda parmtypes,x
	pha
	lda parmtypes+1,x
	sta parmtypes,x
	pla
	sta parmtypes+1,x
	lda #4
	sta swapcount
bswap1:	lda parms,y
	pha
	lda parms+4,y
	sta parms,y
	pla
	sta parms+4,y
	iny
	dec swapcount
	bne bswap1
	dey
	dey
	dey
	dey
	rts

swapcount:
	.byte 0

;
; calc_pindex -- x=4*(num_parms-1)
;
calc_pindex:
	pha
	ldx num_parms
	dex
	txa
	asl a
	asl a
	tax
	pla
	rts

;***********************************************
;
; parse the next positional parameter
;
posit_parm:
	ldy #0
	lda (cmd_ptr),y
	bne posit_done	;option character present
	iny
	lda (cmd_ptr),y	;end of parm list?
	beq posit_done
	tax	;type of parm to parse
	lda #0	;opt char (none)
	jsr pval_ax
	jsr adv_cmdptr
	jsr adv_cmdptr
	clc
	rts
posit_done:
	sec
	rts

;***********************************************
;
; parse a parameter (positional or optional)
;
one_parm:
	jsr munch_space
	beq posit_parm
	cmp #$80+'-'
	bne posit_parm
	jsr chrget
	bne opt_ok
	jmp illeg_parm	;"-" at end of line
opt_ok:	jsr downcase
	sta optchar
	jsr chrget	;point to char after option
;jsr munch_space ;24-Jan-90 DL
	ldy #0
chk_allowed:
	iny
	lda (cmd_ptr),y
	dey
	cmp #0
	bne p_legal
	lda (cmd_ptr),y
	bne p_legal
	jmp illeg_parm
p_legal:
	lda (cmd_ptr),y
	cmp optchar
	beq this_parm
	iny
	iny
	bne chk_allowed
this_parm:
	iny
	lda (cmd_ptr),y
	tax
	stx last_type
; 24-Jan-90
	beq noMunch98
	jsr munch_space
	ldx last_type
noMunch98:
;
	lda optchar
	jsr pval_ax
; 24-Jan-90
	lda last_type
	beq noMunchEm
	jsr munch_space
noMunchEm:

	jsr chrgot
	beq fudgex
	cmp #$80+'-'
	beq fudgex
	cmp #$80+';'
	beq fudgex
	ldx last_type
	bne fudgex
	cmp #$80+' '
	beq fudgex
; %%% multiple-flags disabled by removing next line
	jmp opt_ok
fudgex:	clc
	rts

last_type:
	.byte 0

;***********************************************
;
; pval_ax -- parse a nil, int2, int3, path, string,
;       device, yesno, or ftype parameter into the
;       parms table from the cmd line
;
; A contains option character of this parameter
; X contains the type of this parameter (t_xxx)
;
pval_ax:
	jsr pvax2
	ldx ptype
	cpx #t_path
	beq fixpath1
	cpx #t_wildpath
	beq fixpath1
	rts
fixpath1:
	ldx num_parms
	dex
	txa
	jsr getparm_n
	jmp fixup_path_ay

pvax2:	stx ptype
; record parameter type in table
	pha
	txa
	ldy num_parms
	sta parmtypes,y
	pla

	beq pv_legal
	pha
	jsr getparm_ch
	pla
	bcc duplicated

pv_legal:
	inc num_parms
	jsr calc_pindex
	sta parms,x	;store character into table
;
; dispatch by parm type
;
	lda ptype
	beq noMunch99	;24-Jan-90
	jsr munch_space	;12-Mar-88 DL
noMunch99:
	lda ptype
	cmp #t_devnum+1
	bcs badtype
	asl a
	tax
	lda parsers+1,x
	pha
	lda parsers,x
	pha
	jmp calc_pindex

parsers:
	.addr pv_done-1
	.addr pv_int-1
	.addr pv_int-1
	.addr pv_string-1	; path
	.addr pv_string-1	; wildpath
	.addr pv_string-1	; string
	.addr pv_int-1		; int1
	.addr pv_yesno-1
	.addr pv_ftype-1
	.addr pv_devnum-1

badtype:
	lda #der_badtype
	bne der

pv_done:
	clc
	rts
;
; duplicate parm -- given more than once
;
duplicated:
	lda #der_dupopt
der:	jmp ProDOS_err

;
; illegal parameter
;
illeg_parm:
	lda #der_illegparm
	bne der

;
; getparm_n -- return the value of the Ath parameter
;              parsed
;
; return SEC if that parameter was not given
;
getparm_n:
	cmp num_parms
	bcs gpn_x
	asl a
	asl a
	tax
retval_x:
	lda parms+3,x
	pha
	lda parms+2,x
	pha
	lda parms+1,x
	tay
	pla
	tax
	pla
	clc
gpn_x:	rts

;
; getparm_ch -- get option parameter corresponding to
;               the character in A
;
;  return SEC if that parm was not given
;
getparm_ch:
	ldx #0
	ldy num_parms
	sec
	beq gpn_x
chk_ch:	cmp parms,x
	beq retval_x
	inx
	inx
	inx
	inx
	dey
	bne chk_ch
	sec
	rts
;
; get_strbuf -- move strbuf down and return address
; in AY
;
get_strbuf:
	sec
	lda strbuf
	sbc #128
	tay
	lda strbuf+1
	sbc #0
	cmp #>(string_buffs-$300) ;only 6 buffers available
	bcc s2many
	sta strbuf+1
	sty strbuf
	rts
s2many:	ldx #der_outroom
	jmp ProDOS_err

;
; free_sbuff -- deallocate last string buff
;
free_sbuff:
	clc
	lda strbuf
	adc #128
	sta strbuf
	bcc fsbxx
	inc strbuf+1
fsbxx:	rts

;
; parse a "y" or "n" parameter
;
pv_yesno:
	jsr chrgot
	jsr downcase
	cmp #$80+'y'
	beq @yes
	cmp #$80+'n'
	beq @no
	lda #der_ynexp
	jmp ProDOS_err
@no:	lda #0
	beq @yn		;always taken
@yes:	lda #<-1
@yn:	pha
	jsr calc_pindex
	pla
	sta parms+3,x
	jmp chrget

;
; parse an integer parameter (1, 2, or 3 bytes)
;
pv_int:	lda #0
	sta num
	sta num+1
	sta num+2
	sta num+3
	jsr chrgot
	cmp #$80+'$'
	bne not_hex
	jmp hex_num
not_hex:
	jsr chk_dig
	bcs num_exp

int_1:	pha
	jsr mult10num
	pla
	and #%00001111
	clc
	adc num
	sta num
	bcc num_ok
	inc num+1
	bne num_ok
	inc num+2
	beq overflow
num_ok:	jsr chrget
	jsr chk_dig
	bcc int_1
return_chk:
	lda num+3	;17-Oct-89
	bne overflow	;17-Oct-89
	ldy ptype
	cpy #t_int2
	bne num_ok2
	lda num+2
	bne overflow
num_ok2:
	cpy #t_int1
	bne num_ok3
	lda num+1
	ora num+2
	bne overflow
return_num:
num_ok3:
	jsr calc_pindex
	lda num+2
	sta parms+3,x
	lda num+1
	sta parms+2,x
	lda num
	sta parms+1,x
	clc
	rts

num_exp:
	lda #der_badnum
der3:	jmp ProDOS_err

overflow:
	lda #der_bignum
	bne der3

chk_dig:
	cmp #'9'+1+$80
	bcs chkdig_no
	cmp #$80+'0'
	bcc chkdig_no
	clc
	rts
chkdig_no:
	sec
	rts

;
; mult10um - multiply num (4 bytes) by 10
;
; destroys temp (4 bytes)
;
; Overflow: Bails out, does not return.
;
mult10num:
	lda num
	ldx num+1
	ldy num+2
	sta temp
	stx temp+1
	sty temp+2
	lda num+3
	sta temp+3
	jsr mult2num	; *2
	jsr mult2num	; *4
	clc
	lda num
	adc temp
	sta num
	lda num+1
	adc temp+1
	sta num+1
	lda num+2
	adc temp+2
	sta num+2
	lda num+3
	adc temp+3
	sta num+3	; *5
	bcs overflow
mult2num:
	asl num
	rol num+1
	rol num+2
	rol num+3
	bcs overflow
	rts

;
; hex_num - parse a hex number
;
; Overflow: Bails out, does not return.
;
hex_num:
	jsr chrget	;skip past "$"
	jsr chk_hex
	bcs hex_exp
hex_1:	pha
	jsr mult2num
	jsr mult2num
	jsr mult2num
	jsr mult2num
	pla
	clc
	adc num
	sta num
	bcc hnum_ok
	inc num+1
	bcc hnum_ok
	inc num+2
	bne hnum_ok
	jmp overflow
hnum_ok:
	jsr chrget
	jsr chk_hex
	bcc hex_1
	jmp return_chk

hex_exp:
	lda #der_badnum
	jmp ProDOS_err

chk_hex:
	jsr downcase
	cmp #$80+'0'
	bcc hex_x
	cmp #'f'+1+$80
	bcs hex_x
	cmp #'9'+1+$80
	bcc is_hex
	cmp #$80+'a'
	bcs is_hex0
hex_x:	sec
	rts
is_hex0:
	sec
	sbc #'a'-':'
is_hex:	and #%00001111
	clc
	rts
;
; Parse a path or string parm (possibly null,
; and possibly quoted); path possibly followed
; by a Type specifier (:xxx)
;
; Single (') or double (") quotes can be used,
; and a quote mark may be doubled inside the
; string to get just one quote (like Pascal
; does for single quotes)
;
pv_string:
	jsr get_strbuf
	sta p+1
	sty p
	sta parms+3,x
	tya
	sta parms+1,x
	lda #0
	sta parms+2,x	;file type
	sta quotechr
	tay
	sta (p),y
	sty string_index
	jsr munch_space
	jsr chrgot
	cmp #$80+'-'
	beq strdun
	cmp #$A7
	beq gotqch
	cmp #$A2	;double quote
	bne pstr_1
gotqch:	sta quotechr
pstr_0:	jsr chrget
pstr_1:	jsr chrgot
	beq strdun
	ldx quotechr
	bne sep_allowed
; if unquoted, check for blank, ";", comma
	cmp #$80+' '
	beq strdun
	cmp #$80+','
	beq strdun0
	cmp #$80+';'
	beq strdun
	ldy ptype
	cpy #t_string
	beq sep_allowed
	cmp #$80+':'
	beq typespec
sep_allowed:
	cmp quotechr
	beq strdun0
StrChar:
	inc string_index
	ldy string_index
	and #%01111111
	sta (p),y
	bne pstr_0
strdun0:
	jsr chrget
	beq strdun	;23-Feb-88
	cmp quotechr	;
	beq StrChar	;
strdun:	lda string_index
	ldy #0
	sta (p),y
	rts

typespec:
	lda string_index
	ldy #0
	sta (p),y
	jsr calc_pindex
	lda parms+1,x
	pha
	lda parms+3,x
	pha
	jsr chrget	;skip past colon
	jsr pv_ftype
	jsr calc_pindex
	lda num+2
	sta parms+2,x
	pla
	sta parms+3,x
	pla
	sta parms+1,x
	rts
;
; parse a file type -- xxx or 1-byte integer
;
ftyp_int:
	jsr pv_int
	lda num+1
	ora num+2
	beq ftyp_ok
	jmp overflow
ftyp_ok:
	lda num
	sta num+2
	jmp return_num

pv_ftype:
	jsr munch_space
	cmp #$80+'$'
	beq ftyp_int
	jsr chk_dig
	bcc ftyp_int
	jsr calc_pindex
	jsr pv_string
	ldy #0
	lda (strbuf),y
	cmp #3
	beq is3
	lda #der_needs3
	jmp ProDOS_err

is3:	jsr free_sbuff
	ldx #0	;index into filetyp
	lda #>fileasc
	ldy #<fileasc
	sta p2+1
	sty p2
	inc p
	bne :+
	inc p+1
:
chktyp1:
	ldy #2
chktyp2:
	lda (p),y
	jsr downcase
	sta temp
	lda (p2),y
	jsr downcase
	cmp temp
	bne chknextt
	dey
	bpl chktyp2
	lda filetyp,x
	sta num+2
	jmp return_num

chknextt:
	inx
	clc
	lda p2
	adc #3
	sta p2
	bcc @p2ok
	inc p2+1
@p2ok:	lda filetyp,x
	bne chktyp1

	ldx #0	;index into filetyp0
	lda #>fileasc0
	ldy #<fileasc0
	sta p2+1
	sty p2
chktyp1b:
	ldy #2
chktyp2b:
	lda (p),y
	jsr downcase
	sta temp
	lda (p2),y
	jsr downcase
	cmp temp
	bne chknextt2
	dey
	bpl chktyp2b
	lda filetyp0,x
	sta num+2
	jmp return_num

chknextt2:
	inx
	clc
	lda p2
	adc #3
	sta p2
	bcc p2ok2
	inc p2+1
p2ok2:	lda filetyp0,x
	bne chktyp1b

	lda #der_unknftyp
	jmp ProDOS_err
;
; parse a devnum value:   .sd
;
pv_devnum:
	jsr chrgot
	cmp #$80+'.'
	bne dvnerr
	jsr chrget
	cmp #$80+'1'
	bcc dvnerr
	cmp #$80+'8'
	bcs dvnerr
	and #%00001111
	asl a
	asl a
	asl a
	asl a
	sta temp
	jsr chrget
	cmp #$80+'1'
	bcc dvnerr
	cmp #$80+'3'
	bcs dvnerr
	and #%00000001
	ror a
	ror a
	eor #%10000000
	ora temp
	pha
	jsr calc_pindex
	pla
	sta parms+3,x
	jmp chrget
dvnerr:	lda #der_baddev
	jmp ProDOS_err

;
; getln -- print prefix and input a line of text
;
getln:
	lda #0
	jsr redirect
	asl a
	bmi cmd_again
	jsr print_pfx
	message_cstr ": "
cmd_again:
	jsr mygetln
	bcs cmd_again
	stx string-1
	cpx #0
	beq dont_keep
	lda #>(string-1)
	ldy #<(string-1)
	ldx #mli_write
	jsr HistoryMgr
dont_keep:
	ldx string-1
	rts
;
; print_pfx -- get prefix and print it
;
print_pfx:
	jsr get_pfx
	ldx string2-1
	beq :+
	dec string2-1
:	jmp print_path

;
; get_pfx
;
get_pfx:
	CALLOS mli_getpfx, get_pfx_parms
	CALLOS_BRANCH_NEG pfx_err
	jsr pmgr
	.byte pm_downcase
	.addr string2-1
	lda #>(string2-1)
	ldy #<(string2-1)
	rts

pfx_err:
	jmp ProDOS_err
;
; set_pfx
;
set_pfx:
	CALLOS mli_setpfx, set_pfx_parms
	CALLOS_BRANCH_NEG pfx_err
	rts

;
; print_p
;
print_p:
	ldy #0
pp1:	lda (p),y
	beq :+
	ora #$80
	jsr cout
	iny
	bne pp1
:	rts

;
; upcase
;
upcase:	ora #%10000000
	cmp #$80+'a'
	bcc uc_x
	cmp #'z'+1+$80
	bcs uc_x
	and #%11011111
uc_x:	rts

;
; downcase
;
downcase:
	ora #%10000000
	cmp #$80+'A'
	bcc :+
	cmp #'Z'+1+$80
	bcs :+
	ora #%00100000
:	rts

;***********************************************
;
; clear screen and print title
;
clear_sc:
.if IsDavex2
	lda #$80+'L'-ctrl
	jsr cout
	lda #0
	jsr redirect
	bmi nohome
.endif
	jsr home
nohome:	rts

;
; welcome
;
welcome:
	lda cfgquiet
	beq wNotQuiet
	cmp #2
	beq Quiet
	bit speech
	bmi Quiet
wNotQuiet:
	jsr pDavexVer

	jsr mess
	.byte cr
	cstr_cr "Type ? for help, $ for Freeware notice."
	jmp print_time

pDavexVer:
	message_cstr "Davex "
	lda #myversion
	jsr print_ver
	lda #AuxVersion+$80+'0'
	jsr cout
	jsr mess
.if  Proto 
	asc "p"
.endif
	cstr "  "
Quiet:	rts

;***********************************************
;
; shell_info --
;   X = request code
;   Exit: CLC if okay, info in registers
;
shell_info:
	txa
	bne shinf1
; shell_info(0) = version(AY)
	lda #myversion
	ldy #AuxVersion
	clc
	rts
shinf1:	dex
	bne shinf2
; shell_info(1) = alias buffer(AY=adr,X=pages)
	lda #>Aliases
	ldy #<Aliases
	ldx #3
	clc
	rts
shinf2:	dex
	bne shinf3
; shell_info(2) = history buffer(AY=adr,X=pages)
	lda #>History
	ldy #<History
	ldx #1
	clc
	rts
shinf3:	dex
	bne shinf4
; shell_info(3) = internal filetype table(AY)
	lda #>filetyp0
	ldy #<filetyp0
	clc
	rts
shinf4:	dex
	bne shinf5
; shell_info(4) = internal filetype name tbl(AY)
	lda #>fileasc0
	ldy #<fileasc0
	clc
	rts
shinf5:	sec
	rts


x99:		.byte 0		; [TODO] move to davex_io.asm (2 and 3), where it's used
exec_flag:	.byte 0
fudgeCR:	.byte 0

;**************************************
;
; Davex command table and commands
;
;**************************************
;
; Do scan -i
;
;**************************************
;
; command table format:
;  list of <command_entry>
;
; <command_entry> ::=
;   name   $00
;   cmd address
;   list of <positional_parm>
;   list of <optional_parm>
;
; <positional_parm> ::=
;   $00  (no option character)
;   <parm_type>
;
; <optional_parm> ::=
;   <option_character>
;   <parm_type>
;
;************************************
cmdtbl:
	asc_hi "bye"
	.byte 0
	.addr go_quit
	.byte 0,0

	asc_hi "$"
	.byte 0
	.addr copyright
	.byte 0,0

	asc_hi "version"
	.byte 0
	.addr wNotQuiet
	.byte 0,0

	asc_hi "rep"
	.byte 0
	.addr go_repeat
	.byte 0,t_int2
	.byte 0,0

	asc_hi "config"
	.byte 0
	.addr go_config
	.byte $80+'p',t_int1
	.byte $80+'4',t_yesno
	.byte $80+'c',t_yesno
	.byte $80+'b',t_yesno
	.byte $80+'q',t_int1
	.byte $80+'h',t_string
	.byte 0,0

	asc_hi "como"
	.byte 0
	.addr go_como
	.byte 0,t_wildpath
	.byte 0,0

	asc_hi "exec"
	.byte 0
	.addr go_exec
	.byte 0,t_wildpath
	.byte 0,0

	asc_hi "prefix"
	.byte 0
	.addr go_prefix
	.byte 0,t_wildpath
	.byte 0,0

	asc_hi "boot"
	.byte 0
	.addr go_boot
	.byte $80+'s',t_int1
	.byte $80+'i',t_nil	;ice cold!
	.byte 0,0

	asc_hi "mon"
	.byte 0
	.addr go_mon
	.byte 0,0

	asc_hi "up"
	.byte 0
	.addr go_up
	.byte 0,0

	asc_hi "top"
	.byte 0
	.addr go_top
	.byte 0,0

	asc_hi "help"
	.byte 0
	.addr go_help
	.byte 0,t_string
	.byte 0,0

	asc_hi "?"
	.byte 0
	.addr go_help
	.byte 0,t_string
	.byte 0,0

	asc_hi "online"
	.byte 0
	.addr go_online
	.byte $80+'o',t_nil
	.byte 0,0

	asc_hi "cls"
	.byte 0
	.addr clear_sc
	.byte 0,0

	asc_hi "type"
	.byte 0
	.addr go_type
	.byte 0,t_wildpath
	.byte $80+'h',t_nil
	.byte $80+'f',t_nil
	.byte $80+'u',t_nil
	.byte $80+'l',t_nil
	.byte $80+'p',t_nil
	.byte $80+'t',t_string
	.byte 0,0

	asc_hi "pg"
	.byte 0
	.addr go_more
	.byte 0,t_wildpath
	.byte $80+'h',t_nil
	.byte $80+'f',t_nil
	.byte $80+'u',t_nil
	.byte $80+'l',t_nil
	.byte $80+'p',t_nil
	.byte $80+'t',t_string
	.byte 0,0

	asc_hi "rename"
	.byte 0
	.addr go_rename
	.byte 0,t_wildpath
	.byte 0,t_path
	.byte 0,0

	asc_hi "filetype"
	.byte 0
	.addr go_ctype
	.byte 0,t_wildpath
	.byte 0,t_ftype
	.byte $80+'x',t_int2
	.byte 0,0

	asc_hi "create"
	.byte 0
	.addr go_create
	.byte 0,t_path
	.byte 0,0

	asc_hi "dt"
	.byte 0
	.addr print_time
	.byte 0,0

	asc_hi "delete"
	.byte 0
	.addr go_del
	.byte 0,t_wildpath
	.byte $80+'u',t_nil
	.byte 0,0

	asc_hi "lock"
	.byte 0
	.addr go_lock
	.byte 0,t_wildpath
	.byte 0,0

	asc_hi "unlock"
	.byte 0
	.addr go_unlock
	.byte 0,t_wildpath
	.byte 0,0

	asc_hi "prot"
	.byte 0
	.addr go_prot
	.byte 0,t_wildpath
	.byte $80+'r',t_nil
	.byte $80+'w',t_nil
	.byte $80+'d',t_nil
	.byte $80+'n',t_nil
	.byte 0,0

	asc_hi "scan"
	.byte 0
	.addr go_scan
	.byte $80+'a',t_string
	.byte $80+'r',t_string
	.byte $80+'z',t_nil
	.byte $80+'i',t_string
	.byte 0,0

	asc_hi "cat"
	.byte 0
	.addr go_cat
	.byte 0,t_wildpath
	.byte $80+'a',t_string
	.byte $80+'t',t_nil
	.byte $80+'s',t_nil
	.byte $80+'f',t_ftype
	.byte $80+'i',t_nil
	.byte 0,0

	asc_hi "spool"
	.byte 0
	.addr go_spool
	.byte 0,t_wildpath
;dfb $80+'h',t_string ;header
;dfb $80+'l',t_int1 ;lines/page
;dfb $80+'w',t_int1 ;page width
	.byte $80+'x',t_int1	;cancel 1
	.byte $80+'z',t_nil	;zap (cancel all)
	.byte 0,0

	asc_hi "info"
	.byte 0
	.addr go_info
	.byte 0,t_wildpath
	.byte 0,0

	asc_hi "update"
	.byte 0
	.addr go_update
	.byte 0,t_wildpath
	.byte 0,t_wildpath
	.byte $80+'f',t_nil
	.byte $80+'b',t_nil
	.byte 0,0

	asc_hi "copy"
	.byte 0
	.addr go_copy
	.byte 0,t_wildpath
	.byte 0,t_wildpath
	.byte $80+'d',t_nil	;delete orig
	.byte $80+'f',t_nil	;force delete
	.byte $80+'b',t_nil	;clr bkup bit
	.byte 0,0

	asc_hi "move"
	.byte 0
	.addr go_move
	.byte 0,t_wildpath
	.byte 0,t_wildpath
	.byte $80+'f',t_nil	;force delete
	.byte 0,0

	asc_hi "touch"
	.byte 0
	.addr go_touch
	.byte 0,t_wildpath
	.byte $80+'b',t_yesno
	.byte $80+'d',t_yesno
	.byte $80+'i',t_yesno
	.byte 0,0

.if IsDavex2
	asc_hi "dev"
	.byte 0
	.addr go_dev
	.byte $80+'r',t_devnum
	.byte $80+'a',t_devnum
	.byte $80+'z',t_nil
	.byte 0,0
.endif

	asc_hi "ftype"
	.byte 0
	.addr go_ftype
	.byte $80+'r',t_ftype
	.byte $80+'a',t_string
	.byte $80+'v',t_ftype
	.byte $80+'z',t_nil
	.byte 0,0

; [TODO] what was "appl" going to do if implemented? Maybe assign filetypes to applications,
;	so you can launch something by document path and automatically have the right app
;	use the document?
;;;;;
; asc_hi "appl"
; .byte 0
; .addr go_appl
; .byte $80+'r',t_ftype
; .byte $80+'a',t_ftype
; .byte $80+'p',t_string
; .byte 0,0

	asc_hi "err"
	.byte 0
	.addr go_err
	.byte 0,t_int1
	.byte 0,0

	asc_hi "="
	.byte 0
	.addr go_equal
	.byte 0,t_wildpath
	.byte 0,t_path
	.byte 0,0

	asc_hi "size"
	.byte 0
	.addr go_size
	.byte 0,t_wildpath
	.byte 0,0

	asc_hi "echo"
	.byte 0
	.addr go_echo
	.byte 0,t_string
	.byte $80+'n',t_nil	;no CR
	.byte 0,0

	asc_hi "eject"
	.byte 0
	.addr go_eject
	.byte 0,t_path
	.byte 0,0

	asc_hi "wait"
	.byte 0
	.addr go_wait
	.byte 0,0

	asc_hi "num"
	.byte 0
	.addr go_num
	.byte 0,t_int3
	.byte 0,0

 .if RemoteImp 
	asc_hi "remote"
	.byte 0
	.addr go_remote
	.byte 0,t_int1
	.byte 0,0
 .endif


; asc_hi "mem"
; .byte 0
; .addr go_mem
; .byte 0,0

; end of command table
	.byte 0,0

;********************************************
notspool:
	bit spooling
	bmi ouchspool
	rts
ouchspool:
	lda #der_waitspool
	jmp ProDOS_err

;********************************************
go_num:	sta num+2
	stx num+1
	sty num
	message_cstr "  $"
	lda num+2
	jsr prbyte
	lda num+1
	jsr prbyte
	lda num
	jsr prbyte
	message_cstr " = "
	jsr prdec
	jmp crout

;********************************************
go_wait:
	bit spooling
	bpl :+
	jsr poll_io
	bit keyboard
	bpl go_wait
	sta kbdstrb
	jmp yn_abort
:	rts

;********************************************
s16_flag:
	.byte 0

go_quit:
.if IsDavex3
	lda #0
	SET_LEVEL
	jsr close
	clc		; [TODO] why?
.else
	clc
	ror s16_flag
	sta s16_name+1
	sty s16_name
	jsr notspool
	lda #0
	SET_LEVEL
	jsr close
	jsr off80
	lda #$ff
	ldy #$59
	sta $3fd
	sty $3fc

	lda $3f3
	sta $3f4
; quitting to S16?
	bit s16_flag
	bmi quit_s16
.endif

os_quit:
	CALLOS mli_bye, bye_parms
	jmp ProDOS_err

.if IsDavex2
quit_s16:
	CALLOS mli_bye, quit2_parms
	jmp ProDOS_err

quit2_parms:
	.byte 4,$ee
s16_name:
	.addr 0
	.byte 0,0,0
.endif

;*********************************************
;
; boot [-s slot#] [-i]
;
;   -i = ice-cold boot (IIgs)
;
go_boot:
.if IsDavex2
	lda reset+1
	sta reset+2
; If IIgs, do what the ProDOS-16 PQUIT thinger does
; on 'Reboot system'
	sec
	jsr $fe1f	;CLC on IIgs
	bcs rb_NotGS
	sei
	lda #0
.P816
	sta $E0C035	; Shadow register
.P02
	sta $c047	;clear VBL/3_75Hz int flags
	sta $c041	;disable lots of ints
	lda #9
	sta $c039	;SCC channel A cmd reg
	lda #$c0
	sta $c039
; if -i, trash $5f in the Keyboard Micro's RAM
	lda #$80+'i'
	jsr getparm_ch
	bcs no_ice
	jsr ice_it
no_ice:
rb_NotGS:

	jsr off80
	jsr home
	start_normal
	lda #$80+'i'	;
	jsr getparm_ch	;
	bcc badslot	;
	lda #$80+'s'
	jsr getparm_ch
	bcc boot_slot
badslot:
	jmp ($fffc)

boot_slot:
	lda #0
	sta p
	tya
	beq badslot
	cmp #7+1
	bcs badslot
	ora #$C0
	sta p+1
	jmp (p)

;
; ice_it: (OpenApple V3#6, p3_48)
;
.P816
ice_it:
	clc
	XCE
	rep #$30
.A16
.I16
	lda #$0051
	sta $0000
	pea $0002	; send 2 bytes
	pea $0000
	pea $0000
	pea $0008	; write Key Micro RAM
	ldx #$0909	; send to ADB
	jsl $e10000	; Stores $00 into $51 (Key Micro RAM)
	sec
	XCE
	rts
.P02
.else ; IsDavex3
	lda #$53	; Switch in ROM#1, I/O, disable reset switch
	sta e_reg	; Set the environment register
	jmp boot	; Jump to boot code in ROM
.endif
;
; handle an NMI
;
NMIouch:
	sec
	bcs mon2
;
; enter monitor
;
go_mon:
.if IsDavex2
	jsr notspool
	clc
mon2:	php
	jsr off80
	jsr home
	start_normal
	plp
	bcc no_nmi
	message_cstr_cr "Ouch!"
no_nmi:	jmp monitor

.else ; IsDavex3

mon2:	lda #columns40
	sta INIT_SCREEN_COLUMNS
	jsr set_columns
	jsr home
	jmp monitor
.endif

;
; prefix <path>
;
go_prefix:
setthepfx:
	sta pfxstradr+1
	sty pfxstradr
.if IsDavex3
				; SOS won't change directory to a relative path.
				; So, if a request is made without a leading slash,
				; prefix it with the current directory.
	sty p
	sta p+1
	ldy #$01
	lda (p),y		; Check out the first character
	cmp #'/'			; Is it a slash?
	beq set_prefix_literal	; Yes - then just set the request literally
	jsr get_pfx		; Otherwise, get current prefix - AY points to string2
	jsr xpmgr
	.byte pm_slashif		; Append a trailing slash, if needed
	.addr string2-1

	lda pfxstradr+1
	ldy pfxstradr
	jsr xpmgr
	.byte pm_appay		; Append the requested prefix string at ay to string2
	.addr string2-1

	ldy #<(string2-1)
	sty pfxstradr
	lda #>(string2-1)
	sta pfxstradr+1		; Point the set prefix call at the concatenated string
set_prefix_literal:

.endif ; IsDavex3
	CALLOS mli_setpfx, pfxcmdparms
	CALLOS_BRANCH_POS set_ok
	jmp ProDOS_err
set_ok:	rts

pfxcmdparms:
	.byte 1
pfxstradr:
	.res 2

;
; up -- leave a subdirectory
;
go_up:	jsr get_pfx
	jsr pmgr
	.byte pm_up
	.addr string2-1
	jmp set_pfx

;
; top
;
go_top:	jsr get_pfx
	ldx string2-1
	beq topped
	ldy #0		;# slashes
countSlashes:
	lda string2-1,x
	ora #$80
	cmp #$80+'/'
	bne cs_not
	iny
cs_not:	dex
	bne countSlashes
	cpy #3
	bcc topped
	jsr go_up
	jmp go_top
topped:	rts

;*********************************************
;
; 'type' command -- show contents of a file (without pausing like 'pg' and 'more')
;
case_flags:	.res 1
pause_flag:	.res 1
line_count:	.res 1
saved_tchr:	.res 1

go_type:
	clc
type_pg:
	ror pause_flag

	lda #$80+'f'
	jsr getparm_ch
	ror a
	sta filter

	lda #$80+'l'
	jsr getparm_ch
	ror case_flags
	lda #$80+'u'
	jsr getparm_ch
	ror case_flags

	lda #0
	jsr getparm_n
more2:	pha
	tya
	pha
; don't prompt if output redirected
	lda #0
	jsr redirect
	bpl :+
	lsr pause_flag
:	pla
	tay
	pla
	jsr fman_open
	bcc typeopened
type_err:
	jmp ProDOS_err
typeopened:
	sta type_readref
	sta tyeofr
	CALLOS mli_geteof, tyeof
	CALLOS_BRANCH_NEG type_err

	lda #23
	sta line_count
;
; print header if -h given
;
	lda #$80+'h'
	jsr getparm_ch
	bcs no_head
	message_cstr "******* "
	lda p+1
	ldy p
	jsr print_path
	message_cstr "--modified "
	lda p+1
	ldy p
	jsr getinfo
	lda info_moddat+1
	ldy info_moddat
	jsr pr_date_ay
	lda info_modtim+1
	ldy info_modtim
	jsr pr_time_ay
	jsr mess
	asc " *******"
	.byte cr,cr,0
	dec line_count
	dec line_count
no_head:

	lda scr_width
	sta temp
type_1:	jsr poll_io
	lda type_readref
	jsr fman_read
	bcc treadok
	cmp #err_eof
	bne typerr9
	jmp type_finish
typerr9:
	jmp ProDOS_err
treadok:
	ora #%10000000
	sta saved_tchr
	cmp #$80+'M'-ctrl
	bne not_typeret
typeret:
	ldx scr_width
	inx
	stx temp
	jsr check_wait
	bcc type_chk1
	jmp type_finish
type_chk1:
	lda saved_tchr
	dec line_count
	bne print_char
	lda #23
	sta line_count
	lda saved_tchr
	bit pause_flag
	bpl print_char
	jsr suspend
	jsr TalkCont
	jsr mess
	.byte cr
	cstr "--- "
	jsr type_percent
	jsr prdec_1
	message_cstr "% --- more"
	lda #$80+'y'	;default = Yes
	jsr yesno2
	jsr restore
	beq type_finish
	lda saved_tchr
	jmp print_char

not_typeret:
	cmp #$89
	bne not_TAB
	lda #$80+'t'
	jsr getparm_ch
	bcs not_TAB0
	jsr print_path
	jmp type_1

not_TAB0:
	lda #$89
not_TAB:
	bit filter
	bpl print_char
	cmp #$a0
	bcs print_char
	jmp type_1
print_char:
.if IsDavex3
	cmp #$8d
	bne :+
	lda #$0d
:
.endif
	dec temp
	beq typeret
	bit case_flags
	bmi t_no_up
	jsr upcase
t_no_up:
	bit case_flags
	bvs t_no_down
	jsr downcase
t_no_down:
	jsr cout
	jmp type_1


type_finish:
	lda #$80+'p'
	jsr getparm_ch
	bcs type_done
	jsr clear_sc
type_done:
	lda type_readref
	jsr close
	rts

type_percent:
	lda tyeofr
	sta tymarkr
	CALLOS mli_getmark, tymark
	lda tymarkval+2
	ldx tymarkval+1
	ldy tymarkval
	sta num+2
	stx num+1
	sty num
	lda tyeofval+2
	ldx tyeofval+1
	ldy tyeofval
	jmp percent

tymark:		.byte 2
tymarkr:	.res 1
  .if IsDavex3
tymarkval:	.res 4	; SOS has a four-byte tymarkval result.
  .else
tymarkval:	.res 3
  .endif

tyeof:		.byte 2
tyeofr:		.res 1
tyeofval:
.if IsDavex3
		.res 4	; SOS has a four-byte result
.else
		.res 3
.endif

type_readref:	.res 1
filter:		.res 1

;
; pg and more commands -- show contents of file;
; pause between pages
;
go_more:
	sec
	jmp type_pg

;****************************************************
;
; rename command:  rename <path1> <path2>
;
go_rename:
	sta rename_1+1
	sty rename_1
	lda #1
	jsr getparm_n
	sta rename_2+1
	sty rename_2
	CALLOS mli_rename, rename_parms
	CALLOS_BRANCH_NEG rename_err
	rts
rename_err:
	jmp ProDOS_err

rename_parms:	.byte 2
rename_1:	.res 2
rename_2:	.res 2

;
; ctype command: ctype <path1> <type> (-x auxtype)
;
; Change filetype.
;
ctype_typ:	.res 1

go_ctype:
	sta p+1
	sty p
	jsr getinfo
	lda #1
	jsr getparm_n
	sta info_type
; if -x given, change aux type
	lda #$80+'x'
	jsr getparm_ch
	bcs same_aux
	stx info_auxtype+1
	sty info_auxtype
same_aux:
	lda p+1
	ldy p
	jmp setinfo

;****************************************
;
; create <path>[:type]
;
go_create:
	sta cr_path+1
	sty cr_path
	cpx #0
	bne :+
	ldx #tDIR
:	stx cr_type
	ldy #1		;storage type for seedling
	cpx #tDIR
	bne cr_seed
	ldy #$d		;storage type for directory
cr_seed:
	sty cr_stype
	CALLOS mli_create, cr_parms
	CALLOS_BRANCH_NEG cr_err
	rts

cr_err:	jmp ProDOS_err

;
; unlock
;
go_unlock:
	lda #%11111111	;AND mask
	ldy #%11000011	;OR mask: RWND
	bne protect
;
; lock
;
go_lock:
	lda #%00111100	;AND mask
	ldy #%00000001	;OR mask: R
	bne protect

protect:
	sta and_mask
	sty or_mask
; get file access
	lda #0
	jsr getparm_n
	sta p+1
	sty p
	jsr getinfo
	lda info_acc
	and and_mask
	ora or_mask
	sta info_acc
	lda p+1
	ldy p
	jmp setinfo

;*******************************************
;
; prot <path> -r -w -n -d
;
go_prot:
	lda #%00000000
	pha
	lda #$80+'r'
	jsr getparm_ch
	bcs protp1
	pla
	ora #%00000001	;R
	pha
protp1:	lda #$80+'w'
	jsr getparm_ch
	bcs protp2
	pla
	ora #%00000010	;W
	pha
protp2:	lda #$80+'n'
	jsr getparm_ch
	bcs protp3
	pla
	ora #%01000000	;N
	pha
protp3:	lda #$80+'d'
	jsr getparm_ch
	bcs protp4
	pla
	ora #%10000000
	pha
protp4:	pla
	tay
	lda #%00111100	;AND: clear RWND
	jmp protect

;***************************************************
;
; scan [-a add_path] [-r remove_path]
;      [-z defaults] [-i insert]
;
go_scan:
	lda num_parms
	bne scan_parms
; show list of cmd directories
	lda scanlist
	bne somedirs
	message_cstr_cr "no command dirs"
	rts

somedirs:
	message_cstr_cr "command dirs:"
	ldx #0
scan_show1:
	lda scanlist,x
	beq scan_shown
	stx temp
	message_cstr "  "
	ldx temp
	lda scanlist,x	;length
	tay
scanshowch:
	inx
	lda scanlist,x
	ora #%10000000
	jsr cout
	dey
	bne scanshowch
	inx
	stx temp
	jsr crout
	jmp scan_show1
scan_shown:
	rts

; Default scan-path entries
scan_dflt:
	pstr "%"
	pstr "*"
	.byte 0

scan_zap:
	ldy #<-1
scanz1:	iny
	lda scan_dflt,y
	sta scanlist,y
	bne scanz1
	jmp makedirt

scan_parms:
	lda #$80+'z'
	jsr getparm_ch
	bcs @notz
	jsr scan_zap
@notz:	lda #$80+'r'
	jsr getparm_ch
	bcs @notrem
	jsr findscan_x
	bcc :+
	lda #der_notfnd
	jmp ProDOS_err
:	txa
	sec
	adc scanlist,x
	tay
@squish:
	lda scanlist,y
	sta scanlist,x
	inx
	iny
	bpl @squish

@notrem:
	lda #$80+'a'
	jsr getparm_ch
	bcs scan_notadd
	jsr findscan_x
	bcc scan_notadd
	ldy #0
	lda (p),y
	sta count
;;;	sec
	txa
	adc count
	bpl scan_fits

	lda #der_outroom
	jmp ProDOS_err

scan_fits:
scappend:
	lda (p),y
	sta scanlist,x
	iny
	inx
	dec count
	bpl scappend
	lda #0
	sta scanlist,x

scan_notadd:
	sec
	ror config_dirty
	rts

count:	.res 1

findscan_x:
	sta p+1
	sty p
	ldy #0
	lda (p),y
	cmp #1
	beq noslash
	tay
	lda (p),y
	cmp #$2f
	beq noslash	;don't add one
	iny
	tya
	lda #$2f
	sta (p),y
	tya
	ldy #0
	sta (p),y	;update len
noslash:
	ldx #0
fsx1:	stx temp
	ldy #0
	lda (p),y	;length of target
	cmp scanlist,x	;same lengths?
	bne fsxnext
	sta count
fsxcomp:
	iny
	inx
	lda (p),y
	jsr downcase
	sta scchar
	lda scanlist,x
	jsr downcase
	cmp scchar
	bne fsxnext
	dec count
	bne fsxcomp
	clc
	ldx temp
	rts

scchar:	.byte 0

fsxnext:
	ldx temp
	lda scanlist,x
	beq scanx
	txa
	sec
	adc scanlist,x
	tax
	lda scanlist,x
	bne fsx1
scanx:	sec		;not found
	rts

;**************************************************
;
; info <path> -- print info on file & volume
;
go_info:
	jsr empty_prefix
	sta p+1
	sty p
	sta info_path+1
	sty info_path
	jsr getinfo
; devnum may change if output redirected
	lda devnum
	pha
	jsr mess
	.byte cr
	cstr "name:      "
	lda #0
	jsr getparm_n
	jsr empty_prefix
	jsr prnt_compl
	message_cstr "   "
	pla		;get devnum
	jsr print_sd
	jsr mess
	.byte cr
	cstr "strg type: "
	lda info_stype
	jsr print_stype
	jsr mess
	.byte cr
	cstr "type:      "
	lda info_type
	jsr print_ftype
	jsr mess
	cstr "        access: "
	lda info_acc
	jsr print_access
	jsr mess
	.byte cr
	cstr "aux type:  "
	lda info_auxtype+1
	ldy info_auxtype
	jsr prdec_2
	jsr mess
	cstr "  ($"
	lda info_auxtype+1
	jsr prbyte
	lda info_auxtype
	jsr prbyte
	jsr mess
	.byte ')',cr
	cstr "blocks:    "
	lda info_blocks+1
	ldy info_blocks
	jsr prdec_2
	jsr crout

	lda info_crdat+1
	ora info_crdat
	ora info_crtim+1
	ora info_crtim
	beq info_nullcr
	jsr mess
	cstr "created:   "
	lda info_crdat+1
	ldy info_crdat
	jsr pr_date_ay
	lda info_crtim+1
	ldy info_crtim
	jsr pr_time_ay
	jsr crout
info_nullcr:
	lda info_moddat+1
	ora info_moddat
	ora info_modtim+1
	ora info_modtim
	beq info_nullmod
	message_cstr "modified:  "
	lda info_moddat+1
	ldy info_moddat
	jsr pr_date_ay
	lda info_modtim+1
	ldy info_modtim
	jsr pr_time_ay
	jsr crout
info_nullmod:
info_nbin:
	rts

startup_size:
	sta info_path+1
	sty info_path
	lda #0
	tay
zrpgbf:	sta pagebuff,y
	dey
	bne zrpgbf	;in case file is short!
	CALLOS mli_open, info_op
	CALLOS_BRANCH_NEG info_err
zrpgbfOK:
	lda inforef
	sta inforef2
	CALLOS mli_read, info_rd
; a short read is not an error (no CALLOS_BRANCH_NEG info_err)
	lda inforef
	jsr close
	lda pagebuff
	cmp #$4c
	bne cbuf0
	lda #$ee
	cmp pagebuff+3
	bne cbuf0
	cmp pagebuff+4
	bne cbuf0
	lda pagebuff+5
	rts
cbuf0:	lda #0
	rts

info_err:
	jmp ProDOS_err

info_rd:	.byte 4
inforef2:	.res 1
		.addr pagebuff
		.addr 256
		.addr 0

print_stype:
	cmp #1
	beq st_seed
	cmp #2
	beq st_sap
	cmp #3
	beq st_tree
	cmp #4
	beq st_pasc
	cmp #5
	beq st_extended
	cmp #$D
	beq stp_dir
	cmp #$F
	beq st_vol
	jmp prdec_1
st_seed:
	message_cstr "seedling"
	rts
st_sap:	message_cstr "sapling"
	rts
st_tree:
	message_cstr "tree"
	rts
st_pasc:
	message_cstr "pascal area"
	rts
st_extended:
	message_cstr "extended"
	rts
stp_dir:
	message_cstr "subdirectory"
	rts
st_vol:	message_cstr "volume"
	rts

;
; repeat <int2>
;
go_repeat:
	stx rep_count+1
	sty rep_count
	tya
	ora rep_count+1
	beq rc_eq0
	cpy #0
	bne nodecrc1
	dec rep_count+1
nodecrc1:
	dec rep_count
rc_eq0:
	pla
	pla		; pop RTS address
	jmp repeated	; must cheat instead of returning normally

; [TODO] What was the 'remote' command going to do, if ever implemented? Control Davex from a serial card?
 .if  RemoteImp 
go_remote:
	cpy #1
	bcc remote0
	cpy #7+1
	bcs badrem
	sty remslot
; %%% only if not exec?!
	jsr finish_iredir
	rts
badrem:	lda #der_badnum
	jmp ProDOS_err
remote0:
	sty remslot
; %%% ?
	jsr finish_iredir
	jsr finish_oredir
	rts
 .endif


;*************************************************
;************************************************
;
; cmds2 -- lots more Davex commands
;
;************************************************
indent_level:	.byte 0
cat_ftype:	.byte 0
cat_devnum:	.byte 0
;
show_invis:
	.byte 0

;
; go_cat -- Catalog command
;
go_cat:	lda #0
	sta indent_level
	sta cat_ftype
	lda #$80+'i'
	jsr getparm_ch
	ror a
	eor #$80
	sta show_invis
	lda #$80+'f'
	jsr getparm_ch
	bcs c_noftp
	sta cat_ftype
c_noftp:
	lda #0
	jsr getparm_n
	jsr empty_prefix
	sta ptr+1
	sty ptr
	jsr getinfo
	lda devnum
	sta cat_devnum
	lda info_type
.if IsDavex3
	cmp #$00
	bne c_cmp_tdir
	lda #tDIR
.endif
c_cmp_tdir:
	cmp #tDIR
	beq cat_isdir
	lda #der_notdir
	jmp ProDOS_err
cat_isdir:
	lda #$80+'a'	;arrange
	jsr getparm_ch
	bcs cat_unsort
	sta sort_str+1
	sty sort_str
	jmp cat_sorted
cat_unsort:
	jsr push_level
	lda ptr+1
	ldy ptr
	jsr dir_setup
	jsr crout
	jsr cat_header
dir_1:	jsr read1dir_vis
	bcs dir_x
	jsr print1dir
	bcs dir_xx
	lda catbuff+16	;type
	cmp #tDIR
	bne cat_xnest
	lda #$80+'t'
	jsr getparm_ch
	bcs cat_xnest
	jsr push_level
	lda catbuff
	and #%00001111
	sta catbuff
	lda #>catbuff
	ldy #<catbuff
;
; use dir_setup2 to allow a partial path that is relative
; to the previous directory level; standard dir_setup
; paths must be relative to the PREFIX (or be complete)
;
	jsr dir_setup2
	bcc nest_ok
	pha
	ldx indent_level
	inx
	inx
	jsr indent_x
	pla
	jsr ProDOS_er2
	jsr dir_finish
	jmp nest_fail
nest_ok:
	inc indent_level
	inc indent_level
	bit speech
	bpl cat_xnest
	message_cstr_cr ">"
nest_fail:
cat_xnest:
	jmp dir_1
dir_x:	bit speech
	bpl dirdec
	lda indent_level
	beq dirdec
	message_cstr_cr "<"
dirdec:	dec indent_level
	dec indent_level
	jsr dir_finish
	lda indent_level
	bpl dir_1
	jmp cat_trailer
dir_xx:	jsr dir_finish
	dec indent_level
	dec indent_level
	bpl dir_xx
	rts
;
; -arrange the dir listing
;
cat_sorted:
	jsr push_level
	lda ptr+1
	ldy ptr
	jsr dir_setup
	jsr crout
	jsr cat_header
	lda #0
	sta keep_count+1
	sta keep_count
	jsr keep_init
catsrt1:
	jsr read1dir_vis
	bcs catsrt2
	jsr keep1dir
	jmp catsrt1
catsrt2:
	jsr dir_finish
	jsr sortdir
	jsr keep_init
catsrt3:
	jsr get1kept
	bcs catsrt_x
	jsr print1dir
	bcc catsrt3
catsrt_x:
	jmp cat_trailer

keep_count:
	.addr 0

;
; sort directory entries (length = entrylen) at
; 'keepbuff'.  There are keep_count(2 by) files
;
swapped:	.byte 0
srt_count:	.byte 0

sortdir:
	ldy #0	;if sort_str is empty, sort by name
	lda (sort_str),y
	bne sort_given
	lda #1
	sta (sort_str),y
	iny
	lda #$80+'n'
	sta (sort_str),y
sort_given:
	lda keep_count+1
	bne dont_srt
	lda keep_count
	pha
nextpass:
	lda #0
	sta swapped
	jsr sort1pass
	dec keep_count
	lda swapped
	bne nextpass
	pla
	sta keep_count
dont_srt:
	rts

sort1pass:
	lda keep_count
	sta srt_count
	beq sort_x
	lda #>keepbuff
	ldy #<keepbuff
sort1swap:
	sta p+1
	sty p
	dec srt_count
	beq sort_x
	clc
	lda p
	adc EntryLen
	sta p2
	lda p+1
	adc #0
	sta p2+1
	jsr cond_swap
	clc
	lda p
	adc EntryLen
	tay
	lda p+1
	adc #0
	jmp sort1swap
sort_x:	rts

sortstr_i:
	.byte 0	;index into sort string

cond_swap:
	ldy #0
	sty sortstr_i
cond1:	lda sortstr_i
	ldy #0
	inc sortstr_i
	cmp (sort_str),y
	bcs sortdun
	tay
	iny
	lda (sort_str),y
	ora #%10000000
	sta sort_char
	jsr downcase
	jsr doCmp
	beq cond1
	php
	lda sort_char
	cmp #$80+'a'
	bcc revSort
	plp
	bcs need2swap
	rts
revSort:
	plp
	bcc need2swap
sortdun:
	rts
need2swap:
	jmp swap_two

doCmp:	cmp #$80+'n'
	beq cmpNAME
	cmp #$80+'b'
	beq cmpBACKUP
	cmp #$80+'f'
	beq cmpTYPE
	cmp #$80+'t'
	beq cmpTYPE
	cmp #$80+'d'
	beq cmpModDATE
	cmp #$80+'m'
	beq cmpModDATE
	cmp #$80+'x'
	beq cmpAUX
	cmp #$80+'s'
	beq cmpSIZE
	cmp #$80+'c'
	beq cmpCrDATE
	lda #der_illegparm
	jmp ProDOS_err

cmpNAME:
	ldy #0
cmpNam:	iny
	cpy #16
	beq NamEq
	lda (p2),y
	jsr downcase
	sta temp
	lda (p),y
	jsr downcase
	cmp temp
	beq cmpNam
NamEq:	rts

cmpSIZE:
	ldy #$17
	lda (p2),y
	cmp (p),y
	bne cmpSZx
	dey
	lda (p2),y
	cmp (p),y
	bne cmpSZx
	dey
	lda (p2),y
	cmp (p),y
cmpSZx:	rts

cmpAUX:	ldy #$20
	lda (p),y
	cmp (p2),y
	bne cmpAUXx
	dey
	lda (p),y
	cmp (p2),y
cmpAUXx:
	rts

cmpBACKUP:
	ldy #$1e
	lda (p),y
	and #%00100000
	sta temp
	lda (p2),y
	and #%00100000
	cmp temp
	rts

cmpTYPE:
	ldy #16
	lda (p),y
	cmp (p2),y
	rts

cmpCrDATE:
	ldy #$18+1
	bne cmpDate
cmpModDATE:
	ldy #$21+1

cmpDate:
 .if 1 
;
; Y2K-happy date-compare:
;
; Input = 4-byte date/time records at (p),y and (p2),y
;         with Y pointing at the 2nd byte
;
; Output = BEQ/BCS/BCC for P2 compared to P
;
	lda (p),y
	jsr ExtractAndNormalizeYear
	sta tempDate
	lda (p2),y
	jsr ExtractAndNormalizeYear
	cmp tempDate
	bne cmpDATEx

	lda (p),y	;compare high bit of months
	and #1
	sta tempDate
	lda (p2),y
	and #1
	cmp tempDate
	bne cmpDATEx

	dey
	lda (p2),y
	cmp (p),y
	bne cmpDATEx
 .else
	lda (p2),y
	cmp (p),y
	bne cmpDATEx
	dey
	lda (p2),y
	cmp (p),y
	bne cmpDATEx
 .endif
	iny
	iny
	iny	;now pointing at the last byte
	lda (p2),y
	cmp (p),y
	bne cmpDATEx
	dey
	lda (p2),y
	cmp (p),y
cmpDATEx:
	rts


swap_two:
	ldy EntryLen
	dey
swap22:	lda (p),y
	pha
	lda (p2),y
	sta (p),y
	pla
	sta (p2),y
	dey
	bpl swap22
	sec
	ror swapped
	rts

;
; keep_init and keep1dir
;
keep_init:
	lda #>keepbuff
	ldy #<keepbuff
	sta keep+1
	sty keep
	rts

keep1dir:
	inc keep_count
	bne scok
	inc keep_count+1
scok:	ldy EntryLen
k1d:	dey
	bmi :+
	lda catbuff,y
	sta (keep),y
	jmp k1d
:	jmp nextkeep

get1kept:
	lda keep_count+1
	ora keep_count
	bne :+
	sec
	rts
:	lda keep_count
	bne :+
	dec keep_count+1
:	dec keep_count
	ldy EntryLen
g1k:	dey
	bmi g1kx
	lda (keep),y
	sta catbuff,y
	jmp g1k
g1kx:

nextkeep:
	clc
	lda keep
	adc EntryLen
	sta keep
	lda keep+1
	adc #0
	sta keep+1
	cmp #$AF
	bcc nkok
	lda #der_outroom
	jmp ProDOS_err
nkok:	rts	;clc

;************************************************
read1dir_vis:
	jsr read1dir
	bcs :+
	bit show_invis
	bmi :+
	lda catbuff+$1E	;access
	and #%00000100
	bne read1dir_vis
	clc
:	rts

;************************************************
cat_header:
	lda ptr+1
	ldy ptr
	jsr prnt_compl
	message_cstr "      "
	lda file_count+1
	ldy file_count
	jsr prdec_2
	message_cstr " file"
	lda file_count+1
	ldy file_count
	jsr plural
	jsr crout
	jsr crout
	message_cstr "name                       type"
	lda #$80+'s'
	jsr getparm_ch
	bcc catshort1
	message_cstr "        blocks   modified               access"
catshort1:
	bit speech
	bmi catshort2
	jsr mess
	.byte cr
	cstr "----                       ----"
	lda #$80+'s'
	jsr getparm_ch
	bcc catshort2
	message_cstr "------  ------   --------               ------"
catshort2:
	jmp crout

cat_trailer:
	lda #$80+'s'
	jsr getparm_ch
	bcs catlong2
	rts
catlong2:
	jsr get_vol_info
	jsr crout
	message_cstr "blocks free: "
	sec
	lda info_auxtype
	sbc info_blocks
	tay
	lda info_auxtype+1
	sbc info_blocks+1
	jsr prdec_2
	message_cstr "    used: "
	lda info_blocks+1
	ldy info_blocks
	jsr prdec_2
	jsr show_percent
	message_cstr "     total: "
	lda info_auxtype+1
	ldy info_auxtype
	jsr prdec_2
	jmp crout

get_vol_info:
	lda cat_devnum
.if IsDavex2
	sta online_dev
	CALLOS mli_online, online_parm
	CALLOS_BRANCH_POS von_ok
	jmp ProDOS_err
.else
	lda #$00		; Clear out A & Y to ask for the real empty prefix 
	tay
	jsr empty_prefix
	sta ginfopth+1
	sty ginfopth
	jmp getinfo
.endif
von_ok:	lda catbuff
	and #%00001111
	tax
	inx
	stx catbuff-1
	lda #$80+'/'
	sta catbuff
	lda #>(catbuff-1)
	ldy #<(catbuff-1)
	jmp getinfo
;
; print this entry if:
;   no -f type was given     OR
;   the type matches the -f type   OR
;   it's a DIR and -t was given
;
print1dir:
	lda cat_ftype
	beq dothis2
	cmp catbuff+16
	beq dothis2
	lda catbuff+16
	cmp #tDIR
	bne notthis2
	lda #$80+'t'
	jsr getparm_ch
	bcc dothis2
notthis2:
	clc
	rts
dothis2:
	ldx indent_level
	jsr indent_x
	lda catbuff
	and #%00001111
	tax
	ldy #1
prcat1:	lda catbuff,y
	ora #%10000000
; asl case_mask+1
; rol case_mask
; bcc no_dcase
; jsr downcase
;no_dcase
	jsr cout
	iny
	dex
	bne prcat1

	clc
	tya
	adc indent_level
	tay
tabType:
	cpy #18+10
	bcs tabbedType
	jsr pr_sp
	iny
	bne tabType
tabbedType:
	ldx #$80+' '
	lda catbuff
	and #$f0
	cmp #$50
	bne not_xtnd
	ldx #$80+'+'
not_xtnd:
	txa
	jsr cout
	lda catbuff+16
	jsr print_ftype
; short form -s?
	lda #$80+'s'
	jsr getparm_ch
	bcs longcat
	jsr crout
	jmp check_wait
longcat:
; print ' $xxxx' (auxtype)
	message_cstr " $"
	lda catbuff+$20
	jsr prbyte
	lda catbuff+$1f
	jsr prbyte
; print a comma for Speech users
	jsr speech_comma
; blocks
	lda catbuff+$14
	ldy catbuff+$13
	ldx #0
	stx num+2
	sta num+1
	sty num
	jsr prdec_pad

	lda #$80+' '
	bit speech
	bpl store_char
	lda #$80+','
store_char:
	sta spComma

	jsr mess
spComma: cstr "   "	; first char MODIFIED above
	lda catbuff+$22
	ldy catbuff+$21
	jsr pr_date_ay

	jsr pr_sp
	lda catbuff+$24
	ldy catbuff+$23
	jsr pr_time_ay

	message_cstr "   "
	lda catbuff+$1E
	jsr print_access
	jsr crout
	jmp check_wait

;
; Calculate mask of uppercase/lowercase letters in the filename.
;
; Three filetypes use their auxtype to store this information:
;	19 ADB   UprLwr    AppleWorks Database
;	1A AWP   UprLwr    AppleWorks Word Processing
;	1B ASP   UprLwr    AppleWorks Spreadsheet
;
; But in general, the ProDOS FST stores it in two other bytes.
;
calc_cmask:
	ldx catbuff+16	;type
	cpx #$19	; < ADB ?
	bcc cm_ProFST
	cpx #$1B+1	; >= ASP+1 ?
	bcs cm_ProFST
	lda catbuff+$20
	ldy catbuff+$1f
cm_store:
	sta case_mask+1
	sty case_mask
	rts

; check for ProDOS FST lowercase bits
cm_ProFST:
	lda catbuff+$1d
	bpl no_case
	lda catbuff+$1c
	asl a
	rol catbuff+$1d
	ldy catbuff+$1d
	jmp cm_store
no_case:
	lda #$ff
	tay
	bne cm_store

case_mask:
	.res 2

indent_x:
	beq @exit
:	jsr pr_sp
	dex
	bne :-
@exit:	rts

;************************************************
;************************************************
;
; ftype [-r<type>] [-a<string> -v<ftype>] [-z]
;
go_ftype:
	lda num_parms
	bne ftype_p
; display all filetype names
	lda #7
	ldx scr_width
	cpx #80
	bcs :+
	lsr a
:	sta ftyp_mask

	clc
	jsr displayFTs
	jsr crout
	sec
displayFTs:
	ror ftInternal
	ldx #0
	ldy #0
ftype1:
	lda filetyp,x
	bit ftInternal
	bpl ftExt1
	lda filetyp0,x
ftExt1:	cmp #0
	beq ftypex
	pha
	jsr pr_sp
	jsr oneFTchar
	jsr oneFTchar
	jsr oneFTchar
	lda #$80+'='
	jsr cout
	lda #$80+'$'
	jsr cout
	pla
	jsr prbyte
	jsr pr_sp
	inx
	txa
	and ftyp_mask
	bne ftype1
	jsr crout
	jmp ftype1
ftypex:	jmp crout

ftyp_mask:	.byte 0
ftInternal:	.byte 0

oneFTchar:
	lda fileasc,y
	bit ftInternal
	bpl oneFTch
	lda fileasc0,y
oneFTch:
	iny
	ora #%10000000
	jmp cout

ftype_p:
	lda #$80+'z'
	jsr getparm_ch
	bcs no_zapft
	lda #0
	sta filetyp
	jsr makedirt
no_zapft:

	lda #$80+'r'
	jsr getparm_ch
	bcs ftype_add
; remove type A
	sta temp
	ldx #0
ftr1:	lda filetyp,x
	beq ftr_nf
	cmp temp
	beq ftr_f
	inx
	cpx #63
	bcc ftr1
ftr_nf:	lda #der_notfnd
	jmp ProDOS_err
ftr_f:	txa
	sta temp
	asl a
	adc temp
	tay
ftr_f1:	lda filetyp+1,x
	sta filetyp,x
	lda fileasc+5,y
	sta fileasc+2,y
	lda fileasc+4,y
	sta fileasc+1,y
	lda fileasc+3,y
	sta fileasc,y
	iny
	iny
	iny
	inx
	cpx #63
	bcc ftr_f1
	jsr makedirt

ftype_add:
	lda #$80+'a'
	jsr getparm_ch
	bcs ftype_x
	sta p2+1
	sty p2
	ldy #0
	lda (p2),y
	cmp #3
	beq fta3
	lda #der_needs3
der2:	jmp ProDOS_err
fta3:	lda #$80+'v'
	jsr getparm_ch
	bcc fta4
	lda #der_missopt
	bne der2
fta4:	sta temp
	ldx #0
fta1:	lda filetyp,x
	beq fta_f
	inx
	cpx #63
	bcc fta1
	lda #der_outroom
	bne der2
fta_f:	lda temp
	sta filetyp,x
	lda #0
	sta filetyp+1,x
	stx temp
	txa
	asl a
	adc temp
	tax
	inx
	inx
	ldy #3
ftacopy:
	lda (p2),y
	sta fileasc,x
	dex
	dey
	bne ftacopy
	jsr makedirt
ftype_x:
	rts

;************************************************
;
; err <int> -- print xProDOS error
;
go_err:	tya
	beq all_errs
	jmp ProDOS_er
all_errs:
	lda #0
next_err:
	pha
	ldy #3
	sta num
	lda #0
	sta num+1
	sta num+2
	jsr prdec_pady
	message_cstr ": "
	pla
	pha
	jsr ProDOS_er2
	jsr check_wait
	pla
	bcs :+
;;;	clc
	adc #1
	bcc next_err
:	rts

;************************************************
;
; '=' -- print a pathname
;
go_equal:
	nop	;disables wildcard expansion echo
	sta p2+1
	sty p2
	lda #1
	jsr getparm_n
	sta p+1
	sty p
	ldy #0
	lda (p),y
	bne goeq2
	ldy #0
	lda (p2),y
	beq eqx
	iny
	lda (p2),y
	ora #%10000000
	cmp #$80+'/'
	beq eq_compl
	jsr print_pfx
	lda #$80+'/'
	jsr cout
eq_compl:
	lda p2+1
	ldy p2
	jsr print_path
	jmp crout
eqx:	rts
goeq2:	lda p+1
	ldy p
	jsr print_path
	jmp crout

;************************************************
;
; appl)ications
;
 .if 0 
go_appl:
	message_cstr_cr "(appl not implemented)"
	rts
 .endif

;************************************************
;
; > | como
;
go_como:
	sta p+1
	sty p
	jsr begin_oredir
	lda redir_out
	beq :+
	cmp #refSlot0
	bcs :+
	jsr append
:	rts

;************************************************
;
; < | exec
;
go_exec:
	jsr finish_iredir
	lda #0
	jsr getparm_n
	jmp begin_iredir

;************************************************
;
; go_echo -- type a string (-n = no CR)
;
go_echo:
	sta p+1
	sty p
	ldy #0
	lda (p),y	; length byte
	beq echoed
	tax
echo1:	iny
	lda (p),y
	ora #%10000000
	jsr cout
	dex
	bne echo1
echoed:	lda #$80+'n'
	jsr getparm_ch
	bcc echo_noCR
	jsr crout
echo_noCR:
	rts

;************************************************
;
; touch -- update the mod date of a file,
;          or set/clear backup bit or
;          invisible bit, or enable/disable
;
go_touch:
	jsr getinfo

	jsr touch_b
	jsr touch_d
	jsr touch_i

	jsr getnump
	cmp #1
	bne nTouchDate
	lda date+1
	ldy date
	sta info_moddat+1
	sty info_moddat
	lda time+1
	ldy time
	sta info_modtim+1
	sty info_modtim
nTouchDate:

touch_set:
	lda #0
	jsr getparm_n
	jmp setinfo

touch_b:
	lda #$80+'b'
	jsr getparm_ch
	bcs touch_bx
	tax
	beq touch_bn
	lda info_acc
	ora #%00100000
	bne do_bub
touch_bn:
	lda info_acc
	and #%11011111
do_bub:	sta info_acc
	lda #$ff
	sta bubit	;allow fiddling w/ bkup bit
touch_bx:
	rts

touch_i:
	lda #$80+'i'
	jsr getparm_ch
	bcs touch_ix
	tax
	beq touch_in
	lda info_acc
	ora #%00000100
	sta info_acc
	rts
touch_in:
	lda info_acc
	and #%11111011
	sta info_acc
touch_ix:
	rts

touch_d:
	lda #$80+'d'
	jsr getparm_ch
	bcs touch_dx
	tax
	lda info_type
	cmp #$c7	;CDEV
	beq okDisable
	cmp #$b6
	bcc bad_disable
	cmp #$bd+1
	bcs bad_disable
	cmp #$ba
	beq bad_disable
	cmp #$bc
	beq bad_disable
okDisable:
	txa
	bne tDISABLE
	lda info_auxtype+1
	and #$7f	;enable
	sta info_auxtype+1
	rts
tDISABLE:
	lda info_auxtype+1
	ora #$80	;disable
	sta info_auxtype+1
touch_dx:
	rts

bad_disable:
	jsr mess
	.byte cr
	cstr_cr "*** bad filetype for enable/disable"
	jmp main_err

;************************************************
;
; config
;
go_config:
	lda num_parms
	beq cfg_show
	lda #$80+'p'
	jsr getparm_ch
	bcs cfg2
	cpy #7+1
	bcs cfgperr
	cpy #0
	beq cfgperr
	sty print_slot
	jsr makedirt
cfg2:	lda #$80+'4'
	jsr getparm_ch
	bcs cfg3
	sta cfg40
.if IsDavex3
	jsr config_set_columns
.endif
	jsr makedirt
cfg3:	lda #$80+'b'
	jsr getparm_ch
	bcs cfg4
	sta cfgbell
	jsr makedirt
cfg4:	lda #$80+'c'
	jsr getparm_ch
	bcs cfg5
	sta cfgclock
	jsr makedirt
cfg5:	lda #$80+'q'
	jsr getparm_ch
	bcs cfg6
	cpy #3
	bcs cfgperr
	sty cfgquiet
	jsr makedirt
cfg6:	lda #$80+'h'
	jsr getparm_ch
	bcs cfg7
	sta p+1
	sty p
	sta hp1+1
	sty hp1
	ldy #0
	lda (p),y
	cmp #64
	bcc HelpPok
	lda #der_outroom
	jmp ProDOS_err
HelpPok:
	jsr pmgr
	.byte pm_copy
hp1:	.addr 0,cfghelp
	jsr makedirt
cfg7:	rts

cfgperr:
	lda #der_badnum
	jmp ProDOS_err

cfg_show:
	message_cstr "   Printer slot: "
	lda print_slot
	ora #$80+'0'
	jsr cout
	jsr mess
	.byte cr
	cstr "Use system bell: "
	lda cfgbell
	jsr showyn
	jsr mess
	.byte cr
	cstr "40 columns only: "
	lda cfg40
	jsr showyn
	jsr mess
	.byte cr
	cstr "Show IIgs clock: "
	lda cfgclock
	jsr showyn
	jsr mess
	.byte cr
	cstr "    Quiet level: "
	lda cfgquiet
	ora #$80+'0'
	jsr cout
	jsr mess
	.byte cr
	cstr " Help directory: "
	lda #>cfghelp
	ldy #<cfghelp
	jsr print_path
	jmp crout

showyn:	bne showy
	message_cstr "no"
	rts
showy:	message_cstr "yes"
	rts

.if IsDavex3
config_set_columns:
	bne config_set_40
	lda #columns80
	bne config_set_it	; Always
config_set_40:
	lda #columns40
config_set_it:
	sta INIT_SCREEN_COLUMNS
	jsr set_columns
	rts
.endif

;*******************************************************

;*******************************************************
;
; copy <pn1> <pn2> [-f] [-d] [-b]
;
; -f = force replacement of existing file
; -d = delete original after successful copy
; -b = clear backup bit after copy (both files)
;
;*******************************************************
;
; copy(pn1,pn2,options)
; {
;   if null(pn2) pn2 = GetPrefix();
;   GetInfo(pn1);
;   Open(pn1);
;   GetEOF(pn1);
;   repeat
;     GetInfo(pn2);
;     .if type=DIR  concat(pn2,filename(pn1));
;   until type<>DIR;
;   If not found(pn2)
;     create(pn2,"BAD",unlocked)
;   else
;     ask("okay to replace",pn2);
;   ...
; }
;
;*******************************************************
copydir:
	lda cp_pn2+1
	ldy cp_pn2
	sta cpd_cr+2
	sty cpd_cr+1
	jsr geti2
	bcs cpd_cre
	lda info_stype
	cmp #$f
	beq cpdok3
cpd_cre:
	CALLOS mli_create, cpd_cr
	CALLOS_BRANCH_NEG cpd_err
cpdok3:	jsr push_level
	lda cp_pn1+1
	ldy cp_pn1
	jsr dir_setup
cdir1:	jsr read1dir
	bcs cdirx
	lda catbuff
	and #%00001111
	sta catbuff
; append name to path1, path2
	jsr cp_appboth

	jsr cp_report
	jsr cp_recurse

; remove last seg from path1, path2
	lda cp_pn1+1
	ldy cp_pn1
	jsr up_ay
	lda cp_pn2+1
	ldy cp_pn2
	jsr up_ay
	jmp cdir1
cdirx:	jmp dir_finish
cpd_err:
	jmp ProDOS_err

cpd_cr:	.byte 7,0,0,%11000011,tDIR,0,0,$D,0,0,0,0

;*******************************************
up_ay:	sta upay+1
	sty upay
	jsr pmgr
	.byte pm_up
upay:	.addr 0
	rts

cp_appboth:
	lda cp_pn1+1
	ldy cp_pn1
	sta cpapp+1
	sty cpapp
	sta cpsl1+1
	sty cpsl1
	lda cp_pn2+1
	ldy cp_pn2
	sta cpapp2+1
	sty cpapp2
	sta cpsl2+1
	sty cpsl2
	jsr pmgr
	.byte pm_slashif
cpsl1:	.addr 0
	jsr pmgr
	.byte pm_slashif
cpsl2:	.addr 0
	lda #>catbuff
	ldy #<catbuff
	jsr pmgr
	.byte pm_appay
cpapp:	.addr 0
	lda #>catbuff
	ldy #<catbuff
	jsr pmgr
	.byte pm_appay
cpapp2:	.addr 0
	rts

;*******************************************
;*******************************************
go_move:
	sta cp_pn1+1
	sty cp_pn1
	lsr del_flag
	bpl goc_2	; always taken

del_flag:	.res 1

;*******************************************
go_copy:
	sta cp_pn1+1
	sty cp_pn1
	lda #$80+'d'
	jsr getparm_ch
	ror del_flag
goc_2:
	lda #1
	jsr getparm_n
	jsr empty_prefix
	jmp cont
go_copy2:
	sec
	ror del_flag
cont:	sta cp_pn2+1
	sty cp_pn2
	sta cp_crpn+1
	sty cp_crpn
	sta desti_name+1
	sty desti_name

cp_recurse:
	lda cp_pn1+1
	ldy cp_pn1
	jsr getinfo

	lda info_type
	cmp #tDIR
	bne cp_ndir
	jmp copydir
cp_ndir:

	CALLOS mli_open, cp_op1
	CALLOS_BRANCH_NEG cp_err0
	lda cpref1
	sta cpref1b
;
; get eof of file1
;
	sta cpeof_r
	CALLOS mli_geteof, cpeof_p
	CALLOS_BRANCH_NEG cp_err0
.if IsDavex3
	lda cpeof_r
	sta cpseof_ref
	ldy #$03
:	lda #<cpgeof_result
	sta p
	lda #>cpgeof_result
	sta p+1
	lda #<cpseof_result
	sta p2
	lda #>cpseof_result
	sta p2+1
	lda (p),y
	sta (p2),y
	dey
	bne :-
.endif
;
; GetInfo on the dest file
;
cp_getdesti:
	lda #$ff
	sta desti_acc
	sta desti_stt
	CALLOS mli_gfinfo, destinfo
	CALLOS_BRANCH_POS cp_goti
	cmp #err_filnotfnd
	beq cp_create
cp_err0:
	jmp ProDOS_err
cp_goti:
	lda desti_stt
	cmp #$f	;is it a volume?
	beq cp_isdir
	cmp #$d	;is it a subdirectory?
	bne cp_ask
cp_isdir:
;
; append filename of path1 onto path2 and go back to see
; if the file exists
;
	jsr cp_intodir
	jmp cp_getdesti
;
cp_create:
	CALLOS mli_create, cp_creatp
	CALLOS_BRANCH_POS cp_created
	jmp ProDOS_err
;
cp_ask:
	lda desti_acc
	and #%11000011
	cmp #%11000011
	bne ask_anyway

	lda #$80+'f'
	jsr getparm_ch
	bcc cp_created

ask_anyway:
	jsr suspend
	jsr TalkCont
	message_cstr "Okay to replace "
	lda cp_pn2+1
	ldy cp_pn2
	jsr prnt_compl
	lda desti_acc
	and #%11000011
	cmp #%11000011
	beq cpyn
	message_cstr " [LOCKED] "
cpyn:	lda #$80+'n'	;default = No
	jsr yesno2
	jsr restore	;must save N!
	bmi cp_created
	lda cpref1
	jmp close

cp_created:
	lda info_type
	pha
	lda info_acc
	pha
	lda #tBAD
	sta info_type
	lda #%11000011
	sta info_acc
	lda cp_pn2+1
	ldy cp_pn2
	jsr setinfo
	pla
	sta info_acc
	pla
	sta info_type

	CALLOS mli_open, cp_op2
	CALLOS_BRANCH_NEG cp_er
	lda cpref2
	sta cpref2b
;
; the main copy loop!  (Read a bufferfull, write it..._)
;
copy1:
	CALLOS mli_read, cp_rd1
	CALLOS_BRANCH_POS copy2
	cmp #err_eof
	beq copied
cp_er:	jmp ProDOS_err
copy2:	lda cp_xfer+1
	ldy cp_xfer
	sta cp_xfer2+1
	sty cp_xfer2
	CALLOS mli_write, cp_wr2
	CALLOS_BRANCH_NEG cp_er
	jmp copy1
copied:
; set EOF of file2
	lda cpref2
	sta cpeof_r
.if IsDavex2
	CALLOS mli_seteof, cpeof_p
.else
	CALLOS mli_seteof, cpseof_p	; Need a slightly different parm structure in SOS
.endif
	CALLOS_BRANCH_NEG cp_er
; close both files
	lda cpref1
	jsr close
	lda cpref2
	jsr close
;
; clr backup bit on original if -b
;
	lda #$80+'b'
	jsr getparm_ch
	bcs no_clearbb
	lda #$ff
	sta bubit	;allow bit to clear
	lda info_acc
	and #%11011111
	sta info_acc
	lda cp_pn1+1
	ldy cp_pn1
	jsr setinfo
	lda #$ff
	sta bubit
no_clearbb:
;
; set info on copy
;
	lda cp_pn2+1
	ldy cp_pn2
	jsr setinfo
;
; if -d, delete 1st file %%% should unlock first???
;
	lda del_flag
	bmi cp_notrm
	lda cp_pn1+1
	ldy cp_pn1
	sta cprm_p+1
	sty cprm_p
	CALLOS mli_destroy, cprm
	CALLOS_BRANCH_POS cp_notrm
	jmp ProDOS_err
cp_notrm:
	rts

cp_rd1:		.byte 4
cpref1b:	.byte 0
		.addr copybuff
		.addr cbufflen
cp_xfer:	.addr 0

cprm:		.byte 1
cprm_p:		.addr 0

;
;
; append last seg of path1 onto path2
;
cp_intodir:
	lda cp_pn1+1
	ldy cp_pn1
	sta p+1
	sty p

	lda cp_pn2+1
	ldy cp_pn2
	sta cp_appnm+1
	sty cp_appnm
	sta cp_appnm0+1
	sty cp_appnm0
;
; add a '/' onto path2 if it doesn't end in one already
;
	jsr pmgr
	.byte pm_slashif
cp_appnm0: .addr 0

	ldy #0
	lda (p),y	;length of pn1
	tay
	sta pn1len
	beq intodx
cpsrch:	dey
	beq cpigot
	lda (p),y
	and #$7f
	cmp #$2f
	bne cpsrch
cpigot:	iny
cpi1:	tya
	pha
	lda (p),y
	jsr pmgr
	.byte pm_appch
cp_appnm: .addr 0
	pla
	tay
	iny
	cpy pn1len
	bcc cpi1
	beq cpi1
intodx:	rts

pn1len:	.byte 0

;*********************************************
cp_report:
	lda cp_pn1+1
	ldy cp_pn1
	jsr print_path
	message_cstr " --> "
	lda cp_pn2+1
	ldy cp_pn2
	jsr print_path
	jsr crout
	jmp check_wait

;*********************************************

;*********************************************
;
; size -- print size of file or tree of files
;
szpath:	.addr 0

go_size:
	nop		;disable wildcard expansion display
	jsr empty_prefix
	sta szpath+1
	sty szpath
	jsr print_path
	message_cstr ":  "
	lda szpath+1
	ldy szpath
	jsr size_ay
	lda num+1
	ldy num
	sta num3+1
	sty num3
	jsr prdec_2
	message_cstr " block"
	lda num3+1
	ldy num3
	jsr plural
	message_cstr "; "
	lda num2+2
	ldx num2+1
	ldy num2
	sta num+2
	stx num+1
	sty num
	jsr print_dec
	message_cstr " byte"
	lda num2+2
	ora num2+1
	ldy num2
	jsr plural
	jmp crout
;
; return # blocks in NUM*2 and # bytes
; in NUM2*3
;
size_ay:
	sta p+1
	sty p
	sta sz_path+1
	sty sz_path
	jsr getinfo
	lda info_blocks+1
	ldy info_blocks
	sta num+1
	sty num
	lda #0
	sta sz_eof+2
	sta sz_eof+1
	sta sz_eof
	CALLOS mli_open, sz_open
	CALLOS_BRANCH_NEG sz0
	lda sz_ref
	sta sz_ref2
	CALLOS mli_geteof, sz_geteof
;CALLOS_BRANCH_NEG sz_err ;just use 0 if it returns an error
	lda sz_ref
	jsr close
sz0:	lda sz_eof+2
	ldx sz_eof+1
	ldy sz_eof
	sta num2+2
	stx num2+1
	sty num2
;
; calc volume block size from EOF
;
	ldx info_stype
	cpx #15
	bne sznvol
	lda num2+2
	lsr a
	sta num+1
	lda num2+1
	ror a
	sta num
sznvol:

	lda info_type
	cmp #tDIR
	beq szdir
	rts
; compute size of everything in dir
szdir:	jsr push_level
	lda p+1
	ldy p
	jsr dir_setup
sz1:	jsr read1dir
	bcs sz_x
	lda num2+2
	pha
	lda num2+1
	pha
	lda num2
	pha
	lda num+1
	pha
	lda num
	pha

	jsr build_szpath

	ldx catbuff+16
	cpx #tDIR
	beq slowsize
;
; kwiksize routine -- just look in the DIR entry!
;
; Put blocks --> NUM  (2 bytes)
;     EOF    --> NUM2 (3 bytes)
;
	lda catbuff+$14
	sta num+1
	lda catbuff+$13
	sta num
	lda catbuff+$17
	sta num2+2
	lda catbuff+$16
	sta num2+1
	lda catbuff+$15
	sta num2
	jmp anysize

slowsize:
	jsr size_ay
anysize:
	clc
	pla
	adc num
	sta num
	pla
	adc num+1
	sta num+1
	clc
	pla
	adc num2
	sta num2
	pla
	adc num2+1
	sta num2+1
	pla
	adc num2+2
	sta num2+2
	jmp sz1
sz_x:	jmp dir_finish
sz_err:
	jmp ProDOS_err

build_szpath:
	ldy #127
bszp:	lda direcpath,y
	sta pagebuff,y
	dey
	bpl bszp
	lda catbuff
	and #%00001111
	sta catbuff
	lda #>catbuff
	ldy #<catbuff
	jsr pmgr
	.byte pm_appay
	.addr pagebuff
	lda #>pagebuff
	ldy #<pagebuff
	rts

;********************************************
;
; del -- delete file
;
go_del:	sta del_path+1
	sty del_path
	jsr getinfo
	cmp #tDIR
	bne del_ndir
	jsr suspend
	lda del_path+1
	ldy del_path
	jsr go_size
	jsr TalkCont
	message_cstr "Okay to destroy directory"
	lda #$80+'n'	;default = No
	jsr yesno2
	jsr restore
	beq deldun
del_ndir:
del_recurse:
	lda #$80+'u'	;unlock first?
	jsr getparm_ch
	bcs del_unlx
	jsr go_unlock
del_unlx:
	lda del_path+1
	ldy del_path
	jsr getinfo
	cmp #tDIR
	bne del_ndir2
	jsr deldir
del_ndir2:
	CALLOS mli_destroy, del_parms
	CALLOS_BRANCH_NEG del_err
deldun:	rts
del_err:
	jmp ProDOS_err

del_parms:
	.byte 1
del_path:
	.addr 0

;****************************************
deldir:
	jsr push_level
	lda del_path+1
	ldy del_path
	jsr dir_setup
deld1:	jsr read1dir
	bcs deldx

	lda catbuff
	and #%00001111
	sta catbuff
	lda del_path+1
	ldy del_path
	sta delp+1
	sty delp
	sta dslif+1
	sty dslif
	jsr pmgr
	.byte pm_slashif
dslif:	.addr 0
	lda #>catbuff
	ldy #<catbuff
	jsr pmgr
	.byte pm_appay
delp:	.addr 0

	jsr del_recurse

	lda del_path+1
	ldy del_path
	jsr up_ay
	jmp deld1
deldx:	jmp dir_finish

;****************************************


;****************************************
;
; dev [-r<dev>] [-a<dev>] [-z]
;
; -z)ap removes all devices that don't
;       currently have volumes online
;
; Should have an option to reconstruct
; the dev table from the BF-page driver
; addresses & slot ROMs.
;
;****************************************
rm_which:
	.byte 0

dv_done:
	rts
go_dev:
	lda num_parms
	bne dv_some

	ldx devcnt
	bmi dv_done
dv_list:
	lda devlst,x
	pha
	jsr pr_sp
	pla
	jsr print_sd
	dex
	bpl dv_list
	rts

dv_some:
	lda #$80+'r'
	jsr getparm_ch
	bcs dv_notr
	jsr dev_rm1
	jmp dv_nota

dv_notr:
	lda #$80+'a'
	jsr getparm_ch
	bcs dv_nota
	ldx devcnt
	cpx #15
	bcc devcntok
	lda #der_outroom
	jmp ProDOS_err
devcntok:
	inc devcnt
	inx
	sta devlst,x
dv_nota:
	lda #$80+'z'
	jsr getparm_ch
	bcs dv_notz
;
; zap all unused volumes
;
	ldx #0
	stx rm_which
zap1:	lda devcnt
	bmi dv_notz
	beq dv_notz
	ldx rm_which
	lda devlst,x
	sta zap_dev
	cpx devcnt
	beq zok
	bcs dv_notz
zok:	CALLOS mli_online, zap_p
	CALLOS_BRANCH_POS zapnext
	lda zap_dev
	jsr dev_rm1
	jmp zap1	;don't increment! (would miss 1)
zapnext:
	inc rm_which
	bne zap1
dv_notz:
	rts

zap_p:		.byte 2
zap_dev:	.byte 1
		.addr pagebuff

;
; dev_rm1 -- remove device in A
;
dev_rm1:
	and #%11110000
	sta temp
; sta dvUnit
	ldx devcnt
	bmi dvrx
	beq dvrx
dv_finda:
	lda devlst,x
	and #%11110000
	cmp temp
	beq dv_found
	dex
	bpl dv_finda
	rts
dv_found:
	lda devlst+1,x
	sta devlst,x
	inx
	cpx devcnt
	bcc dv_found
	dec devcnt
dvrx:	rts

;******************************
;
; update command for Davex
;
go_update:
	sta up_pn1+1
	sty up_pn1
	lda #1
	jsr getparm_n
	jsr empty_prefix
	sta up_pn2+1
	sty up_pn2
upd_recurse:	jsr check_wait
	jsr upd_report
	lda up_pn1+1
	ldy up_pn1
	jsr getinfo
	sta up_type1
	lda info_moddat+1
	ldy info_moddat
	sta up_date1+1
	sty up_date1
	lda info_modtim+1
	ldy info_modtim
	sta up_time1+1
	sty up_time1

	lda up_pn2+1
	ldy up_pn2
	jsr geti2
	bcc upd_ok2
	cmp #err_filnotfnd
	bne uperr
	message_cstr_cr "new file"

	lda #$80+'f'
	jsr getparm_ch
	bcc crenew

	jsr TalkCont
	message_cstr "Okay to create "
	lda up_pn2+1
	ldy up_pn2
	jsr print_path
	jsr yesno
	beq nonew
crenew:	jmp upd_copy
nonew:	rts
uperr:	jmp ProDOS_err
upd_ok2:
;
; check filetypes
;
	lda info_type
	cmp up_type1
	beq types_match

	message_cstr "filetypes differ ("
	lda up_type1
	jsr print_ftype
	lda #$80+','
	jsr cout
	lda info_type
	jsr print_ftype
	message_cstr ")"
	lda #tDIR
	cmp info_type
	beq cantRepl
	cmp up_type1
	beq cantRepl
; ask
	message_cstr ". Continue"
	lda #$80+'n'	;default = No
	jsr yesno2
	bne match0
	rts

cantRepl:
	jsr crout
	jmp check_wait

match0:	jsr upd_report

types_match:
;
; compare mod dates of old/new files, or of all files within
; a directory
;
	lda up_type1
	cmp #tDIR
	bne updndir
	jmp update_dir
updndir:
;
; cmp moddate/modtime; info_xxx is file 2, up_xxx for file 1
;
 .if 1 
; Y2K-happy date comparison
	lda info_moddat+1	;compare year numbers
	jsr ExtractAndNormalizeYear
	sta tempDate

	lda up_date1+1
	jsr ExtractAndNormalizeYear
	cmp tempDate
	bne up_cmp

	lda info_moddat+1	;compare high bit of month
	and #1
	sta tempDate
	lda up_date1+1
	and #1
	cmp tempDate
	bne up_cmp

	lda up_date1
	cmp info_moddat
	bne up_cmp
 .else
;not Y2K happy
	lda up_date1+1
	cmp info_moddat+1
	bne up_cmp
	lda up_date1
	cmp info_moddat
	bne up_cmp
 .endif

	lda up_time1+1
	cmp info_modtim+1
	bne up_cmp
	lda up_time1
	cmp info_modtim
up_cmp:	beq up_done
	bcc up_warn

	message_cstr_cr "outdated"
	jsr check_wait

upd_copy:
	lda up_pn1+1
	ldy up_pn1
	sta cp_pn1+1
	sty cp_pn1
	lda up_pn2+1
	ldy up_pn2
	jmp go_copy2

up_done:
	message_cstr_cr "current"
	jmp check_wait

up_warn:
	message_cstr "master file is older ["
	lda up_pn1+1
	ldy up_pn1
	jsr print_path
	message_cstr_cr "]"
	jmp check_wait

;
; Y2K-happy year utility:
;
;   Input = high byte of Date value in A
;   Output = normalized year number in A (40..139 = 1940..2039)
;
WrapAroundYear	= 40

ExtractAndNormalizeYear:
	lsr a
	cmp #WrapAroundYear
	bcs @noWrap1
	adc #100	;map 0..39 --> 100..139
@noWrap1:
	rts

tempDate:
	.byte 0
;
; update recursively on all files within
; directory
;
update_dir:
	message_cstr_cr "scanning directory"

	jsr push_level
	lda up_pn2+1
	ldy up_pn2
	sta upd_up2+1
	sty upd_up2

	lda up_pn1+1
	ldy up_pn1
	sta upd_up+1
	sty upd_up
	jsr dir_setup	;open the subdir

updd1:	;update recursively for each file
	jsr read1dir
	bcs upddx
	lda catbuff
	and #%00001111
	sta catbuff

	jsr up_appboth
	jsr upd_recurse
;
; remove last seg of both pathnames
;
	jsr pmgr
	.byte pm_up
upd_up:	.addr 0
	jsr pmgr
	.byte pm_up
upd_up2:
	.addr 0
	jmp updd1	;go back for more files this dir

upddx:	jmp dir_finish	;close the subdir, return from recursion

;
; append a filename to both pathnames
;
up_appboth:
	lda up_pn1+1
	ldy up_pn1
	sta upapp+1
	sty upapp
	sta upsl1+1
	sty upsl1
	lda up_pn2+1
	ldy up_pn2
	sta upapp2+1
	sty upapp2
	sta upsl2+1
	sty upsl2
	jsr pmgr
	.byte pm_slashif
upsl1:	.addr 0
	jsr pmgr
	.byte pm_slashif
upsl2:	.addr 0
	lda #>catbuff
	ldy #<catbuff
	jsr pmgr
	.byte pm_appay
upapp:	.addr 0
	lda #>catbuff
	ldy #<catbuff
	jsr pmgr
	.byte pm_appay
upapp2:	.addr 0
	rts

;
; report which file we're trying to update now
;
upd_report:
	lda up_pn2+1
	ldy up_pn2
	jsr print_path
	message_cstr " -- "
	rts

;***********************************************
up_pn1:		.addr 0
up_pn2:		.addr 0
up_type1:	.byte 0
up_date1:	.byte 0,0	;mod date of first file
up_time1:	.byte 0,0	;mod time of first file
;***********************************************


;******************************************************
;
; subr -- Davex subroutines
;
;******************************************************
makedirt:
	sec
	ror config_dirty
	rts

;******************************************************
;
; getnump
;
; Output: A = number of parameters
;	  BEQ/BNE for 0 or >0 params!
;
; This is a public entry point (xgetnump).
;
getnump:
	lda num_parms
	rts

;******************************************************
;
; directory-scanning subroutine
;
; scanall -- scan through all command directories for
;  a file (path in AY).  Return BCS if not found;
;  otherwise path is at $280 and A=file type.
;
scanptr: .res 1

scanall:
	sta p+1
	sty p
	ldy #0
	lda (p),y
	beq cmd_err
	cmp #63
	bcc cmd_ok
cmd_err:
	sec
	rts
cmd_ok:
	iny
	lda (p),y
	ora #%10000000
	cmp #$80+'/'
	bne part_path
;
; full pathname specified; try once
;
	ldy #127
copyfull:
	lda (p),y
	sta cmdpath,y
	dey
	bpl copyfull
	jmp cmdinfo

part_path:
;
; try all the prefixes in ScanList
;
	ldx #0
	stx scanptr
scan1:	ldx scanptr
	lda scanlist,x
	bne scan_more
; we scanned them all and didn't find it
	sec
	rts
scan_more:
	sta count
	cmp #1
	bne not_curdir
	lda scanlist+1,x
	ora #%10000000
	cmp #$80+'*'
	bne not_curdir
	ldy #0
	sty cmdpath
	beq trycurdir
not_curdir:
	ldy #0
copy_part:
	lda scanlist,x
	sta cmdpath,y
	inx
	iny
	dec count
	bpl copy_part
trycurdir:
	lda p+1
	ldy p
	jsr pmgr
	.byte pm_appay
	.addr cmdpath

	lda p+1
	pha
	lda p
	pha
	lda ptr+1
	pha
	lda ptr
	pha
	lda #>cmdpath
	ldy #<cmdpath
	jsr fixup_path_ay
	pla
	sta ptr
	pla
	sta ptr+1
	pla
	sta p
	pla
	sta p+1

	jsr cmdinfo
	bcs cmd_noper
	rts
cmd_noper:
	ldx scanptr
	txa
	sec
	adc scanlist,x
	sta scanptr
	jmp scan1

;****************************************
;
; load_globpg -- attempt to load Davex's
;                global 'page' from disk
;
load_globpg:
	lsr config_dirty
	lda #>config_pn
	ldy #<config_pn
	jsr build_local
	jsr open_config
	bcs globpg_err
.if IsDavex2
	sta qcref2
	sta qcref3
.endif ; IsDavex2
	lda #mli_read
	jsr rw_config
	bcs globpg_err
	jsr close_config
; this is for people with old config files
gpchk:	lda chk77
	cmp #$77
	beq is77
	lda #0
	tax
fillmisc:
	sta misc,x
	dex
	bne fillmisc
	lda #1
	sta print_slot
	lda #$77
	sta chk77
	jsr makedirt
is77:
; supply '%help' help-dir path if none is recorded
	lda cfghelp
	bne HasHelp
	jsr pmgr
	.byte pm_copy
	.addr DefaultHelp,cfghelp
HasHelp:
	rts

DefaultHelp:
	pstr "%help"

globpg_err:
	lda #0
	tax
fillgp:	sta shell_gp,x
	sta shell_gp+$100,x
	sta shell_gp+$200,x
	sta shell_gp+$300,x
	dex
	bne fillgp
	jsr scan_zap
	sec
	ror config_dirty
	bmi gpchk	; always taken

config_pn:
	pstr "config"

;*********************************************
open_config:
	CALLOS mli_open, ocfg_parms
	CALLOS_BRANCH_NEG ocfg_no
	lda cfg_ref
	sta cfgref2
	clc
	rts
ocfg_no:
	sec
	rts

rw_config:
	cmp #mli_read
	bne config_w
.if IsDavex3
	lda #$04
	sta crw_parms
.endif
	CALLOS mli_read, crw_parms
.if IsDavex3
	CALLOS_BRANCH_POS :+
	sec
	rts
:	clc
.endif
	rts

config_w:
.if IsDavex3
	lda #$03
	sta crw_parms
.endif
	CALLOS mli_write, crw_parms
.if IsDavex3
	CALLOS_BRANCH_POS :+
	sec
	rts
:	clc
.endif
	rts

crw_parms:
	.byte 4
cfgref2:
	.res 1
	.addr shell_gp
	.addr config_len
	.addr 0

close_config:
	lda cfgref2
	jmp close

;**********************************************
save_config:
	bit config_dirty
	bpl clean
	lda #>config_pn
	ldy #<config_pn
	jsr build_local
	jsr create_cfg
	jsr open_config
	bcs sc_err
	lda #mli_write
	jsr rw_config
	bcs sc_err
	lsr config_dirty
	jsr close_config
clean:	clc
	rts

sc_err:	message_cstr "[Unable to save %config]"
	clc
	rts

create_cfg:
	CALLOS mli_create, crcfg_parms
	CALLOS_BRANCH_POS crcfg_x
	cmp #err_dupfil
	beq crcfg_x
	sec
	rts
crcfg_x:
	clc
	rts

;**********************************************
;
; build_local --
;
;  entry:  AY points to partial pathname
;
;  exit:   AY points to MYPATH, which contains
;             the shell directory's prefix +
;             the partial pathname
;
build_local:
	ldx mydir_len
	stx mypath
	jsr pmgr
	.byte pm_appay
	.addr mypath
	lda #>mypath
	ldy #<mypath
	rts
;
; do_autoexec -- execute file specifiedd in startup buffer,
;                if the file exists
;
do_autoexec:
	lda #>exec_pn
	ldy #<exec_pn
	sta ginfopth+1
	sty ginfopth
	jsr fixup_path_ay
.if IsDavex2
	lda #10
	sta infoprm
.endif
	CALLOS mli_gfinfo, infoprm
	CALLOS_BRANCH_NEG no_aexec

	lda #>exec_pn
	ldy #<exec_pn
	jsr begin_iredir
no_aexec:
	rts
;
; plural -- if AY<>1, print 's'
;
plural:
	cmp #0
	bne plur_s
	cpy #1
	bne plur_s
	rts
plur_s:	lda #'s'+$80
	jmp cout

;
; prnt_compl -- print_path, but print prefix first
; if pn is partial
;
prnt_compl:
	sta p+1
	sty p
	ldy #1
	lda (p),y
	ora #%10000000
	cmp #$80+'/'
	beq fullpn
	lda p+1
	pha
	lda p
	pha
	jsr print_pfx
	lda #$80+'/'
	jsr cout
	pla
	sta p
	pla
	sta p+1
fullpn:	lda p+1
	ldy p
	jmp print_path

;
; check_wait -- pause display & allow abort (SEC)
;
; For Textalker (Echo) users: Ctrl-X STAYS on kbd
;
stepping:
	.byte 0

check_wait:
	jsr poll_io
	bit stepping
	bmi cw_wait
	lda keyboard
	bpl cw_x
	cmp #$80+'X'-ctrl
	beq cw_x
	cmp #$9b	;esc
	beq cw_xxx
	cmp #$80+'C'-ctrl
	beq cw_abort
	cmp #$80+'S'-ctrl
	beq cw_wait
	jsr chk_appleper
	cmp #$80+' '
	bne cw_x
	sta kbdstrb
cw_wait:
	jsr poll_io
	lda keyboard
	bpl cw_wait
	sta kbdstrb	;munch bad chars in case type-ahead active
	jsr CheckHC
	bcc cw_wait
	cmp #$9b
	beq cw_xxx
	cmp #$80+'C'-ctrl
	beq cw_abort
	cmp #$80+'X'-ctrl
	beq cw_xx
	cmp #$80+'S'-ctrl
	beq cw_done
	cmp #$80+'Q'-ctrl
	beq cw_done
	jsr chk_appleper
	cmp #$a0
	bne cw_x	;was cw_wait
	ror stepping
	clc
	rts
cw_done:
	sta kbdstrb
cw_x:	clc
cw_xx:	php
	lsr stepping
	plp
	rts
cw_xxx:	jsr crout
	sta kbdstrb
	lsr stepping
	sec
	rts
cw_abort:
	sta kbdstrb
	lsr stepping
	jmp yn_abort

chk_appleper:
	cmp #$80+'.'
	bne notAper
	bit button0	;Apple
	bpl notAper
	ldx machine
	cpx #6
	beq cw_abort
notAper:
	rts

close:
	sta mycl_r
	CALLOS mli_close, mycls
close_done:
	rts

mycls:	.byte 1
mycl_r:	.res 1

;
; empty_prefix -- used after call to getparm.
; If string AY points to is empty, load AY
; with pointer to prefix instead
;
empty_prefix:
	sta ptr+1
	sty ptr
	ldy #0
	lda (ptr),y
	beq ep_usepfx
	lda ptr+1
	ldy ptr
	rts
ep_usepfx:
	jmp get_pfx
;
; percent -- return A=percent
; that NUM(*3) is of AXY
;
percent:
	sta num3+2
	stx num3+1
	sty num3
	lda #0
	sta num+3
	sta num3+3
	sta num2+3
	sta num2+2
	sta num2+1
	sta num2
	sta perc
	jsr mult10num
	jsr mult10num
; while num2<num do (perc++; num2+=num3)
per_while:
	sec
	lda num2
	sbc num
	lda num2+1
	sbc num+1
	lda num2+2
	sbc num+2
	lda num2+3
	sbc num+3
	bcs per_whilex
	clc
	ldy #4
	ldx #0
per_add:
	lda num2,x
	adc num3,x
	sta num2,x
	inx
	dey
	bne per_add
	inc perc
	bne per_while
per_whilex:
	lda perc
	rts

perc:	.byte 0

;
; show_percent -- info_blocks/info_auxtype
;
;   ' (xx%)'
;
show_percent:
	message_cstr "  ("
	lda #0
	ldx info_blocks+1
	ldy info_blocks
	sta num+2
	stx num+1
	sty num
	lda #0
	ldx info_auxtype+1
	ldy info_auxtype
	jsr percent
	jsr prdec_1
	message_cstr "%)"
	rts
;
; need_prefix -- if prefix is null, set it
; to the shell path
;
need_prefix:
	jsr get_pfx
	sta p+1
	sty p
	ldy #0
	lda (p),y
	bne @out
	lda mydir_len
	sta mypath
	CALLOS mli_setpfx, needp_p
	jsr go_top
@out:	rts

needp_p:
	.byte 1
	.addr mypath

;****************************************
;
; fixup_path_ay -- if path begins with
;    %    --> % is shell directory
;    .sd  --> .sd is volume name
;    ..   --> .. is parent directory
;    .    -->  . is current directory
;
fixup_path_ay:
	sta p+1
	sty p
	sta ptr+1
	sty ptr
	ldy #0
	lda (p),y
	beq :+
	iny
	jsr pchar
	cmp #$80+'%'
	beq fp_shelld
	cmp #$80+'.'
	beq fixup_dot
:	rts

fp_shelld:
	jsr shorten_p
	ldy #1
	jsr pchar
	cmp #$80+'/'
	bne fpsh2
	jsr shorten_p
fpsh2:	lda p+1
	ldy p
	jsr build_local
	ldy mypath
fpcopy:	lda mypath,y
	sta (ptr),y
	dey
	bpl fpcopy
	rts

fixup_dot:
	ldy #0
	lda (p),y
	cmp #2
	bcc not_parent
	ldy #2
	jsr pchar
	cmp #$80+'.'
	bne not_parent
; .. = parent directory
	jsr shorten_p
	jsr shorten_p
	ldy #0
	lda (ptr),y
	beq parent_nosl
	iny
	jsr pchar
	cmp #$80+'/'
	bne parent_nosl
	jsr shorten_p
parent_nosl:
	sec	;flag '..'
	.byte $24 ; Hide next byte (skip over the CLC)
singleDOT:
	clc	;flag '.'
	php
	CALLOS mli_getpfx, dotdotPARMS
	jsr pmgr
	.byte pm_downcase
	.addr pagebuff
	plp
	bcc not_dotdot
	jsr pmgr
	.byte pm_up
	.addr pagebuff
	lda pagebuff
	cmp #1
	bne not_dotdot
	dec pagebuff
not_dotdot:
	jmp splice_dot

not_parent:
; check for .sd
	ldy #0
	lda (p),y
	cmp #3
	bcc chk_dot
	ldy #2
	jsr pchar
	cmp #$80+'1'
	bcc chk_dot
	cmp #$80+'8'
	bcs chk_dot
	and #%00001111
	asl a
	asl a
	asl a
	asl a
	sta temp
	iny
	jsr pchar
	cmp #$80+'1'
	bcc :+
	cmp #$80+'3'
	bcs :+
	and #%00000001
	ror a
	ror a
	ora temp
	eor #%10000000
	jsr online1
	jmp splice_sd
:	rts

chk_dot:
	jsr shorten_p
	ldy #0
	lda (ptr),y
	beq singleDOT
	iny
	jsr pchar
	cmp #$80+'/'
	bne singleDOT
	jsr shorten_p
	jmp singleDOT

online1:
	sta o1_dev
	CALLOS mli_online, o1_parms
	CALLOS_BRANCH_POS o1ok
	jmp ProDOS_err
o1ok:	lda pagebuff+1
	and #%00001111
	tax
	inx
	inx
	stx pagebuff
	lda #'/'
	sta pagebuff+1
	sta pagebuff,x
	jsr pmgr
	.byte pm_downcase
	.addr pagebuff
	rts

o1_parms:
	.byte 2
o1_dev:	.res 1
	.addr pagebuff+1

splice_dot:
	ldy #0
	lda (ptr),y
	sta temp
	inc temp
	ldy #1
	bne splpth2

splice_sd:
	ldy #0
	lda (ptr),y
	sta temp
	inc temp
	ldy #4
	lda (ptr),y
	ora #%10000000
	cmp #$80+'/'
	bne splpth2
	iny
splpth2:
	cpy temp
	bcs splpth3
	lda (ptr),y
	inc pagebuff
	ldx pagebuff
	sta pagebuff,x
	iny
	bne splpth2
splpth3:
	ldy #127
:	lda pagebuff,y
	sta (ptr),y
	dey
	bpl :-
	rts

;
; shorten_p -- remove 1st character of
;              path at P
;
shorten_p:
	ldy #0
	lda (p),y
	beq :+
	tax
@loop:	iny
	iny
	lda (p),y
	dey
	sta (p),y
	dex
	bne @loop
	lda (p,x)
	sec
	sbc #1
	sta (p,x)
:	rts

;
; pchar -- get (p),y in lowercase, high bit on
;
pchar:	lda (p),y
	jmp downcase

;*************************************
;
; memory manager (crude but useful)
;
; commands (x): MLI_xxx
;   close -- free all dynamic mem
;
;   open  -- alloc A pages from low
;            mem; SEC=out of mem;
;            return A=1st page
;
;   read  -- # free pages --> A (Y=0)
;
;   gfinfo-- get low page --> A (Y=0)
;
;   write -- set high page to A
;
mmgr:	cpx #mli_close
	bne mm_ncl
;
; close: free dynamic mem
;
	lda #>highmem
	sta mmgr_hi
	lda #>copybuff
	sta mmgr_lo
	clc
	rts

mm_ncl:	cpx #mli_write
	bne mm_nwr
;
; write: set high page
;
	cmp mmgr_lo
	bcc mmw_err
	cmp #>highmem
	bcs mmw_err
	sta mmgr_hi
	clc
	rts

mmw_err:
	lda #der_outmem
	sec
	rts

mm_nwr:	cpx #mli_gfinfo
	bne mm_ninfo
;
; getinfo: A=low page
;
	lda #0		;open 0 pages
	beq mmopen	;always taken

mm_ninfo:
	cpx #mli_open
	bne mm_nopen
;
; open: reserve A pages
;
mmopen:	ldy mmgr_lo	;reserve here
	clc
	adc mmgr_lo
	cmp mmgr_hi
	bcs mmw_err
	sta mmgr_lo
	tya
	ldy #0
	clc
	rts

mm_nopen:
	cpx #mli_read
	bne mm_nrd
;
; read: get free pages
;
	sec
	lda mmgr_hi
	sbc mmgr_lo
	ldy #0
	clc
	rts

mm_nrd:
	lda #err_badcall
	sec
	rts

;***********************************
;
; off80
;
off80:
	jsr finish_oredir
.if IsDavex2
	jsr mess
	.byte $80+'U'-ctrl,$80+'T'-ctrl,$80+'A',$80+'1',0
	jsr $fe89
	jsr $fe93
	jsr hook_speech
.else ; isDavex3
	jsr on40
.endif ; isDavex2
	lda #40
	sta scr_width
	jmp home

;********************************************
;
; wildcard expansion routines for
; Davex
;
; 28-Jun-86
;
;*******************************************
;*******************************************
;
; wild_state :
;   0 = not expanding wildcards
;   1 = returning original path; no wildcards
;   2 = scanning directory
;   3 = scanning volume list
;
wild_state:	.res 1
;
; wild_begin -- start a wildcard
; expansion
;
wild_begin:
	lda #1
	sta wild_state
	lda num_parms
	beq wbx
	jsr grab_wstrings
	jsr contains_wild
	bcs wbx

	inc wild_state	; = 2
	bit wild_flags
	bvc :+		; branch if no wildcards in volume name portion
	inc wild_state	; = 3
:	jsr push_level
	lda #>wildstring1
	ldy #<wildstring1
	jsr getinfo
	cmp #tDIR
	beq w_isDIR
	lda #der_notdir
	jmp ProDOS_err
w_isDIR:
	lda #>wildstring1
	ldy #<wildstring1
	jsr dir_setup
wbx:	rts
;
; wild_next -- create next expansion
; of wildcard strings; return SEC if
; no more matches
;
wild_next:
	ldx wild_state
	beq wn_done
	dex
	bne nxtwld
; return non-wild path once
	stx wild_state
	clc
	rts

nxtwld:	jsr read1dir
	bcs wnfin1
	lda catbuff
	and #%00001111
	sta catbuff
	jsr compare_wild
	bcs nxtwld
	jsr expand_wild
;
; print <command> <path1> [<path2>] except
; for commands beginning with NOP
;
	jsr suspend
	bit wild_flags
	bmi ask_path
	ldy #0
	lda (cmd_addr),y
	cmp #$ea
	beq no_askpath
	bne askpath2
ask_path:
	jsr TalkCont
askpath2:
	jsr print_cmd
	jsr pr_sp
	lda #0
	jsr getparm_n
	jsr print_path
	lda parmtypes+1
	cmp #t_path
	beq do2
	cmp #t_wildpath
	bne skip2
do2:	jsr pr_sp
	lda #1
	jsr getparm_n
	jsr print_path
skip2:
	bit wild_flags
	bpl noquery
	lda #$80+'n'	;default = No
	jsr yesno2
	jsr restore
	beq nxtwld
	clc
	rts

noquery:
	jsr crout
no_askpath:
	jsr restore
	clc
	rts

wnfin1:	jsr dir_finish
	dec wild_state
wn_done:
	sec
	rts

;*******************************************
;
; directory reading routines
;
; push_level -- close old dir level (do this
;               before calling dir_setup)
;
; dir_setup -- open dir (ay=path)
;
; read1dir -- get next active entry from
;             open directory; BCS if no more
;             entries
;
; dir_finish -- close level
;
;*******************************************
dir_setup:
	ldx #0
	stx direcpath
	jsr dir_setup2
	bcc :+
	jmp ProDOS_err
:	rts

dir_setup2:		; partial path in AY
	pha
	tya
	pha
	lda dir_level
	bpl :+
	lda #0
	sta direcpath
:	pla
	tay
	pla
	jsr buildcatpath
	lda #wildlevel
	SET_LEVEL
	CALLOS mli_open, opendir_p
	pha
	lda #stdlevel
	SET_LEVEL
	pla
	CALLOS_BRANCH_POS dset_opened
	sec
	rts
dset_opened:
	lda dir_ref
	sta dir_ref2
	sta dir_ref3
	sta dir_ref4
.if IsDavex3
	sta dir_ref5
.endif
	lda #0
	ldy #$23
	jsr setmark
	bcs wld_err
	jsr read1byte
	bcc wld_did1
	rts
wld_did1:
	sta EntryLen
	jsr read1byte
	sta EntPerBlock
	jsr read1byte
	sta file_count
	jsr read1byte
	sta file_count+1

	lda EntPerBlock
	sta filecntr

	lda #4
	clc
	adc EntryLen
	tay
	lda #0
	jsr setmark
	dec filecntr
	lda dir_ref
	clc
	rts
wld_err:
	jmp ProDOS_err

;
; read next active entry & dec file_count
;
read1dir:
	lda EntryLen
	sta rc_len
	CALLOS mli_read, readcat_parms
	CALLOS_BRANCH_POS rc_ok
	cmp #err_eof
	beq eoDIR
	jmp ProDOS_err

eoDIR:
;;;	sec		; carry is already set from CMP+BEQ ( sec for >= )
	rts

rc_ok:	dec filecntr
	bne rc_sameblk
	jsr getmark
	ldy #4
	and #%11111110
	clc
	adc #2
	jsr setmark
	lda EntPerBlock
	sta filecntr
rc_sameblk:
	lda catbuff
	and #%11110000
	beq read1dir	;not active

	lda file_count
	bne :+
	dec file_count+1
:	dec file_count
	jsr calc_cmask
	ldy #1
	ldx #15
niceCase:
	asl case_mask+1
	rol case_mask
	bcc NoLcase
	lda catbuff,y
	jsr downcase
	and #$7f
	sta catbuff,y
NoLcase:
	iny
	dex
	bne niceCase
; zero out unused name bytes (for sorting)
	lda catbuff
	and #$f
	tay
	lda #0
:	cpy #15
	bcs @out
	sta catbuff+1,y
	iny
	bne :-
@out:	clc
	rts
;
; close file & pop level of dirstack
;
dir_finish:
	jmp pop_level

readcat_parms:
	.byte 4
dir_ref2:
	.res 1
	.addr catbuff
rc_len:	.addr 0
	.res 2


; do not change order or insert
file_count:
	.res 2
filecntr:
	.res 1	;counts down to 0 for each block
; end of do-not-change

EntryLen:
	.res 1
EntPerBlock:
	.res 1
;
; getmark into ay
;
getmark:
	CALLOS mli_getmark, get_mark_parms
	lda pmark+1
	ldy pmark
	rts
setmark:
.if IsDavex2
	sta pmark+1
	sty pmark
	lda #0
	sta pmark+2
.else
	sta pmark_set+1
	sty pmark_set
	lda #0
	sta pmark_set+2
.endif
setmark2:
	CALLOS mli_setmark, set_mark_parms
	CALLOS_BRANCH_POS :+
	sec
	rts
:	clc
	rts

read1byte:
	CALLOS mli_read, read1p
	CALLOS_BRANCH_NEG r1x2
dcheat:	lda #0
r1x:
	clc
	rts
r1x2:
	sec
	rts

read1p:	.byte 4
dir_ref4:
	.res 1
	.addr dcheat+1
	.addr 1
	.addr 0

buildcatpath:
	sta p+1
	sty p
	ldy #1
	lda (p),y
	and #%01111111
	cmp #$2f
	beq bcp_full
; append to old direcpath
	ldy #0
	lda (p),y	;len
	tax
appdirp:
	iny
	lda (p),y
	cpx #0
	beq appdirpx
	stx appdpx
	inc direcpath
	ldx direcpath
	sta direcpath,x
	ldx appdpx
	dex
	bne appdirp
needslash:
	ldx direcpath
	lda direcpath,x
	and #%01111111
	cmp #$2f
	beq slashed
	inc direcpath
	lda #$2f
	ldx direcpath
	sta direcpath,x
slashed:
appdirpx:
	rts

appdpx:	.res 1

bcp_full:
	ldy #64
bcpf2:	lda (p),y
	sta direcpath,y
	dey
	bpl bcpf2
	jmp needslash

;*******************************************
push_level:
	lda dir_level
	bmi pl_nolevel

	jsr getmark
	lda #wildlevel
	SET_LEVEL
	lda dir_ref
	jsr close	;close this level
	lda #stdlevel
	SET_LEVEL

	lda dir_level
	cmp #dstkmax
	bcc dlevelok
	lda #der_levels
	jmp ProDOS_err
dlevelok:
	ldy #64
pushpn:	lda direcpath,y
	sta (dstk_ptr),y
	dey
	bpl pushpn
	ldy #dstk_mark
	lda pmark
	sta (dstk_ptr),y
	lda pmark+1
	iny
	sta (dstk_ptr),y
	lda pmark+2
	iny
	sta (dstk_ptr),y
	ldy #dstk_fcount
pushmore:
	lda file_count-dstk_fcount,y
	sta (dstk_ptr),y
	iny
	cpy #dstk_recsiz
	bcc pushmore
	clc
	lda dstk_ptr
	adc #dstk_recsiz
	sta dstk_ptr
	bcc dstkpok
	inc dstk_ptr+1
dstkpok:
pl_nolevel:
	inc dir_level
	rts

;*******************************************
pop_level:
	lda dir_ref
	jsr close
	lda #0
	sta direcpath
	lda dir_level
	cmp #1
	bpl pop_lev2
	lda #<-1
	sta dir_level
	sec
	rts
pop_lev2:
	sec
	lda dstk_ptr
	sbc #dstk_recsiz
	sta dstk_ptr
	bcs dstkpok2
	dec dstk_ptr+1
dstkpok2:
	lda dstk_ptr+1
	ldy dstk_ptr
	sta p+1
	sty p
	ldy #64
popdirp:
	lda (p),y
	sta direcpath,y
	dey
	bpl popdirp
	lda p+1
	ldy p
	jsr dir_setup
	ldy #dstk_mark
	lda (dstk_ptr),y
	sta pmark
	iny
	lda (dstk_ptr),y
	sta pmark+1
	iny
	lda (dstk_ptr),y
	sta pmark+2
	jsr setmark2
	ldy #dstk_fcount
	lda (dstk_ptr),y
	sta file_count
	iny
	lda (dstk_ptr),y
	sta file_count+1
	ldy #dstk_filecntr
	lda (dstk_ptr),y
	sta filecntr
	dec dir_level
	clc
	rts

;*******************************************
;
; wildcard string routines
;
;*******************************************
;
; contains_wild -- return CLC if WILDSTRING1
; is wild
;
; wild_index = position in wildstring1 of
; wildcard_
;
; wild_flags:  Q V x x  x x x x
;   Q=query (?)
;   V=wild in volume name
;
wild_index:	.res 1
wild_flags:	.res 1

contains_wild:
	ldy #0
	sty wild_index
	sty wild_flags
	sty temp	;true if hit '/'
	lda wildstring1,y
	tay
	beq cw_no
cw1:	lda wildstring1,y
	ora #%10000000
	cmp #$80+'/'
	bne cwnslsh
;;;	sec
	ror temp
cwnslsh:
	cmp #$80+'*'
	beq cwyes0
	cmp #$80+'='
	beq cwyes
	cmp #$80+'?'
	bne cwno
	lda #%10000000	;query flag
	ora wild_flags
	sta wild_flags
cwyes0:	lda #$80+'='
	sta wildstring1,y
cwyes:	ldx wild_index
	bne extra_wild
	bit temp
	bmi bad_place
	sty wild_index
cwno:	dey
	bne cw1
	lda wild_index
	bne cw_yes
cw_no:	sec
	rts
cw_yes:	ldy #1
	lda wildstring1,y
	ora #%10000000
	cmp #$80+'/'
	bne not_wvol
	ldx #1	;'/' count
wvolchk:
	iny
	cpy wild_index
	bcs wvchecked
	lda wildstring1,y
	ora #%10000000
	cmp #$80+'/'
	bne wvolchk
	inx
	bne wvolchk
wvchecked:
	cpx #2
	bcs not_wvol
	lda #%01000000	;wc in volname
	ora wild_flags
	sta wild_flags
not_wvol:
	jsr build_wpath
	clc
	rts
;
extra_wild:
	lda #der_1wild
der5:	jmp ProDOS_err
;
bad_place:
bad_wild:
	lda #der_badwild
	bne der5
;
; build_wpath -- copy part of wildstring1 before
; segment with wildcard into wdirpath
;
build_wpath:
	ldy wild_index
bwp2:	lda wildstring1,y
	ora #%10000000
	cmp #$80+'/'
	beq bwp_len
	dey
	bne bwp2
; wc in seg1 of partial path; use prefix
	ldx wildstring1
wseg2:	lda wildstring1,x
	sta wildseg,x
	dex
	bpl wseg2
	CALLOS mli_getpfx, wildpfx
	jsr pmgr
	.byte pm_downcase
	.addr wildstring1
	rts

bwp_len:
	sty temp
	sec
	lda wildstring1
	sbc temp
	sta wildseg	;length of last seg
	ldx #0
wseg1:	iny
	inx
	lda wildstring1,y
	sta wildseg,x
	cpy wildstring1
	bcc wseg1
	ldy temp
	sty wildstring1
	rts
;
; compare_wild -- returns CLC if string in CATBUFF
; matches string at WILDSEG
;
; May have to ask the user (for '?' wildcards)
;
matchstr_left:	.res 1
matchstr_r:	.res 1

compare_wild:
	bit wild_flags
	bvc cmpw_notvol
; we could allow wildcards in volume names someday, but now it's an error
	jmp bad_wild

cmpw_notvol:
	jsr cmp_wseg
	bcs cmpwno
	lda #0
	jsr getparm_n
	txa
	beq cmpw_notyp
	cmp catbuff+16
	bne cmpwno
cmpw_notyp:
	clc
	rts
cmpwno:
	sec
	rts
;
; CLC=matches: compare path at catbuff to
; wildseg (containing '=' for any wc)
;
cmp_wseg:
; an '=' must match at least 0 characters
	ldx catbuff
	inx
	cpx wildseg
	bcc cmppw_no
	jsr cmp_left
	bcs cmppw_no
; calculate matchstr_r
	sec
	lda catbuff
	sbc wildseg
	sec
	adc matchstr_left
	sta matchstr_r

	jmp cmp_right

cmppw_no:
	sec
	rts

;
; cmp_left -- return CLC if chars in WILDSEG
; before wildcard match chars at beginning
; of path at CATBUFF
;
cmp_left:
	ldy #0
cleft1:	lda wildseg+1,y
	jsr downcase
	cmp #$80+'='
	beq cleftok
	sta temp
	lda catbuff+1,y
	jsr downcase
	cmp temp
	bne cleftno
	iny
	cpy wildseg
	bcc cleft1
cleftok:
	iny
	sty matchstr_left
	clc
	rts
cleftno:
	sec
	rts

;
; cmp_right -- return CLC if chars in WILDSEG
; after wildcard match chars at end of path
; at CATBUFF
;
cmp_right:
	ldy wildseg
	ldx catbuff
cright1:
	lda wildseg,y
	jsr downcase
	cmp #$80+'='
	beq crightok
	sta temp
	lda catbuff,x
	jsr downcase
	cmp temp
	bne crightno
	dex
	dey
	bne cright1
crightok:
	clc
	rts
crightno:
	sec
	rts

;
; grab_wstrings -- copy 1st (and possibly 2nd)
; path parameters into wildstring1 (and
; wildstring2)
;
grab_wstrings:
	lda #0
	sta wildstring1
	sta wildstring2
	lda parmtypes
	cmp #t_wildpath
	bne grabbed
	lda #0
	jsr getparm_n
	sta p+1
	sty p
	ldy #127
grab1:	lda (p),y
	sta wildstring1,y
	dey
	cpy #<-1
	bne grab1

	lda parmtypes+1
	cmp #t_path
	beq grab2a
	cmp #t_wildpath
	bne grabbed
grab2a:	lda #1
	jsr getparm_n
	sta p+1
	sty p
	ldy #127
grab2:	lda (p),y
	sta wildstring2,y
	dey
	cpy #<-1
	bne grab2
grabbed:
	rts

;
; expand_wild -- generate first path from
; catbuff & wildstring1.  If there's a second
; path, replace any wild character in it with the
; same string the wild character in the 1st
; path replaces
;
expand_wild:
	lda #0
	jsr getparm_n
	sta p+1
	sty p
	sta ew_p+1
	sty ew_p
	ldy #127
ew1:	lda wildstring1,y
	sta (p),y
	dey
	bpl ew1
	lda #>catbuff
	ldy #<catbuff
	jsr pmgr
	.byte pm_appay
ew_p:	.addr 0
;
; replace '=' in wildstring2 with WildReplace
;
	lda wildstring2
	beq @out
	lda #1
	jsr getparm_n
	sta p+1
	sty p
	lda #0
	tay
	tax
	sta (p),y
@loop:	cpx wildstring2
	bcs @out
	inx
	lda wildstring2,x
	jsr replch
	jmp @loop
@out:	rts

;
; replch -- add char or WILDREPACE onto
; second parameter
;
replch:
	ora #%10000000
	cmp #$80+'?'
	beq replwc
	cmp #$80+'*'
	beq replwc
	cmp #$80+'='
	bne repl_addch

replwc:
	txa
	pha
	ldx matchstr_left
appmatch:
	cpx matchstr_r
	bcs appmatchx
	lda catbuff,x
	jsr repl_addch
	inx
	bne appmatch
appmatchx:
	pla
	tax
	rts

repl_addch:
	pha
	ldy #0
	lda (p),y
	clc
	adc #1
	sta (p),y
	cmp #126
	bcs wc_outr
	tay
	pla
	sta (p),y
	rts

wc_outr:
	lda #der_outroom
	jmp ProDOS_err


;
; Modified 23-Jan-90 DAL for Davex 1.25
;   History buffer is now $100 bytes (was $200)
;
;*********************************************
;
; Path manager for DAVEX
;
; History manager for DAVEX
;
;*********************************************
;
; call format:
;
;   jsr pmgr
;   .byte pm_-----
;   .addr (parameters)
;
;*********************************************
pmlen:	.res 1
pm_y:	.res 1

pm_disp:
	.addr pm_doappay-1
	.addr pm_doappch-1
	.addr pm_doup-1
	.addr pm_doslashif-1
	.addr pm_docopy-1
	.addr pm_dodownc-1

;*********************************************
pmfetch2:
	jsr pmfetch
	sta pmpath2
	jsr pmfetch
	sta pmpath2+1
	rts

;*********************************************
pmfetch:
	inc pmptr
	bne pmptrok
	inc pmptr+1
pmptrok:
	ldy #0
	lda (pmptr),y
	rts

;*********************************************
pmgr:	sta pmpath1+1
	sty pmpath1
	pla
	sta pmptr
	pla
	sta pmptr+1
	jsr pmfetch
	cmp #pm_last+1
	bcc pmgr_ok
	.byte 0		; single-byte brk (since assembler wants 2)

pmgr_ok:
	jsr pmgr2
	lda pmptr+1
	pha
	lda pmptr
	pha
	lda pmpath1+1
	ldy pmpath1
	rts

pmgr2:	asl a
	tay
	lda pm_disp+1,y
	pha
	lda pm_disp,y
	pha
	lda pmpath1+1
	ldy pmpath1
	rts

;*********************************************
pm_doappay:
	jsr pmfetch2
	ldy #0
	lda (pmpath1),y
	sta pmlen
pmapp1:	cpy pmlen
	bcs pmapped
	iny
	lda (pmpath1),y
	jsr pm_app2
	jmp pmapp1
pmapped:
	rts

pm_doappch:
	jsr pmfetch2
	lda pmpath1+1	;a
	jmp pm_app2

pm_doup:
	jsr pmfetch2
	ldy #0
	lda (pmpath2),y
	beq upxx
	tay
	dey
	beq didup
doup1:	lda (pmpath2),y
	and #$7f
	cmp #$2f
	beq didup
	dey
	bpl doup1
didup:	tya
	ldy #0
	sta (pmpath2),y
upxx:	rts

pm_doslashif:
	jsr pmfetch2
	ldy #0
	lda (pmpath2),y
	tay
	lda (pmpath2),y
	and #$7f
	cmp #$2f
	beq dsifx
	lda #$2f	;slash
	bne pm_app2
dsifx:	rts

pm_docopy:
	jsr pmfetch2
	lda pmpath2+1
	ldy pmpath2
	sta pmpath1+1
	sty pmpath1
	jsr pmfetch2
	ldy #0
	lda (pmpath1),y
	tay
pmcopy1:
	lda (pmpath1),y
	sta (pmpath2),y
	dey
	cpy #$ff
	bne pmcopy1
	rts

pm_app2:
	sty pm_y
	pha
	ldy #0
	lda (pmpath2),y
	clc
	adc #1
	sta (pmpath2),y
	tay
	pla
	sta (pmpath2),y
	ldy pm_y
	rts

pm_dodownc:
	jsr pmfetch2
	ldy #0
	lda (pmpath2),y
	beq @out
	tay
@loop:	lda (pmpath2),y
	jsr downcase
	and #$7f
	sta (pmpath2),y
	dey
	bne @loop
@out:	rts

;*********************************************
;*********************************************
;
; HistoryMgr -- manage list of previous cmds
;
HistoryMgr:
	cpx #mli_close
	bne n_hcl
;
; empty the history list
;
	lda #0
	sta History
	clc
	rts

n_hcl:	cpx #mli_write
	bne n_hwr
;
; write string (AY) to history list
;
	sta p2+1
	sty p2
histwr0:
	jsr count_history
	sec
	ldy #0
	lda p
	adc (p2),y
	lda p+1
	adc #0
	cmp #>(History+$100)
	bcc hist_fits
	jsr shift_hist
	jmp histwr0

hist_fits:
	ldy #0
	lda (p2),y
	tay
	iny
	lda #0
	sta (p),y
	dey
	inc p2
	bne hp2ok
	inc p2+1
hp2ok:
histwr1:
	lda (p2),y
	sta (p),y
	dey
	cpy #<-1
	bne histwr1
	clc
	rts

n_hwr:	cpx #mli_read
	bne n_hrd
;
; read the Ath string from the end of the
; history list (return ptr in AY)
;
	sta temp
	jsr count_history
	pha
	jsr point_history
	pla
	sec
	sbc #1
	sec
	sbc temp
	sta temp
	beq readhist
readh1:	jsr next_hist
	cpy #0
	beq readherr
	dec temp
	bne readh1
readhist:
	lda p+1
	ldy p
	clc
readherr:
	rts

n_hrd:	sec
	lda #err_badcall
	rts
;
; return size of history (A)
;
count_history:
	ldx #<-1
	jsr point_history
@count:	inx
	jsr next_hist
	cpy #0
	bne @count
	txa
	rts
;
; point_history
;
point_history:
	lda #>History
	ldy #<History
	sta p+1
	sty p
	rts
;
; next_hist -- advance P to next string
; return len of str in Y
;
next_hist:
	ldy #<-1
nexth1:	iny
	lda (p),y
	bne nexth1
	tya
	beq nh1
	sec
	adc p
	sta p
	bcc nh1
	inc p+1
nh1:	rts

;
; shift_hist -- remove oldest string
;
shift_hist:
	jsr point_history
	lda p+1
	ldy p
	sta move_to+1
	sty move_to
	jsr next_hist
	lda p+1
	ldy p
	sta range_strt+1
	sty range_strt
	lda #>(History+$100)
	ldy #<(History+$100)
	sta range_end+1
	sty range_end
	ldy #0
	jmp move


;***********************************************************
;
; File manager for Davex  -- USES PAGEBUFF!
;
;***********************************************************
;
; Note: This implementation can keep track of just ONE
;       file at a time.
;
;***********************************************************
;
; Allows commands to easily support reading from AWP files.
; calls:
;
;   jsr fman_open
;     takes path ptr in AY, returns (CLC,A=refnum) or
;     (SEC,A=error)
;
;   jsr fman_read
;     takes refnum in A, returns (CLC,A=char) or (SEC,A=err)
;
;***********************************************************
fm_bufidx:	.byte 0
fm_bufsz:	.byte 0
awp_blanks:	.byte 0

fman_open:
	sta fm_name+1
	sty fm_name
	sta fm_info+1
	sty fm_info
	CALLOS mli_gfinfo, fm_infop
	CALLOS_BRANCH_NEG fmEXIT1
	CALLOS mli_open, fm_openp
	CALLOS_BRANCH_NEG fmEXIT2
fmOK:	lda #0
	sta fm_bufsz
	sta fm_bufidx
	sta awp_blanks
	lda fm_type
	cmp #tAWP
	bne notAWPopn
	jsr SkipAWPhdr
notAWPopn:
	lda fm_ref
	clc
	rts
fmEXIT:	sec
	rts
fmEXIT1:
	jmp ProDOS_err
fmEXIT2:
	cmp #err_filopen
	bne fmOK
	jmp ProDOS_err

SkipAWPhdr:
	lda fm_ref
	sta fm_posref
	CALLOS mli_setmark, fm_setmp
	rts

fm_readp:
	.byte 4
fm_rref:
	.byte 0
	.addr pagebuff
	.addr 80	;request count
txtLEN:	.addr 0

;*******************************************
fman_read:
	sta fm_rref
	lda fm_type
	cmp #tAWP
	beq fmr_awp
;
; read 1 character from a non-AWP file
;
fmr_txt:
	ldx fm_bufidx
	lda pagebuff,x
	ora #$80
	cpx fm_bufsz
	bcc fmTXT_ok
	jsr fill_TXT
	bcc fmr_txt
fmTXT_ok:
	inc fm_bufidx
	rts

fill_TXT:
	CALLOS mli_read, fm_readp
	CALLOS_BRANCH_NEG fm_readx
	lda #0
	sta fm_bufidx
	lda txtLEN
	sta fm_bufsz
.if IsDavex3
	clc
	rts
fm_readx:
	sec
	rts
.else
fm_readx:
	rts
.endif

;
; read 1 character from AWP file
;
fmr_awp:
	lda awp_blanks
	beq fmr_notbl
	dec awp_blanks
	lda #$a0
	clc
	rts
fmr_notbl:
	ldx fm_bufidx
	lda pagebuff+2,x
	ora #$80
	cpx fm_bufsz
	bcc :+
	jsr fill_awp
	bcc fmr_awp
:	inc fm_bufidx
	rts

;
; fill the AWP line buffer from file
;
fill_awp:
	lda fm_rref
	sta fill_ref
	sta awptext_ref
	CALLOS mli_read, fillp
	CALLOS_BRANCH_NEG filled
	lda awp_rec+1
	cmp #$D0	;CR record?
	beq awp_cr
	cmp #0
	bne fill_awp	;formatting rec--try again
	lda awp_rec
	sta awptext_len
	CALLOS mli_read, awptext
	pha
	ldx #0
	stx fm_bufidx
	lda pagebuff+1
	and #$7f
	sta fm_bufsz
	inc fm_bufsz
	tax
	lda #$80+'M'-ctrl
	sta pagebuff+2,x
	lda pagebuff
	sta awp_blanks
	pla
filled:	rts

awp_cr:	lda #$80+'M'-ctrl
	sta pagebuff+2
	ldx #0
	stx fm_bufidx
	inx
	stx fm_bufsz
	clc
	rts

fillp:	.byte 4
fill_ref:
	.res 1
	.addr awp_rec
	.addr 2
	.addr 0
awp_rec:
	.res 2


awptext:
	.byte 4
awptext_ref:
	.res 1
	.addr pagebuff
awptext_len:
	.addr 0
	.addr 0

;**************************************
;
; 'eject' command for Davex
;
; Modified 31-Jan-88 DL
;   To do a Status(0) to determine the number of units
;   in the chain, rather than stopping when an error
;   occurs.  Apple's SCSI card does not behave as
;   expected when a unit number beyond the end of the
;   chain is used.
;
;**************************************
max_unit:	.byte 0
this_unit:	.byte 0
this_slot:	.byte 0

go_eject:
	sta p+1
	sty p
	lda #7
	sta this_slot
@ej1:	lda this_slot
	jsr eject_slot
	dec this_slot
	bne @ej1
	rts

;
; eject stuff from slot A if there's a SmartPort there
;
eject_slot:
	jsr isSmartPort
	bcs ejected_sl
	jsr CalcSP
	jsr GetMaxU
	lda #1
	sta this_unit
ej2:
	lda this_unit
	cmp max_unit
	beq TryEjThis
	bcs ejected_sl
TryEjThis:
	lda this_slot
	ldx this_unit
	jsr eject_ax
	inc this_unit
	jmp ej2
ejected_sl:
	rts

CalcSP:
	lda this_slot
	ora #$c0
	sta callSP+2
	sta callSP2+2
	sta callSP3+2
	sta callSP4+2
	sta temp+1
	ldy #0
	sty temp
	ldy #$ff
	lda (temp),y
	clc
	adc #3
	sta callSP+1
	sta callSP2+1
	sta callSP3+1
	sta callSP4+1
	rts

;
; get the number of units in the chain
;
GetMaxU:
callSP4: jsr $ffff
	.byte 0		;status
	.addr maxu_p
	lda pagebuff	;unit count
	sta max_unit
	rts

maxu_p:	.byte 3,0
	.addr pagebuff
	.byte 0

;
; Eject unit (A=slot, X=unit) IF there's
; a UniDisk 3.5 or Apple 3.5 there and the
; volume name is one that we're supposd
; to eject.
;
; (TYPE=1 identifies a UniDisk 3.5 or Apple 3.5)
;
eject_ax:
	stx ej_unitnm
	stx stat_unitnm
; x=unit#
	lda this_slot
	jsr ej_decide
	bcs ejected
	jsr CanEject
	bcs ejected
;
callSP:	jsr $ffff
	.byte 4
	.addr EjParms
ejected:
	rts

;
; CanEject -- return CLC if unit is ejectable (TYPE=1)
;
CanEject:
callSP2: jsr $ffff
	.byte 0	;status
	.addr spstat_p
	bcs cant_ej	;error $11 (invalid unit) should occur eventually

	lda pagebuff+21
	cmp #1
	beq yes_ej
cant_ej:
	sec
	rts
yes_ej:	clc
	rts

spstat_p:
	.byte 3
stat_unitnm:
	.byte 0
	.addr pagebuff
	.byte 3		;get DIB

;
; ej_decide (A=slot, X=unit) CLC = eject this disk
;
ej_decide:
	stx rb2unit
	ldy #0
	lda (p),y
	bne callSP3
	clc	;null name --> eject all
	rts

callSP3: jsr $ffff
	.byte 1	;readblock
	.addr ej_rb2
	bcs decid_no
	lda #$80+'/'
	sta pagebuff+1
	lda filebuff+4
	and #%00001111
	tax
	inx
	stx pagebuff
ejBldN:	dex
	beq ejBilt
	lda filebuff+4,x
	jsr downcase
	sta pagebuff+1,x
	jmp ejBldN
ejBilt:

	jsr pmgr
	.byte pm_slashif
	.addr pagebuff
	lda p+1
	ldy p
	sta ejslif+1
	sty ejslif
	jsr pmgr
	.byte pm_slashif
ejslif:	.addr 0

	ldy #0
	lda (p),y
	tax
	cmp pagebuff
	bne decid_no
:	iny
	dex
	beq decid_yes
	lda (p),y
	jsr downcase
	cmp pagebuff,y
	beq :-
decid_no:
	sec
	rts
decid_yes:
	clc
	rts

ej_rb2:	.byte 3
rb2unit:
	.byte 0
	.addr filebuff
	.byte 2,0,0	;block #

;
; isSmartPort -- return SEC if no card in slot A
;
isSmartPort:
	cmp #8
	bcs ispNO
	cmp #0
	beq ispNO
	ora #$C0
	sta temp+1
	lda #0
	sta temp
	ldy #1
	lda (temp),y
	cmp #$20
	bne ispNO
	ldy #3
	lda (temp),y
	bne ispNO
	ldy #5
	lda (temp),y
	cmp #3
	bne ispNO
	ldy #7
	lda (temp),y
	bne ispNO
	clc
	rts
ispNO:	sec
	rts
;
EjParms:
	.byte 3
ej_unitnm:
	.byte 0
	.addr EjCtrl
	.byte 4
EjCtrl:	.addr 0


;*********************************************
;
; ERR.TEXT for ProDOS and Davex errors
;
;*********************************************
;
; Format:
;   Code*1, String $00
;   Code*1, String $00 ...
;   $00
;
; Codes for ProDOS are $00..$7F
; Codes for Davex  are $80..$FF
;
;**********************************************
err_text:
	.byte $2f
	asc_hi "no disk"
	.byte 0
	.byte err_badcall
	asc_hi "bad ProDOS call"
	.byte 0
	.byte err_badcnt
	asc_hi "bad pcount"
	.byte 0
	.byte err_ifull
	asc_hi "inttbl full"
	.byte 0
	.byte err_io
	asc_hi "disk I/O"
	.byte 0
	.byte err_nodev
	asc_hi "no device connected"
	.byte 0
	.byte err_wrprot
	asc_hi "disk write-protected"
	.byte 0
	.byte err_switched
	asc_hi "disk switched"
	.byte 0
	.byte err_2slow
	asc_hi "drive too slow"
	.byte 0
	.byte err_2fast
	asc_hi "drive too fast"
	.byte 0
	.byte err_pnsyntax
	asc_hi "bad pathname syntax"
	.byte 0
	.byte err_fcbfull
	asc_hi "FCB full"
	.byte 0
	.byte err_ivlref
	asc_hi "bad refnum"
	.byte 0
	.byte err_dirnotfnd
	asc_hi "directory not found"
	.byte 0
	.byte err_volnotfnd
	asc_hi "volume not found"
	.byte 0
	.byte err_filnotfnd
	asc_hi "file not found"
	.byte 0
	.byte err_dupfil
	asc_hi "duplicate file"
	.byte 0
	.byte err_full
	asc_hi "volume full"
	.byte 0
	.byte err_dirfull
	asc_hi "directory full"
	.byte 0
	.byte err_filfmt
	asc_hi "file format error"
	.byte 0
	.byte err_strgtype
	asc_hi "bad storage type"
	.byte 0
	.byte err_eof
	asc_hi "end of file"
	.byte 0
	.byte err_badpos
	asc_hi "bad file pos"
	.byte 0
	.byte err_locked
	asc_hi "file locked"
	.byte 0
	.byte err_filopen
	asc_hi "file open"
	.byte 0
	.byte err_dircnt
	asc_hi "dir count"
	.byte 0
	.byte err_notprodos
	asc_hi "volume is not ProDOS"
	.byte 0
	.byte err_ivlparm
	asc_hi "invalid param"
	.byte 0
	.byte err_vcbtfull
	asc_hi "VCB full"
	.byte 0
	.byte err_badbufadr
	asc_hi "bad buff addr"
	.byte 0
	.byte err_dupvol
	asc_hi "duplicate volume"
	.byte 0
	.byte err_badmap
	asc_hi "baked bit-map"
	.byte 0
;=======================================
;
; Part II of error table:  Davex errors
;
	.byte der_illegparm
	asc_hi "illegal option"
	.byte 0
	.byte der_toomany
	asc_hi "too many parameters"
	.byte 0
	.byte der_badtype
	asc_hi "bad parm type"
	.byte 0
	.byte der_unknftyp
	asc_hi "unknown filetype"
	.byte 0
	.byte der_dupopt
	asc_hi "duplicate option"
	.byte 0
	.byte der_baddev
	asc_hi "devnum format is .61"
	.byte 0
	.byte der_abort
	asc_hi "aborted"
	.byte 0
	.byte der_waitspool
	asc_hi "wait for files to print or use spool -z"
	.byte 0
	.byte $88
	asc_hi "illegal block read/write"
	.byte 0
	.byte der_needs3
	asc_hi "filetype needs 3 chars"
	.byte 0
	.byte der_missopt
	asc_hi "missing option"
	.byte 0
	.byte der_badhware
	asc_hi "missing hardware"
	.byte 0
	.byte der_badnum
	asc_hi "bad number"
	.byte 0
	.byte der_bignum
	asc_hi "number too big"
	.byte 0
	.byte der_ynexp
	asc_hi "y' or 'n' expected"
	.byte 0
	.byte der_nosbf
	asc_hi "no startup buffer"
	.byte 0
	.byte der_smallsbf
	asc_hi "startup buffer too small"
	.byte 0
	.byte der_notxtn
	asc_hi "not an external command"
	.byte 0
	.byte der_adrlow
	asc_hi "cmd address too low"
	.byte 0
	.byte der_notfnd
	asc_hi "not found"
	.byte 0
	.byte der_semiexp
	asc_hi "missing ';'"
	.byte 0
	.byte der_nottxt
	asc_hi "not script file"
	.byte 0
	.byte der_notdir
	asc_hi "not DIR"
	.byte 0
	.byte der_levels
	asc_hi "too many dir levels"
	.byte 0
	.byte der_1wild
	asc_hi "1 wildcard only"
	.byte 0
	.byte der_badwild
	asc_hi "bad wildcard"
	.byte 0
	.byte der_outmem
	asc_hi "out of memory"
	.byte 0
	.byte der_outroom
	asc_hi "out of room"
	.byte 0
;====================================
	.byte 0


;
; 'filetypes' -- default filetypes for Davex
;
; Last mod 24-Mar-90 DAL (March 1990 File Type notes)
;
filetyp0:
	.byte $01,$03,$04,$06,$08,$0B,$0F,$16
	.byte $19,$1A,$1B,$20,$2a,$2b,$2c,$2d
	.byte $2e,$42,$50,$51,$52,$53,$54,$55
	.byte $56,$57,$58,$59,$5a,$5b,$5c,$5d
	.byte $5e,$6b,$6d,$6e,$6f,$a0,$ab,$ac
	.byte $ad,$b0,$b1,$b2,$b3,$b4,$b5,$b6
	.byte $b7,$b8,$b9,$ba,$bb,$bc,$bd,$bf
	.byte $c0,$c1,$c2,$c3,$c5,$c6,$c7,$c8
	.byte $c9,$ca,$d5,$d6,$d7,$d8,$db,$e0
	.byte $e2,$ee,$ef,$f0,$f9,$fa,$fb,$fc
	.byte $fd,$fe,$ff
	.byte $00

fileasc0:
	asc "badptxtxtbinfotwpfdirpfs"
	asc "adbawpasptdmsc8ob8ic8ld8"
	asc "p8cftdgwpgssgdbdrwgdphmd"
	asc "edustnhlpcomcfganmmument"
	asc "dvubiotdrprehdvwp gsbtdf"
	asc "bdfsrcobjlibs16rtlexepif"
	asc "tifndacdatoldvrldffstdoc"
	asc "pntpicanipaloogscrcdvfon"
	asc "fndicnmusinsmdisnddbmlbr"
	asc "atkr16pascmdos intivrbas"
	asc "varrelsys"
listend:

;
; talkstuff -- misc routines for speech (Textalker, Echo II)
;
; Last mod 28-Jul-87 DL
;
hook_speech:
	jsr hook_ispeech
	jsr hook_ospeech
	jsr is_txtt
	beq ini_tt
	jsr is_slotb
	beq ini_sb
	rts
; init textalker
ini_tt:	ldx #$ff
	stx $37d
	ldy $c01f
	lda $bf98
	jsr $3a9
	rts
; init SCAT
ini_sb:
	lda #0
	jsr $3b2
	rts

hook_ispeech:
	jsr hooki2
	lda ksw+1
	ldy ksw
	sta speechi+1
	sty speechi
	rts

hooki2:
	jsr is_txtt
	beq hooki_tt
	jsr is_slotb
	bne no_speek
; hook in SlotBuster ($3ac)
	lda #3
	sta ksw+1
	lda #$ac
	sta ksw
	lda #$ff
	sta speech
	rts

hooki_tt:
	lda #3
	sta ksw+1
	lda #$a9
	sta ksw
	lda #$ff
	sta speech
	rts
no_speek:
	lda #0
	sta speech
	rts

hook_ospeech:
	jsr is_txtt
	beq hooko_tt
	jsr is_slotb
	bne no_speek
; hook out slotbuster == same as textalker ($3A6)
hooko_tt:
	lda #3
	sta csw+1
	lda #$a6
	sta csw
	lda #$ff
	sta speech
	rts
;
; is_txtt -- return BEQ if TextTalker routines present
;
is_txtt:
	lda $3a6
	cmp #$ee
	bne isttx
	lda $3a9
	cmp #$8e
isttx:	rts

;
; is_slotb -- return BEQ if SlotBuster II routines present
;
is_slotb:	lda #$d8
	cmp $3a6
	bne issbx
	cmp $3ac
issbx:	rts

;
; load Textalker from disk
;
no_tt:	rts

load_txttalk:
	lda $bf98
	and #$30
	cmp #$30
	bne no_tt
	lda #$60
	sta ttcheat+2
	jsr is_slotb
	beq no_tt
; if Apple down, force reload PT_OBJ
	bit button0
	bmi loadtt
	jsr is_txtt
	beq no_tt
loadtt:	lda #>tt_name
	ldy #<tt_name
	jsr build_local
	sta tt_open+1
	sty tt_open
	CALLOS mli_open, tt_openp
	CALLOS_BRANCH_NEG no_tt

	lda tt_ref
	sta tt_read+1

	ldx #$3cf-$380
cp3tt:	lda tt3img,x
	sta $380,x
	dex
	bpl cp3tt

readtt:	CALLOS mli_read, tt_read
	CALLOS_BRANCH_POS ttrok
	cmp #err_eof
	beq ttdone
	jmp ProDOS_err
ttrok:	sty $c005	; $C005	W	RAMWRTON	Write enable aux memory from $0200-$BFFF
	ldy #0
ttr2:	lda pagebuff,y
ttcheat: sta $ff00,y
	dey
	bne ttr2
	sty $c004	; $C004	W	RAMWRTOFF	Write enable main memory from $0200-$BFFF
	inc ttcheat+2
	jmp readtt

ttdone:	lda tt_ref
	jsr close

	lda #$ff
	sta $37d
	lda $bf98
	ldy $c01f
	jsr $3a9

	jsr mess
	.byte $85,$80+'C',0	;compressed speech (fast)
	rts

tt3img:
	.byte $e3
	ldx #0
	.byte $8e,$7d,$03,$ae,$7f,$03,$86,$eb
	ldx $380
	stx $ec
	ldx $3cf
	txs
	ldx $3ce
	jmp $c307
	cld
	inc $37d
	cld
	inc $37d
	cld
	inc $37d
	inc $37d
	stx $3ce
	tsx
	stx $3cf
	ldx $eb
	stx $37f
	ldx $ec
	stx $380
	ldx $37d
	stx $eb
	clv
	sec
	ldx #0
	stx $3ed
	ldx #$60
	stx $3ee
	jmp $c314
	.byte $02,$f2

tt_openp:
	.byte 3
tt_open:
	.addr 0
	.addr filebuff
tt_ref:	.byte 0

tt_read:
	.byte 4
	.byte 0
	.addr pagebuff,$100,0

tt_name: pstr "PT.OBJ"

;
; Revised 23-Jan-90 DAL for Davex 1.25
;   for $300 bytes of Aliases space (was $200)
;
;*********************************************************
;
; alias -- routines for 'alias' command and alias
;          expansion
;
;*********************************************************
;
; There are 3 pages reserved for aliases as "Aliases".
;
; The format is simple: an image of a text file, with
; RETURNs between lines, and a $00 at the end.
;
; The file (%aliases) has one alias per line; the first
; word (everything up to the first blank or the end
; of line) is the key, and the rest is the alias (what
; the alias gets "expanded" into).
;
;*********************************************************
;
; init_alias gets called once when Davex is entered.  It
;            loads an image of %aliases to Aliases (or
;            just puts the terminating $00 there if the
;            file can't be read)
;
; exp_alias  gets called whenever a possible alias needs
;            to be expanded; AY = address of string, and
;            there is a length byte just before it.
;
;*********************************************************

;*********************************************************
;
; called once--load %Alias file
;
init_alias:
	lda #0
	tax
InitA1:	sta Aliases,x
	sta Aliases+$100,x
	sta Aliases+$200,x
	dex
	bne InitA1

	lda #>AliasName
	ldy #<AliasName
	jsr build_local
	sta aPath+1
	sty aPath

	CALLOS mli_open, OpenA
	CALLOS_BRANCH_NEG InitA_dun
	lda aRef
	sta aRef2

	CALLOS mli_read, ReadA
	CALLOS_BRANCH_NEG InitA_dun

	ldx #0
Strip7:	lda Aliases,x
	and #%01111111
	sta Aliases,x
	lda Aliases+$100,x
	and #%01111111
	sta Aliases+$100,x
	lda Aliases+$200,x
	and #%01111111
	sta Aliases+$200,x
	dex
	bne Strip7

	lda aRef
	jmp close
InitA_dun:
	rts

AliasName: pstr "aliases"

;*********************************************************
;
; Called for each command on line; pointer to string in
; AY.  The string should be expanded IN PLACE and has a
; maximum length of 250.
;
; The string is zero-terminated AND has a length byte
; just before the address passed in AY.
;
; Return with SEC if no expansion was done, CLC if it was.
;
exp_alias:
	sta p+1
	sty p
	lda #>Aliases
	ldy #<Aliases
	sta p2+1
	sty p2
; a Tilde prevents expansion
	ldy #0
	lda (p),y
	ora #$80
	cmp #$80+'~'
	beq isTilde
ExpA1:	ldy #0
	lda (p2),y
	beq ExpDone
	jsr MaybeExp
	bcc DidExpand
	jsr NextAlias
	jmp ExpA1
ExpDone:
	sec
DidExpand:
	rts

isTilde:
	lda p
	bne :+
	dec p+1
:	dec p
	jsr KillOneChar
	sec
	rts

FetchChar:
	inc p2
	bne :+
	inc p2+1
:	ldy #0
	lda (p2),y
	ora #%10000000
	rts

NextAlias:
	jsr FetchChar
	cmp #$8d
	beq FetchChar
	and #%01111111
	bne NextAlias
	rts

MaybeExp:
	ldy #0
Comp:	lda (p),y
	beq SourceEnd
	jsr downcase
	cmp #$80+';'
	beq SourceEnd
	cmp #$80+' '
	beq SourceEnd
	sta temp
	lda (p2),y
	jsr downcase
	cmp temp
	bne NoMatch
	iny
	bne Comp

NoMatch:
	sec
	rts

;
; Hit end of word in input; if also at end of word in
; the alias, we have a match!
;
SourceEnd:
	lda (p2),y
	jsr downcase
	cmp #$80+' '
	beq YesMatch
	cmp #$8d
	beq YesMatch
	sec
	rts

;
; Remove original text from line & insert alias text one
; character at a time.
;
NullAlias:
	clc
	rts

YesMatch:
	lda p
	bne :+
	dec p+1
:	dec p

	sty temp
KillOld:
	jsr KillOneChar
	dey
	bne KillOld

	ldy temp
	lda (p2),y
	beq NullAlias
	ora #%10000000
	cmp #$8d
	beq NullAlias

	ldy temp
SrchEnd:
	iny
;beq out_room?
	lda (p2),y
	beq InsertExp
	ora #%10000000
	cmp #$8d
	bne SrchEnd

InsertExp:
;inc temp
	dey
Insert1:
	lda (p2),y
	jsr InsertOne
	dey
	cpy temp
	bcs Insert1

KillBlanks:
	ldy #1
	lda (p),y
	ora #$80
	cmp #$a0
	bne :+
	jsr KillOneChar
	jmp KillBlanks
:	clc
	rts


KillOneChar:
	tya
	pha
	ldy #0
	lda (p),y
	sec
	sbc #1
	sta (p),y
:	iny
	iny
	lda (p),y
	dey
	sta (p),y
	cpy #252
	bcc :-
	pla
	tay
	rts

InsertOne:
	sty I1y
	pha
	ldy #0
	lda (p),y
	cmp #250
	bcs @full
	ldy #250
:	lda (p),y
	iny
	sta (p),y
	dey
	dey
	bne :-
; shifted all characters; now inc length
	lda (p),y
	clc
	adc #1
	sta (p),y
; and store the new 1st character
	pla
	ora #$80
	iny
	sta (p),y
	ldy I1y
	rts

@full:	lda #der_outroom
	jmp ProDOS_err

I1y:	.byte 0

;*********************************************************

;*********************************************
;
; Davex help command
;
;*********************************************
bits:	.res 1
ViewName = xczpage
path	= xczpage+2
;
; help command
;
go_help:
	sta p+1
	sty p
	ldy #0
	lda (p),y
	bne help_str

	jsr mess
	.byte cr
	asc "(Use  ? ?  and ?topics for more info.)  Built-in commands:"
	.byte cr,cr,0
	jsr point_cmdtbl
	lda #0
	sta temp
help1:	lda cmd_ptr+1
	ldy cmd_ptr
	jsr print_str
	jsr pr_sp
	inc temp
	lda temp
	clc
	adc #10
	cmp scr_width
	bcc helpl
	jsr crout
	lda #0
	sta temp
helpl:	jsr point_nxtcmd
	bne help1
	jmp crout
;
; help_str -- help cmd has non-null arg
;
help_str:
 .if  0   ;*** expand Help aliases
	lda p+1
	pha
	lda p
	pha
	ldy p
	lda p+1
	iny
	jsr exp_alias
	pla
	sta p
	pla
	sta p+1
 .endif

	ldy #0
	lda (p),y
	tay
	inc p
	lda #0
	sta (p),y
;
; check the help directory for a file with the
; same name
;
	jsr FindHelpDir
; append 0-term str to help dir path (in pagebuff)
	ldy #<-1
helpap:	iny
	lda (p),y
	beq hlpapd
	jsr pmgr
	.byte pm_appch
	.addr pagebuff
	jmp helpap
hlpapd:
;
; if file exists, do a 'pg' on it
;
	lda #>pagebuff
	ldy #<pagebuff
	jsr geti2
	bcs TryIndex

	lda #%11000000
	sta pause_flag	;b7
	sta filter	;b7
	sta case_flags	;b7,6
	lda #>pagebuff
	ldy #<pagebuff
	jmp more2

print_str:
	sta p+1
	sty p
	ldy #0
@loop:	lda (p),y
	beq :+
	ora #%10000000
	jsr cout
	inc temp
	iny
	bne @loop
:	rts

;*********************************************
TryIndex:
	lda #0
	jsr getparm_n
	jmp ViewFile

;*********************************************
;*********************************************
OpenFile:
	sta OpPath+1
	sty OpPath
	CALLOS mli_open, OpParms
	CALLOS_BRANCH_NEG OpFail
ofOK:	clc
	lda OpRef
.if IsDavex3
	clc
	rts
.endif
OpFail:
	cmp #err_filopen
	beq ofOK
.if IsDavex3
	sec
.endif
	rts
;*********************************************
;*********************************************
SeekIndex:
	sta EOFval+2
	stx EOFval+1
	sty EOFval
	CALLOS mli_setmark, EOFparms
	CALLOS_BRANCH_NEG si_fail
	rts

si_fail:
	jmp ProDOS_err

;*********************************************
read4:	CALLOS  mli_read, read4_p
	CALLOS_BRANCH_NEG si_fail
	lda four+2
	ldx four+1
	ldy four
	rts

read4_p:
	.byte 4
r4ref:	.res 1
	.addr four,4,0
four:	.res 4

;*********************************************

ComprTable:
	asc " etoaisrn"
	.byte $0D
	asc "ldhpcf"

byte:	.res 1

;*********************************************
;*********************************************
;
; View a file
;
IndexName:
	pstr "indexed.help"

vf_fail:
	jmp ProDOS_err
ViewFile:
	sta ViewName+1
	sty ViewName

	jsr FindHelpDir
	lda #>IndexName
	ldy #<IndexName
	jsr pmgr
	.byte pm_appay
	.addr pagebuff

	lda #>pagebuff
	ldy #<pagebuff
	jsr OpenFile
	bcs vf_fail
	sta r4ref
	sta EOFref
	lda #0
	tax
	ldy #$C
	jsr SeekIndex
	jsr read4
	jsr SeekIndex
search:	jsr ReadOneName
	bcs missing
	jsr CompareVN
	bne search
	jmp ViewThis

missing:
	jsr mess
	.byte cr
	cstr_cr "*** not found"
	jmp main_err

;*********************************************
ron_err:
	jmp ProDOS_err

ReadOneName:
	lda OpRef
	sta ron_ref1
	sta ron_ref2
	sta unp_ref
	CALLOS mli_read, ron_rd1
	CALLOS_BRANCH_NEG ron_err
	lda pagebuff
	bne ron_cont
	sec
	rts
ron_cont:
	clc
	adc #8
	sta ron_len
	CALLOS mli_read, ron_rd2
	CALLOS_BRANCH_NEG ron_err
	rts

ron_rd1:
	.byte 4
ron_ref1:
	.res 1
	.addr pagebuff,1,0

ron_rd2:
	.byte 4
ron_ref2:
	.res 1
	.addr pagebuff+1
ron_len:
	.addr 0,0

;*********************************************
CompareVN:
	ldy #0
	lda (ViewName),y
	cmp pagebuff
	bne cvn_no
	tay
cvn1:	lda (ViewName),y
	jsr downcase
	and #%01111111
	cmp pagebuff,y
	bne cvn_no
	dey
	bne cvn1
cvn_no:	rts

;*********************************************
vt_fail:
	jmp ProDOS_err

ViewThis:
	ldx pagebuff
	lda pagebuff+1,x
	sta EOFval
	lda pagebuff+2,x
	sta EOFval+1
	lda pagebuff+3,x
	sta EOFval+2
	lda OpRef
	sta EOFref
	CALLOS mli_setmark, EOFparms
	CALLOS_BRANCH_NEG vt_fail

	lda #0
	sta bits
	lda #23
	sta line_count
View1:	jsr UnpackChar
	bcs viewed
	cmp #$8D
	bne not_cw
	jsr check_wait
	jsr NextLine
	beq viewed
	jsr crout
	jmp View1
not_cw:	jsr cout
	jmp View1

viewed:	lda OpRef
	jmp close

;*********************************************
unpack_err:
	jmp ProDOS_err
UnpackChar:
	jsr GetBit
	bcs unp_packed

	lda #0
	ldx #7
unp_u1:	pha
	txa
	pha
	jsr GetBit
	pla
	tax
	pla
	rol a
	dex
	bne unp_u1
	cmp #0
	beq :+
	ora #%10000000
	clc
:	rts

unp_packed:
	lda #0
	ldx #4
unp_p1:	pha
	txa
	pha
	jsr GetBit
	pla
	tax
	pla
	rol a
	dex
	bne unp_p1
	tax
	lda ComprTable,x
	ora #%10000000
	clc
	rts

;*********************************************
GetBit:	ldy bits
	bne have_bit
	CALLOS mli_read, unpack1
	CALLOS_BRANCH_NEG unpack_err
	lda #8
	sta bits
have_bit:
	asl byte
	dec bits
	rts

unpack1:
	.byte 4
unp_ref:
	.res 1
	.addr byte
	.addr 1,0

;*********************************************
FindHelpDir:
	jsr pmgr
	.byte pm_copy
	.addr cfghelp,pagebuff
	lda p+1
	pha
	lda p
	pha
	lda #>pagebuff
	ldy #<pagebuff
	jsr fixup_path_ay
	jsr pmgr
	.byte pm_slashif
	.addr pagebuff
	pla
	sta p
	pla
	sta p+1
	rts

;*********************************************
NextLine:
	dec line_count
	bne no_stop
	lda #23
	sta line_count
	lda #0
	jsr redirect
	asl a
	bcs no_stop
	jsr suspend
	jsr TalkCont
	jsr mess
	.byte cr
	cstr "--- more"
	lda #$80+'y'	;default = Yes
	jsr yesno2
	jmp restore	;(preserves P)

no_stop:
	lda #1
	rts

;---------------------------------------------------------
; dumphex: Dump out successive bytes of a memory range, given an address
; dumphex_ptr: Dump out successive bytes of a memory range, given a pointer to be dereferenced first
; Input - Byte immediately following call is the length
;         Addr immediately following that is the pointer to memory to dump
; Output - text on the screen, processor environment is preserved
;---------------------------------------------------------
dumphex:
	jsr dumphex_stash
	lda #$01
	sta dumphex_mode
	bne dumphex_go	; Always	
dumphex_ptr:
	jsr dumphex_stash
	lda #$00
	sta dumphex_mode
dumphex_go:
	pla		; Return address is on the stack - which we use to find parms
	clc
	adc #$01
	sta dump_ptr
	pla
	adc #$00
	sta dump_ptr+1
	ldy #$00
	lda (dump_ptr),y
	sta num		; First parm - length (byte) number of bytes to process
	iny
	lda (dump_ptr),y
	sta dump_ptr_2	; Second parm - pointer address (2 bytes) of memory to dump
	iny
	lda (dump_ptr),y
	sta dump_ptr_2+1

	clc		; Calculate return address
	lda #$02
	adc dump_ptr
	sta dump_ptr
	lda dump_ptr+1
	adc #$00
	pha		; Push return lsb
	lda dump_ptr
	pha		; Push return msb

	lda dumphex_mode
	bne @skip_deref
	ldy #$00		; Dereference the pointer - caller wants indirect addressing
	lda (dump_ptr_2),y
	sta dump_ptr
	iny
	lda (dump_ptr_2),y
	sta dump_ptr_2+1
	lda dump_ptr
	sta dump_ptr_2	; Put everything back into ptr for printing

@skip_deref:
	lda num
	beq @dump_done
	lda dump_ptr_2+1
	jsr prbyte
	lda dump_ptr_2
	jsr prbyte
	lda #$80+':'
	jsr cout
	lda num
	ldy #$00
:	lda (dump_ptr_2),y
	jsr prbyte
	lda #space
	jsr cout
	iny
	cpy num
	bne :-
	jsr crout
@dump_done:

dumphex_unstash:
	ldx sto_x
	ldy sto_y
	lda sto_p
	pha
	lda sto_a
	plp
	rts

dumphex_stash:
	sta sto_a	; Stash the world away
	sty sto_y
	stx sto_x
	php
	pla
	sta sto_p
	rts

sto_x:	.res 1
sto_y:	.res 1
sto_a:	.res 1
sto_p:	.res 1

dumphex_mode:
	.byte 0		; nonzero = second parm is a memory address (no dereference)
			; $00 = second parm is a pointer to be dereferenced 

;******************************************
;
; Tail of Davex
;
;******************************************
;
; These jumps are copied to high RAM once;
; the space may then be overwritten
;
jumps:	;after code
	jmp getparm_ch
	jmp getparm_n
	jmp mess
	jmp print_ftype
	jmp print_access
	jmp prdec_2
	jmp prdec
	jmp prdec_pad
	jmp print_path
	jmp build_local
	jmp print_sd
	jmp print_drvr
	jmp redirect
	jmp percent
	jmp yesno
	jmp mygetln
	jmp bell
	jmp downcase
	jmp plural
	jmp check_wait
	jmp pr_date_ay
	jmp pr_time_ay
	jmp ProDOS_err
	jmp ProDOS_er
	jmp main_err
	jmp prdec_pady
	jmp dir_setup
	jmp dir_finish
	jmp read1dir
	jmp pmgr
	jmp mmgr
	jmp poll_io
	jmp print_ver
	jmp push_level
	jmp fman_open
	jmp fman_read
	jmp rdchar	;v1.1
	jmp makedirt	;v1.1
	jmp getnump	;v1.1
	jmp yesno2	;v1.2
	jmp dir_setup2	;v1.23
	jmp shell_info	;v1.25