mescc: Support stdarg.

* mlibc/include/stdarg.h (va_list): New type.
  (va_start, va_arg, va_end, va_copy): New macro.
  (vprintf): New declaration.
* mlibc/libc-mes.c (vprintf): New function.
  (printf): Rewrite using vprintf.
* module/language/c99/compiler.mes (expr->accu, expr->accu*): Handle
  any array.  Limitation: element size must be 4/sizeof (expression).
  (make-type): Add value pointer to type.
  (type:type, type:size, type:pointer, type:description): New functions.
  (ast->info): Handle typedef with pointer.
This commit is contained in:
Jan Nieuwenhuizen 2017-07-05 18:48:08 +02:00
parent fa4fdad623
commit ebb15c72a3
3 changed files with 79 additions and 46 deletions

View file

@ -22,7 +22,15 @@
#if __GNUC__ && POSIX
#include_next <stdarg.h>
#endif // (__GNUC__ && POSIX)
#else // ! (__GNUC__ && POSIX)
typedef int va_list;
#define va_start(ap, last) (void)((ap) = (char*)(&(last) + 4))
#define va_arg(ap, type) (((type*)((ap) = ((ap) + sizeof(type))))[-1])
#define va_end(ap) (void)((ap) = 0)
#define va_copy(dest, src) dest = src
int vprintf (char const* format, va_list ap);
#endif // ! (__GNUC__ && POSIX)
#endif // __MES_STDARG_H

View file

@ -349,33 +349,11 @@ getenv (char const* s)
return 0;
}
#if 0
// !__MESC__
// FIXME: mes+nyacc parser bug here
// works fine with Guile, but let's keep a single input source
#define pop_va_arg \
asm ("mov____0x8(%ebp),%eax !-4"); /* mov -<0x4>(%ebp),%eax :va_arg */ \
asm ("shl____$i8,%eax !2"); /* shl $0x2,%eax */ \
asm ("add____%ebp,%eax"); /* add %ebp,%eax */ \
asm ("add____$i8,%eax !12"); /* add $0xc,%eax */ \
asm ("mov____(%eax),%eax"); /* mov (%eax),%eax */ \
asm ("mov____%eax,0x8(%ebp) !-8"); /* mov %eax,-0x8(%ebp) :va */ \
asm ("push___%eax"); /* push %eax */
#else // __MESC__
#define pop_va_arg asm ("mov____0x8(%ebp),%eax !-4\nshl____$i8,%eax !2\nadd____%ebp,%eax add____$i8,%eax !12\nmov____(%eax),%eax\nmov____%eax,0x8(%ebp) !-8\npush___%eax")
#endif
#include <stdarg.h>
int
printf (char const* format, int va_args)
vprintf (char const* format, va_list ap)
{
int va_arg = 0;
int va;
char *p = format;
while (*p)
if (*p != '%')
@ -387,13 +365,23 @@ printf (char const* format, int va_args)
switch (c)
{
case '%': {putchar (*p); break;}
case 'c': {pop_va_arg; putchar ((char)va); va_arg++; break;}
case 'd': {pop_va_arg; puts (itoa (va)); va_arg++; break;}
case 's': {pop_va_arg; puts ((char*)va); va_arg++; break;}
case 'c': {char c; c = va_arg (ap, char); putchar (c); break;}
case 'd': {int d; d = va_arg (ap, int); puts (itoa (d)); break;}
case 's': {char *s; s = va_arg (ap, char *); puts (s); break;}
default: putchar (*p);
}
va_end (ap);
p++;
}
return 0;
}
int
printf (char const* format, ...)
{
va_list ap;
va_start (ap, format);
int r = vprintf (format, ap);
va_end (ap);
return r;
}

View file

