⟦be8e9c3d2⟧

TextFile


;
; CCC.ASM (C.CCC)  v1.45				11/22/81
;
; NOTE: If you are running under MP/M II, be sure to set the MPM2
; equate to 1.
;
; This is the BDS C run-time package. Normally, it resides at
;    the start of the TPA (at address BASE+100h, where BASE is either
;    0000h or 4200h depending on CP/M implementation.) The code
;    generated by the compiler ALWAYS sits immediately after the end of
;    this run-time package code.
;
; Equate statements in CAPITAL letters may be customized by the
;    user in order to change a) the origin of the run-time package,
;    and b) the origin of the run-time RAM area. If you will be
;    generating code to run in a non-CP/M environment, set the CPM
;    equate to zero and make sure to set the ORIGIN, RAM and
;    EXITAD equates to fit your custom run-time configuration.
;
; The "lxi sp,0" instruction at the start is replaced by the sequence:
;
;		lhld	base+6
;		sphl
;
;    by CLINK at link time, unless the -t option is used with CLINK,
;    in which case the "lxi	sp" remains there and the value used to
;    initialize the SP is the argument given to the "-t" option.
;

	page 76
	title 'BDS C Run-Time Module (c.ccc)  v1.45   11/22/81'


CPM:	EQU	1	;True if to be run under CP/M or MP/M

MPM2:	EQU	0	;True ONLY if running under MP/M II

DMAVIO:	EQU	1	;True if using DMA video library routines and
			;need parameters initialized
	IF CPM
base:	equ	0	;start of ram in system (either 0 or 4200h for CP/M)
bdos:	equ	base+5	;rest of these used by CP/M-based configurations.
tpa:	equ	base+100h
nfcbs:	equ	8	;maximum # of files open at one time
tbuff:	equ	base+80h
origin:	equ	tpa
exitad:	equ	base	;warm boot location
	ENDIF

	IF NOT CPM		;fill in the appropriate values...
ORIGIN:	EQU	NEWBASE		;Address at which programs are to run
RAM:	EQU	WHATEVER	;R/W memory area for non-CP/M configurations
				;  (default: just after C.CCC under CP/M)
EXITAD:	EQU	WHENDONE	;where to go when done executing
	ENDIF

;
; The location of the jump vectors and utility routines must remain
; constant relative to the beginning of this run-time module.
;
; Do NOT change ANYTHING between here and the start of the
; "init" routine!!!!!!!!
;

	org	origin
	lxi	sp,0	;this is changed by CLINK to lhld	base+5h
	nop		;this first is usually turned into sphl by CLINK

	nop! nop	;Simple initialization or patches may be
	nop! nop! nop	;inserted here, but better to do all that
	nop! nop! nop	;in the "init" routine

	call	init	;do ARGC & ARGV processing, plus misc. initializations
	call	main	;go crunch!!!!
	jmp	vexit	;close open files and reboot

extrns:	ds	2		;set by CLINK to external data base address
cccsiz:	dw	main-origin	;size of this code (for use by CLINK)
codend:	ds	2		;set by CLINK to (last addr of code + 1)
freram:	ds	2		;set by CLINK to (last addr of externals + 1)

;
; Jump vectors to some file i/o utility routines:
;

error:	jmp	verror	;loads -1 into HL and returns
exit:	jmp	vexit	;close all open files and reboot

	IF	CPM
close:	jmp	vclose	;close a file
setfcb:	jmp	vsetfcb	;set up fcb at HL given filename at DE
fgfd:	jmp	vfgfd	;return C set if file fd in A not open
fgfcb:	jmp	vfgfcb	;compute address of internal fcb for fd in A
	ENDIF

	IF	NOT CPM	;if not under CP/M, file I/O routines
close:	jmp	verror	;are not used.
setfcb:	jmp	verror
fgfd:	jmp	verror
fgfcb:	jmp	verror
	ENDIF

	ds	16	;reserved

	IF	CPM
