ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/DDJMAG/DDJ9003.ZIP/WRIGHT.LST

File List | 1990-02-13 | 18.4 KB | 740 lines

MIXED-LANGUAGE PROGRAMMING WITH ASM
by Karl Wright and Rick Schell

[LISTING ONE]


;* Module description * This module takes care of error trapping. The scheme
;used records the trapping routine stack pointer so that an error can cause
;the stack to return to a consistent state. This module was written using
;Borland's Turbo Assembler 2.0.

;** Environment **
.model small    ;Set up for SMALL model.
locals        ;Enable local symbols.

;** Macros **
;<<Generate correct return based on model>>
procret macro
if @codesize
    retf
else
    retn
endif
endm

;** Public operations **
public pascal ERROR_INIT    ;Initialize error handler.
public pascal ERROR_TRAP    ;Set up error trap.
public pascal ERROR_LOG        ;Log error.

;** Uninitialized data **
.data?
errstk    dw ?    ;SP at last error log (-1 if none).

;** Code **
.code
;Set up DS to nothing since that is the typical arrangement.
assume ds:nothing

;[Initialize error manager]
error_init proc pascal        ;Declare proc with PASCAL calling conventions.
    mov errstk,-1
    ret
endp

;[Set up error trap]
;This procedure preserves the previous ERRSTK, sets up a new ERRSTK, and
;calls the passed procedure.  On exit, the previous ERRSTK is restored.
error_trap proc pascal        ;Pascal calling conventions.
arg @@proc:codeptr        ;Only argument is procedure to call.
uses ds,si,es,di        ;Force a save of all registers C cares for.
    push errstk
    ;Call internal routine to record return address on stack.
    call @@rtn
    pop errstk
    ret
@@rtn    label proc
    mov errstk,sp        ;Save SP so we can restore it later.
    call @@proc pascal    ;Call procedure.
    xor ax,ax        ;Return code = 0 for normal return.
    procret
endp

;[Log error]
;Control is passed to the last ERROR_TRAP, if any.
;Error code is passed and returned in AX.
error_log proc pascal
arg @@error_code:word
    cmp errstk,-1        ;Lock up if no error address.
@@1:    jz @@1
    mov ax,@@error_code
    mov sp,errstk
    procret
endp
end



[LISTING TWO]

;* Module description * This module manages a simple stack-based heap.
;Deallocation is not supported. NOTE: This module must be assembled with /MX
;to publish symbols in the correct case. This module is written using
;Borland's Turbo Assembler 2.0.

;** Environment **
.model small    ;Set up for SMALL model.
locals        ;Enable local symbols.

;** Equates **
err_memory = 1    ;Out of memory error number.

;** Public operations **
public pascal HEAP_INIT        ;Initialize heap.
public pascal HEAP_ALLOC    ;Allocate memory from heap.

;** External operations **

;<<Error handler>>
extrn pascal ERROR_LOG:proc    ;Long jump library procedure for errors.

;** Uninitialized data **
.data?
memptr    dw ?    ;Pointer to first free segment.
memsiz    dw ?    ;Remaining paragraphs in heap.

;** Code **
.code
;Set up DS to nothing since that is the typical arrangement.
assume ds:nothing

;[Initialize the heap]
heap_init proc pascal        ;Declare proc with PASCAL calling conventions.
arg @@start_seg:word,@@para_size:word
                ;Arguments are starting segment and para count.
    mov ax,@@start_seg
    mov memptr,ax
    mov ax,@@para_size
    mov memsiz,ax
    ret
heap_init endp

;[Allocate memory from the heap]
heap_alloc proc pascal        ;Declare proc with PASCAL calling conventions.
arg @@para_count:word        ;Only argument is count of paragraphs.
    ;See if there is enough remaining.
    mov ax,@@para_count
    cmp memsiz,ax
    jc @@err
    sub memsiz,ax
    add ax,memptr
    xchg ax,memptr
    mov dx,ax
    xor ax,ax
    ret
@@err:    ;Out-of-memory error.
    mov ax,err_memory
    call error_log pascal,ax
    ;Never returns.
heap_alloc endp

end


[LISTING THREE]

;* Module description * This module reads source files and converts them into
;words, then files the words away in a symbol table with the help of a hash
;function. This module was written using Borland's Turbo Assembler 2.0.

;** Environment **
.model small    ;Set up for SMALL model.
locals        ;Enable local symbols.

;** Equates **
;<<Error numbers>>
err_hash = 2    ;Out of hash space error number.
err_read = 3    ;Read error.

