pagesize	86

c_mode		equ	6Dh
c_writestr	equ	09h
f_errmode	equ	2dh
m_alloc		equ	80h
s_sysdat	equ	9Ah
p_term		equ	8Fh

sysdat_sysdisk	equ	byte ptr 4Bh

	codemacro CCPM parm:db			;call CCPM
		db 0b1h ! db parm			;mov cl,parm
		db 0cdh ! db 0e0h			;int 0E0H
		endm

;	.xlist
	include	mintdefs.a86

code	cseg	byte public
	extrn	ccpm_init:near
	extrn	ccpm_create_file:near
	extrn	ccpm_open_file:near
	extrn	ccpm_close_file:near
	extrn	ccpm_create_file:near
	extrn	ccpm_read_file:near
	extrn	ccpm_write_file:near
	extrn	ccpm_delete_file:near
	extrn	ccpm_lseek_file:near
	extrn	ccpm_get_time:near
;	extrn	ccpm_get_date:near
	extrn	buffer_allocate:near
;code	ends

data	dseg	byte public

	extrn	next_ids: word
	extrn	formb:	word
	extrn	forme:	word
	extrn	fbgn:	word
	extrn	fend:	word
	extrn	actptr:	word

	extrn	filename: byte

size_buf	rw	1

	public	save_stack
save_stack	rw	1

	public	read_errors
read_errors	dw	read_error_1
	dw	read_error_2
	dw	read_error_3
	dw	read_error_4
	dw	read_error_5

	public	write_errors
write_errors	dw	write_error_1
	dw	write_error_2
	dw	write_error_3
	dw	write_error_4

read_error_1	rb	0
read_error_2	db	'File too large'
read_error_3	db	'File not found'
read_error_4	db	'End of file'
read_error_5	rb	0

write_error_1	rb	0
write_error_2	db	'Disk full'
write_error_3	db	'Directory full or bad filename'
write_error_4	rb	0


runline		db	'env.RUNLINE'
sysdisk		db	'env.SYSDISK'

form_prefix_len	rw	1		;for use by ln prim
form_prefix_ptr	rw	1		;...

out_of_memory_msg	db	'Not enough memory.$'

	extrn	stackp: byte

;data	ends

code	cseg	byte public
	;*** assume	cs:code, ds:data, es:data

;starting address of program.
init:	mov ax,ds ! mov ss,ax		;set our own stack
	mov sp,offset stackp
	mov dl,0ffh ! ccpm f_errmode
	call	ccpm_init
	call	mint_init
	call	init_entry
	call	init_screen
	call	paint_screen
	mov	ax,0ffffh		;start at the end of memory.
	mov	formb,ax		;delete all forms.
	mov	forme,ax

;xx	push	ds			;set the fatal error address.
;xx	push	cs
;xx	pop	ds
;xx	mov	dx,offset abort_fatal
;xx	mov	ax,2524h
;xx	int	21h
;xx	pop	ds

;*****	mov dx,4h ! ccpm c_mode		;disable CTRL-C termination
	jmp	init_ids

init_exit:
	mov	dx,offset out_of_memory_msg
	ccpm c_writestr
	mov dl,0ffh
	ccpm p_term		;halt because of no memory.


	extrn	init_screen: near
	extrn	init_ids: near		;restart mint interpreter
	extrn	abort_fatal: near	;fatal error handler
	extrn	mint_init: near		;perform any special mint initing.
	extrn	return_null: near
	extrn	paint_screen: near	;start with the screen unpainted.

;The following two externs init and uninit anything that's machine specific.
	extrn	init_entry: near
	extrn	uninit_exit: near

	extrn	set_form_pointer: near
;set_form_pointer updates the form pointer.  It does the dirty work
;	for return_form.

	extrn	return_form: near
;return_form updates the form pointer and jumps to return_tos

	extrn	return_arg: near
	extrn	return_arg_active: near
;return_arg and return_arg_active return the argument whose number is given
;	in cx.  return_arg_active always returns the argument as active.

	extrn	return_string: near
;return_string returns the ALth string out of the table pointed to by bx.

	extrn	return_sicx: near
;return_sicx returns the string pointed to by si.  The length of the
;	string is given in cx.

	extrn	return_tos: near
;return_tos returns the string pointed to by the top of the stack.
;	The length of the string is the difference between di and the
;	beginning of the stirng.

	extrn	nomem: near

;primitives here

