; ( -- ) System
; R( -- )
; main loop of amforth. accept - interpret in an endless loop
VE_QUIT:
    .dw $ff04
    .db "quit"
    .dw VE_HEAD
    .set VE_HEAD = VE_QUIT
XT_QUIT:
    .dw DO_COLON
PFA_QUIT:               ; init main front loop: 
    .dw XT_SP0          ;   init stacks
    .dw XT_SP_STORE
    .dw XT_RP0
    .dw XT_RP_STORE
    .dw XT_LBRACKET     ;   zero state ! 
PFA_QUIT2:              ; check state: 
    .dw XT_STATE
    .dw XT_FETCH
    .dw XT_EQUALZERO    ; 0= if prompt else refill then
    .dw XT_DOCONDBRANCH ; 
    .dw PFA_QUIT4
.if (halfduplex==1) ; final prompt on new line. 
    .dw XT_READY_PROMPT
.else
    .dw XT_CR
    .dw XT_SLITERAL 
    .dw 2
    .db "> "
    .dw XT_ITYPE
.endif 
PFA_QUIT4:                      ; refill
        .dw XT_STARTTERMINAL    ; deferred word: noop default. set to xon.
    .dw XT_REFILL
        .dw XT_STOPTERMINAL     ; deferred word: noop default. set to xoff.
    .dw XT_DOCONDBRANCH         ; refillflag=true  if recurse
    .dw PFA_QUIT2
    .dw XT_DOLITERAL            ; else interpret then
    .dw XT_INTERPRET
    .dw XT_CATCH
    .dw XT_QDUP
    .dw XT_DOCONDBRANCH         ; if ok recurse
    .dw PFA_QUIT3
    .dw XT_DUP                  ; exception 
    .dw XT_DOLITERAL
    .dw -2
    .dw XT_LESS
    .dw XT_DOCONDBRANCH         ; if error" ??" tib position
    .dw PFA_QUIT5
.if (halfduplex==1)
        ; noop
.else
        .dw XT_CR    ; mk
.endif
        .dw XT_SLITERAL
        .dw 4
        .db  " ?? "
        .dw XT_ITYPE
        .dw XT_BASE
        .dw XT_FETCH
        .dw XT_TO_R
        .dw XT_DECIMAL
        .dw XT_DOT
        .dw XT_G_IN
        .dw XT_FETCH
        .dw XT_DOT
        .dw XT_R_FROM
        .dw XT_BASE
        .dw XT_STORE           ; then
        .dw XT_CR    ; mk
PFA_QUIT5:
        .dw XT_DOBRANCH     ; restart
    .dw PFA_QUIT
PFA_QUIT3:                  ; ok recurse
.if (halfduplex==1)         ; call deffered prompt  
    .dw XT_OK_PROMPT 
.else
;    .dw XT_CR 
    .dw XT_SLITERAL 
    .dw 5 
    .db "  ok ",0 
    .dw XT_ITYPE 
.endif
    .dw XT_DOBRANCH
    .dw PFA_QUIT2 
    .dw XT_EXIT ; never reached



.if (halfduplex==1)  ; deferred prompt. 

; ( -- n*y ) System Value
; R( -- )
; deferred action 
VE_OK_PROMPT:
    .dw $ff09
    .db "ok_prompt" 
    .dw VE_HEAD
    .set VE_HEAD = VE_OK_PROMPT
XT_OK_PROMPT:
    .dw PFA_DODEFER
PFA_OK_PROMPT:
    .dw EE_OK_PROMPT
    .dw XT_EDEFERFETCH
    .dw XT_EDEFERSTORE

; ( -- n*y ) System Value
; R( -- )
; deferred action 
VE_READY_PROMPT:
    .dw $ff0C
    .db "ready_prompt" 
    .dw VE_HEAD
    .set VE_HEAD = VE_READY_PROMPT
XT_READY_PROMPT:
    .dw PFA_DODEFER
PFA_READY_PROMPT:
    .dw EE_READY_PROMPT
    .dw XT_EDEFERFETCH
    .dw XT_EDEFERSTORE

; default ok prompt: 
; ( -- ) 
VE_OPROMPT: 
    .dw $ff07 
    .db "oprompt",0 
    .dw VE_HEAD 
    .set VE_HEAD = VE_OPROMPT 
XT_OROMPT: 
    .dw DO_COLON
PFA_OPROMPT: 
    .dw XT_CR 
    .dw XT_SLITERAL 
    .dw 4 
    .db " ok " 
    .dw XT_ITYPE 
    .dw XT_EXIT 

; default ready prompt: 
; ( -- ) 
VE_RPROMPT: 
    .dw $ff07 
    .db "rprompt",0 
    .dw VE_HEAD 
    .set VE_HEAD = VE_RPROMPT 
XT_RPROMPT: 
    .dw DO_COLON 
PFA_RPROMPT: 
    .dw XT_CR 
    .dw XT_SLITERAL 
    .dw 2 
    .db "» " 
    .dw XT_ITYPE 
    .dw XT_EXIT 
.endif

; use:  
; ' oprompt is ok_prompt 
; ' rprompt is ready_prompt 

; finis