DataMuseum.dk

top - download

    Length: 36480 (0x8e80)
    Types: TextFile
    Names: »CPMMAC.MAC«

└─⟦01b5c9619⟧ Bits:30005906 Microsoft Multiplan v1.05 og HELP
    └─ ⟦this⟧ »CPMMAC.MAC« 

TextFile

	.z80			;activator
;;
;;	Macro library for CP/M system routines
;;	13 March 1985
;;
;;	Updated:	19 September 1985
;;
;;	1.01		gfname: corrected for drive number
;;	11 Aug. 1985	gfname: added with a fcb option
;;			wrfile: entry changed.
;;
;;	1.02		pfname: added with drive and user number
;;	18 Sep. 1985	wrfile:	corrected sector calculating
;;			user:	new routine
;;
;;	1.03		wrfile:	entry changed
;;	19 Sep. 1985
;;
;;
;;Macros in this library:		flags:
;;-----------------------		------
;;abort	 macro	char			ci,cofalg	upd:	140385
;;ambig	 macro	old,new			(none)		upd:	130385
;;binbin macro				bnflag		upd:	160385
;;close	 macro	pointr			cl,co,cr,pr,op,	upd:	150385
;;					mv,de,ci,un,rn,
;;					s2flag
;;compar macro	first,second,bytes	cmflag		upd:	130385
;;compra macro	first,second,bytes	cmflag		upd:	130385
;;cpmver macro				(none)		upd:	130385
;;crlf	 macro				crflag,coflag	upd:	130385
;;cursor macro	row,culunm		cu,coflag	upd:	170385
;;delete macro	pointr,where		de,ci,co,pr,un	upd:	150385
;;divide macro	denom			dvflag		upd:	160385
;;enter	 macro				(none)		upd:	130385
;;errorm macro	text,where		co,cr,prflag	upd:	130385
;;exit	 macro	space?			(none)		upd:	130385
;;fill	 macro	addr,bytes,char		flflag		upd:	130385
;;filld	 macro	addr,bytes,char		flflag		upd:	160385
;;gfname macro	fcb			fn,fl,rc,co,cr,	upd:	110885
;;					rcflag
;;hexhl	 macro	pointr			hxflag,rcflag	upd:	130385
;;hldec	 macro				de,coflag	upd:	160385
;;lchar	 macro	par			loflag		upd:	130385
;;ldfile macro	fcb,pointr,char		co,dm,rdflag	upg:	150385
;;make	 macro	pointr			mk,co,cr,prflag	upd:	150385
;;move	 macro	from,to,bytes		mvflag		upd:	130385
;;mult	 macro	times			mlflag		upd:	160385
;;open	 macro	pointr,where		op,co,pr,crflag	upd:	130385
;;outhex macro	reg			cxflag,coflag	upd:	130385
;;outhl	 macro				cx,coflag	upd:	160385
;;pchar	 macro	par			coflag		upd:	130385
;;pfname macro	fcb			co,prflag	upd:	180985
;;print	 macro	text,bytes		prflag,coflag	upd:	130385
;;protec macro	pointr			(none)		upd:	160385
;;readb	 macro	buffr			rcflag		upd:	130585
;;readch macro	reg			ciflag,coflag	upd:	130385
;;reads	 macro	pointr,star		rdflag,coflag	upd:	150385
;;rename macro	pointr			rn,co,pr,crflag	upd:	150385
;;rvsoff macro				of,coflag	upd:	170385
;;rvson	 macro				on,coflag	upd:	170385
;;setdma macro	pointr			dmflag		upd:	130385
;;setup2 macro				s2,ci,co,cr,cm,	upd:	150385
;;					de,mk,mv,op,pr,
;;					unflag
;;sysf	 macro	func,ae			(none)		upd:	130385
;;ucase	 macro	reg			(none)		upd:	130385
;;unprot macro	pointr			unflag		upd:	150385
;;upper	 macro	reg			(none)		upd:	130385
;;user	 macro	num			(usflag)	upd:	180985
;;versn	 macro	num			(none)		upd:	120385
;;wrfile macro	fcb,pointr,star,opt	co,cr,dm,wrflag	upd:	190985
;;writes macro	pointr,star		wr,co,prflag	upd:	150385
;
;
eof	equ	1ah		;end of file
esc	equ	1bh		;escape
cr	equ	13		;carriage return
lf	equ	10		;line feed
tab	equ	9		;control-I
blank	equ	20h		;space
period	equ	46		;decimal point
comma	equ	44
;;
;;*********************************************************
;;
abort	macro	char
;;	14 March 1985
;;	Inline macro to abort program when
;;	console key given by char is pressed.
;;	Any key will do if char is omitted.
;▶bb◀	Branch to DONE on abort.
;;
;;	Usage:		abort	esc
;;
;;	Macros needed:	readch
;;
	local	around
	push	hl
	push	de
	push	bc
	ld	c,11		;console status
	call	bdos
	pop	bc
	pop	de
	pop	hl
	jp	nc,around	;no character
	readch			;get char
	if	nul char
	jp	done
	else
	cp	char
	jp	z,done
	endif
around:				;;abort
	endm
;;
;;*********************************************************
;;
ambig	macro	old,new
;;	13 March 1985
;;	Inline macro to change ambiguous file name
;;	at fcb new to match fcb old.
;;
;;	Usage:	Ambig	fcb1,fcb2
;;
	push	hl
	push	de
	push	bc
	ld	hl,new+1
	ld	de,old+1
	ld	c,11		;number of char
amb2?:
	ld	a,'?'
	cp	(hl)		;question mark ?
	jr	nz,amb3?	;no
;
;copy one character from original to new
;
	ld	a,(de)		;get old char
	ld	(hl),a		;put into new
amb3?:
	inc	hl		;new
	inc	de		;old
	dec	c		;count
	jr	nz,amb2?
	pop	bc
	pop	de
	pop	hl
				;;ambig
	endm
