~vertigo/shoehorn

e3d97bad6edebb61e425eac3f790a25d12ca10f4 — Samuel A. Falvo II 6 months ago 65d8ede main
Add DO, ?DO, LOOP, and +LOOP
3 files changed, 29 insertions(+), 2 deletions(-)

M colon.fs
M hw.f
M w65c816.fs
M colon.fs => colon.fs +5 -1
@@ 137,7 137,7 @@ create template
: TXVARIABLE
    TXCREATE 0 T, ;

: cmp:[']		    name check emit:litaddr ;
: cmp:[']		    name check xquery emit:litaddr ;

\ Control Flow Constructs



@@ 150,6 150,10 @@ create template
: cmp:until ( L - )         emit:0branch ;
: cmp:while ( L1 - L2 )     cmp:if swap ;
: cmp:repeat ( L1 L2 - )    emit:jumpL cmp:then ;
: cmp:do ( - L2 L1 )        label label emit:do ;
: cmp:?do ( - L2 L1 )       label label emit:?do ;
: cmp:loop ( L2 L1 - )      emit:loop ;
: cmp:+loop ( L2 L1 - )     emit:+loop ;

\ String Support


M hw.f => hw.f +4 -1
@@ 6,7 6,7 @@
\ defined using extern: N N (for any name N) as well.

xref: drop dup over swap and zgo nzgo go
xref: or
xref: or i

\ Some primitive names don't map to a corresponding name in
\ the assembly language file.  Thus, they must be mangled


@@ 45,3 45,6 @@ tx: hw hello-world
tcreate foo
      1 t, 2 t, 3 tc, 4 tc,

t: anotherType ( a u - )
  0 DO i over + c@ emit loop drop ;


M w65c816.fs => w65c816.fs +20 -0
@@ 45,6 45,7 @@ CREATE vocab
: absE ( cap up cao uo - )  opc .entry type cr ;
: abs# ( n cao uo -- )      opc . cr ;
: dp,x ( dp -- )            opc .n ." ,x" cr ;
: dp,s ( dp -- )            opc .n ." ,s" cr ;
: implied ( -- )            opc cr ;
: lbl ( L -- )              opc .L cr ;
: name# ( ca u cao uo - )   opc ." #entry_" type cr ;


@@ 52,15 53,24 @@ CREATE vocab
: beqL ( L -- )             s" beq" lbl ;
: .byte"" ( caddr u -- )    s" .byte" abs" ;
: inx                       s" inx" implied ;
: inc                       s" inc" implied ;
: jmpL ( L -- )             s" jmp" lbl ;
: braL ( L -- )             s" bra" lbl ;
: bneL ( L -- )		    s" bne" lbl ;
: jsr ( caddr u -- )        s" jsr" abs$ ;
: jsrE ( caddr u -- )       s" jsr" absE ;
: ldad,x ( dp - )           s" lda" dp,x ;
: adcd,x ( dp - )           s" adc" dp,x ;
: ldad,s ( dp - )           s" lda" dp,s ;
: cmpd,s ( dp - )           s" cmp" dp,s ;
: rts ( -- )                s" rts" implied ;
: .word ( n -- )            s" .word" abs# ;
: .byte ( n -- )            s" .byte" abs# ;
: dex                       s" dex" implied ;
: stad,x ( dp - )           s" sta" dp,x ;
: clc                       s" clc" implied ;
: pha                       s" pha" implied ;
: pla                       s" pla" implied ;

: >z                        inx inx 2 ldad,x ;
: reserve		    dex dex ;


@@ 82,6 92,16 @@ CREATE vocab
: emit:cell ( n -- )        .word ;
: emit:char ( c -- )        .byte ;
: emit:litaddr ( caddr u -- ) reserve lda#name >t ;
: do-common                 6 ldad,x pha 4 ldad,x pha inx inx inx inx ;
: emit:do ( L L -- L L )    do-common DUP emit:label ;
: emit:?do ( L L -- L L )   do-common OVER bral DUP emit:label ;
: loop-common ( L L -- )
  SWAP emit:label
  3 cmpd,s
  bnel
  pla pla ;
: emit:loop ( L L -- )      1 ldad,s inc loop-common ;
: emit:+loop ( L L -- )     inx inx 1 ldad,s clc 2 adcd,x loop-common ;


VARIABLE hsh