Category : Assembly Language Source Code
Archive   : EMAC15ES.ZIP
Filename : MINTPRIM.ASM

;History:295,1
;11-04-88 00:39:35 remove #(dt) and #(tm) and put in #(ct).
;10-24-88 23:08:30 change #(si) so that it maps multiple characters.
;10-01-88 17:31:20 get_number would look too far for a minus sign.
;09-18-88 23:13:15 add "string index", si_prim.
;05-15-88 20:04:09 Remove reference to non-existent buffer_free1 [kdb]
;04-19-88 23:01:23 in ll_prim, protect the data buffer by setting data_topbot.
;04-19-88 20:16:30 ll_prim didn't work with a shortage of memory.
;03-27-88 13:40:14 change getarg_filename so that it returns zr on empty filenames.
;03-14-88 23:26:08 add fullpath under dos 3.0.
;12-07-87 23:14:20 make mp_prim discard sgaps after making parameters.
;11-10-87 21:43:34 make a marker at the end of the bufseg() definition.
;09-06-87 23:27:39 in ll_prim, we're all done if we hit eof.
;09-06-87 23:07:39 use a big buffer to read libraries in.
;07-10-87 00:13:50 get rid of duplicate copy of bc_prim.
page ,132

.xlist
include mintform.def
include mint.def
include findfile.def

data segment byte public
extrn data_bottop: word
extrn data_topbot: word

extrn fbgn: word
extrn fend: word

extrn filename: byte, filename2: byte

size_buf dw ?

public save_stack
save_stack dw ?

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 label byte
read_error_2 db 'File too large'
read_error_3 db 'File not found'
read_error_4 db 'End of file'
read_error_5 label byte

write_error_1 label byte
write_error_2 db 'Disk full'
write_error_3 db 'Directory full or bad filename'
write_error_4 label byte


environ_name db 'env.'
environ_name_len equ $-environ_name
db 'RUNLINE'
runline_len equ $-environ_name

switchar_name db 'env.SWITCHAR'
switchar_len equ $-switchar_name

fullpath_name db 'env.FULLPATH'
fullpath_len equ $-fullpath_name

form_prefix_len dw ? ;for use by ln prim
form_prefix_ptr dw ? ;...

out_of_memory_msg db 'Not enough memory.$'

break_state db ? ;=state of break checking flag.

extrn stackp: byte

public phd_seg
phd_seg dw ?

day_of_week db 'Sun Mon Tue Wed Thu Fri Sat '
months db 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec '

data ends

code segment byte public
assume cs:code, ds:data, es:data

extrn buffer_free: near

;starting address of program.
init:
mov ax,data
mov ds,ax
mov bx,es:[2] ;get available paragraphs.
mov phd_seg,es
mov es,ax
cli
mov ss,ax
mov sp,offset stackp
sti

mov dx,bx
sub dx,ax ;compute memory between data and end.
cmp dx,1000h ;more than 64k?
jb init_exit ;no - not enough memory.
add ax,1000h ;start buffers at the next segment up.
;enter with ax=>first paragraph of available memory, bx=> first paragraph of
; unavailable memory.
push ax
push bx
call init_entry ;init the machine-dependent code
pop bx
pop ax
call init_all_buffers
jc init_exit_uninit ;no memory.
call init_screen ;initialize redisplay.
call pick_init ;initialize the mouse.

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

mov ax,33h*256+0 ;get the break state.
int 21h
mov break_state,dl
mov ax,33h*256+1 ;turn break checking off.
mov dl,0
int 21h

jmp init_ids_first
init_exit_uninit:
call uninit_exit
init_exit:
mov dx,offset out_of_memory_msg
mov ah,9
int 21h
mov ax,4c01h
int 21h ;halt because of no memory.

;the following externs are in 'buffers'
extrn init_all_buffers: near

;the following externs are in 'redisp'
extrn init_screen: near

;the following externs are in 'pick'
extrn pick_init: near

extrn init_ids_first: near ;start mint interpreter
extrn init_ids: near ;restart mint interpreter
extrn abort_fatal: near ;fatal error handler

;the following externs are in 'mintprim'
extrn init_forms: near


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

extrn return_form: near
;return_form updates the form pointer and jumps to return_tos.
;Enter with ds:bx ->form, cx=unused chars.

extrn return_null: near

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 get_decimal_arg1 ;get the return code.
push ax
mov ax,33h*256+1 ;set the break state.
mov dl,break_state
int 21h
call uninit_exit
pop ax
mov ah,4ch
int 21h


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
di_points_fbgn
mov ax,cx
jmp return_number


