1 /*
2 **********************************************************************
3 * *
4 * ML/I macro processor -- C version *
5 * *
6 * Module 1 - Machine independent initialisation and finalisation *
7 * *
8 * Copyright (C) R.D. Eager MMXVIII *
9 * P.J. Brown University of Kent MCMLXVII *
10 * *
11 **********************************************************************
12 */
13
14
15 #include "ml1.h"
16
17
18 /*** Copyright notices ***/
19
20 #if FBSD32 | FBSD64
21 #pragma clang diagnostic push
22 #pragma clang diagnostic ignored "-Wunused-const-variable"
23 #endif
24 static CONST char copyr1[] = "Copyright (C) R.D. Eager MMXVIII\n";
25 static CONST char copyr2[] = "Copyright (C) P.J. Brown MCMLXVII\n";
26 #if FBSD32 | FBSD64
27 #pragma clang diagnostic pop
28 #endif
29
30
31 /*** Global variables ***/
32
33
34 /*** Blocks of variables whose relative positions must not be changed ***/
35
36 struct sdbf sdb; /* Scanning description block */
37 struct opdbf opdb; /* Operation macro description block */
38 struct oabf oab; /* OPT-ALL block */
39
40
41 /*** Variables requiring dynamic initialisation ***/
42
43 INT *endpt; /* Points at end of backwards stack */
44 INT glbwsw; /* Global warning switch */
45 INT *lfpt; /* Points at last used location on backwards stack */
46 INT *pvarpt; /* Points at permanent variables */
47 INT pvnum; /* Number of permanent variables */
48 #if CVARS
49 INT *cvarpt; /* Points at character string variables */
50 INT cvnum; /* Number of character string variables */
51 INT cvsize; /* Size of each character string variable */
52 INT exprsw; /* Returns expression type from 'gmeadd' */
53 #endif
54
55
56 /*** Miscellaneous variables ***/
57
58 INT beslin; /* Best-so-far value of 'sdb.linect' */
59 INT *bespt; /* Best-so-far value of 'sdb.spt' */
60 INT bestpl; /* Switch value used in basic scan routine */
61 INT *bfndpt; /* Best-so-far value of 'fndpt' */
62 INT bindic; /* Best-so-far value of 'indic' */
63 INT *binfpt; /* Best-so-far value of 'infopt' */
64 INT caltyp; /* First number in information block */
65 INT *chanpt; /* Used in chaining */
66 INT chlink; /* Used in chaining */
67 INT *cllfpt; /* Points at top entry after scanning information is stacked */
68 INT copdsw; /* For skips; reflects setting of delimiter option */
69 INT coptsw; /* For skips; reflects setting of text option */
70 INT *delpt; /* Head of chain of delimiters searching for */
71 INT *eriapt; /* Points at value of operation macro argument */
72 INT *ffpt; /* Points to first free location on forwards stack */
73 INT *htabpt; /* Points at current hash table */
74 INT idlen; /* Length of current identifier */
75 INT *idpt; /* Points at current identifier */
76 INT indic; /* Contents of nextlink */
77 INT *infopt; /* Points beyond currently matched LID */
78 INT invoct; /* Count of macro calls */
79 INT *knpt; /* Points to node marker entry in delimiter chain */
80 INT levl; /* Level of macros and inserts */
81 INT masksw; /* Used to indicate which types of construction are recognised */
82 INT meval; /* Miscellaneous; used for numerical values calculated at macro time */
83 INT *nargpt; /* Points at argument vector + 1 */
84 INT nestlv; /* Nesting level of calls and skips during scanning */
85 INT offset; /* Offset in hash table */
86 INT oplev; /* Level of operation macros and inserts */
87 INT skiplv; /* Level of skip nesting */
88 INT *stffpt; /* Points at start of global macros */
89 INT *svarpt; /* Points at system variables */
90 INT *tempt; /* Temporary */
91 INT tlinct; /* Temporary storage for 'sdb.linect' */
92
93
94 /*** Variables used in processing structure representations ***/
95
96 INT consw; /* For syntax checking ('evtree' and 'getdel') */
97 INT delct; /* Count of delimiters */
98 INT exitsw; /* For syntax checking ('evtree') */
99 INT keysw; /* For syntax checking ('evtree' and 'getdel') */
100 INT *lnodpt; /* Points at topmost node entry on backwards stack */
101 INT *ndefpt; /* Destination of newly defined construction */
102 INT *nnodpt; /* Points at current node entry on backwards stack */
103 INT *nodept; /* Head of chain of links to be attached to next delimiter */
104 INT nodesw; /* For syntax checking ('evtree' and 'getdel') */
105 INT *ollfpt; /* Previous value of 'lfpt' */
106 INT optlev; /* Level of OPT-ALL brackets */
107
108
109 /*** Variables used in processing macro expressions or inserts ***/
110
111 INT *varpt; /* Points at vector of variables */
112
113
114 /*** Names of table items - dynamically initialised ***/
115
116 INT *das; /* Head of AS/SSAS chain for MC-DEF */
117 INT *delchn; /* Chain of secondary delimiters */
118 INT *dge; /* Head of relation chain for MC-GO */
119 INT *dif; /* Head of IF/UNLESS chain for MC-GO */
120 INT *ghshtb[LHV+5]; /* Global hash table */
121 INT *keychn; /* Head of keyword chain */
122 INT *knrep; /* Points at current node marker */
123 INT *kspacs; /* Points at SPACES keyword */
124 INT *laychn; /* Chain of names of layout characters */
125 INT *spcsrp; /* Points at representation of SPACE */
126
127
128 /*** More miscellaneous variables ***/
129
130 INT *at_edb; /* \ */
131 INT *at_sdb; /* |__ Addresses of blocks of scanning data */
132 INT *at_opdb; /* | */
133 INT *at_all; /* / */
134 INT *at_s1; /* \ */
135 INT *at_s2; /* |__ Addresses of S-variables; for efficient access */
136 INT *at_s5; /* | */
137 #if SPECAN
138 INT *at_s6; /* / */
139 #endif
140 INT *convarea; /* Pointer to number conversion area for 'mdconv' */
141 INT nlsw; /* TRUE if last character read was a newline, otherwise FALSE */
142
143
144 /*** Machine-dependent variables ***/
145
146 INT *at_s10; /* \ */
147 INT *at_s12; /* | */
148 INT *at_s16; /* | */
149 INT *at_s17; /* | */
150 INT *at_s19; /* |-- Addresses of S-variables; for efficient access */
151 INT *at_s20; /* | */
152 INT *at_s21; /* | */
153 INT *at_s22; /* | */
154 INT *at_s23; /* | */
155 INT *at_s24; /* */
156
157 /*** Save areas for 'setjmp' calls ***/
158
159 jmp_buf bssave; /* Transfers control to 'bsnext' */
160 jmp_buf bstsave; /* Transfers control to 'bstrex' */
161 jmp_buf entsave; /* Transfers control to 'entext' */
162 jmp_buf evpsave; /* Transfers control to 'evopt' */
163 jmp_buf evrsave; /* Transfers control to 'evor' */
164 jmp_buf evxsave; /* Transfers control to 'evexit' */
165
166
167 /*** Local variables ***/
168
169 static jmp_buf exsave; /* Transfers control to 'miexit' */
170 static INT svec[SVARNUM+1]; /* System variables (stored in reverse) */
171 static INT result; /* Number of processing errors */
172
173
174 #if ANSI
milogic(INT * workspace,INT size)175 INT milogic(INT *workspace,INT size)
176 #else
177 INT milogic(workspace,size)
178 INT *workspace;
179 INT size;
180 #endif
181 /* Machine-independent initialisation code. */
182 { INT i;
183
184 #if IBMC
185 #pragma checkout(suspend)
186 #endif
187 sdb.hashpt = (INT *) &ghshtb[0];
188 #if IBMC
189 #pragma checkout(resume)
190 #endif
191
192 /* Set up system variables, initialising to zero */
193
194 svarpt = &svec[SVARNUM]; /* S-variables are stored backwards */
195 svec[SVARNUM] = SVARNUM;
196 for(i = 0; i < SVARNUM; i++) svec[i] = 0;
197 at_s1 = svarpt - 1; /* Address of S1 - for efficiency */
198 at_s2 = svarpt - 2; /* Address of S2 - for efficiency */
199 at_s5 = svarpt - 5; /* Address of S5 - for efficiency */
200 #if SPECAN
201 at_s6 = svarpt - 6; /* Address of S6 - for efficiency */
202 #endif
203
204 /* Initialise any non-zero system variables */
205
206 #if SPECAN
207 *at_s6 = -1; /* Character code that will never match */
208 #endif
209
210 /* Set up pointers to blocks of variables which will need to be
211 moved around */
212
213 #if IBMC
214 #pragma checkout(suspend)
215 #endif
216 at_sdb = (INT *) &sdb;
217 at_opdb = (INT *) &opdb;
218 at_all = (INT *) &oab;
219 at_edb = (INT *) &sdb.stakpt;
220 #if IBMC
221 #pragma checkout(resume)
222 #endif
223
224 /* Set up pointers to main workspace */
225
226 stffpt = ffpt = workspace;
227 endpt = lfpt = workspace + size;
228
229 #if DEBUGGING
230 { INT *p = ffpt;
231
232 while(p < endpt) *p++ = (INT) 0;
233 }
234 #endif
235
236 /* Allocate number conversion area */
237
238 { INT n = MAXINT;
239 INT nsize = 1; /* Allow for minus sign */
240
241 while(n > 0) {
242 n = n/10;
243 nsize++;
244 }
245 bumpff(nsize); /* Take space from forwards stack */
246 convarea = ffpt - 1; /* Global pointer to end of conversion area */
247 }
248
249 /* Reserve and zeroise permanent variables */
250
251 for(i = 0; i < PVARNUM; i++) ffpt[i] = 0;
252 bumpff((INT) (PVARNUM+1));
253 pvarpt = ffpt - 1;
254 *pvarpt = pvnum = PVARNUM;
255
256 #if CVARS
257
258 /* Set up initial pointer to character string variable area */
259
260 bumpff((INT) 1);
261 cvarpt = ffpt - 1;
262 cvnum = 0;
263 *cvarpt = cvnum; /* None to start with (size not known yet) */
264 cvsize = 0; /* Until we know */
265 #endif
266
267 glbwsw = 7;
268
269 sdb.argpt = sdb.tvarpt = sdb.stoppt = sdb.labpt = sdb.stakpt = NULLPT;
270
271 sdb.skval = levl = invoct = skiplv = nestlv = oplev = tlinct = 0;
272 bindic = ENDCHN;
273 sdb.linect = 1;
274 sdb.dbugsw = DB_SOURCE;
275 nlsw = TRUE;
276
277 init_tables(); /* Initialise global hash table, and delimiter chains */
278
279 mdinit(); /* Machine dependent initialisation */
280
281 /* Set up initial hash table */
282
283 declf((INT) 1); /* Stack null pointer to 'next' hash table */
284 *lfpt = (INT) NULLPT;
285 #if IBMC
286 #pragma checkout(suspend)
287 #endif
288 sdb.hashpt = (INT *) &ghshtb[0];
289 #if IBMC
290 #pragma checkout(resume)
291 #endif
292 stkhsh();
293
294 /* Set initial limits on local constructions */
295
296 for(i = 0; i <= 3; i++) sdb.hashpt[LHV + i] = (INT) endpt;
297 sdb.hashpt[LHV + 4] = 7;
298
299 knpt = knrep;
300 sdb.spt = ffpt - 1;
301 sdb.inffpt = ffpt;
302
303 /* Set up exit closure */
304
305 if(setjmp(exsave) != 0) goto miexit;
306
307 /* Start scanning */
308
309 basic_scan();
310
311 miexit:
312
313 return(result);
314 }
315
316
mihalt()317 VOID mihalt()
318 /* Machine-independent finalisation code. Calls the machine-dependent
319 finalisation code, prints statistics, and returns to the
320 machine-dependent logic. 'result' is set to the number of ML/I
321 processing errors. */
322 { INT lines;
323
324 mdfinal();
325
326 if((svarpt[-18] & 2) != 0) {
327 lines = *at_s2;
328 #if ATT3B | BSD4 | FBSD32 | IBMC | MSC | VMS | WIN | ZTC | ZTCX
329 mderpr("\nAt end of process: %d line%s, %d call%s\n",lines,lines == 1 ? "": "s",invoct,invoct == 1 ? "": "s");
330 #endif
331 #if FBSD64 | L1
332 mderpr("\nAt end of process: %ld line%s, %ld call%s\n",lines,lines == 1 ? "": "s",invoct,invoct == 1 ? "": "s");
333 #endif
334 }
335
336 result = *at_s5;
337 longjmp(exsave,1);
338 }
339
340 /*
341 ***********************
342 * *
343 * End of module 1 *
344 * *
345 ***********************
346 */
347
348