Category : Files from Magazines
Archive   : VOL9N16.ZIP
Filename : UTL.ASM

 
Output of file : UTL.ASM contained in archive : VOL9N16.ZIP
; UTL.ASM
; (c) 1989, 1990 Ashok P. Nadkarni
;
; General utility functions for CMDEDIT. SMALL model only. Also assume
; ES == DS.
;

INCLUDE common.inc
INCLUDE general.inc
INCLUDE ascii.inc
INCLUDE dos.inc
INCLUDE buffers.inc

PUBLIC stre_cmp
PUBLIC tolower
PUBLIC xlate_lower
PUBLIC getargs
PUBLIC isalphnum
PUBLIC iscntrl
PUBLIC isspace
PUBLIC isdelim
PUBLIC bell
PUBLIC push_string
PUBLIC push_word
PUBLIC skip_nonwhite
PUBLIC skip_whitespace
PUBLIC skip_nondelim
PUBLIC output_newline
PUBLIC output_counted_string

EXTRN silent:BYTE
EXTRN lastchar:WORD
EXTRN linebuf:BYTE


CSEG SEGMENT PARA PUBLIC 'CODE'

DGROUP GROUP CSEG

ASSUME CS:DGROUP,DS:DGROUP,ES:DGROUP,SS:DGROUP

;+
; FUNCTION : stre_cmp
;
; Does a case-insensitve comparison of two strings of equal length.
;
; Parameters:
; DS:SI := Address of string 1.
; ES:DI := Address of string 2.
; CX := Length.
;
; Returns:
; If string 1 = string 2, ZF = 1, CF = 0.
; If string 1 < string 2, ZF = 0, CF = 1.
; If string 1 > string 2, ZF = 0, CF = 0.
; Registers AX,CX destroyed.
;-
stre_cmp proc near
@save si,di,dx
dec si ;Prime for loop
dec di
xor ax,ax ;Clear flags
jcxz @stre_cmp_99
@stre_cmp_10:
cmpsb ;Point SI,DI to next byte
mov al,[si] ;String 1 byte
call near ptr tolower ;al := Uppercase version
xchg al,dl ;Save it.
mov al,ES:[di] ;Ditto for string 2
call near ptr tolower ;al := Uppercase version
cmp dl,al ;Compare string 1 with string 2
@stre_cmp_20:
loope @stre_cmp_10 ;Keep looping as long as equal
@stre_cmp_99:
@restore
ret
stre_cmp endp


;+
; FUNCTION : tolower
;
; Converts the character in AL to lower case if it is a upper case
; character, else leaves it unchanged.
;
; Parameters:
; Al := character
;
; Returns:
; AL := lowercase version or unchanged
;-
tolower proc near
cmp al,'A'
jb @tolower_99
cmp al,'Z'
ja @tolower_99
add al,20h
@tolower_99:
ret
tolower endp



;+
; FUNCTION : xlate_lower
;
; Converts the passed string to lower case.
;
; Parameters:
; AX := length of string
; SI := address of string
;
; Returns:
; Nothing.
;
; Registers destroyed:
; AX,CX
;-
xlate_lower proc near
@save si,di
mov di,si
mov cx,ax
jcxz @xlate_lower_99

@xlate_lower_10:
lodsb
call near ptr tolower
stosb
loop @xlate_lower_10

@xlate_lower_99:
@restore
ret
xlate_lower endp