db_prim:
int 3
jmp return_null


ct_prim:
;Mon Nov 21 11:31:54 1983
call getarg1_filename ;get the filename.
jz ct_prim_1

mov dx,offset filename2
mov ah,1ah
int 21h

mov dx,si ;filename in dx for find_first.
mov ah,4eh ;find first matching file
mov cx,10h ;find subdirs, too.
int 21h
jnc ct_prim_3 ;go if we found it.
jmp return_null
ct_prim_3:
mov ax,filename2.find_buf_time ;get the hours
mov cl,3
shr ax,cl
xor al,al
mov si,ax

mov ax,filename2.find_buf_time ;get the minutes
mov cl,5
shr ax,cl
and al,3fh
xor ah,ah
or si,ax

mov ax,filename2.find_buf_time ;get the seconds.
mov ah,al
xor al,al
and ah,1fh
shl ah,1 ;but they're twoseconds.
mov bp,ax

;we have hhmm in si, ssxx in bp, ddd in al.

mov ax,filename2.find_buf_date ;get the months
mov cl,3
shl ax,cl
and ax,0f00h
mov dx,ax

mov ax,filename2.find_buf_date ;get the days
and ax,1fh
or dx,ax

mov ax,filename2.find_buf_date ;get the year.
shr ah,1
mov al,ah
xor ah,ah
add ax,1980
mov cx,ax

mov al,7 ;use ' ' as the day of the week.

;we have mmdd in dx, yyyy in cx.
jmp short ct_prim_2

ct_prim_1:
mov ah,2ch ;get hhmm into si, ssxx into bp, ddd into al.
int 21h
mov si,cx
mov bp,dx

mov ah,2ah ;get mmdd into dx, yyyy into cx.
int 21h

ct_prim_2:
;we have hhmm in si, ssxx in bp, ddd in al.
;we have mmdd in dx, yyyy in cx.

di_points_fbgn

push cx ;squirrel yyyy, ssxx, and hhmm away.
push bp
push si

;we have mmdd in dx, ddd in al.

xor ah,ah ;stuff the day of the week.
add al,al
add al,al
mov si,offset day_of_week
add si,ax
movsw
movsw

mov al,dh ;get month (1..12)
dec al

xor ah,ah ;stuff the month
add al,al
add al,al
mov si,offset months
add si,ax
movsw
movsw

mov al,dl ;pushed as dx (get date)
mov bx,10 ;do all conversions in decimal.
mov ah,0
mov cx,2
call put_number
mov al,' '
stosb

pop bp ;pushed as cx (get minutes)
mov ax,bp ;we need them in a two-byte register.

mov al,ah ;get hours
mov ah,0
mov cx,2
call put_number
mov al,":"
stosb
mov ax,bp ;get minutes back.
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
mov al,' '
stosb

pop ax ;get the year.
mov cx,4
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


