; RETRO-NG, Release 6.20
; Forth Primitives
;---------------------------------------------------------------------


;---------------------------------------------------------------------
tin dd 0
tp  dd tib
var 'h', h, h0
var 'd', d, d0
var 'base', base, 10
var 'source', source, 0
;---------------------------------------------------------------------


;---------------------------------------------------------------------
section .text
code 'sp@', sp_fetch
	upsh esi
next

code 'bytes', bytes
	upop ecx
.1	push ecx
	embed 'c,'
	pop ecx
	loop .1
next

code 'execute', execute
	mov ebx, eax
	drop
	call ebx
next

; ( source dest count -- )
code 'cmove', $cmove
	mov ecx,eax
	drop
	mov edi,eax
	drop
	push esi
	mov esi,eax
.1	mov edx, [esi] 
	mov [edi], edx
	inc edi
	inc esi
	loop .1
	pop esi
	drop
next

code '@', fetch
	mov eax,[eax]
next

code '+',plus
	add eax,[esi] ; +
	add esi,byte 4
next

code '.', print
	push edx
	push edi
	mov edi,esi	;edi = buffer (in stack space)
	sub edi,4
	or eax,eax	;Negative?
	jns .1
	neg eax
	upsh '-'
	call emit
.1			;Convert
	xor edx,edx
	div dword [base]
	add dl,'0'
	cmp dl,'9'
	jbe .2
	add dl,7+32
.2	dec edi
	mov [edi],dl
	or eax,eax
	jnz .1
	mov eax,edi	;Print
	upsh esi
	sub eax,edi	;# of digits
	call type
	pop edi
	pop edx
	upsh ' '	; And add one space after
	call emit	; the number
next

s_dest dd 0
code 's', s
	upop [s_dest]
	mov [tp],dword tib
.0	call key
	cmp al,10
	je .done
	xchg edi,[tp]
	stosb
	xchg [tp],edi
	call emit
	jmp short .0
.done	push ecx	;move string to a safer place...
	push edi
	mov edi,[s_dest]
	mov eax,edi ;push addr
	dup
	push esi
	mov ecx,[tp]
	mov esi,tib
	sub ecx,esi
	mov eax,ecx	;push length
	rep movsb
	pop esi
	pop edi
	pop ecx
	call cr
next

code '!', store
	upop edx
	mov [edx],eax
	drop
next

code 'c!', cstore
	upop edx
	mov [edx], al
	drop
next

code 'c@', cfetch
	upop edx
	dup
	xor eax,eax
	mov al, [edx]
next

code 'type',type
	push ebx
	push ecx
	upop ecx
	upop ebx
	or ecx,ecx	; Is the count zero?
	jz .done	; If so, we can exit
.1 	push ecx	; store the count
	dup		; Duplicate it
	xor eax,eax 	; Filter out junk bits
	mov al,[ebx]	; Obtain the byte to show
	inc ebx		; increment to the next byte
	call emit	; Show the character
	pop ecx		; Restore the count
	loop .1		; Loop, decrementing the count
.done	pop ecx
	pop ebx
next

code 'word',$word
	mov edi,[tin]	; Pointer into TIB
	mov ecx,[tp]
	sub ecx,edi
	inc ecx
	repe scasb
	dec edi
	inc ecx
	dup
	mov [esi],edi	;a
	repne scasb
	mov eax,edi
	dec eax
	sub eax,[esi]	;n
	mov [tin],edi
next


;---------------------------------------------------------------------
; Debugger Oriented Words
;---------------------------------------------------------------------
code 'words',words
	push ebx
	mov ebx, [last]
.1	mov ebx,[ebx]
	or ebx,ebx
	jz .end
	dup
	lea eax,[ebx+8]
	dup
	movzx eax,byte [eax]
	inc dword [esi]
	call type
	upsh 32
	call emit
	jmp short .1
.end	pop ebx
next

code 'last', dbg_last
   upsh last
next

code '<<', l_shift
  upop ecx
  sal eax,cl
next

code '>>', r_shift
  upop ecx
  sar eax,cl
next

code 'or', f_or
  upop ebx
  or eax, ebx
next

;---------------------------------------------------------------------
; ( Allocate the dictionary space )
SECTION .data
flast dd forth_link         ; ( Forth words )
mlast dd macro_link         ; ( Macro [inline] words )
last  dd flast              ; ( Pointer to last word )
section .text
;---------------------------------------------------------------------