hl_prim:
	call	uninit_exit
	mov dl,0ffh ! ccpm p_term

eq_prim:
	call	getarg1		;get the first argument
	mov	dx,cx		;save size of first argument
	mov	di,si		;save pointer to first argument
	mov	cx,2		;get second argument
	call	getarg
	cmp	cx,dx		;lengths equal?
	jne	eq_prim_1	;no, return 4th
	repe	cmpsb		;strings equal?
	jne	eq_prim_1	;no, return 4th.
	mov	cx,3
	jmp	return_arg
eq_prim_1:
	mov	cx,4
	jmp	return_arg


nc_prim:
	call	getarg1
	mov di,fbgn ! dec di ! push di
	mov	ax,cx
	jmp	return_number


sc_prim:
bc_prim:
	mov	cx,2		;get 'from' argument.
	call	getarg
	mov	dl,'a'		;default to ASCII
	jcxz	bc_prim_1
	mov	dl,[si]		;get from type.
bc_prim_1:
	mov	cx,3		;get 'to' argument.
	call	getarg
	mov	dh,'d'		;default to decimal
	jcxz	bc_prim_2
	mov	dh,[si]
bc_prim_2:
	call	getarg1
	call	bc_prim_base	;get the source base.
	or	bx,bx		;ASCII?
	jnz	bc_prim_4	;no.
	lodsb
	mov	ah,0
	jmps	bc_prim_3
bc_prim_4:
	push	dx		;preserve dx.
	call	get_number
	pop	dx
bc_prim_3:
;we now have the number in ax.
	mov	dl,dh
	call	bc_prim_base
	mov di,fbgn ! dec di ! push di
	or	bx,bx
	jnz	bc_prim_5
	stosb
	jmp	return_tos
bc_prim_5:
	mov	cx,0		;use only as many digits as are needed.
	call	put_number
	jmp	return_tos

;private subroutine, used only bc_prim.
bc_prim_base:
;enter with dl=base character.
;exit with bx=base if number; bx=0 if ASCII.
	or	dl,20h		;convert UPPER case to lower case.
	cmp	dl,'d'
	jne	bc_prim_base_1
	mov	bx,10
	ret
bc_prim_base_1:
	cmp	dl,'o'
	jne	bc_prim_base_2
	mov	bx,8
	ret
bc_prim_base_2:
	cmp	dl,'h'
	jne	bc_prim_base_3
	mov	bx,16
	ret
bc_prim_base_3:
	cmp	dl,'c'
	jne	bc_prim_base_4
	mov	bx,0
	ret
bc_prim_base_4:
	cmp	dl,'a'		;a alias character.
	jne	bc_prim_base_5
	mov	bx,0
	ret
bc_prim_base_5:
	cmp	dl,'b'
	jne	bc_prim_base_6
	mov	bx,2
	ret
bc_prim_base_6:
	ret



db_prim:
	int	3
	jmp	return_null


dt_prim:	;get date
	mov di,fbgn ! dec di ! push di
;	mov	ah,2ah
;	int	21h		;*****************************************
	mov cx,0 ! mov dx,cx	;***** must be changed to CCPM later *****
	mov al,0		;*****************************************

	mov	bx,10		;do all conversions in decimal.
	push	cx
	push	dx
	mov	al,dh		;get month
	mov	ah,0
	mov	cx,2
	call	put_number
	mov	al,'-'
	stosb
	pop	ax		;pushed as dx (get date)
	mov	ah,0
	mov	cx,2
	call	put_number
	mov	al,'-'
	stosb
	pop	ax		;pushed as cx (get year)
	sub	ax,1900		;only output the last two digits.
	mov	cx,2
	call	put_number
	jmp	return_tos


tm_prim:	;get time
	mov di,fbgn ! dec di ! push di
;	mov	ah,2ch
;	int	21h
	call ccpm_get_time
	mov	bx,10		;do all conversions in decimal.
	push	dx
	push	cx
	mov	al,ch		;get hours
	mov	ah,0
	mov	cx,2
	call	put_number
	mov	al,':'
	stosb
	pop	ax		;pushed as cx (get minutes)
	mov	ah,0
	mov	cx,2
	call	put_number
	mov	al,':'
	stosb
	pop	dx		;get seconds
	mov	al,dh
	mov	ah,0
	mov	cx,2
	call	put_number
	jmp	return_tos

;form primitives


