mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 04:10:54 -08:00
Code Issues Projects Releases Wiki Activity

Detabifying code and restructuredtext files.

Browse source 
Copied from Perforce
 Change: 189309
 ServerID: perforce.ravenbrook.com
This commit is contained in:
Richard Brooksby 2016-02-18 19:58:13 +00:00
parent fd45719968
commit 0f8bee3762
48 changed files with 986 additions and 986 deletions
Download patch file Download diff file Expand all files Collapse all files

4
mps/code/arenavm.c
View file

@ -744,8 +744,8 @@ static Res VMArenaGrow(Arena arena, LocusPref pref, Size size)
vmArenaGrow_Done:
EVENT2(vmArenaExtendDone, chunkSize, ArenaReserved(VMArena2Arena(vmArena)));
vmArena->extended(VMArena2Arena(vmArena),
newChunk->base,
AddrOffset(newChunk->base, newChunk->limit));
newChunk->base,
AddrOffset(newChunk->base, newChunk->limit));
return res;
}

72
mps/code/fmtscheme.h
View file

@ -40,55 +40,55 @@ typedef struct type_s {
} type_s;
typedef struct pair_s {
type_t type; /* TYPE_PAIR */
obj_t car, cdr; /* first and second projections */
type_t type; /* TYPE_PAIR */
obj_t car, cdr; /* first and second projections */
} pair_s;
typedef struct symbol_s {
type_t type; /* TYPE_SYMBOL */
size_t length; /* length of symbol string (excl. NUL) */
char string[1]; /* symbol string, NUL terminated */
type_t type; /* TYPE_SYMBOL */
size_t length; /* length of symbol string (excl. NUL) */
char string[1]; /* symbol string, NUL terminated */
} symbol_s;
typedef struct integer_s {
type_t type; /* TYPE_INTEGER */
long integer; /* the integer */
type_t type; /* TYPE_INTEGER */
long integer; /* the integer */
} integer_s;
typedef struct special_s {
type_t type; /* TYPE_SPECIAL */
char *name; /* printed representation, NUL terminated */
type_t type; /* TYPE_SPECIAL */
char *name; /* printed representation, NUL terminated */
} special_s;
typedef struct operator_s {
type_t type; /* TYPE_OPERATOR */
char *name; /* printed name, NUL terminated */
entry_t entry; /* entry point -- see eval() */
obj_t arguments, body; /* function arguments and code */
obj_t env, op_env; /* closure environments */
type_t type; /* TYPE_OPERATOR */
char *name; /* printed name, NUL terminated */
entry_t entry; /* entry point -- see eval() */
obj_t arguments, body; /* function arguments and code */
obj_t env, op_env; /* closure environments */
} operator_s;
typedef struct string_s {
type_t type; /* TYPE_STRING */
size_t length; /* number of chars in string */
char string[1]; /* string, NUL terminated */
type_t type; /* TYPE_STRING */
size_t length; /* number of chars in string */
char string[1]; /* string, NUL terminated */
} string_s;
typedef struct port_s {
type_t type; /* TYPE_PORT */
obj_t name; /* name of stream */
type_t type; /* TYPE_PORT */
obj_t name; /* name of stream */
FILE *stream;
} port_s;
typedef struct character_s {
type_t type; /* TYPE_CHARACTER */
char c; /* the character */
type_t type; /* TYPE_CHARACTER */
char c; /* the character */
} character_s;
typedef struct vector_s {
type_t type; /* TYPE_VECTOR */
size_t length; /* number of elements */
obj_t vector[1]; /* vector elements */
type_t type; /* TYPE_VECTOR */
size_t length; /* number of elements */
obj_t vector[1]; /* vector elements */
} vector_s;
typedef struct table_s {
@ -134,7 +134,7 @@ typedef struct pad_s {
typedef union obj_u {
type_s type; /* one of TYPE_* */
type_s type; /* one of TYPE_* */
pair_s pair;
symbol_s symbol;
integer_s integer;
@ -154,17 +154,17 @@ typedef union obj_u {
/* structure macros */
#define TYPE(obj) ((obj)->type.type)
#define CAR(obj) ((obj)->pair.car)
#define CDR(obj) ((obj)->pair.cdr)
#define CAAR(obj) CAR(CAR(obj))
#define CADR(obj) CAR(CDR(obj))
#define CDAR(obj) CDR(CAR(obj))
#define CDDR(obj) CDR(CDR(obj))
#define CADDR(obj) CAR(CDDR(obj))
#define CDDDR(obj) CDR(CDDR(obj))
#define CDDAR(obj) CDR(CDAR(obj))
#define CADAR(obj) CAR(CDAR(obj))
#define TYPE(obj) ((obj)->type.type)
#define CAR(obj) ((obj)->pair.car)
#define CDR(obj) ((obj)->pair.cdr)
#define CAAR(obj) CAR(CAR(obj))
#define CADR(obj) CAR(CDR(obj))
#define CDAR(obj) CDR(CAR(obj))
#define CDDR(obj) CDR(CDR(obj))
#define CADDR(obj) CAR(CDDR(obj))
#define CDDDR(obj) CDR(CDDR(obj))
#define CDDAR(obj) CDR(CDAR(obj))
#define CADAR(obj) CAR(CDAR(obj))
extern obj_t scheme_make_bool(int condition);

2
mps/code/gcbench.c
View file

@ -177,7 +177,7 @@ static void *start(void *p) {
void *marker;
RESMUST(mps_thread_reg(&thread->mps_thread, arena));
RESMUST(mps_root_create_thread(&thread->reg_root, arena,
thread->mps_thread, &marker));
thread->mps_thread, &marker));
RESMUST(mps_ap_create_k(&thread->ap, pool, mps_args_none));
thread->fn(thread);
mps_ap_destroy(thread->ap);

44
mps/code/getopt.h
View file

@ -6,8 +6,8 @@
* in the Memory Pool System test programs.
*/
/* $NetBSD: getopt.h,v 1.4 2000/07/07 10:43:54 ad Exp $ */
/* $FreeBSD: src/include/getopt.h,v 1.6.30.1.8.1 2012/03/03 06:15:13 kensmith Exp $ */
/* $NetBSD: getopt.h,v 1.4 2000/07/07 10:43:54 ad Exp $ */
/* $FreeBSD: src/include/getopt.h,v 1.6.30.1.8.1 2012/03/03 06:15:13 kensmith Exp $ */
/*-
* Copyright (c) 2000 The NetBSD Foundation, Inc.
@ -57,33 +57,33 @@
#define optional_argument 2
struct option {
/* name of long option */
const char *name;
/*
* one of no_argument, required_argument, and optional_argument:
* whether option takes an argument
*/
int has_arg;
/* if not NULL, set *flag to val when option found */
int *flag;
/* if flag not NULL, value to set *flag to; else return value */
int val;
/* name of long option */
const char *name;
/*
* one of no_argument, required_argument, and optional_argument:
* whether option takes an argument
*/
int has_arg;
/* if not NULL, set *flag to val when option found */
int *flag;
/* if flag not NULL, value to set *flag to; else return value */
int val;
};
int getopt_long(int, char * const *, const char *,
const struct option *, int *);
int getopt_long_only(int, char * const *, const char *,
const struct option *, int *);
int getopt_long(int, char * const *, const char *,
const struct option *, int *);
int getopt_long_only(int, char * const *, const char *,
const struct option *, int *);
#ifndef _GETOPT_DECLARED
#define _GETOPT_DECLARED
int getopt(int, char * const [], const char *);
#define _GETOPT_DECLARED
int getopt(int, char * const [], const char *);
extern char *optarg; /* getopt(3) external variables */
extern char *optarg; /* getopt(3) external variables */
extern int optind, opterr, optopt;
#endif
#ifndef _OPTRESET_DECLARED
#define _OPTRESET_DECLARED
extern int optreset; /* getopt(3) external variable */
#define _OPTRESET_DECLARED
extern int optreset; /* getopt(3) external variable */
#endif
#endif /* !_GETOPT_H_ */

794
mps/code/getoptl.c
View file

@ -6,8 +6,8 @@
* in the Memory Pool System test programs.
*/
/* $OpenBSD: getopt_long.c,v 1.21 2006/09/22 17:22:05 millert Exp $ */
/* $NetBSD: getopt_long.c,v 1.15 2002/01/31 22:43:40 tv Exp $ */
/* $OpenBSD: getopt_long.c,v 1.21 2006/09/22 17:22:05 millert Exp $ */
/* $NetBSD: getopt_long.c,v 1.15 2002/01/31 22:43:40 tv Exp $ */
/*
* Copyright (c) 2002 Todd C. Miller <Todd.Miller@courtesan.com>
@ -73,38 +73,38 @@
#include <stdio.h>
#include <stdarg.h>
#define GNU_COMPATIBLE /* Be more compatible, configure's use us! */
#define GNU_COMPATIBLE /* Be more compatible, configure's use us! */
int opterr = 1; /* if error message should be printed */
int optind = 1; /* index into parent argv vector */
int optopt = '?'; /* character checked for validity */
int optreset; /* reset getopt */
char *optarg; /* argument associated with option */
int opterr = 1; /* if error message should be printed */
int optind = 1; /* index into parent argv vector */
int optopt = '?'; /* character checked for validity */
int optreset; /* reset getopt */
char *optarg; /* argument associated with option */
#define PRINT_ERROR ((opterr) && (*options != ':'))
#define PRINT_ERROR ((opterr) && (*options != ':'))
#define FLAG_PERMUTE 0x01 /* permute non-options to the end of argv */
#define FLAG_ALLARGS 0x02 /* treat non-options as args to option "-1" */
#define FLAG_LONGONLY 0x04 /* operate as getopt_long_only */
#define FLAG_PERMUTE 0x01 /* permute non-options to the end of argv */
#define FLAG_ALLARGS 0x02 /* treat non-options as args to option "-1" */
#define FLAG_LONGONLY 0x04 /* operate as getopt_long_only */
/* return values */
#define BADCH (int)'?'
#define BADARG ((*options == ':') ? (int)':' : (int)'?')
#define INORDER (int)1
#define BADCH (int)'?'
#define BADARG ((*options == ':') ? (int)':' : (int)'?')
#define INORDER (int)1
#define EMSG ""
#define EMSG ""
#ifdef GNU_COMPATIBLE
#define NO_PREFIX (-1)
#define D_PREFIX 0
#define DD_PREFIX 1
#define W_PREFIX 2
#define NO_PREFIX (-1)
#define D_PREFIX 0
#define DD_PREFIX 1
#define W_PREFIX 2
#endif
static int getopt_internal(int, char * const *, const char *,
const struct option *, int *, int);
const struct option *, int *, int);
static int parse_long_options(char * const *, const char *,
const struct option *, int *, int, int);
const struct option *, int *, int, int);
static int gcd(int, int);
static void permute_args(int, int, int, char * const *);
@ -136,7 +136,7 @@ static const char illoptstring[] = "unknown option -- %s";
static void
warnx(const char *fmt, ...)
{
va_list varargs;
va_list varargs;
va_start(varargs, fmt);
vfprintf(stderr, fmt, varargs);
fputc('\n', stderr);
@ -149,16 +149,16 @@ warnx(const char *fmt, ...)
static int
gcd(int a, int b)
{
int c;
int c;
c = a % b;
while (c != 0) {
a = b;
b = c;
c = a % b;
}
c = a % b;
while (c != 0) {
a = b;
b = c;
c = a % b;
}
return (b);
return (b);
}
/*
@ -168,427 +168,427 @@ gcd(int a, int b)
*/
static void
permute_args(int panonopt_start, int panonopt_end, int opt_end,
char * const *nargv)
char * const *nargv)
{
int cstart, cyclelen, i, j, ncycle, nnonopts, nopts, pos;
char *swap;
int cstart, cyclelen, i, j, ncycle, nnonopts, nopts, pos;
char *swap;
/*
* compute lengths of blocks and number and size of cycles
*/
nnonopts = panonopt_end - panonopt_start;
nopts = opt_end - panonopt_end;
ncycle = gcd(nnonopts, nopts);
cyclelen = (opt_end - panonopt_start) / ncycle;
/*
* compute lengths of blocks and number and size of cycles
*/
nnonopts = panonopt_end - panonopt_start;
nopts = opt_end - panonopt_end;
ncycle = gcd(nnonopts, nopts);
cyclelen = (opt_end - panonopt_start) / ncycle;
for (i = 0; i < ncycle; i++) {
cstart = panonopt_end+i;
pos = cstart;
for (j = 0; j < cyclelen; j++) {
if (pos >= panonopt_end)
pos -= nnonopts;
else
pos += nopts;
swap = nargv[pos];
/* LINTED const cast */
((char **) nargv)[pos] = nargv[cstart];
/* LINTED const cast */
((char **)nargv)[cstart] = swap;
}
}
for (i = 0; i < ncycle; i++) {
cstart = panonopt_end+i;
pos = cstart;
for (j = 0; j < cyclelen; j++) {
if (pos >= panonopt_end)
pos -= nnonopts;
else
pos += nopts;
swap = nargv[pos];
/* LINTED const cast */
((char **) nargv)[pos] = nargv[cstart];
/* LINTED const cast */
((char **)nargv)[cstart] = swap;
}
}
}
/*
* parse_long_options --
* Parse long options in argc/argv argument vector.
* Parse long options in argc/argv argument vector.
* Returns -1 if short_too is set and the option does not match long_options.
*/
static int
parse_long_options(char * const *nargv, const char *options,
const struct option *long_options, int *idx, int short_too, int flags)
const struct option *long_options, int *idx, int short_too, int flags)
{
char *current_argv, *has_equal;
char *current_argv, *has_equal;
#ifdef GNU_COMPATIBLE
const char *current_dash;
const char *current_dash;
#endif
size_t current_argv_len;
int i, match, exact_match, second_partial_match;
size_t current_argv_len;
int i, match, exact_match, second_partial_match;
current_argv = place;
current_argv = place;
#ifdef GNU_COMPATIBLE
switch (dash_prefix) {
case D_PREFIX:
current_dash = "-";
break;
case DD_PREFIX:
current_dash = "--";
break;
case W_PREFIX:
current_dash = "-W ";
break;
default:
current_dash = "";
break;
}
switch (dash_prefix) {
case D_PREFIX:
current_dash = "-";
break;
case DD_PREFIX:
current_dash = "--";
break;
case W_PREFIX:
current_dash = "-W ";
break;
default:
current_dash = "";
break;
}
#endif
match = -1;
exact_match = 0;
second_partial_match = 0;
match = -1;
exact_match = 0;
second_partial_match = 0;
optind++;
optind++;
if ((has_equal = strchr(current_argv, '=')) != NULL) {
/* argument found (--option=arg) */
if ((has_equal = strchr(current_argv, '=')) != NULL) {
/* argument found (--option=arg) */
assert(has_equal > current_argv);
current_argv_len = (size_t)(has_equal - current_argv);
has_equal++;
} else
current_argv_len = strlen(current_argv);
current_argv_len = (size_t)(has_equal - current_argv);
has_equal++;
} else
current_argv_len = strlen(current_argv);
for (i = 0; long_options[i].name; i++) {
/* find matching long option */
if (strncmp(current_argv, long_options[i].name,
current_argv_len))
continue;
for (i = 0; long_options[i].name; i++) {
/* find matching long option */
if (strncmp(current_argv, long_options[i].name,
current_argv_len))
continue;
if (strlen(long_options[i].name) == current_argv_len) {
/* exact match */
match = i;
exact_match = 1;
break;
}
/*
* If this is a known short option, don't allow
* a partial match of a single character.
*/
if (short_too && current_argv_len == 1)
continue;
if (strlen(long_options[i].name) == current_argv_len) {
/* exact match */
match = i;
exact_match = 1;
break;
}
/*
* If this is a known short option, don't allow
* a partial match of a single character.
*/
if (short_too && current_argv_len == 1)
continue;
if (match == -1) /* first partial match */
match = i;
else if ((flags & FLAG_LONGONLY) ||
long_options[i].has_arg !=
long_options[match].has_arg ||
long_options[i].flag != long_options[match].flag ||
long_options[i].val != long_options[match].val)
second_partial_match = 1;
}
if (!exact_match && second_partial_match) {
/* ambiguous abbreviation */
if (PRINT_ERROR)
fprintf(stderr,
if (match == -1) /* first partial match */
match = i;
else if ((flags & FLAG_LONGONLY) ||
long_options[i].has_arg !=
long_options[match].has_arg ||
long_options[i].flag != long_options[match].flag ||
long_options[i].val != long_options[match].val)
second_partial_match = 1;
}
if (!exact_match && second_partial_match) {
/* ambiguous abbreviation */
if (PRINT_ERROR)
fprintf(stderr,
ambig,
#ifdef GNU_COMPATIBLE
current_dash,
current_dash,
#endif
(int)current_argv_len,
current_argv);
optopt = 0;
return (BADCH);
}
if (match != -1) { /* option found */
if (long_options[match].has_arg == no_argument
&& has_equal) {
if (PRINT_ERROR)
warnx(noarg,
(int)current_argv_len,
current_argv);
optopt = 0;
return (BADCH);
}
if (match != -1) { /* option found */
if (long_options[match].has_arg == no_argument
&& has_equal) {
if (PRINT_ERROR)
warnx(noarg,
#ifdef GNU_COMPATIBLE
current_dash,
current_dash,
#endif
(int)current_argv_len,
current_argv);
/*
* XXX: GNU sets optopt to val regardless of flag
*/
if (long_options[match].flag == NULL)
optopt = long_options[match].val;
else
optopt = 0;
(int)current_argv_len,
current_argv);
/*
* XXX: GNU sets optopt to val regardless of flag
*/
if (long_options[match].flag == NULL)
optopt = long_options[match].val;
else
optopt = 0;
#ifdef GNU_COMPATIBLE
return (BADCH);
return (BADCH);
#else
return (BADARG);
return (BADARG);
#endif
}
if (long_options[match].has_arg == required_argument ||
long_options[match].has_arg == optional_argument) {
if (has_equal)
optarg = has_equal;
else if (long_options[match].has_arg ==
required_argument) {
/*
* optional argument doesn't use next nargv
*/
optarg = nargv[optind++];
}
}
if ((long_options[match].has_arg == required_argument)
&& (optarg == NULL)) {
/*
* Missing argument; leading ':' indicates no error
* should be generated.
*/
if (PRINT_ERROR)
warnx(recargstring,
}
if (long_options[match].has_arg == required_argument ||
long_options[match].has_arg == optional_argument) {
if (has_equal)
optarg = has_equal;
else if (long_options[match].has_arg ==
required_argument) {
/*
* optional argument doesn't use next nargv
*/
optarg = nargv[optind++];
}
}
if ((long_options[match].has_arg == required_argument)
&& (optarg == NULL)) {
/*
* Missing argument; leading ':' indicates no error
* should be generated.
*/
if (PRINT_ERROR)
warnx(recargstring,
#ifdef GNU_COMPATIBLE
current_dash,
current_dash,
#endif
current_argv);
/*
* XXX: GNU sets optopt to val regardless of flag
*/
if (long_options[match].flag == NULL)
optopt = long_options[match].val;
else
optopt = 0;
--optind;
return (BADARG);
}
} else { /* unknown option */
if (short_too) {
--optind;
return (-1);
}
if (PRINT_ERROR)
warnx(illoptstring,
current_argv);
/*
* XXX: GNU sets optopt to val regardless of flag
*/
if (long_options[match].flag == NULL)
optopt = long_options[match].val;
else
optopt = 0;
--optind;
return (BADARG);
}
} else { /* unknown option */
if (short_too) {
--optind;
return (-1);
}
if (PRINT_ERROR)
warnx(illoptstring,
#ifdef GNU_COMPATIBLE
current_dash,
current_dash,
#endif
current_argv);
optopt = 0;
return (BADCH);
}
if (idx)
*idx = match;
if (long_options[match].flag) {
*long_options[match].flag = long_options[match].val;
return (0);
} else
return (long_options[match].val);
current_argv);
optopt = 0;
return (BADCH);
}
if (idx)
*idx = match;
if (long_options[match].flag) {
*long_options[match].flag = long_options[match].val;
return (0);
} else
return (long_options[match].val);
}
/*
* getopt_internal --
* Parse argc/argv argument vector. Called by user level routines.
* Parse argc/argv argument vector. Called by user level routines.
*/
static int
getopt_internal(int nargc, char * const *nargv, const char *options,
const struct option *long_options, int *idx, int flags)
const struct option *long_options, int *idx, int flags)
{
char *oli; /* option letter list index */
int optchar, short_too;
int posixly_correct; /* no static, can be changed on the fly */
char *oli; /* option letter list index */
int optchar, short_too;
int posixly_correct; /* no static, can be changed on the fly */
if (options == NULL)
return (-1);
if (options == NULL)
return (-1);
/*
* Disable GNU extensions if POSIXLY_CORRECT is set or options
* string begins with a '+'.
*/
posixly_correct = (getenv("POSIXLY_CORRECT") != NULL);
/*
* Disable GNU extensions if POSIXLY_CORRECT is set or options
* string begins with a '+'.
*/
posixly_correct = (getenv("POSIXLY_CORRECT") != NULL);
#ifdef GNU_COMPATIBLE
if (*options == '-')
flags |= FLAG_ALLARGS;
else if (posixly_correct || *options == '+')
flags &= ~FLAG_PERMUTE;
if (*options == '-')
flags |= FLAG_ALLARGS;
else if (posixly_correct || *options == '+')
flags &= ~FLAG_PERMUTE;
#else
if (posixly_correct || *options == '+')
flags &= ~FLAG_PERMUTE;
else if (*options == '-')
flags |= FLAG_ALLARGS;
if (posixly_correct || *options == '+')
flags &= ~FLAG_PERMUTE;
else if (*options == '-')
flags |= FLAG_ALLARGS;
#endif
if (*options == '+' || *options == '-')
options++;
if (*options == '+' || *options == '-')
options++;
/*
* XXX Some GNU programs (like cvs) set optind to 0 instead of
* XXX using optreset. Work around this braindamage.
*/
if (optind == 0)
optind = optreset = 1;
/*
* XXX Some GNU programs (like cvs) set optind to 0 instead of
* XXX using optreset. Work around this braindamage.
*/
if (optind == 0)
optind = optreset = 1;
optarg = NULL;
if (optreset)
nonopt_start = nonopt_end = -1;
optarg = NULL;
if (optreset)
nonopt_start = nonopt_end = -1;
start:
if (optreset || !*place) { /* update scanning pointer */
optreset = 0;
if (optind >= nargc) { /* end of argument vector */
place = emsg;
if (nonopt_end != -1) {
/* do permutation, if we have to */
permute_args(nonopt_start, nonopt_end,
optind, nargv);
optind -= nonopt_end - nonopt_start;
}
else if (nonopt_start != -1) {
/*
* If we skipped non-options, set optind
* to the first of them.
*/
optind = nonopt_start;
}
nonopt_start = nonopt_end = -1;
return (-1);
}
if (*(place = nargv[optind]) != '-' ||
if (optreset || !*place) { /* update scanning pointer */
optreset = 0;
if (optind >= nargc) { /* end of argument vector */
place = emsg;
if (nonopt_end != -1) {
/* do permutation, if we have to */
permute_args(nonopt_start, nonopt_end,
optind, nargv);
optind -= nonopt_end - nonopt_start;
}
else if (nonopt_start != -1) {
/*
* If we skipped non-options, set optind
* to the first of them.
*/
optind = nonopt_start;
}
nonopt_start = nonopt_end = -1;
return (-1);
}
if (*(place = nargv[optind]) != '-' ||
#ifdef GNU_COMPATIBLE
place[1] == '\0') {
place[1] == '\0') {
#else
(place[1] == '\0' && strchr(options, '-') == NULL)) {
(place[1] == '\0' && strchr(options, '-') == NULL)) {
#endif
place = emsg; /* found non-option */
if (flags & FLAG_ALLARGS) {
/*
* GNU extension:
* return non-option as argument to option 1
*/
optarg = nargv[optind++];
return (INORDER);
}
if (!(flags & FLAG_PERMUTE)) {
/*
* If no permutation wanted, stop parsing
* at first non-option.
*/
return (-1);
}
/* do permutation */
if (nonopt_start == -1)
nonopt_start = optind;
else if (nonopt_end != -1) {
permute_args(nonopt_start, nonopt_end,
optind, nargv);
nonopt_start = optind -
(nonopt_end - nonopt_start);
nonopt_end = -1;
}
optind++;
/* process next argument */
goto start;
}
if (nonopt_start != -1 && nonopt_end == -1)
nonopt_end = optind;
place = emsg; /* found non-option */
if (flags & FLAG_ALLARGS) {
/*
* GNU extension:
* return non-option as argument to option 1
*/
optarg = nargv[optind++];
return (INORDER);
}
if (!(flags & FLAG_PERMUTE)) {
/*
* If no permutation wanted, stop parsing
* at first non-option.
*/
return (-1);
}
/* do permutation */
if (nonopt_start == -1)
nonopt_start = optind;
else if (nonopt_end != -1) {
permute_args(nonopt_start, nonopt_end,
optind, nargv);
nonopt_start = optind -
(nonopt_end - nonopt_start);
nonopt_end = -1;
}
optind++;
/* process next argument */
goto start;
}
if (nonopt_start != -1 && nonopt_end == -1)
nonopt_end = optind;
/*
* If we have "-" do nothing, if "--" we are done.
*/
if (place[1] != '\0' && *++place == '-' && place[1] == '\0') {
optind++;
place = emsg;
/*
* We found an option (--), so if we skipped
* non-options, we have to permute.
*/
if (nonopt_end != -1) {
permute_args(nonopt_start, nonopt_end,
optind, nargv);
optind -= nonopt_end - nonopt_start;
}
nonopt_start = nonopt_end = -1;
return (-1);
}
}
/*
* If we have "-" do nothing, if "--" we are done.
*/
if (place[1] != '\0' && *++place == '-' && place[1] == '\0') {
optind++;
place = emsg;
/*
* We found an option (--), so if we skipped
* non-options, we have to permute.
*/
if (nonopt_end != -1) {
permute_args(nonopt_start, nonopt_end,
optind, nargv);
optind -= nonopt_end - nonopt_start;
}
nonopt_start = nonopt_end = -1;
return (-1);
}
}
/*
* Check long options if:
* 1) we were passed some
* 2) the arg is not just "-"
* 3) either the arg starts with -- we are getopt_long_only()
*/
if (long_options != NULL && place != nargv[optind] &&
(*place == '-' || (flags & FLAG_LONGONLY))) {
short_too = 0;
/*
* Check long options if:
* 1) we were passed some
* 2) the arg is not just "-"
* 3) either the arg starts with -- we are getopt_long_only()
*/
if (long_options != NULL && place != nargv[optind] &&
(*place == '-' || (flags & FLAG_LONGONLY))) {
short_too = 0;
#ifdef GNU_COMPATIBLE
dash_prefix = D_PREFIX;
dash_prefix = D_PREFIX;
#endif
if (*place == '-') {
place++; /* --foo long option */
if (*place == '-') {
place++; /* --foo long option */
#ifdef GNU_COMPATIBLE
dash_prefix = DD_PREFIX;
dash_prefix = DD_PREFIX;
#endif
} else if (*place != ':' && strchr(options, *place) != NULL)
short_too = 1; /* could be short option too */
} else if (*place != ':' && strchr(options, *place) != NULL)
short_too = 1; /* could be short option too */
optchar = parse_long_options(nargv, options, long_options,
idx, short_too, flags);
if (optchar != -1) {
place = emsg;
return (optchar);
}
}
optchar = parse_long_options(nargv, options, long_options,
idx, short_too, flags);
if (optchar != -1) {
place = emsg;
return (optchar);
}
}
if ((optchar = (int)*place++) == (int)':' ||
(optchar == (int)'-' && *place != '\0') ||
(oli = strchr(options, optchar)) == NULL) {
/*
* If the user specified "-" and '-' isn't listed in
* options, return -1 (non-option) as per POSIX.
* Otherwise, it is an unknown option character (or ':').
*/
if (optchar == (int)'-' && *place == '\0')
return (-1);
if (!*place)
++optind;
if ((optchar = (int)*place++) == (int)':' ||
(optchar == (int)'-' && *place != '\0') ||
(oli = strchr(options, optchar)) == NULL) {
/*
* If the user specified "-" and '-' isn't listed in
* options, return -1 (non-option) as per POSIX.
* Otherwise, it is an unknown option character (or ':').
*/
if (optchar == (int)'-' && *place == '\0')
return (-1);
if (!*place)
++optind;
#ifdef GNU_COMPATIBLE
if (PRINT_ERROR)
warnx(posixly_correct ? illoptchar : gnuoptchar,
optchar);
if (PRINT_ERROR)
warnx(posixly_correct ? illoptchar : gnuoptchar,
optchar);
#else
if (PRINT_ERROR)
warnx(illoptchar, optchar);
if (PRINT_ERROR)
warnx(illoptchar, optchar);
#endif
optopt = optchar;
return (BADCH);
}
if (long_options != NULL && optchar == 'W' && oli[1] == ';') {
/* -W long-option */
if (*place) /* no space */
/* NOTHING */;
else if (++optind >= nargc) { /* no arg */
place = emsg;
if (PRINT_ERROR)
warnx(recargchar, optchar);
optopt = optchar;
return (BADARG);
} else /* white space */
place = nargv[optind];
optopt = optchar;
return (BADCH);
}
if (long_options != NULL && optchar == 'W' && oli[1] == ';') {
/* -W long-option */
if (*place) /* no space */
/* NOTHING */;
else if (++optind >= nargc) { /* no arg */
place = emsg;
if (PRINT_ERROR)
warnx(recargchar, optchar);
optopt = optchar;
return (BADARG);
} else /* white space */
place = nargv[optind];
#ifdef GNU_COMPATIBLE
dash_prefix = W_PREFIX;
dash_prefix = W_PREFIX;
#endif
optchar = parse_long_options(nargv, options, long_options,
idx, 0, flags);
place = emsg;
return (optchar);
}
if (*++oli != ':') { /* doesn't take argument */
if (!*place)
++optind;
} else { /* takes (optional) argument */
optarg = NULL;
if (*place) /* no white space */
optarg = place;
else if (oli[1] != ':') { /* arg not optional */
if (++optind >= nargc) { /* no arg */
place = emsg;
if (PRINT_ERROR)
warnx(recargchar, optchar);
optopt = optchar;
return (BADARG);
} else
optarg = nargv[optind];
}
place = emsg;
++optind;
}
/* dump back option letter */
return (optchar);
optchar = parse_long_options(nargv, options, long_options,
idx, 0, flags);
place = emsg;
return (optchar);
}
if (*++oli != ':') { /* doesn't take argument */
if (!*place)
++optind;
} else { /* takes (optional) argument */
optarg = NULL;
if (*place) /* no white space */
optarg = place;
else if (oli[1] != ':') { /* arg not optional */
if (++optind >= nargc) { /* no arg */
place = emsg;
if (PRINT_ERROR)
warnx(recargchar, optchar);
optopt = optchar;
return (BADARG);
} else
optarg = nargv[optind];
}
place = emsg;
++optind;
}
/* dump back option letter */
return (optchar);
}
#ifdef REPLACE_GETOPT
/*
* getopt --
* Parse argc/argv argument vector.
* Parse argc/argv argument vector.
*
* [eventually this will replace the BSD getopt]
*/
@ -596,40 +596,40 @@ int
getopt(int nargc, char * const *nargv, const char *options)
{
/*
* We don't pass FLAG_PERMUTE to getopt_internal() since
* the BSD getopt(3) (unlike GNU) has never done this.
*
* Furthermore, since many privileged programs call getopt()
* before dropping privileges it makes sense to keep things
* as simple (and bug-free) as possible.
*/
return (getopt_internal(nargc, nargv, options, NULL, NULL, 0));
/*
* We don't pass FLAG_PERMUTE to getopt_internal() since
* the BSD getopt(3) (unlike GNU) has never done this.
*
* Furthermore, since many privileged programs call getopt()
* before dropping privileges it makes sense to keep things
* as simple (and bug-free) as possible.
*/
return (getopt_internal(nargc, nargv, options, NULL, NULL, 0));
}
#endif /* REPLACE_GETOPT */
/*
* getopt_long --
* Parse argc/argv argument vector.
* Parse argc/argv argument vector.
*/
int
getopt_long(int nargc, char * const *nargv, const char *options,
const struct option *long_options, int *idx)
const struct option *long_options, int *idx)
{
return (getopt_internal(nargc, nargv, options, long_options, idx,
FLAG_PERMUTE));
return (getopt_internal(nargc, nargv, options, long_options, idx,
FLAG_PERMUTE));
}
/*
* getopt_long_only --
* Parse argc/argv argument vector.
* Parse argc/argv argument vector.
*/
int
getopt_long_only(int nargc, char * const *nargv, const char *options,
const struct option *long_options, int *idx)
const struct option *long_options, int *idx)
{
return (getopt_internal(nargc, nargv, options, long_options, idx,
FLAG_PERMUTE|FLAG_LONGONLY));
return (getopt_internal(nargc, nargv, options, long_options, idx,
FLAG_PERMUTE|FLAG_LONGONLY));
}

