mescc: Support global pointer assignments.
authorJan Nieuwenhuizen <janneke@gnu.org>
Tue, 17 Jan 2017 17:57:41 +0000 (18:57 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Tue, 17 Jan 2017 17:57:41 +0000 (18:57 +0100)
* module/mes/libc-i386.mes (base->accu-ref, local-ref->base): New functions.
* module/mes/libc-i386.scm: Export them.
* module/language/c99/compiler.mes (base->ident-ref, ident-ref->base):
  New functions.

module/language/c99/compiler.mes
module/mes/libc-i386.mes
module/mes/libc-i386.scm

index 280c7d9f272a892542f52cac254ca64d9f400461..ce3ea4cb920dc04aedc623e7c3ce3a41c67bae4e 100644 (file)
   (lambda (o)
     (let ((local (assoc-ref locals o)))
       (if local (i386:push-local local)
-          ((push-global globals) o)))))
+          ((push-global globals) o))))) ;; FIXME: char*/int
 
 (define (push-ident-ref globals locals)
   (lambda (o)
        (let ((value (cstring->number value))
              (size 4)) ;; FIXME: type: int
          (append
-          ((ident->base (.locals info)) name)
+          ((ident->base info) name)
           (list
            (lambda (f g t d)
              (append
           (list (lambda (f g t d)
                   (i386:accu->global (+ (data-offset o g) d))))))))
 
+(define (base->ident-ref info)
+  (lambda (o)
+    (let ((local (assoc-ref (.locals info) o)))
+      (if local
+          (list (lambda (f g t d)
+                  (append
+                   (i386:local->accu local)
+                   (i386:byte-base->accu-ref))))
+          TODO:base->ident-ref-global))))
+
 (define (value->ident info)
   (lambda (o value)
     (let ((local (assoc-ref (.locals info) o)))
           (list (lambda (f g t d)
                   (i386:global->base (+ (data-offset o g) d))))))))
 
+(define (ident-ref->base info)
+  (lambda (o)
+    (let ((local (assoc-ref (.locals info) o)))
+      (if local
+          (list (lambda (f g t d)
+                  (i386:local-ref->base local)))
+          TODO:ident-ref->base))))
+
 (define (expr->accu info)
   (lambda (o)
     (pmatch o
                                  (i386:base->accu)
                                  (if (> size 1) (i386:accu+accu) '())
                                  (if (= size 3) (i386:accu+base) '())
-                                 (i386:accu-shl 2)
-                                 ;;;'(#x58 #x58)
-                                 )))
+                                 (i386:accu-shl 2))))
                         ((ident->base info) array)
                         (list (lambda (f g t d)
                                 (i386:accu+base)))))))
                                    (loop (cdr elements) ((statement->info info body-length) (car elements))))))
                 (clause-text (list-tail (.text clause-info) text-length))
                 (clause-length (length (text->list clause-text))))
-           (stderr "clause text[~a]: ~a\n" clause-length (map dec->hex (text->list clause-text)))
            (clone info #:text (append
                                (.text info)
                                (list (lambda (f g t d) (i386:accu-cmp-value value)))
                                    (loop (cdr elements) ((statement->info info body-length) (car elements))))))
                 (clause-text (list-tail (.text clause-info) text-length))
                 (clause-length (length (text->list clause-text))))
-           (stderr "clause text[~a]: ~a\n" clause-length (map dec->hex (text->list clause-text)))
            (clone info #:text (append
                                (.text info)
                                (list (lambda (f g t d) (i386:accu-cmp-value value)))
        (lambda (body-length)
          (let ((text-length (length (.text info))))
           (let loop ((elements elements) (info info))
-            (if (null? elements) (let ((clause-text (list-tail (.text info) text-length)))
-                                   (stderr "default text[~a]: ~a\n" (length (text->list clause-text)) (map dec->hex (text->list clause-text)))
-                                   info)
+            (if (null? elements) info
                 (loop (cdr elements) ((statement->info info body-length) (car elements))))))))
       (_ (stderr "no case match: ~a\n" o) barf)
       )))
           locals))
 
       ;;(stderr "\nS=~a\n" o)