@ -568,6 +568,10 @@
(size (type->size info type)))
(append-text info (wrap-as (i386:value->accu size)))))
((sizeof-type (type-name (decl-spec-list (type-spec (fixed-type ,type))) (abs-declr (pointer))))
(let ((size 4))
(append-text info (wrap-as (i386:value->accu size)))))
;; c+p expr->arg
;; g_cells[<expr>]
((array-ref ,index (p-expr (ident ,array)))
@ -591,6 +595,11 @@
(let ((info ((expr->accu* info) o)))
(append-text info (wrap-as (i386:mem->accu)))))
;; <expr>[baz]
((array-ref ,index ,array)
(let ((info ((expr->accu* info) o)))
(append-text info (wrap-as (i386:mem->accu)))))
;; f.field
((d-sel (ident ,field) (p-expr (ident ,array)))
(let* ((type (ident->type info array))
@ -926,33 +935,52 @@
(i386:pop-base)
(i386:accu+base)))))))
((array-ref ,index ,array)
(let* ((info ((expr->accu info) index))
(size 4) ;; FIXME
(info (append-text info (wrap-as (append (i386:accu->base)
(if (eq? size 1) '()
(append
(if (<= size 4) '()
(i386:accu+accu))
(if (<= size 8) '()
(i386:accu+base))
(i386:accu-shl 2)))))))
(info ((expr->base info) array)))
(append-text info (wrap-as (i386:accu+base)))))
(_ (error "expr->accu*: unsupported: " o)))))
(define (ident->constant name value)
(cons name value))
(define (make-type name type size description)
(cons name (list type size description)))
(define (make-type name type size pointer description)
(cons name (list type size pointer description)))
(define type:type car)
(define type:size cadr)
(define type:pointer caddr)
(define type:description cadddr)
(define (enum->type name fields)
(make-type name 'enum 4 fields))
(make-type name 'enum 4 0 fields))
(define (struct->type name fields)
(make-type name 'struct (apply + (map field:size fields)) fields))
(make-type name 'struct (apply + (map field:size fields)) 0 fields))
(define i386:type-alist
'(("char" . (builtin 1 #f))
("short" . (builtin 2 #f))
("int" . (builtin 4 #f))
("long" . (builtin 4 #f))
("long long" . (builtin 8 #f))
'(("char" . (builtin 1 0 #f))
("short" . (builtin 2 0 #f))
("int" . (builtin 4 0 #f))
("long" . (builtin 4 0 #f))
("long long" . (builtin 8 0 #f))
;; FIXME sign
("unsigned char" . (builtin 1 #f))
("unsigned short" . (builtin 2 #f))
("unsigned" . (builtin 4 #f))
("unsigned int" . (builtin 4 #f))
("unsigned long" . (builtin 4 #f))
("unsigned long long" . (builtin 8 #f))))
("unsigned char" . (builtin 1 0 #f))
("unsigned short" . (builtin 2 0 #f))
("unsigned" . (builtin 4 0 #f))
("unsigned int" . (builtin 4 0 #f))
("unsigned long" . (builtin 4 0 #f))
("unsigned long long" . (builtin 8 0 #f))))
(define (field:size o)
(pmatch o
@ -968,7 +996,7 @@
((struct-ref (ident ,type))
(type->size info `("struct" ,type)))
(_ (let ((type (get-type (.types info) o)))
(if type (cadr type)
(if type (type:size type)
(error "type->size: unsupported: " o))))))
(define (field-offset info struct field)
@ -1214,7 +1242,7 @@
(type->description info `("struct" ,type)))
(_ (let ((type (get-type (.types info) o)))
(if (not type) (stderr "TYPES=~s\n" (.types info)))
(if type (caddr type)
(if type (type:description type)
(error "type->description: unsupported:" o))))))
(define (local? o) ;; formals < 0, locals > 0
@ -1994,6 +2022,15 @@
(let ((info ((ast->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name)))))))
(clone info #:types (cons (cons name (or (get-type types `("struct" ,name)) `(typedef ,name))) types))))
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
(let* ((type (get-type types type))
(type (make-type name
(type:type type)
(type:size type)
(1+ (type:pointer type))
(type:description type))))
(clone info #:types (cons type types))))
((decl (decl-spec-list (stor-spec (typedef)) ,type) ,name)
(format (current-error-port) "SKIP: typedef=~s\n" o)
info)