36
mps/code/mpm.h
View file

@ -474,8 +474,8 @@ extern double TraceWorkFactor;
END
extern Res TraceScanArea(ScanState ss, Word *base, Word *limit,
mps_area_scan_t scan_area,
void *closure, size_t closure_size);
mps_area_scan_t scan_area,
void *closure, size_t closure_size);
extern void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena,
Seg seg, Ref *refIO);
@ -948,25 +948,25 @@ extern void LDMerge(mps_ld_t ld, Arena arena, mps_ld_t from);
/* Root Interface -- see <code/root.c> */
extern Res RootCreateArea(Root *rootReturn, Arena arena,
Rank rank, RootMode mode,
Word *base, Word *limit,
mps_area_scan_t scan_area,
void *closure, size_t closure_size);
Rank rank, RootMode mode,
Word *base, Word *limit,
mps_area_scan_t scan_area,
void *closure, size_t closure_size);
extern Res RootCreateAreaTagged(Root *rootReturn, Arena arena,
Rank rank, RootMode mode,
Word *base, Word *limit,
mps_area_scan_t scan_area,
Word mask, Word pattern);
Rank rank, RootMode mode,
Word *base, Word *limit,
mps_area_scan_t scan_area,
Word mask, Word pattern);
extern Res RootCreateThread(Root *rootReturn, Arena arena,
Rank rank, Thread thread,
mps_area_scan_t scan_area,
void *closure, size_t closure_size,
Word *stackBot);
Rank rank, Thread thread,
mps_area_scan_t scan_area,
void *closure, size_t closure_size,
Word *stackBot);
extern Res RootCreateThreadTagged(Root *rootReturn, Arena arena,
Rank rank, Thread thread,
mps_area_scan_t scan_area,
Word mask, Word pattern,
Word *stackBot);
Rank rank, Thread thread,
mps_area_scan_t scan_area,
Word mask, Word pattern,
Word *stackBot);
extern Res RootCreateFmt(Root *rootReturn, Arena arena,
Rank rank, RootMode mode,
mps_fmt_scan_t scan,

54
mps/code/mps.h
View file

@ -110,7 +110,7 @@ typedef struct mps_scan_tag_s {
typedef mps_res_t (*mps_root_scan_t)(mps_ss_t, void *, size_t);
typedef mps_res_t (*mps_area_scan_t)(mps_ss_t, mps_word_t *, mps_word_t *,
void *, size_t);
void *, size_t);
typedef mps_res_t (*mps_fmt_scan_t)(mps_ss_t, mps_addr_t, mps_addr_t);
typedef mps_res_t (*mps_reg_scan_t)(mps_ss_t, mps_thr_t,
void *, size_t);
@ -676,20 +676,20 @@ extern mps_res_t mps_root_create_table(mps_root_t *, mps_arena_t,
mps_rank_t, mps_rm_t,
mps_addr_t *, size_t);
extern mps_res_t mps_root_create_table_tagged(mps_root_t *mps_root_o,
mps_arena_t arena,
mps_rank_t mps_rank, mps_rm_t mps_rm,
mps_addr_t *base, size_t size,
mps_area_scan_t scan_area,
mps_word_t mask,
mps_word_t pattern);
mps_arena_t arena,
mps_rank_t mps_rank, mps_rm_t mps_rm,
mps_addr_t *base, size_t size,
mps_area_scan_t scan_area,
mps_word_t mask,
mps_word_t pattern);
extern mps_res_t mps_root_create_table_masked(mps_root_t *, mps_arena_t,
mps_rank_t, mps_rm_t,
mps_addr_t *, size_t,
mps_word_t);
extern mps_res_t mps_root_create_area(mps_root_t *, mps_arena_t,
mps_rank_t, mps_rm_t,
mps_word_t *, mps_word_t *,
mps_area_scan_t, void *, size_t);
mps_rank_t, mps_rm_t,
mps_word_t *, mps_word_t *,
mps_area_scan_t, void *, size_t);
extern mps_res_t mps_root_create_fmt(mps_root_t *, mps_arena_t,
mps_rank_t, mps_rm_t,
mps_fmt_scan_t, mps_addr_t,
@ -698,17 +698,17 @@ extern mps_res_t mps_root_create_reg(mps_root_t *, mps_arena_t,
mps_rank_t, mps_rm_t, mps_thr_t,
mps_reg_scan_t, void *, size_t);
extern mps_res_t mps_root_create_thread(mps_root_t *, mps_arena_t,
mps_thr_t, void *);
mps_thr_t, void *);
extern mps_res_t mps_root_create_thread_scanned(mps_root_t *, mps_arena_t,
mps_rank_t, mps_rm_t, mps_thr_t,
mps_area_scan_t,
void *, size_t,
void *);
mps_rank_t, mps_rm_t, mps_thr_t,
mps_area_scan_t,
void *, size_t,
void *);
extern mps_res_t mps_root_create_thread_tagged(mps_root_t *, mps_arena_t,
mps_rank_t, mps_rm_t, mps_thr_t,
mps_area_scan_t,
mps_word_t, mps_word_t,
void *);
mps_rank_t, mps_rm_t, mps_thr_t,
mps_area_scan_t,
mps_word_t, mps_word_t,
void *);
extern void mps_root_destroy(mps_root_t);
extern mps_res_t mps_stack_scan_ambig(mps_ss_t, mps_thr_t,
@ -823,17 +823,17 @@ extern void mps_pool_check_free_space(mps_pool_t);
/* Scanner Support */
extern mps_res_t mps_scan_area(mps_ss_t,
mps_word_t *, mps_word_t *,
void *, size_t);
mps_word_t *, mps_word_t *,
void *, size_t);
extern mps_res_t mps_scan_area_masked(mps_ss_t,
mps_word_t *, mps_word_t *,
void *, size_t);
mps_word_t *, mps_word_t *,
void *, size_t);
extern mps_res_t mps_scan_area_tagged(mps_ss_t,
mps_word_t *, mps_word_t *,
void *, size_t);
mps_word_t *, mps_word_t *,
void *, size_t);
extern mps_res_t mps_scan_area_tagged_or_zero(mps_ss_t,
mps_word_t *, mps_word_t *,
void *, size_t);
mps_word_t *, mps_word_t *,
void *, size_t);
extern mps_res_t mps_fix(mps_ss_t, mps_addr_t *);

