Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > comp.lang.forth > #54599

Re: CASEs compared

Show all headers | View raw

On Thursday, February 2, 2017 at 2:46:07 PM UTC-7, hughag...@gmail.com wrote:
> Having the selector available to the default code might be useful --- if for nothing else, it can be looked at after an abort to determine what invalid value caused the abort --- maybe I'll change <SWITCH to do this; I'll think about it.

Well, I thought about it --- I rewrote the code so all of the table entries and the default code are given the selector value as a parameter --- the programmer now has to manually DROP it if it is not needed.

I also changed my comments so TARG means the constant that we are comparing against and SELECTOR means the value given at run-time that we are selecting on --- my comments had previously used the term TARG for both, which was confusing.

Here is the new version:


\ ******
\ ****** This is a <SWITCH control-structure like in C that generates a jump-table.
\ ******

\ You can build a colon word called XXX that switches on targ values. This is how:
\ <SWITCH
\ :NONAME ... ;  targ SWOF
\ ...
\ :NONAME ... ;  FAST-SWITCH> xxx  ( selector -- )

\ The colon word XXX executes a table-entry corresponding to the targ value.
\ If there is no match, then the xt value prior to FAST-SWITCH> is executed as the default.
\ All of the table-entries and the default are given the selector value which they DROP if not needed.
\ It was HAA's suggestion that the selector value be provided --- I had dropped it internally previously.

\ The targ values don't have to be provided in any particular order --- they get sorted internally.
\ If a duplicate targ value is provided, SWOF will abort with an error message at compile-time.

\ This is pretty crude because, unlike in C, the table entries can't have common local variables.
\ I would have liked to use my rquotations, but they don't have an xt that is known at compile-time,
\ so it is not possible to build a jump-table at compile-time. They have a "continuation" that is only known at run-time.
\ My <SWITCH that I have here uses :NONAME for the table entries --- they can have common global variables.

\ FAST-SWITCH> uses the selector value as an index to do the table look up. This is very fast.
\ If the range is too large however, then FAST-SWITCH> will abort with an error message to save memory.
\ In this case, use SLOW-SWITCH> instead. This builds a smaller table and uses BSEARCH to look up the table-entry.

\ Set JT-LIMIT to the range that you want FAST-SWITCH> to support.
\ It is currently set at 2^16 so you can have jump-tables with up to 64K entries. These consume a lot of memory.
\ If memory usage is an issue, then set JT-LIMIT to a smaller value. Use SLOW-SWITCH> instead of FAST-SWITCH>.
\ If the jump-table is sparse, SLOW-SWITCH> might be faster because there is less data-cache thrashing.

\ <SWITCH is primarily provided for writing VM simulators.
\ JT-LIMIT is currently set at 2^16, so it supports simulating a micro-processor with 16-bit opcodes (such as the AVR).
\ SLOW-SWITCH> would be needed for a micro-processor with 32-bit opcodes (such as the ARM or MIPS).

\ Some micro-processors (or byte-code VMs) have 8-bit opcodes, but also have post-bytes on some of the opcodes.
\ These variable-sized opcodes could be done with nested FAST-SWITCH> constructs.

list
    w field .xt
    w field .targ
constant jt

: init-jt ( xt targ node -- node )
    init-list >r
    r@ .targ !
    r@ .xt !
    r> ;

: new-jt ( xt targ -- node )
    jt alloc
    init-jt ;

: kill-jt ( head -- )
    each[  dealloc  ]each ;

: show-jt ( head -- )
    each[  cr  .targ @ .  ]each ;

: jt> ( new-node node -- new-node flag )    \ used by INSERT-ORDERED to build an ascending list without duplicates
    .targ @  over .targ @
    2dup = abort" *** <SWITCH structures not allowed to have duplicate targ values ***"
    > ;

: <switch ( -- head )
    nil ;