ds_prim:
	mov	cx,2		;get data first.
	call	getarg
	mov	dx,cx
	mov	di,si
	call	getarg1
	mov	bx,0		;reset form pointer.
	call	define_form
	jmp	return_null


ss_prim:
	call	find_arg1
	jnc	ss_prim_3
	mov	dx,data_length[bx]	;save the count of the form in dx.
	lea	di,name_offset[bx]
	add	di,name_length[bx]	;save the pointer to the form in di.
	mov	si,fbgn		;point si at the zeroth arg.
	mov	si,[si]		;point si at the form name.
	mov	si,[si]		;point si at the first argument.
	mov	ah,sgap+1	;start with sgap 1.
ss_prim_1:
	cmp	si,[si]		;are we pointing at fend?
	je	ss_prim_3
	push	si		;save pointer to args.
	mov	cx,[si]		;compute length of this arg.
	sub	cx,si
	sub	cx,mark_overhead
	add	si,mark_overhead-1	;make si=> text of argument.
;at this point, si,cx => arg; di,dx => form.
	push	di
	push	dx
	jcxz	ss_prim_5	;ignore null strings.
ss_prim_4:
	call	string_search
	jc	ss_prim_5	;not found.  Done with this arg.
;at this point, we have found a string.  We proceed to replace it by
;the appropriate segment gap.  We have already ensured that the string
;is at least one character long.
	push	cx		;preserve cx
	mov	al,ah		;get the sgap.
	stosb			;store it.
;by the way, at this point, the relation (cx <= dx) is always true.
	sub	dx,cx		;count it, and the ones we're getting rid of.
	dec	cx		;one less to get rid of.
	mov	al,sgap		;get rid of the rest of the chars.
	rep	stosb		;cx may be zero, but it doesn't hurt.
	pop	cx
	jmps	ss_prim_4
ss_prim_5:
	pop	dx
	pop	di
	pop	si		;restore pointer to args.
	mov	si,[si]		;make it point to next arg.
	inc	ah		;increment sgap to next arg.
	jmps	ss_prim_1
ss_prim_3:
	jmp	return_null


nb_prim:
	call	find_arg1
	mov	cx,3
	jnc	nb_prim_1
	mov	cx,2
nb_prim_1:
	jmp	return_arg


;default primitive is the same as the cl primitive, only we start counting
;  arguments from zero, not one.
dflt:
	mov	bp,0
	jmps	cl_prim_entry
cl_prim:
	mov	bp,1
cl_prim_entry:
	mov	cx,bp		;get the number of the form name arg.
	mov di,fend ! inc di ! inc di ! push di
	call	find_arg
	jnc	cl_prim_1
	jcxz	cl_prim_1	;if no characters, return null.
	or	bp,bp		;is this dflt or cl?
	jne	cl_prim_2	;cl - use specified args.
	dec	bp		;make bp+1 be the number of the form name arg.
cl_prim_2:
	lodsb			;get char
	or	al,al		;test it for sgapness
	jge	cl_prim_3	;go if not sgap
	sub	al,sgap		;which sgap?
	jz	cl_prim_4	;ignore sgap0's
	cbw			;we're going to be counting off ax
	add	ax,bp		;add in the first arg number.
	push	si		;preserve pointer, count of the form
	push	cx
	mov	cx,ax
	call	getarg
	push di ! add di,cx ! cmp di,actptr
		pop di ! jb $+5 ! jmp nomem
	rep	movsb
	pop	cx		;restore pointer, count of the form
	pop	si
	jmps	cl_prim_4
cl_prim_3:
	cmp di,actptr ! jb $+5 ! jmp nomem
	stosb
cl_prim_4:
	loop	cl_prim_2
cl_prim_1:
	jmp	return_tos


cc_prim:
	call	find_arg1
	jnc	cc_prim_1	;form not found.
	jcxz	cc_prim_2	;no chars left.
	mov di,fbgn ! dec di ! push di
	movsb			;no need to check for collision with actptr.
	dec	cx
	jmp	return_form
cc_prim_2:
	mov	cx,2
	jmp	return_arg_active
cc_prim_1:
	jmp	return_null


cr_prim:
	call	find_arg1
	jnc	cr_prim_1
	mov	form_pointer[bx],0
cr_prim_1:
	jmp	return_null


cn_prim:
	call	find_arg1
	jnc	cn_prim_1
	jcxz	cn_prim_2
	push	si		;save pointer, count to form.
	push	cx
	push	bx
	mov	cx,2		;get number of chars to call.
	call	get_decimal_arg
	mov	dx,ax		;save in dx.
	pop	bx
	pop	cx
	pop	si
	mov di,fbgn ! dec di ! push di
	cmp	dx,cx		;are we trying to get more than exists?
	jbe	cn_prim_3	;no - move the requested amount.
	mov	dx,cx		;yes - truncate to the amount that exists.
cn_prim_3:
	xchg	dx,cx		;swap the count remaining and the get count.
	sub	dx,cx		;dec the count remaining by the get count.
	push di ! add di,cx ! cmp di,actptr
		pop di ! jb $+5 ! jmp nomem		;check for collision
	rep	movsb		;move all the chars.
	mov	cx,dx		;return the count remaining in cx.
	jmp	return_form
cn_prim_2:
	mov	cx,3
	jmp	return_arg_active
cn_prim_1:
	jmp	return_null



in_prim:
	call	find_arg1
	jnc	in_prim_1	;if form not found, return null.
	jcxz	in_prim_2	;if nothing to search, return two.
	push	si
	mov	di,si
	mov	dx,cx
	mov	cx,2
	call	getarg
;now si,cx => short string, di,dx => long string.
	call	string_search
	jc	in_prim_3	;if it's not found, just return arg 3.
;what we want to do now is to return the string from [tos] to [di],
;  and advance the form pointer to point after the found string.
	sub	dx,cx		;dx gets long length - short length.
	pop	si
	mov	cx,di		;get the number of characters before
	sub	cx,si		;  the search string.
	mov di,fbgn ! dec di ! push di		;prepare to return a string.
	push di ! add di,cx ! cmp di,actptr
		pop di ! jb $+5 ! jmp nomem		;make sure we have enough room.
	rep	movsb
	mov	cx,dx		;return_form expects the count in cx.
	jmp	return_form
in_prim_3:
	add	sp,2		;get rid of the pointer to the search string.
in_prim_2:
	mov	cx,3
	jmp	return_arg_active
in_prim_1:
	jmp	return_null


ev_prim:
	mov	di,fbgn
	mov	si,80h
	lodsb				;get the line length.
	mov	dl,al
	mov	dh,0
	mov	cx,dx			;put it where movs can destroy it.
	rep	movsb

	mov	di,fbgn			;restore di again.
	mov	si,offset runline
	mov	cx,length runline
	xor	bx,bx
	call	define_form

	push es ! ccpm s_sysdat
	mov al,es:sysdat_sysdisk[bx]
	add al,'A' ! mov ah,':'
	pop es ! mov di,fbgn
	mov [di],ax ! mov dx,2
	mov si,offset sysdisk
	mov cx,length sysdisk
	xor bx,bx ! call define_form

	jmp	return_null

  if 0
pa_prim:
;#(ps,prefix, seperator, arguments)
	mov di,fend ! inc di ! inc di ! push di
	call	getarg1			;get seperator and save it.
	mov	bp,si			;store the pointer to arg1 in bp
	mov	dx,cx			;store the size of arg1 in dx
	mov	cx,2			;get the form prefix.
	call	getarg
	mov	form_prefix_len,cx
	mov	form_prefix_ptr,si
	mov	si,fbgn			;point si at the zeroth arg.
	mov	si,[si]			;point si at the prefix
	mov	si,[si]			;point si at the seperator.
	mov	si,[si]			;point si at the arguments.
pa_prim_1:
	cmp	si,[si]			;are we pointing at fend?
	je	pa_prim_2		;yes, exit.
	push	si			;save pointer to args.
	mov	cx,[si]			;compute length of this arg.
	sub	cx,si
	sub	cx,mark_overhead
	add	si,mark_overhead-1	;make si=> text of argument.
;at this point, si,cx => arg
	cmp	cx,dx			;is argument length < prefix length?
	jb	pa_prim_4		;yes - prefix can't match.
	push	di			;save the source pointers.
	push	si
	push	cx
	mov	di,bp
	mov	cx,dx
	repe	cmpsb			;compare the prefix to the form name.
	pop	cx
	pop	si
	pop	di
	jne	pa_prim_4		;the prefixes didn't match - ignore it.