;<<Hash function>>
hash_rotate = 5    ;Amount to rotate for hash function.
hash_skip   = 11;Number of entries to skip on hash collision.

;<<Read buffer>>
rbf_size = 800h    ;Size of read buffer in paragraphs.

;** Public operations **
public pascal WORD_INIT        ;Initialize hash table.
public pascal WORD_READ        ;Read file, convert to words, and hash them.
public pascal WORD_COUNT    ;Get total word count.
public pascal WORD_NAME        ;Get name of word.
public pascal WORD_REFCOUNT    ;Get reference count of word.
public pascal WORD_SCAN        ;Scan all words.
public pascal WORD_COMPREF    ;Compare word reference counts.

;** External operations **
;<<Heap>>
extrn pascal HEAP_ALLOC:proc    ;Heap allocation.

;<<Error handling>>
extrn pascal ERROR_LOG:proc    ;Trap an error.

;** Data structure **
;<<Symbol table entry>>
symtbl struc
symref    dw ?    ;Reference count.
symsiz    dw ?    ;Length of word.
ends
symnam    = size symtbl    ;Offset of start of name text.

;** Initialized data **
.data
;<<Translation character type table>>
typdlm    = 1    ;Delimiter bit.
typnum    = 2    ;Numerical digit.
typcas    = 20h    ;Lower case bit: Set if lower case letter.
xlttbl    label byte
    db '0' dup (typdlm)
    db 10 dup (typnum)
    db ('A'-1)-'9' dup (typdlm)
    db 'Z'-('A'-1) dup (0)
    db ('a'-1)-'Z' dup (typdlm)
    db 'z'-('a'-1) dup (typcas)
    db 255-'z' dup (typdlm)

;** Uninitialized data **
.data?

;<<Hash table values>>
hshptr    dw ?    ;Segment address of hash table.
hshsiz    dw ?    ;Total number of hash entries.  Must be a power of 2!
hshcnt    dw ?    ;Total free entries remaining in hash table.
hshmsk    dw ?    ;Mask for converting hash value to address.

;<<Read buffer values>>
rbfptr    dw ?    ;Segment address of read buffer.

;<<Word buffer>>
wrdbuf    db 256 dup (?)

;** Code **
.code
;Set up DS to nothing since that is the typical arrangement.
assume ds:nothing

;[Initialize hash table]
word_init proc pascal
arg @@max_word_count:word    ;Argument: Maximum number of words.
uses es,di
    ;First, allocate read buffer.
    mov ax,rbf_size
    call heap_alloc pascal,ax
    mov rbfptr,dx
    ;Now convert maximum word count to power of 2.
    mov ax,@@max_word_count
    mov cl,16+1
@@l1:    dec cl
    shl ax,1
    jnc @@l1
    mov ax,1
    shl ax,cl
    ;Initialize some hash parameters.
    mov hshsiz,ax
    mov hshcnt,ax
    dec ax
    shl ax,1
    mov hshmsk,ax
    ;Now, allocate hash table from heap.
    mov ax,hshsiz        ;Size of hash table in words.
    add ax,7
    mov cl,3
    shr ax,cl        ;Convert to paragraphs.
    call heap_alloc pascal,ax
    mov hshptr,dx
    ;Clear out hash table: 0 means 'no value'.
    mov es,dx
    xor di,di
    cld
    mov cx,hshsiz
    xor ax,ax
    rep stosw
    ret
word_init endp

;[Read file and assimilate all words]
word_read proc pascal
arg @@handle:word        ;Argument is file handle.
uses ds,si,es,di
    ;Load XLAT buffer address.  The XLAT table is used for case conversion
    ;and for character type identification.
    mov bx,offset xlttbl
@@read:    ;Read next buffer while delimiter processing.
    call @@brd
    jcxz @@done
@@skip:    ;Skip all delimeters, etc.
    lodsb
    xlat xlttbl
    test al,typdlm
    loopnz @@skip
    jnz @@read
    ;Adjust pointer & count.
    dec si
    inc cx
    ;If it is a number, skip to end.
    test al,typnum
    jnz @@num
    ;It is a word. We'll transfer a word at a time to the word buffer,
        ;hashing it as we go. DX will be the current hash value. CX is the
        ;amount remaining in the buffer.
    xor dx,dx
    ;Initialize output address.
    push ss
    pop es
    mov di,offset wrdbuf
