Using the YUKO "unit-strn" table

[The Beez]

Hi 4tH-ers!

I told you it would be fun to get the "unit-strn" table in YUKO working with 4tH -- and it proved to be pretty simple. We need one single 4tH library to make it work! :-)

"unit-strn" is not converted to strings, no -- input strings are converted to numbers (and then compared)!

The first thing I did is let 4tH do the work concerning unit-entries:

TABLE unit-strn
  21825 ( AU ) ,            5264707 ( CUP ) ,         21574 ( FT ) ,
  1515146310 ( FLOZ ) ,     19783 ( GM ) ,            4997447 ( GAL ) ,
  1296126535 ( GRAM ) ,     1212370505 ( INCH ) ,     18251 ( KG ) ,
  19787 ( KM ) ,            16972 ( LB ) ,            22860 ( LY ) ,
  353350469964 ( LITER ) ,  18765 ( MI ) ,            19533 ( ML ) ,
  19789 ( MM ) ,            353350468941 ( METER ) ,  23119 ( OZ ) ,
  17232 ( PC ) ,            21584 ( PT ) ,            21585 ( QT ) ,
  5264212 ( TSP ) ,         1347633748 ( TBSP ) ,     17497 ( YD ) ,
  17220 ( DC ) ,            17988 ( DF ) ,            86076887418187 ( KELVIN ) ,
here unit-strn - constant unit-entries

We can use the get-target-unit unchanged:

: get-target-unit ( "unit" -- n )
    -1   \ Default result for not found
    read-strn
    unit-entries 0 DO
DUP I unit-strn = IF
    DROP I SWAP LEAVE
THEN
    LOOP

    DROP ;

If -- and only if -- we add a :REDO to unit-strn -- and write ourselves a new READ-STRN definition:

:redo unit-strn swap cells + @c ;

Now -- we have to assume the string we got to look up is somewhere in the TIB. In order to get it out we have to parse it -- and once we got it, we have to convert it to a unit-strn entry:

: read-strn bl parse-word >strn ;

Converting it is less difficult than you think. First, we have to convert it to uppercase.  We have a routine in 4tH to do that, but we want to stay as close to the original source as possible, so this is it:

: uppercase ( addr u -- )

  OVER + SWAP ( addr+u addr )

  DO

    I C@ DUP DUP ( c c c )

    [CHAR] ` > SWAP [CHAR] { < AND IF 32 - I C! ELSE DROP THEN

 LOOP ;

Personally, I'd used a WITHIN here -- but there is nothing wrong with it. It's just a bit harder to read IMHO:

[CHAR]  a [CHAR] z 1+ WITHIN

We're almost done here. All we need is the conversion - which is pretty simple:

: >strn stow uppercase n@ tib /tib erase ;

STOW doubles the 2OS, because we will need that address later, because we feed it to N@.

N@ reads an integer from /CELL characters in the Character Segment -- and fortunately these are in the right order, so we're done.

Now -- what is this puzzling "tib /tib erase" good for? TIB returns the address of the TIB, /TIB the size of the TIB. In short, we're ERASEing the TIB after each use, because long units like "KELVIN" leave a lot of characters which will be read by the next one - but are not actually part of that entry.

And that's it! Just make a dummy interpreter to test the whole shebang and we're done!

begin refill while get-target-unit ." Entry " . cr repeat depth .

A sample run looks like:

$ pp4th -x cstr.4th
gram
Entry 6
kelvin
Entry 26
dc
Entry 24
hans
Entry -1 <CTRL-D>
0

Seems to work fine! Note I often leave a "depth ." just to see if we've been working properly. Source snippet included.

Hans Bezemer

[The Beez]

Ok, a few very minor improvements- because I think using it as is would cause trouble:

/cell string cstring

: >strn 2dup uppercase cstring dup >r /cell erase r@ swap cmove r> n@ ;

1. I created a dedicated buffer for cstring expansion;
2. That buffer is erased before the entry is copied there;
3. The conversion to uppercase is done in the TIB;
4. N@ gets the address from that buffer.

This means the TIB is only used to UPPERCASE the unit involved. If one wants to play with the current YUKO involved, I think it will work. :-)

Hans Bezemer

[The Beez]

Thanks to a nice trick I learned from YOKO, this one leaves the TIB untouched:

: >strn 0 cstring dup >r n! tuck r@ swap cmove r@ swap uppercase r> n@ ;

HB

[David Meyer]

Wow. It's not as hard to duplicate my string-to-number trick in 4tH as I thought. That's educational!

--
David Meyer
Takarazuka, Japan
pa...@sdf.org

[The Beez]

I've been a naughty boy. :-) If you rename it, it is a drop-in replacement.

Hans Bezemer