diff --git a/include/math.h b/include/math.h index ca9ae3a5..df0006c4 100644 --- a/include/math.h +++ b/include/math.h @@ -23,7 +23,9 @@ #if __GNUC__ && POSIX #undef __MES_MATH_H #include_next -#endif // (__GNUC__ && POSIX) +#else // !(__GNUC__ && POSIX) +double ldexp (double x, int exp); +#endif // !(__GNUC__ && POSIX) #endif // __MES_MATH_H diff --git a/include/stdlib.h b/include/stdlib.h index e529f086..83686cc1 100644 --- a/include/stdlib.h +++ b/include/stdlib.h @@ -43,6 +43,9 @@ int setenv (char const* s, char const* v, int overwrite_p); void *malloc (size_t); void qsort (void *base, size_t nmemb, size_t size, int (*compar)(void const *, void const *)); void *realloc (void *p, size_t size); +double strtod (char const *nptr, char **endptr); +float strtof (char const *nptr, char **endptr); +long double strtold (char const *nptr, char **endptr); long strtol (char const *nptr, char **endptr, int base); long long strtoll (char const *nptr, char **endptr, int base); unsigned long strtoul (char const *nptr, char **endptr, int base); diff --git a/lib/libc+tcc.c b/lib/libc+tcc.c index 1ce62078..73824a9a 100644 --- a/lib/libc+tcc.c +++ b/lib/libc+tcc.c @@ -127,6 +127,13 @@ gettimeofday (struct timeval *tv, struct timezone *tz) return 0; } +double +ldexp (double x, int exp) +{ + eputs ("ldexp stub\n"); + return 0; +} + struct tm * localtime (time_t const *timep) { @@ -285,6 +292,24 @@ strstr (char const *haystack, char const *needle) return 0; } +double +strtod (char const *nptr, char **endptr) +{ + eputs ("strtoul stub\n"); +} + +float +strtof (char const *nptr, char **endptr) +{ + return strtod (nptr, endptr); +} + +long double +strtold (char const *nptr, char **endptr) +{ + return strtod (nptr, endptr); +} + long strtol (char const *nptr, char **endptr, int base) { diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index aea544b9..c14df62e 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -189,6 +189,7 @@ ((char ,value) (get-type "char" info)) ((enum-ref . _) (get-type "int" info)) ((fixed ,value) (get-type "int" info)) + ((float ,float) (get-type "float" info)) ((void) (get-type "void" info)) ((ident ,name) (ident->type info name)) @@ -949,11 +950,15 @@ (append-text info (list (i386:label->accu `(#:string ,string)))))) ((p-expr (fixed ,value)) - (let ((value (cstring->number value))) + (let ((value (cstring->int value))) + (append-text info (wrap-as (i386:value->accu value))))) + + ((p-expr (float ,value)) + (let ((value (cstring->float value))) (append-text info (wrap-as (i386:value->accu value))))) ((neg (p-expr (fixed ,value))) - (let ((value (- (cstring->number value)))) + (let ((value (- (cstring->int value)))) (append-text info (wrap-as (i386:value->accu value))))) ((p-expr (char ,char)) @@ -975,7 +980,7 @@ ((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base))))) (let* ((type (ast->basic-type struct info)) (offset (field-offset info type field)) - (base (cstring->number base))) + (base (cstring->int base))) (append-text info (wrap-as (i386:value->accu (+ base offset)))))) ;; &foo @@ -1124,7 +1129,7 @@ ((and struct? (= rank 2)) 4) (else 1))) (info (expr->accu a info)) - (value (cstring->number value)) + (value (cstring->int value)) (value (* size value))) (append-text info (wrap-as (i386:accu+value value))))) @@ -1155,7 +1160,7 @@ ((and struct? (= rank 2)) 4) (else 1))) (info (expr->accu a info)) - (value (cstring->number value)) + (value (cstring->int value)) (value (* size value))) (append-text info (wrap-as (i386:accu+value (- value)))))) @@ -1439,20 +1444,25 @@ (_ ((jump i386:jump-z (wrap-as (i386:accu-zero?))) o))))) -(define (cstring->number s) - (let ((s (cond ((string-suffix? "ULL" s) (string-drop-right s 3)) - ((string-suffix? "UL" s) (string-drop-right s 2)) - ((string-suffix? "LL" s) (string-drop-right s 2)) - ((string-suffix? "L" s) (string-drop-right s 1)) - (else s)))) - (cond ((string-prefix? "0x" s) (string->number (string-drop s 2) 16)) - ((string-prefix? "0b" s) (string->number (string-drop s 2) 2)) - ((string-prefix? "0" s) (string->number s 8)) - (else (string->number s))))) +(define (cstring->int o) + (let ((o (cond ((string-suffix? "ULL" o) (string-drop-right o 3)) + ((string-suffix? "UL" o) (string-drop-right o 2)) + ((string-suffix? "LL" o) (string-drop-right o 2)) + ((string-suffix? "L" o) (string-drop-right o 1)) + (else o)))) + (or (cond ((string-prefix? "0x" o) (string->number (string-drop o 2) 16)) + ((string-prefix? "0b" o) (string->number (string-drop o 2) 2)) + ((string-prefix? "0" o) (string->number o 8)) + (else (string->number o))) + (error "cstring->int: not supported:" o)))) + +(define (cstring->float o) + (or (string->number o) + (error "cstring->float: not supported:" o))) (define (try-expr->number info o) (pmatch o - ((fixed ,a) (cstring->number a)) + ((fixed ,a) (cstring->int a)) ((p-expr ,expr) (expr->number info expr)) ((neg ,a) (- (expr->number info a))) @@ -1485,7 +1495,7 @@ ((cast ,type ,expr) (expr->number info expr)) ((cond-expr ,test ,then ,else) (if (p-expr->bool info test) (expr->number info then) (expr->number info else))) - (,string (guard (string? string)) (cstring->number string)) + (,string (guard (string? string)) (cstring->int string)) ((ident ,name) (assoc-ref (.constants info) name)) (_ #f))) @@ -1528,7 +1538,7 @@ (let ((field (car o))) (pmatch field ((comp-declr (bit-field (ident ,name) (p-expr (fixed ,bits)))) - (let ((bits (cstring->number bits))) + (let ((bits (cstring->int bits))) (cons (cons name (make-bit-field type bit bits)) (loop (cdr o) (+ bit bits))))) (_ (error "struct-field: not supported:" field o)))))))))) @@ -1814,8 +1824,8 @@ (0 0) ((p-expr (char ,value)) (char->integer (car (string->list value)))) ((p-expr (ident ,constant)) (assoc-ref (.constants info) constant)) - ((p-expr (fixed ,value)) (cstring->number value)) - ((neg (p-expr (fixed ,value))) (- (cstring->number value))) + ((p-expr (fixed ,value)) (cstring->int value)) + ((neg (p-expr (fixed ,value))) (- (cstring->int value))) (_ (error "case test: not supported: " test))))) (append (wrap-as (i386:accu-cmp-value value)) (jump-z body-label)))) @@ -2106,7 +2116,7 @@ (list->string (map (lambda (i) (pmatch i ((initzer (p-expr (char ,c))) ((compose car string->list) c)) ((initzer (p-expr (fixed ,fixed))) - (let ((value (cstring->number fixed))) + (let ((value (cstring->int fixed))) (if (and (>= value 0) (<= value 255)) (integer->char value) (error "array-init->string: not supported:" i o)))) @@ -2208,7 +2218,7 @@ ((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base))))) (let* ((type (ast->type struct info)) (offset (field-offset info type field)) - (base (cstring->number base))) + (base (cstring->int base))) (int->bv32 (+ base offset)))) ((,char . _) (guard (char? char)) o) ((,number . _) (guard (number? number)) @@ -2286,6 +2296,7 @@ ((typename ,name) info) ((union-ref . _) info) ((fixed-type . _) info) + ((float-type . _) info) ((void) info) (_ ;;(error "type->info: not supported:" o) diff --git a/module/mes/scm.mes b/module/mes/scm.mes index 9bd53581..eba58c16 100644 --- a/module/mes/scm.mes +++ b/module/mes/scm.mes @@ -229,15 +229,31 @@ (equal? (substring string (- length suffix-length)) suffix)))) (define (string->number s . rest) - (let* ((radix (if (null? rest) 10 (car rest))) - (lst (string->list s)) - (sign (if (char=? (car lst) #\-) -1 1)) - (lst (if (= sign -1) (cdr lst) lst))) - (let loop ((lst lst) (n 0)) - (if (null? lst) (* sign n) - (let ((i (char->integer (car lst)))) - (loop (cdr lst) (+ (* n radix) (- i (if (<= i (char->integer #\9)) (char->integer #\0) - (- (char->integer #\a) 10)))))))))) + (let ((lst (string->list s))) + (and (pair? lst) + (let* ((radix (if (null? rest) 10 (car rest))) + (sign (if (and (pair? lst) (char=? (car lst) #\-)) -1 1)) + (lst (if (= sign -1) (cdr lst) lst))) + (let loop ((lst lst) (n 0)) + (if (null? lst) (* sign n) + (let ((i (char->integer (car lst)))) + (cond ((and (>= i (char->integer #\0)) + (<= i (char->integer #\9))) + (let ((d (char->integer #\0))) + (loop (cdr lst) (+ (* n radix) (- i d))))) + ((and (= radix 16) + (>= i (char->integer #\a)) + (<= i (char->integer #\f))) + (let ((d (char->integer #\a))) + (loop (cdr lst) (+ (* n radix) (- i (- d 10)))))) + ((= i (char->integer #\.)) ; minimal FLOAT support + (let ((fraction (cdr lst))) + (if (null? fraction) n + (let ((fraction ((compose string->number list->string) fraction))) + (and fraction n))))) ; FLOAT as integer + (else #f))))))))) + +(define inexact->exact identity) (define (number->string n . rest) (let* ((radix (if (null? rest) 10 (car rest))) diff --git a/tests/math.test b/tests/math.test index 54e38dd7..2be1e448 100755 --- a/tests/math.test +++ b/tests/math.test @@ -8,7 +8,7 @@ exit $? ;;; -*-scheme-*- ;;; Mes --- Maxwell Equations of Software -;;; Copyright © 2016 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen ;;; ;;; This file is part of Mes. ;;; @@ -25,9 +25,12 @@ exit $? ;;; You should have received a copy of the GNU General Public License ;;; along with Mes. If not, see . -(mes-use-module (mes scm)) -(mes-use-module (srfi srfi-0)) (mes-use-module (mes test)) +(pass-if-equal "string->number" 42 (string->number "42")) +(pass-if-equal "string->number neg" -42 (string->number "-42")) +(pass-if-not "string->number hex" (string->number "aa")) +(pass-if-equal "string->number hex" 170 (string->number "aa" 16)) +(pass-if-equal "string->number float" 1 (inexact->exact (string->number "1.0"))) (pass-if-equal "+" 6 (+ 1 2 3)) (pass-if-equal "*" 27 (* 3 3 3))