setfcb3:
	mov	m,a	;this is a patch from the "vsetfcb" routine,
	inx	h	;which causes the random record bytes of the
	mov	m,a	;fcb being initialized to be zeroed. (Former
	inx	h	;versions had a "ds 30" above, so this keeps
	mov	m,a	;all the addresses consistent between this 
	pop	d	;and earlier 1.4's)
	pop	b
	ret

patchnm:
	call	setnm	;another patch from "vsetfcb"
	jmp	setnm3
	ENDIF

	IF	NOT CPM
	ds	14	;keep addresses the same for non-CP/M implementations
	ENDIF

;
; The following routines fetch a variable value from either
; the local stack frame or the external area, given the relative
; offset of the datum required immediately following the call;
; for the "long displacement" routines, the offset must be 16 bits,
; for the "short displacement" routines, the offset must be 8 bits.
;

;
; long-displacement, double-byte external indirection:
;
;	format:	call ldei		; get 16-bit value in HL
;		dw offset_from_extrns	; >= 256
;

ldei:	pop	h	;get address of offset
	mov	e,m	;put offset in DE
	inx	h
	mov	d,m
	inx	h 		
	push	h	;save return address
	lhld	extrns	;add offset to external area base
	dad	d
	mov	a,m	;and get the value into HL
	inx	h
	mov	h,m
	mov	l,a
	ret

;
; short-displacement, double-byte external indirection:
;
;	format:		call sdei		; get 16-bit value in L
;			db offset_from_extrns	; < 256
;

sdei:	pop	h
	mov	e,m
	inx	h
	push	h
	mvi	d,0
	lhld	extrns
	dad	d
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	ret

;
; long-displacement, single-byte external indirection:
;
;	format:		call	lsei		; get 8-bit value in L
;			dw offset_from_extrns	; >= 256
;

lsei:	pop	h
	mov	e,m
	inx	h
	mov	d,m
	inx	h
	push	h
	lhld	extrns
	dad	d
	mov	l,m
	ret

;
; short-displacement, single-byte external indirection:
;
;	format:		call	ssei		; get 8-bit value in L
;			db offset_from_externs	; < 256
;

ssei:	pop	h
	mov	e,m	
	inx	h
	push	h
	mvi	d,0
	lhld	extrns
	dad	d
	mov	l,m
	ret

;
; long-displacement, double-byte local indirection:
;
;	format:		call	ldli		; get 16-bit value in HL
;			dw offset_from_BC	; >= 256
;

ldli:	pop	h
	mov	e,m
	inx	h
	mov	d,m
	inx	h
	push	h
	xchg
	dad	b
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	ret

;
; short-displacement, double-byte local indirection:
;
;	format:		call	sdli		; get 16-bit value in HL
;			db offset_from_BC	; < 256
;

sdli:	pop	h
	mov	e,m
	inx	h
	push	h
	xchg
	mvi	h,0
	dad	b
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	ret

;
; Flag conversion routines:
;

pzinh:	lxi	h,1	;return HL = true if Z set
	rz
	dcx	h
	ret

pnzinh:	lxi	h,0	;return HL = false if Z set
	rz
	inx	h
	ret

pcinh:	lxi	h,1	;return HL = true if C set
	rc
	dcx	h
	ret

pncinh:	lxi	h,0	;return HL = false if C set
	rc
	inx	h
	ret

ppinh:	lxi	h,1	;return HL = true if P (plus) flag set
	rp
	dcx	h
	ret

pminh:	lxi	h,1	;return HL = true if M (minus) flag set
	rm
	dcx	h
	ret

pzind:	lxi	d,1	;return DE = true if Z set
	rz
	dcx	d
	ret

pnzind:	lxi	d,0	;return DE = false if Z set
	rz
	inx	d
	ret

pcind:	lxi	d,1	;return DE = true if C set
	rc
	dcx	d
	ret

pncind:	lxi	d,0	;return DE = false if C set
	rc
	inx	d
	ret

ppind:	lxi	d,1	;return DE = true if P (plus) flag set
	rp
	dcx	d
	ret

pmind:	lxi	d,1	;return DE = true if M (minus) flag set
	rm
	dcx	d
	ret
	

;	
; Relational operator routines: take args in DE and HL,
; and return a flag bit either set or reset.
;
; ==, >, < :
;

eqwel:	mov	a,l	;return Z if HL == DE, else NZ
	cmp	e
	rnz		;if L <> E, then HL <> DE
	mov	a,h	;else HL == DE only if H == D
	cmp	d
	ret

blau:	xchg		;return C if HL < DE, unsigned
albu:	mov	a,d	;return C if DE < HL, unsigned
	cmp	h
	rnz		;if D <> H, C is set correctly
	mov	a,e	;else compare E with L
	cmp	l
	ret

bgau:	xchg		;return C if HL > DE, unsigned
agbu:	mov	a,h	;return C if DE > HL, unsigned
	cmp	d
	rnz		;if H <> D, C is set correctly
	mov	a,l	;else compare L with E
	cmp	e
	ret

blas:	xchg		;return C if HL < DE, signed
albs:	mov	a,h	;return C if DE < HL, signed
	xra	d
	jp albu		;if same sign, do unsigned compare
	mov	a,d
	ora	a
	rp		;else return NC if DE is positive and HL is negative
	stc		;else set carry, since DE is negative and HL is pos.
	ret

bgas:	xchg		;return C if HL > DE, signed
agbs:	mov	a,h	;return C if DE > HL, signed
	xra	d
	jp	agbu	;if same sign, go do unsigned compare
	mov	a,h
	ora	a
	rp		;else return NC is HL is positive and DE is negative
	stc
	ret		;else return C, since HL is neg and DE is pos


;
; Multiplicative operators: *, /, and %:
;

smod:	mov	a,d	;signed MOD routine: return (DE % HL) in HL
	push	psw	;save high bit of DE as sign of result
	call	tstn	;get absolute value of args
	xchg
 	call	tstn
	xchg
	call	usmod	;do unsigned mod
	pop	psw	;was DE negative?
	ora	a	;if not,
	rp		;	all done
	mov	a,h	;else make result negative
	cma
	mov	h,a
	mov	a,l
	cma
	mov	l,a
	inx	h
	ret

	nop		;maintain address compatibility with some
	nop		; pre-release v1.4's.

usmod:	mov	a,h	;unsigned MOD: return (DE % HL) in HL
	ora	l
	rz
	push	d
	push	h
	call	usdiv
	pop	d
	call	usmul
	mov	a,h
	cma
	mov	h,a
	mov	a,l
	cma 
	mov	l,a
	inx	h
	pop	d
	dad	d
	ret

smul:	xra	a	;signed multiply: return (DE * HL) in HL
	sta	tmp
	call	tstn
	xchg
	call	tstn
	call	usmul
smul2:	lda	tmp
	rar
	rnc
	mov	a,h
	cma
	mov	h,a
	mov	a,l
	cma
	mov	l,a
	inx	h
	ret

tstn:	mov	a,h
	ora	a
	rp
	cma
	mov	h,a
	mov	a,l
	cma
	mov	l,a
	inx	h
	lda	tmp
	inr	a
	sta	tmp
	ret

usmul:	push	b	;unsigned multiply: return (DE * HL) in HL
	call	usm2
	pop	b
	ret

usm2:	mov	b,h
	mov	c,l
	lxi	h,0
usm3:	mov	a,b
	ora	c
	rz
	mov	a,b
	rar
	mov	b,a
	mov	a,c
	rar
	mov	c,a
	jnc	usm4
	dad	d
usm4:	xchg
	dad	h
	xchg
	jmp	usm3

usdiv:	mov	a,h	;unsigned divide: return (DE / HL) in HL
	ora	l	;return 0 if HL is 0
	rz
	push	b
	call	usd1
	mov	h,b
	mov	l,c
	pop	b
	ret


usd1:	mvi	b,1
usd2:	mov	a,h
	ora	a
	jm	usd3
	dad	h
	inr	b
	jmp	usd2

usd3:	xchg

usd4:	mov	a,b
	lxi	b,0
usd5:	push	psw
usd6:	call	cmphd
	jc	usd7
	inx	b
	push	d
	mov	a,d
	cma
	mov	d,a
	mov	a,e
	cma
	mov	e,a
	inx	d
	dad	d
	pop	d
usd7:	xra	a
	mov	a,d
	rar
	mov	d,a
	mov	a,e
	rar
	mov	e,a
	pop	psw
	dcr	a
	rz
	push	psw
	mov	a,c
	ral
	mov	c,a
	mov	a,b
	ral
	mov	b,a
	jmp	usd6

sdiv:	xra	a	;signed divide: return (DE / HL) in HL
	sta	tmp
	call	tstn
	xchg
	call	tstn
	xchg
	call	usdiv
	jmp	smul2

cmphd:	mov	a,h	;this returns C if HL < DE
	cmp	d	; (unsigned compare only used
	rc		;  within C.CCC, not from C)
	rnz
	mov	a,l
	cmp	e
	ret

;
; Shift operators  << and >>:
;

sderbl:	xchg		;shift DE right by L bits
shlrbe:	inr	e	;shift HL right by E bits
shrbe2:	dcr	e
	rz
	xra	a
	mov	a,h
	rar
	mov	h,a
	mov	a,l	
	rar
	mov	l,a
	jmp	shrbe2

sdelbl:	xchg		;shift DE left by L bits
shllbe:	inr	e	;shift HL left by E bits
shlbe2:	dcr	e
	rz
	dad	h
	jmp	shlbe2


;
; Routines to 2's complement HL and DE:
;

cmh:	mov	a,h
	cma
	mov	h,a
	mov	a,l
	cma
	mov	l,a
	inx	h
	ret

cmd:	mov	a,d
	cma
	mov	d,a
	mov	a,e
	cma
	mov	e,a
	inx	d
	ret


;
; The following routines yank a formal parameter value off the stack
; and place it in both HL and A (low byte), assuming the caller
; hasn't done anything to its stack pointer since IT was called.
;
; The mnemonics are "Move Arg #n To HL",
; where arg #1 is the third thing on the stack (where the first
; and second things are, respectively, the return address of the
; routine making the call	to here, and the previous return
; address to the routine which actually pushed the args on the
; stack.) Thus, a call	to "ma1toh" would return with the first
; passed parameter in HL and A; "ma2toh" would return the second,
; etc. Note that if the caller has pushed ÆnÅ items on the stack
; before calling "ma ÆxÅ toh", then the Æx-nÅth formal parameter
; value will be returned, not the ÆxÅth.
;

