⟦ba8af2388⟧

TextFile


;
; CCC.ASM:  BDS C Run-Time Package (C.CCC)	    v1.50, 11/9/82
; Copyright (c) 1982 by Leor Zolman
;
; 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 BASE+100h). The code generated
; by BDS C always sits immediately on top 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,
; b) the origin of the run-time package's local r/w area, and c) the
; RST vector used to interface with Kirkland's CDB debugger. 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.
;

FALSE:	EQU	0
TRUE:	EQU	NOT FALSE

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

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

DMAVIO:	EQU	TRUE	;True if using DMA video library routines and
			;need parameters initialized

USERST:	EQU	FALSE	;True to use a restart vector for CDB interfacing
RSTNUM:	EQU	6	;Use "RST n" as default debugger vector. Has no
			;effect if USERST is false.
rstloc:	equ  RSTNUM*8	;Memory address where "RST n" vector falls

	IF CPM
nfcbs:	equ	9	;maximum # of files open at one time
base:	equ	0	;start of ram in system (either 0 or 4200h)
bdos:	equ	base+5	;the rest of these do not vary between CP/M systems.
tpa:	equ	base+100h
tbuff:	equ	base+80h
origin:	equ	tpa
exitad:	equ	base	;warm boot location

conin:	equ	1	;BDOS call codes...console input
cstat:	equ	11	;interrogate console status
closec:	equ	16	;close file
gsuser:	equ	32	;get/set user code
	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

