title	'FDATE list file dates'
;
ver	equ	10
cr	equ	0dh
lf	equ	0ah
tab	equ	09h
;
; CPM/DOS+ syscall values
@cin	equ	1
@cout	equ	2
@csta	equ	11
@seldk	equ	14
@srch1	equ	17
@srchn	equ	18
@curdk	equ	25
@stdma	equ	26
@usrcd	equ	32
;
; CPM/DOS+ definitions
reboot	equ	0
sysfnc	equ	reboot+5;	connector to BDOS system
defdma	equ	reboot+080h
;
; UPPER case in following line for M80. SLRMAC does not need the file.
INCLUDE	Z80.LIB
;
;	--------- Start	----------
;
	jmp	begin
;
maxusr:	db	31
;
; Upshift (a) if lower case alpha.
; a,f
upshft:	cpi	'a'
	rc
	cpi	'z'+1
	rnc
	ani	05fh
	ret
;
; Check (a) valid digit, carry if not
; f
qnum:	cpi	'0'
	rc
	cpi	'9'+1
	cmc
	ret
;
; crlf to console
; a,f
crlf:	mvi	a,cr
	call	couta
	mvi	a,lf
;	"	"
; console output from (a)
; a,f
couta:	push	d
	mov	e,a
	mvi	a,@cout
	call	bdos
	pop	d
	ret
;
; Numeric 1..99 to console.  Convert to Ascii, no zero suppress
; a,f
putnum:	push	b
	mvi	c,'0'-1
pn1:	inr	c
	adi	-10
	jrc	pn1
	adi	10
	push	psw
	mov	a,c
	call	couta
	pop	psw
	pop	b
	adi	'0'
	jr	couta
;
; Test for any console character ready. If so purge it and
; return nz flag.  Else return z flag.  Nulls absorbed
; a,f
qbreak:	mvi	a,@csta
	call	bdos
	rz
	mvi	a,@cin
	jr	bdos
;
; search next on (de)^. Z flag for failure, exit (a) incremented
; a,f
srchn:	mvi	a,@srchn
;	"	"
; execute functions, Z flag for 0ffh, increment return value
; a,f
sfncr:	call	bdos
	inr	a
	ret
;
; search for file fcbdrv. Z flag for failure, exit (a) incremented.
; a,f,d,e
ffind:	lxi	d,fcbdrv
	mvi	a,@srch1
	jr	sfncr
;
; Find current logged disk
qdisk:	mvi	a,@curdk
	jr	bdos
;
; Set user to absolute value in fcbusr and select on BDOS.
; Do not modify or select drive. Leave drv/usr in bc
; Update fcbusr to absolute value
; a,f,b,c,e
setusr:	lbcd	fcbusr;		c := user, b := drive
	mov	a,c
	ora	a
	cm	quser;		default, get current user
	mov	c,a;		now an absolute value
	sbcd	fcbusr
;	"	"
; set user to a
; a,f,e
susera:	mov	e,a
	jr	suser
;
; find current user code
; a,f,e
quser:	mvi	e,0ffh
;	"	"
; set user (e)
; a,f
suser:	mvi	a,@usrcd
;	"	"
; execute bdos call, return (a), set flags. Preserve other registers
; This is the sole connection to the outside world.
; a,f
bdos:	push	h
	push	d
	push	b
	pushix
	mov	c,a
	call	sysfnc
	ora	a;		set flags on return value
	popix
	pop	b
	pop	d
	pop	h
	ret
;
; set drive/user from fcbusr/fcbdrv
setdu:	call	setusr;		and b := drv, c := usr
	mov	a,b
	dcr	a
	cm	qdisk;		get default disk
	mov	b,a
	inr	b
	sbcd	fcbusr;		jam id
;	"	"
; select drive (a). DOS handles redundancies.
; a,f,e
seldka:	ani	0fh
	mov	e,a
	mvi	a,@seldk
	jr	bdos
