; DATSTP.MAC
;
Vers	equ	13		; version number
SubVers	equ	' '		; modification level
;
; Displays or sets file date stamps under DateStamper or ZSDOS.
; Displays date stamps under Z3PLUS.
;
; USAGE:
;
;	DATSTP {dir:}fn.ft {{date} {time} {{/}options}}
;
; If no DU or DIR is given, current drive and user is assumed.  If no
; date or time is given, current date stamps will be displayed.  If date
; and/or time are given, file's create date stamp will be updated as the
; default.
;
; [ Date stamps cannot be changed under CP/M Plus (Z3PLUS). ]
;
; OPTIONS:
;
;	M	Update modify date stamp.
;
;	B	Update both create and modify date stamps.
;
;	Q	Toggle current setting of quiet mode.
;
; Version 1.3 -- October 8, 1990 -- Gene Pizzetta
;	Incorporated Howard Goldstein's excellent optimizations that
;	cut the code size considerably.  Added equates to create a
;	universal version using DSLIB date stamp routines for operation
;	under non-ZSDOS DateStamper, and under Z3PLUS (display only).
;	ZSDOS version is considerably smaller, however.  Corrected
;	lingering bug in the PARSDS module that gave an error when a
;	colon was given that was not followed by a minute specification
;	BUT WAS followed by another command line token.
;
; Version 1.2A -- September 12, 1990 -- Howard Goldstein
;	Optimized code.  No functional changes (I hope).
;
; Version 1.2 -- September 8, 1990 -- Gene Pizzetta
;	Corrected failure to initialize option B flag.
;
; Version 1.1 -- September 7, 1990 -- Gene Pizzetta
;	Improved display, especially for reverse video highlighting.
;	Also corrected small bug in usage message, and made a few other
;	minor code changes.
;
; Version 1.0 -- September 3, 1990 -- Gene Pizzetta
;	Initial release.
;
;	Gene Pizzetta
;	481 Revere Street
;	Revere, MA 02151
;
;	Newton Centre Z-Node:  (617) 965-7259
;	GEnie:  E.PIZZETTA
;	Voice:  (617) 284-0891
;
; Developed with SLRMAC and SLRNK+:
;	slrmac parsds/m
;	slrmac datstp/m
;	slrnkp datstp/n,/v,/a:100,/j,datstp,parsds,zslib/s,dslib/s,vlib/s,
;		z3lib/s,syslib/s,/e
; or, for type 3:
;	slrnkp datstp/n,/v,/a:8000,/j,datstp,parsds,zslib/s,dslib/s,vlib/s,
;		z3lib/s,syslib/s,/e
;
False	equ	0
True	equ	Not False
;
; DOS selection -- Setting equate below to TRUE creates a version that
; works only under ZSDOS and ZDDOS, using date stamp routines from ZSLIB.
; Setting the equate to FALSE creates a universal version that also works
; with DateStamper under ZRDOS, and with Z3PLUS (display only), using
; date stamp routines from DSLIB.  The universal version is 6 records
; larger, which puts it over 4K, but I think it's a little faster.
;  
ZSDOS	equ	True		; False for universal DSLIB version
;
  IF ZSDOS
TypVers	equ	'Z'		; ZSDOS version
  ELSE
TypVers equ	'U'		; universal version
  ENDIF	; ZSDOS
;
; System addresses . . .
;
Bdos	equ	05h
CpmFcb	equ	5Ch
CpmDma	equ	80h
;
; ASCII characters . . .
;
HiOn	equ	1		; standout mode on for vpstr
HiOff	equ	2		; standout mode off for vpstr
TAB	equ	09h		; tab
LF	equ	0Ah		; linefeed
CR	equ	0Dh		; carriage return
;
	MACLIB	Z80
