Sujet : Re: May the numbers speak - supplement
De : peter.noreply (at) *nospam* tin.it (peter)
Groupes : comp.lang.forthDate : 12. Jun 2025, 21:24:33
Autres entêtes
Organisation : A noiseless patient Spider
Message-ID : <20250612222433.000058bd@tin.it>
References : 1 2 3 4 5 6 7 8
User-Agent : 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.
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 ;
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 -
dup $FF0000FF0000FF00 and 8 rshift
swap $00FF0000FF0000FF and dup 3 lshift swap 2* +
+
dup $ff and
swap dup 24 rshift $ff and
swap 48 rshift $ff and ;
: test1 100000000 0 do "12:34:56" hms 2drop drop loop ;
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älth