Annotation of freem/src/frmgbl.c, revision 1.3
1.1 snw 1: /*
2: * *
3: * * *
4: * * *
5: * ***************
6: * * * * *
7: * * MUMPS *
8: * * * * *
9: * ***************
10: * * *
11: * * *
12: * *
13: *
14: * frmgbl.c
15: * freem global C variables
16: *
17: *
18: * Author: Serena Willis <jpw@coherent-logic.com>
19: * Copyright (C) 1998 MUG Deutschland
20: * Copyright (C) 2020 Coherent Logic Development LLC
21: *
22: *
23: * This file is part of FreeM.
24: *
25: * FreeM is free software: you can redistribute it and/or modify
26: * it under the terms of the GNU Affero Public License as published by
27: * the Free Software Foundation, either version 3 of the License, or
28: * (at your option) any later version.
29: *
30: * FreeM is distributed in the hope that it will be useful,
31: * but WITHOUT ANY WARRANTY; without even the implied warranty of
32: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
33: * GNU Affero Public License for more details.
34: *
35: * You should have received a copy of the GNU Affero Public License
36: * along with FreeM. If not, see <https://www.gnu.org/licenses/>.
37: *
38: **/
39:
40: /* needed if byte data are to be interpreted as unsigned integer */
41: #include <stdlib.h>
42: #include <setjmp.h>
43: #include <signal.h>
44: #include <stdio.h>
45: #include "mpsdef0.h"
46: #include <fcntl.h>
47: #include <unistd.h>
48: #include <string.h>
49: #include <sys/types.h>
50: #include <sys/wait.h>
51: #include "transact.h"
52: #include "locktab.h"
53: #include <errno.h>
54:
55: #ifdef LIBFREEM
56: # include "errmsg.h"
57: #endif
58:
59: #define UNSIGN(A) ((A)&0377)
60:
61: #define g_EOL 30
62: #define POINT 28
63: #define MINUS 26
64:
65: #define ROOT 0L
66: /* length of blocks. status bytes defined as offset to blocklength */
67: #define DATALIM (BLOCKLEN-11)
68: #define LLPTR (BLOCKLEN-10)
69: #define NRBLK LLPTR
70: #define RLPTR (BLOCKLEN- 6)
71: #define FREE RLPTR
72: #define BTYP (BLOCKLEN- 3)
73: #define OFFS (BLOCKLEN- 2)
74:
75: #define EMPTY 0
76: #define FBLK 1
77: #define POINTER 2
78: #define BOTTOM 6
79: #define DATA 8
80:
81: #define PROTECT 30
82:
83:
84: #ifndef SYSFIVE
85: #define FreeM_timezone -3600
86: #else
87:
88: #ifdef __CYGWIN__
89: #define FreeM_timezone _timezone
90: #else
91: long FreeM_timezone;
92: #endif /* __CYGWIN__ */
93:
94: #endif /* SYSFIVE */
95:
96: #if defined(__CYGWIN__)
97: # define FreeM_timezone _timezone
98: #endif
99:
100: /* mumps commands */
101: #define BREAK 'b'
102: #define CLOSE 'c'
103: #define DO 'd'
104: #define DO_BLOCK 2
105: #define ELSE 'e'
106: #define FOR 'f'
107: #define GOTO 'g'
108: #define HA 'h'
109: #define HALT '0'
110: #define HANG '1'
111: #define IF 'i'
112: #define JOB 'j'
113: #define KILL 'k'
114: #define LOCK 'l'
115: #define NEW 'n'
116: #define OPEN 'o'
117: #define QUIT 'q'
118: #define READ 'r'
119: #define SET 's'
120: #define USE 'u'
121: #define VIEW 'v'
122: #define WRITE 'w'
123: #define XECUTE 'x'
124:
125: #define ZALLOCATE 'A'
126: #define ZBREAK 'B'
127: #define ZDEALLOCATE 'D'
128: #define ZGO 'G'
129: #define ZHALT 'H'
130: #define ZINSERT 'I'
131: #define ZJOB 'J'
132: #define ZLOAD 'L'
133: #define ZNEW 'N'
134: #define ZPRINT 'P'
135: #define ZQUIT 'Q'
136: #define ZREMOVE 'R'
137: #define ZSAVE 'S'
138: #define ZTRAP 'T'
139: #define ZWRITE 'W'
140: #define PRIVATE SP
141:
142: #if defined(HAVE_MWAPI_MOTIF)
143: # include <Xm/Xm.h>
144: XtAppContext mwapi_context;
145: #endif
146:
147: short run_daemon = FALSE;
148: short nofork = FALSE;
149: char *pid_file_path;
150: int pid_fd;
151:
152: /* USING and WITH */
153: char i_using[STRLEN] = {'\201'};
154: char i_with[STRLEN] = {'\201'};
155:
156: /* common definitions for all mumps modules */
157: /* same as external definition in include_file mpsdef */
158:
159: extern int errno; /* external error code for systemcalls */
160:
161: int m_argc; /* arguments count */
162: char **m_argv; /* arguments string */
163: char **m_envp; /* environment pointer */
164:
165: short frm_throw_all_errors = 1;
166:
167: /* glvn size parameters */
168: union four_fl {
169: long unsigned all;
170: char one[4];
171: } glvnflag; /* [0] unique name chars 0=no limit */
172:
173: /* [1] case sensitivity flag 0=sensitive */
174: /* [2] max. name+subscripts 0=no limit */
175: /* [3] max. length of a subscript 0=no limit */
176: int libflag = FALSE; /* running as library? */
177: int lonelyflag = FALSE; /* single user flag */
178: int lowerflag = TRUE; /* lowercase everywhere flag */
179: int killerflag = TRUE; /* SIGTERM handling flag */
180: int huperflag = TRUE; /* SIGHUP handling flag */
181: int s_fun_flag = TRUE; /* VIEW 70: ZSORT/ZSYNTAX flag */
182: int n_fun_flag = TRUE; /* VIEW 71: ZNEXT/ZNAME flag */
183: int p_fun_flag = TRUE; /* VIEW 72: ZPREVIOUS/ZPIECE flag */
184: int d_fun_flag = TRUE; /* VIEW 73: ZDATA/ZDATE flag */
185: int zjobflag = TRUE; /* VIEW 79: old ZJOB vs. new ZJOB flag */
186: int eightbit = TRUE; /* VIEW 80: 7 vs. 8 bit flag */
187: int PF1flag = FALSE; /* VIEW 81: PF1 flag */
188: int ordercounter = 0; /* VIEW 82: order counter */
189: int etxtflag = FALSE; /* VIEW 83: text in $ZE flag */
190: char lvndefault[256] = "\201"; /* VIEW 89: UNDEF lvn default */
191: char gvndefault[256] = "\201"; /* VIEW 90: UNDEF gvn default */
192: char exfdefault[256] = "\201"; /* VIEW 91: missing QUIT expr default */
193: int typemmflag = FALSE; /* VIEW 92: EUR2DEM: type mismatch error */
194: int namespace = 0; /* VIEW 200: namespace index */
195: int config = 0; /* VIEW 201: configuration index */
196: char WHR[12][4] = { /* names of currencies */
197: "\201",
198: "EUR\201",
199: "ATS\201",
200: "BFR\201",
201: "DEM\201",
202: "ESP\201",
203: "FMK\201",
204: "FRF\201",
205: "IEP\201",
206: "ITL\201",
207: "NLG\201",
208: "PTE\201"
209: };
210:
211: char EUR2WHR[12][9] = { /* conversion factors EUR to ... */
212: "\201", /* dont care */
213: "1\201", /* to EUR */
214: "13.7603\201", /* to ATS */
215: "40.3399\201", /* to BFR */
216: "1.95583\201", /* to DEM (DM) */
217: "166.386\201", /* to ESP */
218: "5.94573\201", /* to FMK */
219: "6.55957\201", /* to FRF (FF) */
220: ".787564\201", /* to IEP */
221: "1936.27\201", /* to ITL */
222: "2.20371\201", /* to NLG */
223: "200.482\201" /* to PTE */
224: };
225:
226: long v93 = 1; /* VIEW 93: ASCII rule default */
227: char v93a[NO_V93][2560] = {
228: /* ASCII */
229: " :, :!,A:a,B:b,C:c,D:d,E:e,F:f,G:g,H:h,I:i,J:j,K:k,L:l,M:m,N:n,O:o,P:p,Q:q,R:r,S:s,T:t,U:u,V:v,W:w,X:x,Y:y,Z:z\201",
230: /* B - BELGIAN */
231: " :, :!,@:a,\\:c,{:e,}:e,\
232: A:a,B:b,C:c,D:d,E:e,F:f,G:g,H:h,I:i,J:j,K:k,L:l,M:m,N:n,O:o,P:p,Q:q,R:r,S:s,T:t,U:u,V:v,W:w,X:x,Y:y,Z:z\201,\200:e",
233: /* D - GERMAN */
234: " \001\002 \001\002!\001\002\042\001\002#\001\002$\001\002%\001\002&\001\002\
235: '\001\002(\001\002)\001\002*\001\002+\001\002,\001\002-\001\002.\001\002\
236: /\001\002:\001\002;\001\002<\001\002=\001\002>\001\002?\001\002@\001\002\
237: ^\001\002_\001\002`\001\002A\001a\002B\001b\002C\001c\002D\001d\002E\001e\002\
238: F\001f\002G\001g\002H\001h\002I\001i\002J\001j\002K\001k\002L\001l\002\
239: M\001m\002N\001n\002O\001o\002P\001p\002Q\001q\002R\001r\002S\001s\002\
240: T\001t\002U\001u\002V\001v\002W\001w\002X\001x\002Y\001y\002Z\001z\002\
241: {\001ae\002[\001ae\002|\001oe\002\134\001oe\002}\001ue\002]\001ue\002\
242: ~\001ss\002\200\001e\002\201",
243: /* DK - DANISH */
244: " :, :!,{:ae,|:oe,}:au,~:ue,\
245: A:a,B:b,C:c,D:d,E:e,F:f,G:g,H:h,I:i,J:j,K:k,L:l,M:m,N:n,O:o,P:p,Q:q,R:r,S:s,T:t,U:u,V:v,W:w,X:x,Y:y,Z:z,\
246: [:ae,\\:oe,]:ao,^:ue,\200:e\201",
247: /* E - SPANISH */
248: " :, :!,|:n,}:c,ll:l,\
249: A:a,B:b,C:c,D:d,E:e,F:f,G:g,H:h,I:i,J:j,K:k,L:l,M:m,N:n,O:o,P:p,Q:q,R:r,S:s,T:t,U:u,V:v,W:w,X:x,Y:y,Z:z,\200:e,\
250: \\:n,LL:l\201",
251: /* F - FRENCH */
252: " :, :!,\\:c,{:e,|:u,}:e,\
253: A:a,B:b,C:c,D:d,E:e,F:f,G:g,H:h,I:i,J:j,K:k,L:l,M:m,N:n,O:o,P:p,Q:q,R:r,S:s,T:t,U:u,V:v,W:w,X:x,Y:y,Z:z,\200:e,\201",
254: /* I - ITALIAN */
255: " :, :!,\\:c,]:e,`:u,{:a,|:o,}:e,~:i,\
256: A:a,B:b,C:c,D:d,E:e,F:f,G:g,H:h,I:i,J:j,K:k,L:l,M:m,N:n,O:o,P:p,Q:q,R:r,S:s,T:t,U:u,V:v,W:w,X:x,Y:y,Z:z,\200:e,\201",
257: /* S - SWEDISH */
258: " :, :!,`:e,{:ae,|:oe,}:ao,~:ue,\
259: A:a,B:b,C:c,D:d,E:e,F:f,G:g,H:h,I:i,J:j,K:k,L:l,M:m,N:n,O:o,P:p,Q:q,R:r,S:s,T:t,U:u,V:v,W:w,X:x,Y:y,Z:z,\
260: @:e,[:ae,\\:oe,]:ao,~:ue,\200:e,\201"
261: };
262:
263:
264: char glo_prefix[MONTH_LEN] = "^\201"; /* VIEW 96: global prefix */
265: char glo_ext[MONTH_LEN] = "\201"; /* VIEW 97: global postfix */
266: char rou_ext[MONTH_LEN] = ".m\201"; /* VIEW 98: routine extention */
267: long tzoffset = 0L; /* VIEW 99: timer offset */
268: int v100 = 0; /* VIEW 100: return value of kill */
269: char l_o_val[256] = "\201"; /* VIEW 110: local $o/$q data value */
270: char g_o_val[256] = "\201"; /* VIEW 111: global $o/$q data value */
271: int zsavestrategy = TRUE; /* VIEW 133: remember ZLOAD directory on ZSAVE */
272:
273: /* vars for screen save/restore */
274: struct vtstyp *screen = NULL; /* active screen */
275: short jour_flag = 0; /* journal flag 0/1/-1 */
276:
277: /* trace vars for global module */
278: unsigned long traceblk[TRLIM]; /* trace stack - block numbers */
279: short traceadr[TRLIM]; /* - status */
280: short trx; /* - stack pointer */
281: char compactkey[256]; /* internal form of key in global.c */
282:
283: short mcmnd; /* mumps command letter */
284: short arg; /* stack pointer for expr.c */
285: char *argstck[PARDEPTH + 1]; /* stack of pointers to */
286:
287: /* intermediate results */
288:
289: long ordercnt = 0L; /* repeater for $order/$query */
290: short setpiece = FALSE; /* TRUE: set$piece executing */
291: short setop = 0; /* SET op flag */
292: char rou_name[256] =
293: {EOL}; /* $T(+0)/$ZN routine name */
294: char *namstck; /* routine name stack */
295: char *namptr; /* routine name stack pointer */
296: char *framstck; /* DO_frame stack */
297: char *dofrmptr; /* DO_frame stack pointer */
298: char zb[40] = "\201"; /* $ZB last ESC_sequence */
299: char zerror[300] = "\201"; /* $ZE last error */
300: short DSM2err = FALSE; /* enable normal error processing */
301: short nesterr = 0; /* nesterr and callerr contain info */
302: char callerr[NESTLEVLS + 1][40]; /* about call situation at error */
303:
304: char stack0[256] = "\201";
305:
306: char zmc[128] = "\
307: \000\001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\
308: \020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037\177\201";
309:
310: /* $ZMC loadable match 'controls' */
311: char zmn[128] = "0123456789\201"; /* $ZMN loadable match 'numerics' */
312:
313: /* $ZMP loadable match 'punctuation' */
314: char zmp[128] = " !\042#$%&'()*+,-./:;<=>?@^_`\201";
315:
316: /* $ZML loadable match 'lowercase' */
317: char zml[128] = "abcdefghijklmnopqrstuvwxyz{|}~\201";
318:
319: /* $ZMU loadable match 'uppercase' */
320: char zmu[128] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]\201";
321:
322: short zerr = OK; /* $ZE numeric error code */
323: char zloc[256] = "\201"; /* $ZL last local reference */
324: char zref[256] = "\201"; /* $ZR last global reference */
325: short nakoffs = 0; /* offset to naked reference */
326: char zfunkey[44][FUNLEN]; /* $ZF function key */
327:
328: typedef struct frm_devstat {
329: short mdc_err;
330: short frm_err;
331: char err_txt[80];
332: } frm_devstat;
333:
334: frm_devstat devstat[MAXDEV + 1]; /* channel statuses for $DEVICE */
335:
336: short xpos[MAXDEV + 1]; /* $X-vector */
337: short ypos[MAXDEV + 1]; /* $Y-vector */
338: short crlf[MAXDEV + 1]; /* CR/LF flag vector */
339: short fm_nodelay[MAXDEV + 1]; /* nodelay flag vector */
340:
341: int ESCflag[MAXDEV + 1] =
342: {0, 0, 0, 0, 0}; /* ESC flag */
343:
344: short RightMargin = 0; /* Output Margin. Default no */
345:
346: /* automatic CR/LF */
347: short InFieldLen = 255; /* Input Field length Def: 255 char */
348: long DSW = BIT2 + BIT21; /* Device Status word (Terminal) */
349: char LineTerm[32] = "\012\015\201"; /* Input Line Terminator chars */
350: char BrkKey = 3; /* <INTERRUPT> key Def: CTRL/C */
351: char ug_buf[MAXDEV + 1][256]; /* ungetc-buffers */
352: char devopen[MAXDEV + 1] =
353: {0, 0, 0, 0, 0}; /* 0 not open */
354:
355: /* 'r' input */
356: /* 'w' or 'a' output */
357:
358: /* names of IO devices */
359: char dev[MAXDEV + 1][40] = {
360: " ", /* HOME */
361: "/usr/tmp/mout.1/a\201", /* dev 1 */
362: "/usr/tmp/mout.2/a\201", /* dev 2 */
363: "/usr/tmp/mout.3/a\201", /* dev 3 */
364: "/usr/tmp/mout.4/a\201" /* dev 4 */
365: };
366:
367: char G0I[MAXDEV + 1][257]; /* G0 input translation table */
368: char G0O[MAXDEV + 1][257]; /* G0 output translation table */
369: char G1I[MAXDEV + 1][257]; /* G1 input translation table */
370: char G1O[MAXDEV + 1][257]; /* G1 output translation table */
371:
372: FILE *opnfile[MAXDEV + 1];
373: char act_oucpath[MAXDEV + 1][40] = {"\201", "\201", "\201", "\201", "\201"};
374: char sq_modes[MAXDEV + 1];
375:
376: short olddes[NO_GLOBLS]; /* filedescr of open global files */
377: char oldfil[NO_GLOBLS][1024]; /* names of open global files */
378: long g_ages[NO_GLOBLS]; /* last access of global files */
379: short usage[NO_GLOBLS]; /* usage count of global files */
380: short inuse = 0; /* file in use */
381:
382: int lio_mode = -1;
383: short io = HOME; /* $IO */
384: short test = FALSE; /* $TEST */
385: short pattrnflag = FALSE; /* incomplete match flag */
386: char pattrnchar = EOL; /* incomplete match flag supplement */
387: int zsystem = 0; /* $ZSYSTEM return status of UNIX call */
388: short zcc = FALSE; /* $ZC (ControlC-Flag) */
389:
390: char *rouptr; /* pointer to begin of routine */
391: char *roucur; /* cursor into routine */
392: char *rouend; /* pointer to end of pgm */
393: char *rouins; /* pointer for direct mode insert */
394: short breakon = ENABLE; /* BREAK enable/disable-flag */
395: short zbreakon = DISABLE; /* ZBREAK enable/disable-flag */
396: short zbflag = FALSE; /* 'ZBREAK from terminal'-flag */
397: short zprecise = 100; /* $ZPRECISION of arithmetic */
398: char fp_conversion[10]; /* sprintf conversion constant for ieee754 support */
399: long nrandom; /* random number seed */
400: long ran_a = 24298L; /* random number parameter a */
401: long ran_b = 99991L; /* random number parameter b */
402: long ran_c = 199017L; /* random number parameter c */
403:
404: short usermode = 1; /* 0=user mode 1=programmer mode */
405: int restricted_mode = FALSE; /* TRUE=restricted FALSE=unrestricted */
406: short demomode = FALSE; /* 0=no demo 1=demo mode */
407: int d0char = DEL; /* demomode ouput character */
408: int d1char = CAN; /* demomode '!' character */
409: short cset = FALSE; /* 0=mumps set 1='C' set flag */
410:
411: /* startup flags */
412: int hardcopy = DISABLE; /* hardcopy flag */
413: int frm_filter = FALSE; /* filter flag */
414: int noclear = FALSE; /* noclear flag */
415: int standard = D_FREEM; /* default dialect */
416: int quiet_mode = FALSE; /* quiet mode */
417: char config_file[4096]; /* path to configuration file */
418: char shm_env[255]; /* shared memory environment */
419:
420: short fp_mode = 0; /* set to 0 for fixed-point math, 1 for IEEE754 floating point */
421: short en_revstrf = 1; /* enable reverse forms of string intrinsics */
422:
423: short ierr; /* immediate error status */
424: short deferred_ierr; /* deferred error status (after returning from a private routine) */
425: char err_suppl[255]; /* supplemental information about an error */
426:
427: long PSIZE = DEFPSIZE; /* size of 'partition' */
428: char *mbpartition; /* memory-backed globals partition */
429: short writing_mb = FALSE;
430: char *partition; /* partition (symbol table) */
431: long symlen = DEFPSIZE; /* 'lower' bound of symbol table */
432: unsigned long alphptr[128] = /* pointers into symbol table */
433: {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
434: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
435: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
436: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
437: char *apartition; /* alternate partition */
438: long asymlen = DEFPSIZE; /* 'lower' bound of symbol table */
439: unsigned long aalphptr[128] = /* pointers into symbol table */
440: {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
441: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
442: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
443: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
444:
445: short autopsize = TRUE; /* automatic increase of PSIZE */
446: long svnlen = DEFUDFSVSIZ; /* 'lower' bound of udf_svn_tab */
447: long UDFSVSIZ = DEFUDFSVSIZ; /* size of userdef special var tab. */
448: char *svntable; /* udf special variable table */
449: unsigned long svnaptr[128] = /* pointers into udf_svn_tab */
450: {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
451: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
452: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
453: 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
454:
455: short autousize = TRUE; /* automatic increase of UDFSVSIZ */
456: long NO_OF_RBUF = DEFNO_OF_RBUF; /* number of routine buffers */
457: long PSIZE0 = DEFPSIZE0; /* size of routine buffers */
458: short autorsize = TRUE; /* automatic increase of PSIZE0 */
459: short aliases = 0; /* aliases pointer */
460: char ali[2000]; /* aliases table */
461: long v22ptr = 0L; /* view 22 aliases pointer */
462: char *v22ali; /* view 22 aliases field */
463: long v22size = 0L; /* current size of aliases field */
464:
465:
466: long NSIZE = DEFNSIZE; /* size of newstack */
467: char *newstack; /* stack for NEWed variables */
468: char *newptr; /* pointer to NEW stack */
469: char *newlimit; /* pointer to NEW stack end */
470:
471: short nstx = 0; /* nest stack: */
472: short nestc[NESTLEVLS + 1]; /* - command (DO...) */
473: char *nestp[NESTLEVLS + 1]; /* - cmdptr */
474: char *nestn[NESTLEVLS + 1]; /* - namptr */
475: long nestr[NESTLEVLS + 1]; /* - roucur */
476: char *nestnew[NESTLEVLS + 1]; /* - newptr */
477: short neste[NESTLEVLS + 1]; /* - was this frame entered as the result of an error? */
478: short nestlt[NESTLEVLS + 1]; /* stack $T / stack levelcount */
479: short brkstk[NESTLEVLS + 1]; /* stack for BREAK information */
480:
481: char ztrap[NESTLEVLS + 2][ZTLEN]; /* $ZTRAP to be xecuted on error */
482:
483:
484: char *s; /* pointer to symlen_offset */
485: char *argptr; /* pointer to beg of tmp-storage */
486:
487: char code[512] =
488: {EOL, EOL}; /* currently interpreted code */
489: char *codptr = code; /* pointer within code[] */
490:
491: char dosave[20]; /* in a FOR range save DO label */
492: char *xdosave;
493:
494: int errfunlvl = 0; /* avoid wrong error message in $$FUN */
495: short repQUIT = 0; /* QUIT repeater */
496:
497: char varnam[256]; /* variable/array/function name */
498: char varerr[256] =
499: {EOL}; /* reference in error message */
500: char *buff; /* routine buffer pool */
501: char pgms[MAXNO_OF_RBUF][40]; /* names of alt.pgms */
502: long ages[MAXNO_OF_RBUF]; /* last call to this pgm */
503: char *ends[MAXNO_OF_RBUF]; /* saved rouend-pointer */
504: char path[MAXNO_OF_RBUF][256]; /* directory where routine was loaded */
505: rtn_flags rbuf_flags[MAXNO_OF_RBUF]; /* per-routine flags */
506:
507: char glopath[PATHLEN]; /* path to access globals */
508: char rou0path[PATHLEN]; /* routine access with DO,GOTO,JOB */
509: char rou1path[PATHLEN]; /* routine access with ZL,ZS */
510: char gloplib[PATHLEN]; /* path to access %globals */
511:
512: char gbl_u_engine[255]; /* user global engine */
513: char gbl_s_engine[255]; /* system global engine */
514: char loc_engine[255]; /* local engine */
515:
516: unsigned long int bdb_flush_threshold;
517:
518: char rou0plib[PATHLEN]; /* %routine path (DO..) */
519: char rou1plib[PATHLEN]; /* %routine path (ZL..) */
520: char oucpath[PATHLEN] = "\201"; /* OPEN/USE/CLOSE path */
521: char zargdefname[PATHLEN]= "%\201"; /* default varname for Z-commands */
522: char jourfile[PATHLEN] = "/usr/tmp/ioprotocol"; /* journal file */
523: FILE *jouraccess; /* dto. filedes */
524: char curdir[256] = "."; /* current directory */
525:
526: char startuprou[PATHLEN] = "\201"; /* start up routine from cmdline*/
527:
528: char zcommds[256] =
529: " za zas zb zd zg zh zi zj zl zn zp zq zr zs zt zwr zallocate zbreak zdeallocate \
530: zgo zhalt zinsert zjob zload znamespace zprint zquit zremove zsave ztrap zwrite \201"; /* intrinsic z-commands */
531: char zfunctions[256] = /* intrinsic z-functions */
532: " zb zc zd ze zh zht zk zl zm zn zo zp zr zs zt zboolean zcall zcr zcrc zdata zdate zedit zhorolog \
533: zkey zlength zlsd zname znext zorder zpiece zprevious zreplace zsyntax zsort ztime \201";
534: char zsvn[256] = /* intrinsic z-special variables */
535: " za zb zc zd ze zf zh zi zj zl zmc zmn zmp zma zml zmu zme zn zo zp zs zt zu zv \
536: zcontrolc zdate zerror zname zhorolog zinrpt zjob zlocal zorder zprecision zsystem ztime ztr ztrap zuuid zut zversion \201";
537: char brkaction[256] = "\201"; /* action in case of BREAK */
538: pid_t father = 0; /* JOB-ID of father process */
539: char jour_hostid[256];
540: /* date types parameters */
541: char month[NO_DATETYPE][12][MONTH_LEN] = {
542: {"01\201", "02\201", "03\201", "04\201", "05\201", "06\201", "07\201", "08\201", "09\201", "10\201", "11\201", "12\201"},
543: {"01\201", "02\201", "03\201", "04\201", "05\201", "06\201", "07\201", "08\201", "09\201", "10\201", "11\201", "12\201"},
544: {"JAN\201", "FEB\201", "MAR\201", "APR\201", "MAY\201", "JUN\201", "JUL\201", "AUG\201", "SEP\201", "OCT\201", "NOV\201", "DEC\201"},
545: {"01\201", "02\201", "03\201", "04\201", "05\201", "06\201", "07\201", "08\201", "09\201", "10\201", "11\201", "12\201"},
546: {"1\201", "2\201", "3\201", "4\201", "5\201", "6\201", "7\201", "8\201", "9\201", "10\201", "11\201", "12\201"},
547: {"1\201", "2\201", "3\201", "4\201", "5\201", "6\201", "7\201", "8\201", "9\201", "10\201", "11\201", "12\201"},
548: {"1\201", "2\201", "3\201", "4\201", "5\201", "6\201", "7\201", "8\201", "9\201", "10\201", "11\201", "12\201"},
549: {"01\201", "02\201", "03\201", "04\201", "05\201", "06\201", "07\201", "08\201", "09\201", "10\201", "11\201", "12\201"}
550: };
551: char dat1char[NO_DATETYPE][MONTH_LEN] = /* date 1st delimiter */
552: {"/\201", "/\201", " \201", "/\201", ".\201", ".\201", ".\201", ".\201"};
553: char dat2char[NO_DATETYPE][MONTH_LEN] = /* date 2nd delimmiter */
554: {"/\201", "/\201", " \201", "/\201", ".\201", ".\201", ".\201", ".\201"};
555: char dat3char[NO_DATETYPE] =
556: {'0', '0', '0', '0', '\201', '\201', '\201', '0'}; /* date day justify char */
557: char dat4flag[NO_DATETYPE] =
558: {2, 1, 0, 0, 0, 0, 0, 0}; /* 0=DMY, 1=MDY, 2=YMD */
559: char dat5flag[NO_DATETYPE] =
560: {0, 1, 1, 1, 1, 1, 0, 1}; /* suppress century digits */
561: long int datGRbeg[NO_DATETYPE] =
562: {578101L, 578101L, 578101L, 578101L, 578101L, 578101L, 578101L, 578101L};
563:
564: /* first day of gregorian calendar 15-OCT-1582 ($H+672411) */
565: int datetype = 0; /* type for $zd special variable */
566:
567: char tim1char[NO_TIMETYPE] =
568: {':', ':'}; /* time 1st delimiter */
569: char tim2char[NO_TIMETYPE] =
570: {':', ':'}; /* time 2nd delimiter */
571: char tim3char[NO_TIMETYPE] =
572: {SP, SP}; /* time hour justify char */
573: char tim4flag[NO_TIMETYPE] =
574: {0, 1}; /* 0=24 Hrs 1=12 Hrs */
575: char tim5flag[NO_TIMETYPE] =
576: {0, 0}; /* suppress seconds */
577: int timetype = 0; /* type for $zt special variable */
578:
579: jmp_buf sjbuf;
580: char *roucu0;
581: char *dofram0;
582:
583: short forx = 0; /* FOR stack pointer */
584: char forvar[NESTLEVLS + 1][40], /* FOR variable */
585: forinc[NESTLEVLS + 1][40], /* FOR increment */
586: forpost[NESTLEVLS + 1][128], /* FOR postconditional */
587: forlim[NESTLEVLS + 1][40]; /* FOR limit value */
588: short fortyp[NESTLEVLS + 1]; /* 0 = forever 1 = single, */
589:
590: /* 2 = unlim.iter,3 = limit iter. */
591: /* 4 = "" +inc=1 5 = "" + inc=1 */
592: short fori[NESTLEVLS + 1]; /* if fortyp=5 length of forlimit */
593:
594: char *fvar; /* current forvar */
595: char *finc; /* current forinc */
596: char *fpost; /* current forpost */
597: char *flim; /* current forlim */
598: short ftyp; /* current fortyp */
599: short fi; /* current fori */
600: short forsw = FALSE; /* FOR switch */
601: short loadsw = TRUE; /* flag to avoid redundant loads */
602: short argless_forsw_quit = FALSE; /* QUIT from argumentless FOR */
603: short sigint_in_for = FALSE;
604: short direct_mode = TRUE; /* are we in direct mode? */
605:
606: short extr_types[NESTLEVLS + 1]; /* return types of extrinsic functions */
607: char destructors[MAX_DESTRUCTORS][50];
608: int destructor_ct;
609: char private_keys[MAX_PRIVATE_KEYS][255];
610:
611: /* after XECUTEs */
612: short promflag = TRUE; /* prompt execute flag */
613: short privflag = FALSE; /* extrinsic z-command flag */
614:
615:
616: char *cmdstack;
617: char *cmdptr;
618:
619: short offset;
620: long frm_timeout;
621: short timeoutms;
622: char tmp4[80] = "\201";
623: short param = 0; /* parameter count */
624: short paramx = 0; /* current parameter */
625: short level = 0; /* level count */
626: pid_t pid; /* $J = process ID */
627:
628: char nsname[256] = "USER\0"; /* namespace name */
629: char nsroot[4096]; /* root path of namespace */
630: char *freem_path; /* path to the running instance of FreeM */
631: char history_file[256]; /* path to the history file */
632: int n_lines;
633: int n_columns;
634:
635: short ipc_pending = 0; /* 1 if an incoming IPC is pending, 0 otherwise */
636:
637: int strict_mode = 0;
638:
639: short first_process = FALSE;
640: size_t shm_init_size = 16777216;
641:
642: short inrpt_after_async = FALSE;
643:
644: //#ifdef USE_SIGACTION
645: // struct sigaction act = {0}; /* signals stuff */
646: //#endif/*USE_SIGACTION*/
647:
648: void unnew (void)
649: {
650: char *xptr;
651: int i;
652: long j;
653: char tmp[256];
654:
655: #ifdef DEBUG_NEWPTR
656: int loop;
657: printf("Un-Newing: ");
658: printf("[nstx] nstx is %d\r\n",nstx);
659: printf("[nestnew] nestnew[nstx] is %d\r\n",nestnew[nstx]);
660: #endif
661:
662:
663: xptr = nestnew[nstx]; /* get position of newpointer */
664:
665: while (xptr < newptr) {
666: i = *--newptr;
667:
668: if (i != kill_all) {
669: j = UNSIGN (*--newptr);
670: newptr -= (j + 1);
671: stcpy0 (varnam, newptr, j + 1);
672:
673: if (i == set_sym) {
674: j = UNSIGN (*--newptr);
675: newptr -= (j + 1);
676: stcpy (tmp, newptr);
677: }
678: else {
679: tmp[0] = EOL;
680: }
681: }
682: else {
683: varnam[0] = EOL;
684: tmp[0] = EOL;
685: }
686:
687: if (varnam[0] == '$') {
688: if (varnam[1] == 't') test = tmp[0]; /* pop $TEST */
689: else if (varnam[1] == 'j') pid = UNSIGN (tmp[0]) * 256 + UNSIGN (tmp[1]); /* pop $job */
690: else if (varnam[1] == 'z' && varnam[2] == 'i') breakon = tmp[0]; /* pop $zinrpt */
691: else if (varnam[1] == 'e' && varnam[2] == 't') { /* pop $etrap */
692: stcpy (etrap, tmp);
693: }
694: else if (varnam[1] == 'e' && varnam[2] == 's') { /* pop $estack */
695: char esbuf[256];
696:
697: stcpy (esbuf, tmp);
698: stcnv_m2c (esbuf);
699:
700: estack = atoi (esbuf);
701: }
702: else { /* pop $reference/$zreference */
703: stcpy (zref, tmp);
704: nakoffs = UNSIGN (varnam[4]);
705: }
706:
707: continue;
708: }
709: symtab (i, varnam, tmp);
710: }
711:
712: newptr = nestnew[nstx];
713: nestnew[nstx] = 0; /* reset pointers */
714:
715: return;
716:
717: } /* end unnew() */
718:
719: void m_fatal(char *s)
720: {
721: int errno_sav;
722: errno_sav = errno;
723:
724: set_io (UNIX);
725:
726:
727: if (tp_level) {
728: fprintf (stderr, "freem [FATAL]: memory allocation failure in %s; rolling back %d transactions [errno %d %s]\n", s, tp_level, errno_sav, strerror (errno_sav));
729: tp_trollback (tp_level);
730: }
731: else {
732: fprintf (stderr, "freem [FATAL]: memory allocation failure in %s [errno %d %s]\n", s, errno_sav, strerror (errno_sav));
733: }
734:
735: exit (3);
736: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to frmgbl.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem / src