Path: news.eternal-september.org!eternal-september.org!.POSTED!not-for-mail
From: peter <peter.noreply@tin.it>
Newsgroups: comp.lang.forth
Subject: Re: May the numbers speak - supplement
Date: Thu, 12 Jun 2025 22:24:33 +0200
Organization: A noiseless patient Spider
Lines: 68
Message-ID: <20250612222433.000058bd@tin.it>
References: <20129e22c76a2b18b0a745e9499cbd9b@www.novabbs.com>
	<nnd$673c55b0$2ad8f129@7aad895b352201b7>
	<cc0a8c7a3216f3ed508bde73fc8bd422@www.novabbs.com>
	<feed5481a2c6f29340546fbefb23bb31@www.novabbs.com>
	<37a6f52a3ab1ec533fcf7ef30beb1022@www.novabbs.com>
	<nnd$673c55b0$2ad8f129@52950e570341256b>
	<7c15e1538a1604ad3c7a293ae6196da2530cd1a4@i2pn2.org>
	<87zfed2sbn.fsf@nightsong.com>
MIME-Version: 1.0
Content-Type: text/plain; charset=ISO-8859-1
Content-Transfer-Encoding: quoted-printable
Injection-Date: Thu, 12 Jun 2025 22:24:34 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="5c22ea1f7142dea59d9d1a08eb5ca2a3";
	logging-data="2950681"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1+h+cytneZKjmEwpDBUhX6CvM/5ZbBqoT8="
Cancel-Lock: sha1:Fwm0bGmebtVQY8GbN68L/e2Nlxc=
X-Newsreader: Claws Mail 4.3.0 (GTK 3.24.42; x86_64-w64-mingw32)

On Thu, 12 Jun 2025 02:59:56 -0700
Paul Rubin <no.email@nospam.invalid> wrote:

> This version with the string in memory, no error checking, and using a
> variable, seems simplest to me.
>=20
> variable p
> : advance ( -- ) 1 p +! ;
> : digit ( -- n ) p @ c@ '0' - advance ;
> : 2digit ( -- n ) digit 10 * digit + ;
> : hms ( a u -- h m s ) drop p !
>     2digit advance 2digit advance 2digit advance ;
> : test clearstack  s" 12:34:56" hms ;
>=20
> test .s

This inspired me to write the following
Requiring a well formed time string and a 64 bit cell size

: hms  ( a u -- h m s )
    drop @  $30303A30303A3030 -       =20
    dup $FF0000FF0000FF00 and 8 rshift =20
    swap $00FF0000FF0000FF and dup 3 lshift swap 2* +  =20
    +                                  =20
    dup $ff and
    swap dup 24 rshift $ff and=20
    swap 48 rshift $ff and ;

: test1 100000000 0 do "12:34:56" hms  2drop drop loop ;=20

timer-reset test1 .elapsed 107 ms elapsed ok

if I inline hmns the time goes down to 71 ms

lxf64 now produces native code and works well!

seea hms
0x41FA70  488B5D00                    mov       rbx, qword [rbp]
0x41FA74  488B1B                      mov       rbx, qword [rbx]
0x41FA77  48B830303A30303A3030        mov       rax, 0x30303A30303A3030
0x41FA81  4829C3                      sub       rbx, rax
0x41FA84  48B800FF0000FF0000FF        mov       rax, 0xFF0000FF0000FF00
0x41FA8E  4889D9                      mov       rcx, rbx
0x41FA91  4821C1                      and       rcx, rax
0x41FA94  48C1E908                    shr       rcx, 0x8
0x41FA98  48B8FF0000FF0000FF00        mov       rax, 0xFF0000FF0000FF
0x41FAA2  4821C3                      and       rbx, rax
0x41FAA5  4889D8                      mov       rax, rbx
0x41FAA8  48C1E003                    shl       rax, 0x3
0x41FAAC  48D1E3                      shl       rbx, 0x1
0x41FAAF  4801C3                      add       rbx, rax
0x41FAB2  4801CB                      add       rbx, rcx
0x41FAB5  4889D8                      mov       rax, rbx
0x41FAB8  4825FF000000                and       rax, 0xFF
0x41FABE  4889D9                      mov       rcx, rbx
0x41FAC1  48C1E918                    shr       rcx, 0x18
0x41FAC5  4881E1FF000000              and       rcx, 0xFF
0x41FACC  48C1EB30                    shr       rbx, 0x30
0x41FAD0  4881E3FF000000              and       rbx, 0xFF
0x41FAD7  48894DF8                    mov       qword [rbp-0x8], rcx
0x41FADB  48894500                    mov       qword [rbp], rax
0x41FADF  488D6DF8                    lea       rbp, [rbp-0x8]
0x41FAE3  C3                          ret
116 bytes, 26 instructions

Best Regards
Peter F=E4lth