pa_prim_3:
	push di ! add di,cx ! cmp di,actptr
		pop di ! jb $+5 ! jmp nomem
	rep	movsb			;move the name in.
	mov	si,form_prefix_ptr	;get the seperator ptr, count.
	mov	cx,form_prefix_len
	push di ! add di,cx ! cmp di,actptr
		pop di ! jb $+5 ! jmp nomem
	rep	movsb			;move it in.
pa_prim_4:
	pop	si			;get the argument pointer back.
	mov	si,[si]			;get the next argument.
	jmps	pa_prim_1		;and continue.
pa_prim_2:
	jmp	return_tos
  endif

ln_prim:
	mov	bx,formb		;get pointer to forms.
	mov di,fend ! inc di ! inc di ! push di
	call	getarg1			;get seperator and save it.
	mov	bp,si			;store the pointer to arg1 in bp
	mov	dx,cx			;store the size of arg1 in dx
	mov	cx,2			;get the form prefix.
	call	getarg
	mov	form_prefix_len,cx
	mov	form_prefix_ptr,si
ln_prim_1:
	cmp	bx,forme		;at end?
	je	ln_prim_2		;yes, exit.
	lea	si,name_offset[bx]	;get the name pointer.
	mov	cx,form_prefix_len
	jcxz	ln_prim_3		;zero prefixes match anything.
	cmp	cx,name_length[bx]	;is prefix length>name length?
	ja	ln_prim_4		;yes - prefix can't match.
	push	di			;save the source pointers.
	push	si
	mov	di,form_prefix_ptr
	repe	cmpsb			;compare the prefix to the form name.
	pop	si
	pop	di
	jne	ln_prim_4		;the prefixes didn't match - ignore it.
ln_prim_3:
	mov	cx,name_length[bx]	;get the name length
	push di ! add di,cx ! cmp di,actptr
		pop di ! jb $+5 ! jmp nomem
	rep	movsb			;move the name in.
	mov	si,bp			;get the pointer to arg1.
	mov	cx,dx			;get the size of arg1.
	push di ! add di,cx ! cmp di,actptr
		pop di ! jb $+5 ! jmp nomem
	rep	movsb			;move it in.
ln_prim_4:
	add	bx,form_length[bx]	;point to next form.
	jmps	ln_prim_1		;and continue.
ln_prim_2:
	jmp	return_tos


dd_prim:
	mov	si,fbgn		;point si at "dd".
	mov	si,[si]		;point si at the first arg.
dd_prim_1:
	cmp	si,[si]		;are we pointing at fend?
	je	dd_prim_3
	push	si		;save pointer to args.
	mov	cx,[si]		;compute length of this arg.
	sub	cx,si
	sub	cx,mark_overhead
	add	si,mark_overhead-1	;make si=> text of argument.
	call	find_form	;try to find this form.
	jnc	dd_prim_2	;go if it didn't exist.
	call	delete_form	;delete the form if it did exist.
dd_prim_2:
	pop	si		;restore pointer to args.
	mov	si,[si]		;make it point to next arg.
	jmps	dd_prim_1
dd_prim_3:
	jmp	return_null


sb_prim:
	call	getarg1_filename
	mov	dx,si
	mov	cx,0
;	mov	ah,3ch			;create file.
;	int	21h
	call ccpm_create_file
	mov	bx,ax			;remember the handle.
	mov	al,2
	jc	sb_prim_4
	mov	si,fbgn			;point si at the zeroth arg.
	mov	si,[si]			;point si at the form name.
	mov	si,[si]			;point si at the first search string.
sb_prim_1:
	cmp	si,[si]			;are we pointing at fend?
	je	sb_prim_3
	push	si			;save pointer to args.
	mov	cx,[si]			;compute length of this arg.
	sub	cx,si
	sub	cx,mark_overhead
	add	si,mark_overhead-1	;make si=> text of argument.
	push	bx
	call	find_form
	mov	di,bx			;remember where the form is.
	pop	bx
	jnc	sb_prim_2		;go if it isn't there.
	mov	cx,form_length[di]
	mov	dx,di
;	mov	ah,40h			;write to a file
;	int	21h
	call ccpm_write_file
	jnc	sb_prim_2		;no problem.
;	mov	ah,3eh			;disk full - close the file.
;	int	21h
	call ccpm_close_file
	mov	dx,offset filename	;delete the file.
;	mov	ah,41h
;	int	21h
	call ccpm_delete_file
	mov	al,1
	jmps sb_prim_4
sb_prim_2:
	pop	si		;restore pointer to args.
	mov	si,[si]		;make it point to next arg.
	jmps	sb_prim_1
