1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
2:
3: /*
4: $Header: b.h,v 1.4 85/08/22 16:41:03 timo Exp $
5: */
6:
7: /* b.h: general */
8:
9: #define MESS(nr, text) nr
10:
11: #include <stdio.h>
12: #include <math.h>
13:
14: #define Forward
15: #define Visible
16: #define Hidden static
17: #define Procedure
18:
19: #define EQ ==
20: #define NE !=
21:
22: /* The following are not intended as pseudo-encapsulation, */
23: /* but to emphasize intention. */
24:
25: typedef char literal;
26: typedef char bool;
27: typedef char *txptr;
28: typedef char *string; /* Strings are always terminated with a char '\0'. */
29:
30: #define Yes ((bool) 1)
31: #define No ((bool) 0)
32: typedef short intlet;
33: extern bool bugs, testing;
34:
35: /************************************************************************/
36: /* */
37: /* Values */
38: /* */
39: /* There are different modules for values, however all agree that */
40: /* the first field of a value is its type, and the second its reference */
41: /* count. All other fields depend on the module. */
42: /* */
43: /************************************************************************/
44:
45: /*
46: * "SMALL INTEGERS":
47: *
48: * When a "value" pointer has its low bit set, it is not a pointer.
49: * By casting to int and shifting one bit to the right, it is converted
50: * to its "int" value. This can save a lot of heap space used for
51: * small integers.
52: * Sorry, you have to change this on machines with word rather than byte
53: * addressing (maybe you can use the sign bit as tag).
54: */
55:
56: #define IsSmallInt(v) (((int)(v)) & 1)
57: #define SmallIntVal(v) (((int)(v) & ~1) / 2)
58: #define MkSmallInt(i) ((value)((i)*2 | 1))
59: /* (Can't use << and >> because their effect on negative numbers
60: is not defined.) */
61:
62: #ifdef IBMPC
63: #define literal type, refcnt; intlet len
64: #else
65: #define HEADER literal type; intlet refcnt, len
66: #endif
67:
68: typedef struct value {HEADER; string *cts;} *value;
69: typedef value parsetree;
70:
71:
72: #define Dummy NULL
73: #define Dumval ((value) Dummy)
74: #define Vnil ((value) NULL)
75: #define Pnil ((value *) NULL)
76: #define NilTree ((parsetree) NULL)
77:
78: /* Types: */
79: #define Num '0'
80: #define Tex '"'
81: #define Com ','
82: #define Lis 'L'
83: #define Tab 'M'
84: #define ELT '}'
85: /* parsetree node */
86: #define Ptn 'T'
87: /* locations: */
88: #define Sim 'S'
89: #define Tri '@'
90: #define Tse '['
91: #define Per 'p'
92: /* units: */
93: #define How 'h'
94: #define For 'f'
95: #define Ref 'r'
96: #define Fun '+'
97: #define Prd 'i'
98:
99: /* targets */
100: #define Tar 't'
101:
102: #ifdef INTEGRATION
103: #define Nod 'N'
104: #define Pat 'P'
105: #endif INTEGRATION
106:
107: #define Type(v) (IsSmallInt(v) ? Num : (v)->type)
108: #define Length(v) ((v)->len)
109: #define Refcnt(v) ((v)->refcnt)
110: #define Unique(v) ((v)->refcnt==1)
111:
112: #define Overall for (k= 0; k < len; k++)
113:
114: #define k_Over_len for (k= 0; k < len; k++)
115: #define Last(k) (k == len-1)
116:
117: #define Ats(v) ((value *)&((v)->cts))
118: #define Str(v) ((string)&((v)->cts)) /* only for use in part1 */
119:
120: /* Environments and context */
121:
122: typedef value envtab;
123: typedef struct ec{envtab tab; struct ec *inv_env;} envchain;
124: typedef envchain *env;
125:
126: typedef struct {
127: value uname;
128: env curnv;
129: value r_names, *bndtgs;
130: literal cntxt, resexp;
131: parsetree cur_line;
132: value cur_lino;
133: } context;
134:
135: #define Enil ((env) NULL)
136:
137: /* contexts: */
138: #define In_command 'c'
139: #define In_read '?'
140: #define In_unit 'u'
141: #define In_edval 'e'
142: #define In_tarval 't'
143: #define In_formal 'f'
144: #define In_prmnv 'p'
145:
146: /* results */
147: #define Ret 'V'
148: #define Rep '+'
149: #define Voi ' '
150:
151: /* adicity */
152: #define Zer '0'
153: #define Mon '1'
154: #define Dya '2'
155:
156: /************************************************************************/
157: /* */
158: /* A function or predicate is modelled as a compound consisting of */
159: /* (i) Zer/Mon/Dya for zero-, mon- or dyadicity; */
160: /* (ii) If a predefined function, an identifying number, otherwise -1 */
161: /* (iii) If a user-defined function/predicate, its parse-tree */
162: /* */
163: /************************************************************************/
164:
165: typedef struct{parsetree unit; bool unparsed, filed; parsetree code;} how;
166: typedef struct{parsetree unit; bool unparsed, filed; parsetree code;
167: literal adic; intlet pre;} funprd;
168: /* The first four fields of hows and funprds must be the same. */
169: #define Use (-1) /* funprd.pre==Use for user-defined funprds */
170:
171: typedef struct{context con; parsetree fp;} formal;
172: typedef struct{parsetree rp;} ref;
173: typedef struct{parsetree val;} per;
174:
175: /************************************************************************/
176: /* */
177: /* Locations */
178: /* */
179: /* A simple location is modelled as a pair basic-identifier and */
180: /* environment, where a basic-identifier is modelled as a text */
181: /* and an environment as a pointer to a pair (T, E), where T is a */
182: /* table with basic-identifiers as keys and content values as */
183: /* associates, and E is the invoking environment or nil. */
184: /* */
185: /* A trimmed-text location is modelled as a triple (R, B, C). */
186: /* */
187: /* A compound location is modelled as a compound whose fields are */
188: /* locations, rather than values. */
189: /* */
190: /* A table-selection location is modelled as a pair (R, K). */
191: /* */
192: /************************************************************************/
193:
194: typedef value loc;
195: #define Lnil ((loc) NULL)
196:
197: typedef value basidf;
198: typedef struct{basidf i; env e;} simploc;
199: typedef struct{loc R; value B, C;} trimloc;
200: typedef struct{loc R; value K;} tbseloc;
201:
202: /* Functions and Predicates */
203: typedef value fun;
204: typedef value prd;
205:
206: char *malloc(), *realloc();
207: char *getenv();