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

Assembly Source File | 1989-12-19 | 15.7 KB | 605 lines

;History:143,1
;Tue Dec 19 22:40:56 1989 Add an ifdef for 'timing' to disable the profiling code.
;Sun Nov 12 22:51:36 1989 add profiling to the code.
;Thu Sep 14 23:26:52 1989 Add make_active and remove return_arg_active.
;12-12-87 13:41:44 bum a lot of instructions out of scan_loop.
;12-07-87 20:09:39 add store_debug
;11-23-87 22:20:47 use scan_copy as the base of scan_xlat_table.
    page    ,132

    .xlist
    include mint.def
    .list

HT    equ    9
LF    equ    10
CR    equ    13

code    segment    byte public
code    ends

data    segment byte public
data    ends

bufseg    segment public
    public    prev_buffer, next_buffer, toptop, topbot, bottop, botbot, new_size
    define_buffer
bufseg    ends

data    segment byte public
    public    data_bottop, data_topbot, data_botbot
    define_buffer    data_
data    ends

data    segment byte public

comment /******************************************************************

Introduction:

    The MINT data structures are laid out in memory as given below.
First are the variables, followed by the neutral string.  Next is the
block of free memory.

    variables, neutral string ... free memory ... neutral string.

The neutral string:

    The neutral string consists of a list of arguments.  Each argument
begins with header which might be laid out as so in Pascal:
    arg_header = record
     marker : (active_marker, neutral_marker, comma_marker);
     previous : ^arg_header;
    end;

The pointer, previous, points to the previous arg_header. The last one in the
list has a nil pointer.  This will always be the #(ps) which is the outermost
function to be executed.

The neutral string during function execution:

    Since we are interested in counting arguments from left to right,
not right to left, we need to reverse the pointers so that they point
from the first argument, to the second argument, to the third argument,
etc.  At this point, [fbgn] points to the first argument (the name of the
funciton), and [fend] points past the last argument.  To make argument
fetching more efficient, the last argument is followed by a null argument
which points to itself.  This causes missing arguments to be fetched as
nulls, in according to the definition of the language.
    Functions which return a value will build that value at either
[fbgn]-1 or [fend]-2, depending on whether or not they need to refer to
arguments supplied to the function.  In general, single argument functions
will use [fbgn]-1, and multiple argument functions will use [fend]-2.

Neutral function results will eventually be moved to [fbgn]-1.

The active string:

    The active string consists of a string of ASCII characters which
have not yet been scanned.  Typically, only ASCII characters appear here,
although any eight bit value may occur.

The active string during function execution:

    [actptr] points to the end of the active string.  Active function
results are built as described above and then moved to the left of [actptr].
Actptr is then adjusted to point to the result just moved in.  Primitives
check for memory overflow by comparing [fend] to [actptr].  If they come
closer than some magic constant, then the 'No Memory' error is given
and the idling string is reloaded.


**************************************************************************/


    public    trace
    public    next_ids
    extrn    standard_ids: byte
    public    fbgn, fend
    extrn    lomem: byte

trace    db    0        ;trace is initially off.
next_ids    dw    standard_ids
fbgn    dw    ?
fend    dw    ?
fcn_save    db    ?
prev_fcn    dw    ?

;some constant definitions

;the _mark constants mark where a particular type of string occurs in
; the linked list.

comma_marker    equ    0    ;comma_marker must not have function_marker_mask set!
active_marker    equ    1    ;active_marker must have function_marker_mask set!
neutral_marker    equ    3    ;neutral_marker must have function_marker_mask set!
function_marker_mask    equ    1

entry    macro    char, adr
    org    (offset scan_xlat_table)+char
    db    (offset adr) - (offset scan_copy)
    endm

    db    0
scan_xlat_table    db    256 dup (0)
;first, fill up the table with 'copy'
;next, put the proper addresses in the right spots,
    entry    HT,scan_ignore
    entry    CR,scan_ignore
    entry    LF,scan_ignore
    entry    '#',scan_sharp
    entry    '(',scan_lpar
    entry    ')',scan_rpar
    entry    ',',scan_comma
;finally, go to the end of the table.
    org    (offset scan_xlat_table)+(size scan_xlat_table)

    purge    entry

    extrn    function_name_table: word
    extrn    function_name_length: abs
    extrn    function_address: word

  if timing
    extrn    counting: byte

    public    counts
counts    dw    100 dup(0)

    public    times
times    dw    100 dup(0)
  endif

nomem_prompt        db    'No memory!',0
fatal_prompt        db    'No disk in drive or door open!',0
protected_prompt    db    'Disk is write protected!',0

    extrn    stackp: byte

buffers_bad_msg    db    'Buffers corrupted, reboot:','$'
buffers_be_msg    db    'xx will say Buffers corrupted, reboot:','$'


data    ends


code    segment byte public

    assume    cs:code, ds:data, es:data

comment /*******************************************************************
    The following is the MINT scan loop.  This loop must be as fast as
possible because it is executed the most often.   As a consequence, the
code is quite unstructured.  However, the code follows the algorithm given in
the MINT language definition document.
    During scan, si -> (points to) the active string, di -> the
neutral string, dx -> previous argument, and bp -> end of active string.
    As we scan a character, we must branch to certain routines on certain
characters.  To make best use of the 8086 instruction set, we have set up a
translate table.  Therefore, the translate table, scan_xlat_table, contains an
offset from the beginning of the scan loop.

    When the scan loop has finally found a function to be executed,
a jump is performed to that primitive (unknown primitives cause jump to dflt).
When the primitive is finished, it jumps (with the exception of hl) to one of
the 'return_???' functions.  Each of the return_??? routines puts the returned
value in the proper place in the proper string (active or neutral), and jumps
back to scan.
    The scan loop is repeatedly executed until there are no more functions
to be executed, or the available memory has been exhausted.
*****************************************************************************/

scan_copy:            ;come here to copy a char from active to neutral
scan_loop:
    lodsb            ;movsb loses because it doesn't load AL.
    stosb
    xlat            ;al was char, is now offset
    jmp    ax

scan_ignore:            ;come here to throw a char away from active.
    dec    di
    jmp    scan_loop

scan_lpar:
    dec    di            ;uncopy the '('
    mov    cx,1
scan_lpar_1:
    lodsb            ;can't use movsb, because it doesn't load al
    stosb
    cmp    al,'('
    je    scan_lpar_2
    cmp    al,')'
    jne    scan_lpar_1
    cmp    si,bp            ;was this our sentinel?
    je    init_ids_jump_2        ;yes - we're gone.
    loop    scan_lpar_1
    dec    di        ;remove final rpar
    mov    ax,offset scan_copy
    jmp    scan_loop
scan_lpar_2:
    inc    cx
    jmp    scan_lpar_1
init_ids_jump_2:
    jmp    init_ids

scan_rpar:
;si -> neutral string
;di -> active string
;dx -> previous argument or function pointer.
    dec    di            ;uncopy the ')'
    cmp    si,bp            ;if we scan off the right end, init_ids
    je    init_ids_jump_2
    call    scan_rpar_sub
    call    buffer_check
    jnz    buffers_be_bad
  if timing
    call    readtimer        ;subtract off the start time.
    sub    times[di-2],ax
    inc    counts[di-2]
    push    di
  endif
    call    function_address[di-2]
  if timing
    call    readtimer        ;add in the finishing time
    pop    bx
    add    times[bx-2],ax
  endif
    extrn    buffer_check: near
    call    buffer_check
    jnz    buffers_bad
    mov    bp,data_botbot
    mov    bx,offset scan_xlat_table    ;->translate table
    mov    ax,offset scan_copy
    jmp    scan_loop
buffers_be_bad:
    mov    word ptr buffers_be_msg,ax
buffers_be_bad_1:
    mov    dx,offset buffers_bad_msg
    mov    ah,9
    int    21h
    mov    ah,7
    int    21h
    jmp    buffers_be_bad_1
buffers_bad:
    mov    dx,offset buffers_bad_msg
    mov    ah,9
    int    21h
    mov    ah,7
    int    21h
    jmp    buffers_bad

scan_comma:
    mov    al,comma_marker
scan_mark:
    mov    [di-1],al    ;store marker where the character was copied.
    mov    ax,dx        ;get previous pointer
    mov    dx,di        ;save current (will soon be previous)
    stosw
    mov    ax,offset scan_copy
scan_copy_j_1:
    jmp    scan_loop

scan_sharp:
    cmp    word ptr [si],'(#'    ;'##(' ?
    je    scan_two_sharps        ;yes.
    cmp    byte ptr [si],'('    ;'#(' ?
    jne    scan_copy_j_1        ;no.
    inc    si
    mov    al,active_marker
    jmp    scan_mark