+      ;; (stderr "  globals[~a=>~a]: ~a\n" (length globals) (length (append-map cdr globals)) (map (lambda (s) (if (string? s) (string-delete #\newline s))) (map car globals)))
       ;; (stderr "  text=~a\n" text)
       ;; (stderr "   info=~a\n" info)
       ;; (stderr "   globals=~a\n" globals)
                           step-text
                           test-text
                           jump-text)
-                  #:globals (append globals (.globals body-info)) ;; FIXME
+                  #:globals (append globals (list-tail (.globals body-info) (length globals)))
                   #:locals locals)))
 
         ((while ,test ,body)
         ((p-expr (ident ,name))
          (clone info #:text
                 (append text
+                        ((ident->accu info) name)
                         (list (lambda (f g t d)
                                 (append
-                                 (i386:local->accu (assoc-ref locals name))
                                  (i386:accu-zero?)))))))
 
         ((p-expr (fixed ,value))
         ((de-ref (p-expr (ident ,name)))
          (clone info #:text
                 (append text
+                        ((ident->accu info) name)
                         (list (lambda (f g t d)
                                 (append
-                                 (i386:local->accu (assoc-ref locals name))
                                  (i386:byte-mem->accu)))))))
 
         ((fctn-call . ,call)
         ;;((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
         ((post-inc (p-expr (ident ,name)))
          (clone info #:text
-                (append text (list (lambda (f g t d)
-                                     (append
-                                      (i386:local->accu (assoc-ref locals name))
-                                      (i386:local-add (assoc-ref locals name) 1)
-                                      (i386:accu-zero?)))))))
+                (append text
+                        ((ident->accu info) name)
+                        (list (lambda (f g t d)
+                                (append
+                                 (i386:local-add (assoc-ref locals name) 1)
+                                 (i386:accu-zero?)))))))
         ((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
         ((post-dec ,expr) ((ast->info info) `(expr-stmt ,o)))
         ((pre-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
         ;; i--
         ((expr-stmt (post-dec (p-expr (ident ,name))))
          (clone info #:text
-                (append text (list (lambda (f g t d)
-                                     (append
-                                      (i386:local->accu (assoc-ref locals name))
-                                      (i386:local-add (assoc-ref locals name) -1)
-                                      (i386:accu-zero?)))))))
+                (append text
+                        ((ident->accu info) name)
+                        (list (lambda (f g t d)
+                                (append
+                                 (i386:local-add (assoc-ref locals name) -1)
+                                 (i386:accu-zero?)))))))
 
         ;; --i
         ((expr-stmt (pre-dec (p-expr (ident ,name))))
         ((eq (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
            (clone info #:text
                   (append text
+                          ((ident->accu info) a)
                           (list (lambda (f g t d)
                                   (append
-                                   (i386:local->accu (assoc-ref locals a))
                                    (i386:byte-mem->base)
                                    (i386:local->accu (assoc-ref locals b))
                                    (i386:byte-mem->accu)
                                    (i386:byte-test-base)))))))
 
+        ((eq (de-ref (p-expr (ident ,a))) (p-expr (char ,b)))
+         (let ((b (char->integer (car (string->list b)))))
+           (clone info #:text
+                  (append text
+                          ((ident->accu info) a)
+                          (list (lambda (f g t d)
+                                  (append
+                                   (i386:byte-mem->base)
+                                   (i386:value->accu b)
+                                   (i386:byte-test-base))))))))
+
+        ((eq (d-sel (ident ,field) . ,d-sel) (p-expr (fixed ,b)))
+         (let* ((expr ((expr->Xaccu info) `(d-sel (ident ,field) ,@d-sel)))
+                (b (- (cstring->number b)))
+
+                (struct-type "scm") ;; FIXME
+                (struct (assoc-ref (.types info) struct-type))
+                (size (length struct))
+                (field-size 4) ;; FIXME:4, not fixed
+                (offset (* field-size (1- (length (member field (reverse struct) (lambda (a b) (equal? a (cdr b)))))))))
+
+           (clone info #:text (append (.text expr)
+                                      (list (lambda (f g t d)
+                                              (i386:value->accu-ref+n offset b)))))))
+
         ((gt (p-expr (ident ,a)) (p-expr (fixed ,b)))
          (let ((b (cstring->number b)))
            (clone info #:text
                   (append text
                           ((ident->base info) a)
                           (list (lambda (f g t d)
-                                  (append 
+                                  (append
                                    (i386:value->accu b)
                                    (i386:sub-base))))))))
 
         ((ne (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
            (clone info #:text
                   (append text
+                          ((ident->accu info) a)
                           (list (lambda (f g t d)
                                   (append
-                                   (i386:local->accu (assoc-ref locals a))
                                    (i386:byte-mem->base)
                                    (i386:local->accu (assoc-ref locals b))
                                    (i386:byte-mem->accu)
          (let ((b (char->integer (car (string->list b)))))
            (clone info #:text
                   (append text
+                          ((ident->accu info) a)
                           (list (lambda (f g t d)
                                   (append
-                                   (i386:local->accu (assoc-ref locals a))
                                    (i386:byte-mem->base)
-                                   ;;(i386:local->accu (assoc-ref locals b))
-                                   ;;(i386:byte-mem->accu)
                                    (i386:value->accu b)
                                    (i386:byte-test-base)
                                    (i386:xor-zf))))))))
                 (append text
                         (list (lambda (f g t d)
                                 (append
+                                 ;;(and (stderr "006\n") '())
                                  (i386:local->accu (assoc-ref locals a))
                                  (i386:byte-mem->base)
                                  (i386:local->accu (assoc-ref locals b))
                   (append text
                           ((value->ident info) name value)))))
 
+        ;; char c = 'A';
+        ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (char ,value))))))
+         (let* ((locals (add-local name))
+                (info (clone info #:locals locals))
+                (value (char->integer (car (string->list value)))))
+           (clone info #:text
+                  (append text
+                          ((value->ident info) name value)))))
+
         ;; int i = -1;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (neg (p-expr (fixed ,value)))))))
          (let* ((locals (add-local name))
          (let* ((globals (.globals info))
                 (count (cstring->number count))
                 (size 1) ;; FIXME
-                (array (list (ident->global name 0)))  ;;FIXME: deref?
+                (array (list (ident->global name #xaaaaaaaa)))  ;;FIXME: deref?
                 (dummy (list (cons (string->list "dummy")
                                    (string->list (make-string (* count size) #\nul))))))
            (clone info #:globals (append globals array dummy))))
 
+        ;; struct scm* arena[200];
+        ((decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (array-of (ident ,name) (p-expr (fixed ,count))))))
+         (let* ((globals (.globals info))
+                (count (cstring->number count))
+                (size 12) ;; FIXME
+                (array (list (ident->global name #x58585858)))  ;;FIXME: deref?
+                (dummy (list (cons (string->list "dummy")
+                                   (string->list (make-string (* count size) #\nul))))))
+           (stderr "(* count size): ~a\n" (* count size))
+           (clone info #:globals (append globals array dummy))))
+
         ;;struct scm *g_cells = (struct scm*)arena;
         ((decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (cast (type-name (decl-spec-list (type-spec (struct-ref (ident ,=type)))) (abs-declr (pointer))) (p-expr (ident ,value)))))))
          (let* ((locals (add-local name))
          (let ((value (cstring->number value)))
            (clone info #:text (append text ((value->ident info) name value)))))
 
+        ;; i = i + 48;
+        ((expr-stmt (assn-expr (p-expr (ident ,a)) (op _) (add (p-expr (ident ,b)) (p-expr (fixed ,value)))))
+         (let ((value (cstring->number value)))
+           (clone info #:text
+                  (append text
+                          ((ident->base info) b)
+                          (list (lambda (f g t d)
+                                  (append
+                                   (i386:value->accu value)
+                                   (i386:accu+base))))
+                          ((accu->ident info) a)))))
+
+        ;; c = 'A';
+        ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (char ,value))))
+         (let ((value (char->integer (car (string->list value)))))
+           (clone info #:text (append text ((value->ident info) name value)))))
+
         ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (fctn-call . ,call)))
          (let* ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
            (clone info #:text (append (.text info) ((accu->ident info) name)))))
                 (append text
                         ((ident->accu info) value)
                         ((accu->ident info) name))))
-        
+
+        ;; *p = 0;
+        ((expr-stmt (assn-expr (de-ref (p-expr (ident ,name))) (op _) (p-expr (fixed ,value))))
+         (let ((value (cstring->number value)))
+           (clone info #:text (append text
+                                      (list (lambda (f g t d)
+                                              (i386:value->base 0)))
+                                      ((base->ident-ref info) name)))))
+
         ;; *p++ = c;
         ((expr-stmt (assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op _) (p-expr (ident ,value))))
-         (let* ((locals (add-local name))
-               (info (clone info #:locals locals)))
-           (clone info #:text
-                  (append text
-                          ((ident->accu info) value)
-                          ((accu->ident info) name)
-                          (list (lambda (f g t d)
-                                  (i386:local-add (assoc-ref locals name) 1)))))))
+         ;; (stderr "VALUE: ~a\n" value)
+         ;; (stderr "LOCALS: ~a\n" (.locals info))
+         ;; (stderr " ==> ~a\n" (assoc-ref (.locals info) value))
+         (clone info #:text
+                (append text
+                        ;;((ident-ref->base info) value)
+                        ((ident->base info) value)
+                        ((base->ident-ref info) name)
+                        (list (lambda (f g t d)
+                                (i386:local-add (assoc-ref locals name) 1))))))
 
         ((d-sel . ,d-sel)
          (let ((expr ((expr->accu info) `(d-sel ,@d-sel))))
 
 
         ;; TYPE (x) = PAIR;
-        ;; ((expr-stmt (assn-expr (d-sel . ,d-sel) (op _) (p-expr (ident ,constant))))
-        ;;  (let ((expr ((expr->accu info) `(d-sel ,@d-sel)))
-        ;;        (b (assoc-ref (.constants info) constant)))
-        ;;    (clone info #:text (append (.text expr)
-        ;;                               (list (lambda (f g t d)
-        ;;                                       (i386:accu+base)
-        ;;                                       (i386:value->accu-ref b)))))))
-
         ((expr-stmt (assn-expr (d-sel (ident ,field) . ,d-sel) (op _) (p-expr (ident ,constant))))
          (let* ((expr ((expr->Xaccu info) `(d-sel (ident ,field) ,@d-sel)))
                 (b (assoc-ref (.constants info) constant))
                                               (i386:value->accu-ref+n offset b)))))))
 
         ;; CAR (x) = 0
-        ;; ((expr-stmt (assn-expr (d-sel . ,d-sel) (op _) (p-expr (fixed ,value))))
-        ;;  (let ((expr ((expr->accu info) `(d-sel ,@d-sel)))
-        ;;        (b (cstring->number value)))
-        ;;    (clone info #:text (append (.text expr)
-        ;;                               (list (lambda (f g t d)
-        ;;                                       (i386:accu+base)
-        ;;                                       (i386:value->accu-ref b)))))))
         ((expr-stmt (assn-expr (d-sel (ident ,field) . ,d-sel) (op _) (p-expr (fixed ,value))))
          (let* ((expr ((expr->Xaccu info) `(d-sel (ident ,field) ,@d-sel)))
                 (b (cstring->number value))
index 27c806696d69c09df2ffc0923ca668145a027c57..cfbec17c5fcead301ac986a29f6ed49f51bfe12b 100644 (file)
   `(#x8b #x45 ,(- 0 (* 4 n))))          ; mov    -<0xn>(%ebp),%eax
 
 (define (i386:byte-local->accu n)
-  (or n local->accu)
+  (or n byte-local->accu)
   `(#x0f #xb6 #x45 ,(- 0 (* 4 n))))     ; movzbl 0x<n>(%ebp),%eax
 
 (define (i386:local->base n)
   (or n local->base)
   `(#x8b #x55 ,(- 0 (* 4 n))))          ; mov    -<0xn>(%ebp),%edx
 
+;; (define (i386:local-ref->base n)
+;;   (or n local-ref->base)
+;;   `(#x8b #x15 ,@(int->bv32 (- 0 (* 4 n))))) ; mov    0x<n>,%edx
+
+(define (i386:local-ref->base n)
+  (or n local-ref->base)
+  `(#x8d #x55 ,(- 0 (* 4 n))))          ; lea    0x<n>(%ebp),%edx
+
 (define (i386:global-ref->base n)
   (or n global->base)
   `(#x8b #x15 ,@(int->bv32 n)))         ; mov    0x<n>,%edx
 (define (i386:base->accu-ref)
   '(#x89 #x10))                         ; mov    %edx,(%eax)
 
+(define (i386:byte-base->accu-ref)
+  '(#x88 #x10))                         ; mov    %dl,(%eax)
+
 (define (i386:value->base v)
   `(#xba ,@(int->bv32 v)))              ; mov    $<v>,%edx
 
index 9b057f69acf0ce411fef64aa2901524344c9bd87..dc020a295cb3eeed2a99402526cdf840cccb754c 100644 (file)
@@ -43,6 +43,7 @@
             i386:base->accu-ref
             i386:base-mem->accu
             i386:byte-base-sub
+            i386:byte-base->accu-ref
             i386:byte-base-mem->accu
             i386:byte-local->accu
             i386:byte-mem->accu
@@ -71,6 +72,7 @@
             i386:local->base
             i386:local-add
             i386:local-address->accu
+            i386:local-ref->base
             i386:local-test
             i386:push-accu
             i386:push-global