pcs/strmlnrs.asm

679 lines
23 KiB
NASM
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

; =====> STIMER.ASM
;***************************************
;* TIPC Scheme '84 Things That Could *
;* Have Been Done in C but Why Waste *
;* Execution Time and Codespace? *
;* *
;* (C) Copyright 1984,1985 by Texas *
;* Instruments Incorporated. *
;* All rights reserved. *
;* *
;* Date Written: July 1985 *
;* Last Modification: 8 October 1985 *
;***************************************
include scheme.equ
DGROUP group data
data segment word public 'DATA'
assume DS:DGROUP
;Table of strange characters
stranges db " ,'"
db ';":()`'
db 13,12,11,10,9,0
;Random number registers
krala dw 22425
kralb dw 30029 ;RANDOMIZE puts seed value here
;Random number table
kraltbl dw 4053,32361,7773,17385,11177,20413,27513,16501
dw 5953,17673,20725,12247,28429,30861,16849,22375
;Copy of random number registers and table.
krala1 dw 22425
kralb2 dw 30029
kraltbl1 dw 4053,32361,7773,17385,11177,20413,27513,16501
dw 5953,17673,20725,12247,28429,30861,16849,22375
kral_len equ krala1-krala
data ends
PGROUP group prog
prog segment byte public 'PROG'
assume CS:PGROUP
;For space and performance reasons, some procedures have been written in the
; following style: the arguments are popped off the stack, and the
; procedure may end in an indirect JMP instead of a RET. In this source file,
; the following are such procedures:
; toblock, gvchars, blk2pbuf, putlong, thefix, ldlong, msubstr,
; mcmpstr, ldreg, pt_flds4, pt_flds6, str2str, adj4bord
; Convert flonum to bignum
; Calling sequence: flotobig(flo,bigbuf)
; Where ---- flo: double-length flonum such that abs(flo)>=1
; bigbuf: pointer to buffer for bignum formation
fbargs struc
dw ? ;Return address
flo dw ?,?,?,? ;Flonum
bigbuf dw ? ;Pointer to bignum buffer
fbargs ends
public flotobig
flotobig proc near
mov BX,SP
lea SI,[BX].flo ;Fetch pointer to flonum
mov DI,[BX].bigbuf ;Fetch buffer pointer
inc DI ;Point DI to sign byte
inc DI
cld ;Direction forward
mov AX,[BX+6].flo ;Fetch exponent word to CX
mov CX,AX
and AX,0fh ;Save mantissa part back
or AL,10h
mov [BX+6].flo,AX
mov AL,AH ;Zero AL
test CH,80h ;Negative flonum?
jz ftb1 ;Jump if not
inc AL ;Otherwise, set AL to 1
ftb1: stosb ;Store sign byte
mov BX,DI ;Save address of first word in BX
mov AL,AH ;Zero AL again
and CX,7ff0h ;Discard sign byte and mantissa
sub CX,3ff0h ;Remove exponent bias
shl CX,1
;At this stage, CH+1==number of bytes for bignum, CL shows how much to
; shift mantissa left (once per 20h)
mov DX,CX ;Use DX to count the shifts
xor DH,DH ;Set up shift count
add DX,80h ;Account for placing leading 1 in high byte
ftb2: shl word ptr[SI],1 ;Shift mantissa left
rcl word ptr[SI+2],1
rcl word ptr[SI+4],1
rcl word ptr[SI+6],1
sub DX,20h ;Repeat until done
jnz ftb2
mov CL,CH ;Set CX to number of bignum bytes
xor CH,CH
inc CX
sub CX,8 ;Check for leading zeros
js ftb3 ;Jump if not all the mantissa will be done
jz ftb3 ;Jump if no trailing zeros exist
rep stosb ;Else store as many zeros as necessary
ftb3: sub SI,CX ;Point SI to eligible part of mantissa
add CX,8 ;Set mantissa byte count
rep movsb ;Copy flonum mantissa to bignum
mov CX,DI ;Find number of bytes in bignum proper
sub CX,BX
shr CX,1 ;Find number of words
jnc ftb4 ;If a whole number of words, do nothing
mov byte ptr[DI],0 ;Otherwise, pad with a 0
inc CX ;Adjust word count
ftb4: mov [BX-3],CX ;Save size of bignum
ret
flotobig endp
; Find the size of a flonum
; Calling sequence: flosiz(flo);
; Where ---- flo: double-length flonum
; Returns the number of bytes needed for a working flonum formed from
; trunc(flonum)
fsargs struc
dw ? ;Return address
fl dw ?,?,?,? ;Double-length flonum
fsargs ends
public flosiz
flosiz proc near
mov SI,SP
mov AX,[SI+6].fl ;Fetch word containing exponent
and AX,7ff0h ;Drop sign and mantissa
sub AX,3ff0h ;Is abs(flo) < 1?
jc small ;Jump if small
mov AL,AH ;Otherwise, return number of bytes
xor AH,AH
shl AL,1
add AL,5
ret
small: xor AX,AX ;Return 0 for smallness
ret
flosiz endp
; Move bytes from buffer to allocated Scheme block
; Calling sequence: toblock(reg,offs,buf,q)
; Where ---- reg: Scheme register pointing to block
; offs: Offset into block to begin transfer
; buf: Buffer pointer
; q: Number of bytes to move
;Stack elements in order of popping:
; Return address, register, offset, buffer address, number of bytes
public toblock
toblock proc near
pop DX ;Save return address in DX
pop BX ;Get register address
mov DI,[BX].C_disp ;Put 8088 address in ES:DI
mov BX,[BX].C_page
mov AX,ES
LoadPage ES,BX
;;; mov ES,pagetabl+[BX]
pop CX ;Get offset
add DI,CX ;Add to DI
pop SI ;Get source address (buffer ptr)
pop CX ;Get number of bytes
jcxz tbskip ;If no bytes, don't move
cld ;Direction forward
rep movsb ;Move bytes
tbskip: mov ES,AX ;Restore ES
jmp DX ;Return
toblock endp
IFNDEF PROMEM
; Give characters from a C string
; Calling sequence: gvchars(str,len)
; Where ---- str: C string address
; len: Number of characters to give
;Stack elements in order of popping:
; Return address, string address, number of chars
extrn givechar:near
public gvchars
gvchars proc near
pop DI ;Get return address
pop SI ;Get string address
pop CX ;Get number of chars
push DI ;Put return address back
jcxz given ;If no chars, stop
cld ;Direction forward
gvlp: push CX ;Save count
lodsb ;Fetch string character
push SI ;Save pointer to next char
push AX
call givechar ;Give it
inc SP ;Restore stack
inc SP
pop SI ;Restore address and count
pop CX
loop gvlp ;Give 'til done
given: ret ;Return
gvchars endp
; Move characters from block (symbol or string) to print buffer
; Calling sequence: blk2pbuf(pg,ds,buf,len,ch,display)
; Where ---- pg: logical page of the block
; ds: block displacement
; buf: address of print buffer
; len: number of chars in the block
; ch: character to escape (| for syms, " for strs)
; display: whether to use escape characters
; Returns the number 2n+s, where n is the number of characters in the
; print buffer, and s=1 if strange chars were encountered, 0 otherwise.
; Popping order: return address, pg, ds, buf, len, ch, display
public blk2pbuf
extrn hicases:byte
blk2pbuf proc near
pop DX ;Pop return address
pop BX ;Pop page
shl BX,1 ;Put segment of block in DS
LoadPage DS,BX
;;; mov DS,pagetabl+[BX]
pop SI ;Pop block displacement
pop DI ;Pop print buffer
pop CX ;Pop character count
pop BX ;Pop must-be-escaped character
pop AX ;Pop whether to use escapes
mov BH,AL ;Save escape boolean in BX
and BH,7fh ;Save bit in BH for strangeness
push DX ;Push return address
push ES ; Save caller's ES register
mov DX,DI ;Save start address of print buffer in DX
jcxz zstrng ;If len=0, mark strangeness
cmp BL,'"' ;Are we looking at a string?
jne b2plp ;Skip if not
zstrng: or BH,80h ;Otherwise, mark as strange
jcxz done ;If len=0, forget everything else
b2plp: lodsb ;Fetch char from block
test BH,7fh ;Are we displaying escape chars?
jz storit ;Jump if not
cmp AL,BL ;Does the char need escaping?
je escit ;If needed, do so
cmp AL,'\'
jne storit ;If not, just store it
escit: mov AH,AL ;Save char in AH
mov AL,'\' ;Store escape character
stosb
mov AL,AH ;Restore char
storit: stosb ;Store it
test BH,80h ;Do we already know that atom's strange?
jnz skptest ;If so, don't bother testing
push SI ;Else save SI
mov SI,offset DGROUP:hicases ;Point SI to table of upper cases
xchg BX,SI
mov AH,AL ;Save char in AH
xlat ES:hicases ;Fetch upper-case equivalent
xchg BX,SI ;Restore BX
cmp AH,AL
jne mrkstrng ;If chars different, mark as strange
mov SI,offset stranges ;Point SI to strange-character string
strnglp: lods byte ptr ES:[SI] ;Fetch strange char
or AL,AL ;End of string?
jz notstrng ;Jump if so
cmp AH,AL ;Is AH strange?
jne strnglp ;If not, try again
mrkstrng: or BH,80h ;Mark strange bit
notstrng: pop SI ;Restore SI
skptest: loop b2plp ;Repeat until done
done: push ES ;Restore DS
pop DS
pop ES ; Restore caller's ES register
mov byte ptr[DI],0 ;Put null at end of string
mov AX,DI ;Return 2*(# of chars in string)+strangeness
sub AX,DX
shl BH,1
rcl AX,1
ret ;Return
blk2pbuf endp
ENDIF
; Load bignum block with long integer
; Calling sequence: putlong(reg,longi)
; Where ----- reg: register pointing to a bignum block
; longi: 32-bit integer to store
; Popping order: return address, register address, low & high integer words
public putlong
putlong proc near
pop DX ;Fetch return address
pop DI ;Fetch register address
mov BX,[DI].C_page ;Point ES:DI to bignum block
LoadPage ES,BX
;;; mov ES,pagetabl+[BX]
mov DI,[DI].C_disp
add DI,3 ;Point ES:DI to block data area
pop BX ;Put long integer in CX:BX
pop CX
xor AL,AL ;Sign byte - default positive
test CH,80h ;Integer negative?
jz poslong ;Jump if not
inc AL ;Otherwise, set sign negative
xor BX,-1 ;Negate long integer
xor CX,-1
add BX,1
adc CX,0
poslong: cld ;Direction forward
stosb ;Store sign byte
mov AX,BX ;Store least significant word
stosw
jcxz notlong ;If most signif. word=0, don't store it
mov AX,CX
stosw
notlong: push DS ;Restore ES
pop ES
jmp DX ;Return
putlong endp
; Add word of zeros, if necessary, to bignum buffer
; Calling sequence: thefix(buf)
; Where ----- buf: address of bignum buffer
; THEFIX is intended to alleviate a problem in the bignum division package.
; Popping order: return address, buf
public thefix
thefix proc near
pop DI ;Return address in DX
pop SI ;Fetch bignum buffer address
mov BX,[SI] ;Get bignum size in words
inc BX ;Point BX+SI to last bignum byte
shl BX,1
test byte ptr[BX+SI],80h ;Is most signif. bit set?
jz fixed ;If not, nothing to fix
inc word ptr[SI] ;Otherwise, increase bignum size
inc BX ;Add word of 0 to most significant end
mov word ptr[BX+SI],0
fixed: jmp DI ;Return
thefix endp
; Load a long integer value with a bignum
; Calling sequence: ldlong(v, reg)
; Where ----- v: pointer to a long integer
; reg: register pointing to a bignum
; Returns 0 if the load was successful, 1 otherwise
; Popping order: return address, v, reg
public ldlong
ldlong proc near
pop DX ;Pop return address
pop DI ;Pop longint destination
pop BX ;Pop register address
push DS ;Save DS
mov SI,[BX].C_disp ;Point DS:SI to bignum object
mov BX,[BX].C_page
LoadPage DS,BX
;;; mov DS,pagetabl+[BX]
cld ;Direction forward
inc SI ;Put bignum length in CX
lodsw
mov CX,AX
lodsb ;Put bignum sign in BL
mov BL,AL
cmp CX,6 ;Check size
je big6
cmp CX,8
je big8
mov AX,1 ;If here, bignum wrong size: error
pop DS ;Restore DS
jmp DX ;Return
big6: lodsw ;Put bignum in CX:AX
xor CX,CX
jmp short havenum
big8: lodsw ;Put bignum in CX:AX
mov CX,AX
lodsw
xchg CX,AX
havenum: test BL,1 ;Was bignum negative?
jz storenum ;No, skip
xor CX,-1 ;Otherwise, negate
xor AX,-1
add AX,1
adc CX,0
storenum: stosw ;Store to long integer
mov AX,CX
stosw
xor AX,AX ;All's well
pop DS ;Restore DS
jmp DX ;Return
ldlong endp
; Move string bytes from one part of PCS memory to another
; Calling sequence: msubstr(to_reg, from_reg, start, end)
; Where ----- to_reg: register pointing to destination string
; from_reg: register pointing to source string
; start: offset at which to start copying
; end: byte after the last to be copied
; Popping order: return address, from_reg, to_reg, start, end
public msubstr
msubstr proc near
pop DX ;Pop return address (temporarily)
pop DI ;Pop destination register address
pop SI ;Pop source register address
pop AX ;Pop start index
pop CX ;Pop end index
push DS ;Save caller's DS & ES
push ES
mov BX,[DI].C_page ;Point ES:DI to destination object
mov DI,[DI].C_disp
LoadPage ES,BX
;;; mov ES,pagetabl+[BX]
add DI,BLK_OVHD ;Adjust DI past string overhead
mov BX,[SI].C_page ;Point DS:SI to source object
mov SI,[SI].C_disp
LoadPage DS,BX
;;; mov DS,pagetabl+[BX]
add SI,BLK_OVHD ;Adjust SI past string overhead
add SI,AX ;Point SI to start of substring
sub CX,AX ;Set number of bytes to move
cld ;Direction forward
rep movsb
pop ES ;Restore caller's DS & ES
pop DS
jmp DX ;Return
msubstr endp
; Compare two Scheme bignums or strings for equal?-ness
; Calling sequence: mcmpstr(reg1,reg2)
; Where ----- reg1,reg2: registers pointing to objects to be compared
; Returns 1 if the objects are equal?, 0 otherwise
public mcmpstr
mcmpstr proc near
pop DX ;Pop return address
pop SI ;Pop register addresses
pop DI
push DS ;Save caller's DS and ES
push ES
mov BX,[DI].C_page ;Point ES:DI to second object
mov DI,[DI].C_disp
LoadPage ES,BX
;;; mov ES,pagetabl+[BX]
mov BX,[SI].C_page ;Point DS:SI to the first object
mov SI,[SI].C_disp
LoadPage DS,BX
;;; mov DS,pagetabl+[BX]
mov CX,[SI].str_len ;Fetch byte count from source's length
cmp CX,0 ;;; check for small string
jge mcm_010
add CX,BLK_OVHD+PTRSIZE
mcm_010: xor AX,AX ;Default AX to FALSE
cld ;Direction forward
repe cmpsb ;Compare
jne cmpskp ;If not equal, return FALSE
inc AX ;Otherwise return TRUE
cmpskp: pop ES ;Restore caller's ES and DS
pop DS
jmp DX ;Return
mcmpstr endp
; Load a register with a pointer from Scheme memory
; Calling sequence: ldreg(reg,pg,ds)
; Where ----- reg: register to be loaded
; pg,ds: page and displacement of Scheme pointer
; Popping order: return address, reg, pg, ds
public ldreg
ldreg proc near
pop DX ;Pop return address
pop DI ;Pop destination register
pop BX ;Pop page and displacement
pop SI
mov CX,DS ;Save caller's DS
shl BX,1 ;Point DS:SI to Scheme pointer
LoadPage DS,BX
;;; mov DS,pagetabl+[BX]
cld ;Direction forward
lodsb ;Load register's page field
xor AH,AH
mov ES:[DI].C_page,AX
lodsw ;Load displacement field
mov ES:[DI].C_disp,AX
mov DS,CX ;Restore caller's DS
jmp DX ;Return
ldreg endp
; Generate pseudorandom numbers in the range 0-16,383
;
; Author: John C. Jensen (converted to assembly lang. by Mark Meyer)
; Date Written: 9 January 1985
; Last Modification: 9 July 1985
;
; Calling Sequence: krandom()
;
; Note: the following random number generator is due to Jaroslav
; Kral. It was adapted to 16 bit words and proven both efficient
; and statistically satisfactory by Overstreet and Nance of SMU.
; See Karl's paper for initialization values for other word
; lengths.
;
; -- Kral, Jaroslav. "A New Additive Pseudorandom Number
; Generator for Extremely Short Word-Lengths," Information
; Processing Letters, 1 (1972), 164-167 (erratum noted in 1
; (1972), 216).
;
; -- Overstreet, C. and Nance, R.E., "A Random Number Generator
; for Small Word-Length Computers," Proceedings of the ACM '73
; Conference, p. 219-223.
;
public krandom
krandom proc near
mov AX,krala ;Put old KRALA in AX, old KRALB in BX
mov BX,kralb
mov CX,BX ;KRALC = KRALB
add BX,AX ;KRALB = (KRALA+KRALB) mod 2^n
and BH,3fh ; (Currently, n=14)
mov kralb,BX
mov BL,BH ;J = KRALB / 2^(n-4)
shr BL,1
and BX,01eh
mov AX,[BX]+offset kraltbl ;KRALA = KRALTBL[J]
mov krala,AX
add AX,CX ;KRALTBL[J] = (KRALA+KRALC) mod 2^n
and AH,3fh
mov [BX]+offset kraltbl,AX
ret ;Return KRALTBL[J]
krandom endp
; RANDOMIZE - Reset the random number registers and table back to their
; original values, then put the seed value into "kralb".
; Calling sequence: randomize(seed) ;seed = normal C int
public randomiz
randz_args struc
dw ? ;caller's ES
dw ? ;caller's BP
dw ? ;return address
rseed dw ? ;argument 1 (seed)
randz_args ends
randomiz proc near
push BP ;save caller's BP
push ES ;save ES
mov BP,SP ;establish local addressability
mov AX,DS ;copy DS to ES
mov ES,AX
mov CX,kral_len/2 ;restore random state to its original state
lea SI,krala1
lea DI,krala
rep movsw
mov BX,[BP].rseed ;get seed
cmp BX,0 ;is it zero?
jnz randz_1 ;no, jump; use the seed directly
mov AX,2C00h ;get the time from DOS
int 21h
push DX ;tempsave DX (seconds, hundredths)
xor AX,AX
mov AL,CH ;determine #sec-in-hours
mov DX,3600
mul DX
mov BX,AX
xor AX,AX
mov AL,CL ;determine #sec-in-minutes
mov DX,60
mul DX
add BX,AX ;#sec-in-hours + #sec-in-minutes
pop DX ;restore seconds (and hundredths, but ignore it)
xchg DH,DL
mov DH,0
add BX,DX ;add in seconds
randz_1: mov kralb,BX ;set seed
pop ES ;wrap up
pop BP
ret
randomiz endp
; Set the cdr field of a list cell
; Calling sequence: asetcdr(creg, preg)
; Where ---- creg: register pointing to cell
; preg: register holding new pointer
; Popping order: Return address, destination register, pointer register
public asetcdr
asetcdr proc near
pop DX ;Pop return address
pop DI ;Pop address of register
mov CX,ES ;Save caller's ES
mov BX,[DI].C_page ;Point ES:DI to list cell
mov DI,[DI].C_disp
LoadPage ES,BX
;;; mov ES,pagetabl+[BX]
add DI,PTRSIZE ;Adjust for cdr field
pop SI ;Pop address of pointer
cld ;Direction forward
mov AX,[SI].C_page ;Store into cdr field
stosb
mov AX,[SI].C_disp
stosw
mov ES,CX ;Restore ES
jmp DX ;Return
asetcdr endp
; Get field values from a port object
; Calling sequence: pt_flds4(reg, &ull, &ulc, &nl, &nc)
; pt_flds6(reg, &cl, &cc, &ull, &ulc, &nl, &nc)
; Where ----- reg: register pointing to port
; cl: variable to receive CUR_LINE value
; cc: ... CUR_COL value
; ull: ... UL_LINE value
; ulc: ... UL_COL value
; nl: ... N_LINES value
; nc: ... N_COLS value
; Warning: This routine expects these six fields to be contiguous
; Popping order: return address, reg, (&cl, &cc,) &ull, &ulc, &nl, &nc
public pt_flds4,pt_flds6
pt_flds proc near
pt_flds6: mov CX,pt_cline ;Set CX to offset of first field
jmp fldsmrg
pt_flds4: mov CX,pt_ullin ;Set CX to offset of first field
fldsmrg: pop DX ;Pop return address
mov AX,DS ;Save caller's DS
pop BX ;Pop register address
mov SI,[BX].C_disp ;Point DS:SI to first field
mov BX,[BX].C_page
LoadPage DS,BX
;;; mov DS,pagetabl+[BX]
add SI,CX
cld ;Direction forward
sub CX,pt_cline ;Set CX to number of fields to do
shr CX,1 ; (6 - (1/2)(CX - pt_cline))
neg CX
add CX,6
fldslp: pop DI ;Pop destination variable address
movsw ;Transfer value
loop fldslp ;Repeat until done
mov DS,AX ;Restore DS
jmp DX ;Return
pt_flds endp
; Copy bytes from one C location to another
; Calling sequence: str2str(dest_adr, src_adr, n)
; Where ----- dest_adr: destination address
; src_adr: source address
; n: number of bytes to copy
; Popping order: return address, dest_adr, src_adr, n
public str2str
str2str proc near
pop DX ;Pop return address
pop DI
pop SI
pop CX
cld ;Direction forward
rep movsb ;Copy bytes
jmp DX ;Return
str2str endp
; Adjust window region variables for presence of a border
; Calling sequence: adj4bord(&ull, &nl, &ulc, &nc)
; Where ----- ull: Upper-left-line variable
; nl: Number-of-lines variable
; ulc: Upper-left-column variable
; nc: Number-of-columns variable
; Popping order: return address, &ull, &nl, &ulc, &nc
public adj4bord
max_lines equ 25
max_cols equ 80
adj4bord proc near
pop DX ;Pop return address
mov BX,max_lines ;Expand HEIGHT of window region
expand: pop SI ;Pop upper-left parameter
pop DI ;Pop extent parameter
mov AX,[SI] ;Get value of upper-left parm
or AX,AX ;If zero,
jz expand1 ; skip next two instructions
dec word ptr[SI] ;Else, expand backward
inc word ptr[DI]
dec AX ;Adjust AX to match upper-left parm
expand1: add AX,[DI] ;Find opposite edge
cmp AX,BX ;If edge too far,
jae expand2 ; skip next instruction
inc word ptr[DI] ;Else, expand forward
expand2: cmp BX,max_cols ;If we're finished,
je adjex ; jump out
mov BX,max_cols ;Else, expand WIDTH of window region
jmp expand
adjex: jmp DX ;Return
adj4bord endp
prog ends
end