;
; Following routines are from ZSLIB,VLIB, Z3LIB, and SYSLIB
;
	ext	f$exist,retud,vpstr,pfn3,cout
	ext	pafdc,phl4hc,crlf
	ext	z3vinit,stndout,stndend,getquiet,gzmtop
	ext	prtname,puter2,inverror,zsyschk,z3log
  IF ZSDOS
	ext	dostyp,getstp,setstp
  ELSE
	ext	timini,gstamp,pstamp
  ENDIF	; ZSDOS
	ext	prdat1,prdat2,ptimc2,ptimm2
	
	ext	parsds		; special version, not ZSLIB
;
	public	pstr,eurdat
;
; TYP3HDR.MAC, Version 1.1  --  Extended Intel Mnemonics
; This code has been modified as suggested by Charles Irvine so that
; it will function correctly with interrupts enabled.
; Extended Intel mnemonics by Gene Pizzetta, April 30, 1989.
;
Entry:	jr	Start0		; must use relative jump
	db	0		; filler
	db	'Z3ENV',3	; type-3 environment
Z3EAdr:	dw	0FE00h		; filled in by Z33
	dw	Entry		; intended load address
;
; Configuration area . . .
;
	db	'DATSTP'	; filename for ZCNFG CFG file
	db	Vers/10+'0',Vers mod 10+'0'
QtFlag:	db	0		; non-zero defaults to quiet mode
TimMod:	db	0		; non-zero uses military time
EurDat:	db	0		; non-zero uses dd/mm/yy; zero uses mm/dd/yy
;
Start0:	lxi	h,0		; point to warmboot entry
	mov	a,m		; save the byte there
	di			; protect against interrupts
	mvi	m,0C9h		; replace warmboot with a return opcode
	rst	0		; call address 0, pushing RetAddr onto stack
RetAddr:
	mov	m,a		; restore byte at 0
	dcx	sp		; get stack pointer to point
	dcx	sp		; ..to the value of RetAddr
	pop	h		; get it into HL and restore stack
	ei			; we can allow interrupts again
	lxi	d,RetAddr	; this is where we should be
	xra	a		; clear carry flag
	push	h		; save address again
	dsbc	de		; subtract -- we should have 0 now
	pop	h		; restore value of RetAddr
	jz	Start		; if addresses matched, begin real code
;
	lxi	d,NotZ33Msg-RetAddr ; offset to message
	dad	d
	xchg			; switch pointer to message into DE
	mvi	c,9
	jmp	0005h		; return via BDOS print string function
;
NotZ33Msg:
	db	'Not Z33+$'	; abort message if not Z33-compatible
;
; Messages . . .
;
MsgUse:	db	'DATSTP    Version ',TypVers,'-'
	db	Vers/10+'0','.',Vers mod 10+'0',SubVers
	db	'  (loaded at ',0
MsgUs1:	db	'h)',CR,LF
	db	'Sets and displays file date stamps'
  IF ZSDOS
	db	' under ZSDOS.',CR,LF
  ELSE
	db	'.',CR,LF
  ENDIF	; ZSDOS
	db	'Usage:',CR,LF,'   ',0
MsgUs2:	db	' {dir:}fn.ft {{date} {time} {{/}options}}',CR,LF
	db	'A filename is required.  Date and time, if given,',CR,LF
	db	'are written to create stamp by default.',CR,LF
	db	'Date/Time Format:',CR,LF,0
MsgAmr:	db	'   {mm{/dd{/yy{ hh{:mm}}}}}  clock time',CR,LF
	db	'   {mm{/dd{/yy{ +nnnn}}}}    relative time',CR,LF,0
MsgEur:	db	'   {dd{.mm{.yy{ hh{:mm}}}}}  clock time',CR,LF
	db	'   {dd{.mm{.yy{ +nnnn}}}}    relative time',CR,LF,0
MsgUs3:	db	'Either periods or slashes may be used as date delimiters.',CR,LF
	db	'Options:',CR,LF
	db	'   M   write to modify stamp',CR,LF
	db	'   B   write to both create and modify stamps',CR,LF
	db	'   Q   toggle quiet mode ',0