sb_prim_3:
;	mov	ah,3eh		;close the file.
;	int	21h
	call ccpm_close_file
	mov	al,0		;no problem.
sb_prim_4:
	mov	bx,offset write_errors
	jmp	return_string


fb_prim:
;Note that information about the structure 'form' is hard-coded into the
;  next routine.  We assume that 'form_length' is only two bytes long,
;  and occurs at the beginning of the structure.
	call	getarg1_filename
	mov	dx,si
;	mov	ax,3d00h		;open file for reading.
;	int	21h
	call ccpm_open_file
	mov	bx,ax			;remember the handle.
	mov	al,2
	jc	fb_prim_4_j_1
	mov	ax,forme		;anything loaded yet?
	cmp	ax,formb
	jne	fb_prim_1		;yes - load one by one.

	mov	cx,0
	mov	dx,cx
;	mov	ax,4202h		;seek to the end of the file.
;	int	21h
	mov al,2
	call ccpm_lseek_file

	push	ax			;remember the file size.
	mov	dx,cx			;zero out dx again.
;	mov	ax,4200h
;	int	21h
	mov al,0
	call ccpm_lseek_file
	pop	cx			;get the file size back again.

	mov	ax,forme		;no - do a bulk load.
	sub	ax,cx			;see if there is enough room.
	jb	fb_prim_3_j		;can't possibly be.
	mov	dx,ax
	sub	ax,free_space		;free_space is the working room.
	cmp	ax,fend
	jb	fb_prim_3_j		;there isn't.

	push cx
	mov	cx,formb		;compute size of active string.
	sub	cx,actptr
	mov	si,actptr		;->active string.
	mov	di,dx			;->new formb.
	sub	di,cx			;leave room for the active string.
	mov	actptr,di
	rep	movsb
	mov	formb,dx

	pop	cx			;read the whole file in.
;	mov	ah,3fh			;read from a file.
;	int	21h
	call ccpm_read_file
	jc	fb_prim_5		;trouble reading...
	push	bx			;preserve handle.
	call	rehash			;reconstruct the hash links.
	pop	bx
fb_prim_6:
;	mov	ah,3eh			;close the file.
;	int	21h
	call ccpm_close_file
	mov	al,0			;all ok.
	jmps	fb_prim_4		;we destroyed the active string.
fb_prim_5:
;	mov	ah,3eh			;close the file.
;	int	21h
	call ccpm_close_file
	mov	al,3			;read error.
fb_prim_4_j_1:
					;we get here if we can't open the file.
	jmps	fb_prim_4		;we destroyed the active string.
fb_prim_3_j:
	jmps	fb_prim_3
fb_prim_1:
	mov	dx,offset size_buf	;set disk transfer address
	mov	cx,2
;	mov	ah,3fh			;read from a file.
;	int	21h
	call ccpm_read_file
	jc	fb_prim_5		;close the file - trouble reading.

	cmp	ax,0			;did we read no bytes at all?
	je	fb_prim_6		;close and exit.

	mov	ax,size_buf		;we need twice as much memory
	shl	ax,1			;  as in size_buf.
	add	ax,fend			;see if there is enough room.
	add	ax,free_space
	cmp	ax,actptr
	jae	fb_prim_3

	mov	dx,fend
	add	dx,2
	mov	cx,size_buf
	sub	cx,2			;transfer two less bytes.
;	mov	ah,3fh			;read from a file.
;	int	21h
	call ccpm_read_file
	jc	fb_prim_5
	cmp	ax,cx
	jne	fb_prim_5		;trouble reading...

	push	bx
	mov	bx,fend			;don't add 2 like we did before because
	mov	cx,name_length[bx]	;  we already read form_length.
	mov	dx,data_length[bx]
	lea	si,name_offset[bx]
	mov	di,si
	add	di,cx		;or [bx].name_length, but cx is cheaper.
	mov	bx,form_pointer[bx]
	call	define_form
	pop	bx

	jmps	fb_prim_1
fb_prim_3:
;	mov	ah,3eh			;close the file.
;	int	21h
	call ccpm_close_file
	jmp	nomem
fb_prim_4:
	mov	bx,offset read_errors
	jmp	return_string


ad_prim:
	call	get_math
	add	ax,bx
	push	si
	jmp	return_number


su_prim:
	call	get_math
	sub	ax,bx
	push	si
	jmp	return_number


