title	SDRUL1  -- allow setdru use of program

; copyright 1983  Michael M Rubenstein

; installs a filter to redirect certain files to a specified drive/user
; and loads program

; zcpr solves the problem of making a single copy of a program available
; to all user numbers, but many programs require overlays or work files
; which must also be made accessable.

; up to 8 files may be redirected.


; known limitations:

;	requires CP/M 2.2 or higher

;	requires Z80 processor

;	untested under CP/M Plus

;	will not work with programs (such as MultiPlan) which modify the drive
;	spec in the fcb after opening. 

	.z80
	entry	sdru1

false	equ	0
true	equ	not false

base	equ	0000h	    ;standard cpm base
boot	equ	base	    ;warm boot
iobyte	equ	0003h+base  ;i/o byte
cpmdsk	equ	0004h+base  ;current cpm disk
bdos	equ	0005h+base  ;entry to bdos
cpmfcb	equ	005ch+base  ;default cpm fcb
cpmbuf	equ	0080h+base  ;default cpm buffer
tpa	equ	0100h+base  ;start of transient pgm

reset	equ	0	;system reset
rdcon	equ	1	;read console
wrcon	equ	2	;write console
rdrdr	equ	3	;read reader
wrpun	equ	4	;write punch
wrlst	equ	5	;write list
conio	equ	6	;console i/o
getiob	equ	7	;get i/o byte
setiob	equ	8	;set i/o byte
wrstr	equ	9	;put string to console
rdstr	equ	10	;get a string from con
cnstat	equ	11	;console status
getver	equ	12	;get cp/m version numb
resetd	equ	13	;reset disk system
seldsk	equ	14	;select disk
opnfle	equ	15	;open disk file
clsfle	equ	16	;close disk file
search	equ	17	;get first disk file
			;(ambiguous reference)
snext	equ	18	;get next disk file
delfle	equ	19	;delete disk file
rdseq	equ	20	;read disk sequential
wrseq	equ	21	;write disk sequential
makefl	equ	22	;create a file
rename	equ	23	;rename disk file
glogin	equ	24	;return login vector
curdsk	equ	25	;return current disk
setdma	equ	26	;set dma for dsk access
getalc	equ	27	;return disk alloc vect
wrprot	equ	28	;write protect disk
getro	equ	29	;get read only vector
setfla	equ	30	;set file attributes
gdprm	equ	31	;get disk parm
ucode	equ	32	;set/get user code
rdrand	equ	33	;read random record
wrrand	equ	34	;write random record
fsize	equ	35	;comp virt file size
setrnd	equ	36	;set random record
resdrv	equ	37	;reset drive
wrranz	equ	40	;write random with zero fill

; relocation macro (just 'cause i'm lazy)
reloc	macro	n
	ld	hl,(rloc&n+1)
	add	hl,de
	ld	(rloc&n+1),hl
	endm

sdru1:
	.phase	tpa
begin:	jp	start
	dw	length			;length of this module
	dw	0			;for compatibility
pgm:	db	0,0			;file to load
	db	'        '
	db	'   ' 
fssize	equ	$-pgm
rfiles:	db	0,0 			;file 1
	db	'        '
	db     	'   '     
	db	0,0 			;file 2
	db	'        '
	db	'   '    
	db	0,0  	 		;file 3
	db	'        '
	db	'   '    
	db	0,0 			;file 4
	db	'        '
	db	'   '    
	db	0,0 	 		;file 5
	db	'        '
	db	'   '    
	db	0,0			;file 6
	db	'        '
	db	'   '
	db	0,0			;file 7
	db	'        '
	db	'   '
	db	0,0			;file 8
	db	'        '
	db	'   '
lfiles	equ	$-rfiles

	db	"***SETDRU1***"		;identification
	db	"Copyright 1983  Michael M Rubenstein"