: swof ( head xt targ -- new-head )
    new-jt                                  \ -- head node
    ['] jt> swap  insert-ordered drop ;

1 16 lshift  value jt-limit                 \ should be at least 256 so we can support byte-code simulators

\ JT-LIMIT is the index that is too big for the jump-table. This can be any reasonable size.
\ The jump-table size is limited so the programmer doesn't accidentally build a jump-table consuming megabytes.
\ I set it at 2^16 to support simulating a micro-processor with 16-bit opcodes.

: fast-switch> { head default | adr offset size -- }    \ stream: name
    align here  to adr
    head .targ @  to offset
    head tail .targ @  offset -  to size
    size jt-limit u> abort" *** FAST-SWITCH> has too large of a range. Use SLOW-SWITCH> instead. ***"
    offset  head each[  >r      \ -- targ
        begin  r@ .targ @  over <> while  default ,  1+  repeat
        r> .xt @ ,  1+  ]each  drop
    : ( selector -- )
        dup, offset lit, -,     \ -- selector index
        dup,  size lit,  u>,  if,  drop,  default lit, execute,  end,
        w lit, *,  adr lit, +,  @, execute,  ;,
    head kill-jt ;

: jt-direction ( target mid-element -- -1|0|1 )         \ for use by BSEARCH
    @                                   \ -- target mid-value
    2dup = if  2drop  0 end                             \ note for HAA: I used your END rather than EXIT THEN
    < if  -1  else  1  then ;

: slow-switch> { head default | adr size -- }           \ stream: name
    align here  to adr
    head length  to size
    head each[  dup .targ @ ,  .xt @ ,  ]each
    : ( selector -- )
        adr lit,  size lit,  rover,  d lit,  ['] jt-direction lit,  postpone bsearch
        0=,  if,  drop,  default lit, execute,  end,
        w lit, +,  @, execute,  ;,
    head kill-jt ;
    
\ char & comment      \ some testing code

<switch
    :noname  cr . ." is the 1st prime number." ;    2 swof
    :noname  cr . ." is the 2nd prime number." ;    3 swof
    :noname  cr . ." is the 3rd prime number." ;    5 swof
    :noname  cr . ." is the 4th prime number." ;    7 swof
    :noname  cr . ." is the 5th prime number." ;   11 swof
    :noname  cr . ." is the 6th prime number." ;   13 swof
    :noname  cr . ." is the 7th prime number." ;   17 swof
    :noname  cr . ." is the 8th prime number." ;   19 swof
    :noname  cr . ." is the 9th prime number." ;   23 swof
    :noname  cr . ." is not in our list of primes." ;       fast-switch> fff
    
<switch
    :noname  cr . ." is the 1st prime number." ;    2 swof
    :noname  cr . ." is the 2nd prime number." ;    3 swof
    :noname  cr . ." is the 3rd prime number." ;    5 swof
    :noname  cr . ." is the 4th prime number." ;    7 swof
    :noname  cr . ." is the 5th prime number." ;   11 swof
    :noname  cr . ." is the 6th prime number." ;   13 swof
    :noname  cr . ." is the 7th prime number." ;   17 swof
    :noname  cr . ." is the 8th prime number." ;   19 swof
    :noname  cr . ." is the 9th prime number." ;   23 swof
    :noname  cr . ." is not in our list of primes" ;        slow-switch> sss
    
&

\ Testra had a switch construct written in UR/Forth assembly-language that built two arrays,
\ one of targ values and one of xt values. It generated code that would use SCASW to search the targ values.
\ I recommended using a binary search instead. I was told that SCASW is faster, even though it is sequential.
\ On the 80486, the ciscy instructions did usually provide better performance than hand-written code.
\ Because Testra was into building custom processors, they needed a fast simulator.
\ I didn't use their simulator for the MiniForth though --- I wrote my own in MFX.

\ The best way to write a simulator is to have your assembler not only generate the machine-code
\ for the target processor, but also generate a Forth program on the host machine that simulates it.
\ This generated simulation is much faster than a simulator that looks up opcodes at run-time.
\ This only works if you have the source-code for the target processor program that you are simulating.

Back to comp.lang.forth | Previous | Next — Previous in thread | Next in thread | Find similar | Unroll thread

Thread

CASEs compared "HAA" <someone@microsoft.com> - 2017-01-30 22:34 +1100
  Re: CASEs compared anton@mips.complang.tuwien.ac.at (Anton Ertl) - 2017-01-30 15:56 +0000
    Re: CASEs compared hughaguilar96@gmail.com - 2017-01-30 09:57 -0800
      Re: CASEs compared "HAA" <someone@microsoft.com> - 2017-01-31 14:26 +1100
        Re: CASEs compared hughaguilar96@gmail.com - 2017-01-31 08:12 -0800
          Re: CASEs compared "HAA" <someone@microsoft.com> - 2017-02-01 11:39 +1100
            Re: CASEs compared hughaguilar96@gmail.com - 2017-01-31 22:37 -0800
              Re: CASEs compared hughaguilar96@gmail.com - 2017-02-01 12:26 -0800
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-01 16:50 -0800
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-01 18:02 -0800
                Re: CASEs compared "HAA" <someone@microsoft.com> - 2017-02-02 21:12 +1100
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-02 13:46 -0800
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-02 17:01 -0800
                Re: CASEs compared "HAA" <someone@microsoft.com> - 2017-02-04 12:43 +1100
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-03 17:52 -0800
                Re: CASEs compared Alex <alex@rivadpm.com> - 2017-02-04 11:10 +0000
                Re: CASEs compared rickman <gnuarm@gmail.com> - 2017-02-02 19:57 -0500
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-02 17:05 -0800
                Re: CASEs compared rickman <gnuarm@gmail.com> - 2017-02-02 21:55 -0500
                Re: CASEs compared Mark Wills <markwills1970@gmail.com> - 2017-02-03 02:11 -0800
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-03 10:52 -0800
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-03 17:38 -0800
                Re: CASEs compared rickman <gnuarm@gmail.com> - 2017-02-03 22:08 -0500
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-03 21:40 -0800
                Re: CASEs compared rickman <gnuarm@gmail.com> - 2017-02-04 01:16 -0500
                Re: CASEs compared rickman <gnuarm@gmail.com> - 2017-02-03 14:40 -0500
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-03 17:47 -0800
                Re: CASEs compared rickman <gnuarm@gmail.com> - 2017-02-03 22:04 -0500
                Re: CASEs compared "HAA" <someone@microsoft.com> - 2017-02-04 12:39 +1100
                Re: CASEs compared rickman <gnuarm@gmail.com> - 2017-02-03 23:32 -0500
                Re: CASEs compared "HAA" <someone@microsoft.com> - 2017-02-04 22:50 +1100
                Re: CASEs compared rickman <gnuarm@gmail.com> - 2017-02-04 11:07 -0500
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-04 08:48 -0800
                Re: CASEs compared Mark Wills <markwills1970@gmail.com> - 2017-02-04 10:01 -0800
                Re: CASEs compared rickman <gnuarm@gmail.com> - 2017-02-04 16:43 -0500
                Re: CASEs compared hughaguilar96@gmail.com - 2017-02-04 18:53 -0800
                Re: CASEs compared "HAA" <someone@microsoft.com> - 2017-02-05 19:12 +1100
    Re: CASEs compared "HAA" <someone@microsoft.com> - 2017-01-31 14:25 +1100
  Re: CASEs compared Elliott Chapin <elliott.chapin@gmail.com> - 2017-02-05 08:25 -0800
    Re: CASEs compared Coos Haak <htrofhc@gmail.com> - 2017-02-06 00:42 +0100
  Re: CASEs compared jacko <jackokring@gmail.com> - 2017-02-16 17:46 -0800
    Re: CASEs compared hughaguilar96@gmail.com - 2017-02-17 09:09 -0800

csiph-web