98
mps/code/mpsi.c
View file

@ -1301,8 +1301,8 @@ mps_res_t mps_root_create_table(mps_root_t *mps_root_o, mps_arena_t arena,
void *. */
res = RootCreateArea(&root, arena, rank, mode,
(void *)base, (void *)(base + size),
mps_scan_area, NULL, 0);
(void *)base, (void *)(base + size),
mps_scan_area, NULL, 0);
ArenaLeave(arena);
@ -1313,11 +1313,11 @@ mps_res_t mps_root_create_table(mps_root_t *mps_root_o, mps_arena_t arena,
}
mps_res_t mps_root_create_area(mps_root_t *mps_root_o,
mps_arena_t arena,
mps_rank_t mps_rank, mps_rm_t mps_rm,
mps_word_t *base, mps_word_t *limit,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_arena_t arena,
mps_rank_t mps_rank, mps_rm_t mps_rm,
mps_word_t *base, mps_word_t *limit,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
Rank rank = (Rank)mps_rank;
Root root;
@ -1334,8 +1334,8 @@ mps_res_t mps_root_create_area(mps_root_t *mps_root_o,
/* Can't check anything about closure */
res = RootCreateArea(&root, arena, rank, mode,
base, limit,
scan_area, closure, closure_size);
base, limit,
scan_area, closure, closure_size);
ArenaLeave(arena);
@ -1349,9 +1349,9 @@ mps_res_t mps_root_create_table_tagged(mps_root_t *mps_root_o,
mps_arena_t arena,
mps_rank_t mps_rank, mps_rm_t mps_rm,
mps_addr_t *base, size_t size,
mps_area_scan_t scan_area,
mps_area_scan_t scan_area,
mps_word_t mask,
mps_word_t pattern)
mps_word_t pattern)
{
Rank rank = (Rank)mps_rank;
Root root;
@ -1369,8 +1369,8 @@ mps_res_t mps_root_create_table_tagged(mps_root_t *mps_root_o,
/* .root.table-size */
res = RootCreateAreaTagged(&root, arena, rank, mode,
(void *)base, (void *)(base + size),
scan_area, mask, pattern);
(void *)base, (void *)(base + size),
scan_area, mask, pattern);
ArenaLeave(arena);
@ -1387,8 +1387,8 @@ mps_res_t mps_root_create_table_masked(mps_root_t *mps_root_o,
mps_word_t mask)
{
return mps_root_create_table_tagged(mps_root_o, arena, mps_rank, mps_rm,
base, size, mps_scan_area_tagged,
mask, 0);
base, size, mps_scan_area_tagged,
mask, 0);
}
mps_res_t mps_root_create_fmt(mps_root_t *mps_root_o, mps_arena_t arena,
@ -1437,9 +1437,9 @@ mps_res_t mps_root_create_reg(mps_root_t *mps_root_o, mps_arena_t arena,
/* See .root-mode. */
res = RootCreateThreadTagged(&root, arena, rank, thread,
mps_scan_area_tagged,
sizeof(mps_word_t) - 1, 0,
(Word *)stack);
mps_scan_area_tagged,
sizeof(mps_word_t) - 1, 0,
(Word *)stack);
ArenaLeave(arena);
@ -1451,31 +1451,31 @@ mps_res_t mps_root_create_reg(mps_root_t *mps_root_o, mps_arena_t arena,
mps_res_t mps_root_create_thread(mps_root_t *mps_root_o,
mps_arena_t arena,
mps_thr_t thread,
void *stack)
mps_arena_t arena,
mps_thr_t thread,
void *stack)
{
return mps_root_create_thread_tagged(mps_root_o,
arena,
mps_rank_ambig(),
(mps_rm_t)0,
thread,
mps_scan_area_tagged,
sizeof(mps_word_t) - 1,
0,
stack);
arena,
mps_rank_ambig(),
(mps_rm_t)0,
thread,
mps_scan_area_tagged,
sizeof(mps_word_t) - 1,
0,
stack);
}
mps_res_t mps_root_create_thread_scanned(mps_root_t *mps_root_o,
mps_arena_t arena,
mps_rank_t mps_rank,
mps_rm_t mps_rm,
mps_thr_t thread,
mps_area_scan_t scan_area,
void *closure,
size_t closure_size,
void *stack)
mps_arena_t arena,
mps_rank_t mps_rank,
mps_rm_t mps_rm,
mps_thr_t thread,
mps_area_scan_t scan_area,
void *closure,
size_t closure_size,
void *stack)
{
Rank rank = (Rank)mps_rank;
Root root;
@ -1493,8 +1493,8 @@ mps_res_t mps_root_create_thread_scanned(mps_root_t *mps_root_o,
/* See .root-mode. */
res = RootCreateThread(&root, arena, rank, thread,
scan_area, closure, closure_size,
(Word *)stack);
scan_area, closure, closure_size,
(Word *)stack);
ArenaLeave(arena);
@ -1506,14 +1506,14 @@ mps_res_t mps_root_create_thread_scanned(mps_root_t *mps_root_o,
mps_res_t mps_root_create_thread_tagged(mps_root_t *mps_root_o,
mps_arena_t arena,
mps_rank_t mps_rank,
mps_rm_t mps_rm,
mps_thr_t thread,
mps_area_scan_t scan_area,
mps_word_t mask,
mps_word_t pattern,
void *stack)
mps_arena_t arena,
mps_rank_t mps_rank,
mps_rm_t mps_rm,
mps_thr_t thread,
mps_area_scan_t scan_area,
mps_word_t mask,
mps_word_t pattern,
void *stack)
{
Rank rank = (Rank)mps_rank;
Root root;
@ -1531,8 +1531,8 @@ mps_res_t mps_root_create_thread_tagged(mps_root_t *mps_root_o,
/* See .root-mode. */
res = RootCreateThreadTagged(&root, arena, rank, thread,
scan_area, mask, pattern,
(Word *)stack);
scan_area, mask, pattern,
(Word *)stack);
ArenaLeave(arena);

4
mps/code/prmci3fr.c
View file

@ -39,8 +39,8 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc)
Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
Res res;

10
mps/code/prmci3li.c
View file

@ -102,8 +102,8 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc)
Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
mcontext_t *mc;
Res res;
@ -113,9 +113,9 @@ Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
to scan only relevant parts would be machine dependent. */
mc = &mfc->ucontext->uc_mcontext;
res = TraceScanArea(ss,
(Word *)mc,
(Word *)((char *)mc + sizeof(*mc)),
scan_area, closure, closure_size);
(Word *)mc,
(Word *)((char *)mc + sizeof(*mc)),
scan_area, closure, closure_size);
return res;
}