;;
;;*********************************************************
;;
binbin	macro
;;	16 March 1985
;;	Inline macro to convrt binary number in A
;;	to a string of ASCII-coded binary characters.
;;
	local	bit2,around
	call	binb2?
	if	not bnflag
	jp	around
binb2?:	push	bc
	ld	c,a
	ld	b,8
bit2:	ld	a,c
	add	a,a		;;set carry
	ld	a,'0'/2
	adc	a,a
	pchar
	djnz	bit2
	pop	bc		;;hl
	ret
	.8080
bnflag	set	true
	.z80
	endif
around:				;;binbin
	endm
;;
;;*********************************************************
;;
close	macro	pointr
;;	15 March 1985
;;	Inline macro to close a new file.
;;	Pointr refers to file control block.
;;	If file is not found, branch to done.
;;	if s2flag from setup2 is true, check if
;;	duplicate file name flag dupl is set. Change
;;	source file name to BAK and new to orig. name.
;;	Set s2flag false in beginning.
;;
;;	Usage:		close	dfcb
;;
;;	Macros needed:	sysf,errorm,open,print,move,delete
;;			rename
;;
	local	around,close3
	if	not nul pointr
	ld	de,pointr
	endif
	call	clos2?
	inc	a		;FF hex is error
	if	not s2flag	;setup2 macro
	jp	nz,around	;ok
	else
	jp	z,clos3?
	ld	a,(dupl)	;duplicate name ?
	or	a
	jp	z,around	;no
	move	'BAK',fcb1+10h+9
	move	fcb1+9,dfcb+10h+9,3
	move	fcb1,fcb1+10h,9
	move	dfcb,dfcb+10h,9
	delete	fcb1+10h	;BAK name if any
	rename	fcb1		;orig to BAK
	rename	dfcb		;$$$ to orig
	move	'BAK',fcb1+9	;restore
	open	fcb1
	jp	around
	endif			;;s2flag
	if	not clflag	;one copy
clos3?:	errorm	'?File not found?',done
clos2?:	sysf	16		;close disk file
	.8080
clflag	set	true		;only one copy
	.z80
	endif			;;clflag
around:				;;close
	endm
;;
;;*********************************************************
;;
compar	macro	first,second,bytes
;;	13 March 1985
;;	Inline macro to compare 2 memory areas.
;;	Zero flag is set if both are the same,
;;	first and second may be addresses,
;;	third parameter is number of bytes.
;;	First parameter may be a quoted string,
;;	in which case there is no third parameter.
;;	Any of the parameters may be omitted.
;;	Register A is altered.
;;
;;	Usage:	compar	fcb1,fcb2,12
;;		compar	'???',fcb1+9
;;		compar	,,5
;;
	local	mesg,around
	push	hl
	push	de
	push	bc
	if	nul bytes
	ld	hl,mesg		;quoted text
	ld	c,around-mesg	;lenght
	else
	if	not nul first
	ld	hl,first
	endif
	if	not nul bytes
	ld	c,bytes
	endif
	endif			;nul bytes
	if	not nul second
	ld	de,second
	endif
	call	comp2?
	pop	bc
	pop	de
	pop	hl
	if	not cmflag or nul bytes
	jp	around
	endif
	if	not cmflag	;one copy
comp2?:				;compare routine
	ld	a,(de)		;get char
	cp	(hl)		;same ?
	ret	nz		;no
	inc	hl
	inc	de		;pointers
	dec	c		;and count
	jr	nz,comp2?	;keep going
	ret
	.8080
cmflag	set	true
	.z80
	endif
	if	nul bytes
mesg:	db	first		;;text
	endif
around:				;;compar
	endm
;;
;;*********************************************************
;;
compra	macro	first,second,bytes
;;	13 March 1984
;;	ASCII version (high bit is zeroed).
;;	Inline macro to compare two memory areas.
;;	Zero flag is set if both are the same,
;;	first and second may be addresses,
;;	third parameter is number of bytes.
;;	First parameter may be a quoted string,
;;	in which case there is no third parameter.
;;	All three parameters may be omitted.
;;	Register A is altered.
;;
;;	Usage:	compra	fcb1,fcb2,11
;;		compra	'COM',fcb1+9
;;		compra	,fcb1+1,11
;;
	local	mesg,around
	push	hl
	push	de
	push	bc
	if	nul bytes
	ld	hl,mesg		;quoted text
	ld	c,around-mesg	;lenght
	else
	if	not nul first
	ld	hl,first
	endif
	if	not nul bytes
	ld	c,bytes
	endif
	endif			;nul bytes
	if	not nul second
	ld	de,second
	endif
	call	comp2?
	pop	bc
	pop	de
	pop	hl
	if	not cmflag or nul bytes
	jp	around
	endif
	if	not cmflag	;one copy
comp2?:				;compare routine
	ld	a,(de)		;get char
	and	7fh		;mask bit 7
	push	bc
	ld	c,a
	ld	a,(hl)
	and	7fh		;mask bit 7
	cp	c		;same ?
	pop	bc
	ret	nz		;no
	inc	hl
	inc	de		;pointers
	dec	c		;and count
	jr	nz,comp2?	;keep going
	ret
	.8080
cmflag	set	true		;one copy
	.z80
	endif
	if	nul bytes
mesg:	db	first		;;text	
	endif
around:				;;compra
	endm
;;
;;*********************************************************
;;
cpmver	macro
;;	13 March 1985
;;	Inline macro to determine the CP/M version.
;;	Accumulator has version in BCD times 10.
;;	A=22 for version 2.2, A=0 for version 1.4
;;
	push	hl
	push	de
	push	bc
	ld	c,12
	call	bdos
	ld	a,l		;;not necessary
	pop	bc
	pop	de
	pop	hl
				;;cpmver
	endm
