; ( This implements the basic forth interpreter )
interpret:
.0     call query		; ( Get a WORD )
.word  upsh 32 		; ( Push a <SPACE> onto the stack )
call $word		;
jnz .find		; ( Look for the end of the line )
drop			; ( DROP two numbers )
drop			;
jmp short .0	; ( Loop back to start if no words found )
.find call find		; ( Else, Lookup the word )
jnc .exec		; ( Execute if found )
call number		; ( Otherwise make it a number )
jnc .word		; ( Loop back )
drop			; ( It wasn't a word or a number? )
drop			; ( We'll just ignore it )
jmp short .0		; ( And Loop back )
.exec upop edi		; ( Ok, we found a word, so let's )
call edi		; ( execute it )
jmp short .word 	; ( And Loop back )
ret

mfind:  push ebx
        mov ebx, mlast
        jmp short find.0
find:   push ebx
        mov ebx, flast
.0      push C
upop C
.1  mov ebx,[ebx]
  or ebx,ebx
  jz .end
  cmp cl,[ebx+8]
          jne .1
.len push PSP, edi, C
  mov PSP,TOS
  lea edi,[ebx+9]
  rep cmpsb
  pop PSP, edi, C
  jne .1
        mov TOS,[ebx+4]         ;exact match
        clc
          jmp short .ret
.end    upsh C                ;no matches
        stc
.ret  pop C
      pop ebx
      ret

number: push dword [base]
        mov C,TOS     ;n   (keep on stack in case of failure)
        mov ebx,[PSP]   ;a
        dup
        xor TOS,TOS     ;the number
        xor edx,edx     ;temp
        mov dl,[ebx]
        cmp dl,45       ; -     Sign prefix
        pushf
        jne .1
        inc ebx
        dec C
        mov dl,[ebx]
.1      sub dl,36       ; $%&'  Base prefix
        cmp dl,4
        ja .2
        mov dl,[edx+bases]
        mov [base],dl
        inc ebx
        dec C
.2      mov dl,[ebx]    ; digits
        inc ebx
        call digit
        jc .err
        loop .2
        jmp short .3
.err    add esp,byte 4
        drop
        stc
        jmp short .ret
.3      popf
        jne .4
        neg TOS
.4      add PSP,byte 8             ; add PSP,byte 4 add PSP,byte 4
        clc
.ret    pop dword [base]
        ret
bases   db 16,2,8,255           ; $hex %bin &oct 'ascii
digit:  cmp byte [base],255
        je .10x
        cmp dl,57               ; 9
        jbe .1
        and dl,5Fh              ; uppercase
        cmp dl,65               ; throw out chars between '9' and 'A'
        jb .err
        sub dl,7
.1      sub dl,48               ; 0
        cmp dl,[base]
        jb .10x
.err    stc                   ;not a digit
        ret
.10x    imul TOS,[base]
        add TOS,edx
        clc
        ret

query:  mov dword C,[source]
        or C,C
        jnz query_mem
        mov dword [tp],tib           ; Reset TP, TIN
        mov dword [tin],tib
.0      call key                ; Get a keypress
        cmp al,10               ; For standard, change to 10
        je .cr                  ; 
        xchg edi,[tp]           ; Store the char in the TIB
        stosb
        xchg [tp],edi
        call emit               ; Show the byte
        jmp short .0            ; And Loop back around
.cr     lodsd
   call cr
        ret

query_mem:
        mov edi,[tin]
        upsh edi                ; Input pointer
        dup
        cmp Byte [edi],10           ; Skip LF
        jne .0
        inc edi                 ; Increase our pointer
.0      mov [tin],edi
        sub C,edi             ; Remaining length
        jbe .eof
        mov al,10               ; Line Feed
        repne scasb
        mov TOS,edi
        jne .2
        dec TOS
        cmp Byte [TOS-1],13         ; We make CR optional
        jne .2
        dec TOS
.2      upop [tp]
        drop
        ret
.eof    drop
        drop
        add esp,Byte 4    	  ; Discard caller
        pop Dword [tp]
        pop Dword [tin]
        pop Dword [source]
        ret
eval:   push Dword [source]
        push Dword [tin]
        push Dword [tp]
        add TOS,[PSP]
        upop [source]
        upop [tin]
        jmp interpret