@@clp:    ;Transfer.  This is THE most time-critical loop in the program.
    lodsb            ;Read character.
    mov ah,al
    xlat xlttbl        ;Get its type.
    test al,typdlm        ;Abort if delimiter.
    jnz @@wend
    and al,typcas        ;Use case bit to convert to upper case.
    neg al
    add al,ah
    stosb            ;Save it in word buffer.
    ;Calculate hash value.
    mov ah,cl
    mov cl,hash_rotate
    rol dx,cl
    mov cl,ah
    xor dl,al
    loop @@clp        ;Keep going until end of buffer.
    ;End of buffer while word processing.  Read more.
    call @@brd
    jcxz @@wnd2
    jmp @@clp
@@nrd:    ;Read next buffer while number processing.
    call @@brd
    jcxz @@done
@@num:    ;Numbers are not considered 'words' and should be skipped.
    ;Skip up to first delimiter.
    lodsb
    xlat xlttbl
    test al,typdlm
    loopz @@num
    jz @@nrd
    ;Adjust pointer and count.
    dec si
    inc cx
    jmp @@skip
@@done:    ret
@@wend:    ;End of word.  Adjust buffer pointer.
    dec si
@@wnd2:    ;End of word.  Hash value is in DX, upper-case word is in WRDBUF,
    ;DI points to end of word + 1.
    push ds si cx bx    ;Save the registers we will use for this step.
    xor al,al        ;Null-terminate the word.
    stosb
    mov cx,di        ;Calculate the word's length.
    sub cx,offset wrdbuf
    mov bx,dx        ;Put the hash value in a useable register.
    shl bx,1        ;Lower bit will be discarded, so shift.
    push ss            ;Initialize DS.
    pop ds
    assume ds:dgroup
    ;Now it is time to locate the word in the hash table if it is there,
    ;or create an entry if it is not.
@@hlp:    mov es,hshptr
    and bx,hshmsk
    mov ax,es:[bx]
    and ax,ax
    jz @@make
    ;Verify that the hash entry is the correct one.
    mov es,ax
    mov ax,cx
    cmp es:[symsiz],ax    ;Compare length of word.
    jnz @@coll
    mov si,offset wrdbuf    ;Compare actual text if that agrees.
    mov di,symnam
    repz cmpsb
    mov cx,ax
    jz @@fd
@@coll:    ;Collision!  Advance to the next candidate hash entry.
    add bx,hash_skip*2
    jmp @@hlp
@@dne2:    ret
@@make:    ;We have encountered this word for the first time.
    ;We must create a new symbol entry of the appropriate size.
    ;First decrement remaining free hash count.
    dec hshcnt
    jz @@herr
    push cx
    push bx
    mov ax,cx        ;Calculate length of symbol descriptor.
    add ax,symnam+15
    mov cl,4
    shr ax,cl
    call heap_alloc pascal,ax
    pop bx            ;Record symbol descriptor in hash table.
    mov es:[bx],dx
    pop cx            ;Record length.
    mov es,dx
    mov es:[symsiz],cx
    mov di,symnam        ;Move text of word into symbol table.
    mov si,offset wrdbuf
    shr cx,1
    rep movsw
    rcl cx,1
    rep movsb
    mov es:[symref],0    ;Clear reference count.
@@fd:    ;Matching entry found!  Increment reference count.
    inc es:[symref]
@@nwd:    ;Go on to the next word in the buffer, if any.
    pop bx cx si ds
    assume ds:nothing
    jcxz @@dne2
    jmp @@skip
@@herr:    ;Out of hash space error.
    mov ax,err_hash
    call error_log pascal,ax
    ;No return from ERROR_LOG.
;(Read buffer)
;Reads the next hunk of buffer.  Returns actual amount read in CX,
;DS:SI as start of data to read.
@@brd:    push dx bx
    mov cx,rbf_size*16
    mov bx,@@handle
    mov ah,3fh
    mov ds,rbfptr
    xor dx,dx
    int 21h
    jc @@err
    mov cx,ax
    xor si,si
    pop bx dx
    cld
    retn        ;Use RETN so stack frame return won't be generated.
@@err:    ;Read error.
    mov ax,err_read
    call error_log pascal,ax
    ;No return is needed because ERROR_LOG never returns.
word_read endp

;[Get total word count]
word_count proc pascal
    mov ax,hshsiz        ;Load total word capacity.
    sub ax,hshcnt        ;Subtract actual remaining free words.
    ret
word_count endp

;[Get address of name of word]
word_name proc pascal
arg @@word_desc:word        ;Argument is word descriptor.
    mov dx,@@word_desc
    mov ax,symnam
    ret
