Show compile.cpp syntax highlighted
# 1 "compile.c"
# 1 "mudlle.h" 1
# 1 "/usr/sww/pkg/egcs-1.1.2/sparc-sun-solaris2.6/include/assert.h" 1 3
# 19 "/usr/sww/pkg/egcs-1.1.2/sparc-sun-solaris2.6/include/assert.h" 3
extern void __eprintf (const char *, const char *, unsigned, const char *)
__attribute__ ((noreturn));
# 52 "/usr/sww/pkg/egcs-1.1.2/sparc-sun-solaris2.6/include/assert.h" 3
# 7 "mudlle.h" 2
# 1 "options.h" 1
# 1 "/usr/include/sys/types.h" 1 3
#pragma ident "@(#)types.h 1.51 97/05/06 SMI"
# 1 "/usr/include/sys/feature_tests.h" 1 3
#pragma ident "@(#)feature_tests.h 1.13 97/06/26 SMI"
# 18 "/usr/include/sys/types.h" 2 3
# 1 "/usr/include/sys/isa_defs.h" 1 3
#pragma ident "@(#)isa_defs.h 1.11 97/03/21 SMI"
# 243 "/usr/include/sys/isa_defs.h" 3
# 334 "/usr/include/sys/isa_defs.h" 3
# 19 "/usr/include/sys/types.h" 2 3
# 1 "/usr/include/sys/machtypes.h" 1 3
#pragma ident "@(#)machtypes.h 1.11 96/04/29 SMI"
typedef struct _physadr_t { int r[1]; } *physadr_t;
typedef struct _label_t { int val[2]; } label_t;
typedef unsigned char lock_t;
# 24 "/usr/include/sys/types.h" 2 3
# 1 "/usr/include/sys/int_types.h" 1 3
#pragma ident "@(#)int_types.h 1.4 96/09/25 SMI"
typedef char int8_t;
typedef short int16_t;
typedef int int32_t;
typedef long long int64_t;
typedef unsigned char uint8_t;
typedef unsigned short uint16_t;
typedef unsigned int uint32_t;
typedef unsigned long long uint64_t;
typedef int64_t intmax_t;
typedef uint64_t uintmax_t;
typedef int intptr_t;
typedef unsigned int uintptr_t;
typedef char int_least8_t;
typedef short int_least16_t;
typedef int int_least32_t;
typedef long long int_least64_t;
typedef unsigned char uint_least8_t;
typedef unsigned short uint_least16_t;
typedef unsigned int uint_least32_t;
typedef unsigned long long uint_least64_t;
# 33 "/usr/include/sys/types.h" 2 3
typedef long long longlong_t;
typedef unsigned long long u_longlong_t;
# 57 "/usr/include/sys/types.h" 3
typedef unsigned char uchar_t;
typedef unsigned short ushort_t;
typedef unsigned int uint_t;
typedef unsigned long ulong_t;
typedef char * caddr_t;
typedef long daddr_t;
typedef short cnt_t;
typedef ulong_t paddr_t;
typedef uchar_t use_t;
typedef short sysid_t;
typedef short index_t;
typedef long off_t;
typedef longlong_t off64_t;
typedef ulong_t ino_t;
typedef long blkcnt_t;
typedef ulong_t fsblkcnt_t;
typedef ulong_t fsfilcnt_t;
typedef u_longlong_t ino64_t;
typedef longlong_t blkcnt64_t;
typedef u_longlong_t fsblkcnt64_t;
typedef u_longlong_t fsfilcnt64_t;
typedef enum { B_FALSE, B_TRUE } boolean_t;
typedef int64_t pad64_t;
typedef uint64_t upad64_t;
# 139 "/usr/include/sys/types.h" 3
typedef longlong_t offset_t;
typedef u_longlong_t u_offset_t;
typedef u_longlong_t len_t;
typedef longlong_t diskaddr_t;
# 159 "/usr/include/sys/types.h" 3
typedef union {
offset_t _f;
struct {
long _u;
off_t _l;
} _p;
} lloff_t;
# 179 "/usr/include/sys/types.h" 3
typedef union {
diskaddr_t _f;
struct {
long _u;
daddr_t _l;
} _p;
} lldaddr_t;
typedef ulong_t k_fltset_t;
typedef long id_t;
typedef uint_t useconds_t;
typedef ulong_t major_t;
typedef ulong_t minor_t;
typedef short pri_t;
typedef ushort_t o_mode_t;
typedef short o_dev_t;
typedef ushort_t o_uid_t;
typedef o_uid_t o_gid_t;
typedef short o_nlink_t;
typedef short o_pid_t;
typedef ushort_t o_ino_t;
typedef int key_t;
typedef ulong_t mode_t;
typedef long uid_t;
typedef uid_t gid_t;
typedef ulong_t nlink_t;
typedef ulong_t dev_t;
typedef long pid_t;
typedef unsigned int pthread_t;
typedef unsigned int pthread_key_t;
typedef struct _pthread_mutex {
struct {
uint8_t __pthread_mutex_flag[4];
uint32_t __pthread_mutex_type;
} __pthread_mutex_flags;
union {
struct {
uint8_t __pthread_mutex_pad[8];
} __pthread_mutex_lock64;
upad64_t __pthread_mutex_owner64;
} __pthread_mutex_lock;
upad64_t __pthread_mutex_data;
} pthread_mutex_t;
typedef struct _pthread_cond {
struct {
uint8_t __pthread_cond_flag[4];
uint32_t __pthread_cond_type;
} __pthread_cond_flags;
upad64_t __pthread_cond_data;
} pthread_cond_t;
typedef struct _pthread_attr {
void *__pthread_attrp;
} pthread_attr_t;
typedef struct _pthread_mutexattr {
void *__pthread_mutexattrp;
} pthread_mutexattr_t;
typedef struct _pthread_condattr {
void *__pthread_condattrp;
} pthread_condattr_t;
typedef struct _once {
upad64_t __pthread_once_pad[4];
} pthread_once_t;
typedef uint_t size_t;
typedef int ssize_t;
typedef long time_t;
typedef long clock_t;
typedef int clockid_t;
typedef int timer_t;
typedef unsigned char unchar;
typedef unsigned short ushort;
typedef unsigned int uint;
typedef unsigned long ulong;
# 379 "/usr/include/sys/types.h" 3
typedef long hostid_t;
typedef unsigned char u_char;
typedef unsigned short u_short;
typedef unsigned int u_int;
typedef unsigned long u_long;
typedef struct _quad { long val[2]; } quad;
# 1 "/usr/include/sys/select.h" 1 3
#pragma ident "@(#)select.h 1.11 96/06/20 SMI"
# 1 "/usr/include/sys/time.h" 1 3
#pragma ident "@(#)time.h 2.52 96/11/15 SMI"
struct timeval {
time_t tv_sec;
long tv_usec;
};
struct timezone {
int tz_minuteswest;
int tz_dsttime;
};
# 1 "/usr/include/sys/types.h" 1 3
# 438 "/usr/include/sys/types.h" 3
# 71 "/usr/include/sys/time.h" 2 3
struct itimerval {
struct timeval it_interval;
struct timeval it_value;
};
typedef struct timespec {
time_t tv_sec;
long tv_nsec;
} timespec_t;
typedef struct timespec timestruc_t;
# 204 "/usr/include/sys/time.h" 3
typedef struct itimerspec {
struct timespec it_interval;
struct timespec it_value;
} itimerspec_t;
typedef longlong_t hrtime_t;
# 318 "/usr/include/sys/time.h" 3
int adjtime(struct timeval *, struct timeval *);
int getitimer(int, struct itimerval *);
int setitimer(int, struct itimerval *, struct itimerval *);
int settimeofday(struct timeval *, void *);
hrtime_t gethrtime(void);
hrtime_t gethrvtime(void);
int gettimeofday(struct timeval *, void *);
# 1 "/usr/include/time.h" 1 3
#pragma ident "@(#)time.h 1.25 96/03/12 SMI"
struct tm {
int tm_sec;
int tm_min;
int tm_hour;
int tm_mday;
int tm_mon;
int tm_year;
int tm_wday;
int tm_yday;
int tm_isdst;
};
extern clock_t clock(void);
extern double difftime(time_t, time_t);
extern time_t mktime(struct tm *);
extern time_t time(time_t *);
extern char *asctime(const struct tm *);
extern char *ctime(const time_t *);
extern struct tm *gmtime(const time_t *);
extern struct tm *localtime(const time_t *);
extern size_t strftime(char *, size_t, const char *, const struct tm *);
extern struct tm *gmtime_r(const time_t *, struct tm *);
extern struct tm *localtime_r(const time_t *, struct tm *);
extern char *strptime(const char *, const char *, struct tm *);
# 1 "/usr/include/sys/time.h" 1 3
# 414 "/usr/include/sys/time.h" 3
# 93 "/usr/include/time.h" 2 3
# 1 "/usr/include/sys/siginfo.h" 1 3
#pragma ident "@(#)siginfo.h 1.39 96/06/28 SMI"
union sigval {
int sival_int;
void *sival_ptr;
};
struct sigevent {
int sigev_notify;
union {
int _sigev_signo;
void (*_sigev_notify_function)(union sigval);
} _sigev_un;
union sigval sigev_value;
int _sigev_pad1;
void *_sigev_notify_attributes;
int _sigev_pad2;
};
# 1 "/usr/include/sys/machsig.h" 1 3
#pragma ident "@(#)machsig.h 1.12 96/04/29 SMI"
# 88 "/usr/include/sys/siginfo.h" 2 3
# 1 "/usr/include/sys/time.h" 1 3
# 414 "/usr/include/sys/time.h" 3
# 160 "/usr/include/sys/siginfo.h" 2 3
# 181 "/usr/include/sys/siginfo.h" 3
typedef struct siginfo {
int si_signo;
int si_code;
int si_errno;
union {
int __pad[((128 / sizeof (int)) - 3) ];
struct {
pid_t __pid;
union {
struct {
uid_t __uid;
union sigval __value;
} __kill;
struct {
clock_t __utime;
int __status;
clock_t __stime;
} __cld;
} __pdata;
} __proc;
struct {
void *__addr;
int __trapno;
caddr_t __pc;
} __fault;
struct {
int __fd;
long __band;
} __file;
struct {
caddr_t __faddr;
timestruc_t __tstamp;
short __syscall;
char __nsysarg;
char __fault;
long __sysarg[8];
long __mstate[17];
} __prof;
} __data;
} siginfo_t;
typedef struct k_siginfo {
int si_signo;
int si_code;
int si_errno;
union {
struct {
pid_t __pid;
union {
struct {
uid_t __uid;
union sigval __value;
} __kill;
struct {
clock_t __utime;
int __status;
clock_t __stime;
} __cld;
} __pdata;
} __proc;
struct {
void *__addr;
int __trapno;
caddr_t __pc;
} __fault;
struct {
int __fd;
long __band;
} __file;
struct {
caddr_t __faddr;
timestruc_t __tstamp;
short __syscall;
char __nsysarg;
char __fault;
} __prof;
} __data;
} k_siginfo_t;
typedef struct sigqueue {
struct sigqueue *sq_next;
k_siginfo_t sq_info;
void (*sq_func)(struct sigqueue *);
void *sq_backptr;
} sigqueue_t;
# 94 "/usr/include/time.h" 2 3
extern int clock_getres(clockid_t, struct timespec *);
extern int clock_gettime(clockid_t, struct timespec *);
extern int clock_settime(clockid_t, const struct timespec *);
extern int timer_create(clockid_t, struct sigevent *, timer_t *);
extern int timer_delete(timer_t);
extern int timer_getoverrun(timer_t);
extern int timer_gettime(timer_t, struct itimerspec *);
extern int timer_settime(timer_t, int, const struct itimerspec *,
struct itimerspec *);
extern int nanosleep(const struct timespec *, struct timespec *);
extern void tzset(void);
extern char *tzname[2];
extern long _sysconf(int);
extern long timezone;
extern int daylight;
extern int cftime(char *, char *, const time_t *);
extern int ascftime(char *, const char *, const struct tm *);
extern long altzone;
extern struct tm *getdate(const char *);
extern int getdate_err;
# 183 "/usr/include/time.h" 3
# 247 "/usr/include/time.h" 3
extern char *asctime_r(const struct tm *, char *, int);
extern char *ctime_r(const time_t *, char *, int);
# 290 "/usr/include/time.h" 3
# 399 "/usr/include/sys/time.h" 2 3
# 1 "/usr/include/sys/select.h" 1 3
# 96 "/usr/include/sys/select.h" 3
# 405 "/usr/include/sys/time.h" 2 3
# 16 "/usr/include/sys/select.h" 2 3
typedef long fd_mask;
typedef long fds_mask;
typedef struct fd_set {
long fds_bits[((( 1024 )+(( (sizeof (fds_mask) * 8 ) )-1))/( (sizeof (fds_mask) * 8 ) )) ];
} fd_set;
extern int select(int, fd_set *, fd_set *, fd_set *, struct timeval *);
# 418 "/usr/include/sys/types.h" 2 3
# 83 "options.h" 2
# 123 "options.h"
# 8 "mudlle.h" 2
typedef signed short word;
typedef unsigned short uword;
typedef signed char byte;
typedef unsigned char ubyte;
# 1 "/usr/include/alloca.h" 1 3
#pragma ident "@(#)alloca.h 1.9 95/03/02 SMI"
extern void *__builtin_alloca(size_t);
# 55 "/usr/include/alloca.h" 3
# 24 "mudlle.h" 2
# 1 "context.h" 1
# 1 "/usr/include/setjmp.h" 1 3
#pragma ident "@(#)setjmp.h 1.26 96/12/18 SMI"
typedef int jmp_buf[12 ];
extern int setjmp(jmp_buf);
#pragma unknown_control_flow(setjmp)
extern int _setjmp(jmp_buf);
#pragma unknown_control_flow(_setjmp)
extern void longjmp(jmp_buf, int);
extern void _longjmp(jmp_buf, int);
typedef int sigjmp_buf[19 ];
extern int sigsetjmp(sigjmp_buf, int);
#pragma unknown_control_flow(sigsetjmp)
extern void siglongjmp(sigjmp_buf, int);
# 94 "/usr/include/setjmp.h" 3
# 38 "context.h" 2
# 1 "mvalues.h" 1
typedef void *value;
struct obj
{
ulong size;
ubyte garbage_type;
ubyte type;
short flags;
};
enum { garbage_string, garbage_record, garbage_code, garbage_forwarded,
garbage_permanent, garbage_temp, garbage_mcode };
struct gstring
{
struct obj o;
char data[1];
};
struct grecord
{
struct obj o;
struct obj *data[1];
};
struct gforwarded
{
struct obj *newp;
};
struct gtemp
{
struct obj o;
void *external;
};
struct gpermanent
{
struct obj o;
ulong nb;
void *external;
ulong call_count;
};
# 140 "mvalues.h"
struct code
{
struct obj o;
uword nb_constants;
uword nb_locals;
uword stkdepth;
uword seclevel;
uword lineno;
ubyte filler[2];
ulong call_count;
ulong instruction_count;
struct string *varname;
struct string *filename;
struct string *help;
ubyte magic_dispatch[16];
struct obj *constants[1 ];
};
struct mcode
{
struct obj o;
uword seclevel;
uword nb_constants;
uword code_length;
uword lineno;
struct string *filename;
struct string *varname;
struct string *help;
ubyte *myself;
ubyte magic[8];
ulong mcode[1 ];
};
# 217 "mvalues.h"
# 247 "mvalues.h"
# 39 "context.h" 2
# 1 "types.h" 1
typedef enum
{
type_code, type_closure, type_variable, type_internal,
type_primitive, type_varargs, type_secure,
type_integer, type_string, type_vector, type_pair, type_symbol, type_table,
type_private,
type_object, type_character, type_gone,
type_outputport, type_mcode, type_float, type_bigint, type_null,
last_type,
stype_none = last_type,
stype_any,
stype_function,
stype_list,
last_synthetic_type
} mtype;
struct closure
{
struct obj o;
struct code *code;
struct variable *variables[1];
};
struct string
{
struct obj o;
char str[1];
};
struct mudlle_float
{
struct obj o;
double d;
};
struct variable
{
struct obj o;
value vvalue;
};
struct symbol
{
struct obj o;
struct string *name;
value data;
};
struct primitive
{
struct obj o;
ulong nb;
struct primitive_ext *op;
ulong call_count;
};
typedef const char *typing[];
struct primitive_ext
{
const char *name;
const char *help;
value (*op)();
word nargs;
uword flags;
const char **type;
uword seclevel;
};
struct vector
{
struct obj o;
value data[1];
};
struct list
{
struct obj o;
value car, cdr;
};
struct character
{
struct obj o;
struct char_data *ch;
};
struct object
{
struct obj o;
struct obj_data *obj;
};
struct closure *unsafe_alloc_closure(ulong nb_variables);
struct closure *alloc_closure0(struct code *code);
struct string *alloc_string(const char *s);
struct mudlle_float *alloc_mudlle_float(double d);
struct string *safe_alloc_string(const char *s);
struct variable *alloc_variable(value val);
struct symbol *alloc_symbol(struct string *name, value data);
struct vector *alloc_vector(ulong size);
struct list *alloc_list(value car, value cdr);
struct character *alloc_character(struct char_data *ch);
struct object *alloc_object(struct obj_data *obj);
struct primitive *alloc_primitive(ulong nb, struct primitive_ext *op);
struct primitive *alloc_secure(ulong nb, struct primitive_ext *op);
struct grecord *alloc_private(int id, ulong size);
int mudlle_strtoint(const char *sp, int *i);
int mudlle_strtofloat(const char *sp, double *d);
# 40 "context.h" 2
# 1 "mudio.h" 1
# 1 "print.h" 1
# 1 "ports.h" 1
# 1 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/stdarg.h" 1 3
# 1 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/va-sparc.h" 1 3
typedef void * __gnuc_va_list;
# 47 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/va-sparc.h" 3
void va_end (__gnuc_va_list);
enum __va_type_classes {
__no_type_class = -1,
__void_type_class,
__integer_type_class,
__char_type_class,
__enumeral_type_class,
__boolean_type_class,
__pointer_type_class,
__reference_type_class,
__offset_type_class,
__real_type_class,
__complex_type_class,
__function_type_class,
__method_type_class,
__record_type_class,
__union_type_class,
__array_type_class,
__string_type_class,
__set_type_class,
__file_type_class,
__lang_type_class
};
# 134 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/va-sparc.h" 3
# 159 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/va-sparc.h" 3
# 30 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/stdarg.h" 2 3
# 128 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/stdarg.h" 3
typedef __gnuc_va_list va_list;
# 200 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/stdarg.h" 3
# 4 "ports.h" 2
# 1 "/usr/include/stdio.h" 1 3
#pragma ident "@(#)stdio.h 1.49 97/05/09 SMI"
# 1 "/usr/include/sys/va_list.h" 1 3
#pragma ident "@(#)va_list.h 1.6 96/01/26 SMI"
# 41 "/usr/include/sys/va_list.h" 3
typedef void *__va_list;
# 18 "/usr/include/stdio.h" 2 3
typedef long long __longlong_t;
# 65 "/usr/include/stdio.h" 3
typedef long fpos_t;
typedef __longlong_t fpos64_t;
# 122 "/usr/include/stdio.h" 3
typedef struct
{
int _cnt;
unsigned char *_ptr;
unsigned char *_base;
unsigned char _flag;
unsigned char _file;
} FILE;
extern FILE __iob[20 ];
extern FILE *_lastbuf;
extern unsigned char *_bufendtab[];
extern unsigned char _sibuf[], _sobuf[];
# 222 "/usr/include/stdio.h" 3
extern int remove(const char *);
extern int rename(const char *, const char *);
extern FILE *tmpfile(void);
extern char *tmpnam(char *);
extern char *tmpnam_r(char *);
extern int fclose(FILE *);
extern int fflush(FILE *);
extern FILE *fopen(const char *, const char *);
extern FILE *freopen(const char *, const char *, FILE *);
extern void setbuf(FILE *, char *);
extern void setbuffer(FILE *, char *, size_t);
extern int setlinebuf(FILE *);
extern int setvbuf(FILE *, char *, int, size_t);
extern int fprintf(FILE *, const char *, ...);
extern int fscanf(FILE *, const char *, ...);
extern int printf(const char *, ...);
extern int scanf(const char *, ...);
extern int snprintf(char *, size_t, const char *, ...);
extern int sprintf(char *, const char *, ...);
extern int sscanf(const char *, const char *, ...);
extern int vfprintf(FILE *, const char *, __va_list);
extern int vprintf(const char *, __va_list);
extern int vsnprintf(char *, size_t, const char *, __va_list);
extern int vsprintf(char *, const char *, __va_list);
extern int fgetc(FILE *);
extern char *fgets(char *, int, FILE *);
extern int fputc(int, FILE *);
extern int fputs(const char *, FILE *);
extern int getc(FILE *);
extern int getchar(void);
extern char *gets(char *);
extern int putc(int, FILE *);
extern int putchar(int);
extern int puts(const char *);
extern int ungetc(int, FILE *);
extern size_t fread(void *, size_t, size_t, FILE *);
extern size_t fwrite(const void *, size_t, size_t, FILE *);
extern int fgetpos(FILE *, fpos_t *);
extern int fseek(FILE *, long, int);
extern int fsetpos(FILE *, const fpos_t *);
extern long ftell(FILE *);
extern void rewind(FILE *);
extern void clearerr(FILE *);
extern int feof(FILE *);
extern int ferror(FILE *);
extern void perror(const char *);
extern int __filbuf(FILE *);
extern int __flsbuf(int, FILE *);
extern FILE *fdopen(int, const char *);
extern char *ctermid(char *);
extern int fileno(FILE *);
extern void flockfile(FILE *);
extern int ftrylockfile(FILE *);
extern void funlockfile(FILE *);
extern int getc_unlocked(FILE *);
extern int getchar_unlocked(void);
extern int putc_unlocked(int, FILE *);
extern int putchar_unlocked(int);
extern FILE *popen(const char *, const char *);
extern char *cuserid(char *);
extern char *tempnam(const char *, const char *);
extern int getopt(int, char *const *, const char *);
extern int getsubopt(char **, char *const *, char **);
extern char *optarg;
extern int optind, opterr, optopt;
extern int getw(FILE *);
extern int putw(int, FILE *);
extern int pclose(FILE *);
extern int fseeko(FILE *, off_t, int);
extern off_t ftello(FILE *);
extern FILE *fopen64(const char *, const char *);
extern FILE *freopen64(const char *, const char *, FILE *);
extern FILE *tmpfile64(void);
extern int fgetpos64(FILE *, fpos64_t *);
extern int fsetpos64(FILE *, const fpos64_t *);
extern int fseeko64(FILE *, off64_t, int);
extern off64_t ftello64(FILE *);
# 467 "/usr/include/stdio.h" 3
# 512 "/usr/include/stdio.h" 3
# 5 "ports.h" 2
struct oport;
struct oport_methods
{
void (*close)(struct oport *p);
void (*putch)(struct oport *p, char c);
void (*write)(struct oport *p, const char *data, int nchars);
void (*swrite)(struct oport *p, struct string *s, int from, int nchars);
void (*flush)(struct oport *p);
};
struct oport
{
struct obj o;
struct gtemp *methods;
};
value make_string_outputport(void);
value make_string_7bit_outputport(void);
value make_file_outputport(FILE *f);
struct string *port_string(struct oport *p);
char *port_cstring(struct oport *p);
int port_empty(struct oport *p);
# 69 "ports.h"
void port_append(struct oport *p1, struct oport *p2);
void pputs(const char *s, struct oport *p);
void pprintf(struct oport *p, const char *fmt, ...);
void vpprintf(struct oport *p, const char *fmt, va_list args);
char *int2str(char *str, int base, ulong n, int is_signed);
char *int2str_wide(char *str, ulong n, int is_signed);
void ports_init(void);
# 4 "print.h" 2
typedef enum { prt_display, prt_print, prt_examine } prt_level;
void output_value(struct oport *f, prt_level level, value v);
void print_init(void);
# 4 "mudio.h" 2
typedef int Muser;
typedef struct oport *Mio;
# 1 "context.h" 1
# 194 "context.h"
# 26 "mudio.h" 2
# 41 "context.h" 2
# 63 "context.h"
struct ccontext {
ulong *frame_start;
ulong *frame_end;
};
extern struct ccontext ccontext;
extern uword seclevel;
enum call_class { call_bytecode, call_c, call_compiled };
struct call_stack
{
struct call_stack *next;
enum call_class type;
union {
struct {
struct closure *fn;
struct code *code;
struct vector *locals;
int nargs;
} mudlle;
struct {
struct primitive_ext *op;
value arg1, arg2, arg3, arg4, arg5;
int nargs;
} c;
} u;
};
extern struct call_stack *call_stack;
struct catch_context
{
int display_error;
struct catch_context *parent;
jmp_buf exception;
struct call_stack *old_call_stack;
int old_stack_depth;
struct gcpro *old_gcpro;
uword old_seclevel;
struct ccontext occontext;
};
extern struct catch_context *catch_context;
extern long exception_signal;
extern value exception_value;
int mcatch(void (*fn)(void *x), void *x, int display_error);
volatile void mthrow(long sig, value val);
struct session_context
{
struct session_context *parent;
Mio _mudout, _muderr;
Muser _muduser;
value data;
uword old_minlevel;
ulong old_xcount;
ulong call_count;
};
extern struct session_context *session_context;
extern ulong xcount;
extern uword minlevel;
void session_start(struct session_context *newp,
uword new_minlevel,
Muser new_muduser,
Mio new_mudout,
Mio new_muderr);
void session_end(void);
void unlimited_execution(void);
void reset_context(void);
void context_init(void);
# 27 "mudlle.h" 2
# 1 "calloc.h" 1
typedef struct memblock **block_t;
block_t new_block(void);
void free_block(block_t b);
void *allocate(block_t b, unsigned long size);
# 29 "mudlle.h" 2
# 1 "alloc.h" 1
void garbage_cleanup(void);
void garbage_init(void);
extern ubyte *gcblock;
extern ulong gcblocksize;
# 38 "alloc.h"
extern struct gcpro *gcpro;
struct gcpro
{
struct gcpro *next;
value *obj;
};
# 1 "valuelist.h" 1
typedef struct
{
struct local_value *first, *last;
} valuelist;
struct local_value
{
struct local_value *next, *prev;
value lvalue;
};
struct local_value *addtail(block_t heap, valuelist *list, value lvalue);
# 64 "alloc.h" 2
extern struct gcpro_list *gcpro_list;
struct gcpro_list
{
struct gcpro_list *next;
valuelist *cl;
};
struct dynpro
{
struct dynpro *prev, *next;
value obj;
};
void dynpro(struct dynpro *what, value obj);
void undynpro(struct dynpro *what);
struct dynpro *protect(value v);
value unprotect(struct dynpro *pro);
void staticpro(value *pro);
struct grecord *allocate_record(ubyte type, ulong entries);
struct grecord *unsafe_allocate_record(ubyte type, ulong entries);
struct gstring *allocate_string(ubyte type, ulong bytes);
struct gpermanent *allocate_permanent(ubyte type, ulong nb, void *ext);
struct gtemp *allocate_temp(ubyte type, void *ext);
struct vector *allocate_locals(ulong n);
value gc_allocate(long n);
void detect_immutability(void);
unsigned long gc_size(value x, unsigned long *mutble);
void *gc_save(value x, unsigned long *size);
value gc_load(void *_load, unsigned long size);
value gc_load_debug(void *_load, unsigned long size);
# 211 "alloc.h"
void dump_memory(void);
void garbage_collect(long n);
# 30 "mudlle.h" 2
extern int debug_level;
int load_file(char *name, char *nicename, int seclev, int reload);
int catch_load_file(char *name, char *nicename, int seclev, int reload);
# 1 "compile.c" 2
# 1 "tree.h" 1
extern block_t parser_memory;
typedef struct _component *component;
typedef struct _constant *constant;
typedef struct _vlist {
struct _vlist *next;
const char *var;
mtype type;
} *vlist;
typedef struct _clist {
struct _clist *next;
component c;
} *clist;
typedef struct _cstlist {
struct _cstlist *next;
constant cst;
} *cstlist;
typedef struct _cstpair {
constant cst1, cst2;
} *cstpair;
typedef struct {
mtype type;
const char *help;
vlist args;
int varargs;
component value;
int lineno;
const char *filename;
const char *varname;
} *function;
typedef struct {
vlist locals;
clist sequence;
} *block;
enum constant_class {
cst_int, cst_string, cst_list, cst_array, cst_float, cst_bigint
};
struct _constant {
enum constant_class vclass;
union {
int integer;
const char *string;
double mudlle_float;
const char *bigint_str;
cstlist constants;
cstpair constpair;
} u;
};
enum {
b_or, b_and, b_sc_or, b_sc_and, b_eq, b_ne, b_lt, b_le, b_gt, b_ge,
b_bitor, b_bitxor, b_bitand, b_shift_left, b_shift_right,
b_add, b_subtract, b_multiply, b_divide, b_remainder, b_negate,
b_not, b_bitnot, b_ifelse, b_if, b_while, b_loop, b_ref, b_set,
b_cons, last_builtin
};
enum component_class {
c_assign, c_recall, c_constant, c_closure, c_execute, c_builtin, c_block,
c_labeled, c_exit
};
struct _component {
enum component_class vclass;
union {
struct {
const char *symbol;
component value;
} assign;
const char *recall;
constant cst;
function closure;
clist execute;
struct {
unsigned int fn;
clist args;
} builtin;
block blk;
struct {
const char *name;
component expression;
} labeled;
} u;
};
enum file_class { f_plain, f_module, f_library };
typedef struct {
enum file_class vclass;
const char *name;
vlist imports;
vlist defines;
vlist reads;
vlist writes;
block body;
} *mfile;
mfile new_file(block_t heap, enum file_class vclass, const char *name,
vlist imports, vlist defines, vlist reads, vlist writes,
block body);
function new_function(block_t heap, mtype type, const char *help, vlist args,
component val, int lineno, const char *filename);
function new_vfunction(block_t heap, mtype type, const char *help,
const char *arg, component val,
int lineno, const char *filename);
block new_codeblock(block_t heap, vlist locals, clist sequence);
clist new_clist(block_t heap, component c, clist next);
cstlist new_cstlist(block_t heap, constant cst, cstlist next);
vlist new_vlist(block_t heap, const char *var, mtype type, vlist next);
constant new_constant(block_t heap, enum constant_class vclass, ...);
component new_component(block_t heap, enum component_class vclass, ...);
void print_file(FILE *out, mfile f);
clist append_clist(clist l1, clist l2);
clist reverse_clist(clist l);
cstlist reverse_cstlist(cstlist l);
vlist append_vlist(vlist l1, vlist l2);
vlist reverse_vlist(vlist l);
value mudlle_parse(block_t heap, mfile f);
# 2 "compile.c" 2
# 1 "code.h" 1
# 1 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/limits.h" 1 3
# 1 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/syslimits.h" 1 3
# 1 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/limits.h" 1 3
# 114 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/limits.h" 3
# 1 "/usr/include/limits.h" 1 3
#pragma ident "@(#)limits.h 1.35 97/02/25 SMI"
# 1 "/usr/include/sys/int_limits.h" 1 3
#pragma ident "@(#)int_limits.h 1.3 96/09/23 SMI"
# 31 "/usr/include/limits.h" 2 3
# 1 "/usr/include/sys/unistd.h" 1 3
#pragma ident "@(#)unistd.h 1.29 96/06/05 SMI"
# 272 "/usr/include/limits.h" 2 3
extern long _sysconf(int);
# 117 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/limits.h" 2 3
# 7 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/syslimits.h" 2 3
# 11 "/usr/sww/pkg/egcs-1.1.2/lib/gcc-lib/sparc-sun-solaris2.6/egcs-2.91.66/include/limits.h" 2 3
# 4 "code.h" 2
typedef ubyte instruction;
typedef enum { local_var, closure_var, global_var } variable_class;
enum {
op_return,
op_constant1,
op_constant2,
op_integer1,
op_integer2,
op_closure,
op_closure_code1,
op_closure_code2,
op_execute,
op_execute_secure,
op_execute_varargs,
op_execute_primitive,
op_execute_primitive1,
op_execute_primitive2,
op_execute_global1,
op_execute_global2,
op_argcheck,
op_varargs,
op_discard,
op_pop_n,
op_exit_n,
op_dup,
op_branch1,
op_branch2,
op_loop1,
op_loop2,
op_branch_nz1,
op_branch_nz2,
op_branch_z1,
op_branch_z2,
op_clear_local,
op_recall,
op_define = op_recall + global_var + 1,
op_assign,
op_closure_var = op_assign + global_var + 1,
op_builtin_eq = op_closure_var + closure_var + 1,
op_builtin_neq,
op_builtin_gt,
op_builtin_lt,
op_builtin_le,
op_builtin_ge,
op_builtin_ref,
op_builtin_set,
op_builtin_add,
op_builtin_sub,
op_builtin_bitand,
op_builtin_bitor,
op_builtin_not,
op_typecheck
};
# 5 "compile.c" 2
# 1 "ins.h" 1
typedef struct _label *label;
typedef struct _fncode *fncode;
fncode new_fncode(int toplevel);
void delete_fncode(fncode fn);
block_t fnmemory(fncode fn);
int fntoplevel(fncode fn);
void ins0(instruction ins, fncode fn);
void ins1(instruction ins, int arg1, fncode fn);
void ins2(instruction ins, int arg2, fncode fn);
void branch(instruction branch, label to, fncode fn);
void adjust_depth(int by, fncode fn);
uword add_constant(value cst, fncode fn);
void ins_constant(value cst, fncode fn);
void peephole(fncode fn);
struct code *generate_fncode(fncode fn,
struct string *help,
struct string *varname,
struct string *afilename,
int alineno,
int seclev);
label new_label(fncode fn);
void set_label(label lab, fncode fn);
void start_block(const char *name, fncode fn);
void end_block(fncode fn);
int exit_block(const char *name, fncode fn);
# 6 "compile.c" 2
# 1 "env.h" 1
typedef struct _varlist
{
struct _varlist *next;
variable_class vclass;
ulong offset;
} *varlist;
void env_reset(void);
void env_push(vlist locals, fncode fn);
void env_block_push(vlist locals);
void env_block_pop(void);
varlist env_pop(uword *nb_locals);
variable_class env_lookup(const char *name, ulong *offset);
# 7 "compile.c" 2
# 1 "global.h" 1
# 1 "objenv.h" 1
struct env
{
struct obj o;
value used;
value size;
struct vector *values;
};
struct env *alloc_env(ulong size);
void env_reserve(struct env *env, ulong n);
ulong env_add_entry(struct env *env, value v);
# 40 "objenv.h"
void print_env(struct oport *f, struct env *env);
# 5 "global.h" 2
extern struct env *environment;
extern struct vector *env_values;
extern struct vector *mvars;
extern struct table *global;
ulong global_lookup(const char *name);
ulong mglobal_lookup(struct string *name);
void global_init(void);
struct list *global_list(void);
# 8 "compile.c" 2
# 1 "runtime/runtime.h" 1
# 1 "stack.h" 1
extern struct env *stack;
void stack_init(void);
void stack_clear(void);
value stack_pop(void);
void stack_push(value v);
value stack_get(ulong idx);
void stack_set(ulong idx, value v);
ulong stack_depth(void);
void print_stack(struct oport *f);
# 7 "runtime/runtime.h" 2
# 1 "error.h" 1
typedef enum {
error_bad_function,
error_stack_underflow,
error_bad_type,
error_divide_by_zero,
error_bad_index,
error_bad_value,
error_variable_read_only,
error_loop,
error_recurse,
error_wrong_parameters,
error_security_violation,
error_value_read_only,
error_user_interrupt,
last_runtime_error
} runtime_errors;
extern const char *mudlle_errors[last_runtime_error];
void error_init(void);
volatile void early_runtime_error(runtime_errors error);
volatile void runtime_error(runtime_errors error);
# 9 "runtime/runtime.h" 2
# 1 "utils.charset.h" 1
typedef unsigned int charset_t;
extern const unsigned char latin1_to_ascii_print[256];
extern const unsigned char latin1_to_ascii_icmp[256];
extern const unsigned char latin1_char_class[256];
extern const unsigned char latin1_to_upper[256];
extern const unsigned char latin1_to_lower[256];
extern int str_is8bit(const char *str);
extern int str8icmp(const char *s1, const char *s2);
extern int str8nicmp(const char *s1, const char *s2, int n);
extern void strto7print(char *str);
extern void str8lwr(char *str);
extern void str7lwr(char *str);
extern char *str8cap(char *str);
# 10 "runtime/runtime.h" 2
void runtime_init(void);
void system_define(const char *name, value val);
void runtime_define(const char *name, struct primitive_ext *op);
void check_interrupt(void);
extern value undefined_value;
void mumecst_init(void);
void mume_init(void);
void rent_init(void);
void predefined_init(void);
void simple_init(void);
# 11 "compile.c" 2
# 1 "utils.h" 1
extern int erred;
void *xmalloc(int size);
void *xcalloc(int number, int size);
void *xrealloc(void *old, int size);
char *xstrdup(const char *s);
char *strlwr(char *s);
void log_error(const char *msg, ...);
void warning(const char *msg, ...);
# 12 "compile.c" 2
# 1 "module.h" 1
enum { module_unloaded, module_error, module_loading, module_loaded, module_protected };
extern struct table *modules;
int module_status(const char *name);
void module_set(const char *name, int status);
int module_unload(const char *name);
int module_load(const char *name);
int module_require(const char *name);
enum { var_normal, var_module, var_write };
int module_vstatus(long n, struct string **name);
int module_vset(long n, int status, struct string *name);
void module_init(void);
# 13 "compile.c" 2
# 1 "mcompile.h" 1
int mstart(block_t heap, mfile f);
void mrecall(ulong n, const char *name, fncode fn);
void mexecute(ulong offset, const char *name, int count, fncode fn);
void massign(ulong n, const char *name, fncode fn);
void mcompile_init(void);
# 14 "compile.c" 2
# 1 "mparser.h" 1
# 1 "tokens.h" 1
typedef union {
char *string;
char *symbol;
int integer;
double mudlle_float;
char *bigint_str;
constant tconstant;
block tblock;
function tfunction;
clist tclist;
vlist tvlist;
cstlist tcstlist;
cstpair tcstpair;
component tcomponent;
mtype tmtype;
struct {
int varargs;
char *var;
vlist args;
} tparameters;
mfile tfile;
} YYSTYPE;
extern YYSTYPE yylval;
# 5 "mparser.h" 2
mfile parse(block_t heap);
void parser_init(void);
# 15 "compile.c" 2
# 1 "call.h" 1
value call0(value c);
value call1(value c, value arg);
value call2(value c, value arg1, value arg2);
value call3(value c, value arg1, value arg2, value arg3);
value call4(value c, value arg1, value arg2, value arg3, value arg4);
value call1plus(value c, value arg, struct vector *args);
value call(value c, struct vector *args);
void callable(value c, int nargs);
int callablep(value c, int nargs);
value mcatch_call0(value c);
value mcatch_call1(value c, value arg);
value mcatch_call2(value c, value arg1, value arg2);
value mcatch_call3(value c, value arg1, value arg2, value arg3);
value mcatch_call4(value c, value arg1, value arg2, value arg3, value arg4);
value mcatch_call1plus(value c, value arg, struct vector *args);
value mcatch_call(value c, struct vector *args);
value invoke0(struct closure *c);
value invoke1(struct closure *c, value arg);
value invoke2(struct closure *c, value arg1, value arg2);
value invoke3(struct closure *c, value arg1, value arg2, value arg3);
value invoke4(struct closure *c, value arg1, value arg2, value arg3, value arg4);
value invoke1plus(struct closure *c, value arg, struct vector *args);
value invoke(struct closure *c, struct vector *args);
# 16 "compile.c" 2
# 1 "runtime/bigint.h" 1
void bigint_init(void);
void free_mpz_temps(void);
# 17 "compile.c" 2
# 1 "/usr/include/string.h" 1 3
#pragma ident "@(#)string.h 1.19 96/03/12 SMI"
extern void *memcpy(void *, const void *, size_t);
extern void *memmove(void *, const void *, size_t);
extern char *strcpy(char *, const char *);
extern char *strncpy(char *, const char *, size_t);
extern char *strcat(char *, const char *);
extern char *strncat(char *, const char *, size_t);
extern int memcmp(const void *, const void *, size_t);
extern int strcmp(const char *, const char *);
extern int strcoll(const char *, const char *);
extern int strncmp(const char *, const char *, size_t);
extern size_t strxfrm(char *, const char *, size_t);
extern void *memchr(const void *, int, size_t);
extern char *strchr(const char *, int);
extern size_t strcspn(const char *, const char *);
extern char *strpbrk(const char *, const char *);
extern char *strrchr(const char *, int);
extern size_t strspn(const char *, const char *);
extern char *strstr(const char *, const char *);
extern char *strtok(char *, const char *);
extern char *strtok_r(char *, const char *, char **);
extern void *memset(void *, int, size_t);
extern char *strerror(int);
extern size_t strlen(const char *);
extern void *memccpy(void *, const void *, int, size_t);
extern char *strsignal(int);
extern int ffs(int);
extern int strcasecmp(const char *, const char *);
extern int strncasecmp(const char *, const char *, size_t);
extern char *strdup(const char *);
# 136 "/usr/include/string.h" 3
# 19 "compile.c" 2
# 1 "/usr/include/stdlib.h" 1 3
#pragma ident "@(#)stdlib.h 1.40 97/06/30 SMI"
# 1 "/usr/include/sys/wait.h" 1 3
#pragma ident "@(#)wait.h 1.20 97/03/02 SMI"
# 1 "/usr/include/sys/resource.h" 1 3
#pragma ident "@(#)resource.h 1.21 96/06/03 SMI"
typedef unsigned long rlim_t;
# 69 "/usr/include/sys/resource.h" 3
struct rlimit {
rlim_t rlim_cur;
rlim_t rlim_max;
};
typedef u_longlong_t rlim64_t;
struct rlimit64 {
rlim64_t rlim_cur;
rlim64_t rlim_max;
};
# 107 "/usr/include/sys/resource.h" 3
struct rusage {
struct timeval ru_utime;
struct timeval ru_stime;
long ru_maxrss;
long ru_ixrss;
long ru_idrss;
long ru_isrss;
long ru_minflt;
long ru_majflt;
long ru_nswap;
long ru_inblock;
long ru_oublock;
long ru_msgsnd;
long ru_msgrcv;
long ru_nsignals;
long ru_nvcsw;
long ru_nivcsw;
};
# 144 "/usr/include/sys/resource.h" 3
extern int setrlimit(int, const struct rlimit *);
extern int getrlimit(int, struct rlimit *);
extern int setrlimit64(int, const struct rlimit64 *);
extern int getrlimit64(int, struct rlimit64 *);
extern int getpriority(int, id_t);
extern int setpriority(int, id_t, int);
extern int getrusage(int, struct rusage *);
# 178 "/usr/include/sys/resource.h" 3
# 24 "/usr/include/sys/wait.h" 2 3
# 1 "/usr/include/sys/procset.h" 1 3
#pragma ident "@(#)procset.h 1.17 96/04/24 SMI"
typedef enum
idtype
{
P_PID,
P_PPID,
P_PGID,
P_SID,
P_CID,
P_UID,
P_GID,
P_ALL,
P_LWPID
} idtype_t;
typedef enum idop {
POP_DIFF,
POP_AND,
POP_OR,
POP_XOR
} idop_t;
typedef struct procset {
idop_t p_op;
idtype_t p_lidtype;
id_t p_lid;
idtype_t p_ridtype;
id_t p_rid;
} procset_t;
# 140 "/usr/include/sys/procset.h" 3
# 26 "/usr/include/sys/wait.h" 2 3
extern pid_t wait(int *);
extern pid_t waitpid(pid_t, int *, int);
extern int waitid(idtype_t, id_t, siginfo_t *, int);
extern pid_t wait3(int *, int, struct rusage *);
# 104 "/usr/include/sys/wait.h" 3
# 22 "/usr/include/stdlib.h" 2 3
typedef struct {
int quot;
int rem;
} div_t;
typedef struct {
long quot;
long rem;
} ldiv_t;
typedef struct {
long long quot;
long long rem;
} lldiv_t;
typedef long wchar_t;
# 86 "/usr/include/stdlib.h" 3
extern unsigned char __ctype[];
extern double atof(const char *);
extern int atoi(const char *);
extern long int atol(const char *);
extern double strtod(const char *, char **);
extern long int strtol(const char *, char **, int);
extern unsigned long int strtoul(const char *, char **, int);
extern int rand(void);
extern void srand(unsigned int);
extern int rand_r(unsigned int *);
extern void *calloc(size_t, size_t);
extern void free(void *);
extern void *malloc(size_t);
extern void *realloc(void *, size_t);
extern void abort(void);
extern int atexit(void (*)(void));
extern void exit(int);
extern void _exithandle(void);
extern char *getenv(const char *);
extern int system(const char *);
extern void *bsearch(const void *, const void *, size_t, size_t,
int (*)(const void *, const void *));
extern void qsort(void *, size_t, size_t,
int (*)(const void *, const void *));
extern int abs(int);
extern div_t div(int, int);
extern long int labs(long);
extern ldiv_t ldiv(long, long);
extern int mbtowc(wchar_t *, const char *, size_t);
extern int mblen(const char *, size_t);
extern int wctomb(char *, wchar_t);
extern size_t mbstowcs(wchar_t *, const char *, size_t);
extern size_t wcstombs(char *, const wchar_t *, size_t);
extern double drand48(void);
extern double erand48(unsigned short *);
extern long jrand48(unsigned short *);
extern void lcong48(unsigned short *);
extern long lrand48(void);
extern long mrand48(void);
extern long nrand48(unsigned short *);
extern unsigned short *seed48(unsigned short *);
extern void srand48(long);
extern int putenv(const char *);
extern void setkey(const char *);
extern void swab(const char *, char *, int);
extern int mkstemp(char *);
extern int mkstemp64(char *);
extern long a64l(const char *);
extern char *ecvt(double, int, int *, int *);
extern char *fcvt(double, int, int *, int *);
extern char *gcvt(double, int, char *);
extern int getsubopt(char **, char *const *, char **);
extern int grantpt(int);
extern char *initstate(unsigned, char *, size_t);
extern char *l64a(long);
extern char *mktemp(char *);
extern char *ptsname(int);
extern long random(void);
extern char *realpath(const char *, char *);
extern char *setstate(const char *);
extern void srandom(unsigned);
extern int ttyslot(void);
extern int unlockpt(int);
extern void *valloc(size_t);
extern int dup2(int, int);
extern char *qecvt(long double, int, int *, int *);
extern char *qfcvt(long double, int, int *, int *);
extern char *qgcvt(long double, int, char *);
extern char *getcwd(char *, size_t);
extern const char *getexecname(void);
extern char *getlogin(void);
extern int getopt(int, char *const *, const char *);
extern char *optarg;
extern int optind, opterr, optopt;
extern char *getpass(const char *);
extern char *getpassphrase(const char *);
extern int getpw(uid_t, char *);
extern int isatty(int);
extern void *memalign(size_t, size_t);
extern char *ttyname(int);
extern long long atoll(const char *);
extern long long llabs(long long);
extern lldiv_t lldiv(long long, long long);
extern char *lltostr(long long, char *);
extern long long strtoll(const char *, char **, int);
extern unsigned long long strtoull(const char *, char **, int);
extern char *ulltostr(unsigned long long, char *);
# 349 "/usr/include/stdlib.h" 3
# 20 "compile.c" 2
static ulong builtin_functions[last_builtin];
static ubyte builtin_ops[last_builtin];
static component component_undefined, component_true, component_false;
static struct string *last_filename;
static const char *last_c_filename;
static uword compile_level;
struct string *make_filename(const char *fname)
{
if (strcmp(fname, last_c_filename))
{
free((void *)last_c_filename);
last_c_filename = xstrdup(fname);
last_filename = alloc_string(fname);
last_filename->o.flags |= 1 ;
}
return last_filename;
}
value make_constant(constant c);
static value make_list(cstlist csts, int has_tail)
{
struct gcpro gcpro1;
struct list *l;
if (has_tail && csts != 0 )
{
l = csts->cst ? make_constant(csts->cst) : 0 ;
csts = csts->next;
}
else
l = 0 ;
do { ; ; gcpro1.next = gcpro; gcpro = &gcpro1; gcpro1.obj = (value *)& l ; } while(0) ;
while (csts)
{
value tmp = make_constant(csts->cst);
l = alloc_list(tmp, l);
l->o.flags |= 1 | 2 ;
csts = csts->next;
}
(gcpro = gcpro1.next) ;
return l;
}
# 86 "compile.c"
static value make_array(cstlist csts)
{
struct gcpro gcpro1;
struct list *l;
struct vector *v;
ulong size = 0, i;
cstlist scan;
for (scan = csts; scan; scan = scan->next) size++;
l = make_list(csts, 0);
do { ; ; gcpro1.next = gcpro; gcpro = &gcpro1; gcpro1.obj = (value *)& l ; } while(0) ;
v = alloc_vector(size);
v->o.flags |= 2 | 1 ;
(gcpro = gcpro1.next) ;
for (i = 0; i < size; i++, l = l->cdr) v->data[i] = l->car;
return v;
}
value make_constant(constant c)
{
struct obj *cst;
switch (c->vclass)
{
case cst_string:
cst = (value)alloc_string(c->u.string);
cst->flags |= 1 | 2 ;
return cst;
case cst_list: return make_list(c->u.constants, 1);
case cst_array: return make_array(c->u.constants);
case cst_int: return ((value)((( c->u.integer ) << 1) + 1)) ;
case cst_float: return (value)alloc_mudlle_float(c->u.mudlle_float);
case cst_bigint:
return 0 ;
}
abort();
}
typedef void (*gencode)(void *data, fncode fn);
struct code *generate_function(function f, int toplevel, fncode fn);
void generate_component(component comp, fncode fn);
void generate_condition(component condition,
label slab, gencode scode, void *sdata,
label flab, gencode fcode, void *fdata,
fncode fn);
struct andordata
{
label lab, slab, flab;
gencode scode, fcode;
void *sdata, *fdata;
component arg2;
};
static void andorcode(void *_data, fncode fn)
{
struct andordata *data = _data;
set_label(data->lab, fn);
generate_condition(data->arg2,
data->slab, data->scode, data->sdata,
data->flab, data->fcode, data->fdata,
fn);
}
void generate_condition(component condition,
label slab, gencode scode, void *sdata,
label flab, gencode fcode, void *fdata,
fncode fn)
{
struct andordata data;
switch (condition->vclass)
{
case c_builtin:
switch (condition->u.builtin.fn)
{
case b_sc_and: case b_sc_or:
{
component arg1 = condition->u.builtin.args->c;
data.arg2 = condition->u.builtin.args->next->c;
data.lab = new_label(fn);
data.slab = slab; data.scode = scode; data.sdata = sdata;
data.flab = flab; data.fcode = fcode; data.fdata = fdata;
if (condition->u.builtin.fn == b_sc_and)
generate_condition(arg1,
data.lab, andorcode, &data,
flab, 0 , 0 ,
fn);
else
generate_condition(arg1,
slab, 0 , 0 ,
data.lab, andorcode, &data,
fn);
return;
}
case b_not:
generate_condition(condition->u.builtin.args->c,
flab, fcode, fdata,
slab, scode, sdata,
fn);
return;
}
default:
generate_component(condition, fn);
if (scode)
{
branch(op_branch_z1, flab, fn);
scode(sdata, fn);
if (fcode) fcode(fdata, fn);
}
else
{
branch(op_branch_nz1, slab, fn);
if (fcode) fcode(fdata, fn);
else branch(op_branch1, flab, fn);
}
break;
}
}
struct ifdata
{
label slab, flab, endlab;
component success, failure;
};
static void ifs_code(void *_data, fncode fn)
{
struct ifdata *data = _data;
set_label(data->slab, fn);
generate_component(data->success, fn);
branch(op_branch1, data->endlab, fn);
adjust_depth(-1, fn);
}
static void iff_code(void *_data, fncode fn)
{
struct ifdata *data = _data;
set_label(data->flab, fn);
generate_component(data->failure, fn);
branch(op_branch1, data->endlab, fn);
adjust_depth(-1, fn);
}
void generate_if(component condition, component success, component failure,
fncode fn)
{
struct ifdata ifdata;
ifdata.slab = new_label(fn);
ifdata.flab = new_label(fn);
ifdata.endlab = new_label(fn);
ifdata.success = success;
ifdata.failure = failure;
generate_condition(condition, ifdata.slab, ifs_code, &ifdata,
ifdata.flab, iff_code, &ifdata, fn);
set_label(ifdata.endlab, fn);
adjust_depth(1, fn);
}
struct whiledata {
label looplab, mainlab, exitlab, endlab;
component code;
};
static void wmain_code(void *_data, fncode fn)
{
struct whiledata *wdata = _data;
set_label(wdata->mainlab, fn);
generate_component(wdata->code, fn);
branch(op_loop1, wdata->looplab, fn);
}
static void wexit_code(void *_data, fncode fn)
{
struct whiledata *wdata = _data;
set_label(wdata->exitlab, fn);
generate_component(component_undefined, fn);
branch(op_branch1, wdata->endlab, fn);
}
void generate_while(component condition, component iteration, fncode fn)
{
struct whiledata wdata;
wdata.looplab = new_label(fn);
wdata.mainlab = new_label(fn);
wdata.exitlab = new_label(fn);
wdata.endlab = new_label(fn);
wdata.code = iteration;
set_label(wdata.looplab, fn);
generate_condition(condition, wdata.mainlab, wmain_code, &wdata,
wdata.exitlab, wexit_code, &wdata, fn);
set_label(wdata.endlab, fn);
}
void generate_args(clist args, fncode fn, uword *_count)
{
uword count = 0;
while (args)
{
count++;
generate_component(args->c, fn);
args = args->next;
}
*_count = count;
}
void generate_block(block b, fncode fn)
{
clist cc = b->sequence;
env_block_push(b->locals);
for (; cc; cc = cc->next)
{
generate_component(cc->c, fn);
if (cc->next) ins0(op_discard, fn);
}
env_block_pop();
}
void generate_execute(component acall, int count, fncode fn)
{
if (acall->vclass == c_recall)
{
ulong offset;
variable_class vclass = env_lookup(acall->u.recall, &offset);
if (vclass == global_var)
{
mexecute(offset, acall->u.recall, count, fn);
return;
}
}
generate_component(acall, fn);
ins1(op_execute, count, fn);
}
void generate_component(component comp, fncode fn)
{
clist args;
switch (comp->vclass)
{
case c_assign:
{
ulong offset;
variable_class vclass = env_lookup(comp->u.assign.symbol, &offset);
component val = comp->u.assign.value;
if (val->vclass == c_closure)
{
if (vclass == global_var)
val->u.closure->varname = comp->u.assign.symbol;
else
{
char *varname = allocate(fnmemory(fn), strlen(comp->u.assign.symbol) + 7);
sprintf(varname, "local-%s", comp->u.assign.symbol);
val->u.closure->varname = varname;
}
}
generate_component(comp->u.assign.value, fn);
if (vclass == global_var)
massign(offset, comp->u.assign.symbol, fn);
else
ins1(op_assign + vclass, offset, fn);
break;
}
case c_recall:
{
ulong offset;
variable_class vclass = env_lookup(comp->u.recall, &offset);
if (vclass == global_var) mrecall(offset, comp->u.recall, fn);
else ins1(op_recall + vclass, offset, fn);
break;
}
case c_constant:
ins_constant(make_constant(comp->u.cst), fn);
break;
case c_closure:
{
uword idx;
idx = add_constant(generate_function(comp->u.closure, 0 , fn), fn);
if (idx < ((1 << 8 ) - 1) ) ins1(op_closure_code1, idx, fn);
else ins2(op_closure_code2, idx, fn);
break;
}
case c_block:
generate_block(comp->u.blk, fn);
break;
case c_labeled:
start_block(comp->u.labeled.name, fn);
generate_component(comp->u.labeled.expression, fn);
end_block(fn);
break;
case c_exit:
generate_component(comp->u.labeled.expression, fn);
if (!exit_block(comp->u.labeled.name, fn))
if (!comp->u.labeled.name)
log_error("No loop to exit from");
else
log_error("No block labeled %s", comp->u.labeled.name);
break;
case c_execute:
{
uword count;
generate_args(comp->u.execute->next, fn, &count);
generate_execute(comp->u.execute->c, count, fn);
break;
}
case c_builtin:
args = comp->u.builtin.args;
switch (comp->u.builtin.fn)
{
case b_if:
generate_if(args->c,
new_component(fnmemory(fn), c_block,
new_codeblock(fnmemory(fn), 0 ,
new_clist(fnmemory(fn), args->next->c,
new_clist(fnmemory(fn), component_undefined, 0 )))),
component_undefined,
fn);
break;
case b_ifelse:
generate_if(args->c, args->next->c, args->next->next->c, fn);
break;
case b_sc_and: case b_sc_or:
generate_if(comp, component_true, component_false, fn);
break;
case b_while:
generate_while(args->c, args->next->c, fn);
break;
case b_loop:
{
label loop = new_label(fn);
set_label(loop, fn);
start_block(0 , fn);
generate_component(args->c, fn);
branch(op_loop1, loop, fn);
end_block(fn);
adjust_depth(1, fn);
break;
}
case b_add: case b_subtract:
case b_ref: case b_set:
case b_bitor: case b_bitand:
case b_not:
case b_eq: case b_ne:
case b_lt: case b_le: case b_ge: case b_gt:
{
uword count;
((void) (( comp->u.builtin.fn < last_builtin ) ? 0 : (__eprintf ("%s:%u: failed assertion `%s'\n", "compile.c" , 478 , "comp->u.builtin.fn < last_builtin" ), 0) )) ;
generate_args(args, fn, &count);
ins0(builtin_ops[comp->u.builtin.fn], fn);
break;
}
default:
{
uword count;
((void) (( comp->u.builtin.fn < last_builtin ) ? 0 : (__eprintf ("%s:%u: failed assertion `%s'\n", "compile.c" , 487 , "comp->u.builtin.fn < last_builtin" ), 0) )) ;
generate_args(args, fn, &count);
mexecute(builtin_functions[comp->u.builtin.fn], 0 , count, fn);
break;
}
}
break;
default: ((void) (( 0 ) ? 0 : (__eprintf ("%s:%u: failed assertion `%s'\n", "compile.c" , 494 , "0" ), 0) )) ;
}
}
struct code *generate_function(function f, int toplevel, fncode fn)
{
struct code *c;
struct string *help, *filename, *varname;
fncode newfn;
vlist argument;
uword nargs, clen;
struct gcpro gcpro1, gcpro2, gcpro3;
varlist closure, cvar;
if (f->help)
help = alloc_string(f->help);
else
help = 0 ;
do { ; ; gcpro1.next = gcpro; gcpro = &gcpro1; gcpro1.obj = (value *)& help ; } while(0) ;
if (f->varname)
varname = alloc_string(f->varname);
else
varname = 0 ;
do { ; ; gcpro2 .next = gcpro; gcpro = & gcpro2 ; gcpro2 .obj = (value *)& varname ; } while(0) ;
filename = make_filename(f->filename);
do { ; ; gcpro3 .next = gcpro; gcpro = & gcpro3 ; gcpro3 .obj = (value *)& filename ; } while(0) ;
newfn = new_fncode(toplevel);
if (f->varargs)
ins0(op_varargs, newfn);
else
{
for (nargs = 0, argument = f->args; argument; argument = argument->next)
nargs++;
ins1(op_argcheck, nargs, newfn);
for (nargs = 0, argument = f->args; argument; argument = argument->next)
{
if (argument->type != stype_any)
ins1(op_typecheck + argument->type, nargs, newfn);
nargs++;
}
ins1(op_pop_n, nargs, newfn);
}
env_push(f->args, newfn);
start_block("function", newfn);
generate_component(f->value, newfn);
end_block(newfn);
if (f->type != stype_any) ins1(op_typecheck + f->type, 0, newfn);
ins0(op_return, newfn);
peephole(newfn);
c = generate_fncode(newfn, help, varname, filename, f->lineno,
compile_level);
closure = env_pop(&c->nb_locals);
(gcpro = gcpro1.next) ;
clen = 0;
for (cvar = closure; cvar; cvar = cvar->next) clen++;
ins1(op_closure, clen, fn);
for (cvar = closure; cvar; cvar = cvar->next)
ins1(op_closure_var + cvar->vclass, cvar->offset, fn);
delete_fncode(newfn);
return c;
}
static struct closure *compile_code(block b, int seclev)
{
struct code *cc;
struct gcpro gcpro1;
uword dummy;
fncode top;
compile_level = seclev;
erred = 0 ;
env_reset();
top = new_fncode(1 );
env_push(0 , top);
cc = generate_function(new_function(fnmemory(top), stype_any, 0 , 0 ,
new_component(fnmemory(top), c_block, b),
0, ""), 1 , top);
do { ; ; gcpro1.next = gcpro; gcpro = &gcpro1; gcpro1.obj = (value *)& cc ; } while(0) ;
generate_fncode(top, 0 , 0 , 0 , 0, seclev);
env_pop(&dummy);
delete_fncode(top);
(gcpro = gcpro1.next) ;
if (erred) return 0 ;
else return alloc_closure0(cc);
}
int interpret(value *result, int seclev, int reload)
{
int ok = 0 ;
block_t parser_block;
mfile f;
parser_block = new_block();
if (f = parse(parser_block))
{
if (f->name && !reload && module_status(f->name) != module_unloaded)
{
free_block(parser_block);
return 1 ;
}
if (mstart(parser_block, f))
{
value closure = compile_code(f->body, seclev);
if (closure)
{
# 642 "compile.c"
*result = mcatch_call0(closure);
ok = exception_signal == 0;
}
if (f->name) module_set(f->name, ok ? module_loaded : module_error);
}
}
free_block(parser_block);
return ok;
}
static block_t compile_block;
void compile_init(void)
{
compile_block = new_block();
component_undefined = new_component(compile_block, c_constant,
new_constant(compile_block, cst_int, 42));
component_true = new_component(compile_block, c_constant,
new_constant(compile_block, cst_int, 1 ));
component_false = new_component(compile_block, c_constant,
new_constant(compile_block, cst_int, 0 ));
builtin_functions[b_or] = global_lookup("or");
builtin_functions[b_and] = global_lookup("and");
builtin_ops[b_eq] = op_builtin_eq;
builtin_ops[b_ne] = op_builtin_neq;
builtin_ops[b_lt] = op_builtin_lt;
builtin_ops[b_le] = op_builtin_le;
builtin_ops[b_gt] = op_builtin_gt;
builtin_ops[b_ge] = op_builtin_ge;
builtin_ops[b_bitor] = op_builtin_bitor;
builtin_functions[b_bitxor] = global_lookup("^");
builtin_ops[b_bitand] = op_builtin_bitand;
builtin_functions[b_shift_left] = global_lookup("<<");
builtin_functions[b_shift_right] = global_lookup(">>");
builtin_ops[b_add] = op_builtin_add;
builtin_ops[b_subtract] = op_builtin_sub;
builtin_functions[b_multiply] = global_lookup("*");
builtin_functions[b_divide] = global_lookup("/");
builtin_functions[b_remainder] = global_lookup("%");
builtin_functions[b_negate] = global_lookup("negate");
builtin_ops[b_not] = op_builtin_not;
builtin_functions[b_bitnot] = global_lookup("~");
builtin_ops[b_ref] = op_builtin_ref;
builtin_ops[b_set] = op_builtin_set;
builtin_functions[b_cons] = global_lookup("cons");
staticpro((value *)&last_filename);
last_filename = alloc_string("");
last_c_filename = xstrdup("");
}
See more files for this project here