;;
;;*********************************************************
;;
crlf	macro
;;	13 March 1985
;;	Inline macro to send a
;;	carriage return, line feed to console
;;	All registers save including A.
;;
;;	Macro needed:	pchar
;;
	local	around
	call	crlf2?
	if	not crflag	;just one
	jp	around
crlf2?:
	push	af
	pchar	cr
	pchar	lf
	pop	af
	ret
	.8080
crflag	set	true
	.z80
	endif
around:				;;crlf
	endm
;;
;;*********************************************************
;;
cursor	macro	row,column
;;	17 March 1985
;;	Inline macro to position cursor at row,column
;;	if row and column are omitted DE holds row,column
;;	D=row, E=column
;;
;;
;;	macros needed:	pchar
;;
;;	usage:		cursor	20,20 = home !!
;;			cursor
;;
	local	around
	push	de		;save content
	if	column
	ld	d,row
	ld	e,column
	endif
	call	cursr?		;position cursor
	pop	de
	if	not cuflag
	jp	around
cursr?:	pchar	esc
	pchar	'='
	pchar	d
	pchar	e
	ret
	.8080
cuflag	set	true		;;only one copy
	.z80
	endif
around:				;;cursor
	endm
;;
;;*********************************************************
;;
delete	macro	pointr,where
;;	15 March 1985
;;	Inline macro to delete an existing disk file
;;	pointr refers to file control block.
;;	If file is protected, branch to where or done.
;;
;;	Macros needed:	sysf,unprot,readch,pfname,
;;			print,ucase,crlf
;;
	local	around,del3?
	ld	de,pointr
	ld	a,(pointr+9)
	and	80h		;protected ?
	jp	z,del3?		;no
	crlf
	pfname	pointr
	print	' is READ ONLY. Delete ?'
	readch
	ucase
	cp	'Y'
	if	not nul where
	jp	nz,where
	else
	jp	nz,done
	endif
	unprot	pointr
del3?:
	call	del2?
	if	not deflag
	jp	around
del2?:	sysf	19		;delete disk file
	.8080
deflag	set	true		;only one copy
	.z80
	endif
around:
	endm
;;
;;*********************************************************
;;
divide	macro	denom
;;	16 March 1985
;;	Inline macro to divide HL register by denom.
;;	Denom should be power of 2 (2,4,8,16).
;;	HL unaltered if denom is 0 or 1.
;;
	local	around,shftr?,div3?
	push	bc
	if	nul denom
	ld	b,2		;;default
	else
	ld	b,denom
	endif
	call	div2?
	pop	bc
;;
	if	not dvflag
;;
	jp	around
;;
div2?:	ld	a,b
	or	a		;;clear carry
	ret	z		;;divide by zero
	rra
	ret	c		;;divide by 1?
	ld	b,a
div3?:	call	shftr?		;;shift HL right
	ld	a,b		;;get divisor
	rra
	ld	b,a
	jr	nc,div3?
	ret
;;
shftr?:	xor	a		;;16 bit shift right
	ld	a,h
	rra
	ld	h,a
	ld	a,l
	rra
	ld	l,a
	ret
;;
	.8080
dvflag	set	true		;;one copy
	.z80
	endif			;;dvflag
around:				;;mult
	endm
;;
;;*********************************************************
;;
enter	macro
;;	Updated:	13 March 1985
;;	Inline macro to save incomming stack
;;
	ld	hl,0		;clear
	add	hl,sp		;add pointer
	ld	(oldstk),hl	;save
	ld	sp,stack
				;;enter
	endm
;;
;;*********************************************************
;;
errorm	macro	text,where
;;	13 March 1985
;;	Macro to print message on console.
;;	Message is enclosed in apostrophes.
;;	Optional second parameter has branch address.
;;	If no second parameter, goto boot
;;
;;	Macros needed:	print,crlf
;;
;;	Usage:		errorm	'Message'
;;
	crlf
	print	<text>
	if	nul where
	jp	boot		;quit
	else
	jp	where
	endif			;;errorm
	endm
;;
;;*********************************************************
;;
exit	macro	where?,space?
;;	Updated:	13 March 1985
;;	inline macro to resore the incomming stack
;;	and branch to location where?
;;	if where? is omitted, execute a return instruction.
;;	space? sets stack space; default is 34
;;
	ld	hl,(oldstk)
	ld	sp,hl
	if	nul where?
	ret
	else
	jp	where?
	endif
;
oldstk:	ds	2		;incomming stack
	if	nul space?
	ds	34
	else
	ds	space?
	endif
stack:
				;;exit
	endm
;;
;;*********************************************************
;;
fill	macro	addr,bytes,char
;;	13 March 1985
;;	Inline macro to fill byte memory
;;	loactions with char starting at addr
;;	Usage:	fill	fcb+1,8,blank
;;		fill	fcb+9,3,?
	local	around
	push	hl
	push	bc
	if	not nul addr
	ld	hl,addr
	endif
	ld	c,bytes
	ld	a,char
	call	fill2?
	pop	bc
	pop	hl
	if	not flflag
	jp	around
fill2?:
	ld	(hl),a		;put into memory
	inc	hl		;pointer
	dec	c		;count
	jr	nz,fill2?	;keep going
	ret
	.8080
flflag	set	true
	.z80
	endif
around:				;;fill
	endm
;;
;;*********************************************************
;;
filld	macro	addr,bytes,char
;;	16 March 1985
;;	(double precision version)
;;	Inline macro to fill bytes memory
;;	locations with char starting at addr.
;;
;;	Usage:	filld	fcb+1,8,blank
;;		filld	fcb+3,3,'?'
;;
	local	around,fill3?
	push	hl
	push	bc
	if	not nul addr
	ld	hl,addr
	endif
	if	not nul bytes
	ld	bc,bytes
	endif
	ld	a,char
	call	fill2?
	pop	bc
	pop	hl
	if	not flflag
	jp	around
