; Program:	SNAP
; Version:	1.2
; Description:	Save an image of the Z-system packages in a reloadable file.
; Author:	Rob Friefeld
; Date: 	26 Mar 1990
; Derivation:	LAP by Bob Andersson (the idea, not the code)
; Assembly:	SLR assembler

; Syntax:	SNAP file[.typ] /oo..

; SNAP captures an image of the ENV,TCAP,IOP,RCP,FCP,NDR, and PATH 
; then writes the image, with a loader, to the file specified on the command
; line.  When the output file is run, it puts the images back where they came
; from, then calls the IOP initialization if one is present.  The overhead for
; the loader is less than 2 records.

; Version 1.2 -
; Program has its own stack (fixed crash with Kaypro Turbo ROM)
; Configure which segments to save - by default and/or on command line.
; SNAPRCP is obsolete.  Very handy for quick loading NDR segments.


; PROGRAM DEFINITIONS

majver	equ	'1'
minver	equ	'2'

yes	equ	-1
no	equ	0
y	equ	yes
n	equ	no

	.accept	'Type 3 program to load at 8000h? (Y/N) ',hiload

	 if	hiload
entry	equ	8000h
	 else
entry	equ	100h
	 endif

; SYSTEM DEFINITIONS

bdos		equ	05h
fcb1		equ	5ch
tbuf		equ	80h
rdconf		equ	1
wrconf		equ	2
prbuff		equ	9
openf		equ	15
closef		equ	16
srchff		equ	17
erasef		equ	19
writef		equ	21
makef		equ	22
setdmaf		equ	26
sguserf		equ	32

lf	equ	0ah
cr	equ	0dh

; PACKAGE DATA OFFSETS IN ENV
; These are from the beginning of the ENV, not the 'Z3ENV' ID string

rcp_off	equ	0ch	;RCP
iop_off	equ	0fh	;IOP
fcp_off	equ	12h	;FCP
env_off	equ	1bh	;ENV
pth_off	equ	09h	;PATH
ndr_off	equ	15h	;NDR

ty4_off	equ	8	;EXTENDED ENV BYTE (80H)
ccp_off	equ	3fh	;CCP

;====================================================================
;
;			S N A P    C O D E
;
;====================================================================

	org	entry

	jp	start
env_str:
	db	'Z3ENV'
	db	3
z3eadr:	dw	0
	dw	entry

; -----------------
; CONFIGURATION

opt_flag:
	db	yes	; Ask to erase existing file?

; Configurable list of segments to save.  Can use this to make only 1 or 2
; segments into self installing units.  The ENV is always loaded.

prefs	equ	$

tcap_pref:	db	yes
rcp_pref:	db	yes
fcp_pref:	db	yes
iop_pref:	db	yes
ndr_pref:	db	yes
path_pref:	db	yes

prefsz	equ	$ - prefs

; -----------------
; MAIN PROGRAM

start:
	ld	(stack),sp
	ld	sp,stack

	ld	a,(fcb1+1)	; Was output file specified?
	cp	' '
	jp	z,help		; No
	cp	'/'
	jp	z,help

; Parse command line preferences

	ld	hl,tbuf+2	; Look at command tail
	call	skspc		; Past object
	ld	a,(hl)		; Option char?
	cp	'/'
	call	z,parse		; Yes

; Test segment loading preference list to see if any are to be skipped.
; If so, signal loader to insist ENV segment of current system is same
; as ENV saved with image.  (The loader could be made a lot smarter,
; especially for non-code segments NDR or TCAP.)

	ld	hl,prefs	; Preference table
	ld	b,prefsz	; ...and its size
pref_loop:
	ld	a,(hl)
	inc	hl
	or	a
	jr	nz,pref_loop1	; NO is NZ
	dec	a
	ld	(l$flag),a	; Signal loader to check ENV carefully
pref_loop1:
	djnz	pref_loop	

	call	findenv		; Verify ENV location
	jp	nz,no_env	; ENV not found

	ld	hl,(z3eadr)	; Install loader for ZCPR 3.0
	ld	(lenv$adr),hl	; ...to word inside loader image