ml_prim:
	call	get_math
	imul	bx
	push	si
	jmp	return_number


dv_prim:
	call	get_math
	or	bx,bx
	je	dv_prim_1
	cwd
	idiv	bx
dv_prim_1:
	push	si
	jmp	return_number


md_prim:
	call	get_math
	or	bx,bx
	je	md_prim_1
	cwd
	idiv	bx
	mov	ax,dx
md_prim_1:
	push	si
	jmp	return_number


gr_prim:
	call	get_math
	mov	cx,3
	cmp	ax,bx
	jg	gr_prim_1
	mov	cx,4
gr_prim_1:
	jmp	return_arg


;primitive externals
	public	dflt
	public	hl_prim
	public	eq_prim
	public	nc_prim
	public	sc_prim
	public	db_prim
	public	dt_prim
	public	tm_prim
;forms
	public	ds_prim
	public	ss_prim
	public	cl_prim
	public	cc_prim
	public	cn_prim
	public	cr_prim
	public	in_prim
	public	ev_prim
	public	ln_prim
	public	dd_prim
	public	sb_prim
	public	fb_prim
	public	nb_prim
;math
	public	ad_prim
	public	su_prim
	public	ml_prim
	public	dv_prim
	public	md_prim
	public	gr_prim

;form subroutines
	extrn	define_form: near
	extrn	delete_form: near
;delete_form deletes the form pointed to by bx.

	extrn	rehash: near
;rehash rebuilds the hashing links.  Used only when a file is bulk loaded.

	extrn	find_form: near
;find_form returns bx pointing to the form whose name is pointed to by si.
;	The length of the form name is given in cx.
;	If the form doesn't exist, cy is set, otherwise cy is clear.
;	di points to the form data after the form pointer, and cx is the
;	number of chars after the form pointer.

	extrn	find_arg1: near
;find_arg1 returns bx pointing to the form whose name is given in
;	arg1.  If the form doesn't exist, cy is set, otherwise cy is clear.
;	di points to the form data after the form pointer, and cx is the
;	number of chars after the form pointer.

	extrn	find_arg: near
;find_arg returns bx pointing to the form whose name is given in
;	the arg specified by cx.  If the form doesn't exist, cy is
;	set, otherwise cy is clear.  di points to the form data
;	after the form pointer, and cx is the number of chars after
;	the form pointer.


;utility subroutines


	public	get_math
get_math:
;exit with ax=first number, bx=second number, si->first arg, di->first number.
	mov	cx,2
	call	get_decimal_arg
	push	ax
	call	getarg1
	push	si
	call	get_decimal
	mov	di,si
	pop	si
	pop	bx		;pushed as ax
	ret


	public	get_decimal_arg1
get_decimal_arg1:
	mov	cx,1
;fall through
	public	get_decimal_arg
get_decimal_arg:
	call	getarg
;fall through
	public	get_decimal
get_decimal:
	mov	bx,10
;fall through
	public	get_number
get_number:
;enter with si,cx => string containing trailing number, bx=base to convert
;  number in.  Return number in ax, si => start of digit string.
	add	si,cx
	push	cx
get_number_1:
	dec	si
	mov	al,[si]
	sub	al,'0'		;between 0 and "9"?
	jb	get_number_2	;no - can't be a digit.
	cmp	al,'9'-'0'	;between "0" and "9"?
	jbe	get_number_6	;yes - must be a digit.
	cmp	al,'a'-'0'
	jb	get_number_8
	sub	al,'a'-'A'
get_number_8:
	cmp	al,'A'-'0'	;between "A" and "9"?
	jb	get_number_2	;yes - can't be a digit.
	sub	al,'A'-('0'+10)	;convert "A" to 10
get_number_6:
	cmp	al,bl		;a legal digit in the desired base?
	jae	get_number_2	;no.
	loop	get_number_1
	dec	si		;setup for pre-increment.
get_number_2:
	mov	dx,cx
	pop	cx		;restore count.
	sub	cx,dx		;get the actual count of chars into cx.
	inc	si
	push	si		;save a copy of the start of the number.
	mov	ax,0		;initially zero.
;at this point, si => first digit, cx = count of digits to convert.
	jcxz	get_number_4	;if no more chars, we're done.
get_number_3:
	mul	bx
	mov	dx,ax
	lodsb			;ax = new ASCII digit.
	sub	al,'0'		;make it a number.
	cmp	al,'9'-'0'
	jbe	get_number_7
	cmp	al,'a'-'0'
	jb	get_number_9
	sub	al,'a'-'A'
