Path: csiph.com!newsfeed.hal-mli.net!feeder3.hal-mli.net!newsfeed.hal-mli.net!feeder1.hal-mli.net!newsreader4.netcologne.de!news.netcologne.de!xlned.com!feeder7.xlned.com!news2.euro.net!postnews2.euro.net!news.wanadoo.nl!not-for-mail From: mhx@iae.nl (Marcel Hendrix) Subject: Re: structure and interpretation of computer programs exercsie 1.3 in forth Newsgroups: comp.lang.forth Message-ID: <85081489028434@frunobulax.edu> Date: Mon, 14 Jan 2013 21:27:50 +0200 References: <50f3e921$0$6089$e4fe514c@dreader36.news.xs4all.nl> X-Newsreader: iForth 2.0 console (October 21, 2006) Lines: 171 Organization: Wanadoo NNTP-Posting-Date: 14 Jan 2013 20:27:46 GMT NNTP-Posting-Host: s529d937f.adsl.online.nl X-Trace: 1358195266 dr5.euro.net 241 82.157.147.127:52241 X-Complaints-To: abuse@wanadoo.nl Xref: csiph.com comp.lang.forth:18778 albert@spenarnc.xs4all.nl (Albert van der Horst) writes Re: structure and interpretation of computer programs exercsie 1.3 in forth > In article <7xk3rgt5ay.fsf@ruckus.brouhaha.com>, > Paul Rubin wrote: >>"Elizabeth D. Rather" writes: >>> Aren't you ignoring the fact that there's a conditional in min? >> >>: min ( a b -- n ) 2dup <= >r 2dup > and swap r> and or ; >Not to forget that one some processors MIN is a code word without jumps. >(Like ARM) [..] Assuming your Forth has a free stack (like iForth): : m2 ( n -- n^2 | 0 ) ( S: 3min -- ) dup S <> and dup * ; : g ( a b c -- n ) 3dup min min >S rot m2 ( -- b c a^2 ) rot m2 + ( -- c a^2+b^2 ) swap m2 + -S ; [ I could have kept 3min and the VALUE, but the LOCALs in g produced ugly code. ] FORTH> ' g idis $01402ACA pop rbx $01402ACB pop rdi $01402ACC mov rax, [rsp] qword $01402AD0 push rdi $01402AD1 push rbx $01402AD2 push rax $01402AD3 mov rcx, rdi $01402AD6 cmp rbx, rcx $01402AD9 cmovg rbx, rcx $01402ADD pop rcx $01402ADE cmp rbx, rcx $01402AE1 cmovg rbx, rcx $01402AE5 pop rdi $01402AE6 pop rax $01402AE7 pop rdx $01402AE8 cmp rbx, rdx $01402AEB setne cl $01402AEF movzx rcx, cl $01402AF3 neg rcx $01402AF6 and rdx, rcx $01402AF9 imul rdx, rdx $01402AFD cmp rbx, rax $01402B00 setne cl $01402B04 movzx rcx, cl $01402B08 neg rcx $01402B0B and rax, rcx $01402B0E imul rax, rax $01402B12 lea r9, [rdx rax*1] qword $01402B16 cmp rbx, rdi $01402B19 setne cl $01402B1D movzx rcx, cl $01402B21 neg rcx $01402B24 and rdi, rcx $01402B27 imul rdi, rdi $01402B2B lea rbx, [r9 rdi*1] qword $01402B2F push rbx $01402B30 ; Branchless. Andrew's: : GodHelpedUsAll ( n1 n2 n3 -- n ) 2dup max >r min max dup * r> dup * + ; $01402BC0 : [trashed] $01402BCA pop rbx $01402BCB mov rdi, [rsp] qword $01402BCF push rbx $01402BD0 mov rcx, rdi $01402BD3 cmp rbx, rcx $01402BD6 cmovl rbx, rcx $01402BDA lea rbp, [rbp -8 +] qword $01402BDE mov [rbp 0 +] qword, rbx $01402BE2 pop rbx $01402BE3 pop rcx $01402BE4 cmp rbx, rcx $01402BE7 cmovg rbx, rcx $01402BEB pop rcx $01402BEC cmp rbx, rcx $01402BEF cmovl rbx, rcx $01402BF3 imul rbx, rbx $01402BF7 mov rdi, [rbp 0 +] qword $01402BFB lea rbp, [rbp 8 +] qword $01402BFF imul rdi, rdi $01402C03 lea rbx, [rbx rdi*1] qword $01402C07 push rbx $01402C08 ; .. turns out branchless and small. Howerd's: : min ( n n -- n ) 2dup - abs - + 2 / ; \ without conditionals : max ( n n -- n ) 2dup + >r min r> swap - ; \ without conditionals \ returns the sum of the squares of the two larger values : GodHelpUsAll ( n1 n2 n3 -- n ) 2dup max >r min max dup * r> dup * + ; FORTH> ' GodHelpUsAll idis $01402CC0 : [trashed] $01402CCA pop rbx $01402CCB pop rdi $01402CCC mov rax, rdi $01402CCF sub rax, rbx $01402CD2 mov rdx, rax $01402CD5 sar rdx, #63 b# $01402CD9 xor rax, rdx $01402CDC sub rax, rdx $01402CDF sub rax, rbx $01402CE2 neg rax $01402CE5 lea rax, [rdi rax*1] qword $01402CE9 lea rdx, [rdi rbx*1] qword $01402CED lea rbp, [rbp -8 +] qword $01402CF1 mov [rbp 0 +] qword, rdx $01402CF5 push rdi $01402CF6 mov rcx, rbx $01402CF9 mov rbx, rax $01402CFC sar rbx, 1 b# $01402D00 mov rdi, [rbp 0 +] qword $01402D04 lea rbp, [rbp 8 +] qword $01402D08 sub rdi, rbx $01402D0B lea rbp, [rbp -8 +] qword $01402D0F mov [rbp 0 +] qword, rdi $01402D13 pop rbx $01402D14 mov rdi, rbx $01402D17 sub rdi, rcx $01402D1A mov rax, rdi $01402D1D sar rax, #63 b# $01402D21 xor rdi, rax $01402D24 sub rdi, rax $01402D27 sub rcx, rdi $01402D2A lea rbx, [rbx rcx*1] qword $01402D2E sar rbx, 1 b# $01402D32 pop rdi $01402D33 mov rax, rdi $01402D36 sub rax, rbx $01402D39 mov rdx, rax $01402D3C sar rdx, #63 b# $01402D40 xor rax, rdx $01402D43 sub rax, rdx $01402D46 sub rax, rbx $01402D49 neg rax $01402D4C lea rax, [rdi rax*1] qword $01402D50 lea rdx, [rdi rbx*1] qword $01402D54 lea rbp, [rbp -8 +] qword $01402D58 mov [rbp 0 +] qword, rdx $01402D5C mov rbx, rax $01402D5F sar rbx, 1 b# $01402D63 mov rdi, [rbp 0 +] qword $01402D67 lea rbp, [rbp 8 +] qword $01402D6B sub rdi, rbx $01402D6E imul rdi, rdi $01402D72 mov rbx, [rbp 0 +] qword $01402D76 lea rbp, [rbp 8 +] qword $01402D7A imul rbx, rbx $01402D7E lea rbx, [rdi rbx*1] qword $01402D82 push rbx $01402D83 ; Branchless but full of gas. -marcel