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

mescc: Tinycc support: pointer arithmetic.

Browse source 
* module/language/c99/compiler.mes (ident->size, expr->size): New function.
  (expr->accu): Use them for ++,--,add, sub.
  (i386:type-alist): Set void size to 1.
* scaffold/tests/71-struct-array.c (test):
* scaffold/tests/76-pointer-arithmetic.c: Test it.
* make.scm (add-scaffold-test): Build it.
This commit is contained in:
Jan Nieuwenhuizen 2017-07-28 10:40:30 +02:00
parent ce980c8239
commit c7547dfd52
4 changed files with 145 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
make.scm
View file

@ -155,7 +155,8 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
"72-typedef-struct-def"
"73-union"
"74-multi-line-string"
"75-struct-union"))
"75-struct-union"
"76-pointer-arithmetic"))
(add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets)))

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

@ -697,27 +697,46 @@
((post-inc (p-expr (ident ,name)))
(let* ((type (ident->type info name))
(ptr (ident->pointer info name))
(size (if (> ptr 1) 4 1)))
(size (cond ((= ptr 1) (ident->size info name))
((> ptr 1) 4)
(else 1))))
(append-text info (append ((ident->accu info) name)
((ident-add info) name size)))))
((post-dec (p-expr (ident ,name)))
(let* ((type (ident->type info name))
(ptr (ident->pointer info name))
(size (cond ((= ptr 1) (ident->size info name))
((> ptr 1) 4)
(else 1))))
(append-text info (append ((ident->accu info) name)
((ident-add info) name -1))))
((ident-add info) name (- size))))))
((pre-inc (p-expr (ident ,name)))
(append-text info (append ((ident-add info) name 1)
((ident->accu info) name))))
(let* ((type (ident->type info name))
(ptr (ident->pointer info name))
(size (cond ((= ptr 1) (ident->size info name))
((> ptr 1) 4)
(else 1))))
(append-text info (append ((ident-add info) name size)
((ident->accu info) name)))))
((pre-dec (p-expr (ident ,name)))
(append-text info (append ((ident-add info) name -1)
((ident->accu info) name))))
(let* ((type (ident->type info name))
(ptr (ident->pointer info name))
(size (cond ((= ptr 1) (ident->size info name))
((> ptr 1) 4)
(else 1))))
(append-text info (append ((ident-add info) name (- size))
((ident->accu info) name)))))
((post-inc ,expr)
(let* ((info (append ((expr->accu info) expr)))
(info (append-text info (wrap-as (i386:push-accu))))
(ptr (expr->pointer info expr))
(size (if (> ptr 0) 4 1))
(size (cond ((= ptr 1) (expr->size info expr))
((> ptr 1) 4)
(else 1)))
(info ((expr-add info) expr size))
(info (append-text info (wrap-as (i386:pop-accu)))))
info))
@ -726,27 +745,70 @@
(let* ((info (append ((expr->accu info) expr)))
(info (append-text info (wrap-as (i386:push-accu))))
(ptr (expr->pointer info expr))
(size (if (> ptr 0) 4 1))
(size (cond ((= ptr 1) (expr->size info expr))
((> ptr 1) 4)
(else 1)))
(info ((expr-add info) expr (- size)))
(info (append-text info (wrap-as (i386:pop-accu)))))
info))
((pre-inc ,expr)
(let* ((ptr (expr->pointer info expr))
(size (if (> ptr 0) 4 1))
(size (cond ((= ptr 1) (expr->size info expr))
((> ptr 1) 4)
(else 1)))
(info ((expr-add info) expr size))
(info (append ((expr->accu info) expr))))
info))
((pre-dec ,expr)
(let* ((ptr (expr->pointer info expr))
(size (if (> ptr 0) 4 1))
(size (cond ((= ptr 1) (expr->size info expr))
((> ptr 1) 4)
(else 1)))
(info ((expr-add info) expr (- size)))
(info (append ((expr->accu info) expr))))
info))
((add ,a ,b) ((binop->accu info) a b (i386:accu+base)))
((sub ,a ,b) ((binop->accu info) a b (i386:accu-base)))
((add ,a (p-expr (fixed ,value)))
(let* ((ptr (expr->pointer info a))
(size (cond ((= ptr 1) (expr->size info a))
((> ptr 1) 4)
(else 1)))
(info ((expr->accu info) a))
(value (cstring->number value))
(value (* size value)))
(append-text info (wrap-as (i386:accu+value value)))))
((add ,a ,b)
(let* ((ptr (expr->pointer info a))
(size (cond ((= ptr 1) (expr->size info a))
((> ptr 1) 4)
(else 1))))
(if (not (= size 1))
(warn (format #f "TODO: pointer arithmetic: ~s\n" o))))
((binop->accu info) a b (i386:accu+base)))
((sub ,a (p-expr (fixed ,value)))
(let* ((ptr (expr->pointer info a))
(size (cond ((= ptr 1) (expr->size info a))
((> ptr 1) 4)
(else 1)))
(info ((expr->accu info) a))
(value (cstring->number value))
(value (* size value)))
(stderr "sub[~s]: ~s + ~s\n" size a value)
(append-text info (wrap-as (i386:accu+value (- value))))))
((sub ,a ,b)
(let* ((ptr (expr->pointer info a))
(size (cond ((= ptr 1) (expr->size info a))
((> ptr 1) 4)
(else 1))))
(if (not (= size 1))
(warn (format #f "TODO: pointer arithmetic: ~s\n" o))))
((binop->accu info) a b (i386:accu-base)))
((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
((bitwise-not ,expr)
(let ((info ((ast->info info) expr)))
@ -1119,7 +1181,7 @@
("long" . ,(make-type 'builtin 4 0 #f))
("long long" . ,(make-type 'builtin 8 0 #f))
("long long int" . ,(make-type 'builtin 8 0 #f))
("void" . ,(make-type 'builtin 4 0 #f))
("void" . ,(make-type 'builtin 1 0 #f))
;; FIXME sign
("unsigned char" . ,(make-type 'builtin 1 0 #f))
("unsigned short" . ,(make-type 'builtin 2 0 #f))
@ -1493,6 +1555,7 @@
(define (ident->decl info o)
(or (assoc-ref (.locals info) o)
(assoc-ref (.globals info) o)
(assoc-ref (.constants info) o)
(begin
(stderr "NO IDENT: ~a\n" o)
(assoc-ref (.functions info) o))))
@ -1501,19 +1564,33 @@
(let ((type (ident->decl info o)))
(cond ((global? type) (global:type type))
((local? type) (local:type type))
((assoc-ref (.constants info) o) "int")
(else (stderr "ident->type ~s => ~s\n" o type)
(car type)))))
(define (ident->pointer info o)
(let ((local (assoc-ref (.locals info) o)))
(if local (local:pointer local)
(or (and=> (ident->decl info o) global:pointer) 0))))
(let ((global (assoc-ref (.globals info) o)))
(if global
(global:pointer (ident->decl info o))
0)))))
(define (ident->size info o)
(let* ((type (ident->type info o))
(xtype (ast-type->type info type)))
(type:size xtype)))
(define (expr->pointer info o)
(pmatch o
((p-expr (ident ,name)) (ident->pointer info name))
(_ (stderr "expr->pointer: unsupported: ~s\n" o) 0)))
(define (expr->size info o)
(pmatch o
((p-expr (ident ,name)) (ident->size info name))
(_ (stderr "expr->size: unsupported: ~s\n" o) 4)))
(define (p-expr->type info o)
(pmatch o
((p-expr (ident ,name)) (ident->type info name))

4
scaffold/tests/71-struct-array.c
View file

@ -58,6 +58,10 @@ test ()
printf ("eentje: %d\n", f.bar[0]);
printf ("tweetje: %d\n", f.bar[1]);
int *pf = &f;
if (*pf != 0x22) return 1;
if (*(pf + 1) != 0x34) return 2;
struct foo *g = &f;
printf ("punter eentje: %d\n", g->bar[0]);
printf ("punter tweetje: %d\n", g->bar[1]);

47
scaffold/tests/76-pointer-arithmetic.c Normal file
View file

@ -0,0 +1,47 @@
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
* Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
* Mes is free software; you can redistribute it and/or modify it
* under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 3 of the License, or (at
* your option) any later version.
*
* Mes is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/
#include "30-test.i"
int
test ()
{
char *pc = 0;
void *pv = 0;
int *pi = 0;
char **ppc = 0;
void **ppv = 0;
int **ppi = 0;
if (++pc != 1) return 1;
if (++pv != 1) return 2;
if (++pi != 4) return 3;
if (++ppc != 4) return 4;
if (++ppv != 4) return 5;
if (++ppi != 4) return 6;
if (pc + 1 != 2) return 7;
if (pv + 1 != 2) return 8;
if (pi + 1 != 8) return 9;
if (ppc + 1 != 8) return 10;
if (ppv + 1 != 8) return 11;
if (ppi + 1 != 8) return 12;
return 0;
}