; -----------------
; NOW GET A SNAP
;
snap:
	ld	de,cim$		; Buffer for core image at end of loader
	ld	iy,ltable$adr	; Segment location table in loader

	xor	a		; Signal GETSEG this is a mandatory load
	dec	a
	ld	bc,env_off	; ENV always loaded first
	call	getseg		; Move segment into loader image
	ld	a,(tcap_pref)	; TCAP is defined as part of ENV package
	or	a
	jr	nz,snap1	; ...and we wanted it
	ld	hl,-80h		; Else, back up over TCAP
	add	hl,de
	ex	de,hl
	ld	hl,80h
	ld	(ltable$adr+2),hl	; Adjust size of ENV load
snap1:
	ld	a,(rcp_pref)	; GETSEG tests the user's preference
	ld	bc,rcp_off	; RCP
	call	getseg
	ld	a,(iop_pref)
	ld	bc,iop_off	; IOP
	call	getseg
	ld	a,(fcp_pref)
	ld	bc,fcp_off	; FCP
	call	getseg
	ld	a,(ndr_pref)
	ld	bc,ndr_off	; NDR
	or	a
	call	nz,findseg	; Can't use GETSEG because ...
	ld	bc,18		; NDR size = (Z3NDIRS*18)+1
	call	getseg1
	ld	a,(path_pref)
	ld	bc,pth_off	; PATH
	or	a
	call	nz,findseg
	ld	bc,2		; Path size = (EXPATHS*2)+1
	call	getseg1

	ld	(imagetop),de	; Save top of buffer pointer

	ld	b,128		; 0 Fill any remainder of last record
	xor	a
	ld	(de),a
	inc	de
	djnz	$-2
	ld	(l$stack),de	; Save this as loader stack location

; -----------------
; SET UP THE OUTPUT FILE


	ld	hl,fcb1+9	; Check .TYP
	ld	a,(hl)
	cp	' '
	jr	nz,find_file	; Specified
	ld	(hl),'C'	; Make default .COM type
	inc	hl
	ld	(hl),'O'
	inc	hl
	ld	(hl),'M'	

find_file:
	ld	a,(fcb1+13)	; Log in output file user #
	ld	e,a
	ld	c,sguserf
	call	bdos

	ld	c,srchff	; Look for file
	call	bdosfcb
	inc	a
	jr	z,make_file	; Not there


; File exists
;   Check whether or not to ask user what to do
;   If no query, erase without warning

	ld	a,(opt_flag)	; Get the default option
	or	a
	jr	z,era_file	; Z = skip query

	call	print
	dc	'File Exists.  Replace? (Y/n) '
	ld	c,rdconf
	call	bdos
	and	5fh
	cp	'N'
	jp	z,exit		; Cancel

era_file:
	ld	c,erasef
	call	bdosfcb

make_file:
	ld	c,makef		; Make the file
	call	bdosfcb

; -----------------
; WRITE THE OUTPUT FILE


	ld	de,image	; Start of saved image (loader code)
wrtloop:
	push	de		; DMA address
	ld	c,setdmaf
	call	bdos
	ld	c,writef	; Write a record
	call	bdosfcb
	pop	de		; Inc DMA to next
	ld	hl,128
	add	hl,de
	ex	de,hl
	ld	hl,(imagetop)	; Stored end of image
	xor	a
	sbc	hl,de
	jr	nc,wrtloop	; Not past end yet

	ld	c,closef
	call	bdosfcb
	jp	done


; -----------------
; SUBROUTINES


bdosfcb:
	ld	de,fcb1
	jp	bdos


; Look for ENV at address in Z3EADR
; Return Z if OK

findenv:
	ld	hl,(z3eadr)	; ENV pointer
	ld	de,env_str	; ENV ID string
	inc	hl		; Leading JP
	inc	hl
	inc	hl

; Match 5 bytes @ HL, DE.  Return Z = matched
	ld	b,5
match:
	ld	a,(de)
	cp	(hl)
	ret	nz
	inc	hl
	inc	de
	djnz	match
	ret


; Fetch a package segment from memory
; Enter A = 0 to skip this segment
; Load LOAD_TABLE with segment RAM address and size
; Move it to -> DE
; (This entry for 128 byte block segments)

getseg:
	or	a		; Will we do this one?
	jr	z,getseg0	; Skip it
	call	findseg		; Return HL -> segment, A = size
	ld	bc,128		; Block size
	call	calcseg		; BC = blocks * block size
getseg0:
	call	nz,getseg01
	ld	bc,4		; Bump the table pointer
	add	iy,bc
	ret
