win32forth-cvs

[Alex M. <ale...@us...>]

Update of /cvsroot/win32forth/win32forth-stc/src
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv5696

Modified Files:
	dis486.f optliterals.f 
Log Message:
arm: further support for type system; cleaner optimisation

Index: dis486.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/dis486.f,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** dis486.f	13 Nov 2006 00:49:19 -0000	1.5
--- dis486.f	22 Nov 2006 00:06:53 -0000	1.6
***************
*** 1075,1079 ****
  \  tcol
  
!         
  : desc-stack    ( n -- )
                  dup 0< if drop ." ? " else . then ;
--- 1075,1079 ----
  \  tcol
  
! 
  : desc-stack    ( n -- )
                  dup 0< if drop ." ? " else . then ;
***************
*** 1082,1093 ****
  
  : describe      ( xt -- )
!                 >name cr
!                 dup ." : " count type
!                 dup (in/out@) swap 
!                   ."  ( " desc-stack
                    ." -- " desc-stack
!                 dup ." ) "oper-col ." ( len=" n>ofa w@ .
                  dup ." type=" n>tfa c@ .
!                     ." flag=" n>flg c@ h.2 ."  )"
                  ;
  
--- 1082,1104 ----
  
  : describe      ( xt -- )
!                 dup>r >name cr
!                 dup dup n>tfa c@
!                 case
!                   tval of r@ execute . ." value "    .id                         endof
!                   tcon of r@ execute . ." constant " .id                         endof
!                   tvar of ." variable " .id ." ( @ is " r@ execute @ 10. ." ) "  endof
!                   tcol of ." : " .id                                             endof
!                   tdef of ." defer " .id ." ( xt is " r@ defer@ .name ." )"      endof
!                   swap ." :  " .id
!                 endcase
!                 dup (in/out@) swap
!                   ." ( " desc-stack
                    ." -- " desc-stack
!                 dup ." ) " oper-col ." \ len=" n>ofa w@ .
                  dup ." type=" n>tfa c@ .
!                 dup ." flag=" n>flg c@ h.2
!                 dup cr oper-col ." \ file=" >ffa@ .id
!                 dup ." @ " >vfa@ 10.
!                 r>drop drop
                  ;
  

Index: optliterals.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth-stc/src/optliterals.f,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** optliterals.f	13 Nov 2006 00:49:19 -0000	1.9
--- optliterals.f	22 Nov 2006 00:06:53 -0000	1.10
***************
*** 34,63 ****
  cr .( Loading optimiser [literals]...)
  
! [undefined] optimise [if] 
    vocabulary optimise
  [then]
  
- code s-reverse ( n[k]..2 1 0 k -- 0 1 2..n[k] ) \ w32f
- \ *g reverse n items on stack   \n
- \ ** usage: 1 2 3 4 5 5 s-reverse ==> 5 4 3 2 1
-          lea     ecx, -4 [ebp]     \ ecx points 4 under top of stack
-          lea     eax, 4 [ecx] [eax*4] \ eax points 4 over stack
-                                    \ bump pointers, if they overlap, stop
- @@1:     sub     eax, # 4          \ adjust top
-          add     ecx, # 4          \ adjust bottom
-          cmp     ecx, eax          \ compare
-          jae     short @@2         \ ecx passing ebx, so exit
-                                    \ rotate a pair
-          mov     edx, 0 [eax]      \ bottom to edx
-          xor     0 [ecx], edx      \ exchange top and edx
-          xor     edx,  0 [ecx]
-          xor     0 [ecx], edx
-          mov     0 [eax], edx      \ eax to bottom
-          jmp     short @@1         \ next pair
- 
- @@2:     mov     eax, [ebp]
-          lea     ebp, 4 [ebp]
-          next    c;
- 
  also optimise definitions
  
--- 34,41 ----
  cr .( Loading optimiser [literals]...)
  
! [undefined] optimise [if]
    vocabulary optimise
  [then]
  
  also optimise definitions
  
***************
*** 73,76 ****
--- 51,57 ----
  ))
  
+ \ To help the optimiser, some code words that deal with constants 
+ \ are broken up into their constituent parts for compile time
+ 
  :noname drop cell postpone literal ; compiles-for cell
  :noname drop postpone cell  postpone + ; compiles-for cell+
***************
*** 82,85 ****
--- 63,69 ----
  :noname drop 1 postpone literal postpone + ; dup compiles-for 1+ compiles-for char+
  
+ \ This stack of literals should really be a queue, as we need fifo. Emulated
+ \ by reversing the contents as it's popped.
+ 
  100 stack lits
  
***************
*** 89,108 ****
  reset-stack-chain chain-add reset-lits
  
! 0 value std-delay
! : std-adjust ( -- )                      \ generate delayed stack adjust
!            std-delay if
!               macro[ lea   ebp, std-delay negate cells [ebp] ]macro
!            0 to std-delay
!            then ;
  