scan_two_sharps:
    add    si,2
    mov    al,neutral_marker
    jmp    scan_mark

    public    abort_fatal
abort_fatal:
    add    sp,22            ;magic number from Z-DOS II, page I.3
    pop    es            ;restore our es and ds.
    push    es
    pop    ds
    mov    sp,offset stackp
    sti                ;enable interrupts again.
    mov    si,offset protected_prompt
    cmp    di,0            ;write protect?
    je    nomem_1
    mov    si,offset fatal_prompt
    jmp    short nomem_1
    public    nomem
nomem:
    esdata
    dsdata
    mov    sp,offset stackp
    mov    si,offset nomem_prompt
nomem_1:
    lodsb
    or    al,al
    je    nomem_2
    mov    dl,al
    mov    ah,2
    int    21h
    jmp    nomem_1
nomem_2:
    jmp    init_ids

    extrn    init_ids: near
    extrn    buffer_free: near

    public    init_ids_continue, init_ids_first
init_ids_continue:
    cld
    mov    ax,data_botbot        ;get rid of the active string.
    mov    data_bottop,ax
    mov    data_topbot,offset lomem;get rid of the neutral string.
    mov    di,next_ids        ;get the desired idling string.
    mov    si,di            ;save a copy
    mov    next_ids,offset standard_ids    ;reset to ids.
    mov    al,0
    mov    cx,-1
    repne    scasb        ;find the terminating null.
    not    cx
    mov    ax,ds
    call    buffer_free
    mov    di,data_botbot
    sub    di,cx
    dec    di            ;leave room for a sentinel
    mov    data_bottop,di
    rep    movsb
    mov    al,')'            ;use an extra ')' as a sentinel
    stosb
init_ids_first:
    mov    cx,256            ;get at least a little bit of room.
    mov    ax,ds
    call    buffer_free
    mov    si,data_bottop
    mov    di,data_topbot
    mov    dx,0
    mov    bp,data_botbot
    mov    bx,offset scan_xlat_table    ;->translate table
    mov    ax,offset scan_copy
    jmp    scan_loop
init_ids_jump_1:
    jmp    init_ids


    public    scan_rpar_sub
scan_rpar_sub:
;store last argument mark
    mov    al,comma_marker
    stosb
    mov    ax,di        ;make final arg -> itself
    stosw
comment @can't use slash***************************************************
    We have a problem here.  Currently, the pointers point backwards
to the previous function/arg.  We want this function's pointers to point
forwards, so we can start at the active/neutral marker and count arguments
forwards.

     __ is a pointer, ^ is what it points to.


    a__SS,__ONE,__TWO,__
      ^    ^    !^    !^
      !   !!    !!    !!
      \___/\____/!    \/
             dx
**********************************************************************@
    mov    fend,di
    mov    data_topbot,di
    sub    di,2        ;make di ->final pointer
    mov    data_bottop,si
scan_rpar_1:
    cmp    dx,0        ;if end of list, we must be running off
    je    init_ids_jump_1    ; the left end (too many rpars)
    mov    bx,dx        ;get previous pointer.
    mov    dx,[bx]        ;get the current pointer [previous pointer].
    mov    [bx],di        ;store the next pointer.
    mov    di,bx        ;save current pointer.
; bx, di -> current arg/fcn
; dx -> previous (to the left) arg/fcn
    test    byte ptr -1[bx],function_marker_mask
    jz    scan_rpar_1
    mov    al,-1[bx]
    mov    fcn_save,al        ;remember the type of function.
    mov    prev_fcn,dx
    mov    fbgn,bx
    call    check_breakchar        ;check for a break.
    jnc    got_break_char        ;got it.
    call    trace_invoke        ;destroys al
;remember that fbgn is really one more than the space taken by the function.
    mov    ax,[bx]            ;get pointer to first arg.
    sub    ax,bx            ;compute length of name
    cmp    ax,2 + mark_overhead    ;two character function name?
    jne    default_to_cl        ;no - must be default.
    mov    ax,2[bx]        ;get function name.
    extrn    store_debug: near
    call    store_debug
    mov    di,offset function_name_table
    mov    cx,offset function_name_length
    repne    scasw
    jne    default_to_cl        ;if not found, default
    sub    di,offset function_name_table
    ret
default_to_cl:
    mov    ax,'d*'
    call    store_debug
    mov    di,0
    ret
got_break_char:
    jmp    init_ids

;return data routines here

    public    return_null