getseg01:			; Load the table with segment data
	ld	(iy),l		; HL = source address
	ld	(iy+1),h
	ld	(iy+2),c	; BC = segment size
	ld	(iy+3),b
	ldir
	ret

; Fetch segment, block size in BC
; Add 1 to segment size if it exists
; (For NDR and PATH)

getseg1:
	or	a		; Check preference
	jr	z,getseg0	; Sip
	call	calcseg		; Block size * blocks
	jr	z,getseg0	; 0 blocks
	inc	bc
	jr	getseg0

; Return pointer to segment address in HL, # blocks in A, Z if no blocks
; Enter with package info offset in BC

findseg:
	ld	ix,(z3eadr)	; ENV address
	add	ix,bc		; Package info offset
	ld	l,(ix)		; Package address to HL
	ld	h,(ix+1)
	ld	a,(ix+2)	; Package size to A
	or	a
	ret

; Compute package size in bytes
; Enter with # package blocks in A, BC = blocksize
; Return BC = bytes, Z if size = 0

calcseg:
	push	hl
	ld	hl,0		; Accumulate count in HL
	or	a
	jr	z,calcx		; No blocks
calc1:	add	hl,bc
	dec	a
	jr	nz,calc1	
	inc	a		; Ret NZ
calcx:
	push	hl
	pop	bc
	pop	hl
	ret


; Parse command tail
; '/' char has been found.  Now compare tail with option list until null.
; Only those segments requested will be loaded.

parse:
	ld	de,prefs	; Zero out default preference list
	ld	b,prefsz
	xor	a
	ld	(de),a
	inc	de
	djnz	$-2

	ld	de,parse1	; Address pushed for loop return
parse1:
	inc	hl		; Step through command line
	ld	a,(hl)
	or	a
	ret	z
	push	de		; Set up parse1 return point
	cp	'T'
	jr	z,setT
	cp	'R'
	jr	z,setR
	cp	'F'
	jr	z,setF
	cp	'I'
	jr	z,setI
	cp	'N'
	jr	z,setN
	cp	'P'
	ret	nz

setP:	ld	(path_pref),a
	ret
setN:	ld	(ndr_pref),a
	ret
setI:	ld	(iop_pref),a
	ret
setF:	ld	(fcp_pref),a
	ret
setR:	ld	(rcp_pref),a
	ret
setT:	ld	(tcap_pref),a
	ret

; Skip over next space, quit on null

skspc:	ld	a,(hl)
	or	a
	ret	z
	inc	hl
	cp	' '
	jr	nz,skspc
	ret


; -----------------
; CONSOLE OUTPUT

conout:
	push	hl
	push	de
	push	bc
	push	af		; Save AF, too
	and	7fh		; Mask out MSB
	ld	e,a		; Transfer character to E
	ld	c,2		; BDOS conout function number
	call	5
	pop	af
	pop	bc
	pop	de
	pop	hl
	ret

; In-line print (string terminated with null or character with the 
; high bit set)

print:
	ex	(sp),hl
	call	printhl
	ex	(sp),hl
	ret
printhl:
	ld	a,(hl)
	inc	hl
	or	a
	ret	z
	call	conout
	ret	m
	jr	printhl


; -----------------
; MESSAGES

help:
	call	print
 db	cr,lf
 db	'SNAP, Version ',majver,'.',minver,cr,lf
 db	'  Syntax: SNAP file[.typ] /oo...',cr,lf
 db	'Options --',cr,lf
 db	'  (R)cp, (F)cp, (N)dr, (T)cap, (I)op, (P)ath'
 dc	cr,lf
	jr	exit

no_env:
	call	print
	dc	'ENV Not Found'
	jr	exit

done:
	call	print
	dc	cr,lf,'Done'
exit:
	ld	sp,(stack)
	ret


; Data

	ds	46	; Internal stack.  This should make ANYONE happy.
stack:	ds	2

imagetop:
	ds	2	; Pointer to end of image file

image	equ	$	; Start of image file

;====================================================================
;
; 		O U T P U T    F I L E    C O D E
;
;====================================================================

; This is the loader written to disk with the package segments.
; It runs at the same address as SNAP did -- 100H or 8000H
; (Items inserted by SNAP are referenced to the IMAGE base)
; Fancy equates create absolute locations for SNAP to poke in some data.

; # bytes of ENV to check for compatibility (up to QUIET flag)
env_bytes	equ	28h

	.phase	entry