;
; The "lxi sp,0" instruction at the start of the code is changed by
; CLINK, if the "-t" option is NOT used, into:
;		lhld	base+6
;		sphl
;
; If "-t <addr>" is used, then the sequence becomes:
;		lxi	sp,<addr>
;		nop
;
; If "-n" is used, to indicate no-warm-boot, then the the sequence becomes:
;		jmp	snobsp
;		nop
;

	lxi	sp,0	;These two instructions change depending on whether
	nop		;or not the CLINK "-t" or "-n" options are given.

	nop
	nop

	jmp	skpfex	;skip over the following vector (don't ask...)

fexitv:	jmp	exitad	;final exit vector. If "-n" used, this
			;becomes address of the "nobret" routine.

skpfex:	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
setfcu:	jmp	vsetfcu	;set up FCB and process user number prefix
setusr:	jmp	vsetusr ;set user area to upper 5 bits of A, save previous
rstusr:	jmp	vrstusr	;restore user area to what it was before setusr call
snobsp: jmp	vsnobsp	;set up SP for non-boot ("-tn") CLINK option
nobret:	jmp	vnobret	;return to CCP when non-boot ("-tn") in effect.
khack:	jmp	vkhack	;Kirkland interrupt vector initialization
clrex:	jmp	vclrex	;routine to clear external data area
	ENDIF

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

	ds	9	;reserved

;
; 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

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


;
; The following two routines are used when the "-tn" CLINK option
; was given, in order to preserve the SP value passed to the transient
; command by the CCP and return to the CCP after execution without
; performing a warm-boot.
;

	IF CPM
vsnobsp:
	lxi	h,0		;get CCP's SP value in HL
	dad	sp
	shld	spsav		;save it for later
	lhld	base+6		;get BIOS pointer
	lxi	d,-2100		;subtract size of CCP plus a fudge
	dad	d
	sphl			;make that the new SP value
	jmp	tpa+3		;and get things under way...

vnobret:
	lhld	spsav		;restore CCP's SP
	sphl
	ret			;return to CCP

	ENDIF


;
; 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 up "argv" for the C main program
	ENDIF
	
	IF	NOT CPM
	lxi	h,0
	ENDIF

	push	h

			;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.

	IF	CPM
	call	khack		;initialize Kirkland debugger vector
	ENDIF

	IF 	CPM		;initialize raw I/O parameters
	xra	a
	sta	freeze		;clear freeze (^S) flag
	sta	pending		;no pending input yet
	mvi	a,1fh	
	sta	mode		;tty mode: all features enabled
	mvi	a,'C'-64
	sta	quitc		;this is the standard interrupt char
	ENDIF

				;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,cstat ;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,conin   ;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,3*nfcbs  ;now initialize all the file info
	lxi	h,fdt	;by zeroing 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

	call	clrex	;clear externals, if CLINK -z option NOT used

	xra	a
	sta	ungetl	;clear the push-back byte,
	sta	errnum	;and file error code

	lhld	tmp2
	pchl		;all done initializing.

;
; The following routine gets called to clear the external
; data area, unless the CLINK "-z" option is used.
;

vclrex:	lhld	freram	;clear externals
	xchg
	lhld	extrns
	call 	cmh
	dad	d	;HL now holds size of external data area
clrex1:	mov 	a,h	;loop till done
	ora	l
	rz
	dcx	d
	dcx	h
	xra	a
	stax	d
	jmp	clrex1


;
; Initialize Kirkland interrupt vector... enables
; programs compiled with "-k" to run without the debugger:
;

	IF USERST
vkhack:	lxi	h,0E1H+2300H	;pop h - inx h
	shld	rstloc		; put at "RST 6" location
	lxi	h,023H+0E900H	;inx h - pchl
	shld	rstloc+2
	ret
	ENDIF

	IF NOT USERST
vkhack:	ret
	ds 12
	ENDIF


;
; 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	fexitv		;done closing...now return
				; to CP/M or whatever.


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

	IF	CPM	;here comes a lot of CP/M stuff...
vclose:
	call	ma1toh	;get fd in A
	call	vfgfd	;see if it is open
	jc	verror	;if not, complain
	mov	a,m
	call	setusr	;set user area to match current fd
	ani	4	;check if open for writing

	ENDIF

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

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

	IF CPM

	push	h	;save fd table entry addr
	call	ma2toh	;get the fd in A again
	push	b
	call	vfgfcb	;get the appropriate fcb address
	xchg		;put it in DE
	mvi	c,closec  ;get BDOS function # for close
	call	bdos	;and do it!
	pop	b
	pop	h
close2:	call	rstusr	;reset user number to original state
	mvi	m,0	;close the file logically
	cpi	255	;if 255 came back from bdos, 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 open, return Cy clear and with the address of the fd table
; entry for the open file in HL. If the file is not open,
; return Cy set:
;

vfgfd:	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	;offset for 3-byte table entries
	dad	d
	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"
; The user number prefix hack is NOT recognized by this subroutine.
;

vsetfcb:
	push	b
	call	igwsp	;ignore blanks and tabs	
	push	h	;save fcb ptr
	inx	d	;peek at 2nd char of filename
	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	'A'-1	;and fudge it a bit
	inx	d	;advance DE past disk designator to filename
	inx	d
setf1:	mov	m,a	;set disk byte
	inx	h
	mvi	b,8
	call	setnm	;set filename, pad with blanks
	call	setnm3	;ignore extra characters in filename
	ldax	d
	cpi	'.'	;if an extension is given,
	jnz	setf2
	inx	d	;skip the '.'
setf2:	mvi	b,3
	call	setnm	;set the extension field and pad with blanks
	xra	a	;and zero the appropriate fields of the fcb
	mov	m,a
	lxi	d,20
	dad	d
	mov	m,a
	inx	h
	mov	m,a	;zero random record bytes of fcb
	inx	h
	mov	m,a
	inx	h
	mov	m,a
	pop	d
	pop	b
	ret

;
; This routine copies up to B characters from (DE) to (HL),
; padding with blanks on the right. An asterisk causes the rest
; of the field to be padded with '?' characters:
;

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

;
; Process filename having optional user area number prefix of form "<u#>/",
; return the effective user area number of the given filename in the upper
; 5 bits of A, and also store this value at "usrnum". Note that if no user
; number is specified, the current user area is presumed by default. After
; the user area prefix is processed, do a regular "setfcb":
;
; Note: a filename is considered to have a user number if the first char
; 	in the name is a decimal digit and the first non-decimal-digit
;	character in the name is a slash (/).

vsetfcu:
	push	b	;save BC
	push	h	;save vcb pointer
	call	igwsp	;ignore blanks and tabs	
	call	isdec	;decimal digit?
	jnc	setfc2	;if so, go process

setfc0:	push	d	;save text pointer
	mvi	c,gsuser  ;else get current effective user number
	mvi	e,0ffh
	call	bdos
	pop	d	;restore text pointer

setfc1:	rlc		;rotate into upper 5 bits of A
	rlc
	rlc
	sta	usrnum	;and save
	pop	h	;restore junk
	pop	b
	jmp	setfcb	;and parse rest of filename

setfc2:	mvi	b,0	;clear user number counter
	push	d	;save text pointer in case we invalidate user prefix
setfc3:	sui	'0'	;save next digit value
	mov	c,a	; in C
	mov	a,b	;multiply previous sum by 10
	add	a	;*2
	add	a	;*4
	add	a	;*8
	add	b	;*9
	add	b	;*10
	add	c	;add new digit
	mov	b,a	;put sum in B
	inx	d	;look at next char in text
	ldax	d	;is it a digit?	
	call	isdec
	jnc	setfc3	;if so, go on looping and summing digits
	cpi	'/'	;make sure number is terminated by a slash
	jz	setfc4
	pop	d	;if not, entire number prefix is not really a 
	jmp	setfc0	; user number, so just ignore it all.

setfc4:	inx	d	;ok, allow the user number
	pop	h	;get old text pointer off the stack
	mov	a,b	;get user number value
	jmp	setfc1	;and go store it and parse rest of filename


;
; 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

;
; Return Cy if char in A is not a decimal digit:
;

isdec:	cpi	'0'
	rc
	cpi	'9'+1
	cmc
	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
	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	;bump to next 3-byte table entry
	inx	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

;
; The following two subroutines change the current CP/M user area for
; user with file I/O:
;

vsetusr:
	push	b	;SET user number to upper bits of A, save current:
	push	h
	push	d
	push	psw	;save A
	mvi	c,gsuser ;get user code
	mvi	e,0ffh
	call	bdos
	sta	curusr	;save current user number
	pop	psw	;get new user number byte
	push	psw
	rar		;shift user number down to low bits
	rar
	rar
	ani	1fh	;and mask off high order garbage
setu0:	mov	e,a
	mvi	c,gsuser  ;set user code
	call	bdos
	pop	psw
	pop	d
	pop	h
	pop	b
	ret

vrstusr:
	push	b
	push	h
	push	d
	push	psw
	lda	curusr	;get last saved user number
	jmp	setu0	;and go set current user area to that

	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 	CPM
ram:	equ	$
	ENDIF

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

	ds	20	;reserved by BDS

errnum:	ds	1	;error code from file I/O operations
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

room:	ds	30	;reserved for use by BDS C system code
uroom:	ds	20	;available for use by user


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"
unused:	equ	room+7
curusr:	equ	room+8	;used to save current user number during file I/O
usrnum:	equ	room+9	;set by "setfcu" to user number of given filename

mode:	equ	room+10	;tty mode
freeze:	equ	room+11	;true if output frozen (^S)
pending: equ	room+12	;true if input character waiting
pendch:	equ	room+13	;if pending true, this is the character
quitc:	equ	room+14	;the general system abort character (^C usually)
spsav:	equ	room+15	;saved SP value from CCP
;	equ	room+17	;where next thing goes

echo:	equ	1	;masks for "mode" byte...echo mode
quit:	equ	2	;quit enabled
flow:	equ	4	;^S/^Q protocol honored
strip:	equ	8	;strip parity
expand:	equ	16	;expand 'Øn' into CR-LF on output

;
;--------------------------------------------------------------------------
; 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)
;	bits 3-7 contain the user number in which the file is active (0-31)
;

fdt:	ds	3*nfcbs	;3 bytes per fcb: 1 for active, r/w, etc., and
			;		  2 to specify highest sector num seen

;
; 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

RegneCentralen RC700 "Piccolo"

⟦ba8af2388⟧ TextFile

Derivation

TextFile
