artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Remove last hardcodings for identifiers.

Browse source 
* module/language/c99/compiler.mes (ident->accu, ident->base):
  Use local:ptr, type->size to remove hard coding of functionx, c1.
  (expr->accu): Use type->size to remove hard coding of size byte.
  (decl->type): Also handle typename, bail out if type not found.
  (type->size): Print identifier and and bail out if type not found.
  (formal:ptr): New function.
  (formals->locals): Use it to set pointer value of parameter.  WAS: 0.
  (ast->info): Remove functionx hardcoding.
  (getchar): Rename c1 to c.
* doc/examples/t.c: Test it.
This commit is contained in:
Jan Nieuwenhuizen 2017-03-17 17:32:23 +01:00
parent cbee04c4b8
commit ddd880bdc8
2 changed files with 69 additions and 40 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

102
module/language/c99/compiler.mes
View file

@ -380,20 +380,23 @@ _)))))
;; (if (and (not global) (not (local:id local))) ;; (if (and (not global) (not (local:id local)))
;; (stderr "globals: ~a\n" (map car (.globals info)))) ;; (stderr "globals: ~a\n" (map car (.globals info))))
(if local (if local
(let ((ptr (local:pointer local))) (let* ((ptr (local:pointer local))
(type (ident->type info o))
(size (and type (type->size info type))))
;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr) ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr)
(cond ((equal? o "c1") ;;(stderr "type: ~s\n" type)
(list (lambda (f g ta t d) ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr)
(i386:byte-local->accu (local:id local))))) ;; FIXME type ;;(stderr "locals: ~s\n" locals)
((equal? o "functionx") (case ptr
(list (lambda (f g ta t d) ((-1) (list (lambda (f g ta t d)
(i386:local->accu (local:id local))))) ;; FIXME type (i386:local-ptr->accu (local:id local)))))
(else ((1) (list (lambda (f g ta t d)
(case ptr (i386:local->accu (local:id local)))))
((-1) (list (lambda (f g ta t d) (else
(i386:local-ptr->accu (local:id local))))) (list (lambda (f g ta t d)
(else (list (lambda (f g ta t d) (if (= size 1)
(i386:local->accu (local:id local))))))))) (i386:byte-local->accu (local:id local))
(i386:local->accu (local:id local))))))))
(if global (if global
(let ((ptr (ident->pointer info o))) (let ((ptr (ident->pointer info o)))
;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr) ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr)
@ -464,8 +467,19 @@ _)))))
(let ((local (assoc-ref (.locals info) o))) (let ((local (assoc-ref (.locals info) o)))
;;(stderr "ident->base: local[~a]: ~a\n" o (and local (local:id local))) ;;(stderr "ident->base: local[~a]: ~a\n" o (and local (local:id local)))
(if local (if local
(list (lambda (f g ta t d) (let* ((ptr (local:pointer local))
(i386:local->base (local:id local)))) (type (ident->type info o))
(size (and type (type->size info type))))
(case ptr
((-1) (list (lambda (f g ta t d)
(i386:local-ptr->base (local:id local)))))
((1) (list (lambda (f g ta t d)
(i386:local->base (local:id local)))))
(else
(list (lambda (f g ta t d)
(if (= size 1)
(i386:byte-local->base (local:id local))
(i386:local->base (local:id local))))))))
(let ((global (assoc-ref (.globals info) o) )) (let ((global (assoc-ref (.globals info) o) ))
(if global (if global
(let ((ptr (ident->pointer info o))) (let ((ptr (ident->pointer info o)))
@ -510,8 +524,7 @@ _)))))
((ident->accu info) name)))) ((ident->accu info) name))))
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name)))))) ((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
(let* (;;(type (assoc-ref (.types info) (list "struct" name))) (let* ((type (list "struct" name))
(type (list "struct" name))
(fields (or (type->description info type) '())) (fields (or (type->description info type) '()))
(size (type->size info type))) (size (type->size info type)))
(clone info #:text (clone info #:text
@ -665,13 +678,15 @@ _)))))
((ident->accu info) name)))) ((ident->accu info) name))))
((de-ref (p-expr (ident ,name))) ((de-ref (p-expr (ident ,name)))
(clone info #:text (let* ((type (ident->type info name))
(append text (size (and type (type->size info type))))
((ident->accu info) name) (clone info #:text
(list (lambda (f g ta t d) (append text
(append ((ident->accu info) name)
(cond ((equal? name "functionx") (i386:mem->accu)) (list (lambda (f g ta t d)
(else (i386:byte-mem->accu))))))))) ;; FIXME: type (if (= size 1)
(i386:byte-mem->accu)
(i386:mem->accu))))))))
;; GRR --> info again??!? ;; GRR --> info again??!?
((fctn-call . ,call) ((fctn-call . ,call)
@ -895,8 +910,10 @@ _)))))
((struct-ref (ident ,name)) (list "struct" name)) ((struct-ref (ident ,name)) (list "struct" name))
((decl (decl-spec-list (type-spec (struct-ref (ident ,name)))));; "scm" ((decl (decl-spec-list (type-spec (struct-ref (ident ,name)))));; "scm"
(list "struct" name)) ;; FIXME (list "struct" name)) ;; FIXME
((typename ,name) name)
(_ (_
;;(stderr "SKIP: decl type=~s\n" o) (stderr "SKIP: decl type=~s\n" o)
barf
o))) o)))
(define (expr->global o) (define (expr->global o)
@ -1098,7 +1115,12 @@ _)))))
(type->size info type)) (type->size info type))
((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual)) ((decl-spec-list (type-spec (fixed-type ,type)) (type-qual ,qual))
(type->size info type)) (type->size info type))
(_ (cadr (assoc-ref (.types info) o))))) (_ (let ((type (assoc-ref (.types info) o)))
(if type (cadr type)
(begin
(stderr "***TYPE NOT FOUND**: o=~s\n" o)
barf
4))))))
(define (ident->decl info o) (define (ident->decl info o)
;; (stderr "ident->decl o=~s\n" o) ;; (stderr "ident->decl o=~s\n" o)
@ -1186,8 +1208,8 @@ _)))))
(loop (cdr expressions) ((expr->arg info) (car expressions)))))) (loop (cdr expressions) ((expr->arg info) (car expressions))))))
(text (.text args-info)) (text (.text args-info))
(n (length expr-list))) (n (length expr-list)))
(if ;;#t ;;(assoc-ref globals name) (if (and (not (assoc-ref locals name))
(not (equal? name "functionx")) (assoc-ref (.functions info) name))
(clone args-info #:text (clone args-info #:text
(append text (append text
(list (lambda (f g ta t d) (list (lambda (f g ta t d)
@ -2186,6 +2208,10 @@ _)))))
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list))))) ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
info) info)
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
(let ((types (.types info)))
(clone info #:types (cons (cons name (assoc-ref types type)) types))))
((decl (decl-spec-list (stor-spec (typedef)) ,type) ,name) ((decl (decl-spec-list (stor-spec (typedef)) ,type) ,name)
(format (current-error-port) "SKIP: typedef=~s\n" o) (format (current-error-port) "SKIP: typedef=~s\n" o)
info) info)
@ -2249,11 +2275,21 @@ _)))))
(_ (format (current-error-port) "formals->text: no match: ~a\n" o) (_ (format (current-error-port) "formals->text: no match: ~a\n" o)
barf))) barf)))
(define (formal:ptr o)
(pmatch o
((param-decl (decl-spec-list . ,decl) (param-declr (ptr-declr (pointer) . _)))
1)
((param-decl (decl-spec-list . ,decl) (param-declr (ident ,name)))
0)
(_
(stderr "formal:ptr[~a] => 0\n" o)
0)))
(define (formals->locals o) (define (formals->locals o)
(pmatch o (pmatch o
((param-list . ,formals) ((param-list . ,formals)
(let ((n (length formals))) (let ((n (length formals)))
(map make-local (map .name formals) (map .type formals) (make-list n 0) (iota n -2 -1)))) (map make-local (map .name formals) (map .type formals) (map formal:ptr formals) (iota n -2 -1))))
(_ (format (current-error-port) "formals->info: no match: ~a\n" o) (_ (format (current-error-port) "formals->info: no match: ~a\n" o)
barf))) barf)))
@ -2320,11 +2356,11 @@ int g_stdin;
int int
getchar () getchar ()
{ {
char c1; char c;
int r = read (g_stdin, &c1, 1); int r = read (g_stdin, &c, 1);
//int r = read (0, &c1, 1); //int r = read (0, &c, 1);
if (r < 1) return -1; if (r < 1) return -1;
return c1; return c;
} }
" "
;;paredit:" ;;paredit:"

7
scaffold/t.c
View file

@ -407,16 +407,9 @@ struct_test ()
if (functionx != bar) return 15; if (functionx != bar) return 15;
puts ("t: (functiony) (1) == bar\n"); puts ("t: (functiony) (1) == bar\n");
#if __GNUC__
//FIXME
int (*functiony) (int) = 0; int (*functiony) (int) = 0;
functiony = g_functions[g_cells[fn].cdr].function; functiony = g_functions[g_cells[fn].cdr].function;
if ((functiony) (1) != 0) return 16; if ((functiony) (1) != 0) return 16;
#endif
#if !__GNUC__
functionx = g_functions[g_cells[fn].cdr].function;
if ((functionx) (1) != 0) return 16;
#endif
puts ("t: g_functions[<bar>].arity;"); puts ("t: g_functions[<bar>].arity;");
if (g_functions[fn].arity != 1) return 18; if (g_functions[fn].arity != 1) return 18;