;Program: TRIM
;Version: 1.0
;Author: Bruce Morgen
;Date: June 25, 1988

;Purpose: To truncate COM files at a requested address, used to
;	  delete unneeded DSEG from the output of linkers like
;	  DRI's LINK, L80, ZLINK, etc.  Replaces the following
;	  ZEX script, adding DU:/DIR: response and much speed:
;
;		^$ ? ?
;		a0:ddtz $1.com
;		k100 $2
;		y
;		g0

;NOTE:	Should be linked to a high address (8000h or so).  TRIM
;	is totally useless at a standard-TPA tool (although it
;	could readily be re-written as one)!  ZCPR 3.3 or later
;	(or BGii 1.13 or later) is therefore required.

CR	EQU	13		; ASCII
LF	EQU	10		;   "
BEL	EQU	7		;   "
BDOSE	EQU	0005H		; DOS entry vector
PRNSTR	EQU	9		; Print string function #
CLOSEF	EQU	16		; Close file      "     "
TPA	EQU	100H		; Normal Transient Program Area
FCB1	EQU	05CH		; Default FCB #1
FCB2	EQU	06CH		;    "     "  "2
Z3ENV	EQU	00		; Dummy value for Z3 environment

	PUBLIC	COUT		; Make SYSLIB use ours

	EXTRN	Z3LOG,EPRINT,EPSTR,BOUT
	EXTRN	PFN2,EVAL16,PUTUD,GETUD
	EXTRN	F$OPEN,F$READ,F$DELETE
	EXTRN	F$MOPEN,F$WRITE,SETDMA
	EXTRN	FILLBC,INITFCB

; TYPE 3 HEADER

; Code modified as suggested by Charles Irvine to function correctly with
; interrupts enabled.  Program will abort with an error message when not
; loaded to the correct address (attempt to run it under CP/M or Z30).

ENTRY:
	JR	START0		; Must use relative jump
	NOP			; Filler
	DB	'Z3ENV',3	; Type-3 environment
Z3EADR:
	DW	Z3ENV		; Filled in by Z33
	DW	ENTRY		; Intended load address

START0:
	LD	HL,0		; Point to warmboot entry
	LD	A,(HL)		; Save the byte there
	DI			; Protect against interrupts
	LD	(HL),0C9H	; Replace warmboot with a return opcode
	RST	0		; Call address 0, pushing RETADDR
				; Onto stack
RETADDR:
	LD	(HL),A		; Restore byte at 0
	DEC	SP		; Get stack pointer to point
	DEC	SP		; To the value of RETADDR
	POP	HL		; Get it into HL and restore stack
	EI			; We can allow interrupts again
	LD	DE,RETADDR	; This is where we should be
	XOR	A		; Clear carry flag
	PUSH	HL		; Save address again
	SBC	HL,DE		; Subtract -- we should have 0 now
	POP	HL		; Restore value of RETADDR
	JR	Z,START		; If addresses matched, begin real code

	LD	DE,NOTZ33MSG-RETADDR ; Offset to message
	ADD	HL,DE
	EX	DE,HL		; Switch pointer to message into DE
HLPEXT:	LD	C,PRNSTR
	JP	BDOSE		; Return via BDOS print string function
NOTZ33MSG:
	DB	'Not Z33+$'	; Abort message if not Z33-compatible

START:	LD	A,(FCB1+1)	; Point to first token
	CP	'/'		; Help query?
	JR	Z,HELP		; Then honor it
	CP	' '		; Blank?
	JR	NZ,NOHELP	; No?  Proceed...
HELP:	LD	DE,HLP		; Otherwise point to help screen
	JR	HLPEXT		; BDOS-print and go home...
; CPR stack more than suffices, we need only 14 or so levels...
NOHELP:	CALL	PUTUD		; Save entry drive & user
	LD	HL,FCB2+1	; Point to second token
	CALL	EVAL16		; Compute to binary in DE, A = E
	OR	D		; Test for a zero result
	JP	Z,NOZERO	; Call that an error
	LD	(HL),0		; Null-terminate for printing
	LD	HL,ENTRY	; Get our origin
	SBC	HL,DE		; Subtract requested address
	JP	C,TOOBIG	; Request can't be past ENTRY
	JP	Z,TOOBIG	; Or right at it
	LD	(SIZE),DE	; Otherwise save it away
	LD	HL,FCB1+9	; Point to filename extension
	LD	A,(HL)		; Check for a blank one
	CP	' '
	JR	NZ,GOTTYP	; Assume "COM" if it's blank
	LD	(HL),'C'
	INC	HL
	LD	(HL),'O'
	INC	HL
	LD	(HL),'M'
