WebSVN – Kolibri OS – Diff – /programs/develop/SPForth/meforth.ASM


; KolSPForth v12
 
;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
 format binary as ""
 
 	org    0x0
 
 	db     'MENUET01'
 	dd     0x01
 	dd     ORIG         ; start of code
 	dd     I_END        ; size of image
MEMS: 	dd     EM       ; memory for app
 	dd     SPP          ; esp
	dd     params
	dd     cur_dir_path
 
 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>, 0x54000000
	; mcall 0,,,COL_WINDOW_BG, ,title ; define window
	mcall 71, 1, header
 
	mcall 9,pinfo,-1
	mov   eax,[pinfo.box.width]
	cdq
	sub   eax,20
	mov   ebx,6
	div   ebx
	mov   [pinfo.box.left],eax
 
	mov   eax,[pinfo.box.height]
	cdq
	sub   eax,40
	mov   ebx,ROWH
	div   ebx
 
	mov   [pinfo.box.top],eax
	call  erase_screen
	mcall 12, 2
	mcall 67,-1,-1,FW_WIDTH,FW_HEIGHT
	popa
	ret
 
 
macro GetSkinHeight
{
	mov  eax,48
	mov  ebx,4
	int 0x40
}
 
erase_screen:
	GetSkinHeight
	mov ecx,eax
	shl ecx,16
	add ecx,[pinfo.box.height]
	sub ecx,eax
	sub ecx,4		
	mov   ebx,[pinfo.box.width]
	add   ebx,5 shl 16 - 9
	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.box.left]
;   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.box.top]
 		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.box.left]
;   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.box.top]
 		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'
 
 header db   'Kolibri Forth v12.1',0
 params: rb 256
 cur_dir_path: rb 4096
 
 
 FINFO:
 	.mode dd 0
		  dd 0
 	.blk  dd 1
 	.buf  dd 0
 	.work dd os_work
 
 
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
   ;=============================================================

