1 /*
2 This file is part of GNU APL, a free implementation of the
3 ISO/IEC Standard 13751, "Programming Language APL, Extended"
4
5 Copyright (C) 2008-2015 Dr. Jürgen Sauermann
6
7 This program is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>.
19 */
20
21 #include <fcntl.h>
22 #include <stdio.h>
23 #include <string.h>
24 #include <sys/stat.h>
25 #include <sys/time.h>
26 #include <sys/types.h>
27
28 #include "Common.hh"
29 #include "LineInput.hh"
30 #include "LibPaths.hh"
31 #include "NativeFunction.hh"
32 #include "Output.hh"
33 #include "Parallel.hh"
34 #include "ProcessorID.hh"
35 #include "Quad_WA.hh"
36 #include "Svar_DB.hh"
37 #include "Symbol.hh"
38 #include "StateIndicator.hh"
39 #include "Thread_context.hh"
40 #include "Token.hh"
41 #include "Value.hh"
42 #include "UserFunction.hh"
43 #include "UserPreferences.hh"
44 #include "ValueHistory.hh"
45
46 bool got_WINCH = false;
47
48 //-----------------------------------------------------------------------------
49 static bool attention_raised = false;
50 static uint64_t attention_count = 0;
51
set_attention_raised(const char * loc)52 extern void set_attention_raised(const char * loc)
53 {
54 attention_raised = true;
55 }
clear_attention_raised(const char * loc)56 extern void clear_attention_raised(const char * loc)
57 {
58 attention_raised = false;
59 }
attention_is_raised()60 bool attention_is_raised()
61 {
62 return attention_raised;
63 }
64 //-----------------------------------------------------------------------------
65 APL_time_us interrupt_when = 0;
66 uint64_t interrupt_count = 0;
67 static bool interrupt_raised = false;
set_interrupt_raised(const char * loc)68 void set_interrupt_raised(const char * loc)
69 {
70 interrupt_raised = true;
71 }
clear_interrupt_raised(const char * loc)72 void clear_interrupt_raised(const char * loc)
73 {
74 interrupt_raised = false;
75 }
interrupt_is_raised()76 bool interrupt_is_raised()
77 {
78 return interrupt_raised;
79 }
80 //-----------------------------------------------------------------------------
81 void
init_1(const char * argv0,bool log_startup)82 init_1(const char * argv0, bool log_startup)
83 {
84 // init the workspace memory limits
85 //
86 Quad_WA::init(log_startup);
87
88 if (log_startup)
89 CERR << endl
90 << "sizeof(int) is " << sizeof(int) << endl
91 << "sizeof(long) is " << sizeof(long) << endl
92 << "sizeof(void *) is " << sizeof(void *) << endl
93 << endl
94 << "sizeof(Cell) is " << sizeof(Cell) << endl
95 << "sizeof(SI stack item) is " << sizeof(StateIndicator) << endl
96 << "sizeof(Svar_partner) is " << sizeof(Svar_partner) << endl
97 << "sizeof(Svar_record) is " << sizeof(Svar_record) << endl
98 << "sizeof(Symbol) is " << sizeof(Symbol) << endl
99 << "sizeof(Token) is " << sizeof(Token) << endl
100 << "sizeof(Value) is " << sizeof(Value)
101 << " (including " << SHORT_VALUE_LENGTH_WANTED << " Cells)" << endl
102 << "sizeof(ValueStackItem) is " << sizeof(ValueStackItem) << endl
103 << "sizeof(UCS_string) is " << sizeof(UCS_string) << endl
104 << "sizeof(UserFunction) is " << sizeof(UserFunction) << endl
105 << endl
106 << "⎕WA total memory is " << Quad_WA::total_memory
107 << " bytes (" << (Quad_WA::total_memory/1000000) << " MB, 0x"
108 << hex << Quad_WA::total_memory << ")" << dec << endl;
109
110 // CYGWIN does not have RLIMIT_NPROC
111 //
112 #ifdef RLIMIT_NPROC
113
114 // unlimit the number of threads and processes...
115 //
116 rlimit rl;
117 getrlimit(RLIMIT_NPROC, &rl);
118 if (log_startup)
119 CERR << "increasing rlimit RLIMIT_NPROC from " << rl.rlim_cur
120 << " to infinity" << endl;
121 rl.rlim_cur = RLIM_INFINITY;
122 setrlimit(RLIMIT_NPROC, &rl);
123
124 // limit the virtual memory size to avoid new() problem with large values
125 //
126 #endif
127
128 Avec::init();
129 LibPaths::init(argv0, log_startup);
130 Value::init();
131 VH_entry::init();
132 }
133 //-----------------------------------------------------------------------------
134 /// initialize subsystems that depend on argv[]
135 void
init_2(bool log_startup)136 init_2(bool log_startup)
137 {
138 const int retry_max = uprefs.emacs_mode ? 15 : 5;
139
140 Output::init(log_startup);
141 Svar_DB::init(LibPaths::get_APL_bin_path(), LibPaths::get_APL_bin_name(),
142 retry_max, log_startup, uprefs.system_do_svars);
143
144 LineInput::init(true);
145
146 Parallel::init(log_startup || LOG_Parallel);
147 }
148 //-----------------------------------------------------------------------------
149 /// the opposite of init()
150 void
cleanup(bool soft)151 cleanup(bool soft)
152 {
153 if (soft) // proper clean-up
154 {
155 ProcessorID::disconnect();
156
157 NativeFunction::cleanup();
158
159 // write line history
160 //
161 LineInput::close(false);
162
163 Output::reset_colors();
164
165 Thread_context::cleanup();
166
167 ID::cleanup();
168 }
169 else // minimal clean-up
170 {
171 LineInput::close(true);
172 Output::reset_colors();
173 }
174 }
175 //-----------------------------------------------------------------------------
176 void
control_C(int)177 control_C(int)
178 {
179 APL_time_us when = now();
180
181 CIN << "^C";
182
183 attention_raised = true;
184 ++attention_count;
185 if ((when - interrupt_when) < 1000000) // second ^C within 1 second
186 {
187 interrupt_raised = true;
188 ++interrupt_count;
189 }
190
191 interrupt_when = when;
192 }
193 //-----------------------------------------------------------------------------
194
195 // Probes...
196
197 int64_t Probe::dummy = 0;
198 Probe Probe::probes[Probe::PROBE_COUNT];
199
200 Probe & Probe::P0 = probes[0];
201 Probe & Probe::P_1 = probes[Probe::PROBE_COUNT - 1];
202 Probe & Probe::P_2 = probes[Probe::PROBE_COUNT - 2];
203 Probe & Probe::P_3 = probes[Probe::PROBE_COUNT - 3];
204 Probe & Probe::P_4 = probes[Probe::PROBE_COUNT - 4];
205 Probe & Probe::P_5 = probes[Probe::PROBE_COUNT - 5];
206
207 //-----------------------------------------------------------------------------
208 void *
common_new(size_t size)209 common_new(size_t size)
210 {
211 void * ret = malloc(size);
212 const uint64_t iret = uint64_t(ret);
213 CERR << "NEW " << HEX(iret) << "-" << HEX(iret + size)
214 << " (" << HEX(size) << ")" << endl;
215 return ret;
216 }
217 //-----------------------------------------------------------------------------
218 void
common_delete(void * p)219 common_delete(void * p)
220 {
221 CERR << "DEL " << HEX(uint64_t(p)) << endl;
222 free(p);
223 }
224 //-----------------------------------------------------------------------------
225 APL_time_us
now()226 now()
227 {
228 timeval tv_now;
229 gettimeofday(&tv_now, 0);
230
231 APL_time_us ret = tv_now.tv_sec;
232 ret *= 1000000;
233 ret += tv_now.tv_usec;
234 return ret;
235 }
236 //-----------------------------------------------------------------------------
YMDhmsu(APL_time_us at)237 YMDhmsu::YMDhmsu(APL_time_us at)
238 : micro(at % 1000000)
239 {
240 const time_t secs = at/1000000;
241 tm t;
242 gmtime_r(&secs, &t);
243
244 year = t.tm_year + 1900;
245 month = t.tm_mon + 1;
246 day = t.tm_mday;
247 hour = t.tm_hour;
248 minute = t.tm_min;
249 second = t.tm_sec;
250 }
251 //-----------------------------------------------------------------------------
252 APL_time_us
get() const253 YMDhmsu::get() const
254 {
255 tm t;
256 t.tm_year = year - 1900;
257 t.tm_mon = month - 1;
258 t.tm_mday = day;
259 t.tm_hour = hour;
260 t.tm_min = minute;
261 t.tm_sec = second;
262 t.tm_isdst = 0;
263
264 APL_time_us ret = mktime(&t);
265 ret *= 1000000;
266 ret += micro;
267 return ret;
268 }
269 //-----------------------------------------------------------------------------
270 ostream &
operator <<(ostream & out,const Function_PC2 & ft)271 operator << (ostream & out, const Function_PC2 & ft)
272 {
273 return out << ft.low << ":" << ft.high;
274 }
275 //-----------------------------------------------------------------------------
276 ostream &
print_flags(ostream & out,ValueFlags flags)277 print_flags(ostream & out, ValueFlags flags)
278 {
279 return out << ((flags & VF_marked) ? "M" : "-")
280 << ((flags & VF_complete) ? "C" : "-");
281 }
282 //-----------------------------------------------------------------------------
283 int
nibble(Unicode uni)284 nibble(Unicode uni)
285 {
286 switch(uni)
287 {
288 case UNI_ASCII_0 ... UNI_ASCII_9: return (uni - UNI_ASCII_0);
289 case UNI_ASCII_A ... UNI_ASCII_F: return 10 + (uni - UNI_ASCII_A);
290 case UNI_ASCII_a ... UNI_ASCII_f: return 10 + (uni - UNI_ASCII_a);
291 default: break;
292 }
293
294 return -1; // uni is not a hex digit
295 }
296 //-----------------------------------------------------------------------------
297 int
sixbit(Unicode uni)298 sixbit(Unicode uni)
299 {
300 switch(uni)
301 {
302 case UNI_ASCII_A ... UNI_ASCII_Z: return (uni - UNI_ASCII_A);
303 case UNI_ASCII_a ... UNI_ASCII_z: return 26 + (uni - UNI_ASCII_a);
304 case UNI_ASCII_0 ... UNI_ASCII_9: return 52 + (uni - UNI_ASCII_0);
305
306 case UNI_ASCII_PLUS: // standard 62
307 case UNI_ASCII_MINUS: return 62; // alternative 62
308
309 case UNI_ASCII_SLASH: // standard 63
310 case UNI_ASCII_UNDERSCORE: return 63; // alternative 63
311
312 case UNI_ASCII_EQUAL: return 64; // fill character
313
314 default: break;
315 }
316
317 return -1; // uni is not a hex digit
318 }
319 //-----------------------------------------------------------------------------
320