Programmer 7500/MAX_PROGRAMMERS.iso/INFO/FREEMACS/EMAC16AS.ZIP/MINTPRIM.ASM

Assembly Source File | 1990-02-22 | 31.5 KB | 1,419 lines

;History:1121,1
;Thu Feb 22 23:32:17 1990 add logical operators: and, or, xor.
;Tue Feb 13 19:24:24 1990 add 'Read Only' to the list of read_errors.
;Thu Sep 14 23:38:27 1989 when dealing with nonexistent strings, remember whether it was active or not.
;Tue Sep 12 23:52:46 1989 gs_prim now calls dflt if the real string can't be found.
;Sun Jun 25 23:55:33 1989 try a faster string_search
;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
    dw    read_error_6

    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    db    'Read Only'
read_error_6    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

dflta_name    db    'dflta'
dflta_len    equ    $-dflta_name

dfltn_name    db    'dfltn'
dfltn_len    equ    $-dfltn_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    make_active: near
;make_active forces the function to be executed in active mode, and returns
;    zr if the function already was active.

    extrn    return_arg: near
;return_arg returns the argument whose number is given in cx.

    extrn    return_arg_active: near
;return_arg_active returns the argument whose number is given in cx, and makes
;    it 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
    jnc    gs_prim_0    ;go if the function was found.
    or    bp,bp        ;only look up dflt if it's a default.
    jne    gs_prim_1
    mov    si,offset dflta_name
    mov    cx,dflta_len    ;try to find the default active function.
    call    make_active    ;but first make it active.
    je    gs_prim_00    ;okay, it's really active.
    mov    si,offset dfltn_name
    mov    cx,dfltn_len    ;Ahhhh, it *was* neutral - call dfltn first.
gs_prim_00:
    call    find_string
    jc    gs_prim_1    ;go if dflt isn't found.
gs_prim_0:
    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
    jmp    return_number_si


su_prim:
    call    get_math
    sub    ax,bx
    jmp    return_number_si


ml_prim:
    call    get_math
    imul    bx
    jmp    return_number_si


dv_prim:
    call    get_math
    or    bx,bx
    je    dv_prim_1
    cwd
    idiv    bx
dv_prim_1:
    jmp    return_number_si


md_prim:
    call    get_math
    or    bx,bx
    je    md_prim_1
    cwd
    idiv    bx
    mov    ax,dx
md_prim_1:
    jmp    return_number_si


and_prim:
    call    get_math
    and    ax,bx
    jmp    return_number_si


or_prim:
    call    get_math
    or    ax,bx
    jmp    return_number_si


xor_prim:
    call    get_math
    xor    ax,bx
    jmp    return_number_si


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    and_prim
    public    or_prim
    public    xor_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.


    extrn    find_string: near
;find_string returns bx pointing to the form whose name is specified by si,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


return_number_si:
    push    si
    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    0

;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, 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.
;preserve si,cx, ah.
    push    bx
    jcxz    string_search_3        ;zero length strings are found immediately
    mov    bx,cx            ;save short string length.
    mov    cx,dx            ;get long string length.
    mov    dx,si            ;save short string pointer.
    dec    bx
    sub    cx,bx            ;this many fewer chars to look at.
    jb    string_search_2        ;"short" string isn't really shorter.
string_search_1:
    jcxz    string_search_2        ;no chars to look at.
    mov    si,dx
    lodsb                ;get the first char.
    repne    scasb            ;look for the first char.
    jnz    string_search_2        ;we didn't find it.
    push    cx            ;save the short length length
    push    di            ;save the long position
    mov    cx,bx            ;get cx=short string length - 1.
    or    cx,cx            ;if cx is zero, we match.
    repe    cmpsb            ;is this it?
    pop    di            ;restore the long position
    pop    cx            ;restore the short length
    jne    string_search_1        ;no match - try at next position.

    mov    si,dx            ;restore short pointer.
    dec    di            ;make di point to the first char again.
    inc    cx            ;and have cx be the number of chars left.

    add    cx,bx            ;restore the original count.
    mov    dx,cx            ;return the remaining count in dx.

    mov    cx,bx            ;restore short count
    inc    cx            ;restore count's original value.
string_search_3:
    pop    bx
    clc
    ret
string_search_2:
    mov    si,dx            ;restore short pointer.
    mov    cx,bx            ;restore search count
    inc    cx            ;restore count's original value.
    pop    bx
    stc
    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