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.