VZEditor/VZ157/SRC/EXPR.ASM
Yoshihiko Hyodo 6f06b9514a first commit
2024-11-18 22:21:26 +09:00

854 lines
11 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.

;****************************
; 'expr.asm'
;****************************
include vz.inc
;--- Equations ---
OPT_ATR equ 21+18+28
OPT_BP equ OPT_ATR+20+44+6
OPT_PT equ OPT_BP+24
OPT_SW equ OPT_PT+14
OPTCNT equ OPT_SW+16*4
OPE_GET equ 0
OPE_SET equ 1
OPE_CLR equ 2
OPE_PTR equ 10
OPE_WPTR equ 11
OPE_AND equ 14
OPE_ADD equ 20
OPE_SUB equ 21
OPE_EQU equ 31 ; used in 'menu'
OPECNT equ 40
OPE_BASE equ 0FCh
OPE_LP equ 0FDh ; (
OPE_RP equ 0FEh ; )
OPE_END equ 0FFh
OPER equ 0FFh
WORDPTR equ 40h
CMD_HIGH equ 01h
OPB_OP equ 00010000b
OPB_NUM equ 10000000b
OPB_ENDEXP equ 01000000b
skipw macro
db 0B8h ; mov ax,imm
endm
cseg
;--- External symbols ---
extrn dataseg :word
extrn dspsw :word
extrn hist_top :word
extrn macsp :word
extrn nullptr :word
extrn optptr :word
extrn isdigit :near
extrn iskanji :near
extrn isupper :near
extrn puts :near
extrn putval :near
extrn scancmd :near
extrn setatr :near
extrn strskip :near
extrn toupper :near
endcs
dseg
;--- Local work ---
rexpnest db 0
endds
eseg
assume ds:cgroup
;--- Option table ---
opttbl db " Z W BTBOBQBFEMEFGVBMBAHSHFHXHAHW BUBCBL" ;21
db "TCWDPGRSTATBCICOFWFVFSFOMPMIWLLCFKSW" ;18
db "R RRS FRFTCMWCRNKSWVWHSPPVPCPNPQVP"
db "UPVMWFWAWBWOCZDZGZKZKP" ;28
db "ANACALAHASAOARAMABATAWAFAIAJAKAGAUAPADAV" ;20
db "A B C D E F G H I J K L M N O P Q T U V X Y "
db "AABBCCDDEEFFGGHHIIJJKKLLMMNNOOPPQQTTUUVVXXYY" ;44
db "AXBXCXDXSIDI" ; 6
db "TZLNLDCDCLCPIDCTCKLXLYKXKYWXWYLHWNWTMRMBFEHTXBWE";24
db "PSPFPXPAPW PZPI PUPD" ;14
db "DLDCDTDEDSDBDNDUDFDPDGDH " ;16
db "EIESEZEBEUEKETEHECEWEXENEVEAELEJ" ;16
db "SSSXSESDSKSRSYSTSNSQFPSBROUS " ;16
db "EPZKFQ FAFBFCFDFXFY" ;16
word_val db ttops,lnumb,dnumb,ccode,tnow,tcp,textid
byte_val db ctype,ckanj,lx,wy,lxs,wys,tw_sx,tw_sy,ly
db wnum,wsplit,tchf,blkm,exttyp,tabr,blkx,fsiz
;--- Operater table ---
opetbl db "[ ] ++--~ ! !!. ..<<>>& ^ | * / % + - < <=> >===!=&&^^||"
db "= &=^=|=*=/=%=+=-="
public symtbl
symtbl db 0 ; SPC
db MCHR_MENU+OPB_OP ; !
db MCHR_STR+OPB_NUM ; "
db MCHR_CMD ; #
db OPB_NUM ; $
db 0 ; %
db MCHR_CALL ; &
db MCHR_CHR+OPB_NUM ; '
db MCHR_VAR ; (
db OPB_ENDEXP ; )
db MCHR_REM+OPB_OP ; *
db OPB_OP ; +
db OPB_ENDEXP ; ,
db OPB_OP ; -
db MCHR_RET ; .
db MCHR_END+OPB_OP ; /
db 10 dup(OPB_NUM) ; 0...9
db MCHR_LABEL ; :
db OPB_ENDEXP ; ;
db OPB_OP ; <
db OPB_OP ; =
db MCHR_JUMP+OPB_OP ; >
db MCHR_IF ; ?
db 0 ; @
;--- Set option ---
;<-- CY :error
public setoption
setoption proc
mov optptr,si
call setoptnum
jc setopt_x
cmp cl,OPT_SW
_if b
cmp cl,OPT_BP
jae setopt_x
_endif
mov dl,OPE_SET
call readexpr
jc setopt_x
mov optptr,NULL
ret
setopt_x:
stc
ret
setoption endp
;--- Read expression ---
;-->
; CX :option No. (left value)
;<--
; CY :expression error
; DX :result value
public readexpr
readexpr proc
mov rexpnest,0
push di
mov di,sp
push dx
movhl ax,OPER,OPE_BASE
push ax
tst cx
jz rexp1
rexp1c:
push cx
rexp1:
lodsb
mov ah,al
cmp al,'A'
jae rexp_a
cmp al,'('
je rexp_lp
cmp al,')'
je rexp_rp
cmp al,'#'
_if e
call scancmd
mov ah,CMD_HIGH
mov dx,ax
_else
mov bx,offset cgroup:symtbl
sub al,SPC
jbe rexp_z
xlat
xchg al,ah
test ah,OPB_ENDEXP
jnz rexp_z
tst ah
jns rexp2
call scannums
dec si
_endif
jc rexp_x
pop ax
push ax
tst ah
_if z
movhl ax,OPER,OPE_EQU
push ax
_endif
rexp1d:
push dx
clr ax
rexp1a:
push ax
jmp rexp1
rexp_a:
call toupper
cmp al,'Z'
ja rexp2
call setoptnum1
jnc rexp1c
rexp_x:
stc
jmp rexp9
rexp_lp:
movhl ax,OPER,OPE_LP
push ax
inc rexpnest
jmp rexp1
rexp_rp:
dec rexpnest
js rexp_z
mov al,OPE_RP
jmps rexp31
rexp2:
mov ah,al
lodsb
cmp al,'='
je rexp3
cmp al,ah
je rexp3
dec si
mov al,SPC
rexp3: xchg al,ah
push di
mov di,offset cgroup:opetbl
mov cx,OPECNT-3
repne scasw
pop di
jne rexp_x
mov al,OPECNT-1
sub al,cl
cmp al,OPE_PTR
_if b
pop cx
tst ch
js rexp_x
tst cl
_ifn z
call setoptval
_else
pop cx
call operate
_endif
jmp rexp1d
rexp_z:
dec si
mov al,OPE_END
_endif
rexp31:
mov bl,al
pop cx
tst ch
_if s
cmp bl,OPE_SUB
je rexp_m
tst cl
js rexp_x
mov al,cl
cmp al,OPE_ADD
_if ae
sub al,OPE_ADD-OPE_SET
_endif
jmps rexp6
rexp_m:
mov ax,cx
clr cx
clr dx
jmps rexp41
_endif
tst cl
_if z
pop dx
_endif
rexp4:
pop ax
tst ah
jns rexp_x
cmp al,bl
jb rexp5
_if e
cmp al,OPE_EQU
jb rexp5
_endif
rexp41: push ax
tst cl
_if z
push dx
_endif
push cx
mov bh,OPER
push bx
jmp rexp1
rexp42:
tst cl
_if z
push dx
_endif
push cx
jmp rexp1
rexp5:
cmp al,OPE_BASE
je rexp7
ja rexp42
tst cl
_ifn z
push ax
mov al,OPE_GET
call setoptval
pop ax
_endif
rexp6:
pop cx
tst cl
_if z
pop cx
call operate
_else
call setoptval
_endif
jmp rexp4
rexp7:
pop ax
tst cl
_ifn z
call setoptval
_endif
clc
rexp9: mov sp,di
pop di
ret
readexpr endp
;--- Set option No. ---
;<-- CX :option No. (CY :error)
public setoptnum
setoptnum proc
call toupper
setoptnum1:
mov ah,al
lodsb
call toupper
call isupper
_ifn c
mov al,SPC
dec si
_endif
setoptnum2:
xchg al,ah
pushm <di,es>
movseg es,cs
mov di,offset cgroup:opttbl
mov cx,OPTCNT
repne scasw
popm <es,di>
stc
_if z
sub cx,OPTCNT-1
neg cx
clc
_endif
ret
setoptnum endp
;--- Set option value ---
;-->
; CX :option No.
; AL :operation mode (OPE_xx)
; DX :equ value (OPE_EQU)
;<--
; DX :result value
; CX :result value of PTR operator
; AL :switch number (-1=not switch)
public setoptval
setoptval proc
pushm <bx,es>
movseg es,cs
cmp al,OPE_PTR
je stval_ptr
cmp al,OPE_WPTR
je stval_wptr
cmp cl,OPT_SW
jae stval_sw
clr bh
mov bl,cl
shl bx,1
cmp cl,OPT_PT
jae stval_pt
cmp cl,OPT_BP
jae stval_bp
add bx,offset cgroup:nullptr
stval2: tst ch
jnz stvalp1
stval3: mov cx,es:[bx]
call operate
_if c
mov es:[bx],dx
_endif
jmps stval5
stval_pt:
sub bx,OPT_PT*2
add bx,offset cgroup:hist_top
jmp stval2
stval_wptr:
or dl,WORDPTR
stval_ptr:
mov ch,dl
inc ch
jmps stval9
stvalp1:
mov es,dataseg
mov cl,ch
clr ch
dec cx
mov bx,[bx]
test cl,WORDPTR
jnz stvalp2
add bx,cx
jmps stval4
stvalp2:
and cl,not WORDPTR
shl cx,1
add bx,cx
jmp stval3
stval_bp:
push ax
sub cl,OPT_BP
mov al,cl
mov bx,offset cgroup:word_val
xlat
cbw
mov bx,ax
add bx,bp
movseg es,ss
pop ax
cmp cl,byte_val-word_val
jb stval2
stval4: mov cl,es:[bx]
clr ch
call operate
_if c
mov es:[bx],dl
_endif
stval5: mov al,-1
jmps stval8
stval_sw:
mov bx,offset cgroup:dspsw
sub cl,OPT_SW
push cx
mov ah,cl
shrm ah,3
add bl,ah
adc bh,0
and cl,7
mov ah,1
shl ah,cl
test [bx],ah
mov cx,FALSE
_ifn z
mov cx,TRUE
_endif
call operate
_if c
test dl,1
_ifn z
or [bx],ah
_else
not ah
and [bx],ah
_endif
_endif
pop ax
stval8: clr cx
stval9: popm <es,bx>
ret
;--- Operate ---
;-->
; AL :operation mode (OPE_xx)
; CX :source value
; DX :destin value
;<--
; DX :result value
op_jmp:
ofs op_get
ofs op_set
ofs op_clr
ofs op_push
ofs op_pop
ofs op_inc
ofs op_dec
ofs op_com
ofs op_not
ofs op_swap
ofs op_nop
ofs op_nop
ofs op_shl
ofs op_shr
ofs op_and
ofs op_xor
ofs op_or
ofs op_mul
ofs op_div
ofs op_mod
ofs op_add
ofs op_sub
ofs op_lt
ofs op_le
ofs op_gt
ofs op_ge
ofs op_eq
ofs op_ne
ofs op_andc
ofs op_xorc
ofs op_orc
ofs op_equ
operate:
pushm <ax,bx>
cmp al,OPE_PTR
jb opr2
cmp al,OPE_EQU
clc
js opr2
je opr1
sub al,OPE_EQU+1-OPE_AND
opr1: stc
opr2: pushf
mov bx,offset cgroup:op_jmp
cbw
shl ax,1
add bx,ax
mov ax,[bx]
xchg cx,ax
cmp ax,dx
call cx
mov dx,ax
clr cx
popf
popm <bx,ax>
op_get:
op_nop:
ret
op_push:
mov bx,macsp
dec bx
dec bx
mov [bx],ax
jmps oppop1
op_pop:
mov bx,macsp
mov ax,[bx]
inc bx
inc bx
oppop1: mov macsp,bx
ret
op_inc:
inc ax
ret
op_dec:
dec ax
ret
op_com:
not ax
ret
op_swap:
xchg al,ah
ret
op_add:
add ax,dx
ret
op_sub:
sub ax,dx
ret
op_shl:
mov cl,dl
shl ax,cl
ret
op_shr:
mov cl,dl
sar ax,cl
ret
op_mul:
imul dx
ret
op_div:
tst dx
_ifn z
mov cx,dx
cwd
idiv cx
_endif
ret
op_mod:
call op_div
op_equ:
mov ax,dx
ret
op_andc:
call tobool
op_and:
and ax,dx
ret
op_orc:
call tobool
op_or:
or ax,dx
ret
op_xorc:
call tobool
op_xor:
xor ax,dx
ret
tobool:
tst ax
mov ax,FALSE
_ifn z
inc ax
_endif
tst dx
mov dx,FALSE
_ifn z
inc dx
_endif
ret
op_lt:
jl op_set
skipw
op_le:
jle op_set
skipw
op_gt:
jg op_set
skipw
op_ge:
jge op_set
skipw
op_eq:
je op_set
skipw
op_ne:
jne op_set
op_clr:
mov ax,FALSE
ret
op_not:
tst ax
jnz op_clr
op_set:
mov ax,TRUE
ret
setoptval endp
;--- Scan numerics ---
;-->
; AL :1st char
;<--
; CY :error
; AL :next char
; DX :result data
public scannum
scannums:
cmp al,'"'
je scan_str
scannum proc
cmp al,SYMCHR
je scan_chr
pushm <bx,cx>
clr bh
cmp al,'-'
_if e
mov bh,80h
lodsb
_endif
mov bl,10
cmp al,'$'
_if e
mov bl,16
lodsb
_endif
clr dx
_repeat
cmp al,'0'
_break b
cmp al,'9'
ja scann2
sub al,'0'
jmps scann3
scann2: cmp bl,10
_break e
call toupper
cmp al,'A'
_break b
cmp al,'F'
_break a
sub al,'A'-10
scann3: cbw
mov cx,ax
mov al,bl
cbw
mul dx
mov dx,ax
add dx,cx
inc bh
lodsb
_until
shl bh,1
_if c
neg dx
_endif
tst bh
_if z
cmp bl,16
_if e
mov dx,si
dec dx
_else
stc
_endif
_endif
popm <cx,bx>
ret
public scan_chr,scan_str
scan_chr:
clr dx
_repeat
lodsb
cmp al,SYMCHR
je scstr8
mov dh,dl
mov dl,al
_until
scan_str:
mov dx,si
call strskip
scstr8: lodsb
clc
ret
scannum endp
;--- Scan decimal word ---
;<--
; CY :error
; DX :result data
public scandeciw
scandeciw proc
lodsw
deciw1:
mov dx,ax
and dx,0F0F0h
cmp dx,3030h
jne deciw_x
xchg al,ah
and ax,0F0Fh
cmp al,9
ja deciw_x
cmp ah,9
ja deciw_x
aad
mov dx,ax
clc
ret
deciw_x:stc
ret
scandeciw endp
;--- Scan decimal word or alpha ---
;<--
; CY :error
; AL :0=decimal(DX),else alpha (upper)
public scandecial
scandecial proc
lodsb
call isdigit
jnc scand9
mov ah,al
lodsb
xchg al,ah
call deciw1
mov al,0
ret
scand9: clc
ret
scandecial endp
;--- Option in 'puts' ---
public optputs
optputs proc
call toupper
push ax
call setoptnum1
pop ax
jc oputs9
cmp al,'A'
_if e
mov al,cl
sub al,OPT_ATR
call setatr
jmps oputs9
_endif
push ds
push ax
mov al,OPE_GET
movseg ds,cs
call setoptval
pop ax
cmp al,'P'
_if e
tst dx
jz oputs8
push si
mov si,dx
call puts
pop si
_else
call putval
_endif
oputs8: pop ds
oputs9: ret
optputs endp
endes
end
;****************************
; End of 'expr.asm'
; Copyright (C) 1989 by c.mos
;****************************