* SAFRAM6.ASM			Creates Safe RAM partition below CCP.
* Roy Lipscomb			For CP/M 2.2 and clones (except CP/M+).
* 2/22/88
*
*	     (C) Copyright 1988, Logic Associates, Chicago
*	Permission is hereby granted for non-commercial copying of
*	this program, provided the copyright notice remains intact.
*
vers	equ	60 ;version 6.0
*
*-----------------------------------------------------------------------------
* FUNCTIONS:
*
*	[]  Acts as a buffer between TSRs (Terminate and Stay Resident
*	    utilities) that normally do not tolerate each other.
*
*	[]  Makes warmboots noticeably faster:
*
*		[]  BYPASSES THE RELOADING OF THE BDOS AND CCP.  These
*		    are also shielded by SAFRAM5 against being overwritten.
*
*		[]  LOGS IN ONLY THE CURRENT DRIVE.  (This feature operates
*		    operates only with CP/M 2.2.)  A normal warmboot always
*		    logs in drive A, even when not needed.
*
*	[]  Creates a "safe" (protected) partition below CCP.  Modules or data
*	    residing in the partition are safe from destruction until the
*	    the next system reset.  (User can specify partition's start addr.)
*
*	[]  Assembles with LASM.COM, or (with a little tweaking) with ASM.COM.
*	    For assembly instructions, see SAFRAM6.DOC.
*
*
*****************************************************************************
*
*	Version 6.0 (1/20/88)
*
*		[]  Resumes compatibility with SUBMIT.COM.  (Vers. 5
*		    inadvertently disabled this compatibility.)
*
*		[]  Allows de-installing SAFRAM, by typing "SAFRAM OFF".
*
*		[]  Marks as "v.6" the lines or routines altered from vers. 5.
*
*		[]  Changed loadpoint-option from "on page boundary" to "on
*		    page boundary + 6."
*
*		[]  Includes a revised and expanded SAFRAM6.DOC.
*
*
*	Version 5.0 (6/24/87)
*
*		[]  No longer needs customization for the quick-warmboot
*		    feature.  This feature is now standard.
*
*		[]  Compatible with ECHO3, another "publike-domain" program
*		    from Logic Associates.
*
*		[]  Cleaned up cosmetic problem of the CCP's occasionally
*		    attempting to execute parts of the old command line
*		    after warmboot.
*
*
*	Version 4.0 (4/5/86)
*
*		    (No record of modifications.)
*
*
*	Version 3.0 (4/4/86)
*
*		[]  Reworked BIOS, BDOS, and CCP locators to be more
*		    compatible with ZCPR and Apple CP/M.
*
*		[]  Made the reprotection trap faster acting, harder to
*		    elude.
*
*		
*	Version 2.0 (3/25/85):
*
*		[]  Does not change address in location 6-7 if address is
*		    already lower than start of SAFRAM module.
*
*		[]  "Safram at" message displayed on extreme screen right,
*		    by backing up past left margin.  (Can be changed in
*		    systems were this might be a problem.)
*
*
*	Version 2.0 (3/25/83):
*
*		[]  SAFRAM will now execute properly under DDT.
*
*		[]  The CCP will no longer sporadically think it
*		    has something in its buffer when warm booting.
*


*********************************************************
*		service/loader routines			*
*********************************************************

	if	copy1		;service routines
	org 	100h
	jmp	begin


no	equ	0
yes	equ	1

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		customizing variables			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

boot	equ	0		;lowest address within CP/M

notify	equ	yes		;at each warmboot, notify of tpa-top addr?

pagebnd	equ	no		;force SAFRAM6 to install at page boundary + 6?
				;					v.6

ofsetcd equ	342h		;offset to current-drive storage byte within
				;  bdos.  (Offset computed from bdos page, not
				;  from bdos page+6.  Eg, from D400, not D406.)
				;For CP/M 2.2, this value is 342h.  If using
				;  a CP/M clone, customize or leave as is.
				;  (If value is incorrect, drive A will always
				;  be selected at warmboot.  There should be
				;  no other side effect.)

;==>> nothing below this point needs to be customized.<<==;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

wboff	equ	3		;warmboot vector			v.6
coutoff	equ	12		;conout vector				v.6

getcon	equ	6
pstr	equ	9
sysrst	equ	13		;system reset (substitute for warm boot).
fopen	equ	15		;open file				v.6
fclos	equ	16		;close file				v.6
fsrch1	equ	17		;search first file			v.6
feras	equ	19		;erase file				v.6
frenam	equ	23		;rename	file				v.6
flogv	equ	24		;get login vector			v.6
setdma	equ	26
drvrst	equ	37

drvusr	equ	boot+4
bdos	equ	boot+5
deffcb	equ	boot+5ch
tbuff	equ	boot+80h

bell	equ	7
bs	equ	8
tab	equ	9
cr	equ	13
lf	equ	10
blank	equ	' '

tstname: db	'$$$     SUB'	;					v.6

offcmd:	db	'OFF '
offlen	equ	$-offcmd

progcode equ	'S'	;code used to detect "SAFRAM" presence.

sfcboff	equ	07ach	;offset to "$$$.SUB" fcb within CCP.	v.6

secaddr	dw	0	;address of first byte of area to be protected.
bypass	dw	0	;addr at which bypass jump is to be installed.
modbase	dw	0	;starting point of resident SAFRAM module.

;values used in setting traps
biosdsp	dw	0
biosav	dw	0
trapent	dw	0

coutdsp	equ	0ch-3		;displacement of charout from boot.

;values used in locating the ccp.
biosent	dw	0
bdosent	dw	0
ccpent	dw	0

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;messages

eom	equ	'$'

helpmes	db	cr,lf
	db	' DDDDDD  DDDD   DDDDD DDDDD    DDDD   DD    DD',cr,lf
	db	'DDD     DD  DD  DD    DD  DD  DD  DD  DDD  DDD',cr,lf
	db	' DDDDD  DD  DD  DDDD  DDDDD   DD  DD  DDDDDDDD',cr,lf
	db	'   DDDD DDDDDD  DD    DD DD   DDDDDD  DD DD DD',cr,lf
	db	'DDDDDD  DD  DD  DD    DD  DD  DD  DD  DD    DD',cr,lf
	db	cr,lf
	db	'SAFRAM 6.0	                       2/25/88',cr,lf
	db	'(C) Copyright 1988, Logic Associates, Chicago ',cr,lf
	db	cr,lf
	db	'   * Acts as buffer between ill-behaved TSRs. ',cr,lf
	db	'   * Speeds up warmboot and "reset all disks".',cr,lf
	db	'   * Creates safe RAM partition below the CCP.',cr,lf
	db	cr,lf
	db	'[] "SAFRAM xxxx" --protects hex address xxxx. ',cr,lf
	db	cr,lf
	db	'[] "SAFRAM"      --protects CCP and all TSRs. ',cr,lf
	db	cr,lf
	db	'[] "SAFRAM OFF"  --removes SAFRAM.            ',cr,lf
	db	cr,lf
	db	'[]  Multiple re-executions are permitted.     ',cr,lf
	db	'----------------------------------------------',cr,lf
	db	eom

baddr:
	db	bell
	db	'*** Abort:  Valid range is '
badad1	db				   '....H to '
badad2	db					    '....H. ***'
	db	eom

crlf	db	cr,lf
	db	eom

mok:
	db	'***               Installed.               ***'
	db	eom

mreassgn:
	db	'***              Reassigned.               ***'
	db	eom

moff:
	db	'***             De-installed.              ***'
	db	eom

ccpmess:
	db	'***      Abort:  Unable to locate CCP.     ***'
	db	bell,eom

mnosafr:
	db	'***       Abort:  SAFRAM not present.      ***'
	db	bell,eom

mnounp:
	db	'***  Abort:  Cannot de-install at present. ***'
	db	bell,eom

mdifver:
	db	'*** Abort:  Conflicting versions of SAFRAM.***'
	db	bell,eom


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		mainline				;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

begin:
	lxi	h,0
	dad	sp

	lxi	sp,lstack
	push	h

	call	signon		;print signon message

	call	isitoff		;request for removal of SAFRAM?		v.6
	jz	exit		; yes, now processed, so exit.		v.6

	call	getload		;determine load point for module.
	cnz	ccperr		;ccp not found?  message, then quit.
	jnz	exit

;is a copy of SAFRAM already active?
	call	tstact
	jnz	begin4		; no, skip.

	lhld	secaddr
	lxi	d,length	;remove SAFRAM length, since
	dad	d		; won't be loaded anew.
	shld	secaddr

;test for explicit address on command line.  Abort if bad.
begin4:
	call	expladr
	jnz	exit		;quit if error

;if already loaded and active, don't load again (just update it)
	call	tstact
	cz	active
	cnz	instal

;set for display of current secured address				v.6
	lhld	modbase		;					v.6
	lxi	d,wbflag	;					v.6
	dad	d		;					v.6
	mvi	m,on		;set flag to "on"			v.6

;if ddt executing, do restart 7; else return to cpm
exit:
	pop	h		;restore original stack pointer.
	sphl

	mov	a,h		;is ddt active?
	cpi	2
	cc	38h		;  yes, call ddt,
	jc	begin		;   then restart if user says "G".

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;			is it "off"?			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;is it request to turn off SAFRAM?
;if yes, do it.
;(entire module introduced in v.6)

isitoff:
	mvi	b,offlen
	lxi	d,offcmd
	lxi	h,deffcb+1

	call	compare		;is file name "off"?
	jnz	isitofx		; no, exit.

	call	tstact		;is SAFRAM active?
	lxi	d,mnosafr
	jnz	isitof6		; no, output error msg and quit.

	mvi	a,vers		;same version?
	cmp	b
	lxi	d,mdifver
	jnz	isitof6		; no, output error msg and quit.

	call	tsttrps		;all patch points available to be reversed?
	lxi	d,mnounp
	jnz	isitof6		; no, notify user, then abort.

	call	reverse		; yes, unpatch SAFRAM.
	lxi	d,moff

isitof6:
	call	domess
isitof8:
	xra	a
isitofx:
	ret			;if "off" request, z = yes.

;----------------------------------------------------
;does template match target?
;on entry, b=length, (de)=template, (hl)=target.

compare:
	ldax	d
	cmp	m
	jnz	comparx

	inx	h
	inx	d

	dcr	b
	jnz	compare

comparx:
	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		is SAFRAM deinstallable?		;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(routine introduced v.6)

tsttrps:
	lxi	b,wbtrap	;check warmboot vector.
	lxi	d,wboff
	call	tstvec

	lxi	b,cotrap	;check conout vector.
	lxi	d,coutoff
	cz	tstvec

	ret

;----------------------------------------------------
;does bios vector point to appropriate safram trap routine?
;on entry, bc=offset to safram routine.
;	   de=offset to bios vector.
;(entire routine introduced v.6)

tstvec:
	lhld	boot+1
	mov	d,h

	lhld	modbase
	dad	b

	inx	d
	ldax	d
	cmp	l
	jnz	tstvecx

	inx	d
	ldax	d
	cmp	h

tstvecx:
	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		reverse the bios traps			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(routine introduced v.6)

reverse:
	lxi	b,wbtrapx	;remove warmboot vector.
	lxi	d,wboff
	call	remove

	lxi	b,cotrapx	;remove conout vector.
	lxi	d,coutoff
	call	remove

	lhld	modbase
	lxi	d,tobdos+1	;reverse bdos+1 vector.
	dad	d

	mov	e,m
	inx	h
	mov	d,m

	xchg
	shld	bdos+1

	ret

;----------------------------------------------------
;remove a bios trap.
;on entry, bc=offset to exit from safram routine.
;	   de=offset to bios vector.
;(entire routine introduced v.6)

remove:
	lhld	boot+1
	mov	d,h

	lhld	modbase
	dad	b

	inx	h
	inx	d
	mov	a,m
	stax	d

	inx	h
	inx	d
	mov	a,m
	stax	d

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		find load point				;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;on exit, if error, z flag = no.

getload:
	call	isbios		;find bios:  14 jmps in a row?
	jnz	getlod9		;  no, abort.

	call	locbdos		;find bdos.
	jnz	getlod9		;  not found?  abort.

	call	locccp		;find ccp.
	jnz	getlod9		;  not found?  abort.

	lhld	ccpent		;point again to start of ccp.
	lda	bdos+2
	sub	h		;ccp page < = address-5 page?
	jnc	getlod5		;  yes, save ccp as tpatop
	lhld	bdos+1		;  no, save location 5 as tpatop.

getlod5:
	mov	a,l		;is a resident utility trying
	cpi	6		; to look like the bdos?  (e.g, EX15.COM)
	jnz	getlod7
	mvi	l,0		;  yes, move down to page boundary.

getlod7:
	lxi	d,-length	;allow room for SAFRAM to be installed.
	dad	d
	shld	modbase		;modbase = new module entry
	shld	secaddr		;presumed new TPA top, after SAFRAM loading.

	xra	a		;say "no error"

getlod9:
	ret			;on exit, z indicates error/no-error.

;--------------------------------------------------
;test if hl points to bios

isbios:
	lhld	boot+1		;initialize bios pointer.
	dcx	h
	dcx	h
	dcx	h
	shld	biosent

	lxi	d,3		;test from boot to write disk.
	mvi	c,14

isbios2:
	dad	d
	mov	a,m

	cpi	jmp
	jz	isbios4

	cpi	ret		;allow for disabled vectors (e.g., conout).
	jnz	isbios9

isbios4:
	dcr	c
	jnz	isbios2

isbios9:
	ret		;if bios, z = yes

;-------------------------------------------------------
;locate beginning instruction of bdos.
;on exit, if found, z  = yes
;		    hl = bdos start (offset 6)

locbdos:
	lhld	biosent
	lxi	d,-100h
	mvi	b,31h		;check for max of 3000h below bios

locbd2:
	dcr	b
	jz	locbd9		;exhausted search, no success:  abort.

	mvi	l,6		;set for offset to bdos start.
	dad	d		;compute bdos start

	shld	bdosent		;save in case found

	mov	a,m		;is this bdos location?
	cpi	jmp		;at page plus 6, is there a "jmp"...
	jnz	locbd2

	inx	h
	mov	a,m
	cpi	11h		;ZDOS and other systems don't have "11h".
	jnz	locbd2		; This value can be changed for those systems.

	mvi	b,1		;  yes, set to "found"

locbd9:
	dcr	b		;set z flag to "yes" (found) or "no" (missing)

	ret


;------------------------------------------------
;check for ccp
;on exit, if ccp found, z  = yes
;			hl = ccpstart

locccp:
	lhld	bdosent
	mvi	b,31h		;check no more than 3000h below bdos.
	lxi	d,-100h

loccp2:
	dcr	b
	jz	loccp9

	mvi	l,0		;correct to bdos start.
	dad	d		;advance to next lower page

	call	isitjmp		;check for two jmp instructions.
	jnz	loccp2

	call	isitjmp		;found?
	jnz	loccp2		;  no, abort.

	call	isitjmp		;a third found?
	jz	loccp2		;  yes, abort.

	mvi	l,0		;correct to ccp start.
	shld	ccpent

	mvi	b,1		;set for "found"

loccp9:
	dcr	b		;set z flag.

	ret

;---------------------------------------------------
;check for jump instruction

isitjmp:
	mov	a,m
	cpi	jmp

	inx	h
	inx	h
	inx	h

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;	test for explicit address on command line	;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;if error, return with z flag = no.

;get parm length and address
expladr:
	lda	deffcb+9
	cpi	blank		;is filetype blank?
	jnz	expl7		;  no, ignore parm (probably = "SAFRAM.COM",
				;      left over from loading by ddt),

	lda	deffcb+1	;filename is blank?			v.6
	cpi	blank		;					v.6
	jz	expl9		;  yes, exit:  no explicit addr.	v.6

	call	getxaddr	;  no, convert the parm into 4-byte hex value.

	call	tstxaddr	;value within acceptable range?
	jnz	expl9		;  no, abort.

	shld	secaddr		;  yes, use it.

expl7:				;					v.6
	xra	a		;					v.6
expl9:
	push	psw		;save result
	cnz	dobadxa		;display error message.
	pop	psw

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;convert parm in fcb into 4-byte hex value.

getxaddr:
	lxi	h,0		;initialize explicit address.		v.6
	lxi	d,deffcb+1
	mvi	b,4		;max length of hex addr
	jmp	getxa6

getxa4:
	call	asc2hex		;build hex value in hl
	jnz	getxa9		;exit if error

	dcr	b
	jz	getxa9

	inx	d
getxa6:
	ldax	d

	cpi	blank
	jnz	getxa4

getxa9:
	ret

;-----------------------------------------------------
;is parm within acceptable range?

tstxaddr:
	mov	a,h		;explicit parm = zero?
	ora	l
	sui	1		;					v.6
	jc	tstxa9		; yes, abort.				v.6

	xchg			;save in de
	lhld	secaddr
;	jz	tstxa9		; yes, keep default.	      voided in v.6

	lxi	h,progend+3	;allow for jump instruction.
	call	deminhl		;subtract: de minus hl.
	jc	tstxa9		;error if below end of this prog...

	lhld	secaddr
	xchg			;put explicit address back into hl.
	call	deminhl		;  ...or if higher than available top.
	jc	tstxa9

	xra	a		;no error.
tstxa9:
	ret			;if error, z = no.

;-----------------------------------------------------
;subtract:  de minus hl.

deminhl:
	mov	a,e
	sub	l
	mov	a,d
	sbb	h
	ret

;-----------------------------------------------------
;parameter error:  display acceptable addr range.
dobadxa:
	lxi	h,progend+3
	call	hex2asc		;put value in de and hl
	lxi	h,badad1
	call	put2bad

	lhld	secaddr
	call	hex2asc
	lxi	h,badad2
	call	put2bad

	lxi	d,baddr
	mvi	c,pstr
	call	bdos

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;put address into error message
put2bad	mov	m,b
	inx	h

	mov	m,c
	inx	h

	mov	m,d
	inx	h

	mov	m,e

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;convert ascii characters into hex (using hl)
;on exit, if error, z = no.

;don't use register b.

asc2hex	sui	'0'
	jc	asc2x		;exit if invalid char

	cpi	10
	jc	asc2b
	sui	7

	cpi	16
	jnc	asc2x

asc2b	dad	h
	dad	h
	dad	h
	dad	h

	add	l
	mov	l,a

	xra	a		;"no error"

asc2x	ora	a		;set z = "error" or "no error"

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;convert hex value to ascii
hex2asc	call	hex2b
	mov	b,d
	mov	c,e

hex2b	call	hex2c
	mov	d,a

	call	hex2c
	mov	e,a

	ret

hex2c	mov	a,h

	dad	h
	dad	h
	dad	h
	dad	h

	rar
	rar
	rar
	rar

	ani	0fh
	adi	'0'

	cpi	'9'+1
	rc

	adi	7

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		test if module already active		;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;check address in bios table for boot
;on exit, z = yes if module already active.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		test if reinstallation			;   
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;is SAFRAM already installed?
;on exit, if yes,   z = yes,
;	            modbase is updated with addr of loaded module.

tstact:
	lxi	d,0		;initialize de to 0000.
	mvi	c,flogv
	mvi	b,progcode	;ask "SAFRAM recursion?"
	call	bdos		;"get login vector".

	mov	a,d		;de still 0000?
	ora	e		;("SAFRAM uninstalled?")
	mvi	a,1
	jz	tstact9		;  yes, exit.

	xchg
	shld	modbase

	xra	a		;say "already installed"

tstact9:
	ora	a
	ret			;if z=yes, SAFRAM installed.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;	module already active:  process only stub	;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;determine where to install bypass
active	lhld	secaddr
	lxi	d,-3		;allow for jump instruction.
	dad	d

	call	adjpage		;adjust to page boundary + 6, if requested. v.6

	shld	bypass		;save address for bypass jump.
	inx	h
	inx	h
	inx	h
	shld	secaddr

;secure, then update message and savearea
	call	doprot

;set for display of current secured address				v.6
;	lhld	modbase				moved to end of mainlinev.6
;	lxi	d,wbflag						v.6
;	dad	d							v.6
;	mvi	m,on		;set flag to "on"			v.6

;say ceiling lowered.		;					v.6
	lxi	d,mreassgn	;					v.6
	call	domess		;					v.6

;set to bypass "not active" module
	xra	a

	ret

;-------------------------------------------------
;if requested, adjust down to page-boundary+6.
;on entry and exit, hl=addr.

;(this routine was introduced in v.6)

adjpage:
	mvi	a,pagebnd	;adjust to page boundary + 6?
	cpi	yes
	jnz	adjpag9		;  no, exit.

	lxi	d,-6		;insure not below that point in curr page.
	dad	d
	mvi	l,6

adjpag9:
	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;	module not active:  load from scratch		;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

instal
	lhld	secaddr
	dcx	h
	dcx	h
	dcx	h

	call	adjpage		;adjust to page boundary + 6, if requested. v.6

	shld	bypass		;set bypass address.

	inx	h
	inx	h
	inx	h
	shld	secaddr
	shld	modbase

	call	chgaddr		;convert to true addresses

	call	ptchmod		;make some run-time patches to the module.

	call	movemod		;move module to load address

	call	traps		;install traps

	call	doprot		;do secure, and update message

	call	switch		;alter bypass jump to allow trapping
				; system-reset calls.

	lxi	d,mok		;say "everyting A-OK"
	call	domess

	ret

;--------------------------------------------------------------------
;make some run-time patches to the trap module.

ptchmod:
	lhld	ccpent		;insert ccp's entry addr.
	inx	h		;(adjust for entry at second vector,	v.6
	inx	h		; which automatically clears old ccp	v.6
	inx	h		; command to zero.)			v.6
	shld	toccp+module1+1

	call	fndsub		;patch $$$.SUB fcb in CCP to drive A.	v.6

	lhld	boot+1		;point to bios wboot entry.
	shld	tobios+module1+1

	lhld	bdosent
	mvi	l,0
	lxi	d,ofsetcd	;point to curr-drive byte in bdos.
	dad	d

	lda	drvusr		;is this really the bdos currdrive byte?
	ani	0fh		;(does it match drive in drive/user byte?)
	sub	m
	mvi	a,jmp
	jnz	ptchmod8	     ; no, don't use "dsk reset" for "sysrst".

	shld	bdcurdv+module1+1    ; yes, use "dsk reset" for "sysrst".
	mvi	a,jnz

ptchmod8:
	sta	voidrst+module1	     ; enable or disable surrogate "sysrst".
ptchmod9:
	ret

;--------------------------------------------------------------------
;patch CCP's $$$.SUB FCB explicitly for drive A.
;(entire routine added v.6)

fndsub:
	lhld	ccpent
	lxi	d,sfcboff+1	;load offset to $$$.SUB fcb.
	dad	d
	lxi	d,tstname	;address expected name
	mvi	b,11

fndsub2:
	ldax	d
	cmp	m
	jnz	fndsub9

	inx	d
	inx	h
	dcr	b
	jnz	fndsub2

	lhld	ccpent		;$$$.SUB FCB found in ccp:
	lxi	d,sfcboff	; patch it explicitly for...
	dad	d
	mvi	m,1		;...drive A.

	xra	a		;say "match found."

fndsub9:
	ret			;if match, z = yes.

;--------------------------------------------------------------------
;alter bypass=jump to allow trapping and conversion of system-reset calls.

switch:
	lhld	bypass
	inx	h
	call	hx2de		;get bdos address from bypass jump,...

	lhld	modbase
	lxi	b,tobdos+1
	dad	b
	call	de2hx		;...insert it at end of system-reset processor.

	lhld	modbase		;neutralize bypass jump.
	xchg
	lhld	bypass
	inx	h
	call	de2hx

	ret

;--------------------------------------------------------------------
;copy contents of de to address that hl points to.  (use "shld" format.)

de2hx:
	mov	m,e
	inx	h
	mov	m,d
	inx	h
	ret

;--------------------------------------------------------------------
;copy contents of address pointed to by hl into de.  (assume "shld" format.)

hx2de:
	mov	e,m
	inx	h
	mov	d,m
	inx	h
	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		convert module1 to true addresses	;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; change pseudo addresses to true addresses

chgaddr	lxi	b,length
	lxi	d,module1
	lxi	h,module2
truloop	ldax	d
	cmp	m
	cnz	convert

	inx	h
	inx	d
	dcx	b

	mov	a,b
	ora	c
	jnz	truloop

	ret

;--------------------------------------------------------
;convert displacement into address

convert	push	b		;length of module not yet processed
	push	h		;module2 character position

;get displacement from instruction, put into bc.
	ldax	d
	mov	b,a
	dcx	d
	ldax	d
	mov	c,a

	lxi	h,-module1	;normalize displacement to zero
	dad	b
	push	h
	pop	b

	lhld	modbase		;add load point for true addr
	dad	b

;move true address to instruction
	mov	a,l
	stax	d
	inx	d
	mov	a,h
	stax	d

	pop	h
	pop	b

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		move module into place			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

movemod	lhld	modbase
	xchg				;de=destination
	lxi	h,module1		;hl=source 
	lxi	b,length 
	call	move

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;	install security, describe in message		;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;move the new secured address to de, then store into SAFRAM
; module (whether active or still to be loaded).

;alter location 6-7 to point to bypass jump.
doprot	lhld	bdos+1
	xchg
	lhld	bypass
	shld	bdos+1

;install bypass at base of secured RAM
	push	h		;save new secured address
	mvi	m,jmp
	inx	h
	mov	m,e
	inx	h
	mov	m,d
	pop	d		;restore new secured address

;store new secured address in module
	lhld	modbase
	lxi	b,savbase
	dad	b
	mov	m,e
	inx	h
	mov	m,d

;convert hex address at location 6 to ascii, put in message
	lhld	modbase		;address message
	lxi	b,messadr
	dad	b		;pointer to message into hl

;output hi and lo bytes of address to message
	call	hilo
hilo	mov	a,d
	mov	d,e		;get next byte
	push	psw
	rar
	rar
	rar
	rar
	call	hexbyte
	pop	psw

hexbyte	ani	0fh
	adi	'0'
	cpi	'9'+1
	jc	movhex
	adi	7
movhex	mov	m,a
	inx	h

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		set all traps				;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;set trap for wboot
traps	lxi	b,wbtrapx+1
	lxi	d,wbtrap
	lxi	h,0
	call	settrap

;set trap for conout
	lxi	b,cotrapx+1
	lxi	d,cotrap
	lxi	h,coutdsp
	call	settrap

	ret

;--------------------------------------------------------
;set a trap
;on entry, bc=biosav
;	   de=trapent
;	   hl=biosdsp

settrap:
	shld	biosdsp
	xchg
	shld	trapent
	mov	h,b
	mov	l,c
	shld	biosav

	lhld	modbase		;get address of moved module
	push	h
	pop	b		;save in bc

	lhld	biosdsp		;get displace for bios jmptable into de
	push	h
	pop	d

;get contents of bios jumptable entry
	lhld	boot+1
	dad	d		;address bios jumptable entry
	inx	h
	push	h		;...save pointer to table entry

	mov	e,m		;...and get contents
	inx	h
	mov	d,m

;store bios entry into trap savearea
	lhld	biosav		;save bios contents into trap mod
	dad	b
	mov	m,e
	inx	h
	mov	m,d

;set bios entry to trap entry
	lhld	trapent		;get addr of appropriate trap into de
	dad	b
	xchg

	pop	h		;store trap addr in bios jmptab
	mov	m,e
	inx	h
	mov	m,d

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		print messages				;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
signon	lxi	d,helpmes
	jmp	domess

ccperr	lxi	d,ccpmess

domess	mvi	c,pstr
	call	bdos
	ori	1		;set non-zero flag to abort.
	ret


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		move block of data			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;source in hl, destination in de, length in bc.

move	mov	a,b
	ora	c
	rz
	mov	a,m
	stax	d
	inx	d
	inx	h
	dcx	b
	jmp	move

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		end of loader routines			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	ds	20
lstack:			;stack for loader module.

	endif


*********************************************************
*	beginning of movable module			*
*********************************************************
;uses no levels of caller's stack.


	org	($+0ffh)/100h*100h	;must be page boundary

adjust	set	$

	if	copy1
module1	equ	$
	endif

	if	not copy1
module2	equ	$
	endif

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;	    	entry to safram module			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(this entire routine revamped and expanded in v.6.)

tentry	equ	$-adjust
	jmp	trmain+adjust

tobdos	equ	$-adjust		;place here to make next in
	jmp	$-$			; chain of modules easy to find.

;-------------------------------------------------------

trmain	equ	$-adjust
	mov	a,c

	cpi	fopen			;asking to "open file"?
	jz	dosub+adjust		;  yes, process and return.

	cpi	fsrch1			;asking to "search first file"?
	jz	dosub+adjust		;  yes, process and return.

	cpi	fclos			;asking to "close file"?
	jz	dosub+adjust		;  yes, process and return.

	cpi	feras			;asking to "erase file"?
	jz	dosub+adjust		;  yes, process and continue.

	cpi	frenam			;asking to "rename file"?
	jz	dosub+adjust		;  yes, process and continue.

	cpi	flogv			;asking for "login vector"?
	jz	trplog+adjust		;  yes, process and return.

	cpi	sysrst			;asking to "reset system"?
	jnz	tobdos+adjust		;  no, exit to bdos.

voidrst	equ	$-adjust-3		;<--("jnz" above becomes "jmp" if cur-
					;    drv savearea in bdos not found.)

;--------------------------------------------------------
;do "reset all drives" in place of "rest system".
;(routine updated in v.6)

dorst	equ	$-adjust

	lxi	d,tbuff			;reset dma to default.
	mvi	c,setdma
	call	tobdos+adjust

	mvi	a,0ffh			;set "curr disk" in bdos to 0ffh.
bdcurdv	equ	$-adjust		; force next drive select to be phys.
	sta	bdcurdv+adjust-1	;(<--initial val is in effect a no-op.)

	mvi	c,drvrst
	lxi	d,0ffffh
	call	tobdos+adjust

	lda	issact+adjust		;return "$$$.SUB-active" flag

	ret

;-------------------------------------------------------
dosub	equ	$-adjust
	call	tstsub+adjust		;is this a $$$.SUB file?
	jnz	tobdos+adjust		; no, on to bdos.

	call	tobdos+adjust		;do the function,
	sta	retfn+adjust		;save the return code.
	inr	a			;failed?
	jz	dosub4+adjust		; true, say "$$$.SUB" inactive.

	lda	savefn+adjust		;successful: was it an erase?
	sui	feras
	jz	dosub4+adjust		; yes, say "$$$.SUB inactive".

	mvi	a,0ffh			; no, say "$$$.SUB active."

dosub4	equ	$-adjust
	sta	issact+adjust		;set/reset $$$.SUB-flag.

dosub9	equ	$-adjust
	lda	retfn+adjust
	ret

;--------------------------------------------------------
;does current fcb have fname of "$$$.SUB"?
;(this routine added in v.6.)

tstsub	equ	$-adjust
	cpi	frenam			;is the function "rename file"?
	lxi	h,16
	jz	tstsub1+adjust		; yes, skip
	lxi	h,0
	
tstsub1	equ	$-adjust
	sta	savefn+adjust		;save function code...
	xchg
	shld	savede+adjust		;...and de regs.
	dad	d
	inx	h

	lxi	d,subname+adjust
	mvi	c,11

tstsub2	equ	$-adjust
	ldax	d
	cmp	m
	jnz	tstsub9+adjust

	inx	d
	inx	h
	dcr	c
	jnz	tstsub2+adjust

tstsub9	equ	$-adjust
	lhld	savede+adjust		;(restore callers registers)
	xchg
	lda	savefn+adjust
	mov	c,a

	ret			;if match, z = yes.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		    trap login vector			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;trap "get login vector", and make de point to old-RAP entry point.
;(Tells new RAP that old copy is already installed and operating.)
;(Entire routine introduced in v.6)

trplog	equ	$-adjust
	mov	a,b		; "RAP recursion?"
	cpi	progcode
	jnz	tobdos+adjust

	call	tobdos+adjust

	mvi	b,vers
	lxi	d,tentry+adjust	;change to entry addr, to indicate RAP active.

	ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		    bios warmboot trap			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

wbtrap	equ	$-adjust
	mvi	a,on			;indicate that wboot just done.
	sta	wbflag+adjust

	lxi	sp,deffcb+32
	mvi	a,jmp

	sta	boot			;restore to-boot vector
tobios	equ	$-adjust
	lxi	h,$-$
	shld	boot+1
	
	sta	bdos			;restore to-bdos vector.
	lhld	savbase+adjust
	shld	bdos+1

	lda	drvusr
	mov	c,a
toccp	equ	$-adjust
	jmp	$-$			;jump to the ccp.

;--------------------------------------------------------
wbtrapx	equ	$-adjust
	jmp	$-$			;original wboot routine.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;		  bios conout trap			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;don't alter register c.

;note:  this and the other routines are designed to avoid using the
;       caller's stack.  Some elegance was sacrificed to this end.

cotrap	equ	$-adjust

savbase	equ	$-adjust+1
	lxi	d,$-$		;restore address this module is protecting.
	lhld	bdos+1		;get current TPA top.

	mov	a,e		;TPA top higher than SAFRAM likes?
	sub	l
	mov	a,d
	sbb	h
	jnc	cotrap4+adjust	;  no, skip.

	xchg
	shld	boot+6		;  yes, reprotect.

cotrap4	equ	$-adjust

wbflag	equ	$-adjust+1	;was warmboot requested just now?
	mvi	a,pflag
	cpi	on
	jnz	cotrap9+adjust	;  no, exit.

	mvi	a,off
	sta	wbflag+adjust	;turn off flag

	lda	notiflg+adjust	;user wants to be notified at warmboot?
	cpi	yes
	jnz	cotrap9+adjust	;  no, exit.

;use local stack
	lxi	h,0
	dad	sp

	lxi	sp,stack+adjust
	push	h		;save caller's stack pointer.

;output "SAFRAM at xxxx" message.
	push	b		;save caller's character.

	lxi	h,message+adjust ;notify of current bypass
	mov	c,m		;get first char of message.

cotrap6	equ	$-adjust
	push	h
	call	cotrapx+adjust	;output char of message.
	pop	h

	inx	h
	mov	c,m		;get next char.

	inr	c		;end of message?  (null byte)
	dcr	c
	jnz	cotrap6+adjust	; no, go output the char.

	pop	b		;restore caller's character.

	pop	h
	sphl			;restore caller's stack pointer.

;go to bios conout.
cotrap9	equ	$-adjust

cotrapx	equ	$-adjust
	jmp	$-$		;to bios conout routine.
				;(address gotten at runtime.)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;			saveareas			;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

on	equ	0		;do resecure.
off	equ	0ffh

pflag	equ	off		;if on, means "display wboot message."

notiflg	equ	$-adjust
	db	notify		;message at each ^C?

savede	equ	$-adjust	;					v.6
	dw	0		;					v.6

savefn	equ	$-adjust	;					v.6
	db	0		;					v.6

retfn	equ	$-adjust	;					v.6
	db	0		;					v.6

issact	equ	$-adjust	;is $$$.SUB active?			v.6
	db	no		;					v.6

subname	equ	$-adjust	;					v.6
	db	'$$$     SUB',0	;					v.6


;--------------------------------------------------------
message	equ	$-adjust
	db	cr,lf			;skip to next line.

	db	bs			;back up to column 80 of prev line.

	db	bs,bs,bs,bs,bs,bs,bs,bs	;backup up to initial column
	db	bs,bs,bs,bs,bs,bs,bs,bs ; for "Safram at" message.
	db	'(Safram at '
messadr	equ	$-adjust
	db	'....)'
	db	0			;message must end in null.

wb2mess	equ	message-wbtrap		;distance from boot trap
testlen	equ	messadr-message

	dw	0,0,0,0
	dw	0,0,0,0
	dw	0,0,0,0
stack	equ	$-adjust

*********************************************************
*		end of relocatable routines		*
*********************************************************

;get length of relocatable routines
length	equ	$-adjust

;flip the copy1/copy2 toggle
copy1	set	not copy1

;assemble address of end of this program
	if	copy1
progend	equ	$
	endif

;link a second copy, if this was the first copy
	if	not copy1
	link	safram6
	endif