Category : Files from Magazines
Archive   : DDJ-9003.ZIP
Filename : WRIGHT.LST

Output of file : WRIGHT.LST contained in archive : DDJ-9003.ZIP
by Karl Wright and Rick Schell


;* 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 **
procret macro
if @codesize

;** 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 **
errstk dw ? ;SP at last error log (-1 if none).

;** 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

;[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
@@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.

;[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


;* 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 **

extrn pascal ERROR_LOG:proc ;Long jump library procedure for errors.

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

;** 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
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
@@err: ;Out-of-memory error.
mov ax,err_memory
call error_log pascal,ax
;Never returns.
heap_alloc endp



;* 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 **
err_hash = 2 ;Out of hash space error number.
err_read = 3 ;Read error.

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

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 **
extrn pascal HEAP_ALLOC:proc ;Heap allocation.

extrn pascal ERROR_LOG:proc ;Trap an error.

;** Data structure **
symtbl struc
symref dw ? ;Reference count.
symsiz dw ? ;Length of word.
symnam = size symtbl ;Offset of start of name text.

;** Initialized data **
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 **

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.

rbfptr dw ? ;Segment address of read buffer.

wrdbuf db 256 dup (?)

;** 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
mov cx,hshsiz
xor ax,ax
rep stosw
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.
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.
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.
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
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.
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
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]
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
@@l1: lodsw
and ax,ax
jnz @@take
@@next: loop @@l1
@@take: push cx ds
push ss
pop ds
call @@scan_proc pascal,ax
pop ds cx
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]


;* 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 **
;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

;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
@@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
sort_do endp



/***** 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 ***/

/*** 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 ) {
heap_init (starting_segment, segment_count);
word_init (32767);
for( i=1 ; i file_handle = _open (global_argv[i], O_RDONLY);
if (file_handle != -1 ) {
word_read( file_handle);
_close( file_handle );
} else {

/* Obtain array address */
sort_array = (unsigned far *)heap_alloc((word_count()+7)/8);
/* Fill array */
sort_index = 0;
/* 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 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;
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);


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

  3 Responses to “Category : Files from Magazines
Archive   : DDJ-9003.ZIP
Filename : WRIGHT.LST

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: