Oakland CPM Archive/oakcpm.iso/cpm/cpm86/fmacs86.ark/MINTPRIM.A86

Text File | 1989-02-09 | 28KB | 1,216 lines

    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