MsgUon:	db	'on',0
MsgUof:	db	'off',0
MsgCre:	db	HiOn,'  Created:  ',HiOff,' ',0
MsgAcc:	db	HiOn,'                   Accessed: ',HiOff,' ',0
MsgMod:	db	HiOn,'                   Modified: ',HiOff,' ',0
MsgNon:	db	'None',0
MsgFNF:	db	'  File not found.',0
MsgREr:	db	'  Date stamp read error.',0
MsgWEr:	db	'  Date stamp write error.',0
MsgAmb:	db	' No ambiguous filenames.',0
MsgDir:	db	' Invalid directory.',0
MsgBdO:	db	' Invalid option.',0
MsgBdD:	db	'  Invalid date/time.',0
  IF ZSDOS
MsgDos:	db	' Requires ZSDOS or ZDDOS.',0
  ELSE
MsgDos:	db	' Incompatible date stamping.',0
  ENDIF	; ZSDOS
;
Start:	lhld	Z3EAdr		; set up environment
	call	zsyschk		; is this a Z-system?
	rnz			; (nope)
	call	z3vinit
	sspd	OldStk		; save old stack pointer
	call	gzmtop		; get top of memory
	sphl			; ..and set up new stack
;
  IF ZSDOS
	call	dostyp		; compatible DOS?
	cpi	'S'		; ZSDOS?
	jrz	Start1		; (yes)
	cpi	'D'		; ZDDOS?
	jnz	BadDos		; (no)
  ELSE
	call	timini		; compatible DOS?
	jz	BadDos		; (no)
  ENDIF	; ZSDOS
Start1:	call	getquiet	; is ZCPR quiet flag set?
	jrnz	SetZQt		; (yes)
	lda	QtFlag		; no, get quiet config byte
SetZQt:	sta	OpQFlg		; ..and store in Q option flag
	lxi	d,CLBuf		; move command line out of way
	lxi	h,CpmDma
	lxi	b,128
	ldir
	lda	CpmFcb+1	; see if there's a tail
	cpi	' '
	jz	Usage		; (no)
	cpi	'/'
	jz	Usage
;
GtTail:	call	GetOpt		; get options
	lxi	h,CpmFcb+1	; check for ambiguous filename
	lxi	b,11
	mvi	a,'?'
	ccir
	jrnz	GtTl1		; (still okay)
	mvi	a,8		; set error code
	lxi	h,MsgAmb	; it's ambiguous
	jr	ErExit
;
GtTl1:	lda	CpmFcb+15	; check for valid directory
	ora	a
	jrnz	InvDir		; (nope)
	lxi	d,CpmFcb
	call	z3log		; log into correct directory
	lda	OpQFlg		; check quiet flag
	lhld	DatPtr		; ..and whether a date spec was given
	ana	m
	cz	PrtFn		; print filename unless quiet and date given
	call	f$exist		; does file exist?
	jrnz	GtTl2		; (yes)
	mvi	a,10		; set error code
	lxi	h,MsgFNF	; file not found
	jr	ErExit
;
; here we get the current file date stamp and store it
GtTl2:	call	GetDS		; get current date stamp
	lhld	DatPtr		; get pointer to command line date token
	mov	a,m		; was date given?
	ora	a
	jrz	NoDat		; (no)
	lxi	d,CpmDma	; assume create date
	lda	OpMFlg		; check for M option
	ora	a
	jrz	PrsDat		; (our assumption was right)
	lxi	d,CpmDma+10	; no, we're doing modify date
PrsDat:	call	parsds		; parse CL date string
	ora	a
	jrz	GotDat		; (okay, so far)
	mvi	a,9		; set error flag
	lxi	h,MsgBdD	; bad date
	jr	ErExit