;;
fill2?:	push	de
	ld	d,a
fill3?:	ld	(hl),d
	inc	hl
	dec	bc
	ld	a,c
	or	b
	jr	nz,fill3?
	pop	de
	ret
	.8080
flflag	set	true
	.z80
	endif
around:				;;filld
	endm
;;
;;*********************************************************
;;
gfname	macro	fcb
;;	13 March 1985
;;
;;	Updated:	11 August 1985
;;
;;	Inline macro to get file name from console
;;	and place in FCB. Lowercase raised to uppercase.
;;
;;	Macros needed:	readb,fill,ucase,print,crlf
;;
;;	Subroutine GETCH is part of macro readb.
;;
	local	around,pname,ename,exten,gnam2
	push	hl
	push	de
	push	bc
	if	fcb
	ld	hl,fcb
	else
	ex	de,hl
	endif
	ld	(fcbs?),hl
	call	gnam?
	pop	bc
	pop	de
	pop	hl
	if	not fnflag
	jp	around
fcbs?:	ds	2		;save original pointer
;;
gnam?:	crlf
;;
gnam2:	print	<'                              ',cr>
	print	'Enter file name: '
	ld	hl,(fcbs?)
	xor	a		;zero
	ld	(hl),a		;default drive
	inc	hl
	fill	,11,blank
	ex	de,hl
	readb			;console buffer
	call	getch		;first char
	jp	c,gnam2		;try again
	cp	blank
	jp	z,gnam2		;try again
	ucase
	ld	(de),a		;maybe first
	call	getch		;second char
	ret	c		;short name
	cp	blank
	ret	z		;ditto
	ld	b,7		;name lenght - 1
	ucase
	cp	period
	jp	z,ename
	cp	':'		;drive ?
	jp	nz,pname	;no
	ld	a,(de)		;get drive
	dec	de		;drive number
	sub	'A'-1		;make binary
	ld	(de),a		;put it
	call	getch		;start file name
	jp	c,gnam2		;drive only
	ucase
	inc	b
;;
pname:				;primary name
	inc	de
	ld	(de),a
	call	getch
	ret	c
	cp	blank
	ret	z
	ucase
	cp	period
	jr	z,ename
	dec	b
	jp	nz,pname	;ok
	jp	gnam2		;if 9 char
;;
ename:	ld	hl,(fcbs?)	;get FCB
	ld	de,9		;ext offset
	add	hl,de
	ex	de,hl
	ld	b,3
;;
exten:	call	getch		;file name extension
	ret	c
	cp	blank
	ret	z
	ucase
	ld	(de),a
	inc	de
	dec	b
	jp	nz,exten
	ret			;done
;
	.8080
fnflag	set	true
	.z80
	endif
around:				;;gfname
	endm
;;
;;*********************************************************
;;
hexhl	macro
;;	13 March 1985
;;	Inline macro to convert ASCII hex characters
;;	in buffer to a 16-bit binary number in hl.
;;	Character string is addressed by pointr.
;;	Carry flag set if invalid hex character found.
;;
;;	Macros needed:	readb,ucase
;;
	local	around,rdhl2,nib?
	call	rdhl?
;;
	if	not hxflag	;only one copy
	jp	around
rdhl?:
	ld	hl,0		;start with 0
rdhl2:
;	Get character from console buffer
	call	getch
	ccf
	ret	nc		;end of line
	ucase			;make uppercase
	call	nib?		;to binary
	ret	c		;error
	add	hl,hl		;* 2
	add	hl,hl		;* 4
	add	hl,hl		;* 8
	add	hl,hl		;* 16
	or	l		;combine new
	ld	l,a		;put back
	jr	rdhl2		;next
;
;	Convert ASCII to binary
;
nib?:
	sub	'0'		;ASCII bias
	ret	c		;< 0
	cp	'F'-'0'+1
	ccf
	ret	c		;> F
	cp	10
	ccf
	ret	nc		;a number 0 - 9
	sub	'A'-'9'-1
	cp	10
	ret
	.8080
hxflag	set	true		;only one copy
	.z80
	endif
around:				;;hexhl
	endm
;;
;;*********************************************************
;;
hldec	macro
;;	16 March 1985
;;	Inline macro to print HL as decimal
;;
;;	Macros needed:	pchar,(sbc)
;;			sbc is converted to:	or	a
;;						sbc	hl,de
;;
	local	around,subtr,subt2,nzero
	call	hldc2?
	if	not deflag
	jp	around
hldc2?:	push	hl
	push	de
	push	bc
	ld	b,0		;;leading-zero flag
	ld	de,-10000	;;two's complement
	call	subtr		;;ten thousands
	ld	de,-1000
	call	subtr		;;thousands
	ld	de,-100
	call	subtr		;;hundreds
	ld	de,-10
	call	subtr		;tens
	ld	a,l
	add	a,'0'		;;ASCII bias
	pchar
	pop	bc
	pop	de
	pop	hl
	ret
;;
;;	subtract powers of ten and count
;;
subtr:	ld	c,'0'-1		;ASCII count
subt2:	inc	c
	add	hl,de
	jp	c,subt2		;keep going
;;
;;	one too many, add one back
;;	by subtracting complement
	or	a
	sbc	hl,de
	ld	a,c		;;get count
;;
;;	check for zero
;;
	cp	'1'		;;<1?
	jp	nc,nzero	;;no
	ld	a,b		;;check zero flag
	or	a		;;set ?
	ld	a,c		;;restore
	ret	z		;;skip leading 0
	pchar
	ret
;;
;;	set flag for nonzero character
;;
nzero:	ld	b,0ffh
	pchar
	ret
	.8080
deflag	set	true
	.z80
	endif