10
mps/code/prmci3xc.c
View file

@ -97,8 +97,8 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc)
Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
x86_thread_state32_t *mc;
Res res;
@ -108,9 +108,9 @@ Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
to scan only relevant parts would be machine dependent. */
mc = mfc->threadState;
res = TraceScanArea(ss,
(Word *)mc,
(Word *)((char *)mc + sizeof(*mc)),
scan_area, closure, closure_size);
(Word *)mc,
(Word *)((char *)mc + sizeof(*mc)),
scan_area, closure, closure_size);
return res;
}

4
mps/code/prmci6fr.c
View file

@ -33,8 +33,8 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc)
Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
Res res;

10
mps/code/prmci6li.c
View file

@ -106,8 +106,8 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc)
Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
mcontext_t *mc;
Res res;
@ -117,9 +117,9 @@ Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
to scan only relevant parts would be machine dependent. */
mc = &mfc->ucontext->uc_mcontext;
res = TraceScanArea(ss,
(Word *)mc,
(Word *)((char *)mc + sizeof(*mc)),
scan_area, closure, closure_size);
(Word *)mc,
(Word *)((char *)mc + sizeof(*mc)),
scan_area, closure, closure_size);
return res;
}

10
mps/code/prmci6xc.c
View file

@ -100,8 +100,8 @@ Addr MutatorFaultContextSP(MutatorFaultContext mfc)
Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
x86_thread_state64_t *mc;
Res res;
@ -111,9 +111,9 @@ Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
to scan only relevant parts would be machine dependent. */
mc = mfc->threadState;
res = TraceScanArea(ss,
(Word *)mc,
(Word *)((char *)mc + sizeof(*mc)),
scan_area, closure, closure_size);
(Word *)mc,
(Word *)((char *)mc + sizeof(*mc)),
scan_area, closure, closure_size);
return res;
}

4
mps/code/prot.h
View file

@ -31,8 +31,8 @@ extern Bool ProtCanStepInstruction(MutatorFaultContext context);
extern Res ProtStepInstruction(MutatorFaultContext context);
extern Addr MutatorFaultContextSP(MutatorFaultContext mfc);
extern Res MutatorFaultContextScan(ScanState ss, MutatorFaultContext mfc,
mps_area_scan_t scan,
void *closure, size_t closure_size);
mps_area_scan_t scan,
void *closure, size_t closure_size);
#endif /* prot_h */

78
mps/code/root.c
View file

@ -266,10 +266,10 @@ static Res rootCreateProtectable(Root *rootReturn, Arena arena,
}
Res RootCreateArea(Root *rootReturn, Arena arena,
Rank rank, RootMode mode,
Word *base, Word *limit,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
Rank rank, RootMode mode,
Word *base, Word *limit,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
Res res;
union RootUnion theUnion;
@ -297,7 +297,7 @@ Res RootCreateArea(Root *rootReturn, Arena arena,
Res RootCreateAreaTagged(Root *rootReturn, Arena arena,
Rank rank, RootMode mode, Word *base, Word *limit,
mps_area_scan_t scan_area, Word mask, Word pattern)
mps_area_scan_t scan_area, Word mask, Word pattern)
{
union RootUnion theUnion;
@ -320,10 +320,10 @@ Res RootCreateAreaTagged(Root *rootReturn, Arena arena,
}
Res RootCreateThread(Root *rootReturn, Arena arena,
Rank rank, Thread thread,
mps_area_scan_t scan_area,
void *closure, size_t closure_size,
Word *stackBot)
Rank rank, Thread thread,
mps_area_scan_t scan_area,
void *closure, size_t closure_size,
Word *stackBot)
{
union RootUnion theUnion;
@ -346,10 +346,10 @@ Res RootCreateThread(Root *rootReturn, Arena arena,
}
Res RootCreateThreadTagged(Root *rootReturn, Arena arena,
Rank rank, Thread thread,
mps_area_scan_t scan_area,
Word mask, Word pattern,
Word *stackBot)
Rank rank, Thread thread,
mps_area_scan_t scan_area,
Word mask, Word pattern,
Word *stackBot)
{
union RootUnion theUnion;
@ -526,11 +526,11 @@ Res RootScan(ScanState ss, Root root)
switch(root->var) {
case RootAREA:
res = TraceScanArea(ss,
root->the.area.base,
root->the.area.limit,
root->the.area.scan_area,
root->the.area.the.closure.p,
root->the.area.the.closure.s);
root->the.area.base,
root->the.area.limit,
root->the.area.scan_area,
root->the.area.the.closure.p,
root->the.area.the.closure.s);
ss->scannedSize += AddrOffset(root->the.area.base, root->the.area.limit);
if (res != ResOK)
goto failScan;
@ -538,11 +538,11 @@ Res RootScan(ScanState ss, Root root)
case RootAREA_TAGGED:
res = TraceScanArea(ss,
root->the.area.base,
root->the.area.limit,
root->the.area.scan_area,
&root->the.area.the.tag,
sizeof(root->the.area.the.tag));
root->the.area.base,
root->the.area.limit,
root->the.area.scan_area,
&root->the.area.the.tag,
sizeof(root->the.area.the.tag));
ss->scannedSize += AddrOffset(root->the.area.base, root->the.area.limit);
if (res != ResOK)
goto failScan;
@ -557,9 +557,9 @@ Res RootScan(ScanState ss, Root root)
case RootTHREAD:
res = ThreadScan(ss, root->the.thread.thread,
root->the.thread.stackBot,
root->the.thread.scan_area,
root->the.thread.the.closure.p,
root->the.thread.the.closure.s);
root->the.thread.scan_area,
root->the.thread.the.closure.p,
root->the.thread.the.closure.s);
if (res != ResOK)
goto failScan;
break;
@ -567,9 +567,9 @@ Res RootScan(ScanState ss, Root root)
case RootTHREAD_TAGGED:
res = ThreadScan(ss, root->the.thread.thread,
root->the.thread.stackBot,
root->the.thread.scan_area,
&root->the.thread.the.tag,
sizeof(root->the.thread.the.tag));
root->the.thread.scan_area,
&root->the.thread.the.tag,
sizeof(root->the.thread.the.tag));
if (res != ResOK)
goto failScan;
break;
@ -703,8 +703,8 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
"area base $A limit $A scan_area closure $P closure_size $U\n",
(WriteFA)root->the.area.base,
(WriteFA)root->the.area.limit,
(WriteFP)root->the.area.the.closure.p,
(WriteFP)root->the.area.the.closure.s,
(WriteFP)root->the.area.the.closure.p,
(WriteFP)root->the.area.the.closure.s,
NULL);
if (res != ResOK)
return res;
@ -716,7 +716,7 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
(WriteFA)root->the.area.base,
(WriteFA)root->the.area.limit,
(WriteFB)root->the.area.the.tag.mask,
(WriteFB)root->the.area.the.tag.pattern,
(WriteFB)root->the.area.the.tag.pattern,
NULL);
if (res != ResOK)
return res;
@ -735,10 +735,10 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
case RootTHREAD:
res = WriteF(stream, depth + 2,
"thread $P\n", (WriteFP)root->the.thread.thread,
"closure $P size $U\n",
(WriteFP)root->the.thread.the.closure.p,
(WriteFU)root->the.thread.the.closure.s,
"stackBot $P\n", (WriteFP)root->the.thread.stackBot,
"closure $P size $U\n",
(WriteFP)root->the.thread.the.closure.p,
(WriteFU)root->the.thread.the.closure.s,
"stackBot $P\n", (WriteFP)root->the.thread.stackBot,
NULL);
if (res != ResOK)
return res;
@ -747,9 +747,9 @@ Res RootDescribe(Root root, mps_lib_FILE *stream, Count depth)
case RootTHREAD_TAGGED:
res = WriteF(stream, depth + 2,
"thread $P\n", (WriteFP)root->the.thread.thread,
"mask $B\n", (WriteFB)root->the.thread.the.tag.mask,
"pattern $B\n", (WriteFB)root->the.thread.the.tag.pattern,
"stackBot $P\n", (WriteFP)root->the.thread.stackBot,
"mask $B\n", (WriteFB)root->the.thread.the.tag.mask,
"pattern $B\n", (WriteFB)root->the.thread.the.tag.pattern,
"stackBot $P\n", (WriteFP)root->the.thread.stackBot,
NULL);
if (res != ResOK)
return res;

10
mps/code/ss.c
View file

@ -26,8 +26,8 @@ SRCID(ss, "$Id$");
Res StackScanInner(ScanState ss, Word *stackBot, Word *stackTop,
Count nSavedRegs,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
Arena arena;
Res res;
@ -50,16 +50,16 @@ Res StackScanInner(ScanState ss, Word *stackBot, Word *stackTop,
AVER(stackTop < arena->stackAtArenaEnter);
AVER(arena->stackAtArenaEnter < stackBot);
res = TraceScanArea(ss, stackTop, stackTop + nSavedRegs,
scan_area, closure, closure_size);
scan_area, closure, closure_size);
if (res != ResOK)
return res;
res = TraceScanArea(ss, arena->stackAtArenaEnter, stackBot,
scan_area, closure, closure_size);
scan_area, closure, closure_size);
if (res != ResOK)
return res;
} else {
res = TraceScanArea(ss, stackTop, stackBot,
scan_area, closure, closure_size);
scan_area, closure, closure_size);
if (res != ResOK)
return res;
}

6
mps/code/ss.h
View file

@ -33,11 +33,11 @@
*/
extern Res StackScan(ScanState ss, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size);
mps_area_scan_t scan_area,
void *closure, size_t closure_size);
extern Res StackScanInner(ScanState ss, Word *stackBot, Word *stackTop,
Count nSavedRegs, mps_area_scan_t scan_area,
void *closure, size_t closure_s);
void *closure, size_t closure_s);
#endif /* ss_h */

6
mps/code/ssan.c
View file

