;---------------------------------------------------------------
; -IF   "not-if"
macro
code '-if', $ifn
       upsh 73h        ; JNC
        jmp short $if.1

; IF
macro
code 'if',$if
	    upsh 72h        ; JC
.1      call comma1
        upsh [h]
        inc dword [h]
        ret

macro
code 'then',then
	mov C,[h]
        sub C,TOS
        dec C
        mov [TOS],C
        drop
        ret

macro
code '?',??
	or TOS,TOS
        drop
          jz .0
        clc     ;true/nonzero, cf=0
        ret
.0      stc
        ret
dovar:  dup
        pop TOS
        ret
;---------------------------------------------------------------
; n ,
comma:  mov C,4
.1      mov edx,[h]
        mov [edx],TOS
        drop
        add edx,C
        mov [h],edx
        ret
code 'x,', usercomma
        upop C
        jmp short comma.1
comma1: mov C,1
        jmp short comma.1
comma2: mov C,2
        jmp short comma.1
comma3: mov C,3
        jmp short comma.1

dodoes: dup
        pop TOS
        xchg TOS,[esp]
        ret
;---------------------------------------------------------------
dolit:  dup
        mov TOS,[esp]
        mov TOS,[TOS]
        add dword [esp],byte 4
        ret
;---------------------------------------------------------------
code 'create', create
        upsh 32         ;Name
        call $word
        push C
        mov edi,[d]     ;LFA
        mov C,[last]  ;last
        mov edx,[C]
        mov [edi],edx   ;LFA= [last]
        mov [C],edi   ;last= LFA
        mov C,[h]
        mov [edi+4],C ;CFA= here
        mov [edi+8],al  ;Length
        add edi,9
        upop C
        push PSP
        mov PSP,TOS
        rep movsb
        mov [d],edi     ;d= d+9+length
        pop PSP
        pop C
        mov TOS,dovar   ;Code
        jmp compile

;---------------------------------------------------------------
macro
code 'does>', does
        upsh pdoes
        call compile
        upsh dodoes
        jmp compile

pdoes:  dup
        mov TOS,[last]  ;TOS= header
        mov TOS,[TOS]
        mov TOS,[TOS+4] ;TOS= CFA
        pop ebx
        sub ebx,TOS
        sub ebx,byte 5
        mov [TOS+1],ebx ;change "call dovar" to "call <code after does>"
        drop
        ret
;---------------------------------------------------------------
; Compiler
;
code ']', rbracket
.word   upsh 32
        call $word
          jnz .find             ; n=0 means EOL
        drop
        drop
        call query
          jmp short .word
.find   call mfind
          jnc .exec             ; -IF
        call find
          jnc .com
        call number
          jnc .lit
        call type               ; go figure
        upsh '?'
        call emit
        call cr
        call query
          ret
.exec   upop edi                ; execute if found
        call edi
          jmp short .word
.com    call compile
          jmp short .word
.lit    upsh dolit
        call compile
        call comma
          jmp short .word

;---------------------------------------------------------------
compile:
	sub TOS,[h]
        sub TOS,5
        upsh 0xE8       ; CALL
        call comma1
        call comma
        ret

;---------------------------------------------------------------
; [     Stop compiling, go back to interpreter (normally precedes ']')
macro
code '[', lbracket
        add esp,byte 4
        ret

;---------------------------------------------------------------
; ;;    Compile EXIT but continue compilation
macro
code ';;', ssemi
	mov edx,[h]
        sub edx,byte 5
        cmp byte [edx],0xE8          ;CALL?
         jnz .1
        inc byte [edx]              ;change to JMP
         ret
.1      mov byte [edx+5],0xC3       ;RET
        inc dword [h]
        ret

;---------------------------------------------------------------
; ;     End compilation
macro
code ';', semi
	call ssemi
        jmp lbracket

;---------------------------------------------------------------
; : <name>      Define a new word & begin compiling
code ':', colon
	call create
        sub dword [h],byte 5    ;undo 'call dovar'
        jmp rbracket