;
GotDat:	lda	OpBFlg		; both date stamps?
	ora	a
	jrz	GotDt2		; (yes)
	xchg			; point to source field in hl
	lxi	d,CpmDma+10	; assume copying create date
	lda	OpMFlg		; check option M flag
	ora	a
	jrz	GotDt1		; (assumption correct)
	lxi	d,CpmDma	; nope, doing modify
GotDt1:	lxi	b,5
	ldir
;
GotDt2:
;	call	ShwDS		; /for debugging parser
;	jr	Finish		; /no disk output
;
	call	WrtDS		; write date stamp to disk
	lda	OpQFlg		; quiet mode?
	ora	a
;
NoDat:	cz	ShwDS
	jr	Finish
;
; Various errors bring us here . . .
;
BadDos:	mvi	a,4		; set error code
	lxi	h,MsgDos	; incompatible DOS
	jr	ErExit
;
InvDir:	mvi	a,2		; invalid directory
	lxi	h,MsgDir
	jr	ErExit
;
Finish:	xra	a		; reset error code
ErExit:	ora	a
	cnz	vpstr
	call	puter2		; set error code
	mov	b,a		; put error code in B
	cnz	inverror	; (yes, call error handler)
	lspd	OldStk		; restore old stack pointer
	ret			; ..and return to CCP
;
; Subroutines . . .
;
; ShwDS -- print all three date stamps
;
ShwDS:	lxi	h,MsgCre	; print create date
	call	vpstr
	lxi	h,CpmDma+1	; is there one?
	mov	a,m
	ora	a
	cz	PrtNon		; (no)
	jrz	ShwDS1
	dcx	h		; output date
	call	PrtDS
ShwDS1:	call	crlf
	lxi	h,MsgMod	; print modify date
	call	vpstr
	lxi	h,CpmDma+11
	mov	a,m
	ora	a
	cz	PrtNon
	jrz	ShwDS2
	dcx	h
	call	PrtDS
ShwDS2:	call	crlf
	lxi	h,MsgAcc	; print access date
	call	vpstr
	lxi	h,CpmDma+6
	mov	a,m
	ora	a
	jrz	PrtNon
	dcx	h
	jr	PrtDS
;
; PrtNon -- prints "None"
;
PrtNon:	lxi	h,MsgNon
pstr:	jmp	vpstr
;
; PrtDS -- prints a single date stamp.  Address in HL.
;	
PrtDS:	lda	TimMod		; military or civilian time?
	ora	a
	cz	ptimc2		; civilian
	cnz	ptimm2		; military
	mvi	a,' '
	call	cout
	call	cout
	lda	EurDat		; date American or European?
	ora	a
	jz	prdat1
	jmp	prdat2
;
; PrtFn -- Prints drive/user and filename on console
;
PrtFn:	call	stndout
	mvi	a,' '
	call	cout
	call	retud
	mov	a,b		; get drive
	adi	'A'		; make it printable
	call	cout		; ..and print it
	mov	a,c		; get user
	call	pafdc		; ..and print it
	mvi	a,':'
	call	cout
	push	d
	lxi	d,CpmFcb+1
	call	pfn3		; print filename
	pop	d
	mov	a,c		; check user number size
	cpi	10		; is it two digits?
	mvi	a,' '
	cc	cout		; (no, print space)
	jmp	stndend
;
; GetOpt -- checks command tail for user supplied options and sets
; appropriate option flags.
;
GetOpt:	xra	a
	sta	OpMFlg		; initialize option M flag
	sta	OpBFlg		; initialize option B flag
	lxi	h,CLBuf+1		; point to command tail
	call	EatSpc
	call	FnLp		; move past filename and spaces
;
	shld	DatPtr		; save pointer to possible date token
	ora	a
	rz			; (end of tail)
	call	FnLp		; get past date string