@ -22,8 +22,8 @@ SRCID(ssan, "$Id$");
Res StackScan(ScanState ss, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
jmp_buf jb;
Word *stackTop = (Word *)&jb;
@ -38,7 +38,7 @@ Res StackScan(ScanState ss, Word *stackBot,
(void)setjmp(jb);
return StackScanInner(ss, stackBot, stackTop, sizeof jb / sizeof(Word),
scan_area, closure, closure_size);
scan_area, closure, closure_size);
}

6
mps/code/ssixi3.c
View file

@ -50,8 +50,8 @@ SRCID(ssixi3, "$Id$");
Res StackScan(ScanState ss, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
Word calleeSaveRegs[4];
@ -65,7 +65,7 @@ Res StackScan(ScanState ss, Word *stackBot,
ASMV("mov %%ebp, %0" : "=m" (calleeSaveRegs[3]));
return StackScanInner(ss, stackBot, calleeSaveRegs, NELEMS(calleeSaveRegs),
scan_area, closure, closure_size);
scan_area, closure, closure_size);
}

6
mps/code/ssixi6.c
View file

@ -48,8 +48,8 @@ SRCID(ssixi6, "$Id$");
Res StackScan(ScanState ss, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
Word calleeSaveRegs[6];
@ -65,7 +65,7 @@ Res StackScan(ScanState ss, Word *stackBot,
ASMV("mov %%r15, %0" : "=m" (calleeSaveRegs[5]));
return StackScanInner(ss, stackBot, calleeSaveRegs, NELEMS(calleeSaveRegs),
scan_area, closure, closure_size);
scan_area, closure, closure_size);
}

6
mps/code/ssw3i3mv.c
View file

@ -23,8 +23,8 @@ SRCID(ssw3i3mv, "$Id$");
Res StackScan(ScanState ss, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
jmp_buf jb;
@ -45,7 +45,7 @@ Res StackScan(ScanState ss, Word *stackBot,
AVER(offsetof(_JUMP_BUFFER, Esi) == offsetof(_JUMP_BUFFER, Ebx) + 8);
return StackScanInner(ss, stackBot, (Word *)&((_JUMP_BUFFER *)jb)->Ebx, 3,
scan_area, closure, closure_size);
scan_area, closure, closure_size);
}
/* C. COPYRIGHT AND LICENSE

6
mps/code/ssw3i3pc.c
View file

@ -47,8 +47,8 @@ typedef struct __JUMP_BUFFER {
Res StackScan(ScanState ss, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
jmp_buf jb;
@ -68,7 +68,7 @@ Res StackScan(ScanState ss, Word *stackBot,
AVER(offsetof(_JUMP_BUFFER, Esi) == offsetof(_JUMP_BUFFER, Ebx) + 8);
return StackScanInner(ss, stackBot, (Word *)&((_JUMP_BUFFER *)jb)->Ebx, 3,
scan_area, closure, closure_size);
scan_area, closure, closure_size);
}

6
mps/code/ssw3i6mv.c
View file

@ -31,8 +31,8 @@ SRCID(ssw3i6mv, "$Id$");
Res StackScan(ScanState ss, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
jmp_buf jb;
@ -64,7 +64,7 @@ Res StackScan(ScanState ss, Word *stackBot,
AVER(offsetof(_JUMP_BUFFER, R15) == offsetof(_JUMP_BUFFER, Rbx) + 64);
return StackScanInner(ss, stackBot, (Word *)&((_JUMP_BUFFER *)jb)->Rbx, 9,
scan_area, closure, closure_size);
scan_area, closure, closure_size);
}
/* C. COPYRIGHT AND LICENSE

12
mps/code/tagtest.c
View file

@ -170,17 +170,17 @@ static void test(int mode)
case MODE_CONS:
/* Scan words tagged "cons" -- everything will live. */
die(mps_root_create_table_tagged(&root, arena, mps_rank_ambig(), 0,
refs, OBJCOUNT,
mps_scan_area_tagged, TAG_MASK, tag_cons),
"root");
refs, OBJCOUNT,
mps_scan_area_tagged, TAG_MASK, tag_cons),
"root");
expected = 0;
break;
case MODE_INVALID:
/* Scan words tagged "invalid" -- everything will die. */
die(mps_root_create_table_tagged(&root, arena, mps_rank_ambig(), 0,
refs, OBJCOUNT,
mps_scan_area_tagged, TAG_MASK, tag_invalid),
"root");
refs, OBJCOUNT,
mps_scan_area_tagged, TAG_MASK, tag_invalid),
"root");
expected = OBJCOUNT;
break;
}

4
mps/code/th.h
View file

@ -69,8 +69,8 @@ extern Thread ThreadRingThread(Ring threadRing);
extern Arena ThreadArena(Thread thread);
extern Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size);
mps_area_scan_t scan_area,
void *closure, size_t closure_size);
#endif /* th_h */

4
mps/code/than.c
View file

@ -118,8 +118,8 @@ Arena ThreadArena(Thread thread)
Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
UNUSED(thread);
return StackScan(ss, stackBot, scan_area, closure, closure_size);

6
mps/code/thix.c
View file

@ -240,8 +240,8 @@ Arena ThreadArena(Thread thread)
/* ThreadScan -- scan the state of a thread (stack and regs) */
Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
pthread_t self;
Res res;
@ -273,7 +273,7 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
* stackBot (.stack.full-descend)
*/
res = TraceScanArea(ss, stackBase, stackLimit,
scan_area, closure, closure_size);
scan_area, closure, closure_size);
if(res != ResOK)
return res;

10
mps/code/thw3i3.c
View file

@ -68,8 +68,8 @@ SRCID(thw3i3, "$Id$");
Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
DWORD id;
Res res;
@ -107,7 +107,7 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
* stackBot (.stack.full-descend)
*/
res = TraceScanArea(ss, stackBase, stackLimit,
scan_area, closure, closure_size);
scan_area, closure, closure_size);
if(res != ResOK)
return res;
@ -117,8 +117,8 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
* to scan only relevant parts would be machine dependent.
*/
res = TraceScanArea(ss, (Word *)&context,
(Word *)((char *)&context + sizeof(CONTEXT)),
scan_area, closure, closure_size);
(Word *)((char *)&context + sizeof(CONTEXT)),
scan_area, closure, closure_size);
if(res != ResOK)
return res;

8
mps/code/thw3i6.c
View file

@ -69,7 +69,7 @@ SRCID(thw3i6, "$Id$");
Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
void *closure, size_t closure_size)
{
DWORD id;
Res res;
@ -107,7 +107,7 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
* stackBot (.stack.full-descend)
*/
res = TraceScanArea(ss, stackBase, stackLimit,
scan_area, closure, closure_size);
scan_area, closure, closure_size);
if(res != ResOK)
return res;
@ -117,8 +117,8 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
* to scan only relevant parts would be machine dependent.
*/
res = TraceScanArea(ss, (Word *)&context,
(Word *)((char *)&context + sizeof(CONTEXT)),
scan_area, closure, closure_size);
(Word *)((char *)&context + sizeof(CONTEXT)),
scan_area, closure, closure_size);
if(res != ResOK)
return res;

6
mps/code/thxc.c
View file

@ -211,8 +211,8 @@ Arena ThreadArena(Thread thread)
#include "prmcxc.h"
Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
mach_port_t self;
Res res;
@ -261,7 +261,7 @@ Res ThreadScan(ScanState ss, Thread thread, Word *stackBot,
* stackBot (.stack.full-descend)
*/
res = TraceScanArea(ss, stackBase, stackLimit,
scan_area, closure, closure_size);
scan_area, closure, closure_size);
if(res != ResOK)
return res;

4
mps/code/trace.c
View file

@ -1427,8 +1427,8 @@ void TraceScanSingleRef(TraceSet ts, Rank rank, Arena arena,
* limit, inclusive of base and exclusive of limit. */
Res TraceScanArea(ScanState ss, Word *base, Word *limit,
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
mps_area_scan_t scan_area,
void *closure, size_t closure_size)
{
AVERT(ScanState, ss);
AVER(base != NULL);

4
mps/code/zcoll.c
View file

@ -575,7 +575,7 @@ static void StackScan(mps_arena_t arena, int on)
if(on) {
Insist(root_stackreg == NULL);
die(mps_root_create_thread(&root_stackreg, arena,
stack_thr, stack_start),
stack_thr, stack_start),
"root_stackreg");
Insist(root_stackreg != NULL);
} else {
@ -762,7 +762,7 @@ static void *testscriptB(void *arg, size_t s)
stack_start = &stack_starts_here;
stack_thr = thr;
die(mps_root_create_thread(&root_stackreg, arena,
stack_thr, stack_start),
stack_thr, stack_start),
"root_stackreg");

2
mps/code/zmess.c
View file

@ -331,7 +331,7 @@ static void *testscriptB(void *arg, size_t s)
/* root_stackreg: stack & registers are ambiguous roots = mutator's workspace */
die(mps_root_create_thread(&root_stackreg, arena,
thr, &stack_starts_here),
thr, &stack_starts_here),
"root_stackreg");
/* Make myrootCOUNT registered-for-finalization objects. */

118
mps/example/scheme/scheme-advanced.c
View file

