679 lines
23 KiB
NASM
679 lines
23 KiB
NASM
; =====> 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
|
||
|