;
	ora	a
	rz			; (end of tail)
	cpi	'/'		; a slash?
	jrz	IsSlsh		; (we've got options)
	call	FnLp		; get past time string
	ora	a
	rz
	cpi	'/'		; a slash?
	jrnz	GotOpt		; (no, get options)
IsSlsh:	inx	h		; move past slash
GotOpt:	call	EatSpc		; get option
	inx	h
	ora	a
	rz			; (end of tail)
	cpi	'/'		; usage request?
	jrz	Usage		; (yes)
	lxi	d,GotOpt
	push	d		; get return address on stack
	cpi	'Q'		; quiet flag?
	jrz	OptQ		; (yes)
	cpi	'M'		; modify date?
	jrz	OptM		; (yes)
	cpi	'B'		; modify and create dates?
	jrz	OptB		; (yes)
	mvi	a,19		; set error code
	lxi	h,MsgBdO	; invalid option
	pop	d
	jmp	ErExit
;
; FnLp -- loop past token
;
FnLp:	inx	h		; move past date string
	mov	a,m
	ora	a
	rz			; (end of tail)
	cpi	' '
	jrz	EatSpc
	cpi	TAB
	jrnz	FnLp
; ... Fall through
;
; EatSpc -- gobbles up spaces and tabs
;
EatSpc:	mov	a,m
	ora	a
	rz
	inx	h
	cpi	' '		; is it a space?
	jrz	EatSpc		; (yes)
	cpi	TAB		; is it a tab?
	jrz	EatSpc		; (yes)
	dcx	h
	ret
;
; Option setting routines
;
Usage:	lxi	h,MsgUse
	call	vpstr
	lxi	h,Entry
	call	phl4hc
	lxi	h,MsgUs1
	call	vpstr
	call	prtname
	lxi	h,MsgUs2
	call	vpstr
	lxi	h,MsgAmr	; assume American time
	lda	EurDat		; check European flag
	ora	a
	jrz	Usage1		; (it's American)
	lxi	h,MsgEur	; it's European
Usage1:	call	vpstr
	lxi	h,MsgUs3
	call	vpstr
	lda	OpQFlg		; check quiet mode
	ora	a
	lxi	h,MsgUon
	jrz	Usage2
	lxi	h,MsgUof
;
Usage2:	call	vpstr
	jmp	Finish
;
OptQ:	lda	OpQFlg		; get Q flag
	rar		; get low bit into carry
	sbb	a		; set all 8 bits of accum according to carry
	cma	; flip
	sta	OpQFlg		; set it
	ret
;
OptM:	sta	OpMFlg		; ..and store it
	ret
;
OptB:	sta	OpBFlg		; store flag
	ret
;
; GetDS -- Get date stamp from file
;
GetDS:	lxi	d,CpmFcb
	lxi	h,CpmDma	; point to DMA buffer
  IF ZSDOS
	call	getstp		; get ZSDOS file stamp
	rz			; (okay)
  ELSE
	call	gstamp		; get file stamp
	rnz			; (okay)
  ENDIF	; ZSDOS
	mvi	a,4		; set error code
	lxi	h,MsgREr	; date stamp read error
	jmp	ErExit
;
; WrtDS -- writes date stamp to file
;
WrtDS:	lxi	d,CpmFcb	; setup for file stamping
	lxi	h,CpmDma
  IF ZSDOS
	call	setstp		; set ZSDOS file stamp
	rz			; (okay)
  ELSE
	call	pstamp		; set file stamp
	rnz			; (okay)
  ENDIF	; ZSDOS
	mvi	a,4		; set error code
	lxi	h,MsgWEr
	jmp	ErExit
;
	DSEG
;
; Uninitialized storage . . .
;
DatPtr:	ds	2		; pointer to date token in cmd line
OpQFlg:	ds	1		; current quiet mode flag
OpBFlg:	ds	1		; option B flag
OpMFlg:	ds	1		; option M flag
OldStk:	ds	2		; old stack pointer
CLBuf:	ds	128		; command line storage
;
	end