word_name endp

;[Get refcount for word]
word_refcount proc pascal
arg @@word_desc:word        ;Argument is word descriptor.
uses ds
    mov ds,@@word_desc
    mov ax,ds:[symref]
    ret
word_refcount endp

;[Scan all words]
word_scan proc pascal
arg @@scan_proc:codeptr        ;Argument is procedure to call for each word.
uses ds,si
    mov ds,hshptr
    xor si,si
    mov cx,hshsiz
    cld
@@l1:    lodsw
    and ax,ax
    jnz @@take
@@next:    loop @@l1
    ret
@@take:    push cx ds
    push ss
    pop ds
    call @@scan_proc pascal,ax
    pop ds cx
    cld
    jmp @@next
word_scan endp

;[Compare reference counts for two word descriptors]
word_compref proc pascal
arg @@word_desc1:word,@@word_desc2:word
uses ds
    mov ds,@@word_desc2
    mov ax,ds:[symref]
    mov ds,@@word_desc1
    sub ax,ds:[symref]
    ret
endp
end


[LISTING FOUR]

;* Module description * This module contains the sort routine for SPECTRUM.
;This module was written using Borland's Turbo Assembler 2.0.

;** Environment **
.model small    ;Set up for SMALL model.
locals        ;Enable local symbols.

;** Public operations **
public pascal SORT_DO        ;Perform sort.

;** Code **
.code
;Set up DS to nothing since that is the typical arrangement.
assume ds:nothing

;[Sort procedure]
sort_do proc pascal
arg @@array:dword,@@count:word,@@compare_proc:codeptr
uses ds,si,di

    ;First load up registers for internal recursion.  DS:SI will be
    ;the current sort array address, CX the count of elements to sort.
    lds si,@@array
    mov cx,@@count
    call @@sort
    ret

;Internally recursive sort routine. This routine accepts DS:SI as the sort
;array address, and CX as the count of elements to sort.
@@sort:    cmp cx,2
    jnc @@go
    retn
@@go:    ;Save all registers we will change.
    ;Internally, DI and DX will be start and count of second merge area.
    push si cx di dx
    ;Divide into two parts and sort each one.
    mov dx,cx
    shr cx,1
    sub dx,cx
    call @@sort
    mov di,si
    add di,cx
    add di,cx
    xchg si,di
    xchg cx,dx
    call @@sort
    xchg cx,dx
    xchg si,di
    ;Now, merge the two areas in place.
    ;Each area must be at least size 1.
@@mrgl:    ;Compare - DS:DI - DS:SI.
    call @@compare_proc pascal,ds:[di],ds:[si]
;;The following commented-out sequence is the code that would be required
;;if strict Pascal calling conventions were adhered to for calling
;;COMPARE_PROC.  You can see how much extra work this is!!
;;    push cx dx
;;    push ds
;;    mov ax,ds:[di]
;;    mov bx,ds:[si]
;;    push ss
;;    pop ds
;;    call @@compare_proc pascal,ax,bx
;;    pop ds
;;    pop dx cx
;;    and ax,ax
    jns @@ok
    ;Slide up first merge area using starting value from DI.
    mov ax,ds:[di]
    push si cx
@@sllp:    xchg ax,ds:[si]
    add si,2
    loop @@sllp
    xchg ax,ds:[si]
    pop cx si
    add si,2
    add di,2
    dec dx
    jnz @@mrgl
    jmp short @@exi
@@ok:    ;Correct so far.  Advance SI.
    add si,2
    loop @@mrgl
@@exi:    ;Restore registers.
    pop dx di cx si
    retn
sort_do endp

end


[LISTING FIVE]

/***** File: SPECTRUM.C *****/
/* This C module is written using Borland's Turbo C 2.0 and can be
   compiled using the default switches.  It should be linked with the file
   WILDARGS.OBJ from the Turbo C examples directory to enable the wildcard
   file name expansion facility.  Without WILDARGS, SPECTRUM will still work
   but will not be capable of expanding file names with wildcards.

   The following is an example make file, where TA is the assembler name, TCC
   is the C compiler name, TLINK is the linker name, \TC\LIB contains the C
   libraries, and \TC\EXA contains the Turbo C examples:

spectrum.exe: spectrum.obj heap.obj word.obj error.obj sort.obj
   tlink \tc\lib\c0s+\tc\exa\wildargs+spectrum+heap+word+error+sort,spectrum,,\tc\lib\cs.lib;
heap.obj: heap.asm
    ta heap /mx;
word.obj: word.asm
    ta word /mx;
error.obj: error.asm
    ta error /mx;
sort.obj: sort.asm
    ta sort /mx;
spectrum.obj: spectrum.c
    tcc -c spectrum
*/