;
; Parse the next field from the command line (IX^) into fcbdrv. Any
; drive/user specifications are recorded in fcbdrv and fcbusr
; (which default to 0 and -1 respectively).  name and type are parsed
; into fname and ftype, blank padded, with any '*'s expanded into
; '?'s, and the fields are blank padded.  At exit IX points to the
; field terminating delimiter char and lastwd points to the 1st char.
; a contains a count of '?' characters in fname & ftype fields, with
; flags set on it.  Illegal chars. cause abort.
; a,f,b,c,d,e,h,l,ix
parse:	xra	a
;	"	"
; Entry to parse 2nd drive spec. for xcom, when a = 010h
parsef:	lxi	h,fcbusr
	call	index;		select fcb or alternate fcb
	call	skipbk;		skip any leading blanks
	sixd	lastwd;		save marker for errors
	call	getdu;		c := user, b := drv
	mov	m,c;		set fcbusr
	inx	h
	mov	m,b;		set fcbdrv, set up for ldfld
	call	lastch
	cpi	':'
	cz	nextch;		Absorb any du terminating ':'
	mvi	b,8
	push	h
	call	ldfld;		fill the name field
	call	lastch
	cpi	'.'
	cz	nextch;		Absorb any name terminating '.'
	mvi	b,3;		 (else terminator blank fills)
	call	ldfld;		fill the type field
	mvi	b,3
parse1:	inx	h
	mvi	m,0
	djnz	parse1;		zero ex, s2, s1 fields
	lxi	b,11 shl 8;	b := 11, c := 0
	pop	h
	mvi	a,'?'
parse2:	inx	h
	cmp	m
	jrnz	parse3
	inr	c
parse3:	djnz	parse2;		count the '?'s in fname/ftype
	mov	a,c
	ora	a;		z flag for no wild cards
	ret
;
; load up to (b) chars from (ix)^ up to (hl)^ up.
; skip to delimiter.  Implement any wild cards on "*"
; blank fill if less than (b) chars available.
; Upshift any lower case characters.
; a,f,b,h,l,ix
ldfld:	call	lastch;		on (ix)^ and load it
	jrz	ldfld4;		delimiter
	inx	h
	cpi	'*'
	jrnz	ldfld1
	mvi	m,'?';		expand '*'
	jr	ldfld2;		dont skip past it
ldfld1:	call	upshft;		upshift any lower case
	mov	m,a
	call	nextch
ldfld2:	djnz	ldfld
	call	lastch;		on (de)^ and load it
	rz;			a delimiter
ldfld3:	call	nextch;		else skip to a delimiter
	rz
	jr	ldfld3
ldfld4:	inx	h
	mvi	m,' ';		blank fill
	djnz	ldfld4
	ret
;
; getdu returns any "du" spec. in b and c, with c = user, b = drv
; The default user is signified by a -1 value, default drive by 0
; At entry, IX points to the start of the field to be parsed. At
; exit, either IX is unchanged (no du found), or points to ':'
; a,f,b,c,d,e,ix
getdu:	lxi	b,0ffh;		set defaults
	pushix
	pop	d;		pre-scan for valid du field
	ldax	d
	call	upshft;		2.1 - No ':' abort here
	call	qnum
	jrnc	getdu1;		1st char digit, no d
	cpi	'@'
	rc;			< '@', no du spec
	cpi	'P'+1
	rnc;			> P, no du spec
	inx	d
	ldax	d
	cpi	':'
	jrz	getdu2;		d spec only
	call	qnum
	rc;			no 'du' spec
getdu1:	inx	d
	ldax	d
	cpi	':'
	jrz	getdu2;		du spec found
	call	qnum
	rc;			no du spec
	inx	d
	ldax	d
	cpi	':'
	rnz;			not terminal ':', no du spec
;	"	"
; prescan found a valid du format, now load it
getdu2:	call	lastch
	call	qnum
	jrnc	getdu3;		digit, no d portion
	call	upshft
	sui	'@'
	mov	b,a;		save d portion
	call	nextch
getdu3:	cpi	':'
	rz;			no 'u' portion
	ani	0fh
	mov	c,a
	call	nextch
	rz;			':', 1 digit only
	call	dstep;		incorporate
	call	nextch;		and advance to the (known) ':'
	lda	maxusr
	cmp	c
	jrc	help;		User # too large
	ret