start:	ld	sp,stack
	ld	hl,rfiles		;move redirected file specs to filter
	ld	de,wrfls
	ld	bc,lfiles
	ldir

	ld	hl,pgm+2		;set up fcb to read program
	ld	de,wfcb+1
	ld	bc,11
	ldir
	ld	a,(pgm)
	ld	(wfcb),a

	ld	c,ucode			;get current user number
	ld	e,0ffh
	call	bdos
	ld	(user),a

	ld	c,ucode			;set user code for program
	ld	a,(pgm+1)
	ld	e,a
	call	bdos

	ld	hl,(bdos+1)		;compute location to move to
	ld	(obdos+1),hl		;save bdos location
	ld	de,-lfilt
	add	hl,de
	push	hl			;save new location
	ld	de,-filter		;compute relocation factor
	add	hl,de
	ex	de,hl

	reloc	01
	reloc	02
	reloc	03
	reloc	04
	reloc	05
	reloc	06
	reloc	07
	reloc	08
	reloc	09
	reloc	10
	reloc	11
	reloc	12
	reloc	13
	reloc	14
	reloc	15
	reloc	16
	reloc	17
	reloc	18
	reloc	19
	reloc	20
	reloc	21
	reloc	22
	reloc	23
	reloc	24
	reloc	25
	reloc	26
	reloc	27
	reloc	28
	reloc	29
	reloc	30
	reloc	31
	reloc	32
	reloc	33
	reloc	34
	reloc	35
	reloc	36
	reloc	37
	reloc	38
	reloc	39

	ld	hl,filter		;move the filter to high memory
	pop	de			;get location again
	push	de			;and save it again
	ld	bc,lfilt
	ldir

	ret				;go to high memory routine

; the following code is moved to high memory before execution
filter:
rloc01:	ld	sp,stack
	ld	c,opnfle		;open program
rloc02:	ld	de,wfcb
	call	bdos
	inc	a
	jp	z,boot			;get out if can't find

	ld	de,tpa

load:	push	de			;load program loop
	ld	c,setdma
	call	bdos
rloc03:	ld	de,wfcb
	ld	c,rdseq
	call	bdos
	pop	de			;advance position
	ld	hl,128
	add	hl,de
	ex	de,hl
	or	a			;end of file?
	jr	z,load

	ld	c,clsfle		;close the file
rloc04:	ld	de,wfcb
	call	bdos

	ld	c,ucode
rloc05:	ld	a,(user)		;reset the user number
	ld	e,a
	call	bdos

	ld	c,setdma		;reset the dma to default buffer
	ld	de,cpmbuf
	call	bdos

rloc06:	ld	hl,nbdos		;set the bdos to filter
	ld	(bdos+1),hl
	ld	hl,boot			;return address
	push	hl
	jp	tpa			;do the program

;resident filter starts here
nbdos:	ld	a,c			;check the function
	cp	opnfle
	jr	z,opnflt
	cp	clsfle
rloc07:	jp	z,fleflt
	cp	search
	jr	z,opnflt
	cp	delfle
	jr	z,mkflt
	cp	rdseq
rloc08:	jp	z,fleflt
	cp	wrseq
rloc09:	jp	z,fleflt
	cp	makefl
	jr	z,mkflt
	cp	rename
	jr	z,mkflt
	cp	rdrand
rloc10:	jp	z,fleflt
	cp	wrrand
rloc11:	jp	z,fleflt
	cp	fsize
rloc12:	jp	z,fleflt
	cp	wrranz
rloc13:	jp	z,fleflt
obdos:	jp	0			;set to old bdos loc

;check file on open for redirection
mkflt:	or	a			;flag for make
	jr	opnfl1
opnflt:	scf				;flag for open
opnfl1:	sbc	a,a			;0 for make, ff for open
rloc14:	ld	(oflag),a
	ld	a,(de)			;may already be set to phony
	cp	c
rloc15:	jp	nc,flefl2
rloc16	equ	$+1
	ld	(fstack),sp
rloc17:	ld	sp,fstack
	push	bc			;save parameters
	push	de
rloc18:	ld	hl,wrfls
	ld	c,17			;offset for phony drive
	inc	de			;point to name
ckloop:	ld	a,(hl)			;are we done checking?
	or	a
	jr	z,nored			;yes, no redirection
	sub	a			;set not ambig
rloc19:	ld	(aflag),a
	push	de			;save pointer to name
	push	hl			;save pointer to table
	ld	b,11			;length of name+type
	inc	hl			;point to name in table
	inc	hl