@ -53,17 +53,17 @@
/* LANGUAGE EXTENSION */
#define unless(c) if(!(c))
#define LENGTH(array) (sizeof(array) / sizeof(array[0]))
#define unless(c) if(!(c))
#define LENGTH(array) (sizeof(array) / sizeof(array[0]))
#define UNUSED(var) ((void)var)
/* CONFIGURATION PARAMETERS */
#define SYMMAX ((size_t)255) /* max length of a symbol */
#define MSGMAX ((size_t)255) /* max length of error message */
#define STRMAX ((size_t)255) /* max length of a string */
#define SYMMAX ((size_t)255) /* max length of a symbol */
#define MSGMAX ((size_t)255) /* max length of error message */
#define STRMAX ((size_t)255) /* max length of a string */
/* DATA TYPES */
@ -116,54 +116,54 @@ typedef struct type_s {
} type_s;
typedef struct pair_s {
type_t type; /* TYPE_PAIR */
obj_t car, cdr; /* first and second projections */
type_t type; /* TYPE_PAIR */
obj_t car, cdr; /* first and second projections */
} pair_s;
typedef struct symbol_s {
type_t type; /* TYPE_SYMBOL */
type_t type; /* TYPE_SYMBOL */
obj_t name; /* its name (a string) */
} symbol_s;
typedef struct integer_s {
type_t type; /* TYPE_INTEGER */
long integer; /* the integer */
type_t type; /* TYPE_INTEGER */
long integer; /* the integer */
} integer_s;
typedef struct special_s {
type_t type; /* TYPE_SPECIAL */
const char *name; /* printed representation, NUL terminated */
type_t type; /* TYPE_SPECIAL */
const char *name; /* printed representation, NUL terminated */
} special_s;
typedef struct operator_s {
type_t type; /* TYPE_OPERATOR */
const char *name; /* printed name, NUL terminated */
entry_t entry; /* entry point -- see eval() */
obj_t arguments, body; /* function arguments and code */
obj_t env, op_env; /* closure environments */
type_t type; /* TYPE_OPERATOR */
const char *name; /* printed name, NUL terminated */
entry_t entry; /* entry point -- see eval() */
obj_t arguments, body; /* function arguments and code */
obj_t env, op_env; /* closure environments */
} operator_s;
typedef struct string_s {
type_t type; /* TYPE_STRING */
size_t length; /* number of chars in string */
char string[1]; /* string, NUL terminated */
type_t type; /* TYPE_STRING */
size_t length; /* number of chars in string */
char string[1]; /* string, NUL terminated */
} string_s;
typedef struct port_s {
type_t type; /* TYPE_PORT */
obj_t name; /* name of stream */
type_t type; /* TYPE_PORT */
obj_t name; /* name of stream */
FILE *stream;
} port_s;
typedef struct character_s {
type_t type; /* TYPE_CHARACTER */
char c; /* the character */
type_t type; /* TYPE_CHARACTER */
char c; /* the character */
} character_s;
typedef struct vector_s {
type_t type; /* TYPE_VECTOR */
size_t length; /* number of elements */
obj_t vector[1]; /* vector elements */
type_t type; /* TYPE_VECTOR */
size_t length; /* number of elements */
obj_t vector[1]; /* vector elements */
} vector_s;
/* %%MPS: Objects in AWL pools must be formatted so that aligned
@ -241,7 +241,7 @@ typedef struct pad_s {
typedef union obj_u {
type_s type; /* one of TYPE_* */
type_s type; /* one of TYPE_* */
pair_s pair;
symbol_s symbol;
integer_s integer;
@ -260,17 +260,17 @@ typedef union obj_u {
/* structure macros */
#define TYPE(obj) ((obj)->type.type)
#define CAR(obj) ((obj)->pair.car)
#define CDR(obj) ((obj)->pair.cdr)
#define CAAR(obj) CAR(CAR(obj))
#define CADR(obj) CAR(CDR(obj))
#define CDAR(obj) CDR(CAR(obj))
#define CDDR(obj) CDR(CDR(obj))
#define CADDR(obj) CAR(CDDR(obj))
#define CDDDR(obj) CDR(CDDR(obj))
#define CDDAR(obj) CDR(CDAR(obj))
#define CADAR(obj) CAR(CDAR(obj))
#define TYPE(obj) ((obj)->type.type)
#define CAR(obj) ((obj)->pair.car)
#define CDR(obj) ((obj)->pair.cdr)
#define CAAR(obj) CAR(CAR(obj))
#define CADR(obj) CAR(CDR(obj))
#define CDAR(obj) CDR(CAR(obj))
#define CDDR(obj) CDR(CDR(obj))
#define CADDR(obj) CAR(CDDR(obj))
#define CDDDR(obj) CDR(CDDR(obj))
#define CDDAR(obj) CDR(CDAR(obj))
#define CADAR(obj) CAR(CDAR(obj))
/* GLOBAL DATA */
@ -305,12 +305,12 @@ static mps_root_t symtab_root;
* See `globals_scan`.
*/
static obj_t obj_empty; /* (), the empty list */
static obj_t obj_eof; /* end of file */
static obj_t obj_error; /* error indicator */
static obj_t obj_true; /* #t, boolean true */
static obj_t obj_false; /* #f, boolean false */
static obj_t obj_undefined; /* undefined result indicator */
static obj_t obj_empty; /* (), the empty list */
static obj_t obj_eof; /* end of file */
static obj_t obj_error; /* error indicator */
static obj_t obj_true; /* #t, boolean true */
static obj_t obj_false; /* #f, boolean false */
static obj_t obj_undefined; /* undefined result indicator */
static obj_t obj_tail; /* tail recursion indicator */
static obj_t obj_deleted; /* deleted key in hashtable */
static obj_t obj_unused; /* unused entry in hashtable */
@ -323,13 +323,13 @@ static obj_t obj_unused; /* unused entry in hashtable */
* Scheme language, and are used by the evaluator to parse code.
*/
static obj_t obj_quote; /* "quote" symbol */
static obj_t obj_quasiquote; /* "quasiquote" symbol */
static obj_t obj_lambda; /* "lambda" symbol */
static obj_t obj_begin; /* "begin" symbol */
static obj_t obj_else; /* "else" symbol */
static obj_t obj_unquote; /* "unquote" symbol */
static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */
static obj_t obj_quote; /* "quote" symbol */
static obj_t obj_quasiquote; /* "quasiquote" symbol */
static obj_t obj_lambda; /* "lambda" symbol */
static obj_t obj_begin; /* "begin" symbol */
static obj_t obj_else; /* "else" symbol */
static obj_t obj_unquote; /* "unquote" symbol */
static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */
/* error handler
@ -1322,13 +1322,13 @@ static obj_t read_special(FILE *stream, int c)
switch(tolower(c)) {
case 't': return obj_true;
case 'f': return obj_false;
case '\\': { /* character (R4RS 6.6) */
case '\\': { /* character (R4RS 6.6) */
c = getc(stream);
if(c == EOF)
error("read: end of file reading character literal");
return make_character((char)c);
}
case '(': { /* vector (R4RS 6.8) */
case '(': { /* vector (R4RS 6.8) */
obj_t list = read_list(stream, c);
obj_t vector = list_to_vector(list);
if(vector == obj_error)
@ -1429,7 +1429,7 @@ static obj_t lookup(obj_t env, obj_t symbol)
static void define(obj_t env, obj_t symbol, obj_t value)
{
obj_t binding;
assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */
assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */
binding = lookup_in_frame(CAR(env), symbol);
if(binding != obj_undefined)
CDR(binding) = value;
@ -1848,7 +1848,7 @@ static obj_t entry_let(obj_t env, obj_t op_env, obj_t operator, obj_t operands)
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -1875,7 +1875,7 @@ static obj_t entry_let_star(obj_t env, obj_t op_env, obj_t operator, obj_t opera
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -1902,7 +1902,7 @@ static obj_t entry_letrec(obj_t env, obj_t op_env, obj_t operator, obj_t operand
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -2626,7 +2626,7 @@ static obj_t entry_divide(obj_t env, obj_t op_env, obj_t operator, obj_t operand
if(args == obj_empty) {
if(result == 0)
error("%s: reciprocal of zero", operator->operator.name);
result = 1/result; /* TODO: pretty meaningless for integers */
result = 1/result; /* TODO: pretty meaningless for integers */
} else {
while(TYPE(args) == TYPE_PAIR) {
unless(TYPE(CAR(args)) == TYPE_INTEGER)

134
mps/example/scheme/scheme-boehm.c
View file

@ -25,16 +25,16 @@
/* LANGUAGE EXTENSION */
#define unless(c) if(!(c))
#define LENGTH(array) (sizeof(array) / sizeof(array[0]))
#define unless(c) if(!(c))
#define LENGTH(array) (sizeof(array) / sizeof(array[0]))
/* CONFIGURATION PARAMETERS */
#define SYMMAX ((size_t)255) /* max length of a symbol */
#define MSGMAX ((size_t)255) /* max length of error message */
#define STRMAX ((size_t)255) /* max length of a string */
#define SYMMAX ((size_t)255) /* max length of a symbol */
#define MSGMAX ((size_t)255) /* max length of error message */
#define STRMAX ((size_t)255) /* max length of a string */
/* DATA TYPES */
@ -84,55 +84,55 @@ typedef struct type_s {
} type_s;
typedef struct pair_s {
type_t type; /* TYPE_PAIR */
obj_t car, cdr; /* first and second projections */
type_t type; /* TYPE_PAIR */
obj_t car, cdr; /* first and second projections */
} pair_s;
typedef struct symbol_s {
type_t type; /* TYPE_SYMBOL */
size_t length; /* length of symbol string (excl. NUL) */
char string[1]; /* symbol string, NUL terminated */
type_t type; /* TYPE_SYMBOL */
size_t length; /* length of symbol string (excl. NUL) */
char string[1]; /* symbol string, NUL terminated */
} symbol_s;
typedef struct integer_s {
type_t type; /* TYPE_INTEGER */
long integer; /* the integer */
type_t type; /* TYPE_INTEGER */
long integer; /* the integer */
} integer_s;
typedef struct special_s {
type_t type; /* TYPE_SPECIAL */
char *name; /* printed representation, NUL terminated */
type_t type; /* TYPE_SPECIAL */
char *name; /* printed representation, NUL terminated */
} special_s;
typedef struct operator_s {
type_t type; /* TYPE_OPERATOR */
char *name; /* printed name, NUL terminated */
entry_t entry; /* entry point -- see eval() */
obj_t arguments, body; /* function arguments and code */
obj_t env, op_env; /* closure environments */
type_t type; /* TYPE_OPERATOR */
char *name; /* printed name, NUL terminated */
entry_t entry; /* entry point -- see eval() */
obj_t arguments, body; /* function arguments and code */
obj_t env, op_env; /* closure environments */
} operator_s;
typedef struct string_s {
type_t type; /* TYPE_STRING */
size_t length; /* number of chars in string */
char string[1]; /* string, NUL terminated */
type_t type; /* TYPE_STRING */
size_t length; /* number of chars in string */
char string[1]; /* string, NUL terminated */
} string_s;
typedef struct port_s {
type_t type; /* TYPE_PORT */
obj_t name; /* name of stream */
type_t type; /* TYPE_PORT */
obj_t name; /* name of stream */
FILE *stream;
} port_s;
typedef struct character_s {
type_t type; /* TYPE_CHARACTER */
char c; /* the character */
type_t type; /* TYPE_CHARACTER */
char c; /* the character */
} character_s;
typedef struct vector_s {
type_t type; /* TYPE_VECTOR */
size_t length; /* number of elements */
obj_t vector[1]; /* vector elements */
type_t type; /* TYPE_VECTOR */
size_t length; /* number of elements */
obj_t vector[1]; /* vector elements */
} vector_s;
typedef unsigned long (*hash_t)(obj_t obj);
@ -156,7 +156,7 @@ typedef struct buckets_s {
} buckets_s;
typedef union obj_u {
type_s type; /* one of TYPE_* */
type_s type; /* one of TYPE_* */
pair_s pair;
symbol_s symbol;
integer_s integer;
@ -173,17 +173,17 @@ typedef union obj_u {
/* structure macros */
#define TYPE(obj) ((obj)->type.type)
#define CAR(obj) ((obj)->pair.car)
#define CDR(obj) ((obj)->pair.cdr)
#define CAAR(obj) CAR(CAR(obj))
#define CADR(obj) CAR(CDR(obj))
#define CDAR(obj) CDR(CAR(obj))
#define CDDR(obj) CDR(CDR(obj))
#define CADDR(obj) CAR(CDDR(obj))
#define CDDDR(obj) CDR(CDDR(obj))
#define CDDAR(obj) CDR(CDAR(obj))
#define CADAR(obj) CAR(CDAR(obj))
#define TYPE(obj) ((obj)->type.type)
#define CAR(obj) ((obj)->pair.car)
#define CDR(obj) ((obj)->pair.cdr)
#define CAAR(obj) CAR(CAR(obj))
#define CADR(obj) CAR(CDR(obj))
#define CDAR(obj) CDR(CAR(obj))
#define CDDR(obj) CDR(CDR(obj))
#define CADDR(obj) CAR(CDDR(obj))
#define CDDDR(obj) CDR(CDDR(obj))
#define CDDAR(obj) CDR(CDAR(obj))
#define CADAR(obj) CAR(CDAR(obj))
/* GLOBAL DATA */
@ -213,12 +213,12 @@ static size_t symtab_size;
* special purposes.
*/
static obj_t obj_empty; /* (), the empty list */
static obj_t obj_eof; /* end of file */
static obj_t obj_error; /* error indicator */
static obj_t obj_true; /* #t, boolean true */
static obj_t obj_false; /* #f, boolean false */
static obj_t obj_undefined; /* undefined result indicator */
static obj_t obj_empty; /* (), the empty list */
static obj_t obj_eof; /* end of file */
static obj_t obj_error; /* error indicator */
static obj_t obj_true; /* #t, boolean true */
static obj_t obj_false; /* #f, boolean false */
static obj_t obj_undefined; /* undefined result indicator */
static obj_t obj_tail; /* tail recursion indicator */
static obj_t obj_deleted; /* deleted key in hashtable */
@ -230,13 +230,13 @@ static obj_t obj_deleted; /* deleted key in hashtable */
* Scheme language, and are used by the evaluator to parse code.
*/
static obj_t obj_quote; /* "quote" symbol */
static obj_t obj_quasiquote; /* "quasiquote" symbol */
static obj_t obj_lambda; /* "lambda" symbol */
static obj_t obj_begin; /* "begin" symbol */
static obj_t obj_else; /* "else" symbol */
static obj_t obj_unquote; /* "unquote" symbol */
static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */
static obj_t obj_quote; /* "quote" symbol */
static obj_t obj_quasiquote; /* "quasiquote" symbol */
static obj_t obj_lambda; /* "lambda" symbol */
static obj_t obj_begin; /* "begin" symbol */
static obj_t obj_else; /* "else" symbol */
static obj_t obj_unquote; /* "unquote" symbol */
static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */
/* error handler
@ -545,8 +545,8 @@ static void rehash(void) {
for(i = 0; i < old_symtab_size; ++i)
if(old_symtab[i] != NULL) {
obj_t *where = find(old_symtab[i]->symbol.string);
assert(where != NULL); /* new table shouldn't be full */
assert(*where == NULL); /* shouldn't be in new table */
assert(where != NULL); /* new table shouldn't be full */
assert(*where == NULL); /* shouldn't be in new table */
*where = old_symtab[i];
}
}
@ -560,10 +560,10 @@ static obj_t intern(char *string) {
if(where == NULL) {
rehash();
where = find(string);
assert(where != NULL); /* shouldn't be full after rehash */
assert(where != NULL); /* shouldn't be full after rehash */
}
if(*where == NULL) /* symbol not found in table */
if(*where == NULL) /* symbol not found in table */
*where = make_symbol(strlen(string), string);
return *where;
@ -673,8 +673,8 @@ static void table_rehash(obj_t tbl)
struct bucket_s *old_b = &tbl->table.buckets->buckets.bucket[i];
if (old_b->key != NULL && old_b->key != obj_deleted) {
struct bucket_s *b = buckets_find(tbl, new_buckets, old_b->key);
assert(b != NULL); /* new table shouldn't be full */
assert(b->key == NULL); /* shouldn't be in new table */
assert(b != NULL); /* new table shouldn't be full */
assert(b->key == NULL); /* shouldn't be in new table */
*b = *old_b;
++ new_buckets->buckets.used;
}
@ -1052,13 +1052,13 @@ static obj_t read_special(FILE *stream, int c)
switch(tolower(c)) {
case 't': return obj_true;
case 'f': return obj_false;
case '\\': { /* character (R4RS 6.6) */
case '\\': { /* character (R4RS 6.6) */
c = getc(stream);
if(c == EOF)
error("read: end of file reading character literal");
return make_character(c);
}
case '(': { /* vector (R4RS 6.8) */
case '(': { /* vector (R4RS 6.8) */
obj_t list = read_list(stream, c);
obj_t vector = list_to_vector(list);
if(vector == obj_error)
@ -1159,7 +1159,7 @@ static obj_t lookup(obj_t env, obj_t symbol)
static void define(obj_t env, obj_t symbol, obj_t value)
{
obj_t binding;
assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */
assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */
binding = lookup_in_frame(CAR(env), symbol);
if(binding != obj_undefined)
CDR(binding) = value;
@ -1572,7 +1572,7 @@ static obj_t entry_let(obj_t env, obj_t op_env, obj_t operator, obj_t operands)
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -1599,7 +1599,7 @@ static obj_t entry_let_star(obj_t env, obj_t op_env, obj_t operator, obj_t opera
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -1626,7 +1626,7 @@ static obj_t entry_letrec(obj_t env, obj_t op_env, obj_t operator, obj_t operand
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -2350,7 +2350,7 @@ static obj_t entry_divide(obj_t env, obj_t op_env, obj_t operator, obj_t operand
if(args == obj_empty) {
if(result == 0)
error("%s: reciprocal of zero", operator->operator.name);
result = 1/result; /* TODO: pretty meaningless for integers */
result = 1/result; /* TODO: pretty meaningless for integers */
} else {
while(TYPE(args) == TYPE_PAIR) {
unless(TYPE(CAR(args)) == TYPE_INTEGER)

134
mps/example/scheme/scheme-malloc.c
View file

@ -23,16 +23,16 @@
/* LANGUAGE EXTENSION */
#define unless(c) if(!(c))
#define LENGTH(array) (sizeof(array) / sizeof(array[0]))
#define unless(c) if(!(c))
#define LENGTH(array) (sizeof(array) / sizeof(array[0]))
/* CONFIGURATION PARAMETERS */
#define SYMMAX ((size_t)255) /* max length of a symbol */
#define MSGMAX ((size_t)255) /* max length of error message */
#define STRMAX ((size_t)255) /* max length of a string */
#define SYMMAX ((size_t)255) /* max length of a symbol */
#define MSGMAX ((size_t)255) /* max length of error message */
#define STRMAX ((size_t)255) /* max length of a string */
/* DATA TYPES */
@ -82,55 +82,55 @@ typedef struct type_s {
} type_s;
typedef struct pair_s {
type_t type; /* TYPE_PAIR */
obj_t car, cdr; /* first and second projections */
type_t type; /* TYPE_PAIR */
obj_t car, cdr; /* first and second projections */
} pair_s;
typedef struct symbol_s {
type_t type; /* TYPE_SYMBOL */
size_t length; /* length of symbol string (excl. NUL) */
char string[1]; /* symbol string, NUL terminated */
type_t type; /* TYPE_SYMBOL */
size_t length; /* length of symbol string (excl. NUL) */
char string[1]; /* symbol string, NUL terminated */
} symbol_s;
typedef struct integer_s {
type_t type; /* TYPE_INTEGER */
long integer; /* the integer */
type_t type; /* TYPE_INTEGER */
long integer; /* the integer */
} integer_s;
typedef struct special_s {
type_t type; /* TYPE_SPECIAL */
char *name; /* printed representation, NUL terminated */
type_t type; /* TYPE_SPECIAL */
char *name; /* printed representation, NUL terminated */
} special_s;
typedef struct operator_s {
type_t type; /* TYPE_OPERATOR */
char *name; /* printed name, NUL terminated */
entry_t entry; /* entry point -- see eval() */
obj_t arguments, body; /* function arguments and code */
obj_t env, op_env; /* closure environments */
type_t type; /* TYPE_OPERATOR */
char *name; /* printed name, NUL terminated */
entry_t entry; /* entry point -- see eval() */
obj_t arguments, body; /* function arguments and code */
obj_t env, op_env; /* closure environments */
} operator_s;
typedef struct string_s {
type_t type; /* TYPE_STRING */
size_t length; /* number of chars in string */
char string[1]; /* string, NUL terminated */
type_t type; /* TYPE_STRING */
size_t length; /* number of chars in string */
char string[1]; /* string, NUL terminated */
} string_s;
typedef struct port_s {
type_t type; /* TYPE_PORT */
obj_t name; /* name of stream */
type_t type; /* TYPE_PORT */
obj_t name; /* name of stream */
FILE *stream;
} port_s;
typedef struct character_s {
type_t type; /* TYPE_CHARACTER */
char c; /* the character */
type_t type; /* TYPE_CHARACTER */
char c; /* the character */
} character_s;
typedef struct vector_s {
type_t type; /* TYPE_VECTOR */
size_t length; /* number of elements */
obj_t vector[1]; /* vector elements */
type_t type; /* TYPE_VECTOR */
size_t length; /* number of elements */
obj_t vector[1]; /* vector elements */
} vector_s;
typedef unsigned long (*hash_t)(obj_t obj);
@ -154,7 +154,7 @@ typedef struct buckets_s {
} buckets_s;
typedef union obj_u {
type_s type; /* one of TYPE_* */
type_s type; /* one of TYPE_* */
pair_s pair;
symbol_s symbol;
integer_s integer;
@ -171,17 +171,17 @@ typedef union obj_u {
/* structure macros */
#define TYPE(obj) ((obj)->type.type)
#define CAR(obj) ((obj)->pair.car)
#define CDR(obj) ((obj)->pair.cdr)
#define CAAR(obj) CAR(CAR(obj))
#define CADR(obj) CAR(CDR(obj))
#define CDAR(obj) CDR(CAR(obj))
#define CDDR(obj) CDR(CDR(obj))
#define CADDR(obj) CAR(CDDR(obj))
#define CDDDR(obj) CDR(CDDR(obj))
#define CDDAR(obj) CDR(CDAR(obj))
#define CADAR(obj) CAR(CDAR(obj))
#define TYPE(obj) ((obj)->type.type)
#define CAR(obj) ((obj)->pair.car)
#define CDR(obj) ((obj)->pair.cdr)
#define CAAR(obj) CAR(CAR(obj))
#define CADR(obj) CAR(CDR(obj))
#define CDAR(obj) CDR(CAR(obj))
#define CDDR(obj) CDR(CDR(obj))
#define CADDR(obj) CAR(CDDR(obj))
#define CDDDR(obj) CDR(CDDR(obj))
#define CDDAR(obj) CDR(CDAR(obj))
#define CADAR(obj) CAR(CDAR(obj))
/* GLOBAL DATA */
@ -211,12 +211,12 @@ static size_t symtab_size;
* special purposes.
*/
static obj_t obj_empty; /* (), the empty list */
static obj_t obj_eof; /* end of file */
static obj_t obj_error; /* error indicator */
static obj_t obj_true; /* #t, boolean true */
static obj_t obj_false; /* #f, boolean false */
static obj_t obj_undefined; /* undefined result indicator */
static obj_t obj_empty; /* (), the empty list */
static obj_t obj_eof; /* end of file */
static obj_t obj_error; /* error indicator */
static obj_t obj_true; /* #t, boolean true */
static obj_t obj_false; /* #f, boolean false */
static obj_t obj_undefined; /* undefined result indicator */
static obj_t obj_tail; /* tail recursion indicator */
static obj_t obj_deleted; /* deleted key in hashtable */
@ -228,13 +228,13 @@ static obj_t obj_deleted; /* deleted key in hashtable */
* Scheme language, and are used by the evaluator to parse code.
*/
static obj_t obj_quote; /* "quote" symbol */
static obj_t obj_quasiquote; /* "quasiquote" symbol */
static obj_t obj_lambda; /* "lambda" symbol */
static obj_t obj_begin; /* "begin" symbol */
static obj_t obj_else; /* "else" symbol */
static obj_t obj_unquote; /* "unquote" symbol */
static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */
static obj_t obj_quote; /* "quote" symbol */
static obj_t obj_quasiquote; /* "quasiquote" symbol */
static obj_t obj_lambda; /* "lambda" symbol */
static obj_t obj_begin; /* "begin" symbol */
static obj_t obj_else; /* "else" symbol */
static obj_t obj_unquote; /* "unquote" symbol */
static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */
/* error handler
@ -543,8 +543,8 @@ static void rehash(void) {
for(i = 0; i < old_symtab_size; ++i)
if(old_symtab[i] != NULL) {
obj_t *where = find(old_symtab[i]->symbol.string);
assert(where != NULL); /* new table shouldn't be full */
assert(*where == NULL); /* shouldn't be in new table */
assert(where != NULL); /* new table shouldn't be full */
assert(*where == NULL); /* shouldn't be in new table */
*where = old_symtab[i];
}
@ -560,10 +560,10 @@ static obj_t intern(char *string) {
if(where == NULL) {
rehash();
where = find(string);
assert(where != NULL); /* shouldn't be full after rehash */
assert(where != NULL); /* shouldn't be full after rehash */
}
if(*where == NULL) /* symbol not found in table */
if(*where == NULL) /* symbol not found in table */
*where = make_symbol(strlen(string), string);
return *where;
@ -673,8 +673,8 @@ static void table_rehash(obj_t tbl)
struct bucket_s *old_b = &tbl->table.buckets->buckets.bucket[i];
if (old_b->key != NULL && old_b->key != obj_deleted) {
struct bucket_s *b = buckets_find(tbl, new_buckets, old_b->key);
assert(b != NULL); /* new table shouldn't be full */
assert(b->key == NULL); /* shouldn't be in new table */
assert(b != NULL); /* new table shouldn't be full */
assert(b->key == NULL); /* shouldn't be in new table */
*b = *old_b;
++ new_buckets->buckets.used;
}
@ -1052,13 +1052,13 @@ static obj_t read_special(FILE *stream, int c)
switch(tolower(c)) {
case 't': return obj_true;
case 'f': return obj_false;
case '\\': { /* character (R4RS 6.6) */
case '\\': { /* character (R4RS 6.6) */
c = getc(stream);
if(c == EOF)
error("read: end of file reading character literal");
return make_character(c);
}
case '(': { /* vector (R4RS 6.8) */
case '(': { /* vector (R4RS 6.8) */
obj_t list = read_list(stream, c);
obj_t vector = list_to_vector(list);
if(vector == obj_error)
@ -1159,7 +1159,7 @@ static obj_t lookup(obj_t env, obj_t symbol)
static void define(obj_t env, obj_t symbol, obj_t value)
{
obj_t binding;
assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */
assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */
binding = lookup_in_frame(CAR(env), symbol);
if(binding != obj_undefined)
CDR(binding) = value;
@ -1572,7 +1572,7 @@ static obj_t entry_let(obj_t env, obj_t op_env, obj_t operator, obj_t operands)
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -1599,7 +1599,7 @@ static obj_t entry_let_star(obj_t env, obj_t op_env, obj_t operator, obj_t opera
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -1626,7 +1626,7 @@ static obj_t entry_letrec(obj_t env, obj_t op_env, obj_t operator, obj_t operand
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -2350,7 +2350,7 @@ static obj_t entry_divide(obj_t env, obj_t op_env, obj_t operator, obj_t operand
if(args == obj_empty) {
if(result == 0)
error("%s: reciprocal of zero", operator->operator.name);
result = 1/result; /* TODO: pretty meaningless for integers */
result = 1/result; /* TODO: pretty meaningless for integers */
} else {
while(TYPE(args) == TYPE_PAIR) {
unless(TYPE(CAR(args)) == TYPE_INTEGER)

134
mps/example/scheme/scheme.c
View file

@ -54,17 +54,17 @@
/* LANGUAGE EXTENSION */
#define unless(c) if(!(c))
#define LENGTH(array) (sizeof(array) / sizeof(array[0]))
#define unless(c) if(!(c))
#define LENGTH(array) (sizeof(array) / sizeof(array[0]))
#define UNUSED(var) ((void)var)
/* CONFIGURATION PARAMETERS */
#define SYMMAX ((size_t)255) /* max length of a symbol */
#define MSGMAX ((size_t)255) /* max length of error message */
#define STRMAX ((size_t)255) /* max length of a string */
#define SYMMAX ((size_t)255) /* max length of a symbol */
#define MSGMAX ((size_t)255) /* max length of error message */
#define STRMAX ((size_t)255) /* max length of a string */
/* DATA TYPES */
@ -118,55 +118,55 @@ typedef struct type_s {
} type_s;
typedef struct pair_s {
type_t type; /* TYPE_PAIR */
obj_t car, cdr; /* first and second projections */
type_t type; /* TYPE_PAIR */
obj_t car, cdr; /* first and second projections */
} pair_s;
typedef struct symbol_s {
type_t type; /* TYPE_SYMBOL */
size_t length; /* length of symbol string (excl. NUL) */
char string[1]; /* symbol string, NUL terminated */
type_t type; /* TYPE_SYMBOL */
size_t length; /* length of symbol string (excl. NUL) */
char string[1]; /* symbol string, NUL terminated */
} symbol_s;
typedef struct integer_s {
type_t type; /* TYPE_INTEGER */
long integer; /* the integer */
type_t type; /* TYPE_INTEGER */
long integer; /* the integer */
} integer_s;
typedef struct special_s {
type_t type; /* TYPE_SPECIAL */
const char *name; /* printed representation, NUL terminated */
type_t type; /* TYPE_SPECIAL */
const char *name; /* printed representation, NUL terminated */
} special_s;
typedef struct operator_s {
type_t type; /* TYPE_OPERATOR */
const char *name; /* printed name, NUL terminated */
entry_t entry; /* entry point -- see eval() */
obj_t arguments, body; /* function arguments and code */
obj_t env, op_env; /* closure environments */
type_t type; /* TYPE_OPERATOR */
const char *name; /* printed name, NUL terminated */
entry_t entry; /* entry point -- see eval() */
obj_t arguments, body; /* function arguments and code */
obj_t env, op_env; /* closure environments */
} operator_s;
typedef struct string_s {
type_t type; /* TYPE_STRING */
size_t length; /* number of chars in string */
char string[1]; /* string, NUL terminated */
type_t type; /* TYPE_STRING */
size_t length; /* number of chars in string */
char string[1]; /* string, NUL terminated */
} string_s;
typedef struct port_s {
type_t type; /* TYPE_PORT */
obj_t name; /* name of stream */
type_t type; /* TYPE_PORT */
obj_t name; /* name of stream */
FILE *stream;
} port_s;
typedef struct character_s {
type_t type; /* TYPE_CHARACTER */
char c; /* the character */
type_t type; /* TYPE_CHARACTER */
char c; /* the character */
} character_s;
typedef struct vector_s {
type_t type; /* TYPE_VECTOR */
size_t length; /* number of elements */
obj_t vector[1]; /* vector elements */
type_t type; /* TYPE_VECTOR */
size_t length; /* number of elements */
obj_t vector[1]; /* vector elements */
} vector_s;
typedef unsigned long (*hash_t)(obj_t obj, mps_ld_t ld);
@ -238,7 +238,7 @@ typedef struct pad_s {
typedef union obj_u {
type_s type; /* one of TYPE_* */
type_s type; /* one of TYPE_* */
pair_s pair;
symbol_s symbol;
integer_s integer;
@ -258,17 +258,17 @@ typedef union obj_u {
/* structure macros */
#define TYPE(obj) ((obj)->type.type)
#define CAR(obj) ((obj)->pair.car)
#define CDR(obj) ((obj)->pair.cdr)
#define CAAR(obj) CAR(CAR(obj))
#define CADR(obj) CAR(CDR(obj))
#define CDAR(obj) CDR(CAR(obj))
#define CDDR(obj) CDR(CDR(obj))
#define CADDR(obj) CAR(CDDR(obj))
#define CDDDR(obj) CDR(CDDR(obj))
#define CDDAR(obj) CDR(CDAR(obj))
#define CADAR(obj) CAR(CDAR(obj))
#define TYPE(obj) ((obj)->type.type)
#define CAR(obj) ((obj)->pair.car)
#define CDR(obj) ((obj)->pair.cdr)
#define CAAR(obj) CAR(CAR(obj))
#define CADR(obj) CAR(CDR(obj))
#define CDAR(obj) CDR(CAR(obj))
#define CDDR(obj) CDR(CDR(obj))
#define CADDR(obj) CAR(CDDR(obj))
#define CDDDR(obj) CDR(CDDR(obj))
#define CDDAR(obj) CDR(CDAR(obj))
#define CADAR(obj) CAR(CDAR(obj))
/* GLOBAL DATA */
@ -308,12 +308,12 @@ static mps_root_t symtab_root;
* See `globals_scan`.
*/
static obj_t obj_empty; /* (), the empty list */
static obj_t obj_eof; /* end of file */
static obj_t obj_error; /* error indicator */
static obj_t obj_true; /* #t, boolean true */
static obj_t obj_false; /* #f, boolean false */
static obj_t obj_undefined; /* undefined result indicator */
static obj_t obj_empty; /* (), the empty list */
static obj_t obj_eof; /* end of file */
static obj_t obj_error; /* error indicator */
static obj_t obj_true; /* #t, boolean true */
static obj_t obj_false; /* #f, boolean false */
static obj_t obj_undefined; /* undefined result indicator */
static obj_t obj_tail; /* tail recursion indicator */
static obj_t obj_deleted; /* deleted key in hashtable */
@ -325,13 +325,13 @@ static obj_t obj_deleted; /* deleted key in hashtable */
* Scheme language, and are used by the evaluator to parse code.
*/
static obj_t obj_quote; /* "quote" symbol */
static obj_t obj_quasiquote; /* "quasiquote" symbol */
static obj_t obj_lambda; /* "lambda" symbol */
static obj_t obj_begin; /* "begin" symbol */
static obj_t obj_else; /* "else" symbol */
static obj_t obj_unquote; /* "unquote" symbol */
static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */
static obj_t obj_quote; /* "quote" symbol */
static obj_t obj_quasiquote; /* "quasiquote" symbol */
static obj_t obj_lambda; /* "lambda" symbol */
static obj_t obj_begin; /* "begin" symbol */
static obj_t obj_else; /* "else" symbol */
static obj_t obj_unquote; /* "unquote" symbol */
static obj_t obj_unquote_splic; /* "unquote-splicing" symbol */
/* error handler
@ -783,8 +783,8 @@ static void rehash(void) {
for(i = 0; i < old_symtab_size; ++i)
if(old_symtab[i] != NULL) {
obj_t *where = find(old_symtab[i]->symbol.string);
assert(where != NULL); /* new table shouldn't be full */
assert(*where == NULL); /* shouldn't be in new table */
assert(where != NULL); /* new table shouldn't be full */
assert(*where == NULL); /* shouldn't be in new table */
*where = old_symtab[i];
}
@ -801,10 +801,10 @@ static obj_t intern(const char *string) {
if(where == NULL) {
rehash();
where = find(string);
assert(where != NULL); /* shouldn't be full after rehash */
assert(where != NULL); /* shouldn't be full after rehash */
}
if(*where == NULL) /* symbol not found in table */
if(*where == NULL) /* symbol not found in table */
*where = make_symbol(strlen(string), string);
return *where;
@ -928,8 +928,8 @@ static struct bucket_s *table_rehash(obj_t tbl, size_t new_length, obj_t key)
struct bucket_s *old_b = &tbl->table.buckets->buckets.bucket[i];
if (old_b->key != NULL && old_b->key != obj_deleted) {
struct bucket_s *b = buckets_find(tbl, new_buckets, old_b->key, 1);
assert(b != NULL); /* new table shouldn't be full */
assert(b->key == NULL); /* shouldn't be in new table */
assert(b != NULL); /* new table shouldn't be full */
assert(b->key == NULL); /* shouldn't be in new table */
*b = *old_b;
if (b->key == key) key_bucket = b;
++ new_buckets->buckets.used;
@ -1352,13 +1352,13 @@ static obj_t read_special(FILE *stream, int c)
switch(tolower(c)) {
case 't': return obj_true;
case 'f': return obj_false;
case '\\': { /* character (R4RS 6.6) */
case '\\': { /* character (R4RS 6.6) */
c = getc(stream);
if(c == EOF)
error("read: end of file reading character literal");
return make_character((char)c);
}
case '(': { /* vector (R4RS 6.8) */
case '(': { /* vector (R4RS 6.8) */
obj_t list = read_list(stream, c);
obj_t vector = list_to_vector(list);
if(vector == obj_error)
@ -1459,7 +1459,7 @@ static obj_t lookup(obj_t env, obj_t symbol)
static void define(obj_t env, obj_t symbol, obj_t value)
{
obj_t binding;
assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */
assert(TYPE(env) == TYPE_PAIR); /* always at least one frame */
binding = lookup_in_frame(CAR(env), symbol);
if(binding != obj_undefined)
CDR(binding) = value;
@ -1878,7 +1878,7 @@ static obj_t entry_let(obj_t env, obj_t op_env, obj_t operator, obj_t operands)
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -1905,7 +1905,7 @@ static obj_t entry_let_star(obj_t env, obj_t op_env, obj_t operator, obj_t opera
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -1932,7 +1932,7 @@ static obj_t entry_letrec(obj_t env, obj_t op_env, obj_t operator, obj_t operand
unless(TYPE(operands) == TYPE_PAIR &&
TYPE(CDR(operands)) == TYPE_PAIR)
error("%s: illegal syntax", operator->operator.name);
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
inner_env = make_pair(obj_empty, env); /* TODO: common with interpret */
bindings = CAR(operands);
while(TYPE(bindings) == TYPE_PAIR) {
obj_t binding = CAR(bindings);
@ -2656,7 +2656,7 @@ static obj_t entry_divide(obj_t env, obj_t op_env, obj_t operator, obj_t operand
if(args == obj_empty) {
if(result == 0)
error("%s: reciprocal of zero", operator->operator.name);
result = 1/result; /* TODO: pretty meaningless for integers */
result = 1/result; /* TODO: pretty meaningless for integers */
} else {
while(TYPE(args) == TYPE_PAIR) {
unless(TYPE(CAR(args)) == TYPE_INTEGER)

8
mps/manual/source/glossary/r.rst
View file

@ -339,10 +339,10 @@ Memory Management Glossary: R
register
A *register* is a small unit of :term:`memory (2)` that is
attached to a processor and accessible very quickly. Registers
typically form the highest level of a computer's
:term:`storage hierarchy`.
A *register* is a small unit of :term:`memory (2)` that is
attached to a processor and accessible very quickly. Registers
typically form the highest level of a computer's
:term:`storage hierarchy`.
.. relevance::

2
mps/manual/source/glossary/v.rst
View file

@ -54,7 +54,7 @@ Memory Management Glossary: V
variety
.. mps:specific::
.. mps:specific::
A behaviour of the MPS that must be selected at
compilation time. There are three varieties: :term:`cool`,

20
mps/manual/source/guide/debug.rst
View file

@ -398,16 +398,16 @@ And here's how it shows up in the debugger:
#3 0x00000001000014e3 in obj_skip (base=0x1003f9b88) at scheme.c:2940
2940 assert(0);
(gdb) list
2935 break;
2936 case TYPE_PAD1:
2937 base = (char *)base + ALIGN_OBJ(sizeof(pad1_s));
2938 break;
2939 default:
2940 assert(0);
2941 fprintf(stderr, "Unexpected object on the heap\n");
2942 abort();
2943 return NULL;
2944 }
2935 break;
2936 case TYPE_PAD1:
2937 base = (char *)base + ALIGN_OBJ(sizeof(pad1_s));
2938 break;
2939 default:
2940 assert(0);
2941 fprintf(stderr, "Unexpected object on the heap\n");
2942 abort();
2943 return NULL;
2944 }
The object being skipped is corrupt::

12
mps/manual/source/mmref/lang.rst
View file

@ -147,8 +147,8 @@ Memory management in various languages
is reclaimed by the memory manager), and :term:`weak
references (1)` (via the ``WeakReference`` class).
The :term:`garbage collector` in the .NET Framework is
configurable to run in soft real time, or in batch mode.
The :term:`garbage collector` in the .NET Framework is
configurable to run in soft real time, or in batch mode.
The Mono runtime comes with two collectors: the
Boehm–Demers–Weiser :term:`conservative collector
@ -607,10 +607,10 @@ Memory management in various languages
Python is a "duck-typed" object-oriented language created in
the early 1990s by Guido van Rossum.
There are several implementations running on a variety of
virtual machines: the original "CPython" implementation runs
on its own virtual machine; IronPython runs on the Common
Language Runtime; Jython on the Java Virtual Machine.
There are several implementations running on a variety of
virtual machines: the original "CPython" implementation runs
on its own virtual machine; IronPython runs on the Common
Language Runtime; Jython on the Java Virtual Machine.
CPython manages memory using a mixture of :term:`reference
counting` and :term:`non-moving <non-moving memory manager>`

4
mps/manual/source/topic/deprecated.rst
View file

@ -178,8 +178,8 @@ Deprecated in version 1.115
mps_root_create_table_tagged(root_o, arena, rank, rm,
base, size,
mps_scan_area_tagged,
mask, 0)
mps_scan_area_tagged,
mask, 0)
.. c:type:: mps_res_t (*mps_reg_scan_t)(mps_ss_t ss, mps_thr_t thr, void *p, size_t s)

48
mps/manual/source/topic/root.rst
View file

@ -396,14 +396,14 @@ Root interface
This function is equivalent to calling::
mps_root_create_thread_tagged(root_o,
arena,
mps_rank_ambig(),
(mps_rm_t)0,
thr,
mps_scan_area_tagged,
sizeof(mps_word_t) - 1,
0,
stack);
arena,
mps_rank_ambig(),
(mps_rm_t)0,
thr,
mps_scan_area_tagged,
sizeof(mps_word_t) - 1,
0,
stack);
.. c:function:: mps_res_t mps_root_create_thread_tagged(mps_root_t *root_o, mps_arena_t arena, mps_rank_t rank, mps_rm_t rm, mps_thr_t thr, mps_area_scan_t scan_area, mps_word_t mask, mps_word_t pattern, void *stack)
@ -460,25 +460,25 @@ Root interface
You can avoid this risk in several ways:
#. Choosing to tag pointers with zero, setting ``scan_area``
as :c:func:`mps_scan_area_tagged` and setting ``pattern``
to zero.
#. Choosing to tag pointers with zero, setting ``scan_area``
as :c:func:`mps_scan_area_tagged` and setting ``pattern``
to zero.
#. Set ``scan_area`` to :c:func:`mps_scan_area_tagged_or_zero`
so that untagged pointers are scanned. Thist may lead to
some additional scanning and retention.
so that untagged pointers are scanned. Thist may lead to
some additional scanning and retention.
#. Use :c:func:`mps_root_create_thread_scanned` and set
``scan_area`` to :c:func:`mps_scan_area`: in this case all
words in registers and on the stack are scanned, leading to
possible additional scanning and retention.
#. Use :c:func:`mps_root_create_thread_scanned` and set
``scan_area`` to :c:func:`mps_scan_area`: in this case all
words in registers and on the stack are scanned, leading to
possible additional scanning and retention.
#. Write your own compiler with complete control over register
contents and stack format, use
:c:func:`mps_root_create_thread_scanned` and set
``scan_area`` to your own custom scanner, derived from the
source code of :c:func:`mps_scan_area`, that knows the
format.
#. Write your own compiler with complete control over register
contents and stack format, use
:c:func:`mps_root_create_thread_scanned` and set
``scan_area`` to your own custom scanner, derived from the
source code of :c:func:`mps_scan_area`, that knows the
format.
.. note::
@ -723,7 +723,7 @@ Root interface
mps_rank_exact(),
(mps_rm_t)0,
base, symtab_size * 2,
mps_scan_area_tagged,
mps_scan_area_tagged,
(mps_word_t)TAG_MASK,
(mps_word_t)TAG_PATTERN);
if (res != MPS_RES_OK) errror("can't create symtab root");

2
mps/manual/source/topic/scanning.rst
View file

@ -531,7 +531,7 @@ the scanners, found in ``scan.c`` in the MPS source code.
mps_res_t scan(mps_ss_t ss,
mps_word_t *base, mps_word_t *limit,
void *closure, size_t closure_size);
void *closure, size_t closure_size);
``ss`` is the :term:`scan state`.

2
mps/procedure/branch-merge.rst
View file

@ -52,7 +52,7 @@ the parent branch. So a typical invocation looks like this::
The specification should look like this::
Branch: mps/branch/2013-08-21/lii6ll
Branch: mps/branch/2013-08-21/lii6ll
Description:
Adding new supported platform lii6ll (job003596).

4
mps/procedure/release-build.rst
View file

@ -147,7 +147,7 @@ On a Unix (including OS X) machine:
View:
//info.ravenbrook.com/project/mps/version/$VERSION/... //$CLIENT/mps-kit-$RELEASE/...
//info.ravenbrook.com/project/mps/release/$RELEASE/... //$CLIENT/release/$RELEASE/...
END
END
#. Sync this client to *CHANGELEVEL*::
@ -169,7 +169,7 @@ On a Unix (including OS X) machine:
#. Sync the version sources again::
rm -rf /tmp/$CLIENT/version/$VERSION
p4 -c $CLIENT sync -f @$CHANGELEVEL
p4 -c $CLIENT sync -f @$CHANGELEVEL
#. Create a zip file containing the MPS sources, and open it for add::

4
mps/procedure/version-create.rst
View file

@ -145,8 +145,8 @@ the parent branch. A typical invocation looks like this::
p4 client -i <<END
Client: git-fusion-mps-version-$VERSION
Description: Git-fusion client for syncing MPS version $VERSION
Root: /home/git-fusion/.git-fusion/views/mps-version-$VERSION/p4
Description: Git-fusion client for syncing MPS version $VERSION
Root: /home/git-fusion/.git-fusion/views/mps-version-$VERSION/p4
View: //info.ravenbrook.com/project/mps/version/$VERSION/... //git-fusion-mps-version-$VERSION/...
END