From ef9bedc247f3f3117df23ed54b887289578255d5 Mon Sep 17 00:00:00 2001 From: crc Date: Wed, 16 Sep 2020 20:01:24 +0000 Subject: [PATCH] interfaces: work on commenting the floating point (forth) code FossilOrigin-Name: dbcc2a7584eba163dce2082a0c926addf5b300e98cb4c642017f3612114060b9 --- interface/floatingpoint.retro | 32 +++++++++++++++++++++++++---- vm/nga-c/retro-image.c | 38 +++++++++++++++++------------------ 2 files changed, 47 insertions(+), 23 deletions(-) diff --git a/interface/floatingpoint.retro b/interface/floatingpoint.retro index 7f00ad7..37ce299 100644 --- a/interface/floatingpoint.retro +++ b/interface/floatingpoint.retro @@ -1,5 +1,11 @@ # Floating Point +On Unix hosts, the floating point stack provides a set of +words building on the C `double` data type. In most cases, +this will be a 64-bit, IEEE 754 double precision floating +point format. + + ~~~ {{ 'FPU var @@ -13,7 +19,9 @@ }} ~~~ -# Floating Point +The initial set of words build directly over the core +floating point device functionality, which on a Unix host +maps closely to C and `libm`. ~~~ :n:to-float (n-_f:-n) #0 float:operation ; @@ -46,20 +54,36 @@ :f:push (f:f-) #27 float:operation ; :f:pop (f:-f) #28 float:operation ; :f:adepth (-n) #29 float:operation ; -:f:square (f:n-m) f:dup f:* ; +~~~ + +Above this, additional functions are defined. First are words +to aid in structuring the floating point stack. + +~~~ :f:over (f:ab-aba) f:push f:dup f:pop f:swap ; :f:tuck (f:ab-bab) f:dup f:push f:swap f:pop ; :f:nip (f:ab-b) f:swap f:drop ; :f:drop-pair (f:ab-) f:drop f:drop ; :f:dup-pair (f:ab-abab) f:over f:over ; :f:rot (f:abc-bca) f:push f:swap f:pop f:swap ; +~~~ + +Then a word to allow creation of floating point values via a +`.` prefix. + +~~~ +:prefix:. (s-__f:-a) + compiling? &s:keep &s:temp choose &s:to-float class:word ; immediate +~~~ + +~~~ +:f:square (f:n-m) f:dup f:* ; :f:positive? (-f__f:a-) #0 n:to-float f:gt? ; :f:negative? (-f__f:a-) #0 n:to-float f:lt? ; :f:negate (f:a-b) #-1 n:to-float f:* ; :f:abs (f:a-b) f:dup f:negative? &f:negate if ; -:prefix:. (s-__f:-a) - compiling? &s:keep &s:temp choose &s:to-float class:word ; immediate :f:put (f:a-) f:to-string s:put ; + :f:PI (f:-F) .3.141592 ; :f:E (f:-F) .2.718281 ; :f:NAN (f:-n) .0 .0 f:/ ; diff --git a/vm/nga-c/retro-image.c b/vm/nga-c/retro-image.c index 5820404..6e88292 100644 --- a/vm/nga-c/retro-image.c +++ b/vm/nga-c/retro-image.c @@ -541,18 +541,18 @@ CELL ngaImage[] = { 1793,14569,15110,15152,202010,0,10,1,10,2,10,3,10,4,10,5,10, 10684,10709,144,102,58,97,116,97,110,0,1,26,2049,10295,10,10699,10724,144,102,58, 112,117,115,104,0,1,27,2049,10295,10,10714,10738,144,102,58,112,111,112,0,1, 28,2049,10295,10,10729,10755,144,102,58,97,100,101,112,116,104,0,1,29,2049,10295, - 10,10743,10772,144,102,58,115,113,117,97,114,101,0,2049,10562,2049,10414,10,10760,10787, - 144,102,58,111,118,101,114,0,2049,10724,2049,10562,2049,10738,2049,10592,10,10777,10806,144, - 102,58,116,117,99,107,0,2049,10562,2049,10724,2049,10592,2049,10738,10,10796,10824,144,102, - 58,110,105,112,0,2049,10592,2049,10577,10,10815,10844,144,102,58,100,114,111,112,45, - 112,97,105,114,0,2049,10577,2049,10577,10,10829,10863,144,102,58,100,117,112,45,112, - 97,105,114,0,2049,10787,2049,10787,10,10849,10877,144,102,58,114,111,116,0,2049,10724, - 2049,10592,2049,10738,2049,10592,10,10868,10901,144,102,58,112,111,115,105,116,105,118,101, - 63,0,1,0,2049,10316,2049,10532,10,10886,10923,144,102,58,110,101,103,97,116,105, - 118,101,63,0,1,0,2049,10316,2049,10518,10,10908,10942,144,102,58,110,101,103,97, - 116,101,0,1,-1,2049,10316,2049,10414,10,10930,10958,144,102,58,97,98,115,0,2049, - 10562,2049,10923,1,10942,9,10,10949,10978,156,112,114,101,102,105,120,58,46,0,2049, - 1815,1,3672,1,3601,2049,64,1,10335,2049,144,10,10966,11000,144,102,58,112,117,116, + 10,10743,10770,144,102,58,111,118,101,114,0,2049,10724,2049,10562,2049,10738,2049,10592,10, + 10760,10789,144,102,58,116,117,99,107,0,2049,10562,2049,10724,2049,10592,2049,10738,10,10779, + 10807,144,102,58,110,105,112,0,2049,10592,2049,10577,10,10798,10827,144,102,58,100,114, + 111,112,45,112,97,105,114,0,2049,10577,2049,10577,10,10812,10846,144,102,58,100,117, + 112,45,112,97,105,114,0,2049,10770,2049,10770,10,10832,10860,144,102,58,114,111,116, + 0,2049,10724,2049,10592,2049,10738,2049,10592,10,10851,10881,156,112,114,101,102,105,120,58, + 46,0,2049,1815,1,3672,1,3601,2049,64,1,10335,2049,144,10,10869,10906,144,102,58, + 115,113,117,97,114,101,0,2049,10562,2049,10414,10,10894,10926,144,102,58,112,111,115, + 105,116,105,118,101,63,0,1,0,2049,10316,2049,10532,10,10911,10948,144,102,58,110, + 101,103,97,116,105,118,101,63,0,1,0,2049,10316,2049,10518,10,10933,10967,144,102, + 58,110,101,103,97,116,101,0,1,-1,2049,10316,2049,10414,10,10955,10983,144,102,58, + 97,98,115,0,2049,10562,2049,10948,1,10967,9,10,10974,11000,144,102,58,112,117,116, 0,2049,10375,2049,9235,10,10991,11013,144,102,58,80,73,0,2049,3646,51,46,49,52, 49,53,57,50,0,1,11015,2049,10335,10,11005,11036,144,102,58,69,0,2049,3646,50, 46,55,49,56,50,56,49,0,1,11038,2049,10335,10,11029,11061,144,102,58,78,65, @@ -563,16 +563,16 @@ CELL ngaImage[] = { 1793,14569,15110,15152,202010,0,10,1,10,2,10,3,10,4,10,5,10, 2049,10426,10,11110,11152,144,102,58,110,97,110,63,0,2049,10562,2049,10504,10,11142,11167, 144,102,58,105,110,102,63,0,2049,11089,2049,10489,10,11157,11183,144,102,58,45,105, 110,102,63,0,2049,11120,2049,10489,10,11172,11199,144,102,58,114,111,117,110,100,0, - 2049,10562,2049,10923,1793,11220,2049,3646,48,46,53,0,1,11207,2049,10335,2049,10402,2049,10460, + 2049,10562,2049,10948,1793,11220,2049,3646,48,46,53,0,1,11207,2049,10335,2049,10402,2049,10460, 10,1,11205,1793,11239,2049,3646,48,46,53,0,1,11226,2049,10335,2049,10390,2049,10442,10, - 1,11224,2049,64,10,11188,11253,144,102,58,109,105,110,0,2049,10863,2049,10518,1,10577, - 1,10824,2049,64,10,11244,11273,144,102,58,109,97,120,0,2049,10863,2049,10532,1,10577, - 1,10824,2049,64,10,11264,11295,144,102,58,108,105,109,105,116,0,2049,10592,2049,10724, + 1,11224,2049,64,10,11188,11253,144,102,58,109,105,110,0,2049,10846,2049,10518,1,10577, + 1,10807,2049,64,10,11244,11273,144,102,58,109,97,120,0,2049,10846,2049,10532,1,10577, + 1,10807,2049,64,10,11264,11295,144,102,58,108,105,109,105,116,0,2049,10592,2049,10724, 2049,11253,2049,10738,2049,11273,10,11284,11320,144,102,58,98,101,116,119,101,101,110,63, - 0,2049,10877,2049,10562,2049,10724,2049,10877,2049,10877,2049,11295,2049,10738,2049,10489,10,11306,11346, + 0,2049,10860,2049,10562,2049,10724,2049,10860,2049,10860,2049,11295,2049,10738,2049,10489,10,11306,11346, 144,102,58,105,110,99,0,2049,3646,49,0,1,11348,2049,10335,2049,10390,10,11337,11366, 144,102,58,100,101,99,0,2049,3646,49,0,1,11368,2049,10335,2049,10402,10,11357,11387, - 144,102,58,99,97,115,101,0,2049,10787,2049,10489,1793,11399,2049,10577,8,1,-1,10, + 144,102,58,99,97,115,101,0,2049,10770,2049,10489,1793,11399,2049,10577,8,1,-1,10, 1,11393,1793,11407,3,1,0,10,1,11403,2049,64,25,6,771,10,11377,11425,144,102, 58,115,105,103,110,0,2049,10562,2049,3646,48,0,1,11429,2049,10335,2049,10489,1793,11444, 1,0,2049,10577,10,1,11439,2049,2653,2049,3646,48,0,1,11450,2049,10335,2049,10532,1793, @@ -589,7 +589,7 @@ CELL ngaImage[] = { 1793,14569,15110,15152,202010,0,10,1,10,2,10,3,10,4,10,5,10, 1,11654,2049,10335,10,11642,11676,144,102,58,45,115,104,105,102,116,0,2049,11650,2049, 10414,10,11664,11693,144,102,58,43,115,104,105,102,116,0,2049,11650,2049,10426,10,11681, 11715,144,102,58,115,105,103,110,101,100,45,115,113,114,116,0,2049,10562,2049,11425, - 2049,10958,2049,10475,2049,10316,2049,10414,10,11698,11741,144,102,58,43,101,110,99,111,100, + 2049,10983,2049,10475,2049,10316,2049,10414,10,11698,11741,144,102,58,43,101,110,99,111,100, 101,0,2049,11715,2049,11676,10,11728,11759,144,102,58,45,101,110,99,111,100,101,0, 2049,10562,2049,11425,2049,11693,2049,10562,2049,10414,2049,10316,2049,10414,10,11746,11793,144,102,58, 115,105,103,110,101,100,45,115,113,117,97,114,101,0,2049,10562,2049,11425,2049,10562,