around:				;;hldec
	endm
;;
;;*********************************************************
;;
lchar	macro	par
;;	13 March 1985
;;	Inline macro to send one char to list
;;	optional par is loaded into A.
;;
;;	Macro needed:	sysf
;;
;;	Usage:		lchar	'*'
;;			lchar	cr
;;			lchar
;;
	local	around
	if	not nul par
	ld	a,par
	endif
	call	lch2?
	if	not loflag
	jp	around
lch2?:	sysf	5,ae		;list char
	.8080
loflag	set	true
	.z80
	endif
around:				;;lchar
	endm
;;
;;*********************************************************
;;
ldfile	macro	fcb,pointr,char
;;	15 March 1985
;;	Inline macro to load a disk file into
;;	memory starting at pointr.
;;	Pointr initialy points to memory buffer.
;;	Place buffer at end of program.
;;	HL points to end of loaded program.
;;	Optional 3rd parameter is printed after
;;	each sector is read.
;;	CCP area may be overlaid but
;;	FDOS is protected.
;;	Carry flag is set if file too big.
;;	DMA address is reset to 80h on exit.
;;
;;	Macros needed:	setdma,reads
;;
;;	Usage:		ldfile	fcb1,dbuffp,'*'
;;			ldfile	fcb1,dbuffp
;;
load2?:	ld	hl,(pointr)
	ex	de,hl		;move to DE
	setdma			;set next sector
	reads	fcb,char
	jp	nz,load3?	;done if nonzero
	ld	hl,(pointr)
	ld	de,80h		;one sector
	add	hl,de
	ld	(pointr),hl	;save pointer
;
;	see if file is entering CCP area
;
	ld	a,(7)		;FDOS
	sub	2		;2 bloks down
	cp	h		;file to big ?
	jp	nc,load2?	;no keep going
load3?:	push	af
	setdma	80h		;reset
	pop	af
				;;ldfile
	endm
;;
;;*********************************************************
;;
make	macro	pointr
;;	15 March 1985
;;	Inline macro to create a new disk file.
;;	pointr refers to file control block.
;;	Extent and current record number are zeroed.
;;
;;	Macros needed:	sysf,errorm
;;
	local	around
	ld	de,pointr
	xor	a		;zero
	ld	(pointr+12),a	;extent
	ld	(pointr+32),a	;current record
	call	make2?
	inc	a		;0=ok, ff means error
	jp	nz,around
	errorm	'No directory space',done
	if	not mkflag
make2?:	sysf	22		;make new disk file
	.8080
mkflag	set	true		;only one copy
	.z80
	endif
around:				;;make
	endm
;;
;;*********************************************************
;;
move	macro	from,to,bytes
;;
;;	updated:	13 March 1985
;;	inline macro to move text
;;
	local	around,mesg
	push	hl
	push	de
	push	bc
	if	not nul to
	ld	de,to
	endif
	if	nul bytes	;;string move
	ld	hl,mesg		;;test
	ld	bc,around-mesg
	else			;;not string move
	if	not nul from
	ld	hl,from
	endif
	ld	bc,bytes
	endif			;;string/not string
	call	move2?
	pop	bc
	pop	de
	pop	hl
	if	not mvflag or nul bytes
	jp	around
	endif
;
	if	not mvflag
;
move2?:	ld	a,(hl)		;get it
	ld	(de),a		;put it
	inc	hl		;from
	inc	de		;to
	dec	bc		;byte count
	ld	a,c
	or	b
	jr	nz,move2?	;not done
	ret
;
	.8080
mvflag 	set	true		;;one copy
	.z80
	endif			;;not mvflag
	if	nul bytes
mesg:
	db	from		;;text
	endif
;
around:				;;move
	endm
;;
;;*********************************************************
;;
mult	macro	times
;;	16 March 1985
;;	Inline macro to multiply value in HL times.
;;	Parameter should be a power of 2.
;;	0 and 1 are valid operands.
;;	Parameter is omitted when A has multiplier
;;
	local	loop,around,notz
	push	bc
	if	nul times
	ld	b,a
	else
	ld	b,times
	endif
	call	mult2?
	pop	bc
	if	not mlflag
	jp	around
;;
mult2?:	ld	a,b
	or	a		;;zero ?
	jp	nz,notz		;; no
	ld	l,a
	ld	h,a		;;HL=0
	ret
;;
notz:	rra			;;times 1
	ret	c
	ld	b,a
;;
loop:	add	hl,hl		;;times 2
	ld	a,b
	rra
	ld	b,a
	jr	nc,loop
	ret
;;
	.8080
mlflag	set	true		;;one copy
	.z80
	endif
around:				;;mult
	endm
;;
;;*********************************************************
;;
open	macro	pointr,where
;;	13 March 1985
;;	Inline macro to open an existing disk file.
;;	POINTR refers to file control block (FCB).
;;	Extent and current record number are zeroed.
;;	Branch to location WHERE if file not found or
;;	print error message and branch to DONE otherwise.
;;
;;	Macros needed:	sysf,errorm
;;
	local	around
	ld	de,pointr
	xor	a		;zero
	ld	(pointr+12),a	;extent
	ld	(pointr+32),a	;current record
	call	open2?
	inc	a		;0 = ok, ff means error
	jp	nz,around
	if	nul where
	errorm	'No source file',done
	else
	jp	where
	endif
	if	not opflag
open2?:	sysf	15		;open disk file
	.8080
opflag	set	true		;only one copy
	.z80
	endif
around:				;;open
	endm
;;
;;*********************************************************
;;
outhex	macro	reg
;;	13 March 1985
;;	Inline macro to convert binary number in
;;	reg to two hex characters and print them.
;;	byte initially in A if reg is omitted.
;;
;;	Macro needed:	pchar
;;
	local	around,hex1?,hex2?
	if	not nul reg
	ld	a,reg
	endif
	call	outhx?
	if	not cxflag
	jp	around