! : std+n    { n }                         \ adjust stack
!            macro[ lea   ebp, n negate cells [ebp] ]macro ;
  
  \ addressing the data stack
! \ std[0] refers to top of stack (eax in this case)
! \ std[-1] is next left (as in a stack diagram)
! \ std[1] is a new right stack entry
  
! macro: std[] ( n -- )                    \ generate code to address stack entry n
             dup if
               dup 0< if 1+ then
--- 73,91 ----
  reset-stack-chain chain-add reset-lits
  
! \ The stack is addressed much in the same way PICK would; 0 refers to the top of
! \ stack, and 1 to next of stack. -1 refers to the first new entry, and
! \ so on for increasing negative numbers.
! \ Keep in mind that the stack (addressed by ebp) grows downwards, so 3 n+stk makes
! \ the stack 3 cells bigger, and conversely -1 n+stk makes it one smaller.
  
! : n+stk    ( n )                         \ adjust stack
!            ?dup if >r macro[ lea   ebp, r@ negate cells [ebp] ]macro r>drop then ;
  
  \ addressing the data stack
! \ stk[0] refers to top of stack (eax in this case)
! \ stk[-1] is next left (as in a stack diagram)
! \ stk[1] is a new right stack entry
  
! macro: stk[] ( n -- )                    \ generate code to address stack entry n
             dup if
               dup 0< if 1+ then
***************
*** 110,133 ****
             else drop eax then ;m
  
! macro: std[-1] -1 std[] ;m               \ next of stack
! macro: std[0]   0 std[] ;m               \ top of stack
! macro: std[1]   1 std[] ;m               \ new on stack
! 
  
! : mov-tos,n[ebp] { off }     macro[ mov   eax, off [ebp]         ]macro ;
! : mov-n[ebp],tos { off }     macro[ mov   off [ebp], eax         ]macro ;
  
! macro: std[],# std[] , dword # ;m
  
! : #n->std[]  { n off }
              n if
!               n -1 = if macro[ or    off std[],# n ]macro
!               else macro[ mov   off std[],# n   ]macro
                then
!             else macro[ and    off std[],# n ]macro
              then ;
              
! : pop-tos     { }             0 mov-tos,n[ebp]   -1 std+n ;
! : push-tos    { }            -4 mov-n[ebp],tos    1 std+n ;
  
  macro: tos,#n    ( n )       eax, # ;m \ macro: supports asm fragments
--- 93,116 ----
             else drop eax then ;m
  
! \ not yet working
! 0 value stk-delay
! : stk-adjust ( -- )                      \ generate delayed stack adjust
!            stk-delay n+stk 0 to stk-delay ;
  
! : n[ebp]->tos { off }     macro[ mov   eax, off [ebp]         ]macro ;
! : tos->n[ebp] { off }     macro[ mov   off [ebp], eax         ]macro ;
  
! macro: stk[],# stk[] , dword # ;m
  
! : #n->stk[]  { n off }
              n if
!               n -1 = if macro[ or    off stk[],# n ]macro
!               else macro[ mov   off stk[],# n   ]macro
                then
!             else macro[ and    off stk[],# n ]macro
              then ;
              
! : pop-tos     { }             0 n[ebp]->tos   -1 n+stk ;
! : push-tos    { }            -4 tos->n[ebp]    1 n+stk ;
  
  macro: tos,#n    ( n )       eax, # ;m \ macro: supports asm fragments
***************
*** 169,181 ****
             in-sync @ 0= if               \ recursing?
               in-sync on                  \ no, so set
!              std-adjust
               lits>0? dup if              \ anything to do?
!                -4 mov-n[ebp],tos         \ save tos
!                lits spop 0 #n->std[]     \ load tos
                 lits sdepth 0 ?do         \ do for n-1 entries
                   lits spop over i -
!                  #n->std[]               \ generate a move
                 loop
!                std+n                     \ adjust stack
               else drop
               then
--- 152,164 ----
             in-sync @ 0= if               \ recursing?
               in-sync on                  \ no, so set
!              stk-adjust
               lits>0? dup if              \ anything to do?
!                -4 tos->n[ebp]         \ save tos
!                lits spop 0 #n->stk[]     \ load tos
                 lits sdepth 0 ?do         \ do for n-1 entries
                   lits spop over i -
!                  #n->stk[]               \ generate a move
                 loop
!                n+stk                     \ adjust stack
               else drop
               then
***************
*** 196,200 ****
  : opt>     opt<= not-tos ;
  
! : optswap  1 #n->std[] 1 std+n ;
  
  create opt-lit-table1
--- 179,183 ----
  : opt>     opt<= not-tos ;
  
! : optswap  1 #n->stk[] 1 n+stk ;
  
  create opt-lit-table1
***************
*** 272,276 ****
             lits>0? if
               litstart push-tos cells dup if
!                mov-tos,n[ebp]
               else drop then
             else
--- 255,259 ----
             lits>0? if
               litstart push-tos cells dup if
!                n[ebp]->tos
               else drop then
             else