Changeset 2112


Ignore:
Timestamp:
Jan 18, 2011, 9:25:30 PM (4 years ago)
Author:
wmb
Message:

Kernel - fixed a longstanding inefficiency in the code that handles "is" / "to" for basic datatypes like value and defer. "to <value>" is now much faster, comparable in speed to "<variable> @".

Files:
7 edited

Legend:

Unmodified
Added
Removed
  • cpu/arm/kerncode.fth

    r2014 r2112  
    133133 
    134134meta definitions 
     135 
     136code isdefer  ( xt -- ) 
     137   ldr r0,[ip],1cell   \ Get CFA of target word 
     138   ldr r0,[r0,1cell]   \ Get user number 
     139   str tos,[r0,up]     \ Store value 
     140   pop tos,sp          \ Fix stack 
     141c; 
     142code isvalue  ( n -- ) 
     143   ldr r0,[ip],1cell   \ Get CFA of target word 
     144   ldr r0,[r0,1cell]   \ Get user number 
     145   str tos,[r0,up]     \ Store value 
     146   pop tos,sp          \ Fix stack 
     147c; 
     148code isuser  ( n -- ) 
     149   ldr r0,[ip],1cell   \ Get CFA of target word 
     150   ldr r0,[r0,1cell]   \ Get user number 
     151   str tos,[r0,up]     \ Store value 
     152   pop tos,sp          \ Fix stack 
     153c; 
     154code isconstant  ( n -- ) 
     155   ldr r0,[ip],1cell   \ Get CFA of target word 
     156   str tos,[r0,1cell]  \ Store value 
     157   pop tos,sp          \ Fix stack 
     158c; 
     159code isvariable  ( n -- ) 
     160   ldr r0,[ip],1cell   \ Get CFA of target word 
     161   str tos,[r0,1cell]  \ Store value 
     162   pop tos,sp          \ Fix stack 
     163c; 
    135164 
    136165code (lit)  ( -- lit ) 
  • cpu/arm/kernel.bth

    r1041 r2112  
    3232 
    3333[ifndef] arm-assembler          \ Make sure we have the ARM assembler 
    34 order cr 
    3534only forth also definitions 
    3635 
  • cpu/mips/kerncode.fth

    r1294 r2112  
    207207 
    208208meta definitions 
     209 
     210code isdefer  ( xt -- ) 
     211   ip        t0   get 
     212   ip             ainc 
     213 
     214   t0 4      t0   lw    \ Get user number 
     215   t0 up     t0   addu  \ User area address 
     216   tos base  tos  subu  \ relocate xt 
     217   tos      t0 0  sw    \ Store value 
     218   sp             ainc  \ finish popping stack 
     219c; 
     220 
     221code isuser  ( xt -- ) 
     222   ip        t0   get 
     223   ip             ainc 
     224 
     225   t0 4      t0   lw    \ Get user number 
     226   t0 up     t0   addu  \ User area address 
     227   tos      t0 0  sw    \ Store value 
     228   sp             ainc  \ finish popping stack 
     229c; 
     230 
     231code isvalue  ( xt -- ) 
     232   ip        t0   get 
     233   ip             ainc 
     234 
     235   t0 4      t0   lw    \ Get user number 
     236   t0 up     t0   addu  \ User area address 
     237   tos      t0 0  sw    \ Store value 
     238   sp             ainc  \ finish popping stack 
     239c; 
     240 
     241code isconstant  ( xt -- ) 
     242   ip        t0   get 
     243   ip             ainc 
     244 
     245   tos      t0 4  sw    \ Store value 
     246   sp             ainc  \ finish popping stack 
     247c; 
     248 
     249code isvariable  ( xt -- ) 
     250   ip        t0   get 
     251   ip             ainc 
     252 
     253   tos      t0 4  sw    \ Store value 
     254   sp             ainc  \ finish popping stack 
     255c; 
    209256 
    210257\ dovariable constant dovariable 
  • cpu/ppc/kerncode.fth

    r1494 r2112  
    190190 
    191191meta definitions 
     192 
     193code isdefer  ( xt -- ) 
     194   literal-to-t0 
     195   lwz    t0,/cf(t0)   \ User number in t0 
     196   stwx   tos,t0,up 
     197   pop-tos 
     198c; 
     199 
     200code isvalue  ( n -- ) 
     201   literal-to-t0 
     202   lwz    t0,/cf(t0)   \ User number in t0 
     203   stwx   tos,t0,up 
     204   pop-tos 
     205c; 
     206 
     207code isuser  ( n -- ) 
     208   literal-to-t0 
     209   lwz    t0,/cf(t0)   \ User number in t0 
     210   stwx   tos,t0,up 
     211   pop-tos 
     212c; 
     213 
     214code isconstant ( n -- ) 
     215   literal-to-t0 
     216   stw    tos,/cf(t0) 
     217   pop-tos 
     218c; 
     219 
     220code isvariable ( n -- ) 
     221   literal-to-t0 
     222   stw    tos,/cf(t0) 
     223   pop-tos 
     224c; 
    192225 
    193226\ dovariable constant dovariable 
  • cpu/x86/kerncode.fth

    r1294 r2112  
    161161 
    162162\ ---- Run-time words compiled by compiling words. 
     163 
     164code isdefer  ( xt -- ) 
     165   0 [ip]  ax  mov   ip ainc  /cf [ax] ax mov  ?bswap-ax  up ax add  \ data address in ax 
     166[ifdef] big-endian-t 
     167   ax bx mov  ax pop  ?bswap-ax  ax 0 [bx] mov 
     168[else] 
     169   bx pop  bx  0 [ax] mov 
     170[then] 
     171c;    
     172code isvalue  ( n -- ) 
     173   0 [ip]  ax  mov   ip ainc  /cf [ax] ax mov  ?bswap-ax  up ax add  \ data address in ax 
     174[ifdef] big-endian-t 
     175   ax bx mov  ax pop  ?bswap-ax  ax 0 [bx] mov 
     176[else] 
     177   bx pop  bx  0 [ax] mov 
     178[then] 
     179c;    
     180code isuser  ( n -- ) 
     181   0 [ip]  ax  mov   ip ainc  /cf [ax] ax mov  ?bswap-ax  up ax add  \ data address in ax 
     182[ifdef] big-endian-t 
     183   ax bx mov  ax pop  ?bswap-ax  ax 0 [bx] mov 
     184[else] 
     185   bx pop  bx  0 [ax] mov 
     186[then] 
     187c;    
     188code isconstant  ( n -- ) 
     189   0 [ip]  bx  mov   ip ainc 
     190   ax pop  ?bswap-ax  ax /cf [bx] mov 
     191c;    
     192code isvariable  ( n -- ) 
     193   0 [ip]  bx  mov   ip ainc 
     194   ax pop  ?bswap-ax  ax /cf [bx] mov 
     195c;    
    163196 
    164197code bswap  (s n1 -- n2 ) 
  • forth/kernel/kernel.fth

    r1865 r2112  
    19131913   ' !      token,-t    \ variable 
    19141914 
     1915create is-ops 
     1916   ' isdefer    token,-t        \ defer 
     1917   ' isuser     token,-t        \ user variable 
     1918   ' isvalue    token,-t        \ value 
     1919   ' isconstant token,-t        \ constant 
     1920   ' isvariable token,-t        \ variable 
     1921 
    19151922: associate  ( acf -- true  |  index false ) 
    19161923   word-type  ( n ) 
     
    19581965 
    19591966: do-is  ( data acf -- ) 
    1960    dup kerntype?  if     ( [data] acf ) 
    1961       state @  if   compile (is)  token,  else  (is   then 
    1962    else                    ( [data] acf ) 
     1967   dup associate  if              ( [data] acf ) 
    19631968      to-hook 
    1964    then 
     1969   else                           ( [data] acf index ) 
     1970      state @  if                 ( acf index ) 
     1971         is-ops swap ta+ token@   ( acf is-token ) 
     1972         token, token,            ( ) 
     1973      else                        ( data acf index ) 
     1974         tuck data-locs +execute  ( data index data-adr ) 
     1975         swap !ops +execute       ( ) 
     1976      then                        ( ) 
     1977   then                           ( ) 
    19651978; 
    19661979\ is is the word that is actually used by applications 
  • forth/lib/decomp.fth

    r1294 r2112  
    301301: skip-(')      ( ip -- ip' )  ta1+ ta1+  ; 
    302302headerless 
    303 : .is           ( ip -- ip' )  .cword dup token@ .name  ta1+ ; 
     303: .is           ( ip -- ip' )  ." to "  ta1+ dup token@ .name  ta1+ ; 
    304304: .string-tail  ( ip -- ip' )  dup count type  +str  ; 
    305305: .string       ( ip -- ip' )  .cword .string-tail  put"  ; 
     
    323323 
    324324\  Common constant for sizing the three classes: 
    325 d# 30 constant #decomp-classes 
     325d# 36 constant #decomp-classes 
    326326 
    327327#decomp-classes tassociative: execution-class  ( token -- index ) 
     
    338338   ( 20 ) [compile]  ("s)            ( 21 ) [compile]  (is) 
    339339   ( 22 ) [compile]  (dlit)          ( 23 ) [compile]  (llit) 
    340    ( 24 ) [compile]  (n")            ( 25 ) [compile]  dummy 
    341    ( 26 ) [compile]  dummy           ( 27 ) [compile]  dummy 
    342    ( 28 ) [compile]  dummy           ( 29 ) [compile]  dummy 
     340   ( 24 ) [compile]  (n")            ( 25 ) [compile]  isdefer 
     341   ( 26 ) [compile]  isuser          ( 27 ) [compile]  isvalue 
     342   ( 28 ) [compile]  isconstant      ( 29 ) [compile]  isvariable 
     343   ( 30 ) [compile]  dummy           ( 31 ) [compile]  dummy 
     344   ( 32 ) [compile]  dummy           ( 33 ) [compile]  dummy 
     345   ( 34 ) [compile]  dummy           ( 35 ) [compile]  dummy 
    343346 
    344347\ Print a word which has been classified by  execution-class 
     
    356359   ( 20 )     .pstring               ( 21 )     .is 
    357360   ( 22 )     .dlit                  ( 23 )     .llit 
    358    ( 24 )     .nstring               ( 25 )     dummy 
    359    ( 26 )     dummy                  ( 27 )     dummy 
    360    ( 28 )     dummy                  ( 29 )     dummy 
     361   ( 24 )     .nstring               ( 25 )     .is 
     362   ( 26 )     .is                    ( 27 )     .is 
     363   ( 28 )     .is                    ( 29 )     .is 
     364   ( 30 )     dummy                  ( 31 )     dummy 
     365   ( 32 )     dummy                  ( 32 )     dummy 
     366   ( 34 )     dummy                  ( 35 )     dummy 
    361367   ( default ) .word 
    362368; 
     
    377383   ( 20 )     skip-string            ( 21 )     skip-word 
    378384   ( 22 )     skip-dlit              ( 23 )     skip-llit 
    379    ( 24 )     skip-nstring           ( 25 )     dummy 
    380    ( 26 )     dummy                  ( 27 )     dummy 
    381    ( 28 )     dummy                  ( 29 )     dummy 
     385   ( 24 )     skip-nstring           ( 25 )     skip-word 
     386   ( 26 )     skip-word              ( 27 )     skip-word 
     387   ( 28 )     skip-word              ( 29 )     skip-word 
     388   ( 30 )     dummy                  ( 31 )     dummy 
     389   ( 32 )     dummy                  ( 32 )     dummy 
     390   ( 34 )     dummy                  ( 35 )     dummy 
    382391  ( default ) skip-word 
    383392; 
Note: See TracChangeset for help on using the changeset viewer.