rloc20:
cmplp:	ld	a,(oflag)		;should we consider ambiguous?
	or	a
	jr	z,cmp1			;not if make
	ld	a,(hl)
	cp	'?'
	jr	nz,cmp1
rloc21:	ld	(aflag),a
	jr	cmp2
cmp1:	ld	a,(de)			;compare
	and	7fh			;strip bit 7
	cp	(hl)
	jr	nz,notit
cmp2:	inc	hl			;advance pointer to table name
	inc	de			;advance pointer to fcb name
	djnz	cmplp
	pop	hl			;got it, throw away pointer to table
	pop	hl			;throw away pointer to name
	pop	de			;get fcb
	ld	l,c
	pop	bc			;get function
rloc22:	ld	a,(aflag)		;ambiguous?
	or	a
	jr	z,opnfl9		;go to it if not
	push	hl			;save everything
	push	de
	push	bc
rloc23:	call	obdos
	cp	0ffh			;ok?
	jr	z,opnfl8
rloc24	equ	$+1
	ld	sp,(fstack)
	ret

opnfl8:	pop	bc			;restore parameters
	pop	de
	pop	hl
opnfl9:	ld	a,l
	ld	(de),a			;set phony drive
	jr	flefl1			;now handle the redirection

nored:	pop	de			;no redirection
	pop	bc			;restore parameters
rloc25	equ	$+1
	ld	sp,(fstack)		;restore stack
	jr	obdos

notit:	pop	hl			;get pointer to table
	ld	de,fssize		;size of table entry
	add	hl,de			;advance to next entry
	ld	a,c
	add	a,e			;advance phony drive spec
	ld	c,a
	pop	de
	jr	ckloop

; if the file is redirected, fudge it
fleflt:	ld	a,(de)
	cp	16+1			;if > max drive, redirected
rloc26:	jp	c,obdos
flefl2:	cp	'?'
rloc27:	jp	z,obdos
rloc28	equ	$+1
	ld	(fstack),sp		;save old stack
rloc29:	ld	sp,fstack		;and use local stack
flefl1:	push	bc			;save parameters
	push	de
	ld	c,ucode			;get user number
	ld	e,0ffh
rloc30:	call	obdos
rloc31:	ld	(user),a		;save user number
	pop	hl			;get fcb address again
	push	hl			;and save it
	ld	a,(hl)			;get phony drive spec
rloc32:	ld	(pdrive),a		;save it
	ld	e,a
	ld	d,0
rloc33:	ld	hl,wrfls-17+1		;phony drive is entry in table + 17
	add	hl,de
	push	hl			;save entry in table
	ld	c,ucode			;set user code
	ld	e,(hl)
rloc34:	call	obdos
	pop	hl			;get entry in table
	pop	de			;get fcb again
	pop	bc			;get function
	dec	hl			;point to drive
	ld	a,(hl)
	ld	(de),a
	push	de			;save fcb address
	push	bc			;save function
rloc35:	call	obdos
	pop	bc			;get function again
	pop	de			;get fcb again
	push	af
	ld	a,c
	cp	clsfle			;is this a close?
	jr	z,flefl9		;don't reset phony spec if so
rloc36:	ld	a,(pdrive)		;reset phony drive spec
	ld	(de),a
flefl9:	push	hl			;save hl return value
	ld	c,ucode
rloc37:	ld	a,(user)
	ld	e,a
rloc38:	call	obdos
	pop	hl			;get real return values
	pop	af
rloc39	equ	$+1
	ld	sp,(fstack)
	ret

user:	db	0			;hold user number
pdrive:	db	0			;hold phony drive spec
oflag:	db	0			;open/make
aflag:	db	0			;ambiguous?

wfcb:	db	0
	db	'        '
	db	'   '
	db	0,0,0,0,0,0,0,0
	db	0,0,0,0,0,0,0,0
	db	0,0,0,0,0,0,0,0

wrfls:	ds	lfiles			;file table
	db	0			;to end it all

	ds	32
fstack:	ds	2
	ds	16
stack:	ds	2

length	equ	$-begin
lfilt	equ	$-filter
	.dephase

	end