ma1toh:	lxi	h,4	;get first arg
ma0toh:	dad	sp
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	ret

ma2toh:	lxi	h,6	;get 2nd arg
	jmp	ma0toh

ma3toh:	lxi	h,8	;get 3rd arg
	jmp	ma0toh

ma4toh:	lxi	h,10	;get 4th arg
	jmp	ma0toh

ma5toh:	lxi	h,12	;get 5th arg
	jmp	ma0toh

ma6toh:	lxi	h,14	;get 6th arg
	jmp	ma0toh

ma7toh:	lxi	h,16	;get 7th arg
	jmp	ma0toh

;
; This routine takes the first 7 args on the stack
; and places them contiguously at the "args" ram area.
; This allows a library routine to make one call	to arghak
; and henceforth have all it's args available directly
; through lhld's instead of having to hack the stack as it
; grows and shrinks. Note that arghak should be called as the
; VERY FIRST THING a function does, before even pushing BC.
;

arghak:	lxi	d,args	;destination for block move in DE
	lxi	h,4	;pass over two return address
	dad	sp	;source for block move in HL
	push	b	;save BC
	mvi	b,14	;countdown in B
arghk2:	mov	a,m	;copy loop
	stax	d
	inx	h
	inx	d
	dcr	b
	jnz	arghk2	
	pop	b	;restore BC
	ret