;+ FUNCTION : getargs
;
; getargs does one of two functions depending on the value in AX.
; If AX = 0, returns count of arguments in the line,
; else if AX = n, returns the nth argument.
;
; The argument separators are tab and space. Note that a
; carraige return (0Dh) terminates a line even if the byte
; count indicates otherwise. Arguments containing a SPACE or
; TAB separator may be specified by enclosing them in a pair of
; quotes ("). The quotes do NOT act as argument delimiters. For
; example the following line
; this"is a single "arg
; contains exactly one argument. An unmatched quote causes the
; remaining characters in the line to be treated as a single
; argument. A quote character can be included as part of an
; argument by preceding it with a ESCARG character. An ESCARG preceding
; any other character does not have any special meaning.
; Note that all other characters including the NUL char (00h)
; have no special significance.
;
; Parameters:
; DS:SI points to the line
; AX = argument number n
; CX = Length of line
; If parameter n != 0,
; then BX = address of user buffer where the returned argument is to
; be stored. This param need not be present if n is 0.
; DX = length of user buffer.
;
;
; Returns:
; If parameter n was 0,
; return argument count in AX (CF is undefined),
; else
; Store n'th argument in the buffer pointed to by BX and
; return the number of chars in the argument in AX.
; The returned argument has quotes and ESCARGes stripped
; out where appropriate. If the buffer is too small, CF
; is set to 1, else it is 0. In this case the user buffer
; contents are undefined.
; BX is explicitly unchanged.
;
; Registers CX,DX are destroyed.
;-
getargs proc near
ESCARG EQU PERCENT
@save si,di
push bp
mov bp,sp
sub sp,2
userbuf_len EQU
mov di,ax ;save argument number

xor ax,ax ;al will hold char, ah will hold state
mov userbuf_len,dx ;Save size of user buffer
xor dx,dx ;dx counts arguments
;CX = line length
or cx,cx ;Check if CX is 0 (jump too far for jcxz)
jne @getargs_2
jmp @getargs_99 ;0 length, jump around ajnup
@getargs_2:
; At the start of this loop, the following hold :
; (1) CX >= 1. CX holds count of remaining characters.
; (2) ah holds the current "state" with the following encoding -
; When Bit 1 is 0, bit 0=0 indicates we're outside an argument
; and bit0=1 indicates we are inside an arg.
; When Bit 1 is 1, we are inside a quoted argument. In this
; case, bit 0 "remembers" the state we were in before the
; quotes so that it can be restored upon reaching the closing
; quotes.
; Bit 2 remembers if prev char was a ESCARG (=1) or not (=0)
; Bit 3 = 1 indicates this argument is to be copied into the
; user buffer

in_arg equ 01h
in_quote equ 02h
saw_ESCARG equ 04h
lodsb ;Get next char
cmp al,CR ;If carraige-return
je @getargs_50 ; then terminate processing.
call near ptr isspace ;Check if space or tab
jne @getargs_10 ;No, jump
; Process separator
and ah,NOT saw_ESCARG ;Remember char is not a ESCARG
test ah,in_quote ;Are we inside quotes ?
jnz @getargs_49 ;If so go onto next char
and ah,NOT in_arg ;else reset the inside arg flag
jmp short @getargs_49 ;and go onto next char


@getargs_10: ;Not a separator
test ah,in_arg OR in_quote ;Were we inside an arg or quoted arg ?
jnz @getargs_11 ;Yes, then skip the increment
;else entering an arg, so
inc dx ; increment arg count
or di,di ; If function is return arg count
je @getargs_11 ; then go on
cmp di,dx ; else check if this is the arg we want
jne @getargs_11 ; Nope, keep on
; Yep, this be the one
mov di,bx ;di = destination buf, ES assumed = DS
xor dx,dx ;Zero the character count
jmp short @getargs_80 ;Go to the copy loop
@getargs_11:
cmp al,QUOTE ;Is this a quote ?
jne @getargs_15 ;No, normal processing
test ah,saw_ESCARG ;Found quote, was prev char a ESCARG ?
jnz @getargs_15 ;Yes, normal processing
xor ah,in_quote ;else toggle the quote flag
jmp short @getargs_49 ;go onto next char
@getargs_15: ;Normal processing
and ah,NOT saw_ESCARG ;assume char is not a ESCARG
cmp al,ESCARG ;Is this a ESCARG ?
jnz @getargs_20 ;No
or ah,saw_ESCARG ;Set ESCARG flag
@getargs_20:
test ah,in_quote ;Are we inside quotes ?
jnz @getargs_49 ;If so go onto next char
or ah,in_arg ;else set the inside arg flag

@getargs_49:
loop @getargs_2 ;Go onto next char if any

@getargs_50: ;Finished with the line
or di,di ;Were we supposed to return an argument ?
je @getargs_99 ;No, so go on
xor dx,dx ;Yes, but arg num was > number of args
; so return a 0 count
jmp short @getargs_99 ;Skip over copy arg section



;Copy argument loop begins.

@getargs_70:
lodsb ;Get next char
cmp al,CR ;If carraige-return
je @getargs_99 ; then terminate processing.

call near ptr isspace ;Check if space or tab
jne @getargs_80 ;No, jump

; Process separator
test ah,in_quote ;Are we inside quotes ?
jz @getargs_99 ;No, terminate processing
jmp short @getargs_85 ;Treat like any other char

@getargs_80: ;Not a separator
;At this point CX = num of bytes remaining in the line including the
;one in AL.

cmp al,QUOTE ;Is this a quote ?
jne @getargs_85 ;No, normal processing
test ah,saw_ESCARG ;Found quote, was prev char a ESCARG ?
jnz @getargs_84 ;Yes, jump
xor ah,in_quote ;else toggle the quote flag
jmp short @getargs_89 ;go onto next char

@getargs_84: ;Found a \" combination
dec di ;Previous \ shouldn't have been written
dec dx ;or counted.
;fall thru for normal processing


@getargs_85: ;Normal processing
sub userbuf_len,1 ;Decrement space remaining in buffer. Do
; NOT use DEC here since CF needs to be set
jb @getargs_100 ;No more space, exit with CF set
stosb ;Store the char
inc dx ;and incr count

and ah,NOT saw_ESCARG ;assume char is not a ESCARG
cmp al,ESCARG ;Is this a ESCARG ?
jnz @getargs_89 ;No
or ah,saw_ESCARG ;Set ESCARG flag

@getargs_89:
loop @getargs_70 ;Go onto next char if any

@getargs_99:
xchg ax,dx ;AX<-arg count or num chars in returned arg
clc ;Clear CF for no error
@getargs_100:
mov sp,bp
pop bp
@restore
ret
getargs endp




;+
; FUNCTION : isalphnum
;
; Test if the character is alphanumeric.
;
; Parameters:
; AL = character
;
; Returns:
; CF = 0 if alphanumeric
; 1 if not
; Register(s) destroyed:
;-
isalphnum proc near
cmp al,'0'
jc @isalphnum_99 ;Not alphanumeric
cmp al,'9'+1
cmc
jnc @isalphnum_99 ;Number
cmp al,'A'
jc @isalphnum_99 ;Not alphanumeric
cmp al,'Z'+1
cmc
jnc @isalphnum_99 ;Uppercase letter
cmp al,'a'
jc @isalphnum_99 ;Not alphanumeric
cmp al,'z'+1
cmc
@isalphnum_99:
ret
isalphnum endp



;+
; FUNCTION : iscntrl
;
; Check if control character and DEL (00h-1Fh and 0FFh).
;
; Parameters:
; AL = character to be checked
;
; Returns:
; CF = 0 if AL is a control character or DEL
; 1 not a control char or DEL
; Register(s) destroyed:
;-
iscntrl proc near
cmp al,DEL
jne @iscntrl_99
cmp al,' '
cmc
@iscntrl_99:
ret
iscntrl endp



;+
; FUNCTION : isspace
;
; Check if a character is a SPACE or a TAB
;
; Parameters:
; AL = character to check
;
; Returns:
; ZF = 1 if AL is a space or a tab
; 0 otherwise
; Register(s) destroyed:
;
;-
isspace proc near
cmp al,TAB
je @isspace_99
cmp al,SPACE
@isspace_99:
ret
isspace endp



;+
; FUNCTION : isdelim
;
; Check if a character is an MSDOS delimiter.
;
; Parameters:
; AL = character to check
;
; Returns:
; ZF = 1 if AL is a delimiter
; 0 otherwise
; Register(s) destroyed:
;
;-
isdelim proc near
call near ptr isspace ;Check if space or tab
je @isdelim_99 ;Yes, go return
cmp al,'/'
je @isdelim_99 ;Yes, go return
cmp al,'|'
je @isdelim_99 ;Yes, go return
cmp al,'<'
je @isdelim_99 ;Yes, go return
cmp al,'>'
@isdelim_99:
ret
isdelim endp



;+
; FUNCTION : skip_whitespace
;
; Searches for the next non-whitespace character in a given string.
;
; Parameters:
; SI -> pointer to string
; CX == num chars in the string
;
; Returns:
; CF = 1 if end-of string reached else 0
; SI ->next non-whitespace character or end-of-string
; CX <-num remaining characters including one pointed to by SI
;
; Register(s) destroyed:
; AX
;-
skip_whitespace proc near
jcxz @skip_whitespace_98 ;Empty string
@skip_whitespace_10:
lodsb ;AL<-next char
call near ptr isspace ;Whitespace character ?
loope @skip_whitespace_10 ;Repeat until
; non-whitespace or string ends
je @skip_whitespace_98 ;End-of-string
; Non-whitespace char found
dec si ;SI->non-whitespace char
inc cx ;CX<-remaining number of bytes
clc ;CF<-0 (char found)
jmp short @skip_whitespace_99

@skip_whitespace_98:
; End of string reached.
stc ;Set CF

@skip_whitespace_99:
ret
skip_whitespace endp




;+ FUNCTION : skip_nonwhite, skip_nondelim
;
; Searches for the next whitespace character / delimiter in a given
; string.
;
; Parameters:
; SI -> pointer to string
; CX == num chars in the string
;
; Returns:
; CF = 1 if end-of string reached else 0
; SI ->next whitespace character or end-of-string
; CX <-num remaining characters including one pointed to by SI
;
; Register(s) destroyed:
; AX
;-
skip_non proc near
skip_nonwhite LABEL near
push dx
mov dx,offset DGROUP:isspace
jmp short @skip_non

skip_nondelim LABEL near
push dx
mov dx,offset DGROUP:isdelim
@skip_non:
jcxz @skip_non_98 ;Empty string
@skip_non_10:
lodsb ;AL<-next char
call dx ;nonwhite / delimiter
; character ?
loopne @skip_non_10 ;Repeat until
; whitespace or string ends
jne @skip_non_98 ;End-of-string
; whitespace char found
dec si ;SI->whitespace char
inc cx ;CX<-remaining number of bytes
clc ;CF<-0 (char found)
jmp short @skip_non_99

@skip_non_98:
; End of string reached.
stc ;Set CF

@skip_non_99:
pop dx
ret
skip_non endp






;+
; FUNCTION : push_word
;
; Looks for the next word (delimited by whitespace) and pushes it
; onto the specified string stack.
;
; Parameters:
; BX -> strstack descriptor
; SI -> string
; CX == length of string (< 256)
;
; Returns:
; AX <- 0 if no errors
; -1 if no room in stack
; +1 if no word in string
; SI -> char after first word (or end-of-string)
; CX <- num remaining characters
;
; Register(s) destroyed:
; DX
;-
push_word proc near
; Skip forward to first word
call near ptr skip_whitespace ;Returns
; SI->start of word
; CX<-remaining chars
jcxz @push_word_98 ;No words in line
mov dx,si ;DX->start of word
push cx ;Save count
call near ptr skip_nonwhite ;Find end of word
; SI->beyond word
; CX<-remaining chars
pop ax
sub ax,cx ;AX<-length of word
push cx ;Save remaining char count
xor cx,cx ;CX<-0 (don't force push)
call near ptr strstk_push ;Store macro name into
; macro stack. Params
; AX,BX,CX,DX
; Returns Cf = 0 or 1
pop cx ;CX<-remaining character
; Assume no error
mov ax,0 ;DON'T DO xor ax,ax SINCE CF to be preserved
jnc @push_word_99 ;Jump if no error
dec ax ;Error AX <- -1
jmp short @push_word_99 ;Exit

@push_word_98:
; No words found in line. Set return codes.
mov ax,1 ;Code for blank line

@push_word_99:
ret
push_word endp





;+
; FUNCTION : push_string
;
; Pushed the specified string onto the specified stack.
;
; Parameters:
; BX -> strstack descriptor
; SI -> string
; CX == length of string must be < 256
;
; Returns:
; CF <- 0 if no errors
; 1 if no room in stack
;
; Register(s) destroyed:
; AX,CX,DX
;-
push_string proc near
mov dx,si ;DX->start of string
mov ax,cx ;AX<-length of string
xor cx,cx ;CX<-0 (don't force push)
call near ptr strstk_push ;Store macro name into
; macro stack. Params
; AX,BX,CX,DX
; Returns Cf = 0 or 1
ret
push_string endp



;+
; FUNCTION : bell
;
; Called to ring the bell.
;
; Parameters:
; None.
;
; Returns:
; Nothing.
; Register(s) destroyed:
; AX
;-
bell proc near
cmp silent,1
je @bell_99
@DispCh BEL
@bell_99:
ret
bell endp


;+
; FUNCTION : output_counted_string
;
; Parameters :
; CX - Number of bytes to display
; DX - address of string
; Registers destroyed:
; AX,BX,CX,DX
output_counted_string proc near
mov ah,40h
mov bx,1 ;stdout handle
int 21h ;Params ax,bx,cx,dx
ret
output_counted_string endp

;+
; FUNCTION: output_newline
;
; Registers destroyed:
; AX,BX,CX,DX
;-
output_newline proc near
@DispCh CR
@DispCh LF
ret
output_newline endp






CSEG ENDS

END



  3 Responses to “Category : Files from Magazines
Archive   : VOL9N16.ZIP
Filename : UTL.ASM

  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: http://www.os2museum.com/wp/mtswslnk/