;
; Decimal input step. Carry for overflow. c is accumulator, a digit
; a,f,c,d
dstep:	ani	0fh
	mov	d,a
	mov	a,c
	cpi	26
	cmc
	rc;			overflow
	add	a
	add	a
	add	c;		5*
	add	a;		10*
	add	d
	mov	c,a;		result
	ret;			cy for overflow
;
; Get next character from line.  Z flag for a delimiter,
; and abort if the character is illegal. Do not advance past eoln.
; Return char in a and leave IX pointing to it. cy for eoln
; a,f,ix
nextch:	ldx	a,+0
	ora	a
	jrz	lastch;		don't advance past eol
	inxix
;	"	"
; Return last character, as above.  Abort if invalid, cy for eoln
; a,f
lastch:	ldx	a,+0
	ora	a
	stc
	rz;			null is a delimiter
	cpi	'=';		and all these
	rz
	cpi	'_'
	rz
	cpi	'.'
	rz
	cpi	':'
	rz
	cpi	';'
	rz
	cpi	'<'
	rz
	cpi	'>';		Redirection chars
	rz
	cpi	',';		Operand separator
	rz
	cpi	'|';		Piping  separator
	rz;
;	"	"
; Check white space, abort on illegal chars. z flag for white
qwhite:	cpi	tab
	rz;			white space is a delimiter
	cpi	' '
	jrc	help;		abort on illegals
	ret
;
; skip blanks and tabs in input line.  Abort on illegal chars.
; return the 1st non-blank char. found.
; a,f,ix
skipbk:	call	lastch
	rc;			eoln
skip1:	call	qwhite
	rnz;			not white space
;	"	"
; Effectively "call nextch ! call skipbk"
next:	call	nextch
	jrnc	skip1
	ret;			eoln
;
; hl := hl + a
; a,f,h,l
index:	add	l
	mov	l,a
	rnc
	inr	h
	ret
;
; load (a+c)th char from defdma array
; a,f,h,l
idxac:	lxi	h,defdma
	add	c
	call	index
	mov	a,m
	ret
;
; crlf, then tstr
; a,f,h,l
tstrc:	call	crlf
;	"	"
; string (hl) to console until 0 byte
; a,f,h,l
tstr:	mov	a,m
	ora	a
	rz
	inx	h
	call	couta
	jr	tstr
;
help:	lxi	h,hlpmsg
;	"	"
; exit with message
msgxit:	call	tstrc
	jr	done
;
; no time stamp message & exit
notime:	lxi	h,notimemsg
	jr	msgxit
;
; jam fcb to all wild cards
mkwild:	lxi	h,fname
	mvi	b,11
mkwld1:	mvi	m,'?'
	inx	h
	djnz	mkwld1
	ret
;
; one blank to console
blk:	mvi	b,1
;	"	"
; blank to console
blks:	mvi	a,' '
	call	couta
	djnz	blks
	ret
;
; Main program operation
begin:	lxi	h,0
	dad	sp
	shld	stksav
	lxi	sp,stksav
	lxi	h,defdma
	mov	a,m
	ora	a
	inx	h
	push	h
	popix;			init input scanner
	jz	help;		empty input line
	call	skipbk
	jc	help;		or only blanks
	call	parse
	lda	fname
	cpi	' '
	cz	mkwild;		must be a du spec
	call	setdu
	call	ffind;		sets de := ^fcbdrv
	cnz	flist;		If any found, list them
done:	lhld	stksav
	sphl
	ret
;
; List files found
flist:	push	psw
	lda	defdma + 060h
	cpi	021h
	jrnz	notime;		and abort
	lxi	h,head
	call	tstrc
	pop	psw
flist1:	dcr	a;		compensate for file-find inr
	push	psw
	mvi	c,060h
	add	a;		2*
	mov	b,a
	add	a;		4*
	add	a;		8*
	add	b;		10*
	adi	2;		displacement of 1st stamp
	call	idxac;		point to time stamp
	lxi	d,fcreat
	lxi	b,10
	ldir;			move into fcb on 1st