outhx?:	push	bc		;save
	ld	c,a
	rra
	rra
	rra
	rra
	call	hex1?		;high byte
	ld	a,c
	call	hex1?		;low byte
	ld	a,c		;restore
	pop	bc
	ret
hex1?:	and	0fh		;output hex byte
	add	a,'0'		;make ASCII
	cp	'9'+1		;0-9 ?
	jr	c,hex2?		;yes
	add	a,'A'-'9'-1	;make A-F
hex2?:
	pchar			;to console
	ret
	.8080
cxflag	set	true
	.z80
	endif
around:				;;outhex
	endm
;;
;;*********************************************************
;;
outhl	macro
;;	16 March 1985
;;	Inline macro to display HL in hex.
;;
;;	Macro needed:	outhex
;;
	local	over
	ld	a,h
	or	a
	jp	z,over
	outhex	h
over:	outhex	l
				;;outhl
	endm
;;
;;*********************************************************
;;
pchar	macro	par
;;	13 March 1985
;;	Inline macro to print one console character 
;;	Parameter, if present, is loaded into A.
;;
;;	Macro needed:	sysf
;;
;;	Usage:		pchar
;;			pchar	'*'
;;
	local	around
	if	not nul par
	ld	a,par
	endif
	call	pch2?
	if	not coflag
	jp	around
pch2?:	sysf	2,ae
	.8080
coflag	set	true		;only one copy
	.z80
	endif
around:				;;pchar
	endm
;;
;;*********************************************************
;;
pfname	macro	fcb
;;	15 March 1985
;;	Inline macro to print a file name as
;;	FIRST.EXT
;;	fcb is file control block.
;;
;;	Macros needed:	pchar,print,user
;;
;;	Updated:	18 Sep. 1985
;;	1.02		added with drive name and user
;;
	local	pfna2?,pfna3?,pfna4?,pfna5?,pfna6?
	push	hl
	push	bc
	ld	a,(fcb)		;;get drive name
	and	0fh		;;delete user number
	or	a		;;default drive ?
	jr	nz,pfna4?	;;no -> skip
	ld	a,(4)		;;then get it
	inc	a		;;adjust
pfna4?:	add	a,'A'-1		;;Bias for drive number
	pchar			;;print drive number
	user	0ffh		;;get current user
	and	0fh		;;delete bit 4-7
	sub	10		;;more than 10
	jr	nc,pfna5?	;;yes -> skip
	add	a,10
	jr	pfna6?
pfna5?:	push	af		;;save number
	pchar	'1'
	pop	af
pfna6?:	add	a,'0'		;;lsb uf user number
	pchar
	pchar	':'
	ld	b,8		;name lenght
	ld	hl,fcb+1	;start
pfna3?:	ld	a,(hl)		;get char
	cp	blank
	jr	z,pfna2?	;end
	pchar
	inc	hl
	dec	b
	jr	nz,pfna3?
pfna2?:	pop	bc
	pop	hl
	pchar	'.'
	print	fcb+9,3		;exten
				;;pfname
	endm
;;
;;*********************************************************
;;
print	macro	text,bytes
;;	13 March 1985
;;	Inline macro to print string on console.
;;	text is address of string, bytes is the lenght.
;;	text may be in quotes if bytes is omitted.
;;
;;	Macro needed:	pchar
;;
;;	Usage:		print	fcb1+1,11
;;			print	'end of file'
;;			print	<cr,lf,'message'>
;;			print	,12
;;
	local	around,mesg
	push	hl
	push	bc
	if	nul bytes
	ld	hl,mesg
	ld	b,around-mesg
	else
	if	not nul text
	ld	hl,text
	endif
	ld	b,bytes
	endif
	call	pbuf?
	pop	bc
	pop	hl
	if	not prflag or nul bytes
	jp	around
	endif
	if	not prflag
pbuf?:	ld	a,(hl)
	pchar
	inc	hl
	dec	b
	jr	nz,pbuf?
	ret
	.8080
prflag	set	true
	.z80
	endif
	if	nul bytes
mesg:	db	text
	endif
around:				;;print
	endm
;;
;;*********************************************************
;;
protec	macro	pointr
;;	16 March 1985
;;	Inline macro to protect FCB at pointr
;;
;;	Macro needed:	sysf
;;
	local	around,prot2?
	ld	de,pointr
	ld	a,(pointr+9)	;extension
	or	80h		;set R/O
	ld	(pointr+9),a
	call	prot2?
	jp	around
prot2?:	sysf	30
around:				;;protec
	endm
;;
;;*********************************************************
;;
readb	macro
;;	13 March 1984
;;	Inline macro to input a line from console
;;	Buffer is located at end of macro
;;	Get characters from buffer by calling 
;;	global subroutine getch in this macro
;;	Buffer pointer RBUFP is also global.
;;
	local	around,rbufm,rbuf,rbufc,rbufe
	call	rdb2?
	if	not rcflag
	jp	around
rdb2?:
	push	hl
	push	de
	push	bc
	ld	de,rbufm
	ld	c,10
	call	bdos
	ld	hl,rbufm+2
	ld	(rbufm-2),hl
	pop	bc
	pop	de
	pop	hl
	ret

;	global routine to get char. from buffer
getch:
	ld	a,(rbufc)	;get count
	sub	1		;dec with carry
	ret	c		;no more char
	ld	(rbufc),a
	push	hl
	ld	hl,(rbufp)
	ld	a,(hl)		;get char
	inc	hl		;next
	ld	(rbufp),hl
	pop	hl
	ret
;
	.8080
rcflag	set	true		;only one copy
	.z80
rbufp:	dw	rbuf		;buffer pointer
;	consol buffer address
rbufm:	db	rbufe-rbuf	;max lenght
rbufc:	ds	1		;actual lenght
rbuf:	ds	16		;buffer start
rbufe:				;buffer end
	endif
