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