; really want min of all create, max of modify/access for file
	pop	psw
	rrc
	rrc
	rrc
	ani	060h
	mvi	c,1
	call	idxac;		point to DIR entry
	call	crlf
	lda	fcbdrv
	adi	'@'
	call	couta
	lda	fcbusr
	call	putnum
	mvi	a,':'
	call	couta
	mvi	b,8
	call	tname
	mvi	a,'.'
	call	couta
	mvi	b,3
	call	tname
	mvi	b,2
	call	blks
	call	dates
	call	qbreak
	rnz
	call	srchn
	jnz	flist1
	ret
;
dates:	lhld	fcreat
	call	date
	mvi	b,2
	call	blks
	lhld	fmodif
	call	date
	call	blk
	lhld	fmodif+2
	call	time
	mvi	b,2
	call	blks
	lhld	facces
	call	date
	call	blk
	lhld	facces+2
	call	time
	ret
;
date:	mvi	b,8
	mov	a,h
	ora	l
	jz	blks
	call	drtodate
	mov	a,c;		year
	call	t2hx
	mvi	a,'/'
	call	couta
	mov	a,d
	call	t2hx
	mvi	a,'/'
	call	couta
	mov	a,e
	jmp	t2hx
;
time:	mvi	b,5
	mov	a,h
	ora	l
	jz	blks
	mov	a,l
	call	t2hx
	mvi	a,':'
	call	couta
	mov	a,h
;	"	"
t2hx:	push	psw
	rlc
	rlc
	rlc
	rlc
	call	t1hx
	pop	psw
;	"	"
t1hx:	ani	0fh
	adi	090h
	daa
	aci	040h
	daa
	jmp	couta
;
; type b chars from hl^
tname:	mov	a,m
	ani	07fh
	call	couta
	inx	h
	djnz	tname
	ret
;
; days per month, except leap year. Leading dummy 0 for month 0
mtbl:	db	0,31,28,31,30,31,30,31,31,30,31,30,31
;
; Convert (a) in binary to BCD. No overflow check. Return z flag.
; a,f
binbcd:	push	b
	lxi	b,0affh;		b := 10, c := -1
bbcd1:	inr c !	sub b !jrnc bbcd1;	divide by 10
	add	b;			correct remainder
	mov	b,a
	mov	a,c;			quotient
	add a !	add a !	add a !	add a;	* 16. Cy for o'flow
	add	b;			+ remainder. clears cy
	pop	b
	ret
;
; PROCEDURE drtodate(thedate : integer; VAR yr, mo, day : integer);
; (* 1 Jan 1978 corresponds to Digital Research date = 1  *)
; (* BUG - cannot handle negative values for dates > 2067 *)
;
;   VAR
;     i, y1        : integer;
;     dayspermonth : ARRAY[1..12] OF 1..31;
;
;   BEGIN (* drtodate *)
;   FOR i := 1 TO 12 DO dayspermonth[i] := 31;
;   dayspermonth[4] := 30; dayspermonth[6] := 30;
;   dayspermonth[9] := 30; dayspermonth[11] := 30;
;   IF thedate > 731 THEN BEGIN (* avoid overflows *)
;     yr := 1980; thedate := thedate - 731; END
;   ELSE BEGIN
;     thedate := thedate + 730; yr := 1976; END;
;   (* 0..365=y0; 366..730=y1; 731..1095=y2; 1096..1460=y3 *)
;   i := thedate DIV 1461; thedate := thedate MOD 1461;
;   y1 := (thedate-1) DIV 365; yr := yr + y1 + 4*i;
;   IF y1 = 0 THEN (* leap year *) dayspermonth[2] := 29
;   ELSE BEGIN
;     thedate := thedate - 1; (* 366 -> 365 -> 1 Jan *)
;     dayspermonth[2] := 28; END;
;   day := thedate - 365*y1 + 1; mo := 1;
;   WHILE day > dayspermonth[mo] DO BEGIN
;     day := day - dayspermonth[mo];
;     mo := succ(mo); END;
;   END; (* drtodate *)
;
; Incorporate (a) in year (c), overflows to century (b)
addyr:	add	c
	jnc	addyr1;		<256
	sui	100;		256..276
	jmp	addyr2