around:				;;readb
	endm
;;
;;*********************************************************
;;
readch	macro	reg
;;	13 March 1985
;;	Inline macro to read one character from
;;	the console; character is returned in register
;;	A unless a second parameter is given.
;;
;;	Macro needed:	sysf
;;
;;	Usage:		readch
;;			readch	c
;;
	local	around
	call	rdch?
	if	not nul reg
	ld	reg,a
	endif
	if	not ciflag
	jp	around
rdch?:	sysf	1
	.8080
ciflag	set	true		;only one copy 
	.z80
	endif
around:				;;readch
	endm
;;
;;*********************************************************
;;
reads	macro	pointr,star
;;	15 March 1985
;;	Inline macro to read a disk sector.
;;	POINTR refers to file control block (FCB)
;;	Optional second parameter is symbol
;;	to be printed after sector is read.
;;	Zero flag is reset if end of file.
;;
;;	Macros needed:	sysf,pchar
;;
;;	Usage:		reads
;;			reads	'*'
;;
	local	around
	if	not nul star
	pchar	star		;to console
	endif
	if	not nul pointr
	ld	de,pointr
	endif
	call	read2?
	or	a		;set flags
	if	not rdflag
	jp	around
read2?:	sysf	20		;read disk sector
	.8080
rdflag	set	true		;only one copy
	.z80
	endif
around:				;reads
	endm
;;
;;*********************************************************
;;
rename	macro	pointr
;;	15 March 1985
;;	Inline macro to rename an existing disk file.
;;	pointr refers to original name.
;;	New name is at pointr + 10 hex.
;;
;;	Macros needed:	sysf,print,unprot,crlf
;;
	local	around,ren2?
	ld	de,pointr
	ld	a,(pointr+9)
	or	(80h)		;file R/O ?
	jp	z,ren2?		;no
	unprot	pointr		;make R/W
ren2?:	call	renam?
	crlf
	print	pointr+1,11
	print	'===>'
	print	pointr+11h,11
	if	not rnflag
	jp	around
renam?:	sysf	23		;rename file
	.8080
rnflag	set	true		;only one copy
	.z80
	endif
around:				;;rename
	endm
;;
;;*********************************************************
;;
rvsoff	macro
;;	17 MArch 1985
;;	Inline macro to turn off reverse screen
;;
;;	Macros needed:		pchar
;;
	local	around
	call	rvsof?
	if	not offlag
	jp	around
rvsof?:	pchar	esc
	pchar	'N'		;;turn off reverse
	ret
;;
	.8080
offlag	set	true		;;only one copy
	.z80
	endif			;;offlag
around:				;;rvsoff
	endm
;;
;;*********************************************************
;;
rvson	macro
;;	17 March 1985
;;	Inline macro to turn on reverse screen
;;
;;	Macros needed:		pchar
;;
	local	around
	call	rvson?
	if	not onflag
	jp	around
rvson?:	pchar	esc
	pchar	'A'
	ret
;;
	.8080
onflag	set	true
	.z80
	endif			;;onflag
around:				;;rvson
	endm
;;
;;*********************************************************
;;
setdma	macro	pointr
;;	13 March 1985
;;	Inline macro to set dma address where
;;	next sector will be read or written.
;;
;;	Macro needed:	sysf
;;
	local	around
	if	not nul pointr
	ld	de,pointr
	endif
	call	dma2?
	if	not dmflag
	jp	around
dma2?:	sysf	26		;set dma address
	.8080
dmflag	set	true		;only one copy
	.z80
	endif
around:				;;setdma
	endm
;;
;;*********************************************************
;;
setup2	macro
;;	15 March 1985
;;	Inline macro to open two disk files.
;;	Input file is the first parameter of command
;;	line. The file control is FCB1 at 5C hex.
;;	The output file is the second parameter.
;;	The file control block is initialy FCB2 at
;;	6C hex. The destination file name is moved into
;;	the macro area.
;;	If only one file is entered or both are the same,
;;	the second file is typed $$$. Macro CLOSE
;;	will rename original file BAK and give original
;;	name to the destination file when S2FLAG is true.
;;
;;	Macros needed:	move,open,make,delete,errorm,ambig
;;			compar
;;
	local	around,set2?,set3?,set4?
	.8080
s2flag	set	true		;used by macro CLOSE
	.z80
;
	ld	a,(fcb2+1)	;second parameter
	cp	blank		;anything ?
	jp	nz,set4?	;yes
; Duplicate file name and type, keep disk name
	move	fcb1+1,fcb2+1,11 ;keep disk
set4?:	ambig	fcb1,fcb2	;fix ??? in name
	compar	fcb1,fcb2,12	;both the same ?
	jp	z,dupnm?	;yes
set2?:	move	fcb2,dfcb,16	;new destination
	open	fcb1		;source file
	open	dfcb,set3?	;destination
set3?:	delete	dfcb		;existing file name
	make	dfcb		;new one
	jp	around		;error messages
dupnm?:	ld	a,true		;set dup flag
	ld	(dupl),a
	move	'$$$',fcb2+9	;source file
	jp	set2?		;continue
;
dupl:	db	false		;duplicate name flag
;
;	File control block for destination file
;
dfcb:	ds	33		;file fcb2
;				;;continue main code
around:				;;setup2
	endm
;;
;;*********************************************************
;;
sysf	macro	func,ae
;;	13 March 1985
;;	Macro to generate BDOS calls.
;;	func is BDOS function number for C.
;;	THIS IS NOT AN INLINE MACRO.
;;	Move A to E if there is a second parameter.
;;
;;	Usage:	open:	sysf	15
;;		pchar:	sysf	2,ae
;;
	push	hl
	push	de
	push	bc
	ld	c,func
	if	not nul ae
	ld	e,a
	push	af
	call	bdos
	pop	af
	else
	call	bdos
	endif
	pop	bc
	pop	de
	pop	hl
	ret
				;;sysf
	endm
