forked from KolibriOS/kolibrios
504 lines
9.2 KiB
NASM
504 lines
9.2 KiB
NASM
; KolSPForth v12
|
||
|
||
SYSTEM equ EMUL
|
||
|
||
;Memory Map
|
||
;
|
||
;0
|
||
;0x02C7D ;I_END
|
||
;0x05430 ;CTOP
|
||
|
||
;0x3F800 ;Data stack
|
||
;0x3FA00 ;return stack
|
||
;0x3FC00 ;User
|
||
;0x3FE00 ;TIB
|
||
;0x30000 ;FILE BUFF
|
||
;0x40000 (256K)
|
||
|
||
;; Version control
|
||
|
||
VER EQU 1 ;major release version
|
||
EXT EQU 0 ;minor extension
|
||
|
||
;; Constants
|
||
|
||
TRUEE EQU -1 ;true flag
|
||
|
||
COMPO EQU 040H ;lexicon compile only bit
|
||
IMEDD EQU 080H ;lexicon immediate bit
|
||
MASKK EQU 01FH ;lexicon bit mask
|
||
|
||
CELLL EQU 4 ;size of a cell
|
||
BASEE EQU 10 ;default radix
|
||
VOCSS EQU 8 ;depth of vocabulary stack
|
||
|
||
BKSPP EQU 8 ;back space
|
||
LF EQU 10 ;line feed
|
||
CRR EQU 13 ;carriage return
|
||
ERR EQU 27 ;error escape
|
||
TIC EQU 39 ;tick
|
||
|
||
CALLL EQU 0E8H ;CALL opcodes
|
||
|
||
ROWH EQU 13
|
||
KEY_DELAY EQU 20
|
||
FW_WIDTH equ 500
|
||
FW_HEIGHT equ 352
|
||
|
||
|
||
;; Memory allocation
|
||
|
||
EM EQU 256*1024 ;top of memory
|
||
FILE_BS EQU 64*1024 ;file buff size
|
||
US EQU 128*CELLL ;user area size in cells
|
||
RTS EQU 1024*CELLL ;return stack/TIB size
|
||
|
||
FILE_B EQU EM-FILE_BS ;terminal input buffer (TIB)
|
||
TIBB EQU FILE_B-RTS ;terminal input buffer (TIB)
|
||
; UPP EQU TIBB-US ;start of user area (UP0)
|
||
RPP EQU UPP-RTS ;start of return stack (ESP0)
|
||
SPP EQU RPP-RTS ;start of data stack (EBP0)
|
||
|
||
LastNFA = 0
|
||
|
||
LastCFA EQU INIT
|
||
|
||
|
||
|
||
macro AHEADER FLAG,ID,F_CFA {
|
||
db FLAG
|
||
DD F_CFA
|
||
DD LastNFA
|
||
The_Nfa = $
|
||
DB ID,0
|
||
LastNFA = The_Nfa
|
||
F_CFA:
|
||
}
|
||
|
||
macro cfa_AHEADER FLAG,ID,F_CFA {
|
||
db FLAG
|
||
DD cfa_#F_CFA
|
||
DD LastNFA
|
||
The_Nfa = $
|
||
DB ID,0
|
||
LastNFA = The_Nfa
|
||
cfa_#F_CFA:
|
||
}
|
||
|
||
|
||
;; Main entry points and COLD start data
|
||
|
||
use32
|
||
|
||
org 0x0
|
||
|
||
db 'MENUET01' ; 8 byte id
|
||
dd 0x01 ; header version
|
||
dd ORIG ; start of code
|
||
dd I_END ; size of image
|
||
MEMS: dd EM ; memory for app
|
||
dd SPP ; esp
|
||
if SYSTEM eq MEOS
|
||
dd FINFO.path
|
||
else
|
||
dd 0
|
||
end if
|
||
dd 0x0 ; I_Param , I_Icon
|
||
|
||
lang fix ru
|
||
include 'MACROS.INC'
|
||
include "proc32.inc"
|
||
|
||
align 4
|
||
proc strncmp stdcall, s1:dword, s2:dword, n:dword
|
||
|
||
push esi
|
||
push edi
|
||
mov ecx, [n]
|
||
test ecx, ecx ; Max length is zero?
|
||
je .done
|
||
|
||
mov esi, [s1] ; esi = string s1
|
||
mov edi, [s2] ; edi = string s2
|
||
cld
|
||
.compare:
|
||
cmpsb ; Compare two bytes
|
||
jne .done
|
||
cmp byte [esi-1], 0 ; End of string?
|
||
je .done
|
||
dec ecx ; Length limit reached?
|
||
jne .compare
|
||
.done:
|
||
seta al ; al = (s1 > s2)
|
||
setb ah ; ah = (s1 < s2)
|
||
sub al, ah
|
||
movsx eax, al ; eax = (s1 > s2) - (s1 < s2), i.e. -1, 0, 1
|
||
pop edi
|
||
pop esi
|
||
ret
|
||
endp
|
||
|
||
align 4
|
||
proc GetPr stdcall, exp:dword, sz_name:dword
|
||
mov edx, [exp]
|
||
.next:
|
||
push edx
|
||
stdcall strncmp, edx, [sz_name], 16
|
||
pop edx
|
||
test eax, eax
|
||
jz .ok
|
||
mov edx, [edx-4]
|
||
test edx, edx
|
||
jnz .next
|
||
mov eax,edx
|
||
ret
|
||
.ok:
|
||
mov eax, [edx-8]
|
||
ret
|
||
endp
|
||
|
||
AHEADER 0 ,'GETPR',cfa_GETPR
|
||
JMP GetPr
|
||
|
||
|
||
ORIG:
|
||
|
||
MOV EBP,RPP ;initialize RP
|
||
CLD ;ESI gets incremented
|
||
finit
|
||
call draw_window
|
||
call calc_lines
|
||
XCHG ESP,EBP
|
||
CALL amain
|
||
BYE: mcall -1
|
||
|
||
|
||
ULAST: ; DD 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
|
||
|
||
|
||
draw_cursor:
|
||
|
||
draw_window:
|
||
pusha
|
||
mcall 12,1
|
||
mov [fRed],ebx
|
||
mcall 0, <0,FW_WIDTH>, <0,FW_HEIGHT>, 0x03000000, 0x805080D0, 0x005080D0
|
||
mcall 4, <8,8>, 0x10DDEEFF, header, header.size
|
||
|
||
mcall 9,pinfo,-1
|
||
mov eax,[pinfo.x_size]
|
||
cdq
|
||
sub eax,20
|
||
mov ebx,6
|
||
div ebx
|
||
mov [pinfo.x_start],eax
|
||
|
||
mov eax,[pinfo.y_size]
|
||
cdq
|
||
sub eax,40
|
||
mov ebx,ROWH
|
||
div ebx
|
||
|
||
mov [pinfo.y_start],eax
|
||
call erase_screen
|
||
mcall 12, 2
|
||
if ~ SYSTEM eq EMUL
|
||
mcall 67,-1,-1,FW_WIDTH,FW_HEIGHT
|
||
end if
|
||
popa
|
||
ret
|
||
|
||
lsz header,\
|
||
ru,'<27><><EFBFBD><EFBFBD> <20><><EFBFBD> MenuetOS (SPF)',\
|
||
en,'EXAMPLE APPLICATION',\
|
||
fr,"L'exemplaire programme"
|
||
|
||
erase_screen:
|
||
mov ebx,[pinfo.x_size]
|
||
add ebx,10 shl 16-20
|
||
mov ecx,[pinfo.y_size]
|
||
add ecx,30 shl 16-35
|
||
mcall 13,,,0;xff
|
||
ret
|
||
|
||
|
||
AHEADER 0,"CC_LINES",cfa_CC_LINES
|
||
calc_lines:
|
||
cmp dword[UPP+10*4],0
|
||
je .ex
|
||
pusha
|
||
mov ebp,os_work
|
||
mov al,0xd
|
||
mov edi,screen_buf
|
||
; mov esi,[cursor]
|
||
; mov byte[esi],'_'
|
||
; inc [cursor]
|
||
.again:
|
||
mov [ebp],edi
|
||
mov esi,[cursor]
|
||
sub esi,edi
|
||
mov ecx,[pinfo.x_start]
|
||
; test ecx,ecx
|
||
; jnz .no0
|
||
; inc ecx
|
||
; .no0:
|
||
cmp ecx,esi
|
||
jbe .ok
|
||
mov ecx,esi
|
||
.ok:
|
||
repne scasb
|
||
jecxz .nocrlf
|
||
cmp byte[edi],10
|
||
jne .nocrlf
|
||
inc edi
|
||
.nocrlf:
|
||
mov ecx,edi
|
||
sub ecx,[ebp]
|
||
add ebp,8
|
||
mov [ebp-4],ecx
|
||
cmp edi,[cursor]
|
||
jb .again
|
||
and dword[ebp],0
|
||
; dpd esi
|
||
mov eax,[pinfo.y_start]
|
||
shl eax,3
|
||
sub ebp,eax
|
||
cmp ebp,os_work
|
||
jae .ok2
|
||
mov ebp,os_work
|
||
.ok2:
|
||
cmp ebp,[last_ebp]
|
||
je .ok3
|
||
mov [last_ebp],ebp
|
||
call erase_screen
|
||
.ok3:
|
||
mov ebx,10 shl 16 +30
|
||
; ud2
|
||
.newl:
|
||
mcall 4,,0xffffff,[ebp],[ebp+4]
|
||
add ebp,8
|
||
add ebx,ROWH
|
||
cmp dword[ebp],0
|
||
jnz .newl
|
||
SUB ebx,ROWH
|
||
call set_cur
|
||
popa
|
||
.ex:
|
||
ret
|
||
|
||
|
||
set_cur:
|
||
MOV ecx,EBX
|
||
shl ecx,16
|
||
add ecx,EBX
|
||
MOV EAX,[ebp+4-8]
|
||
add EAX,2
|
||
imul EAX,6
|
||
mov EBX,EAX
|
||
shl ebx,16
|
||
add EBX,EAX
|
||
mov [lastcur],ecx
|
||
mov [lastcur+4],ebx
|
||
ret
|
||
|
||
e_calc_lines:
|
||
cmp dword[UPP+10*4],0
|
||
je e_.ex
|
||
pusha
|
||
mov ebp,os_work
|
||
mov al,0xd
|
||
mov edi,screen_buf
|
||
; mov esi,[cursor]
|
||
; mov byte[esi],'_'
|
||
; inc [cursor]
|
||
e_.again:
|
||
mov [ebp],edi
|
||
mov esi,[cursor]
|
||
sub esi,edi
|
||
mov ecx,[pinfo.x_start]
|
||
; test ecx,ecx
|
||
; jnz .no0
|
||
; inc ecx
|
||
; .no0:
|
||
cmp ecx,esi
|
||
jbe e_.ok
|
||
mov ecx,esi
|
||
e_.ok:
|
||
repne scasb
|
||
jecxz e_.nocrlf
|
||
cmp byte[edi],10
|
||
jne e_.nocrlf
|
||
inc edi
|
||
e_.nocrlf:
|
||
mov ecx,edi
|
||
sub ecx,[ebp]
|
||
add ebp,8
|
||
mov [ebp-4],ecx
|
||
cmp edi,[cursor]
|
||
jb e_.again
|
||
and dword[ebp],0
|
||
; dpd esi
|
||
mov eax,[pinfo.y_start]
|
||
shl eax,3
|
||
sub ebp,eax
|
||
cmp ebp,os_work
|
||
jae e_.ok2
|
||
mov ebp,os_work
|
||
e_.ok2:
|
||
cmp ebp,[last_ebp]
|
||
je e_.ok3
|
||
mov [last_ebp],ebp
|
||
cmp byte[edi],10
|
||
jne e_.ok3
|
||
|
||
call erase_screen
|
||
e_.ok3:
|
||
mov ebx,10 shl 16+30
|
||
; ud2
|
||
e_.newl:
|
||
; mcall 4,,0xffffff,[ebp],[ebp+4]
|
||
add ebp,8
|
||
add ebx,ROWH
|
||
cmp dword[ebp],0
|
||
jnz e_.newl
|
||
SUB ebx,ROWH
|
||
mcall 4,,0x00ffffff,[ebp-8],[ebp+4-8]
|
||
call set_cur
|
||
popa
|
||
e_.ex:
|
||
ret
|
||
|
||
|
||
AHEADER 0,"?KEY",cfa_queKEY
|
||
PUSH EDI
|
||
XCHG EBP,ESP
|
||
PUSH EAX
|
||
POP EBX
|
||
mov eax,10
|
||
test ebx,ebx
|
||
jz QRX0
|
||
inc eax
|
||
QRX0:
|
||
XOR ECX,ECX ;EBX=0 setup for false flag
|
||
mcall
|
||
cmp eax,1
|
||
jne QRX_
|
||
call draw_window
|
||
call calc_lines
|
||
QRX_:
|
||
cmp eax,3
|
||
je BYE
|
||
cmp eax,2
|
||
jne QRX3
|
||
|
||
mcall 2
|
||
QRX1: MOVZX ECX,AH
|
||
QRX2: PUSH ECX ;save character
|
||
QRX_TRUE:
|
||
MOV ECX,TRUEE ;true flag
|
||
QRX3: PUSH ECX
|
||
POP eax
|
||
XCHG EBP,ESP
|
||
POP EDI
|
||
ret
|
||
|
||
; ?RX ( -- c T | F )
|
||
; Return input character and true, or a false if no input.
|
||
|
||
|
||
AHEADER 0,"EMIT_N",cfa_EMIT_N
|
||
|
||
PUSH EDI
|
||
XCHG EBP,ESP
|
||
;char in AL
|
||
CMP AL,0FFH ;0FFH is interpreted as input
|
||
JNZ TX2 ;do NOT allow input
|
||
MOV AL,32 ;change to blank
|
||
TX2:
|
||
mov ebx,[cursor]
|
||
mov [ebx],AL
|
||
inc [cursor]
|
||
|
||
POP eax
|
||
XCHG EBP,ESP
|
||
POP EDI
|
||
RET
|
||
|
||
|
||
;; Basic I/O
|
||
|
||
cfa_AHEADER 0,'CL_CUR',CL_CUR
|
||
PUSH EAX
|
||
mcall 38,[lastcur+4],[lastcur],0
|
||
POP EAX
|
||
RET
|
||
|
||
cfa_AHEADER 0,'DR_CUR',DR_CUR
|
||
PUSH EAX
|
||
mcall 38,[lastcur+4],[lastcur],0x00FF00FF
|
||
POP EAX
|
||
RET
|
||
|
||
|
||
COLOR_ORDER equ MENUETOS
|
||
include 'gif_lite.inc'
|
||
|
||
cfa_AHEADER 0,'READ_GIF',READ_GIF ;( gif_ptr, out_ptr -- result )
|
||
push esi
|
||
push edi
|
||
push ebp
|
||
mov edi, eax
|
||
mov esi,[ebp]
|
||
mov eax,os_work
|
||
call ReadGIF
|
||
pop ebp
|
||
pop edi
|
||
pop esi
|
||
add ebp,4
|
||
RET
|
||
|
||
;===============================================================
|
||
cursor dd screen_buf
|
||
fRed dd 1
|
||
last_ebp dd 0
|
||
|
||
include 'amain.asm'
|
||
|
||
FINFO:
|
||
.mode dd 0
|
||
dd 0
|
||
.blk dd 1
|
||
.buf dd 0
|
||
.work dd os_work
|
||
.path:
|
||
if SYSTEM eq MEOS
|
||
; .path db 0
|
||
; .path db '/HD/1/FORTH/AUTORUN.DAT',0
|
||
; db '/RD/1/AUTOLOAD.F'
|
||
else
|
||
db '/RD/1/AUTOLOAD.F'
|
||
; db '/RD/1/EXAMPLE.F'
|
||
; db '/RD/1/PICTURE.F'
|
||
; db '/RD/1/AUTORUN.DAT'
|
||
; db '/HD/1/FORTH/AUTORUN.DAT'
|
||
end if
|
||
db 0
|
||
.end_path:
|
||
|
||
|
||
rb 256-($-.path)
|
||
|
||
|
||
lastcur dd 0,0
|
||
|
||
I_END:
|
||
squote_buf rb 1024
|
||
sys_v rd 6
|
||
screen_buf:
|
||
; sc_end:
|
||
rb 4096
|
||
pinfo process_information
|
||
os_work rb 16*1024
|
||
|
||
CTOP = $ ;next available memory in code dictionary
|
||
;============================================================= |