;
; UP TO THIS POINT, ABSOLUTELY NO CHANGES SHOULD EVER BE MADE
; TO THIS SOURCE FILE (except for customizing the EQU statements
; at the beginning of the file).
;


;
; This routine is called first to do argc & argv processing (if
; running under CP/M) and some odds and ends initializations:
;

init:	pop	h	;store return address
	shld	tmp2	; somewhere safe for the time being

	IF	CPM
	lxi	h,arglst-2	;set the "argv" that the C main program
	ENDIF
	
	IF	NOT CPM
	lxi	h,0
	ENDIF

	push	h		; will get.

			;Initialize storage allocation pointers:
	lhld	freram	;get address after end of externals
	shld	allocp	;store at allocation pointer (for "sbrk.")
	lxi	h,1000	;default safety space between stack and
	shld	alocmx	; highest allocatable address in memory 
			; (for use by "sbrk".).

			;Initialize random seed:
	lxi	h,59dch	;let's stick something wierd into the
	shld	rseed	;first 16 bits of the random-number seed

			;Initialize I/O hack locations:
	mvi	a,0dbh		;"in" op, for "in xx; ret" subroutine
	sta	iohack
	mvi	a,0d3h		;"out" op for "out xx; ret" subroutine
	sta	iohack+3
	mvi	a,0c9h		;"ret" for above sobroutines
	sta	iohack+2	;the port number is filled in by the
	sta	iohack+5	;"inp" and "outp" library routines.

				;Initialize DMA video parameters:
	IF	DMAVIO		;if we're using DMA video routines,
	lxi	h,0cc00h	;set up default values (may be changed
	shld	pbase		;to whatever suits). Video board address,
	lxi	h,16
	shld	xsize		;# of lines,
	lxi	h,64
	shld	ysize		;# of columns,
	lxi	h,1024
	shld	psize		;and total # of characters on screen
	ENDIF

	IF	CPM	;under CP/M: clear console, process ARGC & ARGV:
	mvi	c,11	;interrogate console status to see if there
	call	bdos	;  happens to be a stray character there...

	ora	a	;(used to be `ani 1'...they tell me this works
	nop		; better for certain bizarre CP/M-"like" systems)

	jz	initzz
	mvi	c,1	;if input present, clear it
	call	bdos

initzz:	lxi	h,tbuff		;if arguments given, process them.
	lxi	d,comlin	;get ready to copy command line
	mov	b,m		;first get length of it from loc. base+80h
	inx	h
	mov	a,b
	ora	a	;if no arguments, don't parse for argv
	jnz	initl
	lxi	d,1	;set argc to 1 in such a case.
	jmp	i5

initl:	mov	a,m	;ok, there are arguments. parse...
	stax	d	;first copy command line to comlin
	inx	h
	inx	d
	dcr	b
	jnz	initl
	xra	a	;place zero following line
	stax	d

	lxi	h,comlin	;now compute pointers to each arg
	lxi	d,1		;arg count
	lxi	b,arglst	;where pointers will all go
	xra	a		;clear "in a string" flag
	sta	tmp1
i2:	mov	a,m	;between args...
	inx	h
	cpi	' '
	jz	i2
	ora	a
	jz	i5	;if null byte, done with list
	cpi	'"'
	jnz	i2a	;quote?
	sta	tmp1	;yes. set "in a string" flag
	jmp	i2b	

i2a:	dcx	h
i2b:	mov	a,l	;ok, HL is a pointer to the start
	stax	b	;of an arg string. store it.
	inx	b
	mov	a,h
	stax	b
	inx	b
	inx	d	;bump arg count
i3:	mov	a,m
	inx	h	;pass over text of this arg
	ora	a	;if at end, all done
	jz	i5
	push	b	;if tmp1 set, in a string 
	mov	b,a	; (so we have to ignore spaces)
	lda	tmp1
	ora	a
	mov	a,b
	pop	b
	jz	i3a
	cpi	'"'	;we are in a string.
	jnz	i3	;check for terminating quote
	xra	a	;if found, reset "in string" flag
	sta	tmp1
	dcx	h
	mov	m,a	;and stick a zero byte after the string
	inx	h	;and go on to next arg
i3a:	cpi	' '	;now find the space between args
	jnz	i3
	dcx	h	;found it. stick in a zero byte
	mvi	m,0
	inx	h
	jmp	i2	;and go on to next arg

i5:	push	d	;all done finding args. Set argc.

	mvi	b,nfcbs	;now initialize all the file info
	lxi	h,fdt	;(just zero the fd table)
i6:	mvi	m,0
	inx	h
	dcr	b
	jnz	i6
	ENDIF

	IF	NOT CPM	;if not under CP/M, force ARGC value	
	lxi	h,1	; of one.
	push	h
	ENDIF

	xra	a
	sta	ungetl	;clear the push-back byte
	sta	lastc	;and last character byte

	lhld	tmp2
	pchl		;all done initializing.

;
; General purpose error value return routine:
;

verror:	lxi	h,-1	;general error handler...just
	ret		;returns -1 in HL

;
; Here are file I/O handling routines, only needed under CP/M:
;

;
; Close any open files and reboot:
;

vexit:
	IF	CPM		;if under CP/M, close all open files
	mvi	a,7+nfcbs	;start with largest possible fd
exit1:	push	psw		;and scan all fd's for open files
	call	vfgfd		;is file whose fd is in A open?
	jc	exit2		;if not, go on to next fd
	mov	l,a		;else close the associated file
	mvi	h,0
	push	h
	call	vclose
	pop	h
exit2:	pop	psw
	dcr	a		;and go on to next one
	cpi	7
	jnz	exit1
	ENDIF

	jmp	exitad		;done closing; now reboot CP/M or whatever.

;
; Close the file whose fd is 1st arg:
;

	IF	CPM	;here comes a lot of CP/M stuff...
vclose:	call	setdma	;library function just jumps here.
	call	ma1toh	;get fd in A
	call	vfgfd	;see if it is open
	jc	verror	;if not, complain
	mov	a,m
	ani	4

	IF	NOT MPM2	;if not MP/M, and
	jz	close2	;the file isn't open for write, don't bother to close
	ENDIF

	IF MPM2		;always close all files under MP/M
	nop
	nop
	nop
	ENDIF

	push	h	;save fd table entry addr
	call	ma2toh	;move arg1 to A
	push	b
	call	vfgfcb	;get the appropriate fcb address
	xchg		;put it in DE
	mvi	c,16	;get BDOS function # for close
	call	bdos	;and do it!
	pop	b
	pop	h
close2:	mvi	m,0	;close logically
	cpi	255	;if 255 comes back, we got problems
	lxi	h,0	
	rnz		;return 0 if OK
	dcx	h	;return -1 on error
	ret

;
; Determine status of file whose fd is in A...if the file
; is not open, return C flag set, else clear C flag:

vfgfd:	call	setdma
	mov	d,a
	sui	8
	rc		;if fd < 8, error
	cpi	nfcbs
	cmc		;don't allow too big an fd either
	rc
	push	d
	mov	e,a	;OK, we have a value in range. Now
	mvi	d,0	;  see if the file is open or not
	lxi	h,fdt
	dad	d
	mov	a,m
	ani	1	;bit 0 is high if file is open
	stc
	pop	d
	mov	a,d
	rz		;return C set if not open
	cmc
	ret		;else reset C and return

;
; Set up a CP/M file control block at HL with the file whose
; simple null-terminated name is pointed to by DE:
; Format for filename must be: "Æwhite spaceÅÆd:Åfilename.ext"
;

vsetfcb:
	call	setdma	;set up an fcb at HL for filename at DE
	push	b
	call	igwsp	;ignore blanks and tabs	
	mvi	b,8
	push	h
	inx	d
	ldax	d
	dcx	d
	cpi	':'	;default disk byte value is 0
	mvi	a,0	; (for currently logged disk)
	jnz	setf1
	ldax	d	;oh oh...we have a disk designator
	call	mapuc	;make it upper case
	sui	'@'	;and fudge it a bit
	inx	d
	inx	d
setf1:	mov	m,a
	inx	h
	call	patchnm	;now set filename and pad with blanks
	ldax	d
	cpi	'.'	;and if an extension is given,
	jnz	setfcb2	
	inx	d
setfcb2 mvi	b,3	;set the extension and pad with blanks
	call	setnm
	xra	a	;and zero the appropriate fields of the fcb
	mov	m,a
	lxi	d,20
	dad	d
	mov	m,a
	inx	h
	jmp	setfcb3	;finish up elsewhere to keep addresses consistent
			;with prior releases

;
; This routine copes up to B characters from memory at DE to 
; memory at HL and pads with blanks on the right:
;

setnm:	push	b
setnm1:	ldax	d
	cpi	'*'	;wild card?
	mvi	a,'?'	;if so, pad with ? characters
	jz	pad2

setnm2:	ldax	d
	call	legfc	;next char legal filename char?
	jc	pad	;if not, go pad for total of B characters
	mov	m,a	;else store
	inx	h
	inx	d
	dcr	b
	jnz	setnm1	;and go for more if B not yet zero
	pop	b
setnm3:	ldax	d	;skip rest of filename if B chars already found
	call	legfc
	rc
	inx	d
	jmp	setnm3

pad:	mvi	a,' '	;pad with B blanks
pad2:	mov	m,a	;pad with B instances of char in A
	inx	h
	dcr	b
	jnz	pad2
	pop	b
	ret

;
; Test if char in A is legal character to be in a filename:
;

legfc:	call	mapuc
	cpi	'.'	; '.' is illegal in a filename or extension
	stc
	rz
	cpi	':'	;so is ':'
	stc 	
	rz
	cpi	7fh	;delete is no good
	stc
	rz
	cpi	'!'	;if less than exclamation pt, not legal char
	ret		;else good enough

;
; Map character in A to upper case if it is lower case:
;

mapuc:	cpi	'a'
	rc
	cpi	'z'+1
	rnc
	sui	32	;if lower case, map to upper
	ret

;
; Ignore blanks and tabs at text pointed to by DE:
;

igwsp:	dcx	d
igwsp1:	inx	d
	ldax	d
	cpi	' '
	jz	igwsp1
	cpi	9
	jz	igwsp1
	ret

;
; This routine does one of two things, depending
; on the value passed in A.
;
; If A is zero, then it finds a free file slot
;  (if possible), else returns C set.
;
; If A is non-zero, then it returns the address
; of the fcb corresponding to an open file whose
; fd happens to be the value in A, or C set if there
; is no file associated with fd.
;

vfgfcb:	push	b
	call	setdma	
	ora	a	;look for free slot?
	mov	c,a
	jnz	fgfc2	;if not, go away
	mvi	b,nfcbs	;yes. do it...
	lxi	d,fdt
	lxi	h,fcbt
	mvi	c,8
fgfc1:	ldax	d
	ani	1
	mov	a,c
	jnz	fgfc1a	;found free slot?
	pop	b	;yes. all done.
	ret

fgfc1a:	push	d
	lxi	d,36	;fcb length to accommodate random I/O
	dad	d
	pop	d
	inx	d
	inr	c
	dcr	b
	jnz	fgfc1
fgfc1b:	stc
	pop	b
	ret		;return C if no more free slots

fgfc2:	call	vfgfd	;compute fcb address for fd in A:
	jc	fgfc1b	;return C if file isn't open

	sui	8
	mov	l,a	;put (fd-8) in HL
	mvi	h,0
	dad	h	;double it
	dad	h	;4*a
	mov	d,h	;save 4*a in DE
	mov	e,l
	dad	h	;8*a
	dad	h	;16*a
	dad	h	;32*a
	dad	d	;36*a
	xchg		;put 36*a in DE
	lxi	h,fcbt	;add to base of table
	dad	d	;result in HL
	mov	a,c	;and return original fd in A
	pop	b
	ret

setdma:	push	d	;just a preventative measure,
	push	b	;since the default I/O buffer
	push	psw	;tends to magically change
	push	h	;around by itself when left
	mvi	c,26	;in CP/M's hands !!
	lxi	d,tbuff
	call	bdos
	pop	h
	pop	psw
	pop	b
	pop	d
	ret

	ENDIF		;end of CP/M-related file I/O routines


	IF	NOT CPM
main:	equ	$	;where main program resides when not under CP/M
			;(under CP/M, the data area comes first)
	ENDIF


;
; Ram area:
;

	IF	NOT CPM	;if not under CP/M, use custom ram area address
	org	ram
	ENDIF

room:	ds	30	;room for random stuff

pbase:	ds	2	;screen-DMA address
ysize:	ds	2	;screen width
xsize:	ds	2	;screen height
psize:	ds	2	;screen length

rseed:	ds	8	;the random generator seed

args:	ds	14	;"arghak" puts args passed on stack here.

iohack:	ds	6	;room for I/O subroutines for use by "inp"
			;and "outp" library routines

allocp:	ds	2	;pointer to free storage for use by "sbrk" func
alocmx:	ds	2	;highest location to be made available to the
			;storage allocator

tmp:	equ	room	;this is misc. garbage space
tmp1:	equ	room+1
tmp2:	equ	room+2
tmp2a:	equ	room+4
ungetl:	equ	room+6	;where characters are "ungotten"
lastc:	equ	room+7	;last char typed

;
;--------------------------------------------------------------------------
; The following data areas are needed only if running under CP/M:
;
	IF	CPM
;
; The fcb table (fcbt): 36 bytes per file control block
;

fcbt:	ds	36*nfcbs	;reserve room for fcb's (extra byte for IMDOS)

;
; The fd table: one byte per file specifying r/w/open as follows:
; 	bit 0 is high if open, low if closed
; 	bit 1 is high if open for read
; 	bit 2 is high if open for write
; (both b1 and b2 may be high)
;

fdt:	ds	nfcbs	;one byte per fcb tells if it is active, r/w, etc.

;
; The command line is copied here by init:
;

comlin:	ds	131	;copy of the command line pointed to by entries
			;in arglst

;
; This is where "init" places the array of argument pointers:
;

arglst:	ds	60	;the "argv" paramater points here (well,
			;actually to 2 bytes before arglst). Thus,
			;up to 30 parameters may be passed to "main"
	ENDIF		;(enough for you, Andy?)

;
; End of CP/M-only data area
;---------------------------------------------------------------------------

	IF	CPM
main:	equ	$	;where "main" program will be loaded under CP/M
	ENDIF

	end

«eof»
DataMuseum.dk

Christian Rovsing CR7, CR8 & CR16 CP/M

⟦be8e9c3d2⟧ TextFile

Derivation

TextFile