return_null:
    mov    cx,0
    call    trace_result    ;destroys al
return_nothing:
    mov    si,data_bottop
    mov    di,fbgn
    dec    di
    mov    dx,prev_fcn
    ret


    public    return_string
return_string:
;al=string number to return, bx=>list of strings.
    add    al,al
    mov    ah,0
    add    bx,ax
    mov    si,[bx]
    mov    cx,[bx+2]
    sub    cx,si
    jmp    return_sicx


    public    return_tos
return_tos:
;tos -> string, di -> byte after end of string
    pop    si
    mov    cx,di
    sub    cx,si
    jmp    short return_sicx


    public    make_active
make_active:
;force a function's return value to be active.
;return zr if the function already was active.
    cmp    fcn_save,active_marker
    mov    fcn_save,active_marker
    ret


    public    return_arg_active
return_arg_active:
    mov    fcn_save,active_marker
;falls through
;
    public    return_arg
return_arg:
;enter with cx = number of arg to return.
    call    getarg
;fall through to return_sicx


    public    return_sicx
return_sicx:
;si -> string, cx = count.
    cmp    fcn_save,active_marker    ;active or neutral
    jne    return_neutral
;    jmp    return_active        ;fall through!


    public    return_active
return_active:
;we need to move [si] count cx
; to [data_bottop-cx] through [data_bottop-1] reverse
;Then we return si = [data_bottop-cx], di=fbgn-1
    call    trace_result    ;destroys al
    jcxz    return_nothing    ;quick check for 0 chars.
    mov    di,data_bottop
    dec    di
    add    si,cx        ;point si to end of string + 1.
    dec    si        ;remember, it's postdecrement.
    std            ;reverse move
    rep    movsb
    cld            ;everybody assumes it's cleared.
    inc    di        ;make di -> last byte moved.
    mov    si,di        ;si -> what we just moved.
    mov    di,fbgn        ;remove previous function.
    dec    di
    mov    dx,prev_fcn
    ret

    public    return_neutral
return_neutral:
;we need to move [si] count cx
; to [fbgn-1] through [fbgn-1] - (cx - 1)
;Then we return si=data_bottop, di=[fbgn-1] - cx
    call    trace_result    ;destroys al
    jcxz    return_nothing    ;quick check for 0 chars.
    mov    di,fbgn
    dec    di
    cmp    di,si        ;is it there already?
    je    return_neutral_1    ;yes, save some time.
    rep    movsb        ;put it there.
return_neutral_1:
;tricky time!  If we performed the movsb, cx is zero, so we're doing
;nothing.  If we took the jump to return_neutral_1, cx is the proper
;count, so di will point to the right place.
    add    di,cx
    mov    si,data_bottop
    mov    dx,prev_fcn
    ret


    extrn    trace_result: near
    extrn    trace_invoke: near

;utility subroutines


    extrn    check_breakchar: near


    public    getarg1, getarg
getarg1:    mov    cx,1

;fall through to getarg

getarg:

;enter with cx = number of argument to get.
;exit with si -> argument, cx=length of argument.

comment /****************************************************************

The pointer after the last supplied argument points to itself, which allows
us to loop at getarg_loop until we think that we have found the argument.  Of
course, if that argument has not been supplied, all that we've done is to chase
the last pointer a few times.  As an aside, had you ever noticed that when the
amount of comments exceeds the amount of code, the code is likely to be
confusing?  Well, this code is probably confusing.

*************************************************************************/
    mov    si,fbgn
    jcxz    getarg_2    ;skip loop if count is zero.
getarg_loop:
    mov    si,[si]        ;get our argument
    loop    getarg_loop
getarg_2:
    mov    cx,[si]        ;get cx=next argument
    sub    cx,si        ;get cx=length of our argument
    jcxz    getarg_1    ;in case we ran into fend, it doesn't matter what si -> to.
    sub    cx,mark_overhead
    add    si,mark_overhead-1    ;make si-> text of argument.
getarg_1:
    ret


  if timing
readtimer:
;exit with dx:ax set to the time since the last tick.
    cmp    counting,0
    je    readtimer_2

    mov    al,00h            ;Latch timer 0
    out    043h,al
    in    al,040h            ;Counter --> bx*/
    mov    ah,al            ;LSB in BL
    in    al,040h
    xchg    ah,al
    not    ax            ;Need ascending counter

readtimer_2:
    ret
  endif


code    ends

    end