get_number_9:
	sub	al,'A'-('0'+10)
get_number_7:
	cbw			;make it a word.
	add	ax,dx		;and add in the old value.
	loop	get_number_3
get_number_4:
	pop	si
	cmp	byte ptr 0ffffh[si],'-'
	jne	get_number_5
	dec	si
	neg	ax
get_number_5:
	ret


	public	return_number
return_number:
;enter with di => place to put string, tos => start of string,
;  ax=number.
	mov	cx,0		;use only as many digits as is needed.
	mov	bx,10
	call	put_number
	jmp	return_tos


	public	put_number
put_number:
;enter with di => place to put string, ax = number, cx=minimum number of digits
;  bx=base to convert number to.
	or	ax,ax
	jge	put_number_1
	neg	ax
	mov	byte ptr [di],'-'
	inc	di
put_number_1:
	call	one_digit
	ret


one_digit:
	jcxz	one_digit_3
	dec	cx
one_digit_3:
	cwd
	div	bx
	push	dx
	or	ax,ax
	jnz	one_digit_1	;if more digits, do them.
	jcxz	one_digit_2	;if count is zero, don't do next digit.
;we get here if we have more digits to do, or we have more leading
; zeroes to place.
one_digit_1:
	call	one_digit
one_digit_2:
	pop	ax		;pushed as dx
	add	al,'0'
	cmp	al,'9'
	jbe	one_digit_4
	add	al,'A'-('9'+1)	;the digit above "9" becomes an "A".
one_digit_4:
	cmp di,actptr ! jb $+5 ! jmp nomem
	stosb
	ret


string_search:

	if	1

;enter with si,cx => short string, di,dx => long string.
;exit with nc if string was found, di,dx => position found.
;exit with cy if string was not found.
	jcxz	string_search_3	;zero length strings are found immediately
;we can get into trouble if cx = 0 after this point.
string_search_1:
	cmp	dx,cx
	jb	string_search_2
	push	si	;preserve all the registers.
	push	di
	push	cx
	repe	cmpsb
	pop	cx
	pop	di
	pop	si
	je	string_search_3
	dec	dx
	inc	di
	jmps	string_search_1
string_search_3:
	clc
	ret
string_search_2:
	stc
	ret

	else

;enter with si,cx => short string, di,dx => long string.
;exit with nc if string was found, di,dx => position found.
;exit with cy if string was not found.
;preserve si,cx, ah.
	jcxz	string_search_1		;zero length strings are found immediately
	mov	bx,cx			;save search string length.
	mov	cx,dx			;get target string length.
	mov	dx,si			;save search string pointer.
	dec	bx
	sub	cx,bx			;this many fewer chars to look at.
	jb	string_search_5		;string is shorter than search.
string_search_3:
	jcxz	string_search_5		;no chars to look at.
	mov	si,dx
	lodsb				;get the first char.
string_search_4:
	scasb				;look for the first char.
	loopnz	string_search_4		;keep looking until we find it.
	jnz	string_search_5		;we didn't
	xchg	cx,bx			;set the count to the string length.
	push	cx			;save the string length
	push	di			;save the source position
	repe	cmpsb			;is this it?
	mov	cx,bx			;restore the search length
	pop	di			;restore the source position
	pop	bx			;restore the string length
	jne	string_search_3		;no match - try at next position.
	mov	si,dx			;restore search pointer
	dec	di			;make di point to the first char again.
	mov	dx,cx			;return the remaining count in dx.
	mov	cx,bx			;restore search count
	inc	cx			;restore count's original value.
string_search_1:
	clc
	jmps string_search_2
string_search_5:
	stc
string_search_2:
	ret

	endif


	public	getarg1_filename
getarg1_filename:
	mov	cx,1
	public	getarg_filename
getarg_filename:
	call	getarg
	mov	di,offset filename
	rep	movsb
	xor	al,al
	stosb
	mov	si,offset filename
	ret


	extrn	getarg1: near
;getarg1 returns si -> the first argument.  cx is set to the size
;	of the first argument.

	extrn	getarg: near
;getarg returns si -> the argument given in cx.  cx is set to the size
;	of the argument.

;code	ends

	end	init

turns si -> the argument given in cx.  cx is set to the size
;	of the argument.

;code	ends

	end	init