mp_prim:
call getarg1
call find_form
jc mp_prim_2
assume es:formSeg
mov dx,formSeg:[bx].data_length ;save the count of the form in dx.
lea di,formSeg:[bx].name_offset
add di,formSeg:[bx].name_length ;save the pointer to the form in di.
mov si,fbgn ;point si at the zeroth arg.
mov si,data:[si] ;point si at the form name.
mov si,data:[si] ;point si at the first argument.
mov ah,sgap+1 ;start with sgap 1.
mp_prim_1:
cmp si,data:[si] ;are we pointing at fend?
je mp_prim_3
push si ;save pointer to args.
mov cx,data:[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 mp_prim_5 ;ignore null strings.
mp_prim_4:
call string_search
jc mp_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
jmp mp_prim_4
mp_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.
jmp mp_prim_1
mp_prim_3:
mov si,di ;now prepare to crunch out the sgap's.
mov cx,dx
mov dx,di
jcxz mp_prim_8
mp_prim_6:
lods es:byte ptr 0 ;get a byte from es:
cmp al,sgap ;discard sgaps.
je mp_prim_7
stosb
mp_prim_7:
loop mp_prim_6
mp_prim_8:
sub di,dx ;subtract off the base of the string.
mov formSeg:[bx].data_length,di
esdata
mp_prim_2:
jmp return_null



nb_prim:
call find_arg1
dsdata
mov cx,3
jc nb_prim_1
mov cx,2
nb_prim_1:
jmp return_arg
assume ds:data, es:data


si_prim:
mov cx,2 ;get the character we're translating.
call getarg
mov di,si ;we need it in di.
push di ;save this as the pointer to what we return.
jcxz si_prim_1 ;if no characters, return null.

push di ;remember arg2.
push cx
call find_arg1
mov dx,cx
pop cx
pop di
jc si_prim_1 ;go if it doesn't exist.
mov bx,si ;we need the pointer to the string
xor ah,ah ; in bx. Get ah=0 so we can compare.
si_prim_2:
mov al,es:[di] ;get the character.
cmp ax,dx ;are there actually that many?
jae si_prim_3 ;no - use the old character.
xlat ;get the new character.
si_prim_3:
stosb ;salt the character back to where we got it.
loop si_prim_2
si_prim_1:
dsdata
jmp return_tos


;default primitive is the same as the cl primitive, only we start counting
; arguments from zero, not one.
dflt:
mov bp,0
jmp gs_prim_entry
gs_prim:
mov bp,1
gs_prim_entry:
mov cx,bp ;get the number of the form name arg.
di_points_fend
call find_arg
assume ds:formSeg
jc gs_prim_1
jcxz gs_prim_1 ;if no characters, return null.
or bp,bp ;is this dflt or cl?
jne gs_prim_2 ;cl - use specified args.
dec bp ;make bp+1 be the number of the form name arg.
gs_prim_2:
lodsb ;get char from form.
or al,al ;test it for sgapness
jge gs_prim_3 ;go if not sgap
sub al,sgap ;which sgap?
jz gs_prim_4 ;ignore sgap0's
cbw ;we're going to be counting off ax
add ax,bp ;add in the first arg number.
push ds ;preserve pointer, count of the form
push si
push cx
mov cx,ax
dsdata
call getarg
chk_room_cnt es
rep movsb
pop cx ;restore pointer, count of the form
pop si
pop ds
assume ds:formSeg
jmp gs_prim_4
gs_prim_3:
chk_room es
stosb
gs_prim_4:
loop gs_prim_2
gs_prim_1:
dsdata
jmp return_tos
assume ds:data, es:data


go_prim:
call find_arg1
jc go_prim_1 ;form not found.
assume ds:formSeg
jcxz go_prim_2 ;no chars left.
di_points_fbgn
movsb ;no need to check for collision with actptr.
dec cx
jmp return_form
go_prim_2:
dsdata
mov cx,2
jmp return_arg_active
go_prim_1:
jmp return_null
assume ds:data, es:data


rs_prim:
call find_arg1
jc rs_prim_1
assume ds:formSeg
mov formSeg:[bx].form_pointer,0
dsdata
rs_prim_1:
jmp return_null
assume ds:data, es:data


gn_prim:
call find_arg1
jc gn_prim_1
assume ds:formSeg
jcxz gn_prim_2
push ds ;save pointer, count to form.
push si
push cx
push bx
dsdata
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
pop ds
assume ds:formSeg
di_points_fbgn
cmp dx,cx ;are we trying to get more than exists?
jbe gn_prim_3 ;no - move the requested amount.
mov dx,cx ;yes - truncate the count.
gn_prim_3:
xchg dx,cx ;swap the count remaining and the get count.
sub dx,cx ;dec the count remaining by the get count.
chk_room_cnt es ;check for collision
rep movsb ;move all the chars.
mov cx,dx ;return the count remaining in cx.
jmp return_form
gn_prim_2:
dsdata
mov cx,3
jmp return_arg_active
gn_prim_1:
jmp return_null
assume ds:data, es:data



fm_prim:
call find_arg1
jc fm_prim_1 ;if form not found, return null.
assume ds:formSeg
jcxz fm_prim_2 ;if nothing to search, return two.
xchgdses
assume ds:data, es:formSeg
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 fm_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.
xchgdses
assume ds:formSeg, es:data
di_points_fbgn ;prepare to return a string.
chk_room_cnt es ;make sure we have enough room.
rep movsb
mov cx,dx ;return_form expects the count in cx.
jmp return_form
fm_prim_3:
add sp,2 ;get rid of the pointer to the search string.
assume es:formSeg ;because of where we come from above.
esdata
mov cx,3
jmp return_arg_active
fm_prim_2:
assume ds:formSeg ;because of where we come from above.
dsdata
mov cx,3
jmp return_arg_active
fm_prim_1:
jmp return_null
assume ds:data, es:data


ev_prim:
xor si,si ;start at the beginning of the environ.
ev_prim_1:
mov di,fbgn

push si ;copy in the environ name.
mov si,offset environ_name
mov cx,environ_name_len
rep movsb
pop si

push ds
mov ds,phd_seg
mov ds,ds:[2ch]
ev_prim_2:
lodsb
stosb
or al,al
jne ev_prim_2
pop ds
mov cx,di ;compute the length of it.
sub cx,fbgn
dec cx ;don't count the null.

cmp cx,environ_name_len ;did we get any at all?
je ev_prim_3 ;if none, we're done.

push si ;remember the environment pointer.
mov di,fbgn ;make di->entire name.
mov si,di ;make si -> the name.
mov al,'=' ;look for the name/data separator.
repne scasb
mov dx,cx ;dx (data length) is number of chars left.
mov cx,di ;compute the name length.
sub cx,si
dec cx ;don't count the '='.

;define a form. Enter with:
; si => name
; cx = name length
; di => data
; dx = data length
; bx = form pointer.

xor bx,bx
call define_form
pop si
jmp ev_prim_1
ev_prim_3:
mov ah,30h ;get the dos version.
int 21h
cmp al,3 ;the full path is only in dos 3.0.
jb ev_prim_4

add si,2 ;point to the pathname.
mov di,fbgn
push ds
mov ds,phd_seg
mov ds,ds:[2ch]
ev_prim_5:
lodsb
stosb
or al,al
jne ev_prim_5
pop ds
mov dx,di ;compute the length of it.
sub dx,fbgn
dec dx ;don't count the null.

mov di,fbgn ;restore di again.
mov si,offset fullpath_name
mov cx,fullpath_len
xor bx,bx
call define_form

ev_prim_4:
mov di,fbgn
mov si,80h
push ds
mov ds,phd_seg
lodsb ;get the line length.

mov dl,al
mov dh,0
mov cx,dx ;put it where movs can destroy it.
rep movsb
pop ds

mov di,fbgn ;restore di again.
mov si,offset environ_name
mov cx,runline_len
xor bx,bx
call define_form

mov ax,3700h ;get the switchar.
int 21h

mov di,fbgn
mov [di],dl ;store the switchar.
mov dx,1 ;set the data length.

mov si,offset switchar_name
mov cx,switchar_len
xor bx,bx
call define_form

jmp return_null


ret


ls_prim:
di_points_fend
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
call first_form ;get a pointer to the first form.
;during the execution of this loop, bp->, dx = arg1, es:bx->forms.
ls_prim_1:
assume es:formSeg
je ls_prim_2 ;no more forms, we're done.
lea si,formSeg:[bx].name_offset ;get the name pointer.
mov cx,form_prefix_len
jcxz ls_prim_3 ;zero prefixes match anything.
cmp cx,formSeg:[bx].name_length ;is prefix length>name length?
ja ls_prim_4 ;yes - prefix can't match.
push di ;save the source pointers.
push si
mov di,si
mov si,form_prefix_ptr
repe cmpsb ;compare the prefix to the form name.
pop si
pop di
jne ls_prim_4 ;the prefixes didn't match - ignore it.
ls_prim_3:
mov cx,formSeg:[bx].name_length ;get the name length
xchgdses
assume ds:formSeg, es:data
chk_room_cnt es
rep movsb ;move the name in.
dsdata
mov si,bp ;get the pointer to arg1.
mov cx,dx ;get the size of arg1.
chk_room_cnt
rep movsb ;move it in.
ls_prim_4:
call next_form
jmp ls_prim_1 ;and continue.
ls_prim_2:
esdata
jmp return_tos
assume ds:data, es:data


es_prim:
mov si,fbgn ;point si at "dd".
mov si,[si] ;point si at the first arg.
es_prim_1:
cmp si,[si] ;are we pointing at fend?
je es_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.
jc es_prim_2 ;go if it didn't exist.
assume es:formSeg
call delete_form ;delete the form if it did exist.
esdata
es_prim_2:
pop si ;restore pointer to args.
mov si,[si] ;make it point to next arg.
jmp es_prim_1
es_prim_3:
jmp return_null
assume ds:data, es:data


sl_prim:
call getarg1_filename
mov dx,si
mov cx,0
mov ah,3ch ;create file.
int 21h
mov bx,ax ;remember the handle.
mov al,2
jc sl_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.
sl_prim_1:
cmp si,[si] ;are we pointing at fend?
je sl_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
jc sl_prim_2 ;go if it isn't there.
xchgdses
assume ds:formSeg, es:data
mov dx,di
mov cx,formSeg:[di].form_length
mov ah,40h ;write to a file
int 21h
dsdata
jnc sl_prim_2 ;no problem.
mov ah,3eh ;disk full - close the file.
int 21h
mov dx,offset filename ;delete the file.
mov ah,41h
int 21h
mov al,1
jmp short sl_prim_4
sl_prim_2:
pop si ;restore pointer to args.
mov si,[si] ;make it point to next arg.
esdata
jmp sl_prim_1
sl_prim_3:

mov ah,3eh ;close the file.
int 21h
mov al,0 ;no problem.
sl_prim_4:
mov bx,offset write_errors
jmp return_string
assume ds:data, es:data


ll_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
mov bx,ax ;remember the handle.
mov al,2
jc ll_prim_4
mov cx,0 ;nothing in the buffer at present.
mov si,fend ;set the buffer pointer.
ll_prim_read:
;si -> buffer (=fend), cx = count left in buffer.
mov di,fend ;now move the rest of the buffer down
push cx ; to fend.
rep movsb
pop cx
mov si,fend ;now point to the rest of the buffer.

mov dx,di ;set disk transfer address.

push cx
mov cx,data_bottop ;add in the free space.
sub cx,di ;subtract off the buffer address.
mov ah,3fh ;read from a file.
int 21h
pop cx
jc ll_prim_5 ;close the file - trouble reading.
or ax,ax ;did we hit eof?
je ll_prim_6 ;yes - we're done.
add cx,ax ;add to the count the amount we read.
add dx,ax
mov data_topbot,dx ;remember the highest location that we use.

cmp cx,[si] ;do we have enough room to read this in?
jb ll_prim_3 ;no - report nomem.
ll_prim_1:
;si -> buffer, cx = count left in buffer.
cmp word ptr [si],0 ;is this the end of the library?
je ll_prim_6 ;yes - we're all done.

push bx ;define this form.
push cx
push si
mov cx,[si].name_length
mov dx,[si].data_length
mov bx,[si].form_pointer
lea si,[si].name_offset
mov di,si
add di,cx ;or [si].name_length, but cx is cheaper.
call define_form
pop si
pop cx
pop bx

sub cx,[si] ;remove this one from the buffer.
add si,[si] ;skip past this one.

cmp cx,2 ;if not enough, we need to read again.
jb ll_prim_read
cmp cx,[si] ;do we have that many bytes?
jb ll_prim_read ;if not enough, we need to read again.

jmp ll_prim_1
ll_prim_6:
mov ah,3eh ;close the file.
int 21h
mov al,0 ;all ok.
jmp ll_prim_4 ;we destroyed the active string.
ll_prim_3:
mov ah,3eh ;close the file.
int 21h
call nomem
ll_prim_5:
mov ah,3eh ;close the file.
int 21h
mov al,3 ;read error.
ll_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


st_prim:
;set the syntax table.
call find_arg1
assume ds:formSeg
jnc st_prim_1
mov bx,NIL ;if form not found, use NIL.
st_prim_1:
call store_syntax_table
dsdata
jmp return_null


;primitive declarations
public st_prim
public dflt
public hl_prim
public eq_prim
public nc_prim
public db_prim
public ct_prim
;forms
public ds_prim
public mp_prim
public gs_prim
public go_prim
public gn_prim
public rs_prim
public fm_prim
public ev_prim
public ls_prim
public es_prim
public sl_prim
public ll_prim
public nb_prim
public si_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 ds:bx.

;store_syntax_table stores the form in es:bx as the syntax table.
extrn store_syntax_table: near

extrn first_form: near ;returns es:bx ->first form.
extrn next_form: near ;returns es:bx ->next form, zr if none.

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.
; A pointer to the form header is returned in es:bx

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.
; ds:si 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. ds:si 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.
push dx ;remember the number of characters left.
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
pop dx
or dx,dx ;did we use up all the characters?
je get_number_5 ;yes - don't look for a minus sign.
cmp byte ptr -1[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:
xor dx,dx ;unsigned number.
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:
chk_room
stosb
ret


string_search:

if 1

;enter with si,cx => short string, es:di,dx => long string.
;exit with nc if string was found, es: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
jmp 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
jmp short 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:
;return si ->filename, zr if filename is null.
call getarg
mov di,offset filename
rep movsb
xor al,al
stosb
mov si,offset filename
cmp [si],al
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