home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
BEEHIVE
/
ZCAT
/
SETDRU13.LBR
/
SDRU1.MZC
/
SDRU1.MAC
Wrap
Text File
|
2000-06-30
|
9KB
|
443 lines
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
loc34: call obdos
pop hl ;get entry in table
pop de ;get fcb a