/*** Header Files ***/
#include <dos.h>
#include <stdio.h>
#include <fcntl.h>

/*** Function Protypes ***/
/* Used Locally */
int allocmem( unsigned, unsigned * );
int freemem ( unsigned );
int _open( const char *, int oflags );
int _close( int );
/* Error trapper */
extern void pascal error_init (void);
extern unsigned pascal error_trap (void pascal (*execution_procedure)() );
extern void pascal error_log (unsigned error_code);
/* Heap */
extern void pascal heap_init (unsigned starting_segment, unsigned segment_count);
extern void far * pascal heap_alloc (unsigned paragraph_count);
/* Symbol table */
extern void pascal word_init (unsigned maximum_word_count);
extern void pascal word_read (unsigned file_handle);
extern void pascal word_scan (void pascal (*word_procedure)() );
extern char far * pascal word_name (unsigned word_descriptor);
extern unsigned pascal word_refcount (unsigned word_descriptor);
extern unsigned pascal word_count (void);
extern int pascal word_compref (unsigned word_desc1, unsigned word_desc2);
/* Sorting procedure */
extern void pascal sort_do (unsigned far *sort_array, unsigned sort_count,int pascal (*compare_procedure)() );

/*** Global Variables ***/
/* Error table */
char * error_table [] = {
"Insufficient Memory\n",
"Out of Hash Space\n",
"File Read Error\n",
"Usage: SPECTRUM filespec [filespec] ... [filespec]\n(filespec may have ?,*)\n"
};

/* Arguments */
int global_argc;
char **global_argv;

/* Memory */
unsigned segment_count;
unsigned starting_segment;

/* Sort array */
unsigned sort_index;
unsigned far *sort_array;

/**** Procedures ****/
/* Fill sort array with descriptors */
void pascal array_fill(unsigned word_desc)
{
    sort_array[sort_index++] = word_desc;
}

/* Main execution procedure */
void pascal main2 (void)
{
    int i;
    unsigned j;
    int words = 0;
    int file_handle;
    if( global_argc < 2 ) {
    error_log(4);
    }
    heap_init (starting_segment, segment_count);
    word_init (32767);
    for( i=1 ; i<global_argc ; i++ ) {
    file_handle = _open (global_argv[i], O_RDONLY);
    if (file_handle != -1 ) {
        word_read( file_handle);
        _close( file_handle );
        } else {
        error_log(3);
        }
    }

    /* Obtain array address */
    sort_array = (unsigned far *)heap_alloc((word_count()+7)/8);
    /* Fill array */
    sort_index = 0;
    word_scan(array_fill);
    /* Sort array */
    printf ("Sorting...\n");
    sort_do (sort_array, sort_index, word_compref);

    /* Display output */
    printf ("\nCount\tWord\n");
    printf ("-----\t----\n");
    for (i=0 ; i<sort_index-1 ; i++) {
    j = word_refcount(sort_array[i]);
    words = words + j;
    printf ("%d",j);
    printf ("\t");
    printf ("%Fs",word_name(sort_array[i]));
    printf ("\n");
    }
    printf ("\nTotal unique words:\t%d\n",sort_index);
    printf ("Total words:\t\t%d\n",words);
}

/* Main procedure */
int main( int argc, char *argv[] )
{
    int i;
    /* Copy arguments */
    global_argc = argc;
    global_argv = argv;
    error_init();
    segment_count = allocmem(65535,&starting_segment);
    allocmem( segment_count, &starting_segment );
    i = error_trap ( main2 );
    if (i != 0) {
    /* Print error message */
    printf (error_table[i-1]);
    }
    freemem (starting_segment);
    return (i);
}



[LISTING SIX]

spectrum.exe: spectrum.obj heap.obj word.obj error.obj sort.obj
  tlink /v \tc\lib\c0s+\tc\exa\wildargs+spectrum+heap+word+error+sort, spectrum,,\tc\lib\cs.lib;
heap.obj: heap.asm
    ta heap /mx /zi
word.obj: word.asm
    ta word /mx /zi
error.obj: error.asm
    ta error /mx /zi
sort.obj: sort.asm
    ta sort /mx /zi
spectrum.obj: spectrum.c
    tcc -c -v spectrum