GOTTYP:	CALL	EPRINT		; Announce our function
	DB	'Trimming ',0
	LD	DE,FCB1+1	; Point at and print filename
	CALL	PFN2
	CALL	EPRINT		; Preface end address
	DB	' to 0',0
	LD	HL,FCB2		; Find first non-'0' digit
FINDA0:	INC	HL
	LD	A,(HL)
	CP	'0'+1
	JR	C,FINDA0
	CALL	EPSTR		; Print end address
	LD	A,'h'		; Say it's a hex number
	CALL	BOUT
	DEC	DE		; Point to FCB
	CALL	Z3LOG		; Log in as per Z3 parse
	CALL	INITFCB		; Initialize for BDOS
	CALL	F$OPEN		; Open 'er up
	JP	NZ,OPNERR	; A = 0 and Z if no BDOS error
	LD	HL,TPA		; Point to TPA
	LD	BC,ENTRY-TPA
	CALL	FILLBC		; Zero-fill BC bytes, saving HL
	CALL	EPRINT		; Announce next process, "   "
	DB	CR,LF,'Reading ',0
	JR	RDSTRT		; Jump into read loop
RDLOOP:	PUSH	HL		; Save new DMA pointer
	LD	BC,(SIZE)	; Get end address
	XOR	A		; Clears carry flag
	SBC	HL,BC		; Subtract
	POP	HL		; Get back new DMA pointer
	JR	NC,DODEL	; Read done if bigger than end
RDSTRT:	CALL	SETDMA		; Set DMA address
	CALL	DOT		; Print a dot
	LD	BC,128		; Offset to next DMA address
	ADD	HL,BC		; Add it in for next loop around
	CALL	F$READ		; Read a record, saving regs.
	OR	A		; Zero means good read
	JR	Z,RDLOOP
	DEC	A		; One means done reading file
	JR	NZ,READERR	; Anything else is a DOS snafu
	CALL	DOT		; Last dot...
DODEL:	CALL	F$DELETE	; Kill old file
	CALL	INITFCB		; Re-init FCB
	CALL	F$MOPEN		; Make new file and open it
	JR	NZ,OPNERR	; Branch on fatal error
	CALL	EPRINT		; Announce next process
	DB	CR,LF,'Writing ',0
	LD	HL,TPA		; Start DMA at the bottom
WRTLOOP:
	CALL	SETDMA		; Set DMA
	CALL	DOT		; DOT's right...
	CALL	F$WRITE		; Write a record
	OR	A		; Need a zero here
	JR	NZ,WRITERR	; or it's a DOS failure
	LD	BC,128		; Offset to next DMA pointer
	ADD	HL,BC		; Add it in for loop
	PUSH	HL		; Test it against end address
	LD	BC,(SIZE)
	XOR	A
	SBC	HL,BC
	POP	HL
	JR	C,WRTLOOP	; Loop if it's smaller
DONE:	LD	C,CLOSEF	; BDOS function #16
	CALL	BDOSE		; Call BDOS Bros.
	INC	A		; Test for FFh
	JR	Z,CLSERR	; That's an error
	CALL	EPRINT		; Announce success
	DB	BEL,CR,LF,'Done!',0
EXIT:	JP	GETUD		; Reassert home drive & user,
				; exeunt all...

DOT:	LD	A,'.'		; Get a dot
COUT:	JP	BOUT		; Print via BDOS

; ERROR EXIT ROUTINE
;
NOZERO:	LD	HL,NZSTRG
	JR	ERROR
;
TOOBIG:	LD	HL,TBSTRG
	JR	ERROR
;
OPNERR:	LD	HL,OPNSTR
	JR	ERROR
;
READERR:LD	HL,READSTRG
	JR	ERROR
;
WRITERR:LD	HL,WRTSTRG
	JR	ERROR
;
CLSERR:	LD	HL,CLSSTR
;
ERROR:	CALL	EPRINT		; Say it's an error
	DB	BEL,CR,LF,'Fatal error: ',0
	CALL	EPSTR		; Specify
	JR	EXIT		; Go home
;
NZSTRG:	DB	'Zero-length requested, use SAVE',0
;
TBSTRG:	DB	'Can''t create a file that large',0
;
OPNSTR:	DB	'DOS failed to open file',0
;
READSTRG:
	DB	'DOS attempted to read unwritten data',0
;
WRTSTRG:DB	'DOS failed to write',0
;
CLSSTR:	DB	'DOS can''t close file',0

; HELP SCREEN
HLP:	DB	'TRIM, Version 1.0',CR,LF
	DB	'Syntax:',CR,LF
	DB	' TRIM FILENAME HEXADDR',CR,LF
	DB	'Saves a copy of "FILENAME" with',CR,LF
	DB	'a highest address of "HEXADDR"',CR,LF,'$'

; DATA AREA
	DSEG			; I know, why bother...
SIZE:	DS	2		; Requested end address

	END