;;
;;*********************************************************
;;
ucase	macro	reg
;;	13 March 1984
;;	Inline macro to convert a character in any
;;	register to uppercase.
;;	Omit parameter for register A.
;;
;;	Usage:	ucase
;;		ucase	c
;;
	local	notup?
	if	not nul reg
	push	af		;save
	ld	a,reg		;get value
	endif
	cp	'Z'+7		;uppercase ?
	jr	c,notup?	;no
	and	5fh		;make uppercase
notup?:
	if	not nul reg
	ld	reg,a		;put back	
	pop	af		;restore
	endif
				;;ucase
	endm
;;
;;*********************************************************
;;
unprot	macro	pointr
;;	15 March 1985
;;	Inline macro to convert R/O file to R/W.
;;	pointr refers to file control block.
;;
;;	Macro needed:	sysf
;;
	local	around
	ld	de,pointr
	ld	a,(pointr+9)	;load from file type
	and	7fh		;set for R/W
	ld	(pointr+9),a	;store at beginning of file type
	call	unpr2?
	if	not unflag
unpr2?:	sysf	30		;set file attributes
	.8080
unflag	set	true		;only one copy
	.z80
	endif
around:				;unprot
	endm
;;
;;*********************************************************
;;
upper	macro	reg
;;	13 March 1985
;;	Macro to move the upper 4 bits of the
;;	accumulator to the lower 4 bits. The
;;	new upper 4 bits are zeored.
;;	Use this macro to isolate the left
;;	character of packed BCD numbers.
;;
;;	Usage:	upper		;rotate down
;;		outhex		;print
;;
	if	not nul reg
	push	af		;save A
	ld	a,reg		;move to A
	endif
	rra			;move to lover half
	rra
	rra
	rra
	and	0fh		;mask upper
	if	not nul reg
	ld	reg,a		;put back
	pop	af		;restore
	endif
				;;upper
	endm
;;
;;*********************************************************
;;
user	macro	num
;;	18 September 1985
;;	Inline macro to get or change user number
;;
;;	Usage:	user	0ffh	;;for get a user code
	local	around
;;
	if	num		;;user number
	ld	e,num
	call	user?
	else
	call	user?
	endif
	if	not usflag
	jp	around

user?:	sysf	32
	.8080
usflag	set	true		;;only one copy
	.z80
	endif
around:				;;user
	endm
;;
;;
;;*********************************************************
;;
versn	macro	num
  	local	around
;;	Updated:	12 March 1985
;;	Inline macro to embed version number.
;;	NUM is enclosed in quotes.
;;
;;	Usage:	VERSN	'XX.XX.XX.NAME'
;;
	jp	around
	db	'Ver.',num
around:				;;versn
	endm
;;
;;*********************************************************
;;
wrfile	macro	fcb,pointr,star,opt
;;	15 March 1985
;;
;;	Updated:	18 September 1985
;;
;;	1.01		11 Aug 1985
;;			entry changed
;;
;;	1.02		18 Sep. 1985
;;			corrected sector calculating
;;
;;	1.03		19 Sep. 1985
;;			entry corrected
;;
;;	Inline macro to write a disk file from
;;	a memory image. Buffer starts at pointr + 2.
;;	pointr marks end of file.
;;	Optional star symbol is printed for each sector.
;;
;;	Macros needed:	writes,sbc,setdma,errorm
;;
;;	NB !!!!!!!!!!	or	a
;;			sbc	hl,de
;;
;;	Usage:	wrfile	fcb,pointr,'*',1	;de = end, hl = start
;;		wrfile	fcb,pointr,,1		;de = end, hl = start
;;		wrfile	fcb,pointr		;buffer start at pointr+2,
;;						;(pointr)=end
;;
	local	wrfil?,even?,low?
	if	nul opt
	ld	hl,(pointr)	;end
	ex	de,hl		;to DE
	ld	hl,pointr+2	;start
	endif
	ld	(pointr),hl
	ex	de,hl
	or	a
	sbc	hl,de		;program lenght
	ld	a,l
	ld	l,h		;just upper part
	ld	h,0
	add	hl,hl		;doubl = # sectors
	or	a		;odd # of sectors ?
	jp	z,even?		;no
	add	a,a		;;sector lenght is 128 bytes
	jr	nc,low?		;;just one sector inc.
	inc	hl		;;two sectors inc.
low?:	inc	hl
even?:	push	bc
	ld	b,h
	ld	c,l
wrfil?:	ld	hl,(pointr)
	ex	de,hl		;move to DE
	setdma			;next sector
	writes	fcb,star
	ld	hl,(pointr)
	ld	de,80h		;one sector
	add	hl,de		;next location
	ld	(pointr),hl
	dec	bc		;number of sectors
	ld	a,c
	or	b
	jp	nz,wrfil?
	pop	bc
				;;wrfile
	endm
;;
;;*********************************************************
;;
writes	macro	pointr,star
;;	15 March 1985
;;	Inline macro to write a disk sector
;;	pointr refers to file control block.
;;	star is symbol to print for each sector.
;;
;;	Macros needed:	sysf,pchar,errorm
;;
	local	around
	if	not nul star
	pchar	star
	endif
	if	not nul pointr
	ld	de,pointr
	endif
	call	writ2?
	or	a		;set flag
	if	wrflag
	jp	nz,nroom?
	else			;first time
	jp	z,around	;ok
nroom?:	errorm	'No disk space',done
;
writ2?:	sysf	21		;write disk sector
	.8080
wrflag	set	true		;only one copy
	.z80
	endif			;;wrflag
around:				;;writes
	endm
;;
;;*********************************************************
;;

«eof»