% $Id: mp.w 1668 2011-05-05 09:54:59Z taco $
%
% Copyright 2008-2011 Taco Hoekwater.
%
% This program is free software: you can redistribute it and/or modify
% it under the terms of the GNU Lesser General Public License as published by
% the Free Software Foundation, either version 3 of the License, or
% (at your option) any later version.
%
% This program is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
% GNU Lesser General Public License for more details.
%
% You should have received a copy of the GNU Lesser General Public License
% along with this program. If not, see ;
typedef struct MP_options {
@
} MP_options;
@
@ The internal header file is much longer: it not only lists the complete
|MP_instance|, but also a lot of functions that have to be available to
the \ps\ backend, that is defined in a separate \.{WEB} file.
The variables from |MP_options| are included inside the |MP_instance|
wholesale.
@(mpmp.h@>=
#include "avl.h"
#include
typedef struct psout_data_struct *psout_data;
typedef struct svgout_data_struct *svgout_data;
#ifndef HAVE_BOOLEAN
typedef int boolean;
#endif
#ifndef INTEGER_TYPE
typedef int integer;
#endif
@;
@;
@;
@;
typedef struct MP_instance {
@
@
} MP_instance;
@
@ @c
#include
#include
#include
#include
#include
#include
#ifdef HAVE_UNISTD_H
# include /* for access */
#endif
#include /* for struct tm \& co */
#include "mplib.h"
#include "mplibps.h" /* external header */
#include "mplibsvg.h" /* external header */
#include "mpmp.h" /* internal header */
#include "mppsout.h" /* internal header */
#include "mpsvgout.h" /* internal header */
#include "mpmath.h" /* internal header */
extern font_number mp_read_font_info (MP mp, char *fname); /* tfmin.w */
@h @;
@;
@
@ Some debugging support for development. The trick with the variadic macros
probably only works in gcc, as this preprocessor feature was not formalized
until the c99 standard (and that is too new for us). Lets' hope that at least
most compilers understand the non-debug version.
@^system dependencies@>
@(mpmp.h@>=
#define DEBUG 0
#if DEBUG
void do_debug_printf(MP mp, const char *prefix, const char *fmt, ...);
# define debug_printf(a1,a2,a3) do_debug_printf(mp, "", a1,a2,a3)
# define FUNCTION_TRACE1(a1) do_debug_printf(mp, "FTRACE: ", a1)
# define FUNCTION_TRACE2(a1,a2) do_debug_printf(mp, "FTRACE: ", a1,a2)
# define FUNCTION_TRACE3(a1,a2,a3) do_debug_printf(mp, "FTRACE: ", a1,a2,a3)
# define FUNCTION_TRACE4(a1,a2,a3,a4) do_debug_printf(mp, "FTRACE: ", a1,a2,a3,a4)
#else
# define debug_printf(a1,a2,a3)
# define FUNCTION_TRACE1(a1)
# define FUNCTION_TRACE2(a1,a2)
# define FUNCTION_TRACE3(a1,a2,a3)
# define FUNCTION_TRACE4(a1,a2,a3,a4)
#endif
@ This function occasionally crashes (if something is written after the
log file is already closed), but that is not so important while debugging.
@c
#if DEBUG
void do_debug_printf(MP mp, const char *prefix, const char *fmt, ...) {
va_list ap;
va_start (ap, fmt);
if (mp->log_file && !ferror((FILE *)mp->log_file)) {
fputs(prefix, mp->log_file);
vfprintf(mp->log_file, fmt, ap);
}
va_end(ap);
va_start (ap, fmt);
if (mp->term_out && !ferror((FILE *)mp->term_out)) {
fputs(prefix, mp->term_out);
vfprintf(mp->term_out, fmt, ap);
} else {
fputs(prefix, stdout);
vfprintf(stdout, fmt, ap);
}
va_end(ap);
}
#endif
@ Here are the functions that set up the \MP\ instance.
@=
MP_options *mp_options (void);
MP mp_initialize (MP_options * opt);
@ @c
MP_options *mp_options (void) {
MP_options *opt;
size_t l = sizeof (MP_options);
opt = malloc (l);
if (opt != NULL) {
memset (opt, 0, l);
}
return opt;
}
@ @=
@
@ The whole instance structure is initialized with zeroes,
this greatly reduces the number of statements needed in
the |Allocate or initialize variables| block.
@d set_callback_option(A) do { mp->A = mp_##A;
if (opt->A!=NULL) mp->A = opt->A;
} while (0)
@c
static MP mp_do_new (jmp_buf * buf) {
MP mp = malloc (sizeof (MP_instance));
if (mp == NULL) {
xfree (buf);
return NULL;
}
memset (mp, 0, sizeof (MP_instance));
mp->jump_buf = buf;
return mp;
}
@ @c
static void mp_free (MP mp) {
int k; /* loop variable */
@;
if (mp->noninteractive) {
@;
}
xfree (mp->jump_buf);
@;
mp_free_math(mp);
xfree (mp);
}
@ @c
static void mp_do_initialize (MP mp) {
@;
@;
}
@ For the retargetable math library, we need to have a pointer, at least.
@=
void *math;
@ This procedure gets things started properly.
@c
MP mp_initialize (MP_options * opt) {
MP mp;
jmp_buf *buf = malloc (sizeof (jmp_buf));
if (buf == NULL || setjmp (*buf) != 0)
return NULL;
mp = mp_do_new (buf);
if (mp == NULL)
return NULL;
mp->userdata = opt->userdata;
mp->noninteractive = opt->noninteractive;
set_callback_option (find_file);
set_callback_option (open_file);
set_callback_option (read_ascii_file);
set_callback_option (read_binary_file);
set_callback_option (close_file);
set_callback_option (eof_file);
set_callback_option (flush_file);
set_callback_option (write_ascii_file);
set_callback_option (write_binary_file);
set_callback_option (shipout_backend);
if (opt->banner && *(opt->banner)) {
mp->banner = xstrdup (opt->banner);
} else {
mp->banner = xstrdup (default_banner);
}
if (opt->command_line && *(opt->command_line))
mp->command_line = xstrdup (opt->command_line);
if (mp->noninteractive) {
@;
}
/* open the terminal for output */
t_open_out;
mp->math = mp_initialize_math(mp);
@;
@;
mp_reallocate_paths (mp, 1000);
mp_reallocate_fonts (mp, 8);
mp->history = mp_fatal_error_stop; /* in case we quit during initialization */
@;
if (mp->bad > 0) {
char ss[256];
mp_snprintf (ss, 256, "Ouch---my internal constants have been clobbered!\n"
"---case %i", (int) mp->bad);
do_putsf (mp->err_out, (char *) ss);
@.Ouch...clobbered@>;
return mp;
}
mp_do_initialize (mp); /* erase preloaded mem */
mp_init_tab (mp); /* initialize the tables */
mp_init_prim (mp); /* call |primitive| for each primitive */
mp_fix_date_and_time (mp);
if (!mp->noninteractive) {
@;
@;
@;
@internal[mp_job_name]|@>;
} else {
mp->history = mp_spotless;
}
return mp;
}
@ @=
mp_open_log_file (mp);
mp_set_job_id (mp);
mp_init_map_file (mp, mp->troff_mode);
mp->history = mp_spotless; /* ready to go! */
if (mp->troff_mode) {
internal_value (mp_gtroffmode) = unity;
internal_value (mp_prologues) = unity;
}
if (mp->start_sym != NULL) { /* insert the `\&{everyjob}' symbol */
mp->cur_sym = mp->start_sym;
mp_back_input (mp);
}
@ @=
extern MP_options *mp_options (void);
extern MP mp_initialize (MP_options * opt);
extern int mp_status (MP mp);
extern void *mp_userdata (MP mp);
@ @c
int mp_status (MP mp) {
return mp->history;
}
@ @c
void *mp_userdata (MP mp) {
return mp->userdata;
}
@ The overall \MP\ program begins with the heading just shown, after which
comes a bunch of procedure declarations and function declarations.
Finally we will get to the main program, which begins with the
comment `|start_here|'. If you want to skip down to the
main program now, you can look up `|start_here|' in the index.
But the author suggests that the best way to understand this program
is to follow pretty much the order of \MP's components as they appear in the
\.{WEB} description you are now reading, since the present ordering is
intended to combine the advantages of the ``bottom up'' and ``top down''
approaches to the problem of understanding a somewhat complicated system.
@ Some of the code below is intended to be used only when diagnosing the
strange behavior that sometimes occurs when \MP\ is being installed or
when system wizards are fooling around with \MP\ without quite knowing
what they are doing. Such code will not normally be compiled; it is
delimited by the preprocessor test `|#ifdef DEBUG .. #endif|'.
@ The following parameters can be changed at compile time to extend or
reduce \MP's capacity.
@^system dependencies@>
@=
#define bistack_size 1500 /* size of stack for bisection algorithms;
should probably be left at this value */
@ Like the preceding parameters, the following quantities can be changed
to extend or reduce \MP's capacity.
@ @=
int pool_size; /* maximum number of characters in strings, including all
error messages and help texts, and the names of all identifiers */
int max_in_open; /* maximum number of input files and error insertions that
can be going on simultaneously */
int param_size; /* maximum number of simultaneous macro parameters */
@ @=
int error_line; /* width of context lines on terminal error messages */
int half_error_line; /* width of first lines of contexts in terminal
error messages; should be between 30 and |error_line-15| */
int halt_on_error; /* do we quit at the first error? */
int max_print_line; /* width of longest text lines output; should be at least 60 */
void *userdata; /* this allows the calling application to setup local */
char *banner; /* the banner that is printed to the screen and log */
int ini_version;
@ @=
xfree (mp->banner);
@
@d set_lower_limited_value(a,b,c) do { a=c; if (b>c) a=b; } while (0)
@=
mp->param_size = 4;
mp->max_in_open = 0;
mp->pool_size = 10000;
set_lower_limited_value (mp->error_line, opt->error_line, 79);
set_lower_limited_value (mp->half_error_line, opt->half_error_line, 50);
if (mp->half_error_line > mp->error_line - 15)
mp->half_error_line = mp->error_line - 15;
mp->max_print_line = 100;
set_lower_limited_value (mp->max_print_line, opt->max_print_line, 79);
mp->halt_on_error = (opt->halt_on_error ? true : false);
mp->ini_version = (opt->ini_version ? true : false);
@ In case somebody has inadvertently made bad settings of the ``constants,''
\MP\ checks them using a global variable called |bad|.
This is the second of many sections of \MP\ where global variables are
defined.
@=
integer bad; /* is some ``constant'' wrong? */
@ Later on we will say `|if ( int_packets+17*int_increment>bistack_size )mp->bad=19;|',
or something similar.
In case you are wondering about the non-consequtive values of |bad|: most
of the things that used to be WEB constants are now runtime variables
with checking at assignment time.
@=
mp->bad = 0;
@ Some |goto| labels are used by the following definitions. The label
`|restart|' is occasionally used at the very beginning of a procedure; and
the label `|reswitch|' is occasionally used just prior to a |case|
statement in which some cases change the conditions and we wish to branch
to the newly applicable case. Loops that are set up with the |loop|
construction defined below are commonly exited by going to `|done|' or to
`|found|' or to `|not_found|', and they are sometimes repeated by going to
`|continue|'. If two or more parts of a subroutine start differently but
end up the same, the shared code may be gathered together at
`|common_ending|'.
@ Here are some macros for common programming idioms.
@d incr(A) (A)=(A)+1 /* increase a variable by unity */
@d decr(A) (A)=(A)-1 /* decrease a variable by unity */
@d negate(A) (A)=-(A) /* change the sign of a variable */
@d double(A) (A)=(A)+(A)
@d odd(A) ((A)%2==1)
@* The character set.
In order to make \MP\ readily portable to a wide variety of
computers, all of its input text is converted to an internal eight-bit
code that includes standard ASCII, the ``American Standard Code for
Information Interchange.'' This conversion is done immediately when each
character is read in. Conversely, characters are converted from ASCII to
the user's external representation just before they are output to a
text file.
@^ASCII code@>
Such an internal code is relevant to users of \MP\ only with respect to
the \&{char} and \&{ASCII} operations, and the comparison of strings.
@ Characters of text that have been converted to \MP's internal form
are said to be of type |ASCII_code|, which is a subrange of the integers.
@=
typedef unsigned char ASCII_code; /* eight-bit numbers */
@ The present specification of \MP\ has been written under the assumption
that the character set contains at least the letters and symbols associated
with ASCII codes 040 through 0176; all of these characters are now
available on most computer terminals.
@=
typedef unsigned char text_char; /* the data type of characters in text files */
@ @=
integer i;
@ The \MP\ processor converts between ASCII code and
the user's external character set by means of arrays |xord| and |xchr|
that are analogous to Pascal's |ord| and |chr| functions.
@(mpmp.h@>=
#define xchr(A) mp->xchr[(A)]
#define xord(A) mp->xord[(A)]
@ @=
ASCII_code xord[256]; /* specifies conversion of input characters */
text_char xchr[256]; /* specifies conversion of output characters */
@ The core system assumes all 8-bit is acceptable. If it is not,
a change file has to alter the below section.
@^system dependencies@>
Additionally, people with extended character sets can
assign codes arbitrarily, giving an |xchr| equivalent to whatever
characters the users of \MP\ are allowed to have in their input files.
Appropriate changes to \MP's |char_class| table should then be made.
(Unlike \TeX, each installation of \MP\ has a fixed assignment of category
codes, called the |char_class|.) Such changes make portability of programs
more difficult, so they should be introduced cautiously if at all.
@^character set dependencies@>
@^system dependencies@>
@=
for (i = 0; i <= 0377; i++) {
xchr (i) = (text_char) i;
}
@ The following system-independent code makes the |xord| array contain a
suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
where |i=
for (i = 0; i <= 255; i++) {
xord (xchr (i)) = 0177;
}
for (i = 0200; i <= 0377; i++) {
xord (xchr (i)) = (ASCII_code) i;
}
for (i = 0; i <= 0176; i++) {
xord (xchr (i)) = (ASCII_code) i;
}
@* Input and output.
The bane of portability is the fact that different operating systems treat
input and output quite differently, perhaps because computer scientists
have not given sufficient attention to this problem. People have felt somehow
that input and output are not part of ``real'' programming. Well, it is true
that some kinds of programming are more fun than others. With existing
input/output conventions being so diverse and so messy, the only sources of
joy in such parts of the code are the rare occasions when one can find a
way to make the program a little less bad than it might have been. We have
two choices, either to attack I/O now and get it over with, or to postpone
I/O until near the end. Neither prospect is very attractive, so let's
get it over with.
The basic operations we need to do are (1)~inputting and outputting of
text, to or from a file or the user's terminal; (2)~inputting and
outputting of eight-bit bytes, to or from a file; (3)~instructing the
operating system to initiate (``open'') or to terminate (``close'') input or
output from a specified file; (4)~testing whether the end of an input
file has been reached; (5)~display of bits on the user's screen.
The bit-display operation will be discussed in a later section; we shall
deal here only with more traditional kinds of I/O.
@ Finding files happens in a slightly roundabout fashion: the \MP\
instance object contains a field that holds a function pointer that finds a
file, and returns its name, or NULL. For this, it receives three
parameters: the non-qualified name |fname|, the intended |fopen|
operation type |fmode|, and the type of the file |ftype|.
The file types that are passed on in |ftype| can be used to
differentiate file searches if a library like kpathsea is used,
the fopen mode is passed along for the same reason.
@=
typedef unsigned char eight_bits; /* unsigned one-byte quantity */
@ @=
enum mp_filetype {
mp_filetype_terminal = 0, /* the terminal */
mp_filetype_error, /* the terminal */
mp_filetype_program, /* \MP\ language input */
mp_filetype_log, /* the log file */
mp_filetype_postscript, /* the postscript output */
mp_filetype_memfile, /* memory dumps, obsolete */
mp_filetype_metrics, /* TeX font metric files */
mp_filetype_fontmap, /* PostScript font mapping files */
mp_filetype_font, /* PostScript type1 font programs */
mp_filetype_encoding, /* PostScript font encoding files */
mp_filetype_text /* first text file for readfrom and writeto primitives */
};
typedef char *(*mp_file_finder) (MP, const char *, const char *, int);
typedef void *(*mp_file_opener) (MP, const char *, const char *, int);
typedef char *(*mp_file_reader) (MP, void *, size_t *);
typedef void (*mp_binfile_reader) (MP, void *, void **, size_t *);
typedef void (*mp_file_closer) (MP, void *);
typedef int (*mp_file_eoftest) (MP, void *);
typedef void (*mp_file_flush) (MP, void *);
typedef void (*mp_file_writer) (MP, void *, const char *);
typedef void (*mp_binfile_writer) (MP, void *, void *, size_t);
@ @=
mp_file_finder find_file;
mp_file_opener open_file;
mp_file_reader read_ascii_file;
mp_binfile_reader read_binary_file;
mp_file_closer close_file;
mp_file_eoftest eof_file;
mp_file_flush flush_file;
mp_file_writer write_ascii_file;
mp_binfile_writer write_binary_file;
@ The default function for finding files is |mp_find_file|. It is
pretty stupid: it will only find files in the current directory.
This function may disappear altogether, it is currently only
used for the default font map file.
@c
static char *mp_find_file (MP mp, const char *fname, const char *fmode,
int ftype) {
(void) mp;
if (fmode[0] != 'r' || (!access (fname, R_OK)) || ftype) {
return mp_strdup (fname);
}
return NULL;
}
@ Because |mp_find_file| is used so early, it has to be in the helpers
section.
@=
static char *mp_find_file (MP mp, const char *fname, const char *fmode,
int ftype);
static void *mp_open_file (MP mp, const char *fname, const char *fmode,
int ftype);
static char *mp_read_ascii_file (MP mp, void *f, size_t * size);
static void mp_read_binary_file (MP mp, void *f, void **d, size_t * size);
static void mp_close_file (MP mp, void *f);
static int mp_eof_file (MP mp, void *f);
static void mp_flush_file (MP mp, void *f);
static void mp_write_ascii_file (MP mp, void *f, const char *s);
static void mp_write_binary_file (MP mp, void *f, void *s, size_t t);
@ The function to open files can now be very short.
@c
void *mp_open_file (MP mp, const char *fname, const char *fmode, int ftype) {
char realmode[3];
(void) mp;
realmode[0] = *fmode;
realmode[1] = 'b';
realmode[2] = 0;
if (ftype == mp_filetype_terminal) {
return (fmode[0] == 'r' ? stdin : stdout);
} else if (ftype == mp_filetype_error) {
return stderr;
} else if (fname != NULL && (fmode[0] != 'r' || (!access (fname, R_OK)))) {
return (void *) fopen (fname, realmode);
}
return NULL;
}
@ (Almost) all file names pass through |name_of_file|.
@=
char *name_of_file; /* the name of a system file */
@ If this parameter is true, the terminal and log will report the found
file names for input files instead of the requested ones.
It is off by default because it creates an extra filename lookup.
@=
int print_found_names; /* configuration parameter */
@ @=
mp->print_found_names = (opt->print_found_names > 0 ? true : false);
@ The |file_line_error_style| parameter makes \MP\ use a more
standard compiler error message format instead of the Knuthian
exclamation mark. It needs the actual version of the current input
file name, that will be saved by |a_open_in| in the |long_name|.
TODO: currently these long strings cause memory leaks, because they cannot
be safely freed as they may appear in the |input_stack| multiple times.
In fact, the current implementation is just a quick hack in response
to a bug report for metapost 1.205.
@d long_name mp->cur_input.long_name_field /* long name of the current file */
@=
int file_line_error_style; /* configuration parameter */
@ @=
mp->file_line_error_style = (opt->file_line_error_style > 0 ? true : false);
@ \MP's file-opening procedures return |false| if no file identified by
|name_of_file| could be opened.
The |OPEN_FILE| macro takes care of the |print_found_names| parameter.
@d OPEN_FILE(A) do {
if (mp->print_found_names || mp->file_line_error_style) {
char *s = (mp->find_file)(mp,mp->name_of_file,A,ftype);
if (s!=NULL) {
*f = (mp->open_file)(mp,mp->name_of_file,A, ftype);
if (mp->print_found_names) {
xfree(mp->name_of_file);
mp->name_of_file = xstrdup(s);
}
if ((*(A) == 'r') && (ftype == mp_filetype_program)) {
long_name = xstrdup(s);
}
xfree(s);
} else {
*f = NULL;
}
} else {
*f = (mp->open_file)(mp,mp->name_of_file,A, ftype);
}
} while (0);
return (*f ? true : false)
@c
static boolean mp_a_open_in (MP mp, void **f, int ftype) {
/* open a text file for input */
OPEN_FILE ("r");
}
@#
static boolean mp_a_open_out (MP mp, void **f, int ftype) {
/* open a text file for output */
OPEN_FILE ("w");
}
@#
static boolean mp_b_open_out (MP mp, void **f, int ftype) {
/* open a binary file for output */
OPEN_FILE ("w");
}
@ @c
static char *mp_read_ascii_file (MP mp, void *ff, size_t * size) {
int c;
size_t len = 0, lim = 128;
char *s = NULL;
FILE *f = (FILE *) ff;
*size = 0;
(void) mp; /* for -Wunused */
if (f == NULL)
return NULL;
c = fgetc (f);
if (c == EOF)
return NULL;
s = malloc (lim);
if (s == NULL)
return NULL;
while (c != EOF && c != '\n' && c != '\r') {
if ((len + 1) == lim) {
s = realloc (s, (lim + (lim >> 2)));
if (s == NULL)
return NULL;
lim += (lim >> 2);
}
s[len++] = (char) c;
c = fgetc (f);
}
if (c == '\r') {
c = fgetc (f);
if (c != EOF && c != '\n')
ungetc (c, f);
}
s[len] = 0;
*size = len;
return s;
}
@ @c
void mp_write_ascii_file (MP mp, void *f, const char *s) {
(void) mp;
if (f != NULL) {
fputs (s, (FILE *) f);
}
}
@ @c
void mp_read_binary_file (MP mp, void *f, void **data, size_t * size) {
size_t len = 0;
(void) mp;
if (f != NULL)
len = fread (*data, 1, *size, (FILE *) f);
*size = len;
}
@ @c
void mp_write_binary_file (MP mp, void *f, void *s, size_t size) {
(void) mp;
if (f != NULL)
(void) fwrite (s, size, 1, (FILE *) f);
}
@ @c
void mp_close_file (MP mp, void *f) {
(void) mp;
if (f != NULL)
fclose ((FILE *) f);
}
@ @c
int mp_eof_file (MP mp, void *f) {
(void) mp;
if (f != NULL)
return feof ((FILE *) f);
else
return 1;
}
@ @c
void mp_flush_file (MP mp, void *f) {
(void) mp;
if (f != NULL)
fflush ((FILE *) f);
}
@ Input from text files is read one line at a time, using a routine called
|input_ln|. This function is defined in terms of global variables called
|buffer|, |first|, and |last| that will be described in detail later; for
now, it suffices for us to know that |buffer| is an array of |ASCII_code|
values, and that |first| and |last| are indices into this array
representing the beginning and ending of a line of text.
@=
size_t buf_size; /* maximum number of characters simultaneously present in
current lines of open files */
ASCII_code *buffer; /* lines of characters being read */
size_t first; /* the first unused position in |buffer| */
size_t last; /* end of the line just input to |buffer| */
size_t max_buf_stack; /* largest index used in |buffer| */
@ @=
mp->buf_size = 200;
mp->buffer = xmalloc ((mp->buf_size + 1), sizeof (ASCII_code));
@ @=
xfree (mp->buffer);
@ @c
static void mp_reallocate_buffer (MP mp, size_t l) {
ASCII_code *buffer;
if (l > max_halfword) {
mp_confusion (mp, "buffer size"); /* can't happen (I hope) */
}
buffer = xmalloc ((l + 1), sizeof (ASCII_code));
(void) memcpy (buffer, mp->buffer, (mp->buf_size + 1));
xfree (mp->buffer);
mp->buffer = buffer;
mp->buf_size = l;
}
@ The |input_ln| function brings the next line of input from the specified
field into available positions of the buffer array and returns the value
|true|, unless the file has already been entirely read, in which case it
returns |false| and sets |last:=first|. In general, the |ASCII_code|
numbers that represent the next line of the file are input into
|buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the
global variable |last| is set equal to |first| plus the length of the
line. Trailing blanks are removed from the line; thus, either |last=first|
(in which case the line was entirely blank) or |buffer[last-1]<>" "|.
@^inner loop@>
The variable |max_buf_stack|, which is used to keep track of how large
the |buf_size| parameter must be to accommodate the present job, is
also kept up to date by |input_ln|.
@c
static boolean mp_input_ln (MP mp, void *f) {
/* inputs the next line or returns |false| */
char *s;
size_t size = 0;
mp->last = mp->first; /* cf.\ Matthew 19\thinspace:\thinspace30 */
s = (mp->read_ascii_file) (mp, f, &size);
if (s == NULL)
return false;
if (size > 0) {
mp->last = mp->first + size;
if (mp->last >= mp->max_buf_stack) {
mp->max_buf_stack = mp->last + 1;
while (mp->max_buf_stack > mp->buf_size) {
mp_reallocate_buffer (mp, (mp->buf_size + (mp->buf_size >> 2)));
}
}
(void) memcpy ((mp->buffer + mp->first), s, size);
}
free (s);
return true;
}
@ The user's terminal acts essentially like other files of text, except
that it is used both for input and for output. When the terminal is
considered an input file, the file variable is called |term_in|, and when it
is considered an output file the file variable is |term_out|.
@^system dependencies@>
@=
void *term_in; /* the terminal as an input file */
void *term_out; /* the terminal as an output file */
void *err_out; /* the terminal as an output file */
@ Here is how to open the terminal files. In the default configuration,
nothing happens except that the command line (if there is one) is copied
to the input buffer. The variable |command_line| will be filled by the
|main| procedure.
@d t_open_out do {/* open the terminal for text output */
mp->term_out = (mp->open_file)(mp,"terminal", "w", mp_filetype_terminal);
mp->err_out = (mp->open_file)(mp,"error", "w", mp_filetype_error);
} while (0)
@d t_open_in do { /* open the terminal for text input */
mp->term_in = (mp->open_file)(mp,"terminal", "r", mp_filetype_terminal);
if (mp->command_line!=NULL) {
mp->last = strlen(mp->command_line);
(void)memcpy((void *)mp->buffer,(void *)mp->command_line,mp->last);
xfree(mp->command_line);
} else {
mp->last = 0;
}
} while (0)
@=
char *command_line;
@ Sometimes it is necessary to synchronize the input/output mixture that
happens on the user's terminal, and three system-dependent
procedures are used for this
purpose. The first of these, |update_terminal|, is called when we want
to make sure that everything we have output to the terminal so far has
actually left the computer's internal buffers and been sent.
The second, |clear_terminal|, is called when we wish to cancel any
input that the user may have typed ahead (since we are about to
issue an unexpected error message). The third, |wake_up_terminal|,
is supposed to revive the terminal if the user has disabled it by
some instruction to the operating system. The following macros show how
these operations can be specified:
@^system dependencies@>
@(mpmp.h@>=
#define update_terminal (mp->flush_file)(mp,mp->term_out) /* empty the terminal output buffer */
#define clear_terminal /* clear the terminal input buffer */
#define wake_up_terminal (mp->flush_file)(mp,mp->term_out)
/* cancel the user's cancellation of output */
@ We need a special routine to read the first line of \MP\ input from
the user's terminal. This line is different because it is read before we
have opened the transcript file; there is sort of a ``chicken and
egg'' problem here. If the user types `\.{input cmr10}' on the first
line, or if some macro invoked by that line does such an \.{input},
the transcript file will be named `\.{cmr10.log}'; but if no \.{input}
commands are performed during the first line of terminal input, the transcript
file will acquire its default name `\.{mpout.log}'. (The transcript file
will not contain error messages generated by the first line before the
first \.{input} command.)
The first line is even more special. It's nice to let the user start
running a \MP\ job by typing a command line like `\.{MP cmr10}'; in
such a case, \MP\ will operate as if the first line of input were
`\.{cmr10}', i.e., the first line will consist of the remainder of the
command line, after the part that invoked \MP.
@ Different systems have different ways to get started. But regardless of
what conventions are adopted, the routine that initializes the terminal
should satisfy the following specifications:
\yskip\textindent{1)}It should open file |term_in| for input from the
terminal. (The file |term_out| will already be open for output to the
terminal.)
\textindent{2)}If the user has given a command line, this line should be
considered the first line of terminal input. Otherwise the
user should be prompted with `\.{**}', and the first line of input
should be whatever is typed in response.
\textindent{3)}The first line of input, which might or might not be a
command line, should appear in locations |first| to |last-1| of the
|buffer| array.
\textindent{4)}The global variable |loc| should be set so that the
character to be read next by \MP\ is in |buffer[loc]|. This
character should not be blank, and we should have |loccur_input.loc_field /* location of first unread character in |buffer| */
@c
boolean mp_init_terminal (MP mp) { /* gets the terminal input started */
t_open_in;
if (mp->last != 0) {
loc = 0;
mp->first = 0;
return true;
}
while (1) {
if (!mp->noninteractive) {
wake_up_terminal;
do_putsf (mp->term_out, "**");
@.**@>;
update_terminal;
}
if (!mp_input_ln (mp, mp->term_in)) { /* this shouldn't happen */
do_putsf (mp->term_out, "\n! End of file on the terminal... why?");
@.End of file on the terminal@>;
return false;
}
loc = (halfword) mp->first;
while ((loc < (int) mp->last) && (mp->buffer[loc] == ' '))
incr (loc);
if (loc < (int) mp->last) {
return true; /* return unless the line was all blank */
}
if (!mp->noninteractive) {
do_putsf (mp->term_out, "Please type the name of your input file.\n");
}
}
}
@ @=
static boolean mp_init_terminal (MP mp);
@* String handling.
Symbolic token names and diagnostic messages are variable-length strings
of eight-bit characters. Many strings \MP\ uses are simply literals
in the compiled source, like the error messages and the names of the
internal parameters. Other strings are used or defined from the \MP\ input
language, and these have to be interned.
\MP\ uses strings more extensively than \MF\ does, but the necessary
operations can still be handled with a fairly simple data structure.
The avl tree |strings| contains all of the known string structures.
Each structure contains an |unsigned char| pointer containing the eight-bit
data, a |size_t| that holds the length of that data, and an |int| that
indicates how often this string is referenced (this will be explained below).
Such strings are referred to by structure pointers called |str_number|.
Besides the avl tree, there is a set of three variables called |cur_string|,
|cur_length| and |cur_string_size| that are used for strings while they are
being built.
@=
typedef struct {
unsigned char *str; /* the string value */
size_t len; /* its length */
int refs; /* number of references */
} mp_lstring;
typedef mp_lstring *str_number; /* for pointers to string values */
@ @=
avl_tree strings; /* string avl tree */
unsigned char *cur_string; /* current string buffer */
size_t cur_length; /* current index in that buffer */
size_t cur_string_size; /* malloced size of |cur_string| */
@ Here are the functions needed for the avl construction.
@=
static int comp_strings_entry (void *p, const void *pa, const void *pb);
static void *copy_strings_entry (const void *p);
static void *delete_strings_entry (void *p);
@ An earlier version of this function used |strncmp|, but that produces
wrong results in some cases.
@c
#define STRCMP_RESULT(a) ((a)<0 ? -1 : ((a)>0 ? 1 : 0))
static int comp_strings_entry (void *p, const void *pa, const void *pb) {
const mp_lstring *a = (const mp_lstring *) pa;
const mp_lstring *b = (const mp_lstring *) pb;
size_t l;
unsigned char *s,*t;
(void) p;
s = a->str;
t = b->str;
l = (a->len<=b->len ? a->len : b->len);
while ( l-->0 ) {
if ( *s!=*t)
return STRCMP_RESULT(*s-*t);
s++; t++;
}
return STRCMP_RESULT((int)(a->len)-(int)(b->len));
}
static void *copy_strings_entry (const void *p) {
str_number ff;
const mp_lstring *fp;
fp = (const mp_lstring *) p;
ff = malloc (sizeof (mp_lstring));
if (ff == NULL)
return NULL;
ff->str = malloc (fp->len + 1);
if (ff->str == NULL) {
return NULL;
}
memcpy ((char *) ff->str, (char *) fp->str, fp->len + 1);
ff->len = fp->len;
ff->refs = 0;
return ff;
}
static void *delete_strings_entry (void *p) {
str_number ff = (str_number) p;
mp_xfree (ff->str);
mp_xfree (ff);
return NULL;
}
@ @=
mp->strings = avl_create (comp_strings_entry,
copy_strings_entry,
delete_strings_entry, malloc, free, NULL);
mp->cur_string = NULL;
mp->cur_length = 0;
mp->cur_string_size = 0;
@ @=
if (mp->strings != NULL)
avl_destroy (mp->strings);
xfree (mp->cur_string);
@ Actually creating strings is done by |make_string|, but in order to
do so it needs a way to create a new, empty string structure.
@=
static str_number new_strings_entry (MP mp);
@ @c
static str_number new_strings_entry (MP mp) {
str_number ff;
ff = mp_xmalloc (mp, 1, sizeof (mp_lstring));
ff->str = NULL;
ff->len = 0;
ff->refs = 0;
return ff;
}
@ Most printing is done from |char *|s, but sometimes not. Here are
functions that convert an internal string into a |char *| for use
by the printing routines, and vice versa.
@d null_str mp_rts(mp,"")
@=
int mp_xstrcmp (const char *a, const char *b);
char *mp_str (MP mp, str_number s);
@ @=
static str_number mp_rtsl (MP mp, const char *s, size_t l);
static str_number mp_rts (MP mp, const char *s);
static str_number mp_make_string (MP mp);
@ @c
int mp_xstrcmp (const char *a, const char *b) {
if (a == NULL && b == NULL)
return 0;
if (a == NULL)
return -1;
if (b == NULL)
return 1;
return strcmp (a, b);
}
@ @c
char *mp_str (MP mp, str_number ss) {
(void) mp;
return (char *) ss->str;
}
str_number mp_rtsl (MP mp, const char *s, size_t l) {
str_number str;
mp_lstring tmp;
tmp.str = xmalloc (l + 1, 1);
memcpy (tmp.str, s, (l + 1));
tmp.len = l;
str = (str_number) avl_find (&tmp, mp->strings);
if (str == NULL) { /* not yet known */
str = new_strings_entry (mp);
str->str = xmalloc (l + 1, 1);
memcpy (str->str, s, (l + 1));
str->len = tmp.len;
assert (avl_ins (str, mp->strings, avl_false) > 0);
xfree (str->str);
xfree (str);
str = (str_number) avl_find (&tmp, mp->strings);
}
str->refs++;
free (tmp.str);
return str;
}
str_number mp_rts (MP mp, const char *s) {
return mp_rtsl (mp, s, strlen (s));
}
@ The next four variables for keeping track of string pool usage.
@=
integer pool_in_use; /* total number of string bytes actually in use */
integer max_pl_used; /* maximum |pool_in_use| so far */
integer strs_in_use; /* total number of strings actually in use */
integer max_strs_used; /* maximum |strs_in_use| so far */
@ Several of the elementary string operations are performed using \.{WEB}
macros instead of functions, because many of the
operations are done quite frequently and we want to avoid the
overhead of procedure calls. For example, here is
a simple macro that computes the length of a string.
@.WEB@>
@d length(A) ((A)->len) /* the number of characters in string \# */
@ Strings are created by appending character codes to |cur_string|.
The |append_char| macro, defined here, does not check to see if the
buffer overflows; this test is supposed to be
made before |append_char| is used.
To test if there is room to append |l| more characters to |cur_string|,
we shall write |str_room(l)|, which tries to make sure there is enough room
in the |cur_string|.
@d EXTRA_STRING 500
@d append_char(A) do {
if (mp->cur_string==NULL) reset_cur_string(mp);
else str_room(1);
*(mp->cur_string+mp->cur_length)=(unsigned char)(A);
mp->cur_length++;
} while (0)
@d str_room(wsize) do {
size_t nsize;
if ((mp->cur_length+(size_t)wsize) > mp->cur_string_size) {
nsize = mp->cur_string_size + mp->cur_string_size / 5 + EXTRA_STRING;
if (nsize < (size_t)(wsize)) {
nsize = (size_t)wsize + EXTRA_STRING;
}
mp->cur_string = (unsigned char *) xrealloc(mp->cur_string, (unsigned)nsize, sizeof(unsigned char));
memset (mp->cur_string+mp->cur_length,0,(nsize-mp->cur_length));
mp->cur_string_size = nsize;
}
} while (0)
@ At the very start of the metapost run and each time after
|make_string| has stored a new string in the avl tree, the
|cur_string| variable has to be prepared so that it will be ready to
start creating a new string. The initial size is fairly arbitrary, but
setting it a little higher than expected helps prevent |reallocs|
@=
static void reset_cur_string (MP mp);
@ @c
static void reset_cur_string (MP mp) {
xfree (mp->cur_string);
mp->cur_length = 0;
mp->cur_string_size = 63;
mp->cur_string = (unsigned char *) xmalloc (64, sizeof (unsigned char));
memset (mp->cur_string, 0, 64);
}
@ \MP's string expressions are implemented in a brute-force way: Every
new string or substring that is needed is simply stored into the string pool.
Space is eventually reclaimed using the aid of a simple system system
of reference counts.
@^reference counts@>
The number of references to string number |s| will be |s->refs|. The
special value |s->refs=MAX_STR_REF=127| is used to denote an unknown
positive number of references; such strings will never be recycled. If
a string is ever referred to more than 126 times, simultaneously, we
put it in this category.
@d MAX_STR_REF 127 /* ``infinite'' number of references */
@d add_str_ref(A) { if ( (A)->refs < MAX_STR_REF ) incr((A)->refs); }
@ Here's what we do when a string reference disappears:
@d delete_str_ref(A) {
if ( (A)->refs < MAX_STR_REF ) {
if ( (A)->refs > 1 ) decr((A)->refs);
else mp_flush_string(mp, (A));
}
}
@=
static void mp_flush_string (MP mp, str_number s);
@ @c
void mp_flush_string (MP mp, str_number s) {
if (s->refs == 0) {
decr (mp->strs_in_use);
mp->pool_in_use = mp->pool_in_use - (integer) length (s);
(void) avl_del (s, mp->strings, NULL);
}
}
@ Some C literals that are used as values cannot be simply added,
their reference count has to be set such that they can not be flushed.
@c
str_number mp_intern (MP mp, const char *s) {
str_number r;
r = mp_rts (mp, s);
r->refs = MAX_STR_REF;
return r;
}
@ @=
static str_number mp_intern (MP mp, const char *s);
@ Once a sequence of characters has been appended to |cur_string|, it
officially becomes a string when the function |make_string| is called.
This function returns a pointer to the new string as its value.
@=
static str_number mp_make_string (MP mp);
@ @c
str_number mp_make_string (MP mp) { /* current string enters the pool */
str_number str;
mp_lstring tmp;
tmp.str = mp->cur_string;
tmp.len = mp->cur_length;
str = (str_number) avl_find (&tmp, mp->strings);
if (str == NULL) { /* not yet known */
str = xmalloc (1, sizeof (mp_lstring));
str->str = mp->cur_string;
str->len = tmp.len;
assert (avl_ins (str, mp->strings, avl_false) > 0);
str = (str_number) avl_find (&tmp, mp->strings);
mp->pool_in_use = mp->pool_in_use + (integer) length (str);
if (mp->pool_in_use > mp->max_pl_used)
mp->max_pl_used = mp->pool_in_use;
incr (mp->strs_in_use);
if (mp->strs_in_use > mp->max_strs_used)
mp->max_strs_used = mp->strs_in_use;
str->refs = 1;
}
reset_cur_string (mp);
return str;
}
@ Here is a routine that compares two strings in the string pool,
and it does not assume that they have the same length. If the first string
is lexicographically greater than, less than, or equal to the second,
the result is respectively positive, negative, or zero.
@c
static integer mp_str_vs_str (MP mp, str_number s, str_number t) {
(void) mp;
return comp_strings_entry (NULL, (const void *) s, (const void *) t);
}
@ The first 128 strings will contain 95 standard ASCII characters, and the
other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
unless a system-dependent change is made here. Installations that have
an extended character set, where for example |xchr[032]=@t\.{'^^Z'}@>|,
would like string 032 to be printed as the single character 032 instead
of the three characters 0136, 0136, 0132 (\.{\^\^Z}). On the other hand,
even people with an extended character set will want to represent string
015 by \.{\^\^M}, since 015 is ASCII's ``carriage return'' code; the idea is
to produce visible strings instead of tabs or line-feeds or carriage-returns
or bell-rings or characters that are treated anomalously in text files.
The boolean expression defined here should be |true| unless \MP\ internal
code number~|k| corresponds to a non-troublesome visible symbol in the
local character set.
If character |k| cannot be printed, and |k<0200|, then character |k+0100| or
|k-0100| must be printable; moreover, ASCII codes |[060..071, 0141..0146]|
must be printable.
@^character set dependencies@>
@^system dependencies@>
@=
(k < ' ') || (k == 127)
@* On-line and off-line printing.
Messages that are sent to a user's terminal and to the transcript-log file
are produced by several `|print|' procedures. These procedures will
direct their output to a variety of places, based on the setting of
the global variable |selector|, which has the following possible
values:
\yskip
\hang |term_and_log|, the normal setting, prints on the terminal and on the
transcript file.
\hang |log_only|, prints only on the transcript file.
\hang |term_only|, prints only on the terminal.
\hang |no_print|, doesn't print at all. This is used only in rare cases
before the transcript file is open.
\hang |pseudo|, puts output into a cyclic buffer that is used
by the |show_context| routine; when we get to that routine we shall discuss
the reasoning behind this curious mode.
\hang |new_string|, appends the output to the current string in the
string pool.
\hang |>=write_file| prints on one of the files used for the \&{write}
@:write_}{\&{write} primitive@>
command.
\yskip
\noindent The symbolic names `|term_and_log|', etc., have been assigned
numeric codes that satisfy the convenient relations |no_print+1=term_only|,
|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|. These
relations are not used when |selector| could be |pseudo|, or |new_string|.
We need not check for unprintable characters when |selector=
void *log_file; /* transcript of \MP\ session */
void *output_file; /* the generic font output goes here */
unsigned int selector; /* where to print a message */
integer tally; /* the number of characters recently printed */
unsigned int term_offset;
/* the number of characters on the current terminal line */
unsigned int file_offset;
/* the number of characters on the current file line */
ASCII_code *trick_buf; /* circular buffer for pseudoprinting */
integer trick_count; /* threshold for pseudoprinting, explained later */
integer first_count; /* another variable for pseudoprinting */
@ @=
mp->trick_buf = xmalloc ((mp->error_line + 1), sizeof (ASCII_code));
@ @=
xfree (mp->trick_buf);
@ @=
mp->selector = term_only;
mp->tally = 0;
mp->term_offset = 0;
mp->file_offset = 0;
@ Macro abbreviations for output to the terminal and to the log file are
defined here for convenience. Some systems need special conventions
for terminal output, and it is possible to adhere to those conventions
by changing |wterm|, |wterm_ln|, and |wterm_cr| here.
@^system dependencies@>
@(mpmp.h@>=
#define do_putsf(f,b) (mp->write_ascii_file)(mp,f,b)
#define wterm(A) do_putsf(mp->term_out,(A))
#define wterm_chr(A) { unsigned char ss[2]; ss[0]=(A); ss[1]='\0'; wterm((char *)ss);}
#define wterm_cr do_putsf(mp->term_out,"\n")
#define wterm_ln(A) { wterm_cr; do_putsf(mp->term_out,(A)); }
#define wlog(A) do_putsf(mp->log_file,(A))
#define wlog_chr(A) { unsigned char ss[2]; ss[0]=(A); ss[1]='\0'; wlog((char *)ss);}
#define wlog_cr do_putsf(mp->log_file, "\n")
#define wlog_ln(A) { wlog_cr; do_putsf(mp->log_file,(A)); }
@ To end a line of text output, we call |print_ln|. Cases |0..max_write_files|
use an array |wr_file| that will be declared later.
@d mp_print_text(A) mp_print_str(mp,text((A)))
@=
void mp_print (MP mp, const char *s);
void mp_print_ln (MP mp);
void mp_print_char (MP mp, ASCII_code k);
void mp_print_str (MP mp, str_number s);
void mp_print_nl (MP mp, const char *s);
void mp_print_two (MP mp, scaled x, scaled y);
@ @=
static void mp_print_visible_char (MP mp, ASCII_code s);
@ @=
void mp_print_ln (MP mp) { /* prints an end-of-line */
switch (mp->selector) {
case term_and_log:
wterm_cr;
wlog_cr;
mp->term_offset = 0;
mp->file_offset = 0;
break;
case log_only:
wlog_cr;
mp->file_offset = 0;
break;
case term_only:
wterm_cr;
mp->term_offset = 0;
break;
case no_print:
case pseudo:
case new_string:
break;
default:
do_putsf (mp->wr_file[(mp->selector - write_file)], "\n");
}
} /* note that |tally| is not affected */
@ The |print_visible_char| procedure sends one character to the desired
destination, using the |xchr| array to map it into an external character
compatible with |input_ln|. (It assumes that it is always called with
a visible ASCII character.) All printing comes through |print_ln| or
|print_char|, which ultimately calls |print_visible_char|, hence these
routines are the ones that limit lines to at most |max_print_line| characters.
But we must make an exception for the \ps\ output file since it is not safe
to cut up lines arbitrarily in \ps.
@=
static void mp_print_visible_char (MP mp, ASCII_code s) { /* prints a single character */
switch (mp->selector) {
case term_and_log:
wterm_chr (xchr (s));
wlog_chr (xchr (s));
incr (mp->term_offset);
incr (mp->file_offset);
if (mp->term_offset == (unsigned) mp->max_print_line) {
wterm_cr;
mp->term_offset = 0;
};
if (mp->file_offset == (unsigned) mp->max_print_line) {
wlog_cr;
mp->file_offset = 0;
};
break;
case log_only:
wlog_chr (xchr (s));
incr (mp->file_offset);
if (mp->file_offset == (unsigned) mp->max_print_line)
mp_print_ln (mp);
break;
case term_only:
wterm_chr (xchr (s));
incr (mp->term_offset);
if (mp->term_offset == (unsigned) mp->max_print_line)
mp_print_ln (mp);
break;
case no_print:
break;
case pseudo:
if (mp->tally < mp->trick_count)
mp->trick_buf[mp->tally % mp->error_line] = s;
break;
case new_string:
append_char (s);
break;
default:
{
text_char ss[2];
ss[0] = xchr (s);
ss[1] = 0;
do_putsf (mp->wr_file[(mp->selector - write_file)], (char *) ss);
}
}
incr (mp->tally);
}
@ The |print_char| procedure sends one character to the desired destination.
File names and string expressions might contain |ASCII_code| values that
can't be printed using |print_visible_char|. These characters will be
printed in three- or four-symbol form like `\.{\^\^A}' or `\.{\^\^e4}'.
(This procedure assumes that it is safe to bypass all checks for unprintable
characters when |selector| is in the range |0..max_write_files-1|.
The user might want to write unprintable characters.
@=
void mp_print_char (MP mp, ASCII_code k) { /* prints a single character */
if (mp->selector < pseudo || mp->selector >= write_file) {
mp_print_visible_char (mp, k);
} else if (@) {
mp_print (mp, "^^");
if (k < 0100) {
mp_print_visible_char (mp, (ASCII_code) (k + 0100));
} else if (k < 0200) {
mp_print_visible_char (mp, (ASCII_code) (k - 0100));
} else {
int l; /* small index or counter */
l = (k / 16);
mp_print_visible_char (mp, xord (l < 10 ? l + '0' : l - 10 + 'a'));
l = (k % 16);
mp_print_visible_char (mp, xord (l < 10 ? l + '0' : l - 10 + 'a'));
}
} else {
mp_print_visible_char (mp, k);
}
}
@ An entire string is output by calling |print|. Note that if we are outputting
the single standard ASCII character \.c, we could call |print("c")|, since
|"c"=99| is the number of a single-character string, as explained above. But
|print_char("c")| is quicker, so \MP\ goes directly to the |print_char|
routine when it knows that this is safe. (The present implementation
assumes that it is always safe to print a visible ASCII character.)
@^system dependencies@>
@=
static void mp_do_print (MP mp, const char *ss, size_t len) { /* prints string |s| */
size_t j = 0;
if (mp->selector == new_string) {
str_room ((len * 4));
}
while (j < len) {
/* this was |xord((int)ss[j])| but that doesnt work */
mp_print_char (mp, (ASCII_code) ss[j]);
j++;
}
}
@
@=
void mp_print (MP mp, const char *ss) {
if (ss == NULL)
return;
mp_do_print (mp, ss, strlen (ss));
}
void mp_print_str (MP mp, str_number s) {
assert (s != NULL);
mp_do_print (mp, (const char *) s->str, s->len);
}
@ Here is the very first thing that \MP\ prints: a headline that identifies
the version number and base name. The |term_offset| variable is temporarily
incorrect, but the discrepancy is not serious since we assume that the banner
and mem identifier together will occupy at most |max_print_line|
character positions.
@=
wterm (mp->banner);
if (mp->mem_ident != NULL)
mp_print (mp, mp->mem_ident);
mp_print_ln (mp);
update_terminal;
@ The procedure |print_nl| is like |print|, but it makes sure that the
string appears at the beginning of a new line.
@=
void mp_print_nl (MP mp, const char *s) { /* prints string |s| at beginning of line */
switch (mp->selector) {
case term_and_log:
if ((mp->term_offset > 0) || (mp->file_offset > 0))
mp_print_ln (mp);
break;
case log_only:
if (mp->file_offset > 0)
mp_print_ln (mp);
break;
case term_only:
if (mp->term_offset > 0)
mp_print_ln (mp);
break;
case no_print:
case pseudo:
case new_string:
break;
} /* there are no other cases */
mp_print (mp, s);
}
@ The following procedure, which prints out the decimal representation of a
given integer |n|, assumes that all integers fit nicely into a |int|.
@^system dependencies@>
@=
void mp_print_int (MP mp, integer n) { /* prints an integer in decimal form */
char s[12];
mp_snprintf (s, 12, "%d", (int) n);
mp_print (mp, s);
}
@ @=
void mp_print_int (MP mp, integer n);
@ \MP\ also makes use of a trivial procedure to print two digits. The
following subroutine is usually called with a parameter in the range |0<=n<=99|.
@c
static void mp_print_dd (MP mp, integer n) { /* prints two least significant digits */
n = abs (n) % 100;
mp_print_char (mp, xord ('0' + (n / 10)));
mp_print_char (mp, xord ('0' + (n % 10)));
}
@ @=
static void mp_print_dd (MP mp, integer n);
@ Here is a procedure that asks the user to type a line of input,
assuming that the |selector| setting is either |term_only| or |term_and_log|.
The input is placed into locations |first| through |last-1| of the
|buffer| array, and echoed on the transcript file if appropriate.
This procedure is never called when |interactionnoninteractive) {
wake_up_terminal; mp_print(mp, (A));
}
mp_term_input(mp);
} while (0) /* prints a string and gets a line of input */
@c
void mp_term_input (MP mp) { /* gets a line from the terminal */
size_t k; /* index into |buffer| */
if (mp->noninteractive) {
if (!mp_input_ln (mp, mp->term_in))
longjmp (*(mp->jump_buf), 1); /* chunk finished */
mp->buffer[mp->last] = xord ('%');
} else {
update_terminal; /* Now the user sees the prompt for sure */
if (!mp_input_ln (mp, mp->term_in)) {
mp_fatal_error (mp, "End of file on the terminal!");
@.End of file on the terminal@>
}
mp->term_offset = 0; /* the user's line ended with \<\rm return> */
decr (mp->selector); /* prepare to echo the input */
if (mp->last != mp->first) {
for (k = mp->first; k < mp->last; k++) {
mp_print_char (mp, mp->buffer[k]);
}
}
mp_print_ln (mp);
mp->buffer[mp->last] = xord ('%');
incr (mp->selector); /* restore previous status */
}
}
@* Reporting errors.
When something anomalous is detected, \MP\ typically does something like this:
$$\vbox{\halign{#\hfil\cr
|print_err("Something anomalous has been detected");|\cr
|help3("This is the first line of my offer to help.")|\cr
|("This is the second line. I'm trying to")|\cr
|("explain the best way for you to proceed.");|\cr
|error;|\cr}}$$
A two-line help message would be given using |help2|, etc.; these informal
helps should use simple vocabulary that complements the words used in the
official error message that was printed. (Outside the U.S.A., the help
messages should preferably be translated into the local vernacular. Each
line of help is at most 60 characters long, in the present implementation,
so that |max_print_line| will not be exceeded.)
The |print_err| procedure supplies a `\.!' before the official message,
and makes sure that the terminal is awake if a stop is going to occur.
The |error| procedure supplies a `\..' after the official message, then it
shows the location of the error; and if |interaction=error_stop_mode|,
it also enters into a dialog with the user, during which time the help
message may be printed.
@^system dependencies@>
@ The global variable |interaction| has four settings, representing increasing
amounts of user interaction:
@=
enum mp_interaction_mode {
mp_unspecified_mode = 0, /* extra value for command-line switch */
mp_batch_mode, /* omits all stops and omits terminal output */
mp_nonstop_mode, /* omits all stops */
mp_scroll_mode, /* omits error stops */
mp_error_stop_mode /* stops at every opportunity to interact */
};
@ @=
int interaction; /* current level of interaction */
int noninteractive; /* do we have a terminal? */
@ Set it here so it can be overwritten by the commandline
@=
mp->interaction = opt->interaction;
if (mp->interaction == mp_unspecified_mode
|| mp->interaction > mp_error_stop_mode)
mp->interaction = mp_error_stop_mode;
if (mp->interaction < mp_unspecified_mode)
mp->interaction = mp_batch_mode;
@
@d print_err(A) mp_print_err(mp,(A))
@=
void mp_print_err (MP mp, const char *A);
@ @c
void mp_print_err (MP mp, const char *A) {
if (mp->interaction == mp_error_stop_mode)
wake_up_terminal;
if (mp->file_line_error_style && file_state && !terminal_input) {
mp_print_nl (mp, "");
if (long_name != NULL) {
mp_print (mp, long_name);
} else {
mp_print (mp, mp_str (mp, name));
}
mp_print (mp, ":");
mp_print_int (mp, line);
mp_print (mp, ": ");
} else {
mp_print_nl (mp, "! ");
}
mp_print (mp, A);
@.!\relax@>
}
@ \MP\ is careful not to call |error| when the print |selector| setting
might be unusual. The only possible values of |selector| at the time of
error messages are
\yskip\hang|no_print| (when |interaction=mp_batch_mode|
and |log_file| not yet open);
\hang|term_only| (when |interaction>mp_batch_mode| and |log_file| not yet open);
\hang|log_only| (when |interaction=mp_batch_mode| and |log_file| is open);
\hang|term_and_log| (when |interaction>mp_batch_mode| and |log_file| is open).
@=
if (mp->interaction == mp_batch_mode)
mp->selector = no_print;
else
mp->selector = term_only
@ A global variable |deletions_allowed| is set |false| if the |get_next|
routine is active when |error| is called; this ensures that |get_next|
will never be called recursively.
@^recursion@>
The global variable |history| records the worst level of error that
has been detected. It has four possible values: |spotless|, |warning_issued|,
|error_message_issued|, and |fatal_error_stop|.
Another global variable, |error_count|, is increased by one when an
|error| occurs without an interactive dialog, and it is reset to zero at
the end of every statement. If |error_count| reaches 100, \MP\ decides
that there is no point in continuing further.
@=
enum mp_history_state {
mp_spotless = 0, /* |history| value when nothing has been amiss yet */
mp_warning_issued, /* |history| value when |begin_diagnostic| has been called */
mp_error_message_issued, /* |history| value when |error| has been called */
mp_fatal_error_stop, /* |history| value when termination was premature */
mp_system_error_stop /* |history| value when termination was due to disaster */
};
@ @=
boolean deletions_allowed; /* is it safe for |error| to call |get_next|? */
int history; /* has the source input been clean so far? */
int error_count; /* the number of scrolled errors since the last statement ended */
@ The value of |history| is initially |fatal_error_stop|, but it will
be changed to |spotless| if \MP\ survives the initialization process.
@=
mp->deletions_allowed = true; /* |history| is initialized elsewhere */
@ Since errors can be detected almost anywhere in \MP, we want to declare the
error procedures near the beginning of the program. But the error procedures
in turn use some other procedures, which need to be declared |forward|
before we get to |error| itself.
It is possible for |error| to be called recursively if some error arises
when |get_next| is being used to delete a token, and/or if some fatal error
occurs while \MP\ is trying to fix a non-fatal one. But such recursion
@^recursion@>
is never more than two levels deep.
@=
static void mp_get_next (MP mp);
static void mp_term_input (MP mp);
static void mp_show_context (MP mp);
static void mp_begin_file_reading (MP mp);
static void mp_open_log_file (MP mp);
static void mp_clear_for_error_prompt (MP mp);
@ @=
void mp_normalize_selector (MP mp);
@ Individual lines of help are recorded in the array |help_line|, which
contains entries in positions |0..(help_ptr-1)|. They should be printed
in reverse order, i.e., with |help_line[0]| appearing last.
@d hlp1(A) mp->help_line[0]=A; }
@d hlp2(A,B) mp->help_line[1]=A; hlp1(B)
@d hlp3(A,B,C) mp->help_line[2]=A; hlp2(B,C)
@d hlp4(A,B,C,D) mp->help_line[3]=A; hlp3(B,C,D)
@d hlp5(A,B,C,D,E) mp->help_line[4]=A; hlp4(B,C,D,E)
@d hlp6(A,B,C,D,E,F) mp->help_line[5]=A; hlp5(B,C,D,E,F)
@d help0 mp->help_ptr=0 /* sometimes there might be no help */
@d help1 { mp->help_ptr=1; hlp1 /* use this with one help line */
@d help2 { mp->help_ptr=2; hlp2 /* use this with two help lines */
@d help3 { mp->help_ptr=3; hlp3 /* use this with three help lines */
@d help4 { mp->help_ptr=4; hlp4 /* use this with four help lines */
@d help5 { mp->help_ptr=5; hlp5 /* use this with five help lines */
@d help6 { mp->help_ptr=6; hlp6 /* use this with six help lines */
@=
const char *help_line[6]; /* helps for the next |error| */
unsigned int help_ptr; /* the number of help lines present */
boolean use_err_help; /* should the |err_help| string be shown? */
str_number err_help; /* a string set up by \&{errhelp} */
@ @=
mp->use_err_help = false;
@ The |jump_out| procedure just cuts across all active procedure levels and
goes to |end_of_MP|. This is the only nonlocal |goto| statement in the
whole program. It is used when there is no recovery from a particular error.
The program uses a |jump_buf| to handle this, this is initialized at three
spots: the start of |mp_new|, the start of |mp_initialize|, and the start
of |mp_run|. Those are the only library enty points.
@^system dependencies@>
@=
jmp_buf *jump_buf;
@ If the array of internals is still |NULL| when |jump_out| is called, a
crash occured during initialization, and it is not safe to run the normal
cleanup routine.
@=
static void mp_jump_out (MP mp) {
if (mp->internal != NULL && mp->history < mp_system_error_stop)
mp_close_files_and_terminate (mp);
longjmp (*(mp->jump_buf), 1);
}
@ Here now is the general |error| routine.
@=
void mp_error (MP mp) { /* completes the job of error reporting */
ASCII_code c; /* what the user types */
integer s1, s2; /* used to save global variables when deleting tokens */
mp_sym s3; /* likewise */
if (mp->history < mp_error_message_issued)
mp->history = mp_error_message_issued;
mp_print_char (mp, xord ('.'));
mp_show_context (mp);
if (mp->halt_on_error) {
mp->history = mp_fatal_error_stop;
mp_jump_out (mp);
}
if ((!mp->noninteractive) && (mp->interaction == mp_error_stop_mode)) {
@;
}
incr (mp->error_count);
if (mp->error_count == 100) {
mp_print_nl (mp, "(That makes 100 errors; please try again.)");
@.That makes 100 errors...@>;
mp->history = mp_fatal_error_stop;
mp_jump_out (mp);
}
@;
}
void mp_warn (MP mp, const char *msg) {
unsigned saved_selector = mp->selector;
mp_normalize_selector (mp);
mp_print_nl (mp, "Warning: ");
mp_print (mp, msg);
mp_print_ln (mp);
mp->selector = saved_selector;
}
@ @=
extern void mp_error (MP mp);
extern void mp_warn (MP mp, const char *msg);
@ @=
while (true) {
CONTINUE:
mp_clear_for_error_prompt (mp);
prompt_input ("? ");
@.?\relax@>;
if (mp->last == mp->first)
return;
c = mp->buffer[mp->first];
if (c >= 'a')
c = (ASCII_code) (c + 'A' - 'a'); /* convert to uppercase */
@;
}
@ It is desirable to provide an `\.E' option here that gives the user
an easy way to return from \MP\ to the system editor, with the offending
line ready to be edited. But such an extension requires some system
wizardry, so the present implementation simply types out the name of the
file that should be
edited and the relevant line number.
@^system dependencies@>
@=
typedef void (*mp_editor_cmd) (MP, char *, int);
@ @=
mp_editor_cmd run_editor;
@ @=
set_callback_option (run_editor);
@ @=
static void mp_run_editor (MP mp, char *fname, int fline);
@ @c
void mp_run_editor (MP mp, char *fname, int fline) {
char *s = xmalloc (256, 1);
mp_snprintf (s, 256, "You want to edit file %s at line %d\n", fname, fline);
wterm_ln (s);
@.You want to edit file x@>
}
@
There is a secret `\.D' option available when the debugging routines haven't
been commented~out.
@^debugging@>
@=
switch (c) {
case '0':
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
if (mp->deletions_allowed) {
@;
}
break;
case 'E':
if (mp->file_ptr > 0) {
mp->interaction = mp_scroll_mode;
mp_close_files_and_terminate (mp);
(mp->run_editor) (mp,
mp_str (mp, mp->input_stack[mp->file_ptr].name_field),
mp_true_line (mp));
mp_jump_out (mp);
}
break;
case 'H':
@;
/* |break;| */
case 'I':
@;
/* |break;| */
case 'Q':
case 'R':
case 'S':
@;
/* |break;| */
case 'X':
mp->interaction = mp_scroll_mode;
mp_jump_out (mp);
break;
default:
break;
}
@
@ @=
{
mp_print (mp, "Type to proceed, S to scroll future error messages,");
@.Type to proceed...@>;
mp_print_nl (mp, "R to run without stopping, Q to run quietly,");
mp_print_nl (mp, "I to insert something, ");
if (mp->file_ptr > 0)
mp_print (mp, "E to edit your file,");
if (mp->deletions_allowed)
mp_print_nl (mp,
"1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
mp_print_nl (mp, "H for help, X to quit.");
}
@ Here the author of \MP\ apologizes for making use of the numerical
relation between |"Q"|, |"R"|, |"S"|, and the desired interaction settings
|mp_batch_mode|, |mp_nonstop_mode|, |mp_scroll_mode|.
@^Knuth, Donald Ervin@>
@=
{
mp->error_count = 0;
mp->interaction = mp_batch_mode + c - 'Q';
mp_print (mp, "OK, entering ");
switch (c) {
case 'Q':
mp_print (mp, "batchmode");
decr (mp->selector);
break;
case 'R':
mp_print (mp, "nonstopmode");
break;
case 'S':
mp_print (mp, "scrollmode");
break;
} /* there are no other cases */
mp_print (mp, "...");
mp_print_ln (mp);
update_terminal;
return;
}
@ When the following code is executed, |buffer[(first+1)..(last-1)]| may
contain the material inserted by the user; otherwise another prompt will
be given. In order to understand this part of the program fully, you need
to be familiar with \MP's input stacks.
@=
{
mp_begin_file_reading (mp); /* enter a new syntactic level for terminal input */
if (mp->last > mp->first + 1) {
loc = (halfword) (mp->first + 1);
mp->buffer[mp->first] = xord (' ');
} else {
prompt_input ("insert>");
loc = (halfword) mp->first;
@.insert>@>
}
mp->first = mp->last + 1;
mp->cur_input.limit_field = (halfword) mp->last;
return;
}
@ We allow deletion of up to 99 tokens at a time.
@=
{
s1 = mp->cur_cmd;
s2 = mp->cur_mod;
s3 = mp->cur_sym;
mp->OK_to_interrupt = false;
if ((mp->last > mp->first + 1) && (mp->buffer[mp->first + 1] >= '0')
&& (mp->buffer[mp->first + 1] <= '9'))
c = xord (c * 10 + mp->buffer[mp->first + 1] - '0' * 11);
else
c = (ASCII_code) (c - '0');
while (c > 0) {
mp_get_next (mp); /* one-level recursive call of |error| is possible */
@;
c--;
};
mp->cur_cmd = s1;
mp->cur_mod = s2;
mp->cur_sym = s3;
mp->OK_to_interrupt = true;
help2 ("I have just deleted some text, as you asked.",
"You can now delete more, or insert, or whatever.");
mp_show_context (mp);
goto CONTINUE;
}
@ @=
{
if (mp->use_err_help) {
@;
mp->use_err_help = false;
} else {
if (mp->help_ptr == 0) {
help2 ("Sorry, I don't know how to help in this situation.",
"Maybe you should try asking a human?");
}
do {
decr (mp->help_ptr);
mp_print (mp, mp->help_line[mp->help_ptr]);
mp_print_ln (mp);
} while (mp->help_ptr != 0);
};
help4 ("Sorry, I already gave what help I could...",
"Maybe you should try asking a human?",
"An error might have occurred before I noticed any problems.",
"``If all else fails, read the instructions.''");
goto CONTINUE;
}
@ @=
{
size_t j = 0;
while (j < length (mp->err_help)) {
if (*(mp->err_help->str + j) != '%')
mp_print (mp, (const char *) (mp->err_help->str + j));
else if (j + 1 == length (mp->err_help))
mp_print_ln (mp);
else if (*(mp->err_help->str + j) != '%')
mp_print_ln (mp);
else {
j++;
mp_print_char (mp, xord ('%'));
};
j++;
}
}
@ @=
if (mp->interaction > mp_batch_mode)
decr (mp->selector); /* avoid terminal output */
if (mp->use_err_help) {
mp_print_nl (mp, "");
@;
} else {
while (mp->help_ptr > 0) {
decr (mp->help_ptr);
mp_print_nl (mp, mp->help_line[mp->help_ptr]);
};
mp_print_ln (mp);
if (mp->interaction > mp_batch_mode)
incr (mp->selector); /* re-enable terminal output */
mp_print_ln (mp);
}
@ In anomalous cases, the print selector might be in an unknown state;
the following subroutine is called to fix things just enough to keep
running a bit longer.
@c
void mp_normalize_selector (MP mp) {
if (mp->log_opened)
mp->selector = term_and_log;
else
mp->selector = term_only;
if (mp->job_name == NULL)
mp_open_log_file (mp);
if (mp->interaction == mp_batch_mode)
decr (mp->selector);
}
@ The following procedure prints \MP's last words before dying.
@d succumb { if ( mp->interaction==mp_error_stop_mode )
mp->interaction=mp_scroll_mode; /* no more interaction */
if ( mp->log_opened ) mp_error(mp);
mp->history=mp_fatal_error_stop; mp_jump_out(mp); /* irrecoverable error */
}
@=
void mp_fatal_error (MP mp, const char *s) { /* prints |s|, and that's it */
mp_normalize_selector (mp);
print_err ("Emergency stop");
help1 (s);
succumb;
@.Emergency stop@>
}
@ @=
extern void mp_fatal_error (MP mp, const char *s);
@ Here is the most dreaded error message.
@=
void mp_overflow (MP mp, const char *s, integer n) { /* stop due to finiteness */
char msg[256];
mp_normalize_selector (mp);
mp_snprintf (msg, 256, "MetaPost capacity exceeded, sorry [%s=%d]", s,
(int) n);
@.MetaPost capacity exceeded ...@>;
print_err (msg);
help2 ("If you really absolutely need more capacity,",
"you can ask a wizard to enlarge me.");
succumb;
}
@ @=
void mp_overflow (MP mp, const char *s, integer n);
@ The program might sometime run completely amok, at which point there is
no choice but to stop. If no previous error has been detected, that's bad
news; a message is printed that is really intended for the \MP\
maintenance person instead of the user (unless the user has been
particularly diabolical). The index entries for `this can't happen' may
help to pinpoint the problem.
@^dry rot@>
@=
void mp_confusion (MP mp, const char *s);
@ Consistency check violated; |s| tells where.
@=
void mp_confusion (MP mp, const char *s) {
char msg[256];
mp_normalize_selector (mp);
if (mp->history < mp_error_message_issued) {
mp_snprintf (msg, 256, "This can't happen (%s)", s);
@.This can't happen@>;
print_err (msg);
help1 ("I'm broken. Please show this to someone who can fix can fix");
} else {
print_err ("I can\'t go on meeting you like this");
@.I can't go on...@>;
help2 ("One of your faux pas seems to have wounded me deeply...",
"in fact, I'm barely conscious. Please fix it and try again.");
}
succumb;
}
@ Users occasionally want to interrupt \MP\ while it's running.
If the runtime system allows this, one can implement
a routine that sets the global variable |interrupt| to some nonzero value
when such an interrupt is signaled. Otherwise there is probably at least
a way to make |interrupt| nonzero using the C debugger.
@^system dependencies@>
@^debugging@>
@d check_interrupt { if ( mp->interrupt!=0 )
mp_pause_for_instructions(mp); }
@=
integer interrupt; /* should \MP\ pause for instructions? */
boolean OK_to_interrupt; /* should interrupts be observed? */
integer run_state; /* are we processing input ? */
boolean finished; /* set true by |close_files_and_terminate| */
boolean reading_preload;
@ @=
mp->OK_to_interrupt = true;
mp->finished = false;
@ When an interrupt has been detected, the program goes into its
highest interaction level and lets the user have the full flexibility of
the |error| routine. \MP\ checks for interrupts only at times when it is
safe to do this.
@c
static void mp_pause_for_instructions (MP mp) {
if (mp->OK_to_interrupt) {
mp->interaction = mp_error_stop_mode;
if ((mp->selector == log_only) || (mp->selector == no_print))
incr (mp->selector);
print_err ("Interruption");
@.Interruption@>;
help3 ("You rang?",
"Try to insert some instructions for me (e.g.,`I show x'),",
"unless you just want to quit by typing `X'.");
mp->deletions_allowed = false;
mp_error (mp);
mp->deletions_allowed = true;
mp->interrupt = 0;
}
}
@ Many of \MP's error messages state that a missing token has been
inserted behind the scenes. We can save string space and program space
by putting this common code into a subroutine.
@c
static void mp_missing_err (MP mp, const char *s) {
char msg[256];
mp_snprintf (msg, 256, "Missing `%s' has been inserted", s);
@.Missing...inserted@>;
print_err (msg);
}
@* Arithmetic with scaled numbers.
The principal computations performed by \MP\ are done entirely in terms of
integers less than $2^{31}$ in magnitude; thus, the arithmetic specified in this
program can be carried out in exactly the same way on a wide variety of
computers, including some small ones.
@^small computers@>
But C does not rigidly define the |/| operation in the case of negative
dividends; for example, the result of |(-2*n-1) / 2| is |-(n+1)| on some
computers and |-n| on others (is this true ?). There are two principal
types of arithmetic: ``translation-preserving,'' in which the identity
|(a+q*b)/b=(a/b)+q| is valid; and ``negation-preserving,'' in which
|(-a)/b=-(a/b)|. This leads to two \MP s, which can produce
different results, although the differences should be negligible when the
language is being used properly. The \TeX\ processor has been defined
carefully so that both varieties of arithmetic will produce identical
output, but it would be too inefficient to constrain \MP\ in a similar way.
@d EL_GORDO ((math_data *)mp->math)->max_scaled_
@ A single computation might use several subroutine calls, and it is
desirable to avoid producing multiple error messages in case of arithmetic
overflow. So the routines below set the global variable |arith_error| to |true|
instead of reporting errors directly to the user.
@^overflow in arithmetic@>
@=
boolean arith_error; /* has arithmetic overflow occurred recently? */
@ @=
mp->arith_error = false;
@ At crucial points the program will say |check_arith|, to test if
an arithmetic error has been detected.
@d check_arith do {
if ( mp->arith_error )
mp_clear_arith(mp);
} while (0)
@c
static void mp_clear_arith (MP mp) {
print_err ("Arithmetic overflow");
@.Arithmetic overflow@>;
help4 ("Uh, oh. A little while ago one of the quantities that I was",
"computing got too large, so I'm afraid your answers will be",
"somewhat askew. You'll probably have to adopt different",
"tactics next time. But I shall try to carry on anyway.");
mp_error (mp);
mp->arith_error = false;
}
@ The definitions of these are set up by the math initialization.
@d unity ((math_data *)mp->math)->unity_
@d two ((math_data *)mp->math)->two_
@d three ((math_data *)mp->math)->three_
@d half_unit ((math_data *)mp->math)->half_unit_
@d three_quarter_unit ((math_data *)mp->math)->three_quarter_unit_
@ In fact, the two sorts of scaling discussed above aren't quite
sufficient; \MP\ has yet another, used internally to keep track of angles.
@=
#if 1
typedef int scaled; /* this type is used for scaled integers */
#else
typedef struct scaled {
int val;
} scaled;
#endif
typedef int fraction; /* this type is used for scaled fractions */
typedef int angle; /* this type is used for scaled angles */
@ We often want to print two scaled quantities in parentheses,
separated by a comma.
@=
void mp_print_two (MP mp, scaled x, scaled y) { /* prints `|(x,y)|' */
mp_print_char (mp, xord ('('));
mp_print_scaled (mp, x);
mp_print_char (mp, xord (','));
mp_print_scaled (mp, y);
mp_print_char (mp, xord (')'));
}
@
@d fraction_one ((math_data *)mp->math)->fraction_one_
@d fraction_half ((math_data *)mp->math)->fraction_half_
@d fraction_two ((math_data *)mp->math)->fraction_two_
@d fraction_three ((math_data *)mp->math)->fraction_three_
@d fraction_four ((math_data *)mp->math)->fraction_four_
@d ninety_deg ((math_data *)mp->math)->ninety_deg_
@d one_eighty_deg ((math_data *)mp->math)->one_eighty_deg_
@d three_sixty_deg ((math_data *)mp->math)->three_sixty_deg_
@ @=
integer k; /* all-purpose loop index */
@ And now let's complete our collection of numeric utility routines
by considering random number generation.
\MP\ generates pseudo-random numbers with the additive scheme recommended
in Section 3.6 of {\sl The Art of Computer Programming}; however, the
results are random fractions between 0 and |fraction_one-1|, inclusive.
There's an auxiliary array |randoms| that contains 55 pseudo-random
fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-31})\bmod 2^{28}$,
we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|.
The global variable |j_random| tells which element has most recently
been consumed.
The global variable |random_seed| was introduced in version 0.9,
for the sole reason of stressing the fact that the initial value of the
random seed is system-dependant. The initialization code below will initialize
this variable to |(internal[mp_time] div unity)+internal[mp_day]|, but this
is not good enough on modern fast machines that are capable of running
multiple MetaPost processes within the same second.
@^system dependencies@>
@=
fraction randoms[55]; /* the last 55 random values generated */
int j_random; /* the number of unused |randoms| */
@ @=
int random_seed; /* the default random seed */
@ @=
mp->random_seed = opt->random_seed;
@ To consume a random fraction, the program below will say `|next_random|'
and then it will fetch |randoms[j_random]|.
@d next_random { if ( mp->j_random==0 ) mp_new_randoms(mp);
else decr(mp->j_random); }
@c
static void mp_new_randoms (MP mp) {
int k; /* index into |randoms| */
fraction x; /* accumulator */
for (k = 0; k <= 23; k++) {
x = mp->randoms[k] - mp->randoms[k + 31];
if (x < 0)
x = x + fraction_one;
mp->randoms[k] = x;
}
for (k = 24; k <= 54; k++) {
x = mp->randoms[k] - mp->randoms[k - 24];
if (x < 0)
x = x + fraction_one;
mp->randoms[k] = x;
}
mp->j_random = 54;
}
@ @=
static void mp_init_randoms (MP mp, int seed);
@ To initialize the |randoms| table, we call the following routine.
@c
void mp_init_randoms (MP mp, int seed) {
fraction j, jj, k; /* more or less random integers */
int i; /* index into |randoms| */
j = abs (seed);
while (j >= fraction_one)
j = halfp (j);
k = 1;
for (i = 0; i <= 54; i++) {
jj = k;
k = j - k;
j = jj;
if (k < 0)
k = k + fraction_one;
mp->randoms[(i * 21) % 55] = j;
}
mp_new_randoms (mp);
mp_new_randoms (mp);
mp_new_randoms (mp); /* ``warm up'' the array */
}
@ To produce a uniform random number in the range |0<=u=u>x|
or |0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
Note that the call of |take_fraction| will produce the values 0 and~|x|
with about half the probability that it will produce any other particular
values between 0 and~|x|, because it rounds its answers.
@c
static scaled mp_unif_rand (MP mp, scaled x) {
scaled y; /* trial value */
next_random;
y = mp_take_fraction (mp, abs (x), mp->randoms[mp->j_random]);
if (y == abs (x))
return 0;
else if (x > 0)
return y;
else
return (-y);
}
@ Finally, a normal deviate with mean zero and unit standard deviation
can readily be obtained with the ratio method (Algorithm 3.4.1R in
{\sl The Art of Computer Programming\/}).
@c
static scaled mp_norm_rand (MP mp) {
integer x, u, l; /* what the book would call $2^{16}X$, $2^{28}U$, and $-2^{24}\ln U$ */
do {
do {
next_random;
x =
mp_take_fraction (mp, 112429,
mp->randoms[mp->j_random] - fraction_half);
/* $2^{16}\sqrt{8/e}\approx 112428.82793$ */
next_random;
u = mp->randoms[mp->j_random];
} while (abs (x) >= u);
x = mp_make_fraction (mp, x, u);
l = 139548960 - mp_m_log (mp, u); /* $2^{24}\cdot12\ln2\approx139548959.6165$ */
} while (mp_ab_vs_cd (mp, 1024, l, x, x) < 0);
return x;
}
@* Packed data.
@d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */
@d max_halfword 0xFFFFFFF /* largest allowable value in a |halfword| */
@ The macros |qi| and |qo| are used for input to and output
from quarterwords. These are legacy macros.
@^system dependencies@>
@d qo(A) (A) /* to read eight bits from a quarterword */
@d qi(A) (quarterword)(A) /* to store eight bits in a quarterword */
@ The reader should study the following definitions closely:
@^system dependencies@>
@=
typedef struct mp_value_node_data *mp_value_node;
typedef struct mp_node_data *mp_node;
typedef struct mp_symbol_entry *mp_sym;
typedef short quarterword; /* 1/4 of a word */
typedef int halfword; /* 1/2 of a word */
typedef struct {
halfword val;
integer scale;
str_number str;
mp_sym sym;
mp_node node;
mp_knot p;
} mp_value_data;
typedef struct {
mp_variable_type type;
mp_value_data data;
} mp_value;
typedef struct {
quarterword b0, b1, b2, b3;
} four_quarters;
typedef union {
integer sc;
four_quarters qqqq;
} font_data;
@
@d xfree(A) do { mp_xfree(A); A=NULL; } while (0)
@d xrealloc(P,A,B) mp_xrealloc(mp,P,(size_t)A,B)
@d xmalloc(A,B) mp_xmalloc(mp,(size_t)A,B)
@d xstrdup(A) mp_xstrdup(mp,A)
@d XREALLOC(a,b,c) a = xrealloc(a,(b+1),sizeof(c));
@=
extern char *mp_strdup (const char *p);
extern char *mp_strldup (const char *p, size_t l);
extern void mp_xfree (void *x);
extern void *mp_xrealloc (MP mp, void *p, size_t nmem, size_t size);
extern void *mp_xmalloc (MP mp, size_t nmem, size_t size);
extern char *mp_xstrdup (MP mp, const char *s);
extern char *mp_xstrldup (MP mp, const char *s, size_t l);
@ Some care has to be taken while copying strings
@c
char *mp_strldup (const char *p, size_t l) {
char *r, *s;
if (p == NULL)
return NULL;
r = malloc ((size_t) (l * sizeof (char) + 1));
if (r == NULL)
return NULL;
s = memcpy (r, p, (size_t) (l));
*(s + l) = '\0';
return s;
}
char *mp_strdup (const char *p) {
if (p == NULL)
return NULL;
return mp_strldup (p, strlen (p));
}
@ The |max_size_test| guards against overflow, on the assumption that
|size_t| is at least 31bits wide.
@d max_size_test 0x7FFFFFFF
@c
void mp_xfree (void *x) {
if (x != NULL)
free (x);
}
void *mp_xrealloc (MP mp, void *p, size_t nmem, size_t size) {
void *w;
if ((max_size_test / size) < nmem) {
do_putsf (mp->err_out, "Memory size overflow!\n");
mp->history = mp_fatal_error_stop;
mp_jump_out (mp);
}
w = realloc (p, (nmem * size));
if (w == NULL) {
do_putsf (mp->err_out, "Out of memory!\n");
mp->history = mp_system_error_stop;
mp_jump_out (mp);
}
return w;
}
void *mp_xmalloc (MP mp, size_t nmem, size_t size) {
void *w;
if ((max_size_test / size) < nmem) {
do_putsf (mp->err_out, "Memory size overflow!\n");
mp->history = mp_fatal_error_stop;
mp_jump_out (mp);
}
w = malloc (nmem * size);
if (w == NULL) {
do_putsf (mp->err_out, "Out of memory!\n");
mp->history = mp_system_error_stop;
mp_jump_out (mp);
}
return w;
}
char *mp_xstrldup (MP mp, const char *s, size_t l) {
char *w;
if (s == NULL)
return NULL;
w = mp_strldup (s, l);
if (w == NULL) {
do_putsf (mp->err_out, "Out of memory!\n");
mp->history = mp_system_error_stop;
mp_jump_out (mp);
}
return w;
}
char *mp_xstrdup (MP mp, const char *s) {
if (s == NULL)
return NULL;
return mp_xstrldup (mp, s, strlen (s));
}
@ @=
#ifdef HAVE_SNPRINTF
# define mp_snprintf (void)snprintf
#else
static void mp_snprintf (char *str, int size, const char *fmt, ...);
#endif
@ This internal version is rather stupid, but good enough for its purpose.
@c
#ifndef HAVE_SNPRINTF
static char *mp_itoa (int i) {
char res[32];
unsigned idx = 30;
unsigned v = (unsigned) abs (i);
memset (res, 0, 32 * sizeof (char));
while (v >= 10) {
char d = (char) (v % 10);
v = v / 10;
res[idx--] = (char) (d + '0');
}
res[idx--] = (char) (v + '0');
if (i < 0) {
res[idx--] = '-';
}
return mp_strdup ((res + idx + 1));
}
static char *mp_utoa (unsigned v) {
char res[32];
unsigned idx = 30;
memset (res, 0, 32 * sizeof (char));
while (v >= 10) {
char d = (char) (v % 10);
v = v / 10;
res[idx--] = (char) (d + '0');
}
res[idx--] = (char) (v + '0');
return mp_strdup ((res + idx + 1));
}
static void mp_snprintf (char *str, int size, const char *format, ...) {
const char *fmt;
char *res;
int fw, pad;
va_list ap;
va_start (ap, format);
res = str;
for (fmt = format; *fmt != '\0'; fmt++) {
if (*fmt == '%') {
fw = 0;
pad = 0;
RESTART:
fmt++;
switch (*fmt) {
case '0':
pad = 1;
goto RESTART;
break;
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
assert (fw == 0);
fw = *fmt - '0';
goto RESTART;
break;
case 's':
{
char *s = va_arg (ap, char *);
while (*s) {
*res = *s++;
if (size-- > 0)
res++;
}
}
break;
case 'c':
{
int s = va_arg (ap, int);
*res = (char) s;
if (size-- > 0)
res++;
}
break;
case 'i':
case 'd':
{
char *sstart, *s = mp_itoa (va_arg (ap, int));
sstart = s;
if (fw) {
int ffw = fw - (int) strlen (s);
while (ffw-- > 0) {
*res = (char) (pad ? '0' : ' ');
if (size-- > 0)
res++;
}
}
if (s != NULL) {
while (*s) {
*res = *s++;
if (size-- > 0)
res++;
}
mp_xfree (sstart);
}
}
break;
case 'u':
{
char *sstart, *s = mp_utoa (va_arg (ap, unsigned));
sstart = s;
if (fw) {
int ffw = fw - (int) strlen (s);
while (ffw-- > 0) {
*res = (char) (pad ? '0' : ' ');
if (size-- > 0)
res++;
}
}
if (s != NULL) {
while (*s) {
*res = *s++;
if (size-- > 0)
res++;
}
mp_xfree (sstart);
}
}
break;
case '%':
*res = '%';
if (size-- > 0)
res++;
break;
default:
*res = '%';
if (size-- > 0)
res++;
*res = *fmt;
if (size-- > 0)
res++;
break;
}
} else {
*res = *fmt;
if (size-- > 0)
res++;
}
}
*res = '\0';
va_end (ap);
}
#endif
@* Dynamic memory allocation.
The \MP\ system does nearly all of its own memory allocation, so that it
can readily be transported into environments that do not have automatic
facilities for strings, garbage collection, etc., and so that it can be in
control of what error messages the user receives.
@d MP_VOID (mp_node)(1) /* |NULL+1|, a |NULL| pointer different from |NULL| */
@d mp_link(A) (A)->link /* the |link| field of a node */
@d set_mp_link(A,B) do {
mp_node d = (B);
/* |printf("set link of %p to %p on line %d\n", (A), d, __LINE__);| */
mp_link((A)) = d;
} while (0)
@d mp_type(A) (A)->type /* identifies what kind of value this is */
@d mp_name_type(A) (A)->name_type /* a clue to the name of this value */
@ @(mpmp.h@>=
#define NODE_BODY \
mp_variable_type type; \
quarterword name_type; \
halfword info; \
struct mp_node_data *link
typedef struct mp_node_data {
NODE_BODY;
} mp_node_data;
typedef struct mp_symbolic_node_data {
NODE_BODY;
mp_sym sym;
} mp_symbolic_node_data;
typedef struct mp_symbolic_node_data *mp_symbolic_node;
@ Users who wish to study the memory requirements of particular applications can
can use the special features that keep track of current and maximum memory usage.
\MP\ will report these statistics when |mp_tracing_stats| is positive.
@d add_var_used(a) do {
mp->var_used+=(a);
if (mp->var_used>mp->var_used_max) mp->var_used_max=mp->var_used;
} while (0)
@=
size_t var_used; /* how much memory is in use */
size_t var_used_max; /* how much memory was in use max */
@ These redirect to function to aid in debugging.
@d mp_sym_info(A) get_mp_sym_info(mp,(A))
@d set_mp_sym_info(A,B) do_set_mp_sym_info(mp,(A),(B))
@c
static void do_set_mp_sym_info (MP mp, mp_node p, halfword v) {
(void) mp;
assert (p->type == mp_symbol_node);
p->info = v;
}
static halfword get_mp_sym_info (MP mp, mp_node p) {
(void) mp;
assert (p->type == mp_symbol_node);
return p->info;
}
@ Similarly, so do these redirect to functions.
@d mp_sym_sym(A) get_mp_sym_sym(mp,(A))
@d set_mp_sym_sym(A,B) do_set_mp_sym_sym(mp,(A),(mp_sym)(B))
@c
static void do_set_mp_sym_sym (MP mp, mp_node p, mp_sym v) {
mp_symbolic_node pp = (mp_symbolic_node) p;
(void) mp;
assert (pp->type == mp_symbol_node);
pp->sym = v;
}
static mp_sym get_mp_sym_sym (MP mp, mp_node p) {
mp_symbolic_node pp = (mp_symbolic_node) p;
(void) mp;
assert (pp->type == mp_symbol_node);
return pp->sym;
}
@ @=
static void do_set_mp_sym_info (MP mp, mp_node A, halfword B);
static halfword get_mp_sym_info (MP mp, mp_node p);
static void do_set_mp_sym_sym (MP mp, mp_node A, mp_sym B);
static mp_sym get_mp_sym_sym (MP mp, mp_node p);
@ Symbolic nodes also have |name_type|, which is a short enumeration
@=
enum {
mp_normal_sym = 0,
mp_internal_sym, /* for values of internals */
mp_macro_sym, /* for macro names */
mp_expr_sym, /* for macro parameters if type |expr| */
mp_suffix_sym, /* for macro parameters if type |suffix| */
mp_text_sym, /* for macro parameters if type |text| */
} mp_sym_name_types;
@ The function |get_symbolic_node| returns a pointer to a new symbolic node whose
|link| field is null.
@^inner loop@>
@d symbolic_node_size sizeof(mp_symbolic_node_data)
@c
static mp_node mp_get_symbolic_node (MP mp) {
mp_symbolic_node p = xmalloc (1, symbolic_node_size);
add_var_used (symbolic_node_size);
memset (p, 0, symbolic_node_size);
p->type = mp_symbol_node;
p->name_type = mp_normal_sym;
FUNCTION_TRACE2 ("%p = mp_get_symbolic_node()\n", p);
return (mp_node) p;
}
@ Conversely, when some node |p| of size |s| is no longer needed,
the operation |free_node(p,s)| will make its words available, by inserting
|p| as a new empty node just before where |rover| now points.
A symbolic node is recycled by calling |free_symbolic_node|.
@d mp_free_symbolic_node(mp, A) mp_free_node(mp, (A), symbolic_node_size)
@c
void mp_free_node (MP mp, mp_node p, size_t siz) { /* node liberation */
FUNCTION_TRACE3 ("mp_free_node(%p,%d)\n", p, siz);
mp->var_used -= siz;
xfree (p); /* do more later */
}
@ @=
void mp_free_node (MP mp, mp_node p, size_t siz);
@ Same redirection trick as above
@d mp_info(A) get_mp_info(mp,(A))
@d set_mp_info(A,B) do_set_mp_info(mp,(A),(B))
@c
static void do_set_mp_info (MP mp, mp_node p, halfword v) {
(void) mp;
p->info = v;
}
halfword get_mp_info (MP mp, mp_node p) {
(void) mp;
return p->info;
}
@ @=
static halfword get_mp_info (MP mp, mp_node p);
static void do_set_mp_info (MP mp, mp_node p, halfword v);
@* Memory layout.
Some nodes are created statically, since static allocation is
more efficient than dynamic allocation when we can get away with it.
@=
mp_node null_dash;
mp_value_node dep_head;
mp_node inf_val;
mp_node zero_val;
mp_node temp_val;
mp_node end_attr;
mp_node bad_vardef;
mp_node temp_head;
mp_node hold_head;
mp_node spec_head;
@ The following code gets the memory off to a good start.
@=
mp->spec_head = mp_get_symbolic_node (mp);
mp->last_pending = mp->spec_head;
mp->temp_head = mp_get_symbolic_node (mp);
mp->hold_head = mp_get_symbolic_node (mp);
@ @=
mp_free_symbolic_node (mp, mp->spec_head);
mp_free_symbolic_node (mp, mp->temp_head);
mp_free_symbolic_node (mp, mp->hold_head);
@ The procedure |flush_node_list(p)| frees an entire linked list of
nodes that starts at a given position, until coming to a |NULL| pointer.
@^inner loop@>
@c
static void mp_flush_node_list (MP mp, mp_node p) {
mp_node q; /* the node being recycled */
FUNCTION_TRACE2 ("mp_flush_node_list(%p)\n", p);
while (p != NULL) {
q = p;
p = p->link;
if (q->type != mp_symbol_node)
mp_free_node (mp, q, token_node_size);
else
mp_free_symbolic_node (mp, q);
}
}
@* The command codes.
Before we can go much further, we need to define symbolic names for the internal
code numbers that represent the various commands obeyed by \MP. These codes
are somewhat arbitrary, but not completely so. For example,
some codes have been made adjacent so that |case| statements in the
program need not consider cases that are widely spaced, or so that |case|
statements can be replaced by |if| statements. A command can begin an
expression if and only if its code lies between |min_primary_command| and
|max_primary_command|, inclusive. The first token of a statement that doesn't
begin with an expression has a command code between |min_command| and
|max_statement_command|, inclusive. Anything less than |min_command| is
eliminated during macro expansions, and anything no more than |max_pre_command|
is eliminated when expanding \TeX\ material. Ranges such as
|min_secondary_command..max_secondary_command| are used when parsing
expressions, but the relative ordering within such a range is generally not
critical.
The ordering of the highest-numbered commands
(|commacur_cmd>comma)
@d semicolon 82 /* the operator `\.;', must be |comma+1| */
@d end_group 83 /* end a group (\&{endgroup}), must be |semicolon+1| */
@d stop 84 /* end a job (\&{end}, \&{dump}), must be |end_group+1| */
@d max_command_code stop
@d outer_tag (max_command_code+1) /* protection code added to command code */
@d undefined_cs (max_command_code+2) /* protection code added to command code */
@=
typedef int command_code;
@ Variables and capsules in \MP\ have a variety of ``types,''
distinguished by the code numbers defined here. These numbers are also
not completely arbitrary. Things that get expanded must have types
|>mp_independent|; a type remaining after expansion is numeric if and only if
its code number is at least |numeric_type|; objects containing numeric
parts must have types between |transform_type| and |pair_type|;
all other types must be smaller than |transform_type|; and among the types
that are not unknown or vacuous, the smallest two must be |boolean_type|
and |string_type| in that order.
@d undefined 0 /* no type has been declared */
@d unknown_tag 1 /* this constant is added to certain type codes below */
@d unknown_types mp_unknown_boolean: case mp_unknown_string:
case mp_unknown_pen: case mp_unknown_picture: case mp_unknown_path
@=
typedef enum {
mp_vacuous = 1, /* no expression was present */
mp_boolean_type, /* \&{boolean} with a known value */
mp_unknown_boolean,
mp_string_type, /* \&{string} with a known value */
mp_unknown_string,
mp_pen_type, /* \&{pen} with a known value */
mp_unknown_pen,
mp_path_type, /* \&{path} with a known value */
mp_unknown_path,
mp_picture_type, /* \&{picture} with a known value */
mp_unknown_picture,
mp_transform_type, /* \&{transform} variable or capsule */
mp_color_type, /* \&{color} variable or capsule */
mp_cmykcolor_type, /* \&{cmykcolor} variable or capsule */
mp_pair_type, /* \&{pair} variable or capsule */
mp_numeric_type, /* variable that has been declared \&{numeric} but not used */
mp_known, /* \&{numeric} with a known value */
mp_dependent, /* a linear combination with |fraction| coefficients */
mp_proto_dependent, /* a linear combination with |scaled| coefficients */
mp_independent, /* \&{numeric} with unknown value */
mp_token_list, /* variable name or suffix argument or text argument */
mp_structured, /* variable with subscripts and attributes */
mp_unsuffixed_macro, /* variable defined with \&{vardef} but no \.{\AT!\#} */
mp_suffixed_macro, /* variable defined with \&{vardef} and \.{\AT!\#} */
/* here are some generic node types */
mp_symbol_node,
mp_token_node_type,
mp_value_node_type,
mp_attr_node_type,
mp_subscr_node_type,
mp_pair_node_type,
mp_transform_node_type,
mp_color_node_type,
mp_cmykcolor_node_type,
/* it is important that the next 7 items remain in this order, for export */
mp_fill_node_type,
mp_stroked_node_type,
mp_text_node_type,
mp_start_clip_node_type,
mp_start_bounds_node_type,
mp_stop_clip_node_type,
mp_stop_bounds_node_type,
mp_dash_node_type,
mp_dep_node_type,
mp_if_node_type,
mp_edge_header_node_type,
} mp_variable_type;
@ @=
static void mp_print_type (MP mp, quarterword t);
@ @=
static const char *mp_type_string (quarterword t) {
const char *s = NULL;
switch (t) {
case undefined:
s = "undefined";
break;
case mp_vacuous:
s = "vacuous";
break;
case mp_boolean_type:
s = "boolean";
break;
case mp_unknown_boolean:
s = "unknown boolean";
break;
case mp_string_type:
s = "string";
break;
case mp_unknown_string:
s = "unknown string";
break;
case mp_pen_type:
s = "pen";
break;
case mp_unknown_pen:
s = "unknown pen";
break;
case mp_path_type:
s = "path";
break;
case mp_unknown_path:
s = "unknown path";
break;
case mp_picture_type:
s = "picture";
break;
case mp_unknown_picture:
s = "unknown picture";
break;
case mp_transform_type:
s = "transform";
break;
case mp_color_type:
s = "color";
break;
case mp_cmykcolor_type:
s = "cmykcolor";
break;
case mp_pair_type:
s = "pair";
break;
case mp_known:
s = "known numeric";
break;
case mp_dependent:
s = "dependent";
break;
case mp_proto_dependent:
s = "proto-dependent";
break;
case mp_numeric_type:
s = "numeric";
break;
case mp_independent:
s = "independent";
break;
case mp_token_list:
s = "token list";
break;
case mp_structured:
s = "mp_structured";
break;
case mp_unsuffixed_macro:
s = "unsuffixed macro";
break;
case mp_suffixed_macro:
s = "suffixed macro";
break;
case mp_symbol_node:
s = "symbol node";
break;
case mp_token_node_type:
s = "token node";
break;
case mp_value_node_type:
s = "value node";
break;
case mp_attr_node_type:
s = "attribute node";
break;
case mp_subscr_node_type:
s = "subscript node";
break;
case mp_fill_node_type:
s = "fill node";
break;
case mp_stroked_node_type:
s = "stroked node";
break;
case mp_text_node_type:
s = "text node";
break;
case mp_start_clip_node_type:
s = "start clip node";
break;
case mp_start_bounds_node_type:
s = "start bounds node";
break;
case mp_stop_clip_node_type:
s = "stop clip node";
break;
case mp_stop_bounds_node_type:
s = "stop bounds node";
break;
case mp_dash_node_type:
s = "dash node";
break;
case mp_dep_node_type:
s = "dependency node";
break;
case mp_if_node_type:
s = "if node";
break;
case mp_edge_header_node_type:
s = "edge header node";
break;
default:
assert (0);
break;
}
return s;
}
void mp_print_type (MP mp, quarterword t) {
if (t >= 0 && t <= mp_edge_header_node_type)
mp_print (mp, mp_type_string (t));
else
mp_print (mp, "unknown");
}
@ Values inside \MP\ are stored in non-symbolic nodes that have a |name_type|
as well as a |type|. The possibilities for |name_type| are defined
here; they will be explained in more detail later.
@=
enum mp_name_types {
mp_root = 0, /* |name_type| at the top level of a variable */
mp_saved_root, /* same, when the variable has been saved */
mp_structured_root, /* |name_type| where a |mp_structured| branch occurs */
mp_subscr, /* |name_type| in a subscript node */
mp_attr, /* |name_type| in an attribute node */
mp_x_part_sector, /* |name_type| in the \&{xpart} of a node */
mp_y_part_sector, /* |name_type| in the \&{ypart} of a node */
mp_xx_part_sector, /* |name_type| in the \&{xxpart} of a node */
mp_xy_part_sector, /* |name_type| in the \&{xypart} of a node */
mp_yx_part_sector, /* |name_type| in the \&{yxpart} of a node */
mp_yy_part_sector, /* |name_type| in the \&{yypart} of a node */
mp_red_part_sector, /* |name_type| in the \&{redpart} of a node */
mp_green_part_sector, /* |name_type| in the \&{greenpart} of a node */
mp_blue_part_sector, /* |name_type| in the \&{bluepart} of a node */
mp_cyan_part_sector, /* |name_type| in the \&{redpart} of a node */
mp_magenta_part_sector, /* |name_type| in the \&{greenpart} of a node */
mp_yellow_part_sector, /* |name_type| in the \&{bluepart} of a node */
mp_black_part_sector, /* |name_type| in the \&{greenpart} of a node */
mp_grey_part_sector, /* |name_type| in the \&{bluepart} of a node */
mp_capsule, /* |name_type| in stashed-away subexpressions */
mp_token /* |name_type| in a numeric token or string token */
};
@ Primitive operations that produce values have a secondary identification
code in addition to their command code; it's something like genera and species.
For example, `\.*' has the command code |primary_binary|, and its
secondary identification is |times|. The secondary codes start at 30 so that
they don't overlap with the type codes; some type codes (e.g., |mp_string_type|)
are used as operators as well as type identifications. The relative values
are not critical, except for |true_code..false_code|, |or_op..and_op|,
and |filled_op..bounded_op|. The restrictions are that
|and_op-false_code=or_op-true_code|, that the ordering of
|x_part...blue_part| must match that of |x_part_sector..mp_blue_part_sector|,
and the ordering of |filled_op..bounded_op| must match that of the code
values they test for.
@d true_code 30 /* operation code for \.{true} */
@d false_code 31 /* operation code for \.{false} */
@d null_picture_code 32 /* operation code for \.{nullpicture} */
@d null_pen_code 33 /* operation code for \.{nullpen} */
@d read_string_op 35 /* operation code for \.{readstring} */
@d pen_circle 36 /* operation code for \.{pencircle} */
@d normal_deviate 37 /* operation code for \.{normaldeviate} */
@d read_from_op 38 /* operation code for \.{readfrom} */
@d close_from_op 39 /* operation code for \.{closefrom} */
@d odd_op 40 /* operation code for \.{odd} */
@d known_op 41 /* operation code for \.{known} */
@d unknown_op 42 /* operation code for \.{unknown} */
@d not_op 43 /* operation code for \.{not} */
@d decimal 44 /* operation code for \.{decimal} */
@d reverse 45 /* operation code for \.{reverse} */
@d make_path_op 46 /* operation code for \.{makepath} */
@d make_pen_op 47 /* operation code for \.{makepen} */
@d oct_op 48 /* operation code for \.{oct} */
@d hex_op 49 /* operation code for \.{hex} */
@d ASCII_op 50 /* operation code for \.{ASCII} */
@d char_op 51 /* operation code for \.{char} */
@d length_op 52 /* operation code for \.{length} */
@d turning_op 53 /* operation code for \.{turningnumber} */
@d color_model_part 54 /* operation code for \.{colormodel} */
@d x_part 55 /* operation code for \.{xpart} */
@d y_part 56 /* operation code for \.{ypart} */
@d xx_part 57 /* operation code for \.{xxpart} */
@d xy_part 58 /* operation code for \.{xypart} */
@d yx_part 59 /* operation code for \.{yxpart} */
@d yy_part 60 /* operation code for \.{yypart} */
@d red_part 61 /* operation code for \.{redpart} */
@d green_part 62 /* operation code for \.{greenpart} */
@d blue_part 63 /* operation code for \.{bluepart} */
@d cyan_part 64 /* operation code for \.{cyanpart} */
@d magenta_part 65 /* operation code for \.{magentapart} */
@d yellow_part 66 /* operation code for \.{yellowpart} */
@d black_part 67 /* operation code for \.{blackpart} */
@d grey_part 68 /* operation code for \.{greypart} */
@d font_part 69 /* operation code for \.{fontpart} */
@d text_part 70 /* operation code for \.{textpart} */
@d path_part 71 /* operation code for \.{pathpart} */
@d pen_part 72 /* operation code for \.{penpart} */
@d dash_part 73 /* operation code for \.{dashpart} */
@d sqrt_op 74 /* operation code for \.{sqrt} */
@d mp_m_exp_op 75 /* operation code for \.{mexp} */
@d mp_m_log_op 76 /* operation code for \.{mlog} */
@d sin_d_op 77 /* operation code for \.{sind} */
@d cos_d_op 78 /* operation code for \.{cosd} */
@d floor_op 79 /* operation code for \.{floor} */
@d uniform_deviate 80 /* operation code for \.{uniformdeviate} */
@d char_exists_op 81 /* operation code for \.{charexists} */
@d font_size 82 /* operation code for \.{fontsize} */
@d ll_corner_op 83 /* operation code for \.{llcorner} */
@d lr_corner_op 84 /* operation code for \.{lrcorner} */
@d ul_corner_op 85 /* operation code for \.{ulcorner} */
@d ur_corner_op 86 /* operation code for \.{urcorner} */
@d arc_length 87 /* operation code for \.{arclength} */
@d angle_op 88 /* operation code for \.{angle} */
@d cycle_op 89 /* operation code for \.{cycle} */
@d filled_op 90 /* operation code for \.{filled} */
@d stroked_op 91 /* operation code for \.{stroked} */
@d textual_op 92 /* operation code for \.{textual} */
@d clipped_op 93 /* operation code for \.{clipped} */
@d bounded_op 94 /* operation code for \.{bounded} */
@d plus 95 /* operation code for \.+ */
@d minus 96 /* operation code for \.- */
@d times 97 /* operation code for \.* */
@d over 98 /* operation code for \./ */
@d pythag_add 99 /* operation code for \.{++} */
@d pythag_sub 100 /* operation code for \.{+-+} */
@d or_op 101 /* operation code for \.{or} */
@d and_op 102 /* operation code for \.{and} */
@d less_than 103 /* operation code for \.< */
@d less_or_equal 104 /* operation code for \.{<=} */
@d greater_than 105 /* operation code for \.> */
@d greater_or_equal 106 /* operation code for \.{>=} */
@d equal_to 107 /* operation code for \.= */
@d unequal_to 108 /* operation code for \.{<>} */
@d concatenate 109 /* operation code for \.\& */
@d rotated_by 110 /* operation code for \.{rotated} */
@d slanted_by 111 /* operation code for \.{slanted} */
@d scaled_by 112 /* operation code for \.{scaled} */
@d shifted_by 113 /* operation code for \.{shifted} */
@d transformed_by 114 /* operation code for \.{transformed} */
@d x_scaled 115 /* operation code for \.{xscaled} */
@d y_scaled 116 /* operation code for \.{yscaled} */
@d z_scaled 117 /* operation code for \.{zscaled} */
@d in_font 118 /* operation code for \.{infont} */
@d intersect 119 /* operation code for \.{intersectiontimes} */
@d double_dot 120 /* operation code for improper \.{..} */
@d substring_of 121 /* operation code for \.{substring} */
@d min_of substring_of
@d subpath_of 122 /* operation code for \.{subpath} */
@d direction_time_of 123 /* operation code for \.{directiontime} */
@d point_of 124 /* operation code for \.{point} */
@d precontrol_of 125 /* operation code for \.{precontrol} */
@d postcontrol_of 126 /* operation code for \.{postcontrol} */
@d pen_offset_of 127 /* operation code for \.{penoffset} */
@d arc_time_of 128 /* operation code for \.{arctime} */
@d mp_version 129 /* operation code for \.{mpversion} */
@d envelope_of 130 /* operation code for \.{envelope} */
@d glyph_infont 131 /* operation code for \.{glyph} */
@c
static void mp_print_op (MP mp, quarterword c) {
if (c <= mp_numeric_type) {
mp_print_type (mp, c);
} else {
switch (c) {
case true_code:
mp_print (mp, "true");
break;
case false_code:
mp_print (mp, "false");
break;
case null_picture_code:
mp_print (mp, "nullpicture");
break;
case null_pen_code:
mp_print (mp, "nullpen");
break;
case read_string_op:
mp_print (mp, "readstring");
break;
case pen_circle:
mp_print (mp, "pencircle");
break;
case normal_deviate:
mp_print (mp, "normaldeviate");
break;
case read_from_op:
mp_print (mp, "readfrom");
break;
case close_from_op:
mp_print (mp, "closefrom");
break;
case odd_op:
mp_print (mp, "odd");
break;
case known_op:
mp_print (mp, "known");
break;
case unknown_op:
mp_print (mp, "unknown");
break;
case not_op:
mp_print (mp, "not");
break;
case decimal:
mp_print (mp, "decimal");
break;
case reverse:
mp_print (mp, "reverse");
break;
case make_path_op:
mp_print (mp, "makepath");
break;
case make_pen_op:
mp_print (mp, "makepen");
break;
case oct_op:
mp_print (mp, "oct");
break;
case hex_op:
mp_print (mp, "hex");
break;
case ASCII_op:
mp_print (mp, "ASCII");
break;
case char_op:
mp_print (mp, "char");
break;
case length_op:
mp_print (mp, "length");
break;
case turning_op:
mp_print (mp, "turningnumber");
break;
case x_part:
mp_print (mp, "xpart");
break;
case y_part:
mp_print (mp, "ypart");
break;
case xx_part:
mp_print (mp, "xxpart");
break;
case xy_part:
mp_print (mp, "xypart");
break;
case yx_part:
mp_print (mp, "yxpart");
break;
case yy_part:
mp_print (mp, "yypart");
break;
case red_part:
mp_print (mp, "redpart");
break;
case green_part:
mp_print (mp, "greenpart");
break;
case blue_part:
mp_print (mp, "bluepart");
break;
case cyan_part:
mp_print (mp, "cyanpart");
break;
case magenta_part:
mp_print (mp, "magentapart");
break;
case yellow_part:
mp_print (mp, "yellowpart");
break;
case black_part:
mp_print (mp, "blackpart");
break;
case grey_part:
mp_print (mp, "greypart");
break;
case color_model_part:
mp_print (mp, "colormodel");
break;
case font_part:
mp_print (mp, "fontpart");
break;
case text_part:
mp_print (mp, "textpart");
break;
case path_part:
mp_print (mp, "pathpart");
break;
case pen_part:
mp_print (mp, "penpart");
break;
case dash_part:
mp_print (mp, "dashpart");
break;
case sqrt_op:
mp_print (mp, "sqrt");
break;
case mp_m_exp_op:
mp_print (mp, "mexp");
break;
case mp_m_log_op:
mp_print (mp, "mlog");
break;
case sin_d_op:
mp_print (mp, "sind");
break;
case cos_d_op:
mp_print (mp, "cosd");
break;
case floor_op:
mp_print (mp, "floor");
break;
case uniform_deviate:
mp_print (mp, "uniformdeviate");
break;
case char_exists_op:
mp_print (mp, "charexists");
break;
case font_size:
mp_print (mp, "fontsize");
break;
case ll_corner_op:
mp_print (mp, "llcorner");
break;
case lr_corner_op:
mp_print (mp, "lrcorner");
break;
case ul_corner_op:
mp_print (mp, "ulcorner");
break;
case ur_corner_op:
mp_print (mp, "urcorner");
break;
case arc_length:
mp_print (mp, "arclength");
break;
case angle_op:
mp_print (mp, "angle");
break;
case cycle_op:
mp_print (mp, "cycle");
break;
case filled_op:
mp_print (mp, "filled");
break;
case stroked_op:
mp_print (mp, "stroked");
break;
case textual_op:
mp_print (mp, "textual");
break;
case clipped_op:
mp_print (mp, "clipped");
break;
case bounded_op:
mp_print (mp, "bounded");
break;
case plus:
mp_print_char (mp, xord ('+'));
break;
case minus:
mp_print_char (mp, xord ('-'));
break;
case times:
mp_print_char (mp, xord ('*'));
break;
case over:
mp_print_char (mp, xord ('/'));
break;
case pythag_add:
mp_print (mp, "++");
break;
case pythag_sub:
mp_print (mp, "+-+");
break;
case or_op:
mp_print (mp, "or");
break;
case and_op:
mp_print (mp, "and");
break;
case less_than:
mp_print_char (mp, xord ('<'));
break;
case less_or_equal:
mp_print (mp, "<=");
break;
case greater_than:
mp_print_char (mp, xord ('>'));
break;
case greater_or_equal:
mp_print (mp, ">=");
break;
case equal_to:
mp_print_char (mp, xord ('='));
break;
case unequal_to:
mp_print (mp, "<>");
break;
case concatenate:
mp_print (mp, "&");
break;
case rotated_by:
mp_print (mp, "rotated");
break;
case slanted_by:
mp_print (mp, "slanted");
break;
case scaled_by:
mp_print (mp, "scaled");
break;
case shifted_by:
mp_print (mp, "shifted");
break;
case transformed_by:
mp_print (mp, "transformed");
break;
case x_scaled:
mp_print (mp, "xscaled");
break;
case y_scaled:
mp_print (mp, "yscaled");
break;
case z_scaled:
mp_print (mp, "zscaled");
break;
case in_font:
mp_print (mp, "infont");
break;
case intersect:
mp_print (mp, "intersectiontimes");
break;
case substring_of:
mp_print (mp, "substring");
break;
case subpath_of:
mp_print (mp, "subpath");
break;
case direction_time_of:
mp_print (mp, "directiontime");
break;
case point_of:
mp_print (mp, "point");
break;
case precontrol_of:
mp_print (mp, "precontrol");
break;
case postcontrol_of:
mp_print (mp, "postcontrol");
break;
case pen_offset_of:
mp_print (mp, "penoffset");
break;
case arc_time_of:
mp_print (mp, "arctime");
break;
case mp_version:
mp_print (mp, "mpversion");
break;
case envelope_of:
mp_print (mp, "envelope");
break;
case glyph_infont:
mp_print (mp, "glyph");
break;
default:
mp_print (mp, "..");
break;
}
}
}
@ \MP\ also has a bunch of internal parameters that a user might want to
fuss with. Every such parameter has an identifying code number, defined here.
@=
enum mp_given_internal {
mp_output_template = 1, /* a string set up by \&{outputtemplate} */
mp_output_format, /* the output format set up by \&{outputformat} */
mp_job_name, /* the perceived jobname, as set up from the options stucture,
the name of the input file, or by \&{jobname} */
mp_tracing_titles, /* show titles online when they appear */
mp_tracing_equations, /* show each variable when it becomes known */
mp_tracing_capsules, /* show capsules too */
mp_tracing_choices, /* show the control points chosen for paths */
mp_tracing_specs, /* show path subdivision prior to filling with polygonal a pen */
mp_tracing_commands, /* show commands and operations before they are performed */
mp_tracing_restores, /* show when a variable or internal is restored */
mp_tracing_macros, /* show macros before they are expanded */
mp_tracing_output, /* show digitized edges as they are output */
mp_tracing_stats, /* show memory usage at end of job */
mp_tracing_lost_chars, /* show characters that aren't \&{infont} */
mp_tracing_online, /* show long diagnostics on terminal and in the log file */
mp_year, /* the current year (e.g., 1984) */
mp_month, /* the current month (e.g., 3 $\equiv$ March) */
mp_day, /* the current day of the month */
mp_time, /* the number of minutes past midnight when this job started */
mp_hour, /* the number of hours past midnight when this job started */
mp_minute, /* the number of minutes in that hour when this job started */
mp_char_code, /* the number of the next character to be output */
mp_char_ext, /* the extension code of the next character to be output */
mp_char_wd, /* the width of the next character to be output */
mp_char_ht, /* the height of the next character to be output */
mp_char_dp, /* the depth of the next character to be output */
mp_char_ic, /* the italic correction of the next character to be output */
mp_design_size, /* the unit of measure used for |mp_char_wd..mp_char_ic|, in points */
mp_pausing, /* positive to display lines on the terminal before they are read */
mp_showstopping, /* positive to stop after each \&{show} command */
mp_fontmaking, /* positive if font metric output is to be produced */
mp_linejoin, /* as in \ps: 0 for mitered, 1 for round, 2 for beveled */
mp_linecap, /* as in \ps: 0 for butt, 1 for round, 2 for square */
mp_miterlimit, /* controls miter length as in \ps */
mp_warning_check, /* controls error message when variable value is large */
mp_boundary_char, /* the right boundary character for ligatures */
mp_prologues, /* positive to output conforming PostScript using built-in fonts */
mp_true_corners, /* positive to make \&{llcorner} etc. ignore \&{setbounds} */
mp_default_color_model, /* the default color model for unspecified items */
mp_restore_clip_color,
mp_procset, /* wether or not create PostScript command shortcuts */
mp_gtroffmode /* whether the user specified |-troff| on the command line */
};
typedef struct {
mp_value v;
char *intname;
} mp_internal;
@ @(mpmp.h@>=
#define internal_value(A) mp->internal[(A)].v.data.val
#define internal_string(A) mp->internal[(A)].v.data.str
#define internal_name(A) mp->internal[(A)].intname
#define internal_type(A) mp->internal[(A)].v.type
@
@d max_given_internal mp_gtroffmode
@=
mp_internal *internal; /* the values of internal quantities */
int int_ptr; /* the maximum internal quantity defined so far */
int max_internal; /* current maximum number of internal quantities */
@ @=
int troff_mode;
@ @=
mp->max_internal = 2 * max_given_internal;
mp->internal = xmalloc ((mp->max_internal + 1), sizeof (mp_internal));
memset (mp->internal, 0,
(size_t) (mp->max_internal + 1) * sizeof (mp_internal));
{
int i;
for (i = 1; i <= max_given_internal; i++)
internal_type (i) = mp_known;
}
internal_type (mp_output_format) = mp_string_type;
internal_type (mp_output_template) = mp_string_type;
internal_type (mp_job_name) = mp_string_type;
mp->troff_mode = (opt->troff_mode > 0 ? true : false);
@ @=
int mp_troff_mode (MP mp);
@ @c
int mp_troff_mode (MP mp) {
return mp->troff_mode;
}
@ @=
mp->int_ptr = max_given_internal;
@ The symbolic names for internal quantities are put into \MP's hash table
by using a routine called |primitive|, which will be defined later. Let us
enter them now, so that we don't have to list all those names again
anywhere else.
@=
mp_primitive (mp, "tracingtitles", internal_quantity, mp_tracing_titles);
@:tracingtitles_}{\&{tracingtitles} primitive@>;
mp_primitive (mp, "tracingequations", internal_quantity, mp_tracing_equations);
@:mp_tracing_equations_}{\&{tracingequations} primitive@>;
mp_primitive (mp, "tracingcapsules", internal_quantity, mp_tracing_capsules);
@:mp_tracing_capsules_}{\&{tracingcapsules} primitive@>;
mp_primitive (mp, "tracingchoices", internal_quantity, mp_tracing_choices);
@:mp_tracing_choices_}{\&{tracingchoices} primitive@>;
mp_primitive (mp, "tracingspecs", internal_quantity, mp_tracing_specs);
@:mp_tracing_specs_}{\&{tracingspecs} primitive@>;
mp_primitive (mp, "tracingcommands", internal_quantity, mp_tracing_commands);
@:mp_tracing_commands_}{\&{tracingcommands} primitive@>;
mp_primitive (mp, "tracingrestores", internal_quantity, mp_tracing_restores);
@:mp_tracing_restores_}{\&{tracingrestores} primitive@>;
mp_primitive (mp, "tracingmacros", internal_quantity, mp_tracing_macros);
@:mp_tracing_macros_}{\&{tracingmacros} primitive@>;
mp_primitive (mp, "tracingoutput", internal_quantity, mp_tracing_output);
@:mp_tracing_output_}{\&{tracingoutput} primitive@>;
mp_primitive (mp, "tracingstats", internal_quantity, mp_tracing_stats);
@:mp_tracing_stats_}{\&{tracingstats} primitive@>;
mp_primitive (mp, "tracinglostchars", internal_quantity, mp_tracing_lost_chars);
@:mp_tracing_lost_chars_}{\&{tracinglostchars} primitive@>;
mp_primitive (mp, "tracingonline", internal_quantity, mp_tracing_online);
@:mp_tracing_online_}{\&{tracingonline} primitive@>;
mp_primitive (mp, "year", internal_quantity, mp_year);
@:mp_year_}{\&{year} primitive@>;
mp_primitive (mp, "month", internal_quantity, mp_month);
@:mp_month_}{\&{month} primitive@>;
mp_primitive (mp, "day", internal_quantity, mp_day);
@:mp_day_}{\&{day} primitive@>;
mp_primitive (mp, "time", internal_quantity, mp_time);
@:time_}{\&{time} primitive@>;
mp_primitive (mp, "hour", internal_quantity, mp_hour);
@:hour_}{\&{hour} primitive@>;
mp_primitive (mp, "minute", internal_quantity, mp_minute);
@:minute_}{\&{minute} primitive@>;
mp_primitive (mp, "charcode", internal_quantity, mp_char_code);
@:mp_char_code_}{\&{charcode} primitive@>;
mp_primitive (mp, "charext", internal_quantity, mp_char_ext);
@:mp_char_ext_}{\&{charext} primitive@>;
mp_primitive (mp, "charwd", internal_quantity, mp_char_wd);
@:mp_char_wd_}{\&{charwd} primitive@>;
mp_primitive (mp, "charht", internal_quantity, mp_char_ht);
@:mp_char_ht_}{\&{charht} primitive@>;
mp_primitive (mp, "chardp", internal_quantity, mp_char_dp);
@:mp_char_dp_}{\&{chardp} primitive@>;
mp_primitive (mp, "charic", internal_quantity, mp_char_ic);
@:mp_char_ic_}{\&{charic} primitive@>;
mp_primitive (mp, "designsize", internal_quantity, mp_design_size);
@:mp_design_size_}{\&{designsize} primitive@>;
mp_primitive (mp, "pausing", internal_quantity, mp_pausing);
@:mp_pausing_}{\&{pausing} primitive@>;
mp_primitive (mp, "showstopping", internal_quantity, mp_showstopping);
@:mp_showstopping_}{\&{showstopping} primitive@>;
mp_primitive (mp, "fontmaking", internal_quantity, mp_fontmaking);
@:mp_fontmaking_}{\&{fontmaking} primitive@>;
mp_primitive (mp, "linejoin", internal_quantity, mp_linejoin);
@:mp_linejoin_}{\&{linejoin} primitive@>;
mp_primitive (mp, "linecap", internal_quantity, mp_linecap);
@:mp_linecap_}{\&{linecap} primitive@>;
mp_primitive (mp, "miterlimit", internal_quantity, mp_miterlimit);
@:mp_miterlimit_}{\&{miterlimit} primitive@>;
mp_primitive (mp, "warningcheck", internal_quantity, mp_warning_check);
@:mp_warning_check_}{\&{warningcheck} primitive@>;
mp_primitive (mp, "boundarychar", internal_quantity, mp_boundary_char);
@:mp_boundary_char_}{\&{boundarychar} primitive@>;
mp_primitive (mp, "prologues", internal_quantity, mp_prologues);
@:mp_prologues_}{\&{prologues} primitive@>;
mp_primitive (mp, "truecorners", internal_quantity, mp_true_corners);
@:mp_true_corners_}{\&{truecorners} primitive@>;
mp_primitive (mp, "mpprocset", internal_quantity, mp_procset);
@:mp_procset_}{\&{mpprocset} primitive@>;
mp_primitive (mp, "troffmode", internal_quantity, mp_gtroffmode);
@:troffmode_}{\&{troffmode} primitive@>;
mp_primitive (mp, "defaultcolormodel", internal_quantity,
mp_default_color_model);
@:mp_default_color_model_}{\&{defaultcolormodel} primitive@>;
mp_primitive (mp, "restoreclipcolor", internal_quantity, mp_restore_clip_color);
@:mp_restore_clip_color_}{\&{restoreclipcolor} primitive@>;
mp_primitive (mp, "outputtemplate", internal_quantity, mp_output_template);
@:mp_output_template_}{\&{outputtemplate} primitive@>;
mp_primitive (mp, "outputformat", internal_quantity, mp_output_format);
@:mp_output_format_}{\&{outputformat} primitive@>;
mp_primitive (mp, "jobname", internal_quantity, mp_job_name);
@:mp_job_name_}{\&{jobname} primitive@>
@ Colors can be specified in four color models. In the special
case of |no_model|, MetaPost does not output any color operator to
the postscript output.
Note: these values are passed directly on to |with_option|. This only
works because the other possible values passed to |with_option| are
8 and 10 respectively (from |with_pen| and |with_picture|).
There is a first state, that is only used for |gs_colormodel|. It flags
the fact that there has not been any kind of color specification by
the user so far in the game.
@(mplib.h@>=
enum mp_color_model {
mp_no_model = 1,
mp_grey_model = 3,
mp_rgb_model = 5,
mp_cmyk_model = 7,
mp_uninitialized_model = 9
};
@ @=
internal_value (mp_default_color_model) = (mp_rgb_model * unity);
internal_value (mp_restore_clip_color) = unity;
internal_string (mp_output_template) = mp_intern (mp, "%j.%c");
internal_string (mp_output_format) = mp_intern (mp, "eps");
#if 0
internal_value (mp_tracing_titles) = 3 * unity;
internal_value (mp_tracing_equations) = 3 * unity;
internal_value (mp_tracing_capsules) = 3 * unity;
internal_value (mp_tracing_choices) = 3 * unity;
internal_value (mp_tracing_specs) = 3 * unity;
internal_value (mp_tracing_commands) = 3 * unity;
internal_value (mp_tracing_restores) = 3 * unity;
internal_value (mp_tracing_macros) = 3 * unity;
internal_value (mp_tracing_output) = 3 * unity;
internal_value (mp_tracing_stats) = 3 * unity;
internal_value (mp_tracing_lost_chars) = 3 * unity;
internal_value (mp_tracing_online) = 3 * unity;
#endif
@ Well, we do have to list the names one more time, for use in symbolic
printouts.
@=
internal_name (mp_tracing_titles) = xstrdup ("tracingtitles");
internal_name (mp_tracing_equations) = xstrdup ("tracingequations");
internal_name (mp_tracing_capsules) = xstrdup ("tracingcapsules");
internal_name (mp_tracing_choices) = xstrdup ("tracingchoices");
internal_name (mp_tracing_specs) = xstrdup ("tracingspecs");
internal_name (mp_tracing_commands) = xstrdup ("tracingcommands");
internal_name (mp_tracing_restores) = xstrdup ("tracingrestores");
internal_name (mp_tracing_macros) = xstrdup ("tracingmacros");
internal_name (mp_tracing_output) = xstrdup ("tracingoutput");
internal_name (mp_tracing_stats) = xstrdup ("tracingstats");
internal_name (mp_tracing_lost_chars) = xstrdup ("tracinglostchars");
internal_name (mp_tracing_online) = xstrdup ("tracingonline");
internal_name (mp_year) = xstrdup ("year");
internal_name (mp_month) = xstrdup ("month");
internal_name (mp_day) = xstrdup ("day");
internal_name (mp_time) = xstrdup ("time");
internal_name (mp_hour) = xstrdup ("hour");
internal_name (mp_minute) = xstrdup ("minute");
internal_name (mp_char_code) = xstrdup ("charcode");
internal_name (mp_char_ext) = xstrdup ("charext");
internal_name (mp_char_wd) = xstrdup ("charwd");
internal_name (mp_char_ht) = xstrdup ("charht");
internal_name (mp_char_dp) = xstrdup ("chardp");
internal_name (mp_char_ic) = xstrdup ("charic");
internal_name (mp_design_size) = xstrdup ("designsize");
internal_name (mp_pausing) = xstrdup ("pausing");
internal_name (mp_showstopping) = xstrdup ("showstopping");
internal_name (mp_fontmaking) = xstrdup ("fontmaking");
internal_name (mp_linejoin) = xstrdup ("linejoin");
internal_name (mp_linecap) = xstrdup ("linecap");
internal_name (mp_miterlimit) = xstrdup ("miterlimit");
internal_name (mp_warning_check) = xstrdup ("warningcheck");
internal_name (mp_boundary_char) = xstrdup ("boundarychar");
internal_name (mp_prologues) = xstrdup ("prologues");
internal_name (mp_true_corners) = xstrdup ("truecorners");
internal_name (mp_default_color_model) = xstrdup ("defaultcolormodel");
internal_name (mp_procset) = xstrdup ("mpprocset");
internal_name (mp_gtroffmode) = xstrdup ("troffmode");
internal_name (mp_restore_clip_color) = xstrdup ("restoreclipcolor");
internal_name (mp_output_template) = xstrdup ("outputtemplate");
internal_name (mp_output_format) = xstrdup ("outputformat");
internal_name (mp_job_name) = xstrdup ("jobname");
@ The following procedure, which is called just before \MP\ initializes its
input and output, establishes the initial values of the date and time.
@^system dependencies@>
Note that the values are |scaled| integers. Hence \MP\ can no longer
be used after the year 32767.
@c
static void mp_fix_date_and_time (MP mp) {
time_t aclock = time ((time_t *) 0);
struct tm *tmptr = localtime (&aclock);
internal_value (mp_time) = (tmptr->tm_hour * 60 + tmptr->tm_min) * unity; /* minutes since midnight */
internal_value (mp_hour) = (tmptr->tm_hour) * unity; /* hours since midnight */
internal_value (mp_minute) = (tmptr->tm_min) * unity; /* minutes since the hour */
internal_value (mp_day) = (tmptr->tm_mday) * unity; /* fourth day of the month */
internal_value (mp_month) = (tmptr->tm_mon + 1) * unity; /* seventh month of the year */
internal_value (mp_year) = (tmptr->tm_year + 1900) * unity; /* Anno Domini */
}
@ @=
static void mp_fix_date_and_time (MP mp);
@ \MP\ is occasionally supposed to print diagnostic information that
goes only into the transcript file, unless |mp_tracing_online| is positive.
Now that we have defined |mp_tracing_online| we can define
two routines that adjust the destination of print commands:
@=
static void mp_begin_diagnostic (MP mp);
static void mp_end_diagnostic (MP mp, boolean blank_line);
static void mp_print_diagnostic (MP mp, const char *s, const char *t,
boolean nuline);
@ @=
void mp_begin_diagnostic (MP mp) { /* prepare to do some tracing */
mp->old_setting = mp->selector;
if ((internal_value (mp_tracing_online) <= 0)
&& (mp->selector == term_and_log)) {
decr (mp->selector);
if (mp->history == mp_spotless)
mp->history = mp_warning_issued;
}
}
@#
void mp_end_diagnostic (MP mp, boolean blank_line) {
/* restore proper conditions after tracing */
mp_print_nl (mp, "");
if (blank_line)
mp_print_ln (mp);
mp->selector = mp->old_setting;
}
@
@=
unsigned int old_setting;
@ We will occasionally use |begin_diagnostic| in connection with line-number
printing, as follows. (The parameter |s| is typically |"Path"| or
|"Cycle spec"|, etc.)
@=
void mp_print_diagnostic (MP mp, const char *s, const char *t, boolean nuline) {
mp_begin_diagnostic (mp);
if (nuline)
mp_print_nl (mp, s);
else
mp_print (mp, s);
mp_print (mp, " at line ");
mp_print_int (mp, mp_true_line (mp));
mp_print (mp, t);
mp_print_char (mp, xord (':'));
}
@ The 256 |ASCII_code| characters are grouped into classes by means of
the |char_class| table. Individual class numbers have no semantic
or syntactic significance, except in a few instances defined here.
There's also |max_class|, which can be used as a basis for additional
class numbers in nonstandard extensions of \MP.
@d digit_class 0 /* the class number of \.{0123456789} */
@d period_class 1 /* the class number of `\..' */
@d space_class 2 /* the class number of spaces and nonstandard characters */
@d percent_class 3 /* the class number of `\.\%' */
@d string_class 4 /* the class number of `\."' */
@d right_paren_class 8 /* the class number of `\.)' */
@d isolated_classes 5: case 6: case 7: case 8 /* characters that make length-one tokens only */
@d letter_class 9 /* letters and the underline character */
@d left_bracket_class 17 /* `\.[' */
@d right_bracket_class 18 /* `\.]' */
@d invalid_class 20 /* bad character in the input */
@d max_class 20 /* the largest class number */
@=
int char_class[256]; /* the class numbers */
@ If changes are made to accommodate non-ASCII character sets, they should
follow the guidelines in Appendix~C of {\sl The {\logos METAFONT\/}book}.
@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
@^system dependencies@>
@=
for (k = '0'; k <= '9'; k++)
mp->char_class[k] = digit_class;
mp->char_class['.'] = period_class;
mp->char_class[' '] = space_class;
mp->char_class['%'] = percent_class;
mp->char_class['"'] = string_class;
mp->char_class[','] = 5;
mp->char_class[';'] = 6;
mp->char_class['('] = 7;
mp->char_class[')'] = right_paren_class;
for (k = 'A'; k <= 'Z'; k++)
mp->char_class[k] = letter_class;
for (k = 'a'; k <= 'z'; k++)
mp->char_class[k] = letter_class;
mp->char_class['_'] = letter_class;
mp->char_class['<'] = 10;
mp->char_class['='] = 10;
mp->char_class['>'] = 10;
mp->char_class[':'] = 10;
mp->char_class['|'] = 10;
mp->char_class['`'] = 11;
mp->char_class['\''] = 11;
mp->char_class['+'] = 12;
mp->char_class['-'] = 12;
mp->char_class['/'] = 13;
mp->char_class['*'] = 13;
mp->char_class['\\'] = 13;
mp->char_class['!'] = 14;
mp->char_class['?'] = 14;
mp->char_class['#'] = 15;
mp->char_class['&'] = 15;
mp->char_class['@@'] = 15;
mp->char_class['$'] = 15;
mp->char_class['^'] = 16;
mp->char_class['~'] = 16;
mp->char_class['['] = left_bracket_class;
mp->char_class[']'] = right_bracket_class;
mp->char_class['{'] = 19;
mp->char_class['}'] = 19;
for (k = 0; k < ' '; k++)
mp->char_class[k] = invalid_class;
mp->char_class['\t'] = space_class;
mp->char_class['\f'] = space_class;
for (k = 127; k <= 255; k++)
mp->char_class[k] = invalid_class;
@* The hash table.
Symbolic tokens are stored in and retrieved from an AVL tree. This
is not as fast as an actual hash table, but it is easily extensible.
A symbolic token contains a pointer to the |str_number| that
contains the string representation of the symbol, a |halfword|
that holds the current command value of the token, and an
|mp_value| for the associated equivalent.
@d text(A) (A)->text /* string number for symbolic token name */
@d eq_type(A) (A)->type /* the current ``meaning'' of a symbolic token */
@d equiv(A) (A)->v.data.val /* parametric part of a token's meaning */
@d equiv_node(A) (A)->v.data.node /* parametric part of a token's meaning */
@d equiv_sym(A) (A)->v.data.sym /* parametric part of a token's meaning */
@ @=
typedef struct mp_symbol_entry {
halfword type;
mp_value v;
str_number text;
} mp_symbol_entry;
@ @=
integer st_count; /* total number of known identifiers */
avl_tree symbols; /* avl tree of symbolic tokens */
avl_tree frozen_symbols; /* avl tree of frozen symbolic tokens */
mp_sym frozen_bad_vardef;
mp_sym frozen_colon;
mp_sym frozen_end_def;
mp_sym frozen_end_for;
mp_sym frozen_end_group;
mp_sym frozen_etex;
mp_sym frozen_fi;
mp_sym frozen_inaccessible;
mp_sym frozen_left_bracket;
mp_sym frozen_mpx_break;
mp_sym frozen_repeat_loop;
mp_sym frozen_right_delimiter;
mp_sym frozen_semicolon;
mp_sym frozen_slash;
mp_sym frozen_undefined;
mp_sym frozen_dump;
@ Here are the functions needed for the avl construction.
@=
static int comp_symbols_entry (void *p, const void *pa, const void *pb);
static void *copy_symbols_entry (const void *p);
static void *delete_symbols_entry (void *p);
@ The avl comparison function is a straightword version of |strcmp|,
except that checks for the string lengths first.
@c
static int comp_symbols_entry (void *p, const void *pa, const void *pb) {
const mp_symbol_entry *a = (const mp_symbol_entry *) pa;
const mp_symbol_entry *b = (const mp_symbol_entry *) pb;
(void) p;
if (a->text->len != b->text->len) {
return (a->text->len > b->text->len ? 1 : -1);
}
return strncmp ((const char *) a->text->str, (const char *) b->text->str,
a->text->len);
}
@ Copying a symbol happens when an item is inserted into an AVL tree.
The |text| needs to be deep copied, every thing else can be reassigned.
@c
static void *copy_symbols_entry (const void *p) {
mp_sym ff;
const mp_symbol_entry *fp;
fp = (const mp_symbol_entry *) p;
ff = malloc (sizeof (mp_symbol_entry));
if (ff == NULL)
return NULL;
ff->text = copy_strings_entry (fp->text);
if (ff->text == NULL)
return NULL;
ff->v = fp->v;
ff->type = fp->type;
return ff;
}
@ In the current implementation, symbols are not freed until the
end of the run.
@c
static void *delete_symbols_entry (void *p) {
mp_sym ff = (mp_sym) p;
delete_strings_entry (ff->text);
mp_xfree (ff);
return NULL;
}
@ @=
mp->symbols = avl_create (comp_symbols_entry,
copy_symbols_entry,
delete_symbols_entry, malloc, free, NULL);
mp->frozen_symbols = avl_create (comp_symbols_entry,
copy_symbols_entry,
delete_symbols_entry, malloc, free, NULL);
@ @=
if (mp->symbols != NULL)
avl_destroy (mp->symbols);
if (mp->frozen_symbols != NULL)
avl_destroy (mp->frozen_symbols);
@ Actually creating symbols is done by |id_lookup|, but in order to
do so it needs a way to create a new, empty symbol structure.
@=
static mp_sym new_symbols_entry (MP mp, unsigned char *nam, size_t len);
@ @c
static mp_sym new_symbols_entry (MP mp, unsigned char *nam, size_t len) {
mp_sym ff;
ff = mp_xmalloc (mp, 1, sizeof (mp_symbol_entry));
memset (ff, 0, sizeof (mp_symbol_entry));
ff->text = new_strings_entry (mp);
ff->text->str = nam;
ff->text->len = len;
ff->type = tag_token;
ff->v.type = mp_known;
FUNCTION_TRACE4 ("%p = new_symbols_entry(\"%s\",%d)\n", ff, nam, len);
return ff;
}
@ Certain symbols are ``frozen'' and not redefinable, since they are
used
in error recovery.
@=
mp->st_count = 0;
mp->frozen_bad_vardef =
mp_frozen_primitive (mp, "a bad variable", tag_token, 0);
mp->frozen_right_delimiter = mp_frozen_primitive (mp, ")", right_delimiter, 0);
mp->frozen_inaccessible =
mp_frozen_primitive (mp, " INACCESSIBLE", tag_token, 0);
mp->frozen_undefined = mp_frozen_primitive (mp, " UNDEFINED", tag_token, 0);
@ Here is the subroutine that searches the avl tree for an identifier
that matches a given string of length~|l| appearing in |buffer[j..
(j+l-1)]|. If the identifier is not found, it is inserted if
|insert_new| is |true|, and the corresponding symbol will be returned.
There are two variations on the lookup function: one for the normal
symbol table, and one for the table of error recovery symbols.
@c
static mp_sym mp_do_id_lookup (MP mp, avl_tree symbols, const char *j,
size_t l, boolean insert_new) {
/* search an avl tree */
mp_sym s, str;
unsigned char *nam = (unsigned char *) mp_xstrldup (mp, j, l);
s = new_symbols_entry (mp, nam, l);
str = (mp_sym) avl_find (s, symbols);
if (str == NULL && insert_new) {
mp->st_count++;
assert (avl_ins (s, symbols, avl_false) > 0);
str = (mp_sym) avl_find (s, symbols);
}
delete_symbols_entry (s);
return str;
}
static mp_sym mp_id_lookup (MP mp, char *j, size_t l, boolean insert_new) {
/* search the normal symbol table */
return mp_do_id_lookup (mp, mp->symbols, j, l, insert_new);
}
static mp_sym mp_frozen_id_lookup (MP mp, const char *j, size_t l,
boolean insert_new) {
/* search the error recovery symbol table */
return mp_do_id_lookup (mp, mp->frozen_symbols, j, l, insert_new);
}
@ We need to put \MP's ``primitive'' symbolic tokens into the hash
table, together with their command code (which will be the |eq_type|)
and an operand (which will be the |equiv|). The |primitive| procedure
does this, in a way that no \MP\ user can. The global value |cur_sym|
contains the new |eqtb| pointer after |primitive| has acted.
@c
static void mp_primitive (MP mp, const char *ss, halfword c, halfword o) {
char *s = mp_xstrdup (mp, ss);
mp->cur_sym = mp_id_lookup (mp, s, strlen (s), true);
mp_xfree (s);
eq_type (mp->cur_sym) = c;
equiv (mp->cur_sym) = o;
}
@ Some other symbolic tokens only exist for error recovery.
@c
static mp_sym mp_frozen_primitive (MP mp, const char *ss, halfword c,
halfword o) {
mp_sym str = mp_frozen_id_lookup (mp, ss, strlen (ss), true);
str->type = c;
str->v.data.val = o;
return str;
}
@ This routine returns |true| if the argument is an un-redefinable symbol
because it is one of the error recovery tokens (as explained elsewhere,
|frozen_inaccessible| actuall is redefinable).
@c
static boolean mp_is_frozen (MP mp, mp_sym sym) {
mp_sym temp = mp_frozen_id_lookup (mp, (char *) sym->text->str, sym->text->len, false);
if (temp==mp->frozen_inaccessible)
return false;
return (temp == sym);
}
@ Many of \MP's primitives need no |equiv|, since they are identifiable
by their |eq_type| alone. These primitives are loaded into the hash table
as follows:
@=
mp_primitive (mp, "..", path_join, 0);
@:.._}{\.{..} primitive@>;
mp_primitive (mp, "[", left_bracket, 0);
mp->frozen_left_bracket = mp_frozen_primitive (mp, "[", left_bracket, 0);
@:[ }{\.{[} primitive@>;
mp_primitive (mp, "]", right_bracket, 0);
@:] }{\.{]} primitive@>;
mp_primitive (mp, "}", right_brace, 0);
@:]]}{\.{\char`\}} primitive@>;
mp_primitive (mp, "{", left_brace, 0);
@:][}{\.{\char`\{} primitive@>;
mp_primitive (mp, ":", colon, 0);
mp->frozen_colon = mp_frozen_primitive (mp, ":", colon, 0);
@:: }{\.{:} primitive@>;
mp_primitive (mp, "::", double_colon, 0);
@::: }{\.{::} primitive@>;
mp_primitive (mp, "||:", bchar_label, 0);
@:::: }{\.{\char'174\char'174:} primitive@>;
mp_primitive (mp, ":=", assignment, 0);
@::=_}{\.{:=} primitive@>;
mp_primitive (mp, ",", comma, 0);
@:, }{\., primitive@>;
mp_primitive (mp, ";", semicolon, 0);
mp->frozen_semicolon = mp_frozen_primitive (mp, ";", semicolon, 0);
@:; }{\.; primitive@>;
mp_primitive (mp, "\\", relax, 0);
@:]]\\}{\.{\char`\\} primitive@>;
mp_primitive (mp, "addto", add_to_command, 0);
@:add_to_}{\&{addto} primitive@>;
mp_primitive (mp, "atleast", at_least, 0);
@:at_least_}{\&{atleast} primitive@>;
mp_primitive (mp, "begingroup", begin_group, 0);
mp->bg_loc = mp->cur_sym;
@:begin_group_}{\&{begingroup} primitive@>;
mp_primitive (mp, "controls", controls, 0);
@:controls_}{\&{controls} primitive@>;
mp_primitive (mp, "curl", curl_command, 0);
@:curl_}{\&{curl} primitive@>;
mp_primitive (mp, "delimiters", delimiters, 0);
@:delimiters_}{\&{delimiters} primitive@>;
mp_primitive (mp, "endgroup", end_group, 0);
mp->eg_loc = mp->cur_sym;
mp->frozen_end_group = mp_frozen_primitive (mp, "endgroup", end_group, 0);
@:endgroup_}{\&{endgroup} primitive@>;
mp_primitive (mp, "everyjob", every_job_command, 0);
@:every_job_}{\&{everyjob} primitive@>;
mp_primitive (mp, "exitif", exit_test, 0);
@:exit_if_}{\&{exitif} primitive@>;
mp_primitive (mp, "expandafter", expand_after, 0);
@:expand_after_}{\&{expandafter} primitive@>;
mp_primitive (mp, "interim", interim_command, 0);
@:interim_}{\&{interim} primitive@>;
mp_primitive (mp, "let", let_command, 0);
@:let_}{\&{let} primitive@>;
mp_primitive (mp, "newinternal", new_internal, 0);
@:new_internal_}{\&{newinternal} primitive@>;
mp_primitive (mp, "of", of_token, 0);
@:of_}{\&{of} primitive@>;
mp_primitive (mp, "randomseed", mp_random_seed, 0);
@:mp_random_seed_}{\&{randomseed} primitive@>;
mp_primitive (mp, "save", save_command, 0);
@:save_}{\&{save} primitive@>;
mp_primitive (mp, "scantokens", scan_tokens, 0);
@:scan_tokens_}{\&{scantokens} primitive@>;
mp_primitive (mp, "shipout", ship_out_command, 0);
@:ship_out_}{\&{shipout} primitive@>;
mp_primitive (mp, "skipto", skip_to, 0);
@:skip_to_}{\&{skipto} primitive@>;
mp_primitive (mp, "special", special_command, 0);
@:special}{\&{special} primitive@>;
mp_primitive (mp, "fontmapfile", special_command, 1);
@:fontmapfile}{\&{fontmapfile} primitive@>;
mp_primitive (mp, "fontmapline", special_command, 2);
@:fontmapline}{\&{fontmapline} primitive@>;
mp_primitive (mp, "step", step_token, 0);
@:step_}{\&{step} primitive@>;
mp_primitive (mp, "str", str_op, 0);
@:str_}{\&{str} primitive@>;
mp_primitive (mp, "tension", tension, 0);
@:tension_}{\&{tension} primitive@>;
mp_primitive (mp, "to", to_token, 0);
@:to_}{\&{to} primitive@>;
mp_primitive (mp, "until", until_token, 0);
@:until_}{\&{until} primitive@>;
mp_primitive (mp, "within", within_token, 0);
@:within_}{\&{within} primitive@>;
mp_primitive (mp, "write", write_command, 0);
@:write_}{\&{write} primitive@>
@ Each primitive has a corresponding inverse, so that it is possible to
display the cryptic numeric contents of |eqtb| in symbolic form.
Every call of |primitive| in this program is therefore accompanied by some
straightforward code that forms part of the |print_cmd_mod| routine
explained below.
@=
case add_to_command:
mp_print (mp, "addto");
break;
case assignment:
mp_print (mp, ":=");
break;
case at_least:
mp_print (mp, "atleast");
break;
case bchar_label:
mp_print (mp, "||:");
break;
case begin_group:
mp_print (mp, "begingroup");
break;
case colon:
mp_print (mp, ":");
break;
case comma:
mp_print (mp, ",");
break;
case controls:
mp_print (mp, "controls");
break;
case curl_command:
mp_print (mp, "curl");
break;
case delimiters:
mp_print (mp, "delimiters");
break;
case double_colon:
mp_print (mp, "::");
break;
case end_group:
mp_print (mp, "endgroup");
break;
case every_job_command:
mp_print (mp, "everyjob");
break;
case exit_test:
mp_print (mp, "exitif");
break;
case expand_after:
mp_print (mp, "expandafter");
break;
case interim_command:
mp_print (mp, "interim");
break;
case left_brace:
mp_print (mp, "{");
break;
case left_bracket:
mp_print (mp, "[");
break;
case let_command:
mp_print (mp, "let");
break;
case new_internal:
mp_print (mp, "newinternal");
break;
case of_token:
mp_print (mp, "of");
break;
case path_join:
mp_print (mp, "..");
break;
case mp_random_seed:
mp_print (mp, "randomseed");
break;
case relax:
mp_print_char (mp, xord ('\\'));
break;
case right_brace:
mp_print_char (mp, xord ('}'));
break;
case right_bracket:
mp_print_char (mp, xord (']'));
break;
case save_command:
mp_print (mp, "save");
break;
case scan_tokens:
mp_print (mp, "scantokens");
break;
case semicolon:
mp_print_char (mp, xord (';'));
break;
case ship_out_command:
mp_print (mp, "shipout");
break;
case skip_to:
mp_print (mp, "skipto");
break;
case special_command:
if (m == 2)
mp_print (mp, "fontmapline");
else if (m == 1)
mp_print (mp, "fontmapfile");
else
mp_print (mp, "special");
break;
case step_token:
mp_print (mp, "step");
break;
case str_op:
mp_print (mp, "str");
break;
case tension:
mp_print (mp, "tension");
break;
case to_token:
mp_print (mp, "to");
break;
case until_token:
mp_print (mp, "until");
break;
case within_token:
mp_print (mp, "within");
break;
case write_command:
mp_print (mp, "write");
break;
@ We will deal with the other primitives later, at some point in the program
where their |eq_type| and |equiv| values are more meaningful. For example,
the primitives for macro definitions will be loaded when we consider the
routines that define macros. It is easy to find where each particular
primitive was treated by looking in the index at the end; for example, the
section where |"def"| entered |eqtb| is listed under `\&{def} primitive'.
@* Token lists.
A \MP\ token is either symbolic or numeric or a string, or it denotes a macro
parameter or capsule or an internal; so there are six corresponding ways to
encode it internally:
@^token@>
(1)~A symbolic token for symbol |p| is represented by the pointer |p|,
in the |sym_sym| field of a symbolic node in~|mem|. The |type| field is |symbol_node|;
and it has a |name_type| to differentiate various subtypes of symbolic tokens,
which is usually |normal_sym|, but |macro_sym| for macro names.
(2)~A numeric token whose |scaled| value is~|v| is
represented in a non-symbolic node of~|mem|; the |type| field is |known|,
the |name_type| field is |token|, and the |value| field holds~|v|.
(3)~A string token is also represented in a non-symbolic node; the |type|
field is |mp_string_type|, the |name_type| field is |token|, and the
|value| field holds the corresponding |str_number|.
(4)~Capsules have |name_type=capsule|, and their |type| and |value| fields
represent arbitrary values, with |type| different from |symbol_node|
(in ways to be explained later).
(5)~Macro parameters appear in |sym_info| fields of symbolic nodes. The |type|
field is |symbol_node|; the $k$th parameter is represented by |k| in |sym_info|;
and |expr_sym| in |name_type|, if it is of type \&{expr}, or |suffix_sym| if it
is of type \&{suffix}, or by |text_sym| if it is of type \&{text}.
(6)~The $k$th internal is also represented by |k| in |sym_info|; the |type| field is
|symbol_node| as for the other symbolic tokens; and |internal_sym| is its |name_type|;
Actual values of the parameters and internals are kept in a separate
stack, as we will see later.
Note that the `\\{type}' field of a node has nothing to do with ``type'' in a
printer's sense. It's curious that the same word is used in such different ways.
@d token_node_size sizeof(mp_token_node_data) /* the number of words in a large token node */
@d value_sym(A) ((mp_token_node)(A))->data.sym /* the sym stored in a large token node */
@d value(A) ((mp_token_node)(A))->data.val /* the value stored in a large token node */
@d set_value(A,B) do { /* store the value in a large token node */
knot_value(A)=NULL;
str_value(A)=NULL;
value_node(A)=NULL;
value(A)=(B);
} while (0)
@d value_node(A) ((mp_token_node)(A))->data.node /* the value stored in a large token node */
@d set_value_node(A,B) do { /* store the value in a large token node */
knot_value(A)=NULL;
str_value(A)=NULL;
value_node(A)=(B);
value(A)=0;
} while (0)
@d str_value(A) ((mp_token_node)(A))->data.str /* the value stored in a large token node */
@d set_str_value(A,B) do { /* store the value in a large token node */
knot_value(A)=NULL;
str_value(A)=(B);
value_node(A)=NULL;
value(A)=0;
} while (0)
@d knot_value(A) ((mp_token_node)(A))->data.p /* the value stored in a large token node */
@d set_knot_value(A,B) do { /* store the value in a large token node */
knot_value(A)=(B);
str_value(A)=NULL;
value_node(A)=NULL;
value(A)=0;
} while (0)
@(mpmp.h@>=
typedef struct mp_token_node_data {
NODE_BODY;
mp_value_data data;
} mp_token_node_data;
typedef struct mp_token_node_data *mp_token_node;
@
@c
static mp_node mp_get_token_node (MP mp) {
mp_token_node p = (mp_token_node) xmalloc (1, token_node_size);
add_var_used (token_node_size);
memset (p, 0, token_node_size);
p->type = mp_token_node_type;
FUNCTION_TRACE2 ("%p = mp_get_token_node()\n", p);
return (mp_node) p;
}
@ A numeric token is created by the following trivial routine.
@c
static mp_node mp_new_num_tok (MP mp, scaled v) {
mp_node p; /* the new node */
p = mp_get_token_node (mp);
set_value (p, v);
p->type = mp_known;
p->name_type = mp_token;
return p;
}
@ A token list is a singly linked list of nodes in |mem|, where
each node contains a token and a link. Here's a subroutine that gets rid
of a token list when it is no longer needed.
@c
static void mp_flush_token_list (MP mp, mp_node p) {
mp_node q; /* the node being recycled */
FUNCTION_TRACE2 ("mp_flush_token_list(%p)\n", p);
while (p != NULL) {
q = p;
p = mp_link (p);
if (mp_type (q) == mp_symbol_node) {
mp_free_symbolic_node (mp, q);
} else {
switch (mp_type (q)) {
case mp_vacuous:
case mp_boolean_type:
case mp_known:
break;
case mp_string_type:
delete_str_ref (str_value (q));
break;
case unknown_types:
case mp_pen_type:
case mp_path_type:
case mp_picture_type:
case mp_pair_type:
case mp_color_type:
case mp_cmykcolor_type:
case mp_transform_type:
case mp_dependent:
case mp_proto_dependent:
case mp_independent:
mp_recycle_value (mp, q);
break;
default:
mp_confusion (mp, "token");
@:this can't happen token}{\quad token@>;
}
mp_free_node (mp, q, token_node_size);
}
}
}
@ The procedure |show_token_list|, which prints a symbolic form of
the token list that starts at a given node |p|, illustrates these
conventions. The token list being displayed should not begin with a reference
count.
An additional parameter |q| is also given; this parameter is either NULL
or it points to a node in the token list where a certain magic computation
takes place that will be explained later. (Basically, |q| is non-NULL when
we are printing the two-line context information at the time of an error
message; |q| marks the place corresponding to where the second line
should begin.)
The generation will stop, and `\.{\char`\ ETC.}' will be printed, if the length
of printing exceeds a given limit~|l|; the length of printing upon entry is
assumed to be a given amount called |null_tally|. (Note that
|show_token_list| sometimes uses itself recursively to print
variable names within a capsule.)
@^recursion@>
Unusual entries are printed in the form of all-caps tokens
preceded by a space, e.g., `\.{\char`\ BAD}'.
@=
static void mp_show_token_list (MP mp, mp_node p, mp_node q, integer l,
integer null_tally);
@ @c
void mp_show_token_list (MP mp, mp_node p, mp_node q, integer l,
integer null_tally) {
quarterword class, c; /* the |char_class| of previous and new tokens */
integer r, v; /* temporary registers */
class = percent_class;
mp->tally = null_tally;
while ((p != NULL) && (mp->tally < l)) {
if (p == q)
@;
@;
class = c;
p = mp_link (p);
}
if (p != NULL)
mp_print (mp, " ETC.");
@.ETC@>;
return;
}
@ @=
c = letter_class; /* the default */
if (mp_type (p) != mp_symbol_node) {
@;
} else {
if (mp_name_type (p) == mp_expr_sym ||
mp_name_type (p) == mp_suffix_sym || mp_name_type (p) == mp_text_sym) {
r = mp_sym_info (p);
if (mp_name_type (p) == mp_expr_sym) {
mp_print (mp, "(EXPR");
@.EXPR@>
} else if (mp_name_type (p) == mp_suffix_sym) {
mp_print (mp, "(SUFFIX");
@.SUFFIX@>
} else {
mp_print (mp, "(TEXT");
@.TEXT@>
}
mp_print_int (mp, r);
mp_print_char (mp, xord (')'));
c = right_paren_class;
} else {
mp_sym sr = mp_sym_sym (p);
if (sr == 0) {
@
} else {
str_number rr = text (sr);
if (rr == NULL) {
mp_print (mp, " NONEXISTENT");
@.NONEXISTENT@>
} else {
@;
}
}
}
}
@ @=
if (mp_name_type (p) == mp_token) {
if (mp_type (p) == mp_known) {
@;
} else if (mp_type (p) != mp_string_type) {
mp_print (mp, " BAD");
@.BAD@>
} else {
mp_print_char (mp, xord ('"'));
mp_print_str (mp, str_value (p));
mp_print_char (mp, xord ('"'));
c = string_class;
}
} else if ((mp_name_type (p) != mp_capsule) || (mp_type (p) < mp_vacuous)
|| (mp_type (p) > mp_independent)) {
mp_print (mp, " BAD");
} else {
mp_print_capsule (mp, p);
c = right_paren_class;
}
@ @=
if (class == digit_class)
mp_print_char (mp, xord (' '));
v = value (p);
if (v < 0) {
if (class == left_bracket_class)
mp_print_char (mp, xord (' '));
mp_print_char (mp, xord ('['));
mp_print_scaled (mp, v);
mp_print_char (mp, xord (']'));
c = right_bracket_class;
} else {
mp_print_scaled (mp, v);
c = digit_class;
}
@ Strictly speaking, a genuine token will never have |mp_info(p)=0|.
But we will see later (in the |print_variable_name| routine) that
it is convenient to let |mp_info(p)=0| stand for `\.{[]}'.
@=
{
if (class == left_bracket_class)
mp_print_char (mp, xord (' '));
mp_print (mp, "[]");
c = right_bracket_class;
}
@ @=
{
c = (quarterword) mp->char_class[(rr->str[0])];
if (c == class) {
switch (c) {
case letter_class:
mp_print_char (mp, xord ('.'));
break;
case isolated_classes:
break;
default:
mp_print_char (mp, xord (' '));
break;
}
}
mp_print_str (mp, rr);
}
@ @=
static void mp_print_capsule (MP mp, mp_node p);
@ @=
void mp_print_capsule (MP mp, mp_node p) {
mp_print_char (mp, xord ('('));
mp_print_exp (mp, p, 0);
mp_print_char (mp, xord (')'));
}
@ Macro definitions are kept in \MP's memory in the form of token lists
that have a few extra symbolic nodes at the beginning.
The first node contains a reference count that is used to tell when the
list is no longer needed. To emphasize the fact that a reference count is
present, we shall refer to the |sym_info| field of this special node as the
|ref_count| field.
@^reference counts@>
The next node or nodes after the reference count serve to describe the
formal parameters. They consist of zero or more parameter tokens followed
by a code for the type of macro.
@d ref_count(A) mp_sym_info(A)
/* reference count preceding a macro definition or picture header */
@d add_mac_ref(A) set_mp_sym_info((A),ref_count((A))+1) /* make a new reference to a macro list */
@d decr_mac_ref(A) set_mp_sym_info((A),ref_count((A))-1) /* remove a reference to a macro list */
@d general_macro 0 /* preface to a macro defined with a parameter list */
@d primary_macro 1 /* preface to a macro with a \&{primary} parameter */
@d secondary_macro 2 /* preface to a macro with a \&{secondary} parameter */
@d tertiary_macro 3 /* preface to a macro with a \&{tertiary} parameter */
@d expr_macro 4 /* preface to a macro with an undelimited \&{expr} parameter */
@d of_macro 5 /* preface to a macro with
undelimited `\&{expr} |x| \&{of}~|y|' parameters */
@d suffix_macro 6 /* preface to a macro with an undelimited \&{suffix} parameter */
@d text_macro 7 /* preface to a macro with an undelimited \&{text} parameter */
@d expr_param 8
@d suffix_param 9
@d text_param 10
@c
static void mp_delete_mac_ref (MP mp, mp_node p) {
/* |p| points to the reference count of a macro list that is
losing one reference */
if (ref_count (p) == 0)
mp_flush_token_list (mp, p);
else
decr_mac_ref (p);
}
@ The following subroutine displays a macro, given a pointer to its
reference count.
@c
static void mp_show_macro (MP mp, mp_node p, mp_node q, integer l) {
mp_node r; /* temporary storage */
p = mp_link (p); /* bypass the reference count */
while (mp_name_type (p) != mp_macro_sym) {
r = mp_link (p);
mp_link (p) = NULL;
mp_show_token_list (mp, p, NULL, l, 0);
mp_link (p) = r;
p = r;
if (l > 0)
l = l - mp->tally;
else
return;
} /* control printing of `\.{ETC.}' */
@.ETC@>;
mp->tally = 0;
switch (mp_sym_info (p)) {
case general_macro:
mp_print (mp, "->");
break;
@.->@>
case primary_macro:
case secondary_macro:
case tertiary_macro:
mp_print_char (mp, xord ('<'));
mp_print_cmd_mod (mp, param_type, mp_sym_info (p));
mp_print (mp, ">->");
break;
case expr_macro:
mp_print (mp, "->");
break;
case of_macro:
mp_print (mp, "of->");
break;
case suffix_macro:
mp_print (mp, "->");
break;
case text_macro:
mp_print (mp, "->");
break;
} /* there are no other cases */
mp_show_token_list (mp, mp_link (p), q, l - mp->tally, 0);
}
@* Data structures for variables.
The variables of \MP\ programs can be simple, like `\.x', or they can
combine the structural properties of arrays and records, like `\.{x20a.b}'.
A \MP\ user assigns a type to a variable like \.{x20a.b} by saying, for
example, `\.{boolean} \.{x[]a.b}'. It's time for us to study how such
things are represented inside of the computer.
Each variable value occupies two consecutive words, either in a non-symbolic
node called a value node, or as a non-symbolic subfield of a larger node. One
of those two words is called the |value| field; it is an integer,
containing either a |scaled| numeric value or the representation of some
other type of quantity. (It might also be subdivided into halfwords, in
which case it is referred to by other names instead of |value|.) The other
word is broken into subfields called |type|, |name_type|, and |link|. The
|type| field is a quarterword that specifies the variable's type, and
|name_type| is a quarterword from which \MP\ can reconstruct the
variable's name (sometimes by using the |link| field as well). Thus, only
1.25 words are actually devoted to the value itself; the other
three-quarters of a word are overhead, but they aren't wasted because they
allow \MP\ to deal with sparse arrays and to provide meaningful diagnostics.
In this section we shall be concerned only with the structural aspects of
variables, not their values. Later parts of the program will change the
|type| and |value| fields, but we shall treat those fields as black boxes
whose contents should not be touched.
However, if the |type| field is |mp_structured|, there is no |value| field,
and the second word is broken into two pointer fields called |attr_head|
and |subscr_head|. Those fields point to additional nodes that
contain structural information, as we shall see.
TH Note: DEK and JDH had a nice theoretical split between |value|,
|attr| and |subscr| nodes, as documented above and further
below. However, all three types had a bad habit of transmuting into
each other in practice while pointers to them still lived on
elsewhere, so using three different C structures is simply not
workable. All three are now represented as a single C structure called
|mp_value_node|.
There is a union in this structure in the interest of space
saving: |subscript_| and |hashloc_| are mutually exclusive.
Actually, so are |attr_head_| + |subscr_head_| on one side and and
|value_| on the other, but because of all the access macros that are
used in the code base to get at values, those cannot be folded into a
union (yet); this would have required creating a similar union in
|mp_token_node| where it would only serve to confuse things.
Finally, |parent_| only applies in |attr| nodes (the ones that have
|hashloc_|), but creating an extra substructure inside the union just
for that does not save space and the extra complication in the
structure is not worth the minimal extra code clarification.
@d attr_head(A) ((mp_value_node)(A))->attr_head_ /* pointer to attribute info */
@d set_attr_head(A,B) do {
mp_node d = (B);
/* |printf("set attrhead of %p to %p on %d\n",A,d,__LINE__);| */
attr_head((A)) = d;
} while (0)
@d subscr_head(A) ((mp_value_node)(A))->subscr_head_ /* pointer to subscript info */
@d set_subscr_head(A,B) do {
mp_node d = (B);
/* |printf("set subcrhead of %p to %p on %d\n",A,d,__LINE__);| */
subscr_head((A)) = d;
} while (0)
@(mpmp.h@>=
typedef struct mp_value_node_data {
NODE_BODY;
mp_value_data data;
union {
scaled subscript_;
mp_sym hashloc_;
} v;
mp_node parent_;
mp_node attr_head_;
mp_node subscr_head_;
} mp_value_node_data;
@ @=
static mp_node mp_get_value_node (MP mp);
@ It would have been nicer to make |mp_get_value_node| return
|mp_value_node| variables, but with |eqtb| as it stands that
became messy: lots of typecasts. So, it returns a simple
|mp_node| for now.
@d value_node_size sizeof(struct mp_value_node_data) /* the number of words in a value node */
@d mp_free_value_node(a,b) mp_free_node(a,b,value_node_size)
@c
static mp_node mp_get_value_node (MP mp) {
mp_node p = xmalloc (1, value_node_size);
add_var_used (value_node_size);
memset (p, 0, value_node_size);
mp_type (p) = mp_value_node_type;
FUNCTION_TRACE2 ("%p = mp_get_value_node()\n", p);
return p;
}
@ An attribute node is three words long. Two of these words contain |type|
and |value| fields as described above, and the third word contains
additional information: There is an |hashloc| field, which contains the
hash address of the token that names this attribute; and there's also a
|parent| field, which points to the value node of |mp_structured| type at the
next higher level (i.e., at the level to which this attribute is
subsidiary). The |name_type| in an attribute node is `|attr|'. The
|link| field points to the next attribute with the same parent; these are
arranged in increasing order, so that |hashloc(mp_link(p))>hashloc(p)|. The
final attribute node links to the constant |end_attr|, whose |hashloc|
field is greater than any legal hash address. The |attr_head| in the
parent points to a node whose |name_type| is |mp_structured_root|; this
node represents the NULL attribute, i.e., the variable that is relevant
when no attributes are attached to the parent. The |attr_head| node
has the fields of either
a value node, a subscript node, or an attribute node, depending on what
the parent would be if it were not structured; but the subscript and
attribute fields are ignored, so it effectively contains only the data of
a value node. The |link| field in this special node points to an attribute
node whose |hashloc| field is zero; the latter node represents a collective
subscript `\.{[]}' attached to the parent, and its |link| field points to
the first non-special attribute node (or to |end_attr| if there are none).
A subscript node likewise occupies three words, with |type| and |value| fields
plus extra information; its |name_type| is |subscr|. In this case the
third word is called the |subscript| field, which is a |scaled| integer.
The |link| field points to the subscript node with the next larger
subscript, if any; otherwise the |link| points to the attribute node
for collective subscripts at this level. We have seen that the latter node
contains an upward pointer, so that the parent can be deduced.
The |name_type| in a parent-less value node is |root|, and the |link|
is the hash address of the token that names this value.
In other words, variables have a hierarchical structure that includes
enough threads running around so that the program is able to move easily
between siblings, parents, and children. An example should be helpful:
(The reader is advised to draw a picture while reading the following
description, since that will help to firm up the ideas.)
Suppose that `\.x' and `\.{x.a}' and `\.{x[]b}' and `\.{x5}'
and `\.{x20b}' have been mentioned in a user's program, where
\.{x[]b} has been declared to be of \&{boolean} type. Let |h(x)|, |h(a)|,
and |h(b)| be the hash addresses of \.x, \.a, and~\.b. Then
|eq_type(h(x))=name| and |equiv(h(x))=p|, where |p|~is a non-symbolic value
node with |mp_name_type(p)=root| and |mp_link(p)=h(x)|. We have |type(p)=mp_structured|,
|attr_head(p)=q|, and |subscr_head(p)=r|, where |q| points to a value
node and |r| to a subscript node. (Are you still following this? Use
a pencil to draw a diagram.) The lone variable `\.x' is represented by
|type(q)| and |value(q)|; furthermore
|mp_name_type(q)=mp_structured_root| and |mp_link(q)=q1|, where |q1| points
to an attribute node representing `\.{x[]}'. Thus |mp_name_type(q1)=attr|,
|hashloc(q1)=collective_subscript=0|, |parent(q1)=p|,
|type(q1)=mp_structured|, |attr_head(q1)=qq|, and |subscr_head(q1)=qq1|;
|qq| is a three-word ``attribute-as-value'' node with |type(qq)=numeric_type|
(assuming that \.{x5} is numeric, because |qq| represents `\.{x[]}'
with no further attributes), |mp_name_type(qq)=structured_root|,
|hashloc(qq)=0|, |parent(qq)=p|, and
|mp_link(qq)=qq1|. (Now pay attention to the next part.) Node |qq1| is
an attribute node representing `\.{x[][]}', which has never yet
occurred; its |type| field is |undefined|, and its |value| field is
undefined. We have |mp_name_type(qq1)=attr|, |hashloc(qq1)=collective_subscript|,
|parent(qq1)=q1|, and |mp_link(qq1)=qq2|. Since |qq2| represents
`\.{x[]b}', |type(qq2)=mp_unknown_boolean|; also |hashloc(qq2)=h(b)|,
|parent(qq2)=q1|, |mp_name_type(qq2)=attr|, |mp_link(qq2)=end_attr|.
(Maybe colored lines will help untangle your picture.)
Node |r| is a subscript node with |type| and |value|
representing `\.{x5}'; |mp_name_type(r)=subscr|, |subscript(r)=5.0|,
and |mp_link(r)=r1| is another subscript node. To complete the picture,
see if you can guess what |mp_link(r1)| is; give up? It's~|q1|.
Furthermore |subscript(r1)=20.0|, |mp_name_type(r1)=subscr|,
|type(r1)=mp_structured|, |attr_head(r1)=qqq|, |subscr_head(r1)=qqq1|,
and we finish things off with three more nodes
|qqq|, |qqq1|, and |qqq2| hung onto~|r1|. (Perhaps you should start again
with a larger sheet of paper.) The value of variable \.{x20b}
appears in node~|qqq2|, as you can well imagine.
If the example in the previous paragraph doesn't make things crystal
clear, a glance at some of the simpler subroutines below will reveal how
things work out in practice.
The only really unusual thing about these conventions is the use of
collective subscript attributes. The idea is to avoid repeating a lot of
type information when many elements of an array are identical macros
(for which distinct values need not be stored) or when they don't have
all of the possible attributes. Branches of the structure below collective
subscript attributes do not carry actual values except for macro identifiers;
branches of the structure below subscript nodes do not carry significant
information in their collective subscript attributes.
@d hashloc(A) ((mp_value_node)(A))->v.hashloc_ /* hash address of this attribute */
@d set_hashloc(A,B) do {
/* |printf ("set attrloc of %p to %d on %d\n", (A), d, __LINE__);| */
((mp_value_node)(A))->v.hashloc_ = (mp_sym)(B);
} while (0)
@d parent(A) (A)->parent_ /* pointer to |mp_structured| variable */
@
@d mp_free_attr_node(a,b) mp_free_node(a,b,value_node_size)
@c
static mp_value_node mp_get_attr_node (MP mp) {
mp_value_node p = (mp_value_node) mp_get_value_node (mp);
mp_type (p) = mp_attr_node_type;
return p;
}
@ Setting the |hashloc| field of |end_attr| to a value greater than
any legal hash address is done by assigning $-1$ typecasted to
|mp_sym|, hopefully resulting in all bits being set. On systems that
support negative pointer values or where typecasting $-1$ does not
result in all bits in a pointer being set, something else needs to be done.
@^system dependencies@>
@=
mp->end_attr = (mp_node) mp_get_attr_node (mp);
set_hashloc (mp->end_attr, -1);
parent ((mp_value_node) mp->end_attr) = NULL;
@ @=
mp_free_attr_node (mp, mp->end_attr);
@
@d collective_subscript 0 /* code for the attribute `\.{[]}' */
@d subscript(A) ((mp_value_node)(A))->v.subscript_ /* subscript of this variable */
@c
static mp_value_node mp_get_subscr_node (MP mp) {
mp_value_node p = (mp_value_node) mp_get_value_node (mp);
mp_type (p) = mp_subscr_node_type;
return p;
}
@ Variables of type \&{pair} will have values that point to four-word
nodes containing two numeric values. The first of these values has
|name_type=mp_x_part_sector| and the second has |name_type=mp_y_part_sector|;
the |link| in the first points back to the node whose |value| points
to this four-word node.
@d x_part_loc(A) ((mp_pair_node)(A))->x_part_ /* where the \&{xpart} is found in a pair node */
@d y_part_loc(A) ((mp_pair_node)(A))->y_part_ /* where the \&{ypart} is found in a pair node */
@(mpmp.h@>=
typedef struct mp_pair_node_data {
NODE_BODY;
mp_node x_part_;
mp_node y_part_;
} mp_pair_node_data;
typedef struct mp_pair_node_data *mp_pair_node;
@
@d pair_node_size sizeof(struct mp_pair_node_data) /* the number of words in a subscript node */
@c
static mp_node mp_get_pair_node (MP mp) {
mp_pair_node p = (mp_pair_node) xmalloc (1, pair_node_size);
add_var_used (pair_node_size);
memset (p, 0, pair_node_size);
mp_type (p) = mp_pair_node_type;
FUNCTION_TRACE2("get_pair_node(): %p\n", p);
return (mp_node) p;
}
@ If |type(p)=mp_pair_type| or if |value(p)=NULL|, the procedure call |init_pair_node(p)| will
allocate a pair node for~|p|. The individual parts of such nodes are initially of type
|mp_independent|.
@c
static void mp_init_pair_node (MP mp, mp_node p) {
mp_node q; /* the new node */
mp_type (p) = mp_pair_type;
q = mp_get_pair_node (mp);
y_part_loc (q) = mp_get_value_node (mp);
new_indep (y_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (y_part_loc (q)) = (quarterword) (mp_y_part_sector);
mp_link (y_part_loc (q)) = p;
x_part_loc (q) = mp_get_value_node (mp);
new_indep (x_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (x_part_loc (q)) = (quarterword) (mp_x_part_sector);
mp_link (x_part_loc (q)) = p;
set_value_node (p, q);
}
@
Variables of type \&{transform} are similar, but in this case their
|value| points to a 12-word node containing six values, identified by
|x_part_sector|, |y_part_sector|, |mp_xx_part_sector|, |mp_xy_part_sector|,
|mp_yx_part_sector|, and |mp_yy_part_sector|.
@d tx_part_loc(A) ((mp_transform_node)(A))->tx_part_ /* where the \&{xpart} is found in a transform node */
@d ty_part_loc(A) ((mp_transform_node)(A))->ty_part_ /* where the \&{ypart} is found in a transform node */
@d xx_part_loc(A) ((mp_transform_node)(A))->xx_part_ /* where the \&{xxpart} is found in a transform node */
@d xy_part_loc(A) ((mp_transform_node)(A))->xy_part_ /* where the \&{xypart} is found in a transform node */
@d yx_part_loc(A) ((mp_transform_node)(A))->yx_part_ /* where the \&{yxpart} is found in a transform node */
@d yy_part_loc(A) ((mp_transform_node)(A))->yy_part_ /* where the \&{yypart} is found in a transform node */
@(mpmp.h@>=
typedef struct mp_transform_node_data {
NODE_BODY;
mp_node tx_part_;
mp_node ty_part_;
mp_node xx_part_;
mp_node yx_part_;
mp_node xy_part_;
mp_node yy_part_;
} mp_transform_node_data;
typedef struct mp_transform_node_data *mp_transform_node;
@
@d transform_node_size sizeof(struct mp_transform_node_data) /* the number of words in a subscript node */
@c
static mp_node mp_get_transform_node (MP mp) {
mp_transform_node p = (mp_transform_node) xmalloc (1, transform_node_size);
add_var_used (transform_node_size);
memset (p, 0, transform_node_size);
mp_type (p) = mp_transform_node_type;
return (mp_node) p;
}
@ @c
static void mp_init_transform_node (MP mp, mp_node p) {
mp_node q; /* the new node */
mp_type (p) = mp_transform_type;
q = mp_get_transform_node (mp); /* big node */
yy_part_loc (q) = mp_get_value_node (mp);
new_indep (yy_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (yy_part_loc (q)) = (quarterword) (mp_yy_part_sector);
mp_link (yy_part_loc (q)) = p;
yx_part_loc (q) = mp_get_value_node (mp);
new_indep (yx_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (yx_part_loc (q)) = (quarterword) (mp_yx_part_sector);
mp_link (yx_part_loc (q)) = p;
xy_part_loc (q) = mp_get_value_node (mp);
new_indep (xy_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (xy_part_loc (q)) = (quarterword) (mp_xy_part_sector);
mp_link (xy_part_loc (q)) = p;
xx_part_loc (q) = mp_get_value_node (mp);
new_indep (xx_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (xx_part_loc (q)) = (quarterword) (mp_xx_part_sector);
mp_link (xx_part_loc (q)) = p;
ty_part_loc (q) = mp_get_value_node (mp);
new_indep (ty_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (ty_part_loc (q)) = (quarterword) (mp_y_part_sector);
mp_link (ty_part_loc (q)) = p;
tx_part_loc (q) = mp_get_value_node (mp);
new_indep (tx_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (tx_part_loc (q)) = (quarterword) (mp_x_part_sector);
mp_link (tx_part_loc (q)) = p;
set_value_node (p, q);
}
@
Variables of type \&{color} have 3~values in 6~words identified by |mp_red_part_sector|,
|mp_green_part_sector|, and |mp_blue_part_sector|.
@d red_part_loc(A) ((mp_color_node)(A))->red_part_ /* where the \&{redpart} is found in a color node */
@d green_part_loc(A) ((mp_color_node)(A))->green_part_ /* where the \&{greenpart} is found in a color node */
@d blue_part_loc(A) ((mp_color_node)(A))->blue_part_ /* where the \&{bluepart} is found in a color node */
@d grey_part_loc(A) red_part_loc(A) /* where the \&{greypart} is found in a color node */
@(mpmp.h@>=
typedef struct mp_color_node_data {
NODE_BODY;
mp_node red_part_;
mp_node green_part_;
mp_node blue_part_;
} mp_color_node_data;
typedef struct mp_color_node_data *mp_color_node;
@
@d color_node_size sizeof(struct mp_color_node_data) /* the number of words in a subscript node */
@c
static mp_node mp_get_color_node (MP mp) {
mp_color_node p = (mp_color_node) xmalloc (1, color_node_size);
add_var_used (color_node_size);
memset (p, 0, color_node_size);
mp_type (p) = mp_color_node_type;
p->link = NULL;
return (mp_node) p;
}
@
@c
static void mp_init_color_node (MP mp, mp_node p) {
mp_node q; /* the new node */
mp_type (p) = mp_color_type;
q = mp_get_color_node (mp); /* big node */
blue_part_loc (q) = mp_get_value_node (mp);
new_indep (blue_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (blue_part_loc (q)) = (quarterword) (mp_blue_part_sector);
mp_link (blue_part_loc (q)) = p;
green_part_loc (q) = mp_get_value_node (mp);
new_indep (green_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (y_part_loc (q)) = (quarterword) (mp_green_part_sector);
mp_link (green_part_loc (q)) = p;
red_part_loc (q) = mp_get_value_node (mp);
new_indep (red_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (red_part_loc (q)) = (quarterword) (mp_red_part_sector);
mp_link (red_part_loc (q)) = p;
set_value_node (p, q);
}
@ Finally, variables of type |cmykcolor|.
@d cyan_part_loc(A) ((mp_cmykcolor_node)(A))->cyan_part_ /* where the \&{cyanpart} is found in a color node */
@d magenta_part_loc(A) ((mp_cmykcolor_node)(A))->magenta_part_ /* where the \&{magentapart} is found in a color node */
@d yellow_part_loc(A) ((mp_cmykcolor_node)(A))->yellow_part_ /* where the \&{yellowpart} is found in a color node */
@d black_part_loc(A) ((mp_cmykcolor_node)(A))->black_part_ /* where the \&{blackpart} is found in a color node */
@(mpmp.h@>=
typedef struct mp_cmykcolor_node_data {
NODE_BODY;
mp_node cyan_part_;
mp_node magenta_part_;
mp_node yellow_part_;
mp_node black_part_;
} mp_cmykcolor_node_data;
typedef struct mp_cmykcolor_node_data *mp_cmykcolor_node;
@
@d cmykcolor_node_size sizeof(struct mp_cmykcolor_node_data) /* the number of words in a subscript node */
@c
static mp_node mp_get_cmykcolor_node (MP mp) {
mp_cmykcolor_node p = (mp_cmykcolor_node) xmalloc (1, cmykcolor_node_size);
add_var_used (cmykcolor_node_size);
memset (p, 0, cmykcolor_node_size);
mp_type (p) = mp_cmykcolor_node_type;
p->link = NULL;
return (mp_node) p;
}
@
@c
static void mp_init_cmykcolor_node (MP mp, mp_node p) {
mp_node q; /* the new node */
mp_type (p) = mp_cmykcolor_type;
q = mp_get_cmykcolor_node (mp); /* big node */
black_part_loc (q) = mp_get_value_node (mp);
new_indep (black_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (black_part_loc (q)) = (quarterword) (mp_black_part_sector);
mp_link (black_part_loc (q)) = p;
yellow_part_loc (q) = mp_get_value_node (mp);
new_indep (yellow_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (yellow_part_loc (q)) = (quarterword) (mp_yellow_part_sector);
mp_link (yellow_part_loc (q)) = p;
magenta_part_loc (q) = mp_get_value_node (mp);
new_indep (magenta_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (magenta_part_loc (q)) = (quarterword) (mp_magenta_part_sector);
mp_link (magenta_part_loc (q)) = p;
cyan_part_loc (q) = mp_get_value_node (mp);
new_indep (cyan_part_loc (q)); /* sets |type(q)| and |value(q)| */
mp_name_type (cyan_part_loc (q)) = (quarterword) (mp_cyan_part_sector);
mp_link (cyan_part_loc (q)) = p;
set_value_node (p, q);
}
@ When an entire structured variable is saved, the |root| indication
is temporarily replaced by |saved_root|.
Some variables have no name; they just are used for temporary storage
while expressions are being evaluated. We call them {\sl capsules}.
@ The |id_transform| function creates a capsule for the
identity transformation.
@c
static mp_node mp_id_transform (MP mp) {
mp_node p, q; /* list manipulation registers */
p = mp_get_value_node (mp);
mp_name_type (p) = mp_capsule;
set_value (p, 0); /* todo: this was |null| */
mp_init_transform_node (mp, p);
q = value_node (p);
mp_type (tx_part_loc (q)) = mp_known;
set_value (tx_part_loc (q), 0);
mp_type (ty_part_loc (q)) = mp_known;
set_value (ty_part_loc (q), 0);
mp_type (xy_part_loc (q)) = mp_known;
set_value (xy_part_loc (q), 0);
mp_type (yx_part_loc (q)) = mp_known;
set_value (yx_part_loc (q), 0);
mp_type (xx_part_loc (q)) = mp_known;
set_value (xx_part_loc (q), unity);
mp_type (yy_part_loc (q)) = mp_known;
set_value (yy_part_loc (q), unity);
return p;
}
@ Tokens are of type |tag_token| when they first appear, but they point
to |NULL| until they are first used as the root of a variable.
The following subroutine establishes the root node on such grand occasions.
@c
static void mp_new_root (MP mp, mp_sym x) {
mp_node p; /* the new node */
p = mp_get_value_node (mp);
mp_type (p) = undefined;
mp_name_type (p) = mp_root;
value_sym (p) = x;
equiv_node (x) = p;
}
@ These conventions for variable representation are illustrated by the
|print_variable_name| routine, which displays the full name of a
variable given only a pointer to its value.
@=
static void mp_print_variable_name (MP mp, mp_node p);
@ @c
void mp_print_variable_name (MP mp, mp_node p) {
mp_node q; /* a token list that will name the variable's suffix */
mp_node r; /* temporary for token list creation */
while (mp_name_type (p) >= mp_x_part_sector) {
@;
}
q = NULL;
while (mp_name_type (p) > mp_saved_root) {
@;
}
/* now |link(p)| is the hash address of |p|, and
|name_type(p)| is either |root| or |saved_root|.
Have to prepend a token to |q| for |show_token_list|.
*/
r = mp_get_symbolic_node (mp);
set_mp_sym_sym (r, value_sym (p));
mp_link (r) = q;
if (mp_name_type (p) == mp_saved_root)
mp_print (mp, "(SAVED)");
@.SAVED@>;
mp_show_token_list (mp, r, NULL, max_integer, mp->tally);
mp_flush_token_list (mp, r);
}
@ @=
{
if (mp_name_type (p) == mp_subscr) {
r = mp_new_num_tok (mp, subscript (p));
do {
p = mp_link (p);
} while (mp_name_type (p) != mp_attr);
} else if (mp_name_type (p) == mp_structured_root) {
p = mp_link (p);
goto FOUND;
} else {
if (mp_name_type (p) != mp_attr)
mp_confusion (mp, "var");
@:this can't happen var}{\quad var@>;
r = mp_get_symbolic_node (mp);
set_mp_sym_sym (r, hashloc (p)); /* the hash address */
}
set_mp_link (r, q);
q = r;
FOUND:
p = parent ((mp_value_node) p);
}
@ @=
{
switch (mp_name_type (p)) {
case mp_x_part_sector:
mp_print (mp, "x");
break;
case mp_y_part_sector:
mp_print (mp, "y");
break;
case mp_xx_part_sector:
mp_print (mp, "xx");
break;
case mp_xy_part_sector:
mp_print (mp, "xy");
break;
case mp_yx_part_sector:
mp_print (mp, "yx");
break;
case mp_yy_part_sector:
mp_print (mp, "yy");
break;
case mp_red_part_sector:
mp_print (mp, "red");
break;
case mp_green_part_sector:
mp_print (mp, "green");
break;
case mp_blue_part_sector:
mp_print (mp, "blue");
break;
case mp_cyan_part_sector:
mp_print (mp, "cyan");
break;
case mp_magenta_part_sector:
mp_print (mp, "magenta");
break;
case mp_yellow_part_sector:
mp_print (mp, "yellow");
break;
case mp_black_part_sector:
mp_print (mp, "black");
break;
case mp_grey_part_sector:
mp_print (mp, "grey");
break;
case mp_capsule:
{
char pval[19]; /* allow 64bit pointers, + "0x" */
mp_print (mp, "%CAPSULE");
sprintf (pval, "%p", p);
mp_print (mp, pval);
return;
}
break;
@.CAPSULE@>
} /* there are no other cases */
mp_print (mp, "part ");
p = mp_link (p);
}
@ The |interesting| function returns |true| if a given variable is not
in a capsule, or if the user wants to trace capsules.
@c
static boolean mp_interesting (MP mp, mp_node p) {
quarterword t; /* a |name_type| */
if (internal_value (mp_tracing_capsules) > 0) {
return true;
} else {
t = mp_name_type (p);
if (t >= mp_x_part_sector && t != mp_capsule) {
switch (t) {
case mp_x_part_sector:
t = mp_name_type (mp_link (x_part_loc (p)));
break;
case mp_y_part_sector:
t = mp_name_type (mp_link (y_part_loc (p)));
break;
case mp_xx_part_sector:
t = mp_name_type (mp_link (xx_part_loc (p)));
break;
case mp_xy_part_sector:
t = mp_name_type (mp_link (xy_part_loc (p)));
break;
case mp_yx_part_sector:
t = mp_name_type (mp_link (yx_part_loc (p)));
break;
case mp_yy_part_sector:
t = mp_name_type (mp_link (yy_part_loc (p)));
break;
case mp_red_part_sector:
t = mp_name_type (mp_link (red_part_loc (p)));
break;
case mp_green_part_sector:
t = mp_name_type (mp_link (green_part_loc (p)));
break;
case mp_blue_part_sector:
t = mp_name_type (mp_link (blue_part_loc (p)));
break;
case mp_cyan_part_sector:
t = mp_name_type (mp_link (cyan_part_loc (p)));
break;
case mp_magenta_part_sector:
t = mp_name_type (mp_link (magenta_part_loc (p)));
break;
case mp_yellow_part_sector:
t = mp_name_type (mp_link (yellow_part_loc (p)));
break;
case mp_black_part_sector:
t = mp_name_type (mp_link (black_part_loc (p)));
break;
case mp_grey_part_sector:
t = mp_name_type (mp_link (grey_part_loc (p)));
break;
}
}
}
return (t != mp_capsule);
}
@ Now here is a subroutine that converts an unstructured type into an
equivalent structured type, by inserting a |mp_structured| node that is
capable of growing. This operation is done only when |mp_name_type(p)=root|,
|subscr|, or |attr|.
The procedure returns a pointer to the new node that has taken node~|p|'s
place in the structure. Node~|p| itself does not move, nor are its
|value| or |type| fields changed in any way.
@c
static mp_node mp_new_structure (MP mp, mp_node p) {
mp_node q, r = NULL; /* list manipulation registers */
mp_sym qq = NULL;
switch (mp_name_type (p)) {
case mp_root:
{
qq = value_sym (p);
r = mp_get_value_node (mp);
equiv_node (qq) = r;
}
break;
case mp_subscr:
@;
p_sym = mp_sym_sym (t);
t = mp_link (t);
if ((eq_type (p_sym) % outer_tag) != tag_token)
abort_find;
if (equiv_node (p_sym) == NULL)
mp_new_root (mp, p_sym);
p = equiv_node (p_sym);
pp = p;
while (t != NULL) {
@;
if (mp_type (t) != mp_symbol_node) {
@
} else {
@;
}
t = mp_link (t);
}
if (mp_type (pp) >= mp_structured) {
if (mp_type (pp) == mp_structured)
pp = attr_head (pp);
else
abort_find;
}
if (mp_type (p) == mp_structured)
p = attr_head (p);
if (mp_type (p) == undefined) {
if (mp_type (pp) == undefined) {
mp_type (pp) = mp_numeric_type;
set_value (pp, 0); /* todo: this was |null| */
}
mp_type (p) = mp_type (pp);
set_value (p, 0); /* todo: this was |null| */
}
return p;
}
@ Although |pp| and |p| begin together, they diverge when a subscript occurs;
|pp|~stays in the collective line while |p|~goes through actual subscript
values.
@=
{
if (mp_type (pp) != mp_structured) {
if (mp_type (pp) > mp_structured)
abort_find;
ss = mp_new_structure (mp, pp);
if (p == pp)
p = ss;
pp = ss;
} /* now |type(pp)=mp_structured| */
if (mp_type (p) != mp_structured) { /* it cannot be |>mp_structured| */
p = mp_new_structure (mp, p); /* now |type(p)=mp_structured| */
}
}
@ We want this part of the program to be reasonably fast, in case there are
@^inner loop@>
lots of subscripts at the same level of the data structure. Therefore
we store an ``infinite'' value in the word that appears at the end of the
subscript list, even though that word isn't part of a subscript node.
@=
{
halfword save_subscript; /* temporary storage */
n = value (t);
pp = mp_link (attr_head (pp)); /* now |hashloc(pp)=collective_subscript| */
q = mp_link (attr_head (p));
save_subscript = subscript (q);
subscript (q) = EL_GORDO;
s = mp->temp_head;
set_mp_link (s, subscr_head (p));
do {
r = s;
s = mp_link (s);
} while (n > subscript (s));
if (n == subscript (s)) {
p = s;
} else {
mp_value_node pp = mp_get_subscr_node (mp);
if (r == mp->temp_head)
set_subscr_head (p, (mp_node) pp);
else
set_mp_link (r, (mp_node) pp);
set_mp_link (pp, s);
subscript (pp) = n;
mp_name_type (pp) = mp_subscr;
mp_type (pp) = undefined;
p = (mp_node) pp;
}
subscript (q) = save_subscript;
}
@ @=
{
mp_sym nn = mp_sym_sym (t);
ss = attr_head (pp);
do {
rr = ss;
ss = mp_link (ss);
} while (nn > hashloc (ss));
if (nn < hashloc (ss)) {
qq = (mp_node) mp_get_attr_node (mp);
set_mp_link (rr, qq);
set_mp_link (qq, ss);
set_hashloc (qq, nn);
mp_name_type (qq) = mp_attr;
mp_type (qq) = undefined;
parent ((mp_value_node) qq) = pp;
ss = qq;
}
if (p == pp) {
p = ss;
pp = ss;
} else {
pp = ss;
s = attr_head (p);
do {
r = s;
s = mp_link (s);
} while (nn > hashloc (s));
if (nn == hashloc (s)) {
p = s;
} else {
q = (mp_node) mp_get_attr_node (mp);
set_mp_link (r, q);
set_mp_link (q, s);
set_hashloc (q, nn);
mp_name_type (q) = mp_attr;
mp_type (q) = undefined;
parent ((mp_value_node) q) = p;
p = q;
}
}
}
@ Variables lose their former values when they appear in a type declaration,
or when they are defined to be macros or \&{let} equal to something else.
A subroutine will be defined later that recycles the storage associated
with any particular |type| or |value|; our goal now is to study a higher
level process called |flush_variable|, which selectively frees parts of a
variable structure.
This routine has some complexity because of examples such as
`\hbox{\tt numeric x[]a[]b}'
which recycles all variables of the form \.{x[i]a[j]b} (and no others), while
`\hbox{\tt vardef x[]a[]=...}'
discards all variables of the form \.{x[i]a[j]} followed by an arbitrary
suffix, except for the collective node \.{x[]a[]} itself. The obvious way
to handle such examples is to use recursion; so that's what we~do.
@^recursion@>
Parameter |p| points to the root information of the variable;
parameter |t| points to a list of symbolic nodes that represent
suffixes, with |info=collective_subscript| for subscripts.
@=
static void mp_flush_cur_exp (MP mp, mp_value v);
@ @c
static void mp_flush_variable (MP mp, mp_node p, mp_node t,
boolean discard_suffixes) {
mp_node q, r; /* list manipulation */
mp_sym n; /* attribute to match */
while (t != NULL) {
if (mp_type (p) != mp_structured)
return;
n = mp_sym_sym (t);
t = mp_link (t);
if (n == collective_subscript) {
r = mp->temp_head;
mp_link (r) = subscr_head (p);
q = mp_link (r);
while (mp_name_type (q) == mp_subscr) {
mp_flush_variable (mp, q, t, discard_suffixes);
if (t == NULL) {
if (mp_type (q) == mp_structured) {
r = q;
} else {
set_mp_link (r, mp_link (q));
mp_free_node (mp, q, value_node_size);
}
} else {
r = q;
}
q = mp_link (r);
}
/* fix |subscr_head| if it was already present */
if (q==mp_link(mp->temp_head))
set_subscr_head (p, q);
}
p = attr_head (p);
do {
r = p;
p = mp_link (p);
} while (hashloc (p) < n);
if (hashloc (p) != n)
return;
}
if (discard_suffixes) {
mp_flush_below_variable (mp, p);
} else {
if (mp_type (p) == mp_structured)
p = attr_head (p);
mp_recycle_value (mp, p);
}
}
@ The next procedure is simpler; it wipes out everything but |p| itself,
which becomes undefined.
@=
static void mp_flush_below_variable (MP mp, mp_node p);
@ @c
void mp_flush_below_variable (MP mp, mp_node p) {
mp_node q, r; /* list manipulation registers */
FUNCTION_TRACE2 ("mp_flush_below_variable(%p)\n", p);
if (mp_type (p) != mp_structured) {
mp_recycle_value (mp, p); /* this sets |type(p)=undefined| */
} else {
q = subscr_head (p);
while (mp_name_type (q) == mp_subscr) {
mp_flush_below_variable (mp, q);
r = q;
q = mp_link (q);
mp_free_node (mp, r, value_node_size);
}
r = attr_head (p);
q = mp_link (r);
mp_recycle_value (mp, r);
mp_free_node (mp, r, value_node_size);
do {
mp_flush_below_variable (mp, q);
r = q;
q = mp_link (q);
mp_free_node (mp, r, value_node_size);
} while (q != mp->end_attr);
mp_type (p) = undefined;
}
}
@ Just before assigning a new value to a variable, we will recycle the
old value and make the old value undefined. The |und_type| routine
determines what type of undefined value should be given, based on
the current type before recycling.
@c
static quarterword mp_und_type (MP mp, mp_node p) {
(void) mp;
switch (mp_type (p)) {
case mp_vacuous:
return undefined;
case mp_boolean_type:
case mp_unknown_boolean:
return mp_unknown_boolean;
case mp_string_type:
case mp_unknown_string:
return mp_unknown_string;
case mp_pen_type:
case mp_unknown_pen:
return mp_unknown_pen;
case mp_path_type:
case mp_unknown_path:
return mp_unknown_path;
case mp_picture_type:
case mp_unknown_picture:
return mp_unknown_picture;
case mp_transform_type:
case mp_color_type:
case mp_cmykcolor_type:
case mp_pair_type:
case mp_numeric_type:
return mp_type (p);
case mp_known:
case mp_dependent:
case mp_proto_dependent:
case mp_independent:
return mp_numeric_type;
default: /* there are no other valid cases, but please the compiler */
return 0;
}
return 0;
}
@ The |clear_symbol| routine is used when we want to redefine the equivalent
of a symbolic token. It must remove any variable structure or macro
definition that is currently attached to that symbol. If the |saving|
parameter is true, a subsidiary structure is saved instead of destroyed.
@c
static void mp_clear_symbol (MP mp, mp_sym p, boolean saving) {
mp_node q; /* |equiv(p)| */
FUNCTION_TRACE3 ("mp_clear_symbol(%p,%d)\n", p, saving);
q = equiv_node (p);
switch (eq_type (p) % outer_tag) {
case defined_macro:
case secondary_primary_macro:
case tertiary_secondary_macro:
case expression_tertiary_macro:
if (!saving)
mp_delete_mac_ref (mp, q);
break;
case tag_token:
if (q != NULL) {
if (saving) {
mp_name_type (q) = mp_saved_root;
} else {
mp_flush_below_variable (mp, q);
mp_free_node (mp, q, value_node_size);
}
}
break;
default:
break;
}
equiv (p) = mp->frozen_undefined->v.data.val;
equiv_node (p) = NULL;
eq_type (p) = mp->frozen_undefined->type;
}
@* Saving and restoring equivalents.
The nested structure given by \&{begingroup} and \&{endgroup}
allows |eqtb| entries to be saved and restored, so that temporary changes
can be made without difficulty. When the user requests a current value to
be saved, \MP\ puts that value into its ``save stack.'' An appearance of
\&{endgroup} ultimately causes the old values to be removed from the save
stack and put back in their former places.
The save stack is a linked list containing three kinds of entries,
distinguished by their |info| fields. If |p| points to a saved item,
then
\smallskip\hang
|p->info=0| stands for a group boundary; each \&{begingroup} contributes
such an item to the save stack and each \&{endgroup} cuts back the stack
until the most recent such entry has been removed.
\smallskip\hang
|p->type=mp_normal_sym| and |p->info=q|, means that |p->equiv| holds the former
contents of |eqtb[q]|. Such save stack entries are generated by \&{save}
commands.
\smallskip\hang
|p->type=mp_internal_sym| and |p->info=q|, where |q>0|, means that |p->value| is a |mp_internal|
to be restored to internal parameter number~|q|. Such entries
are generated by \&{interim} commands.
\smallskip\noindent
The global variable |save_ptr| points to the top item on the save stack.
@=
typedef struct mp_save_data {
halfword info;
mp_sym sym;
quarterword type;
mp_internal value;
halfword equiv;
halfword eq_type;
mp_node equiv_n;
struct mp_save_data *link;
} mp_save_data;
@ @=
mp_save_data *save_ptr; /* the most recently saved item */
@ @=
mp->save_ptr = NULL;
@ Saving a boundary item
@c
static void mp_save_boundary (MP mp) {
mp_save_data *p; /* temporary register */
FUNCTION_TRACE1 ("mp_save_boundary ()\n");
p = xmalloc (1, sizeof (mp_save_data));
p->info = 0;
p->link = mp->save_ptr;
mp->save_ptr = p;
}
@ The |save_variable| routine is given a hash address |q|; it salts this
address in the save stack, together with its current equivalent,
then makes token~|q| behave as though it were brand new.
Nothing is stacked when |save_ptr=NULL|, however; there's no way to remove
things from the stack when the program is not inside a group, so there's
no point in wasting the space.
@c
static void mp_save_variable (MP mp, mp_sym q) {
mp_save_data *p; /* temporary register */
FUNCTION_TRACE2 ("mp_save_variable (%p)\n", q);
if (mp->save_ptr != NULL) {
p = xmalloc (1, sizeof (mp_save_data));
p->info = 1;
p->sym = q;
p->type = mp_normal_sym;
p->link = mp->save_ptr;
p->equiv = equiv (q);
p->eq_type = eq_type (q);
p->equiv_n = equiv_node (q);
mp->save_ptr = p;
}
mp_clear_symbol (mp, q, (mp->save_ptr != NULL));
}
@ Similarly, |save_internal| is given the location |q| of an internal
quantity like |mp_tracing_pens|. It creates a save stack entry of the
third kind.
@c
static void mp_save_internal (MP mp, halfword q) {
mp_save_data *p; /* new item for the save stack */
FUNCTION_TRACE2 ("mp_save_internal (%p)\n", q);
if (mp->save_ptr != NULL) {
p = xmalloc (1, sizeof (mp_save_data));
p->info = q;
p->type = mp_internal_sym;
p->link = mp->save_ptr;
p->value = mp->internal[q];
mp->save_ptr = p;
}
}
@ At the end of a group, the |unsave| routine restores all of the saved
equivalents in reverse order. This routine will be called only when there
is at least one boundary item on the save stack.
@c
static void mp_unsave (MP mp) {
mp_save_data *p; /* saved item */
FUNCTION_TRACE1 ("mp_unsave ()\n");
while (mp->save_ptr->info != 0) {
halfword q = mp->save_ptr->info;
if (mp->save_ptr->type == mp_internal_sym) {
if (internal_value (mp_tracing_restores) > 0) {
mp_begin_diagnostic (mp);
mp_print_nl (mp, "{restoring ");
mp_print (mp, internal_name (q));
mp_print_char (mp, xord ('='));
if (internal_type (q) == mp_known) {
mp_print_scaled (mp, mp->save_ptr->value.v.data.val);
} else if (internal_type (q) == mp_string_type) {
char *s = mp_str (mp, mp->save_ptr->value.v.data.str);
mp_print (mp, s);
} else {
mp_confusion (mp, "internal_restore");
}
mp_print_char (mp, xord ('}'));
mp_end_diagnostic (mp, false);
}
mp->internal[q] = mp->save_ptr->value;
} else {
mp_sym q = mp->save_ptr->sym;
if (internal_value (mp_tracing_restores) > 0) {
mp_begin_diagnostic (mp);
mp_print_nl (mp, "{restoring ");
mp_print_text (q);
mp_print_char (mp, xord ('}'));
mp_end_diagnostic (mp, false);
}
mp_clear_symbol (mp, q, false);
equiv (q) = mp->save_ptr->equiv;
eq_type (q) = mp->save_ptr->eq_type;
equiv_node (q) = mp->save_ptr->equiv_n;
if (eq_type (q) % outer_tag == tag_token) {
mp_node pp = equiv_node (q);
if (pp != NULL)
mp_name_type (pp) = mp_root;
}
}
p = mp->save_ptr->link;
xfree (mp->save_ptr);
mp->save_ptr = p;
}
p = mp->save_ptr->link;
xfree (mp->save_ptr);
mp->save_ptr = p;
}
@* Data structures for paths.
When a \MP\ user specifies a path, \MP\ will create a list of knots
and control points for the associated cubic spline curves. If the
knots are $z_0$, $z_1$, \dots, $z_n$, there are control points
$z_k^+$ and $z_{k+1}^-$ such that the cubic splines between knots
$z_k$ and $z_{k+1}$ are defined by B\'ezier's formula
@:Bezier}{B\'ezier, Pierre Etienne@>
$$\eqalign{z(t)&=B(z_k,z_k^+,z_{k+1}^-,z_{k+1};t)\cr
&=(1-t)^3z_k+3(1-t)^2tz_k^++3(1-t)t^2z_{k+1}^-+t^3z_{k+1}\cr}$$
for |0<=t<=1|.
There is a 8-word node for each knot $z_k$, containing one word of
control information and six words for the |x| and |y| coordinates of
$z_k^-$ and $z_k$ and~$z_k^+$. The control information appears in the
|mp_left_type| and |mp_right_type| fields, which each occupy a quarter of
the first word in the node; they specify properties of the curve as it
enters and leaves the knot. There's also a halfword |link| field,
which points to the following knot, and a final supplementary word (of
which only a quarter is used).
If the path is a closed contour, knots 0 and |n| are identical;
i.e., the |link| in knot |n-1| points to knot~0. But if the path
is not closed, the |mp_left_type| of knot~0 and the |mp_right_type| of knot~|n|
are equal to |endpoint|. In the latter case the |link| in knot~|n| points
to knot~0, and the control points $z_0^-$ and $z_n^+$ are not used.
@d mp_x_coord(A) (A)->x_coord /* the |x| coordinate of this knot */
@d mp_y_coord(A) (A)->y_coord /* the |y| coordinate of this knot */
@d mp_left_x(A) (A)->left_x /* the |x| coordinate of previous control point */
@d mp_left_y(A) (A)->left_y /* the |y| coordinate of previous control point */
@d mp_right_x(A) (A)->right_x /* the |x| coordinate of next control point */
@d mp_right_y(A) (A)->right_y /* the |y| coordinate of next control point */
@d mp_next_knot(A) (A)->next /* the next knot in this list */
@d mp_left_type(A) (A)->data.types.left_type /* characterizes the path entering this knot */
@d mp_right_type(A) (A)->data.types.right_type /* characterizes the path leaving this knot */
@d mp_prev_knot(A) (A)->data.prev /* the previous knot in this list (only for pens) */
@d mp_knot_info(A) (A)->data.info /* temporary info, used during splitting */
@=
typedef struct mp_knot_data *mp_knot;
typedef struct mp_knot_data {
scaled x_coord;
scaled y_coord;
scaled left_x;
scaled left_y;
scaled right_x;
scaled right_y;
mp_knot next;
union {
struct {
unsigned short left_type;
unsigned short right_type;
} types;
mp_knot prev;
signed int info;
} data;
unsigned char originator;
} mp_knot_data;
@ @(mplib.h@>=
enum mp_knot_type {
mp_endpoint = 0, /* |mp_left_type| at path beginning and |mp_right_type| at path end */
mp_explicit, /* |mp_left_type| or |mp_right_type| when control points are known */
mp_given, /* |mp_left_type| or |mp_right_type| when a direction is given */
mp_curl, /* |mp_left_type| or |mp_right_type| when a curl is desired */
mp_open, /* |mp_left_type| or |mp_right_type| when \MP\ should choose the direction */
mp_end_cycle
};
@ Before the B\'ezier control points have been calculated, the memory
space they will ultimately occupy is taken up by information that can be
used to compute them. There are four cases:
\yskip
\textindent{$\bullet$} If |mp_right_type=mp_open|, the curve should leave
the knot in the same direction it entered; \MP\ will figure out a
suitable direction.
\yskip
\textindent{$\bullet$} If |mp_right_type=mp_curl|, the curve should leave the
knot in a direction depending on the angle at which it enters the next
knot and on the curl parameter stored in |right_curl|.
\yskip
\textindent{$\bullet$} If |mp_right_type=mp_given|, the curve should leave the
knot in a nonzero direction stored as an |angle| in |right_given|.
\yskip
\textindent{$\bullet$} If |mp_right_type=mp_explicit|, the B\'ezier control
point for leaving this knot has already been computed; it is in the
|mp_right_x| and |mp_right_y| fields.
\yskip\noindent
The rules for |mp_left_type| are similar, but they refer to the curve entering
the knot, and to \\{left} fields instead of \\{right} fields.
Non-|explicit| control points will be chosen based on ``tension'' parameters
in the |left_tension| and |right_tension| fields. The
`\&{atleast}' option is represented by negative tension values.
@:at_least_}{\&{atleast} primitive@>
For example, the \MP\ path specification
$$\.{z0..z1..tension atleast 1..\{curl 2\}z2..z3\{-1,-2\}..tension
3 and 4..p},$$
where \.p is the path `\.{z4..controls z45 and z54..z5}', will be represented
by the six knots
\def\lodash{\hbox to 1.1em{\thinspace\hrulefill\thinspace}}
$$\vbox{\halign{#\hfil&&\qquad#\hfil\cr
|mp_left_type|&\\{left} info&|mp_x_coord,mp_y_coord|&|mp_right_type|&\\{right} info\cr
\noalign{\yskip}
|endpoint|&\lodash$,\,$\lodash&$x_0,y_0$&|curl|&$1.0,1.0$\cr
|open|&\lodash$,1.0$&$x_1,y_1$&|open|&\lodash$,-1.0$\cr
|curl|&$2.0,-1.0$&$x_2,y_2$&|curl|&$2.0,1.0$\cr
|given|&$d,1.0$&$x_3,y_3$&|given|&$d,3.0$\cr
|open|&\lodash$,4.0$&$x_4,y_4$&|explicit|&$x_{45},y_{45}$\cr
|explicit|&$x_{54},y_{54}$&$x_5,y_5$&|endpoint|&\lodash$,\,$\lodash\cr}}$$
Here |d| is the |angle| obtained by calling |n_arg(-unity,-two)|.
Of course, this example is more complicated than anything a normal user
would ever write.
These types must satisfy certain restrictions because of the form of \MP's
path syntax:
(i)~|open| type never appears in the same node together with |endpoint|,
|given|, or |curl|.
(ii)~The |mp_right_type| of a node is |explicit| if and only if the
|mp_left_type| of the following node is |explicit|.
(iii)~|endpoint| types occur only at the ends, as mentioned above.
@d left_curl mp_left_x /* curl information when entering this knot */
@d left_given mp_left_x /* given direction when entering this knot */
@d left_tension mp_left_y /* tension information when entering this knot */
@d right_curl mp_right_x /* curl information when leaving this knot */
@d right_given mp_right_x /* given direction when leaving this knot */
@d right_tension mp_right_y /* tension information when leaving this knot */
@ Knots can be user-supplied, or they can be created by program code,
like the |split_cubic| function, or |copy_path|. The distinction is
needed for the cleanup routine that runs after |split_cubic|, because
it should only delete knots it has previously inserted, and never
anything that was user-supplied. In order to be able to differentiate
one knot from another, we will set |originator(p):=mp_metapost_user| when
it appeared in the actual metapost program, and
|originator(p):=mp_program_code| in all other cases.
@d mp_originator(A) (A)->originator /* the creator of this knot */
@=
enum mp_knot_originator {
mp_program_code = 0, /* not created by a user */
mp_metapost_user /* created by a user */
};
@ Here is a routine that prints a given knot list
in symbolic form. It illustrates the conventions discussed above,
and checks for anomalies that might arise while \MP\ is being debugged.
@=
static void mp_pr_path (MP mp, mp_knot h);
@ @c
void mp_pr_path (MP mp, mp_knot h) {
mp_knot p, q; /* for list traversal */
p = h;
do {
q = mp_next_knot (p);
if ((p == NULL) || (q == NULL)) {
mp_print_nl (mp, "???");
return; /* this won't happen */
@.???@>
}
@;
DONE1:
p = q;
if ((p != h) || (mp_left_type (h) != mp_endpoint)) {
@;
}
} while (p != h);
if (mp_left_type (h) != mp_endpoint)
mp_print (mp, "cycle");
}
@ @=
mp_print_two (mp, mp_x_coord (p), mp_y_coord (p));
switch (mp_right_type (p)) {
case mp_endpoint:
if (mp_left_type (p) == mp_open)
mp_print (mp, "{open?}"); /* can't happen */
@.open?@>;
if ((mp_left_type (q) != mp_endpoint) || (q != h))
q = NULL; /* force an error */
goto DONE1;
break;
case mp_explicit:
@;
break;
case mp_open:
@;
break;
case mp_curl:
case mp_given:
@;
break;
default:
mp_print (mp, "???"); /* can't happen */
@.???@>;
break;
}
if (mp_left_type (q) <= mp_explicit) {
mp_print (mp, "..control?"); /* can't happen */
@.control?@>
} else if ((right_tension (p) != unity) || (left_tension (q) != unity)) {
@;
}
@ Since |n_sin_cos| produces |fraction| results, which we will print as if they
were |scaled|, the magnitude of a |given| direction vector will be~4096.
@