addyr1:	dcr	b
addyr2:	inr	b
	sui	100
	jnc	addyr2
	adi	100;		b = century, c = year MOD 100
	mov	c,a
	ret
;
; divide hl by -de, rdr to hl, quotient to a
divd:	mvi	a,-1
divd1:	inr	a
	dad	d
	jc	divd1
	push	psw
	mov	a,l
	sub	e
	mov	l,a
	mov	a,h
	sbb	d
	mov	h,a
	pop	psw
	ret
;
; Input  : hl = drdate (days since 78/1/1, 1 = 78/1/1)
; Output : b, c, d, e = cent, year, month, day (binary)
; a,f,b,c,d,e,h,l
drtodate:
	lxi	b,256*19 + 76;	731 represents 80/1/1
	push	h
	lxi	d,-731
	dad	d
	pop	h
	jnc	drd1;		before 80/1/1
	dad	d;		on or after 80/1/1
	mvi	c,80;		now 0 represents 80/1/1
	jmp	drd2
drd1:	lxi	d,730
	dad	d;		now 731 represents 78/1/1
drd2:	lxi	d,-1461
	call	divd;		get quad years since base (in c)
	add	a
	add	a;		4 * i.  180 max
	call	addyr;		yr := yr + 4 * i
	mov	a,h
	ora	l
	jz	drd3;		At Jan 1, leap year
	dcx	h;		thedate := thedate - 1
	lxi	d,-365;		so year thresholds come out right
	call	divd;		thedate := thedate MOD 365
	push	psw;		y1 := a := thedate DIV 365
	call	addyr;		yr := yr+y1
	pop	psw;		0 for leapyear
	jnz	drd5;		not a leap year
	inx	h;		thedate := thedate+1 (1..365)
drd3:	mvi	a,29
	sta	mtbl+2
drd5:	xchg
	lxi	h,mtbl
	push	b
	mvi	b,0;		mo := 0
drd6:	inx	h;		WHILE
	inr	b;		 day := day-dayspermo[mo := mo+1] >= 0
	mov	a,e;			DO (* again *)
	sub	m
	mov	e,a
	mov	a,d
	sbi	0
	mov	d,a
	jnc	drd6
	mov	a,e;		day := day+dayspermo[mo]
	add	m
	mov	e,a;		range 0..pred(dayspermo[mo])
	adc	d
	sub	e
	mov	d,a
	xchg
	mov	d,b
	pop	b
	mov	e,l
	inr	e;		make result 1 based
	mvi	a,28
	sta	mtbl+2;		restore month table
	mov	a,b
	call	binbcd
	mov	b,a
	mov	a,c
	call	binbcd
	mov	c,a
	mov	a,d
	call	binbcd
	mov	d,a
	mov	a,e
	call	binbcd
	mov	e,a	
	ret
;
hlpmsg:		db	'FDATE ver. '
		db	ver / 10 + '0', '.', ver mod 10 + '0'
		db	'by C.B. Falconer',cr,lf,lf
		db	'Usage: FDATE [d[u]:][afn.aft]',cr,lf
		db	'shows timestamps for DOS+ directories',0
notimemsg:	db	'No time stamps on this volume',0
head:		db	'd/u:Filename.Typ  Created   '
		db	'---Modified---  ---Accessed---',cr,lf
		db	'--- -------- ---  --------  '
		db	'--------------  --------------',0
;
; NOTE: the ",0" in ds statements ensures the areas are 0 filled
;
; File control block and receiver of parse fields (34 bytes)
fcbusr:	ds	1
fcbdrv:	ds	1
fname:	ds	8
ftype:	ds	3
	ds	3
	ds	1
fcreat:	ds	2;		date created or disk map
fmodif:	ds	4;		date/time modified
facces:	ds	4;		date/time accessed
;
; Parsing
lastwd:	ds	2;		start of current word in iobuff
;
	ds	64;		stack space
stksav:	ds	2;		save entry stack
;
	end