Permalink
Browse files

Block size made configurable (not completed)

Float and double number separators configurable (see VFX)
  • Loading branch information...
1 parent a24cccc commit c87d0e6567121eba9febb29d50a8795275669815 pazsan committed May 26, 2012
Showing with 45 additions and 24 deletions.
  1. +2 −2 blocks.fs
  2. +1 −1 engine/forth.h
  3. +3 −3 engine/support.c
  4. +6 −11 float.fs
  5. +1 −1 kernel/int.fs
  6. +13 −3 kernel/vars.fs
  7. +4 −2 mini-oof.fs
  8. +15 −1 prim
View
@@ -208,9 +208,9 @@ User scr ( -- a-addr ) \ block-ext s-c-r
dup scr !
." Screen " u.
scr @ updated? 0= IF ." not " THEN ." modified " cr
- 16 0
+ l/s 0
?do
- i 2 .r space scr @ block i 64 * chars + 64 type cr
+ i 2 .r space scr @ block i c/l * chars + c/l type cr
loop ;
[IFDEF] current-input
View
@@ -408,7 +408,7 @@ struct Cellpair parse_white(Char *c_addr1, UCell u1);
Cell rename_file(Char *c_addr1, UCell u1, Char *c_addr2, UCell u2);
struct Cellquad read_line(Char *c_addr, UCell u1, FILE *wfileid);
struct Cellpair file_status(Char *c_addr, UCell u);
-Cell to_float(Char *c_addr, UCell u, Float *r_p);
+Cell to_float(Char *c_addr, UCell u, Float *r_p, Char dot);
Float v_star(Float *f_addr1, Cell nstride1, Float *f_addr2, Cell nstride2, UCell ucount);
void faxpy(Float ra, Float *f_x, Cell nstridex, Float *f_y, Cell nstridey, UCell ucount);
UCell lshift(UCell u1, UCell n);
View
@@ -378,7 +378,7 @@ struct Cellpair file_status(Char *c_addr, UCell u)
return r;
}
-Cell to_float(Char *c_addr, UCell u, Float *rp)
+Cell to_float(Char *c_addr, UCell u, Float *rp, Char dot)
{
/* convertible string := <significand>[<exponent>]
<significand> := [<sign>]{<digits>[.<digits0>] | .<digits> }
@@ -415,9 +415,9 @@ Cell to_float(Char *c_addr, UCell u, Float *rp)
aftersign:
if (s >= send)
goto exponent;
- switch (c=*s) {
+ if((c=*s)==dot) { *t++ = '.'; ndots++; s++; goto aftersign; }
+ switch (c) {
case '0' ... '9': *t++ = c; ndigits++; s++; goto aftersign;
- case '.': *t++ = c; ndots++; s++; goto aftersign;
default: goto exponent;
}
exponent:
View
@@ -128,18 +128,13 @@ DOES> ( -- r )
scratch over c@ emit '. emit 1 /string type
'E emit . ;
+[IFDEF] fp-char
: sfnumber ( c-addr u -- r true | false )
- 2dup [CHAR] e scan ( c-addr u c-addr2 u2 )
- dup 0=
- IF
- 2drop 2dup [CHAR] E scan ( c-addr u c-addr3 u3 )
- THEN
- nip
- IF
- >float
- ELSE
- 2drop false
- THEN ;
+ fp-char @ >float1 ;
+[ELSE]
+: sfnumber ( c-addr u -- r true | false )
+ >float ;
+[THEN]
[ifdef] recognizer:
[IFDEF] 2lit,
View
@@ -143,7 +143,7 @@ has? os 0= [IF]
WHILE \ there are characters left
dup r> -
WHILE \ the last >number parsed something
- dup 1- dpl ! over c@ [char] . =
+ dup 1- dpl ! over c@ dp-char @ =
WHILE \ the current char is '.'
1 /string
REPEAT THEN \ there are unparseable characters left
View
@@ -48,9 +48,9 @@ has? floating [IF]
has? EC [IF] 20 cells [ELSE] FF [THEN] Constant /line
has? file [IF]
-40 Constant c/l
-10 Constant l/s
-400 Constant chars/block
+40 Value c/l
+10 Value l/s
+400 Value chars/block
[THEN]
20 8 2* cells + 2 + cell+ constant word-pno-size ( -- u )
@@ -184,6 +184,16 @@ User dpl ( -- a-addr ) \ gforth
\G 0. After the conversion of 234123.9 it contains 1, and so forth.
-1 dpl !
+User dp-char ( -- a-addr ) \ VFX
+\G @code{User} variable -- @i{a-addr} is the address of a cell that stores the
+\G decimal point character for double number conversion
+'.' dp-char !
+
+User fp-char ( -- a-addr ) \ VFX
+\G @code{User} variable -- @i{a-addr} is the address of a cell that stores the
+\G decimal point character for floating point number conversion
+'.' fp-char !
+
User state ( -- a-addr ) \ core,tools-ext
\G @code{User} variable -- @i{a-addr} is the address of a cell
\G containing the compilation state flag. 0 => interpreting, -1 =>
View
@@ -7,7 +7,9 @@
: end-class ( class methods vars "name" -- )
Create here >r , dup , 2 cells ?DO ['] noop , 1 cells +LOOP
cell+ dup cell+ r> rot @ 2 cells /string move ;
-: defines ( xt class "name" -- ) ' >body @ + ! ;
+: >vt ( class "name" -- addr ) ' >body @ + ;
+: bind ( class "name" -- xt ) >vt @ ;
+: defines ( xt class "name" -- ) >vt ! ;
: new ( class -- o ) here over @ allot swap over ! ;
-: :: ( class "name" -- ) ' >body @ + @ compile, ;
+: :: ( class "name" -- ) bind compile, ;
Create object 1 cells , 2 cells ,
View
@@ -2262,7 +2262,7 @@ representation. If the string represents a valid floating-point number
true. Otherwise, @i{flag} is false. A string of blanks is a special
case and represents the floating-point number 0.""
Float r;
-flag = to_float(c_addr, u, &r);
+flag = to_float(c_addr, u, &r, '.');
if (flag) {
fp--;
fp[0]=r;
@@ -2457,6 +2457,20 @@ faxpy(ra, f_x, nstridex, f_y, nstridey, ucount);
fdup dup f@ f* over + 2swap dup f@ f+ dup f! over + 2swap
LOOP 2drop 2drop fdrop ;
+>float1 ( c_addr u c -- f:... flag ) gforth to_float1
+""Actual stack effect: ( c_addr u c -- r t | f ). Attempt to convert the
+character string @i{c-addr u} to internal floating-point
+representation. If the string represents a valid floating-point number
+@i{r} is placed on the floating-point stack and @i{flag} is
+true. Otherwise, @i{flag} is false. A string of blanks is a special
+case and represents the floating-point number 0.""
+Float r;
+flag = to_float(c_addr, u, &r, c);
+if (flag) {
+ fp--;
+ fp[0]=r;
+}
+
\+
\ The following words access machine/OS/installation-dependent

0 comments on commit c87d0e6

Please sign in to comment.