load:
	jp	load_start
	db	'Z3ENV'
	db	3
lenv$adr	equ	image + ($-load)	; External reference
lenvadr:
	dw	0
	dw	entry

; Loading is controlled by this table, which is made at capture time.
; Each 4 byte record contains the segment target address and its size
; Elements initialized to 0

ltable$adr	equ	image + ($ - load)
load_table:
	ds	4,0		; ENV & TCAP
	ds	4,0		; RCP
	ds	4,0		; IOP
	ds	4,0		; FCP
	ds	4,0		; NDR
	ds	4,0		; PATH

load_start:
	ld	(lstksav),sp	; Save SP

l$stack	equ	image + ($-load) +1
	ld	sp,0		; Start loader stack

; Load error check
;   - Are image ENV and memory ENV at the same address?
;   - Are CCP, DOS, BIOS addresses the same? (Requires extended ENV)

	ld	bc,env_off	; Make sure ENV is where image expects it
	call	pointseg	; DE = ENV address in image
	ex	de,hl
	ld	de,(lenvadr)	; HL = current ENV address
	xor	a
	sbc	hl,de
	jr	nz,loaderr	; They differ

	ld	hl,ty4_off	; Check for extended ENV
	add	hl,de
	bit	7,(hl)		; Byte >= 80h if so
	jr	z,putpkg
	ld	hl,cim+ty4_off
	bit	7,(hl)
	jr	z,putpkg	; Not Type 4, skip test
	ld	hl,ccp_off	; OK, compare CCP,CCPS,DOS,DOSS,BIOS
	add	hl,de
	ld	de,cim+ccp_off
	ld	b,8
	call	compare		; Compare exits on mismatch

; If only selected segments have been saved, insist that the current ENV
; be identical to the saved ENV.  If all segments have been saved, permit
; user to risk loading a configuration with a different segment apportionment.

l$flag	equ	image + ($-load) +1	; Flag set if command line option used
	ld	a,0
	or	a
	jr	z,putpkg
	ld	b,env_bytes	; Check system addresses, skip SHVAR &tc.
	ld	hl,cim
	ld	de,(lenvadr)
	call	compare

; Load the packages into memory

putpkg:
	di
	ld	iy,load_table	; Pointer to addresses and sizes
	ld	hl,cim		; Start of saved images
	ld	b,6		; Items to load
putpkg1:
	push	bc
	call	putseg		; Move an item
	ld	bc,4		; Table entry size
	add	iy,bc		; Advance table pointer
	pop	bc
	djnz	putpkg1

	call	iopinit		; Init the IOP, if any
	ei

	ld	de,loadmsg	; Tell user we are done
ldprt:	ld	c,prbuff	; Exit with message
	call	bdos
;	rst	0		; Warm boot
	ld	sp,(lstksav)
	ret

; Subroutines
;

loaderr:
	ld	de,lderrmsg
	jr	ldprt

; Compare @HL to @DE for B bytes
; Exit if mismatch

compare:
	ld	a,(de)
	cp	(hl)
	jr	nz,loaderr
	inc	hl
	inc	de
	djnz	compare
	ret


; Move a segment from image to RAM
; Enter HL @ image location.  Get destination from LOAD_TABLE pointer

putseg:
	ld	e,(iy)		; Target addr to DE
	ld	d,(iy+1)
	ld	c,(iy+2)	; Size to BC
	ld	b,(iy+3)

	ld	a,c
	or	b
	ret	z		; Zero size segment
	ld	a,d
	or	e
	ret	z		; ...or no seg address
	ldir
	ret


; Initialize IOP

iopinit:
	ld	bc,iop_off
	call	pointseg	; Get segment address in DE
	ret	z		; NO IOP
	ld	hl,9		; Offset to INIT vector
	add	hl,de
	jp	(hl)		; Run the routine


; Enter  BC = offset to segment address in image ENV
; Return DE = address, Z if no address

pointseg:
	ld	hl,cim
	add	hl,bc
	ld	e,(hl)
	inc	hl
	ld	d,(hl)
	ld	a,d
	or	e
	ret

; Messages
;
loadmsg:
	db	'System Loaded$'
lderrmsg:
	db	'System Mismatch$'	

; Incoming SP
;
lstksav:	ds	2

;
; CORE IMAGE SAVED BY SNAP
;

cim$	equ	image + ($-load)
cim	equ	$
	.dephase

	END	START