Rev 4869	Rev 7134
1	; KolSPForth v12	1	; KolSPForth v12
2		2
3	;Memory Map	3	;Memory Map
4	;	4	;
5	;0	5	;0
6	;0x02C7D ;I_END	6	;0x02C7D ;I_END
7	;0x05430 ;CTOP	7	;0x05430 ;CTOP
8		8
9	;0x3F800 ;Data stack	9	;0x3F800 ;Data stack
10	;0x3FA00 ;return stack	10	;0x3FA00 ;return stack
11	;0x3FC00 ;User	11	;0x3FC00 ;User
12	;0x3FE00 ;TIB	12	;0x3FE00 ;TIB
13	;0x30000 ;FILE BUFF	13	;0x30000 ;FILE BUFF
14	;0x40000 (256K)	14	;0x40000 (256K)
15		15
16	;; Version control	16	;; Version control
17		17
18	VER EQU 1 ;major release version	18	VER EQU 1 ;major release version
19	EXT EQU 0 ;minor extension	19	EXT EQU 0 ;minor extension
20		20
21	;; Constants	21	;; Constants
22		22
23	TRUEE EQU -1 ;true flag	23	TRUEE EQU -1 ;true flag
24		24
25	COMPO EQU 040H ;lexicon compile only bit	25	COMPO EQU 040H ;lexicon compile only bit
26	IMEDD EQU 080H ;lexicon immediate bit	26	IMEDD EQU 080H ;lexicon immediate bit
27	MASKK EQU 01FH ;lexicon bit mask	27	MASKK EQU 01FH ;lexicon bit mask
28		28
29	CELLL EQU 4 ;size of a cell	29	CELLL EQU 4 ;size of a cell
30	BASEE EQU 10 ;default radix	30	BASEE EQU 10 ;default radix
31	VOCSS EQU 8 ;depth of vocabulary stack	31	VOCSS EQU 8 ;depth of vocabulary stack
32		32
33	BKSPP EQU 8 ;back space	33	BKSPP EQU 8 ;back space
34	LF EQU 10 ;line feed	34	LF EQU 10 ;line feed
35	CRR EQU 13 ;carriage return	35	CRR EQU 13 ;carriage return
36	ERR EQU 27 ;error escape	36	ERR EQU 27 ;error escape
37	TIC EQU 39 ;tick	37	TIC EQU 39 ;tick
38		38
39	CALLL EQU 0E8H ;CALL opcodes	39	CALLL EQU 0E8H ;CALL opcodes
40		40
41	ROWH EQU 13	41	ROWH EQU 13
42	KEY_DELAY EQU 20	42	KEY_DELAY EQU 20
43	FW_WIDTH equ 500	43	FW_WIDTH equ 500
44	FW_HEIGHT equ 352	44	FW_HEIGHT equ 352
45		45
46		46
47	;; Memory allocation	47	;; Memory allocation
48		48
49	EM EQU 256*1024 ;top of memory	49	EM EQU 256*1024 ;top of memory
50	FILE_BS EQU 64*1024 ;file buff size	50	FILE_BS EQU 64*1024 ;file buff size
51	US EQU 128*CELLL ;user area size in cells	51	US EQU 128*CELLL ;user area size in cells
52	RTS EQU 1024*CELLL ;return stack/TIB size	52	RTS EQU 1024*CELLL ;return stack/TIB size
53		53
54	FILE_B EQU EM-FILE_BS ;terminal input buffer (TIB)	54	FILE_B EQU EM-FILE_BS ;terminal input buffer (TIB)
55	TIBB EQU FILE_B-RTS ;terminal input buffer (TIB)	55	TIBB EQU FILE_B-RTS ;terminal input buffer (TIB)
56	; UPP EQU TIBB-US ;start of user area (UP0)	56	; UPP EQU TIBB-US ;start of user area (UP0)
57	RPP EQU UPP-RTS ;start of return stack (ESP0)	57	RPP EQU UPP-RTS ;start of return stack (ESP0)
58	SPP EQU RPP-RTS ;start of data stack (EBP0)	58	SPP EQU RPP-RTS ;start of data stack (EBP0)
59		59
60	LastNFA = 0	60	LastNFA = 0
61		61
62	LastCFA EQU INIT	62	LastCFA EQU INIT
63		63
64		64
65		65
66	macro AHEADER FLAG,ID,F_CFA {	66	macro AHEADER FLAG,ID,F_CFA {
67	db FLAG	67	db FLAG
68	DD F_CFA	68	DD F_CFA
69	DD LastNFA	69	DD LastNFA
70	The_Nfa = $	70	The_Nfa = $
71	DB ID,0	71	DB ID,0
72	LastNFA = The_Nfa	72	LastNFA = The_Nfa
73	F_CFA:	73	F_CFA:
74	}	74	}
75		75
76	macro cfa_AHEADER FLAG,ID,F_CFA {	76	macro cfa_AHEADER FLAG,ID,F_CFA {
77	db FLAG	77	db FLAG
78	DD cfa_#F_CFA	78	DD cfa_#F_CFA
79	DD LastNFA	79	DD LastNFA
80	The_Nfa = $	80	The_Nfa = $
81	DB ID,0	81	DB ID,0
82	LastNFA = The_Nfa	82	LastNFA = The_Nfa
83	cfa_#F_CFA:	83	cfa_#F_CFA:
84	}	84	}
85		85
86		86
87	;; Main entry points and COLD start data	87	;; Main entry points and COLD start data
88		88
89	use32	89	use32
90	format binary as ""	90	format binary as ""
91		91
92	org 0x0	92	org 0x0
93		93
94	db 'MENUET01'	94	db 'MENUET01'
95	dd 0x01	95	dd 0x01
96	dd ORIG ; start of code	96	dd ORIG ; start of code
97	dd I_END ; size of image	97	dd I_END ; size of image
98	MEMS: dd EM ; memory for app	98	MEMS: dd EM ; memory for app
99	dd SPP ; esp	99	dd SPP ; esp
100	dd params	100	dd params
101	dd cur_dir_path	101	dd cur_dir_path
102		102
103	lang fix ru	103	lang fix ru
104	include 'MACROS.INC'	104	include 'macros.inc'
105	include '..\..\proc32.inc'	105	include 'proc32.inc'
106		106
107	align 4	107	align 4
108	proc strncmp stdcall, s1:dword, s2:dword, n:dword	108	proc strncmp stdcall, s1:dword, s2:dword, n:dword
109		109
110	push esi	110	push esi
111	push edi	111	push edi
112	mov ecx, [n]	112	mov ecx, [n]
113	test ecx, ecx ; Max length is zero?	113	test ecx, ecx ; Max length is zero?
114	je .done	114	je .done
115		115
116	mov esi, [s1] ; esi = string s1	116	mov esi, [s1] ; esi = string s1
117	mov edi, [s2] ; edi = string s2	117	mov edi, [s2] ; edi = string s2
118	cld	118	cld
119	.compare:	119	.compare:
120	cmpsb ; Compare two bytes	120	cmpsb ; Compare two bytes
121	jne .done	121	jne .done
122	cmp byte [esi-1], 0 ; End of string?	122	cmp byte [esi-1], 0 ; End of string?
123	je .done	123	je .done
124	dec ecx ; Length limit reached?	124	dec ecx ; Length limit reached?
125	jne .compare	125	jne .compare
126	.done:	126	.done:
127	seta al ; al = (s1 > s2)	127	seta al ; al = (s1 > s2)
128	setb ah ; ah = (s1 < s2)	128	setb ah ; ah = (s1 < s2)
129	sub al, ah	129	sub al, ah
130	movsx eax, al ; eax = (s1 > s2) - (s1 < s2), i.e. -1, 0, 1	130	movsx eax, al ; eax = (s1 > s2) - (s1 < s2), i.e. -1, 0, 1
131	pop edi	131	pop edi
132	pop esi	132	pop esi
133	ret	133	ret
134	endp	134	endp
135		135
136	align 4	136	align 4
137	proc GetPr stdcall, exp:dword, sz_name:dword	137	proc GetPr stdcall, exp:dword, sz_name:dword
138	mov edx, [exp]	138	mov edx, [exp]
139	.next:	139	.next:
140	push edx	140	push edx
141	stdcall strncmp, edx, [sz_name], 16	141	stdcall strncmp, edx, [sz_name], 16
142	pop edx	142	pop edx
143	test eax, eax	143	test eax, eax
144	jz .ok	144	jz .ok
145	mov edx, [edx-4]	145	mov edx, [edx-4]
146	test edx, edx	146	test edx, edx
147	jnz .next	147	jnz .next
148	mov eax,edx	148	mov eax,edx
149	ret	149	ret
150	.ok:	150	.ok:
151	mov eax, [edx-8]	151	mov eax, [edx-8]
152	ret	152	ret
153	endp	153	endp
154		154
155	AHEADER 0 ,'GETPR',cfa_GETPR	155	AHEADER 0 ,'GETPR',cfa_GETPR
156	JMP GetPr	156	JMP GetPr
157		157
158		158
159	ORIG:	159	ORIG:
160		160
161	MOV EBP,RPP ;initialize RP	161	MOV EBP,RPP ;initialize RP
162	CLD ;ESI gets incremented	162	CLD ;ESI gets incremented
163	finit	163	finit
164	call draw_window	164	call draw_window
165	call calc_lines	165	call calc_lines
166	XCHG ESP,EBP	166	XCHG ESP,EBP
167	CALL amain	167	CALL amain
168	BYE: mcall -1	168	BYE: mcall -1
169		169
170		170
171	ULAST: ; DD 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0	171	ULAST: ; DD 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
172		172
173		173
174	draw_cursor:	174	draw_cursor:
175		175
176	draw_window:	176	draw_window:
177	pusha	177	pusha
178	mcall 12,1	178	mcall 12,1
179	mov [fRed],ebx	179	mov [fRed],ebx
180	mcall 0, <0,FW_WIDTH>, <0,FW_HEIGHT>, 0x54000000	180	mcall 0, <0,FW_WIDTH>, <0,FW_HEIGHT>, 0x54000000
181	; mcall 0,,,COL_WINDOW_BG, ,title ; define window	181	; mcall 0,,,COL_WINDOW_BG, ,title ; define window
182	mcall 71, 1, header	182	mcall 71, 1, header
183		183
184	mcall 9,pinfo,-1	184	mcall 9,pinfo,-1
185	mov eax,[pinfo.x_size]	185	mov eax,[pinfo.box.width]
186	cdq	186	cdq
187	sub eax,20	187	sub eax,20
188	mov ebx,6	188	mov ebx,6
189	div ebx	189	div ebx
190	mov [pinfo.x_start],eax	190	mov [pinfo.box.left],eax
191		191
192	mov eax,[pinfo.y_size]	192	mov eax,[pinfo.box.height]
193	cdq	193	cdq
194	sub eax,40	194	sub eax,40
195	mov ebx,ROWH	195	mov ebx,ROWH
196	div ebx	196	div ebx
197		197
198	mov [pinfo.y_start],eax	198	mov [pinfo.box.top],eax
199	call erase_screen	199	call erase_screen
200	mcall 12, 2	200	mcall 12, 2
201	mcall 67,-1,-1,FW_WIDTH,FW_HEIGHT	201	mcall 67,-1,-1,FW_WIDTH,FW_HEIGHT
202	popa	202	popa
203	ret	203	ret
204		204
205		205
206	macro GetSkinHeight	206	macro GetSkinHeight
207	{	207	{
208	mov eax,48	208	mov eax,48
209	mov ebx,4	209	mov ebx,4
210	int 0x40	210	int 0x40
211	}	211	}
212		212
213	erase_screen:	213	erase_screen:
214	GetSkinHeight	214	GetSkinHeight
215	mov ecx,eax	215	mov ecx,eax
216	shl ecx,16	216	shl ecx,16
217	add ecx,[pinfo.y_size]	217	add ecx,[pinfo.box.height]
218	sub ecx,eax	218	sub ecx,eax
219	sub ecx,4	219	sub ecx,4
220	mov ebx,[pinfo.x_size]	220	mov ebx,[pinfo.box.width]
221	add ebx,5 shl 16 - 9	221	add ebx,5 shl 16 - 9
222	mcall 13,,,0;xff	222	mcall 13,,,0;xff
223	ret	223	ret
224		224
225		225
226	AHEADER 0,"CC_LINES",cfa_CC_LINES	226	AHEADER 0,"CC_LINES",cfa_CC_LINES
227	calc_lines:	227	calc_lines:
228	cmp dword[UPP+10*4],0	228	cmp dword[UPP+10*4],0
229	je .ex	229	je .ex
230	pusha	230	pusha
231	mov ebp,os_work	231	mov ebp,os_work
232	mov al,0xd	232	mov al,0xd
233	mov edi,screen_buf	233	mov edi,screen_buf
234	; mov esi,[cursor]	234	; mov esi,[cursor]
235	; mov byte[esi],'_'	235	; mov byte[esi],'_'
236	; inc [cursor]	236	; inc [cursor]
237	.again:	237	.again:
238	mov [ebp],edi	238	mov [ebp],edi
239	mov esi,[cursor]	239	mov esi,[cursor]
240	sub esi,edi	240	sub esi,edi
241	mov ecx,[pinfo.x_start]	241	mov ecx,[pinfo.box.left]
242	; test ecx,ecx	242	; test ecx,ecx
243	; jnz .no0	243	; jnz .no0
244	; inc ecx	244	; inc ecx
245	; .no0:	245	; .no0:
246	cmp ecx,esi	246	cmp ecx,esi
247	jbe .ok	247	jbe .ok
248	mov ecx,esi	248	mov ecx,esi
249	.ok:	249	.ok:
250	repne scasb	250	repne scasb
251	jecxz .nocrlf	251	jecxz .nocrlf
252	cmp byte[edi],10	252	cmp byte[edi],10
253	jne .nocrlf	253	jne .nocrlf
254	inc edi	254	inc edi
255	.nocrlf:	255	.nocrlf:
256	mov ecx,edi	256	mov ecx,edi
257	sub ecx,[ebp]	257	sub ecx,[ebp]
258	add ebp,8	258	add ebp,8
259	mov [ebp-4],ecx	259	mov [ebp-4],ecx
260	cmp edi,[cursor]	260	cmp edi,[cursor]
261	jb .again	261	jb .again
262	and dword[ebp],0	262	and dword[ebp],0
263	; dpd esi	263	; dpd esi
264	mov eax,[pinfo.y_start]	264	mov eax,[pinfo.box.top]
265	shl eax,3	265	shl eax,3
266	sub ebp,eax	266	sub ebp,eax
267	cmp ebp,os_work	267	cmp ebp,os_work
268	jae .ok2	268	jae .ok2
269	mov ebp,os_work	269	mov ebp,os_work
270	.ok2:	270	.ok2:
271	cmp ebp,[last_ebp]	271	cmp ebp,[last_ebp]
272	je .ok3	272	je .ok3
273	mov [last_ebp],ebp	273	mov [last_ebp],ebp
274	call erase_screen	274	call erase_screen
275	.ok3:	275	.ok3:
276	mov ebx,10 shl 16 +30	276	mov ebx,10 shl 16 +30
277	; ud2	277	; ud2
278	.newl:	278	.newl:
279	mcall 4,,0xffffff,[ebp],[ebp+4]	279	mcall 4,,0xffffff,[ebp],[ebp+4]
280	add ebp,8	280	add ebp,8
281	add ebx,ROWH	281	add ebx,ROWH
282	cmp dword[ebp],0	282	cmp dword[ebp],0
283	jnz .newl	283	jnz .newl
284	SUB ebx,ROWH	284	SUB ebx,ROWH
285	call set_cur	285	call set_cur
286	popa	286	popa
287	.ex:	287	.ex:
288	ret	288	ret
289		289
290		290
291	set_cur:	291	set_cur:
292	MOV ecx,EBX	292	MOV ecx,EBX
293	shl ecx,16	293	shl ecx,16
294	add ecx,EBX	294	add ecx,EBX
295	MOV EAX,[ebp+4-8]	295	MOV EAX,[ebp+4-8]
296	add EAX,2	296	add EAX,2
297	imul EAX,6	297	imul EAX,6
298	mov EBX,EAX	298	mov EBX,EAX
299	shl ebx,16	299	shl ebx,16
300	add EBX,EAX	300	add EBX,EAX
301	mov [lastcur],ecx	301	mov [lastcur],ecx
302	mov [lastcur+4],ebx	302	mov [lastcur+4],ebx
303	ret	303	ret
304		304
305	e_calc_lines:	305	e_calc_lines:
306	cmp dword[UPP+10*4],0	306	cmp dword[UPP+10*4],0
307	je e_.ex	307	je e_.ex
308	pusha	308	pusha
309	mov ebp,os_work	309	mov ebp,os_work
310	mov al,0xd	310	mov al,0xd
311	mov edi,screen_buf	311	mov edi,screen_buf
312	; mov esi,[cursor]	312	; mov esi,[cursor]
313	; mov byte[esi],'_'	313	; mov byte[esi],'_'
314	; inc [cursor]	314	; inc [cursor]
315	e_.again:	315	e_.again:
316	mov [ebp],edi	316	mov [ebp],edi
317	mov esi,[cursor]	317	mov esi,[cursor]
318	sub esi,edi	318	sub esi,edi
319	mov ecx,[pinfo.x_start]	319	mov ecx,[pinfo.box.left]
320	; test ecx,ecx	320	; test ecx,ecx
321	; jnz .no0	321	; jnz .no0
322	; inc ecx	322	; inc ecx
323	; .no0:	323	; .no0:
324	cmp ecx,esi	324	cmp ecx,esi
325	jbe e_.ok	325	jbe e_.ok
326	mov ecx,esi	326	mov ecx,esi
327	e_.ok:	327	e_.ok:
328	repne scasb	328	repne scasb
329	jecxz e_.nocrlf	329	jecxz e_.nocrlf
330	cmp byte[edi],10	330	cmp byte[edi],10
331	jne e_.nocrlf	331	jne e_.nocrlf
332	inc edi	332	inc edi
333	e_.nocrlf:	333	e_.nocrlf:
334	mov ecx,edi	334	mov ecx,edi
335	sub ecx,[ebp]	335	sub ecx,[ebp]
336	add ebp,8	336	add ebp,8
337	mov [ebp-4],ecx	337	mov [ebp-4],ecx
338	cmp edi,[cursor]	338	cmp edi,[cursor]
339	jb e_.again	339	jb e_.again
340	and dword[ebp],0	340	and dword[ebp],0
341	; dpd esi	341	; dpd esi
342	mov eax,[pinfo.y_start]	342	mov eax,[pinfo.box.top]
343	shl eax,3	343	shl eax,3
344	sub ebp,eax	344	sub ebp,eax
345	cmp ebp,os_work	345	cmp ebp,os_work
346	jae e_.ok2	346	jae e_.ok2
347	mov ebp,os_work	347	mov ebp,os_work
348	e_.ok2:	348	e_.ok2:
349	cmp ebp,[last_ebp]	349	cmp ebp,[last_ebp]
350	je e_.ok3	350	je e_.ok3
351	mov [last_ebp],ebp	351	mov [last_ebp],ebp
352	cmp byte[edi],10	352	cmp byte[edi],10
353	jne e_.ok3	353	jne e_.ok3
354		354
355	call erase_screen	355	call erase_screen
356	e_.ok3:	356	e_.ok3:
357	mov ebx,10 shl 16+30	357	mov ebx,10 shl 16+30
358	; ud2	358	; ud2
359	e_.newl:	359	e_.newl:
360	; mcall 4,,0xffffff,[ebp],[ebp+4]	360	; mcall 4,,0xffffff,[ebp],[ebp+4]
361	add ebp,8	361	add ebp,8
362	add ebx,ROWH	362	add ebx,ROWH
363	cmp dword[ebp],0	363	cmp dword[ebp],0
364	jnz e_.newl	364	jnz e_.newl
365	SUB ebx,ROWH	365	SUB ebx,ROWH
366	mcall 4,,0x00ffffff,[ebp-8],[ebp+4-8]	366	mcall 4,,0x00ffffff,[ebp-8],[ebp+4-8]
367	call set_cur	367	call set_cur
368	popa	368	popa
369	e_.ex:	369	e_.ex:
370	ret	370	ret
371		371
372		372
373	AHEADER 0,"?KEY",cfa_queKEY	373	AHEADER 0,"?KEY",cfa_queKEY
374	PUSH EDI	374	PUSH EDI
375	XCHG EBP,ESP	375	XCHG EBP,ESP
376	PUSH EAX	376	PUSH EAX
377	POP EBX	377	POP EBX
378	mov eax,10	378	mov eax,10
379	test ebx,ebx	379	test ebx,ebx
380	jz QRX0	380	jz QRX0
381	inc eax	381	inc eax
382	QRX0:	382	QRX0:
383	XOR ECX,ECX ;EBX=0 setup for false flag	383	XOR ECX,ECX ;EBX=0 setup for false flag
384	mcall	384	mcall
385	cmp eax,1	385	cmp eax,1
386	jne QRX_	386	jne QRX_
387	call draw_window	387	call draw_window
388	call calc_lines	388	call calc_lines
389	QRX_:	389	QRX_:
390	cmp eax,3	390	cmp eax,3
391	je BYE	391	je BYE
392	cmp eax,2	392	cmp eax,2
393	jne QRX3	393	jne QRX3
394		394
395	mcall 2	395	mcall 2
396	QRX1: MOVZX ECX,AH	396	QRX1: MOVZX ECX,AH
397	QRX2: PUSH ECX ;save character	397	QRX2: PUSH ECX ;save character
398	QRX_TRUE:	398	QRX_TRUE:
399	MOV ECX,TRUEE ;true flag	399	MOV ECX,TRUEE ;true flag
400	QRX3: PUSH ECX	400	QRX3: PUSH ECX
401	POP eax	401	POP eax
402	XCHG EBP,ESP	402	XCHG EBP,ESP
403	POP EDI	403	POP EDI
404	ret	404	ret
405		405
406	; ?RX ( -- c T \| F )	406	; ?RX ( -- c T \| F )
407	; Return input character and true, or a false if no input.	407	; Return input character and true, or a false if no input.
408		408
409		409
410	AHEADER 0,"EMIT_N",cfa_EMIT_N	410	AHEADER 0,"EMIT_N",cfa_EMIT_N
411		411
412	PUSH EDI	412	PUSH EDI
413	XCHG EBP,ESP	413	XCHG EBP,ESP
414	;char in AL	414	;char in AL
415	CMP AL,0FFH ;0FFH is interpreted as input	415	CMP AL,0FFH ;0FFH is interpreted as input
416	JNZ TX2 ;do NOT allow input	416	JNZ TX2 ;do NOT allow input
417	MOV AL,32 ;change to blank	417	MOV AL,32 ;change to blank
418	TX2:	418	TX2:
419	mov ebx,[cursor]	419	mov ebx,[cursor]
420	mov [ebx],AL	420	mov [ebx],AL
421	inc [cursor]	421	inc [cursor]
422		422
423	POP eax	423	POP eax
424	XCHG EBP,ESP	424	XCHG EBP,ESP
425	POP EDI	425	POP EDI
426	RET	426	RET
427		427
428		428
429	;; Basic I/O	429	;; Basic I/O
430		430
431	cfa_AHEADER 0,'CL_CUR',CL_CUR	431	cfa_AHEADER 0,'CL_CUR',CL_CUR
432	PUSH EAX	432	PUSH EAX
433	mcall 38,[lastcur+4],[lastcur],0	433	mcall 38,[lastcur+4],[lastcur],0
434	POP EAX	434	POP EAX
435	RET	435	RET
436		436
437	cfa_AHEADER 0,'DR_CUR',DR_CUR	437	cfa_AHEADER 0,'DR_CUR',DR_CUR
438	PUSH EAX	438	PUSH EAX
439	mcall 38,[lastcur+4],[lastcur],0x00FF00FF	439	mcall 38,[lastcur+4],[lastcur],0x00FF00FF
440	POP EAX	440	POP EAX
441	RET	441	RET
442		442
443		443
444	COLOR_ORDER equ MENUETOS	444	COLOR_ORDER equ MENUETOS
445	include 'gif_lite.inc'	445	include 'gif_lite.inc'
446		446
447	cfa_AHEADER 0,'READ_GIF',READ_GIF ;( gif_ptr, out_ptr -- result )	447	cfa_AHEADER 0,'READ_GIF',READ_GIF ;( gif_ptr, out_ptr -- result )
448	push esi	448	push esi
449	push edi	449	push edi
450	push ebp	450	push ebp
451	mov edi, eax	451	mov edi, eax
452	mov esi,[ebp]	452	mov esi,[ebp]
453	mov eax,os_work	453	mov eax,os_work
454	call ReadGIF	454	call ReadGIF
455	pop ebp	455	pop ebp
456	pop edi	456	pop edi
457	pop esi	457	pop esi
458	add ebp,4	458	add ebp,4
459	RET	459	RET
460		460
461	;===============================================================	461	;===============================================================
462	cursor dd screen_buf	462	cursor dd screen_buf
463	fRed dd 1	463	fRed dd 1
464	last_ebp dd 0	464	last_ebp dd 0
465		465
466	include 'amain.asm'	466	include 'amain.asm'
467		467
468	header db 'Kolibri Forth v12.1',0	468	header db 'Kolibri Forth v12.1',0
469	params: rb 256	469	params: rb 256
470	cur_dir_path: rb 4096	470	cur_dir_path: rb 4096
471		471
472		472
473	FINFO:	473	FINFO:
474	.mode dd 0	474	.mode dd 0
475	dd 0	475	dd 0
476	.blk dd 1	476	.blk dd 1
477	.buf dd 0	477	.buf dd 0
478	.work dd os_work	478	.work dd os_work
479		479
480		480
481	lastcur dd 0,0	481	lastcur dd 0,0
482		482
483	I_END:	483	I_END:
484	squote_buf rb 1024	484	squote_buf rb 1024
485	sys_v rd 6	485	sys_v rd 6
486	screen_buf:	486	screen_buf:
487	; sc_end:	487	; sc_end:
488	rb 4096	488	rb 4096
489	pinfo process_information	489	pinfo process_information
490	os_work rb 16*1024	490	os_work rb 16*1024
491		491
492	CTOP = $ ;next available memory in code dictionary	492	CTOP = $ ;next available memory in code dictionary
493	;=============================================================	493	;=============================================================

Subversion Repositories Kolibri OS

(root)/programs/develop/SPForth/meforth.ASM – Rev 4869 → 7134