File:  [gforth] / gforth / abi-code-test.fs
Revision 1.5: download - view: text, annotated - select for diffs
Sun May 2 18:15:14 2010 UTC (13 years, 10 months ago) by anton
Branches: MAIN
CVS tags: HEAD
Better compilation of code words (no need to use LIT-EXECUTE for them)

    1: abi-code my+  ( n1 n2 -- n3 )
    2: \ ABI: SP passed in di, returned in ax,  address of FP passed in si
    3: \ Caller-saved: ax,cx,dx,si,di,r8-r11,xmm0-xmm15
    4: 8 di d) ax lea        \ compute new sp in result reg
    5: di )    dx mov        \ get old tos
    6: dx    ax ) add        \ add to new tos
    7: ret
    8: end-code
    9: 
   10: : my+-compiled   ( n1 n2 -- n3 ) my+ ;
   11: 
   12: 12 34 my+  46 <> throw
   13: 12 34 my+-compiled  46 <> throw
   14: 
   15: 
   16: abi-code my-f+ ( r1 r2 -- r )
   17: \ ABI: SP passed in di, returned in ax,  address of FP passed in si
   18: si )    dx mov  \ load fp
   19: .fl dx )   fld  \ r2
   20: 8 #     dx add  \ update fp
   21: .fl dx )   fadd \ r1+r2
   22: .fl dx )   fstp \ store r
   23: dx    si ) mov  \ store new fp
   24: di      ax mov  \ sp into return reg
   25: ret             \ return from my-f+ 
   26: end-code
   27: 
   28: 
   29: : my-constant ( w "name" -- )
   30:     create ,
   31: ;abi-code ( -- w )
   32:     \ sp in di, address of fp in si, body address in dx
   33:     -8 di d) ax lea \ compute new sp in result reg
   34:     dx )     cx mov \ load w
   35:     cx     ax ) mov \ put it in TOS
   36:     ret
   37: end-code
   38: 
   39: 5 my-constant foo
   40: 
   41: : foo-compiled foo ;
   42: 
   43: foo 5 <> throw
   44: foo-compiled 5 <> throw
   45: 
   46: : my-constant2 ( w "name" -- )
   47:     create ,
   48: ;code ( -- w )
   49:     \ sp=r15, tos=r14, ip=bx
   50:     8 #        bx add
   51:     r14     r15 ) mov
   52:     $10 r9 d) r14 mov
   53:     8 #       r15 sub
   54:     -8 bx d)   jmp
   55: end-code
   56: 
   57: 7 my-constant2 bar
   58: : bar-compiled bar ;
   59: 
   60: bar 7 <> throw
   61: bar-compiled 7 <> throw
   62: 
   63: code my-1+ ( n1 -- n2 )
   64:     8 #        bx add
   65:     r14 inc
   66:     -8 bx d)   jmp
   67: end-code
   68: 
   69: : compiled-my-1+
   70:     my-1+ ;
   71: 
   72: 7 my-1+ 8 <> throw
   73: 8 compiled-my-1+ 9 <> throw
   74: 
   75: : funny-compiler-test
   76:     drop my-1+ 1 ;
   77: 
   78: \ 6 9 funny-compiler-test 1 <> throw 7 <> throw

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>