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-2017 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 <errno.h>
22 #include <string.h>
23 #include <sys/stat.h>
24
25 #include <fstream>
26
27 using namespace std;
28
29 #include "Archive.hh"
30 #include "Command.hh"
31 #include "InputFile.hh"
32 #include "IO_Files.hh"
33 #include "LibPaths.hh"
34 #include "Output.hh"
35 #include "Quad_FFT.hh"
36 #include "Quad_FX.hh"
37 #include "Quad_GTK.hh"
38 #include "Quad_PLOT.hh"
39 #include "Quad_SQL.hh"
40 #include "Quad_TF.hh"
41 #include "SystemVariable.hh"
42 #include "UserFunction.hh"
43 #include "UserPreferences.hh"
44 #include "Workspace.hh"
45
46 //-----------------------------------------------------------------------------
Workspace()47 Workspace::Workspace()
48 : WS_name("CLEAR WS"),
49 // prompt("-----> "),
50 prompt(" "),
51 top_SI(0)
52 {
53 #define ro_sv_def(x, str, _txt) \
54 if (*str) { UCS_string q(UNI_Quad_Quad); q.append_UTF8(str); \
55 distinguished_names.add_variable(q, ID_ ## x, &v_ ## x); }
56
57 #define rw_sv_def ro_sv_def
58
59 #define sf_def(x, str, _txt) \
60 if (*str) { UCS_string q(UNI_Quad_Quad); q.append_UTF8(str); \
61 distinguished_names.add_function(q, ID_ ## x, x::fun); }
62
63 #include "SystemVariable.def"
64 }
65 //-----------------------------------------------------------------------------
66 void
push_SI(Executable * fun,const char * loc)67 Workspace::push_SI(Executable * fun, const char * loc)
68 {
69 Assert1(fun);
70
71 if (Quad_SYL::si_depth_limit && SI_top() &&
72 Quad_SYL::si_depth_limit <= SI_top()->get_level())
73 {
74 MORE_ERROR() <<
75 "the system limit on SI depth (as set in ⎕SYL) was reached\n"
76 "(and to avoid lock-up, the limit in ⎕SYL was automatically cleared).";
77
78 Quad_SYL::si_depth_limit = 0;
79 set_attention_raised(LOC);
80 set_interrupt_raised(LOC);
81 }
82
83 if (Value::check_WS_FULL(__FUNCTION__, 1000, LOC))
84 {
85 if (SI_top() && SI_top()->get_executable() &&
86 the_workspace.SI_entry_count() > 100)
87 MORE_ERROR() <<
88 "Value::check_WS_FULL() complained when calling a defined function.\n"
89 "This was most likely caused by some infinite recursion involving "
90 << SI_top()->get_executable()->get_name();
91 else
92 MORE_ERROR() <<
93 "Value::check_WS_FULL() complained when calling a defined function";
94 WS_FULL;
95 }
96
97 try
98 {
99 StateIndicator * old_top = SI_top();
100 the_workspace.top_SI = new StateIndicator(fun, old_top);
101 if (the_workspace.top_SI == 0)
102 {
103 MORE_ERROR() <<
104 "malloc() → 0 when calling a defined function";
105 the_workspace.top_SI = old_top;
106 WS_FULL;
107 }
108 }
109 catch (const std::bad_alloc & e)
110 {
111 if (SI_top() && SI_top()->get_executable() &&
112 the_workspace.SI_entry_count() > 100)
113 MORE_ERROR() <<
114 "std::bad_alloc exception when calling a defined function\n"
115 "This was most likely caused by some infinite recursion involving "
116 << SI_top()->get_executable()->get_name();
117 else
118 MORE_ERROR() <<
119 "std::bad_alloc exception when calling a defined function";
120 WS_FULL;
121 }
122
123 Log(LOG_StateIndicator__push_pop)
124 {
125 CERR << "Push SI[" << SI_top()->get_level() << "] "
126 << "pmode=" << fun->get_parse_mode()
127 << " exec=" << fun << " "
128 << fun->get_name();
129
130 CERR << " new SI is " << voidP(SI_top())
131 << " at " << loc << endl;
132 }
133 }
134 //-----------------------------------------------------------------------------
135 void
pop_SI(const char * loc)136 Workspace::pop_SI(const char * loc)
137 {
138 Assert(SI_top());
139 const Executable * exec = SI_top()->get_executable();
140 Assert1(exec);
141
142 Log(LOG_StateIndicator__push_pop)
143 {
144 CERR << "Pop SI[" << SI_top()->get_level() << "] "
145 << "pmode=" << exec->get_parse_mode()
146 << " exec=" << exec << " ";
147
148 if (exec->get_ufun()) CERR << exec->get_ufun()->get_name();
149 else CERR << SI_top()->get_parse_mode_name();
150 CERR << " " << voidP(SI_top())
151 << " at " << loc << endl;
152 }
153
154 // remove the top SI
155 //
156 StateIndicator * del = SI_top();
157 the_workspace.top_SI = del->get_parent();
158 delete del;
159 }
160 //-----------------------------------------------------------------------------
161 uint64_t
get_RL(uint64_t mod)162 Workspace::get_RL(uint64_t mod)
163 {
164 // we discard random numbers >= max_rand in order to avoid a bias
165 // towards small numbers
166 //
167 const uint64_t max_rand = 0xFFFFFFFFFFFFFFFFULL - (0xFFFFFFFFFFFFFFFFULL % mod);
168 uint64_t rand = the_workspace.v_Quad_RL.get_random();
169
170 do { rand ^= rand >> 11;
171 rand ^= rand << 29;
172 rand ^= rand >> 14;
173 } while (rand >= max_rand);
174
175 return rand % mod;
176 }
177 //-----------------------------------------------------------------------------
178 void
clear_error(const char * loc)179 Workspace::clear_error(const char * loc)
180 {
181 // clear errors up to (including) next user defined function (see ⎕ET)
182 //
183 for (StateIndicator * si = the_workspace.SI_top(); si; si = si->get_parent())
184 {
185 new (&StateIndicator::get_error(si)) Error(E_NO_ERROR, LOC);
186 if (si->get_parse_mode() == PM_FUNCTION) break;
187 }
188 }
189 //-----------------------------------------------------------------------------
190 StateIndicator *
SI_top_fun()191 Workspace::SI_top_fun()
192 {
193 for (StateIndicator * si = SI_top(); si; si = si->get_parent())
194 {
195 if (si->get_parse_mode() == PM_FUNCTION) return si;
196 }
197
198 return 0; // no context wirh parse mode PM_FUNCTION
199 }
200 //-----------------------------------------------------------------------------
201 StateIndicator *
SI_top_error()202 Workspace::SI_top_error()
203 {
204 for (StateIndicator * si = SI_top(); si; si = si->get_parent())
205 {
206 if (StateIndicator::get_error(si).get_error_code() != E_NO_ERROR)
207 return si;
208 }
209
210 return 0; // no context with an error
211 }
212 //-----------------------------------------------------------------------------
213 Token
immediate_execution(bool exit_on_error)214 Workspace::immediate_execution(bool exit_on_error)
215 {
216 for (;;)
217 {
218 try
219 {
220 Command::process_line();
221 }
222 catch (Error & err)
223 {
224 if (!err.get_print_loc())
225 {
226 if (err.get_error_code() != E_DEFN_ERROR)
227 {
228 err.print_em(UERR, LOC);
229 CERR << __FUNCTION__ << "() caught APL error "
230 << HEX(err.get_error_code()) << " ("
231 << err.error_name(err.get_error_code()) << ")"
232 << endl;
233
234 IO_Files::apl_error(LOC);
235 }
236 }
237 if (exit_on_error) return Token(TOK_OFF);
238 }
239 catch (const std::bad_alloc & e)
240 {
241 CERR << "*** " << __FUNCTION__
242 << "() caught bad_alloc: " << e.what() << " ***" << endl;
243 if (the_workspace.SI_entry_count() > 100)
244 CERR << ")SI depth is " << the_workspace.SI_entry_count()
245 << "; )SIC is strongly recommended !!!"
246 << endl;
247 try { WS_FULL } catch (...) {}
248 if (exit_on_error) return Token(TOK_OFF);
249 }
250 catch (...)
251 {
252 CERR << "*** " << __FUNCTION__
253 << "() caught other exception ***" << endl;
254 IO_Files::apl_error(LOC);
255 if (exit_on_error) return Token(TOK_OFF);
256 }
257 }
258
259 return Token(TOK_ESCAPE);
260 }
261 //-----------------------------------------------------------------------------
262 NamedObject *
lookup_existing_name(const UCS_string & name)263 Workspace::lookup_existing_name(const UCS_string & name)
264 {
265 if (name.size() == 0) return 0;
266
267 if (Avec::is_quad(name[0])) // distinguished name
268 {
269 int len;
270 Token tok = get_quad(name, len);
271 if (len == 1) return 0;
272 if (name.size() != len) return 0;
273 if (tok.get_Class() == TC_SYMBOL) return tok.get_sym_ptr();
274 if (tok.get_Class() == TC_FUN0) return tok.get_function();
275 if (tok.get_Class() == TC_FUN1) return tok.get_function();
276 if (tok.get_Class() == TC_FUN2) return tok.get_function();
277
278 Assert(0);
279 }
280
281 // user defined variable or function
282 //
283 Symbol * sym = the_workspace.symbol_table.lookup_existing_symbol(name);
284 if (sym == 0) return 0;
285
286 switch(sym->get_nc())
287 {
288 case NC_VARIABLE: return sym;
289
290 case NC_FUNCTION:
291 case NC_OPERATOR: return sym->get_function();
292 default: return 0;
293 }
294 }
295 //-----------------------------------------------------------------------------
296 Symbol *
lookup_existing_symbol(const UCS_string & symbol_name)297 Workspace::lookup_existing_symbol(const UCS_string & symbol_name)
298 {
299 if (symbol_name.size() == 0) return 0;
300
301 if (Avec::is_quad(symbol_name[0])) // distinguished name
302 {
303 int len;
304 Token tok = get_quad(symbol_name, len);
305 if (symbol_name.size() != len) return 0;
306 if (tok.get_Class() != TC_SYMBOL) return 0; // system function
307
308 return tok.get_sym_ptr();
309 }
310
311 return the_workspace.symbol_table.lookup_existing_symbol(symbol_name);
312 }
313 //-----------------------------------------------------------------------------
314 Token
get_quad(const UCS_string & ucs,int & len)315 Workspace::get_quad(const UCS_string & ucs, int & len)
316 {
317 if (ucs.size() == 0 || !Avec::is_quad(ucs[0]))
318 {
319 len = 0;
320 return Token();
321 }
322
323 UCS_string name(UNI_Quad_Quad);
324 len = 1;
325
326 SystemName * longest = 0;
327
328 for (ShapeItem u = 1; u < ucs.size(); ++u)
329 {
330 Unicode uni = ucs[u];
331 if (!Avec::is_symbol_char(uni)) break;
332
333 if (uni >= 'a' && uni <= 'z') uni = Unicode(uni - 0x20);
334 name.append(uni);
335 SystemName * dn =
336 the_workspace.distinguished_names.lookup_existing_symbol(name);
337
338 if (dn) // ss is a valid distinguished name
339 {
340 longest = dn;
341 len = name.size();
342 }
343 }
344
345 if (longest == 0) return Token(TOK_Quad_Quad, &the_workspace.v_Quad_Quad);
346
347 if (longest->get_variable()) return longest->get_variable()->get_token();
348 else return longest->get_function()->get_token();
349 }
350 //-----------------------------------------------------------------------------
351 StateIndicator *
oldest_exec(const Executable * exec)352 Workspace::oldest_exec(const Executable * exec)
353 {
354 StateIndicator * ret = 0;
355
356 for (StateIndicator * si = SI_top(); si; si = si->get_parent())
357 if (exec == si->get_executable()) ret = si; // maybe not yet oldest
358
359 return ret;
360 }
361 //-----------------------------------------------------------------------------
362 bool
is_called(const UCS_string & funname)363 Workspace::is_called(const UCS_string & funname)
364 {
365 // return true if the current-referent of funname is pendant
366 //
367 Symbol * current_referent = lookup_existing_symbol(funname);
368 if (current_referent == 0) return false; // no such symbol
369
370 Assert(current_referent->get_Id() == ID_USER_SYMBOL);
371
372 const NameClass nc = current_referent->get_nc();
373 if (nc != NC_FUNCTION && nc != NC_OPERATOR) return false;
374
375 const Function * fun = current_referent->get_function();
376 Assert(fun);
377
378 const UserFunction * ufun = fun->get_ufun1();
379 if (!ufun) return false; // not a defined function
380
381 for (const StateIndicator * si = SI_top(); si; si = si->get_parent())
382 {
383 if (si->uses_function(ufun)) return true;
384 }
385
386 return false;
387 }
388 //-----------------------------------------------------------------------------
389 void
write_OUT(FILE * out,uint64_t & seq,const UCS_string_vector & objects)390 Workspace::write_OUT(FILE * out, uint64_t & seq, const UCS_string_vector
391 & objects)
392 {
393 // if objects is empty then write all user define objects and some system
394 // variables
395 //
396 if (objects.size() == 0) // all objects plus some system variables
397 {
398 get_v_Quad_CT().write_OUT(out, seq);
399 get_v_Quad_FC().write_OUT(out, seq);
400 get_v_Quad_IO().write_OUT(out, seq);
401 get_v_Quad_LX().write_OUT(out, seq);
402 get_v_Quad_PP().write_OUT(out, seq);
403 get_v_Quad_PR().write_OUT(out, seq);
404 get_v_Quad_RL().write_OUT(out, seq);
405
406 get_symbol_table().write_all_symbols(out, seq);
407 }
408 else // only specified objects
409 {
410 loop(o, objects.size())
411 {
412 NamedObject * obj = lookup_existing_name(objects[o]);
413 if (obj == 0) // not found
414 {
415 COUT << ")OUT: " << objects[o] << " NOT SAVED (not found)"
416 << endl;
417 continue;
418 }
419
420 if (obj->get_Id() == ID_USER_SYMBOL) // user defined name
421 {
422 const Symbol * sym = lookup_existing_symbol(objects[o]);
423 Assert(sym);
424 sym->write_OUT(out, seq);
425 }
426 else // distinguished name
427 {
428 const Symbol * sym = obj->get_symbol();
429 if (sym == 0)
430 {
431 COUT << ")OUT: " << objects[o]
432 << " NOT SAVED (not a variable)" << endl;
433 continue;
434 }
435
436 sym->write_OUT(out, seq);
437 }
438 }
439 }
440 }
441 //-----------------------------------------------------------------------------
442 void
unmark_all_values()443 Workspace::unmark_all_values()
444 {
445 // unmark user defined symbols
446 //
447 the_workspace.symbol_table.unmark_all_values();
448
449 // unmark system variables
450 //
451 #define rw_sv_def(x, _str, _txt) the_workspace.v_ ## x.unmark_all_values();
452 #define ro_sv_def(x, _str, _txt) the_workspace.v_ ## x.unmark_all_values();
453 #include "SystemVariable.def"
454 the_workspace.v_Quad_Quad .unmark_all_values();
455 the_workspace.v_Quad_QUOTE.unmark_all_values();
456
457 // unmark token reachable vi SI stack
458 //
459 for (StateIndicator * si = SI_top(); si; si = si->get_parent())
460 si->unmark_all_values();
461
462 // unmark token in (failed) ⎕EX functions
463 //
464 loop(f, the_workspace.expunged_functions.size())
465 the_workspace.expunged_functions[f]->unmark_all_values();
466 }
467 //-----------------------------------------------------------------------------
468 int
show_owners(ostream & out,const Value & value)469 Workspace::show_owners(ostream & out, const Value & value)
470 {
471 int count = 0;
472
473 // user defined variabes
474 //
475 count += the_workspace.symbol_table.show_owners(out, value);
476
477 // system variabes
478 //
479 #define rw_sv_def(x, _str, _txt) count += get_v_ ## x().show_owners(out, value);
480 #define ro_sv_def(x, _str, _txt) count += get_v_ ## x().show_owners(out, value);
481 #include "SystemVariable.def"
482 count += the_workspace.v_Quad_Quad .show_owners(out, value);
483 count += the_workspace.v_Quad_QUOTE.show_owners(out, value);
484
485 for (StateIndicator * si = SI_top(); si; si = si->get_parent())
486 count += si->show_owners(out, value);
487
488 loop(f, the_workspace.expunged_functions.size())
489 {
490 char cc[100];
491 const long long lf(f);
492 snprintf(cc, sizeof(cc), " ⎕EX[%lld] ", lf);
493 count += the_workspace.expunged_functions[f]
494 ->show_owners(cc, out, value);
495 }
496
497 return count;
498 }
499 //-----------------------------------------------------------------------------
500 int
cleanup_expunged(ostream & out,bool & erased)501 Workspace::cleanup_expunged(ostream & out, bool & erased)
502 {
503 const int ret = the_workspace.expunged_functions.size();
504
505 if (SI_entry_count() > 0)
506 {
507 out << "SI not cleared (size " << SI_entry_count()
508 << "): not deleting ⎕EX'ed functions (try )SIC first)" << endl;
509 erased = false;
510 return ret;
511 }
512
513 while(the_workspace.expunged_functions.size())
514 {
515 const UserFunction * ufun = the_workspace.expunged_functions.back();
516 the_workspace.expunged_functions.pop_back();
517 out << "finally deleting " << ufun->get_name() << "...";
518 delete ufun;
519 out << " OK" << endl;
520 }
521
522 erased = true;
523 return ret;
524 }
525 //-----------------------------------------------------------------------------
526 void
clear_WS(ostream & out,bool silent)527 Workspace::clear_WS(ostream & out, bool silent)
528 {
529 // remove user-defined commands
530 //
531 get_user_commands().clear();
532
533 // clear the SI (pops all localized symbols)
534 //
535 clear_SI(out);
536
537 // clear the symbol tables
538 //
539 the_workspace.symbol_table.clear(out);
540
541 // clear the )MORE error info
542 //
543 more_error().clear();
544
545 // ⎕PW and ⎕TZ shall survive )CLEAR (lrm p. 260);
546 //
547 const int pw = the_workspace.v_Quad_PW[0].apl_val->get_sole_integer();
548 const int tz = the_workspace.v_Quad_TZ.get_offset();
549
550 // clear the value stacks of read/write system variables...
551 //
552 #define rw_sv_def(x, _str, _txt) get_v_ ## x().clear_vs();
553 #define ro_sv_def(x, _str, _txt)
554 #include "SystemVariable.def"
555
556 // at this point all values should have been gone.
557 // complain about those that still exist, and remove them.
558 //
559 // Value::erase_all(out);
560
561 #define rw_sv_def(x, _str, _txt) \
562 { get_v_ ##x().~x(); new (&get_v_ ##x()) x; }
563 #define ro_sv_def(x, _str, _txt)
564 #include "SystemVariable.def"
565
566 get_v_Quad_RL().reset_seed();
567 Workspace::set_PW(pw, LOC);
568 the_workspace.v_Quad_TZ.set_offset(tz);
569
570 // close open windows in ⎕GTK
571 Quad_GTK::fun->clear();
572
573 // close open files in ⎕FIO
574 Quad_FIO::fun->clear();
575
576 set_WS_name(UCS_string("CLEAR WS"));
577 if (!silent) out << "CLEAR WS" << endl;
578 }
579 //-----------------------------------------------------------------------------
580 void
clear_SI(ostream & out)581 Workspace::clear_SI(ostream & out)
582 {
583 // clear the SI (pops all localized symbols)
584 while (SI_top())
585 {
586 SI_top()->escape();
587 pop_SI(LOC);
588 }
589 }
590 //-----------------------------------------------------------------------------
591 void
list_SI(ostream & out,SI_mode mode)592 Workspace::list_SI(ostream & out, SI_mode mode)
593 {
594 for (const StateIndicator * si = SI_top(); si; si = si->get_parent())
595 si->list(out, mode);
596
597 if (mode & SIM_debug) out << endl;
598 }
599 //-----------------------------------------------------------------------------
600 void
save_WS(ostream & out,LibRef libref,const UCS_string & wsname,bool name_from_WSID)601 Workspace::save_WS(ostream & out, LibRef libref, const UCS_string & wsname,
602 bool name_from_WSID)
603 {
604 UTF8_string filename = LibPaths::get_lib_filename(libref, wsname, false,
605 ".xml", 0);
606
607 // dont )SAVE if wsname differs from wsid and the file exists
608 //
609 const bool file_exists = access(filename.c_str(), W_OK) == 0;
610 if (file_exists)
611 {
612 if (wsname.compare(the_workspace.WS_name) != 0) // names differ
613 {
614 out << "NOT SAVED: THIS WS IS "
615 << the_workspace.WS_name << endl;
616
617 MORE_ERROR() << "the workspace was not saved because:\n"
618 << " the workspace name '" << the_workspace.WS_name
619 << "' of )WSID\n does not match the name '" << wsname
620 << "' used in the )SAVE command\n"
621 << " and the workspace file\n " << filename
622 << "\n already exists. Use )WSID " << wsname << " first.";
623 return;
624 }
625 }
626
627 if (uprefs.backup_before_save && backup_existing_file(filename.c_str()))
628 {
629 COUT << "NOT SAVED: COULD NOT CREATE BACKUP FILE "
630 << filename << endl;
631 return;
632 }
633
634 // at this point it is OK to rename and save the workspace
635 //
636 ofstream outf(filename.c_str(), ofstream::out);
637 if (!outf.is_open()) // open failed
638 {
639 CERR << "Unable to )SAVE workspace '" << wsname
640 << "'. " << strerror(errno) << endl;
641 return;
642 }
643
644 the_workspace.WS_name = wsname;
645
646 XML_Saving_Archive ar(outf);
647 ar.save();
648
649 // print time and date to COUT
650 get_v_Quad_TZ().print_timestamp(out, now());
651 if (name_from_WSID) out << " " << the_workspace.WS_name;
652 out << endl;
653 }
654 //-----------------------------------------------------------------------------
655 bool
backup_existing_file(const char * filename)656 Workspace::backup_existing_file(const char * filename)
657 {
658 // 1. if file 'filename' does not exist then no backup is needed.
659 //
660 if (access(filename, F_OK) != 0) return false; // OK
661
662 UTF8_string backup_filename = filename;
663 backup_filename.append_ASCII(".bak");
664
665 // 2. if backup file exists then remove it...
666 //
667 if (access(backup_filename.c_str(), F_OK) == 0) // backup exists
668 {
669 const int err = unlink(backup_filename.c_str());
670 if (err)
671 {
672 CERR << "Could not remove backup file " << backup_filename
673 << ": " << strerror(errno) << endl;
674 return true; // error
675 }
676
677 if (access(backup_filename.c_str(), F_OK) == 0) // still exists
678 {
679 CERR << "Could not remove backup file " << backup_filename << endl;
680 return true; // error
681 }
682 }
683
684 // 3. rename file to file.bak
685 //
686 const int err = rename(filename, backup_filename.c_str());
687 if (err) // rename failed
688 {
689 CERR << "Could not rename file " << filename
690 << " to " << backup_filename
691 << ": " << strerror(errno) << endl;
692 return true; // error
693 }
694
695 if (access(filename, F_OK) == 0) // file still exists
696 {
697 CERR << "Could not rename file " << filename
698 << " to " << backup_filename << endl;
699 return true; // error
700 }
701
702 return false; // OK
703 }
704 //-----------------------------------------------------------------------------
705 void
load_DUMP(ostream & out,const UTF8_string & filename,int fd,LX_mode with_LX,bool silent,UCS_string_vector * object_filter)706 Workspace::load_DUMP(ostream & out, const UTF8_string & filename, int fd,
707 LX_mode with_LX, bool silent,
708 UCS_string_vector * object_filter)
709 {
710 Log(LOG_command_IN)
711 CERR << "loading )DUMP file " << filename << "..." << endl;
712
713 {
714 struct stat st;
715 fstat(fd, &st);
716 const APL_time_us when = 1000000ULL * st.st_mtime;
717 Workspace::get_v_Quad_TZ().print_timestamp(out << "DUMPED ", when) << endl;
718 }
719
720 FILE * file = fdopen(fd, "r");
721
722 // make sure that filename is not already open (which would indicate
723 // )COPY recursion
724 //
725 loop(f, InputFile::files_todo.size())
726 {
727 if (filename == InputFile::files_todo[f].filename) // same filename
728 {
729 CERR << "*** )COPY " << filename
730 << " would cause recursion (NOT COPIED)" << endl;
731 return;
732 }
733 }
734
735 InputFile fam(filename, file, false, false, true, with_LX);
736 if (object_filter) // therefore )COPY, not )LOAD
737 {
738 loop(o, object_filter->size())
739 fam.add_filter_object((*object_filter)[o]);
740 fam.set_COPY();
741 ++Bif_F1_EXECUTE::copy_pending;
742 }
743 InputFile::files_todo.insert(InputFile::files_todo.begin(), fam);
744 }
745 //-----------------------------------------------------------------------------
746 /// a streambuf that escapes certain HTML characters
747 class HTML_streambuf : public streambuf
748 {
749 public:
750 /// constructor
HTML_streambuf(ofstream & outf)751 HTML_streambuf(ofstream & outf)
752 : out_file(outf)
753 {}
754
755 /// overloaded streambuf::overflow()
overflow(int c)756 virtual int overflow(int c)
757 {
758 switch(c & 0xFF)
759 {
760 case '#': out_file << "#"; break;
761 case '%': out_file << "%"; break;
762 case '&': out_file << "&"; break;
763 case '<': out_file << "<"; break;
764 case '>': out_file << ">"; break;
765 default: out_file << char(c & 0xFF);
766 }
767 return 0;
768 }
769
770 protected:
771 /// the output file
772 ofstream & out_file;
773 };
774
775 /// a stream that escapes certain HTML characters
776 class HTML_stream : public ostream
777 {
778 public:
779 /// constructor
HTML_stream(HTML_streambuf * html_out)780 HTML_stream(HTML_streambuf * html_out)
781 : ostream(html_out)
782 {}
783 };
784 //-----------------------------------------------------------------------------
785 void
dump_WS(ostream & out,LibRef libref,const UCS_string & wsname,bool html,bool silent)786 Workspace::dump_WS(ostream & out, LibRef libref, const UCS_string & wsname,
787 bool html, bool silent)
788 {
789 // )DUMP
790 // )DUMP wsname
791 // )DUMP libnum wsname
792
793 const char * extension = html ? ".html" : ".apl";
794 UTF8_string filename = LibPaths::get_lib_filename(libref, wsname, false,
795 extension, 0);
796 if (wsname.compare(UCS_string("CLEAR WS")) == 0) // don't save CLEAR WS
797 {
798 COUT << "NOT DUMPED: THIS WS IS " << wsname << endl;
799 MORE_ERROR() <<
800 "the workspace was not dumped because 'CLEAR WS' is a special\n"
801 "workspace name that cannot be dumped. Use )WSID <name> first.";
802 return;
803 }
804
805 if (uprefs.backup_before_save && backup_existing_file(filename.c_str()))
806 {
807 COUT << "NOT DUMPED: COULD NOT CREATE BACKUP FILE "
808 << filename << endl;
809 return;
810 }
811
812 ofstream outf(filename.c_str(), ofstream::out);
813
814 if (!outf.is_open()) // open failed
815 {
816 CERR << "Unable to )DUMP workspace '" << wsname
817 << "': " << strerror(errno) << "." << endl
818 << " NOTE: filename: " << filename << endl;
819 return;
820 }
821
822 HTML_streambuf hout_buf(outf);
823 HTML_stream hout(&hout_buf);
824 ostream * sout = &outf;
825 if (html) sout = &hout;
826 // print header line, workspace name, time, and date to outf
827 //
828 const APL_time_us offset = get_v_Quad_TZ().get_offset();
829 const APL_time_us gmt = now();
830 const YMDhmsu time(gmt + 1000000*offset);
831 {
832 if (html)
833 {
834 outf <<
835 "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\"" << endl <<
836 " \"http://www.w3.org/TR/html4/strict.dtd\">" << endl <<
837 "<html>" << endl <<
838 " <head>" << endl <<
839 " <title>" << wsname << ".apl</title> " << endl <<
840 " <meta http-equiv=\"content-type\" " << endl <<
841 " content=\"text/html; charset=UTF-8\">" << endl <<
842 " <meta name=\"author\" content=\"??????\">" << endl <<
843 " <meta name=\"copyright\" content=\"© " << time.year
844 <<" by ??????\">" << endl <<
845 " <meta name=\"date\" content=\"" << time.year << "-"
846 << time.month << "-"
847 << time.day << "\">" << endl <<
848 " <meta name=\"description\"" << endl <<
849 " content=\"??????\">" << endl <<
850 " <meta name=\"keywords\" lang=\"en\"" << endl <<
851 " content=\"??????, APL, GNU\">" << endl <<
852 " </head>" << endl <<
853 " <body><pre>" << endl <<
854 "⍝" << endl <<
855 "⍝ Author: ??????" << endl <<
856 "⍝ Date: " << time.year << "-"
857 << time.month << "-"
858 << time.day << endl <<
859 "⍝ Copyright: Copyright (C) " << time.year << " by ??????" << endl <<
860 "⍝ License: GPL see http://www.gnu.org/licenses/gpl-3.0.en.html"<< endl <<
861 "⍝ Support email: ??????@??????" << endl <<
862 "⍝ Portability: L3 (GNU APL)" << endl <<
863 "⍝" << endl <<
864 "⍝ Purpose:" << endl <<
865 "⍝ ??????" << endl <<
866 "⍝" << endl <<
867 "⍝ Description:" << endl <<
868 "⍝ ??????" << endl <<
869 "⍝" << endl <<
870 endl;
871 }
872 else
873 {
874 outf << "#!" << LibPaths::get_APL_bin_path()
875 << "/" << LibPaths::get_APL_bin_name()
876 << " --script" << endl;
877 }
878
879 *sout << " ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝" << endl
880 << "⍝" << endl
881 << "⍝ " << wsname << " ";
882 get_v_Quad_TZ().print_timestamp(*sout, gmt) << endl
883 << " ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝" << endl
884 << endl;
885 }
886
887 int function_count = 0;
888 int variable_count = 0;
889 the_workspace.symbol_table.dump(*sout, function_count, variable_count);
890 the_workspace.dump_commands(*sout);
891
892 // system variables
893 //
894 #define ro_sv_def(x, _str, _txt)
895 #define rw_sv_def(x, _str, _txt) if (ID_ ## x != ID_Quad_SYL) \
896 { get_v_ ## x().dump(*sout); ++variable_count; }
897 #include "SystemVariable.def"
898
899 if (html) outf << endl << "⍝ EOF </pre></body></html>" << endl;
900
901 if (silent)
902 {
903 get_v_Quad_TZ().print_timestamp(out, gmt) << endl;
904 }
905 else
906 {
907 out << "DUMPED WORKSPACE '" << wsname << "'" << endl
908 << " TO FILE '" << filename << "'" << endl
909 << " (" << function_count << " FUNCTIONS, " << variable_count
910 << " VARIABLES)" << endl;
911 }
912 }
913 //-----------------------------------------------------------------------------
914 void
dump_commands(ostream & out)915 Workspace::dump_commands(ostream & out)
916 {
917 vector<Command::user_command> & cmds = get_user_commands();
918
919 loop(c, cmds.size())
920 out << "]USERCMD " << cmds[c].prefix
921 << " " << cmds[c].apl_function
922 << " " << cmds[c].mode << endl;
923
924 if (cmds.size()) out << endl;
925 }
926 //-----------------------------------------------------------------------------
927 // )LOAD WS, set ⎕LX of loaded WS on success
928 void
load_WS(ostream & out,LibRef libref,const UCS_string & wsname,UCS_string & quad_lx,bool silent)929 Workspace::load_WS(ostream & out, LibRef libref, const UCS_string & wsname,
930 UCS_string & quad_lx, bool silent)
931 {
932 // )LOAD wsname wsname /absolute or relative
933 // )LOAD libnum wsname wsname relative
934 //
935 if (UTF8_string(wsname).ends_with(".bak"))
936 {
937 out << "BAD COMMAND+" << endl;
938 MORE_ERROR() << wsname <<
939 " is a backup file! You need to rename it before it can be )LOADed";
940 return;
941 }
942
943 UTF8_string filename = LibPaths::get_lib_filename(libref, wsname, true,
944 ".xml", ".apl");
945
946 int dump_fd = -1;
947 XML_Loading_Archive in(filename.c_str(), dump_fd);
948
949 if (dump_fd != -1) // wsname.apl
950 {
951 the_workspace.clear_WS(out, true);
952
953 Log(LOG_command_IN) out << "LOADING " << wsname << " from file '"
954 << filename << "' ..." << endl;
955
956 load_DUMP(out, filename, dump_fd, do_LX, silent, 0); // closes dump_fd
957
958 // )DUMP files have no )WSID so create one from the filename
959 //
960 const char * wsid_start = strrchr(filename.c_str(), '/');
961 if (wsid_start == 0) wsid_start = filename.c_str();
962 else ++wsid_start; // skip /
963 const char * wsid_end = filename.c_str() + filename.size();
964 if (wsid_end > (wsid_start - 4) &&
965 wsid_end[-4] == '.' &&
966 wsid_end[-3] == 'a' &&
967 wsid_end[-2] == 'p' &&
968 wsid_end[-1] == 'l') wsid_end -= 4; // skip .apl extension
969 const UTF8_string wsid_utf8(utf8P(wsid_start), wsid_end - wsid_start);
970 const UCS_string wsid_ucs(wsid_utf8);
971 wsid(out, wsid_ucs, libref, true);
972
973 // we cant set ⎕LX because it was not executed yet.
974 return;
975 }
976 else // wsname.xml
977 {
978 if (!in.is_open()) // open failed
979 {
980 out << ")LOAD " << wsname << " (file " << filename
981 << ") failed: " << strerror(errno) << endl;
982 return;
983 }
984
985 Log(LOG_command_IN) out << "LOADING " << wsname << " from file '"
986 << filename << "' ..." << endl;
987
988 // got open file. We assume that from here on everything will be fine.
989 // clear current WS and load it from file
990 //
991 the_workspace.clear_WS(out, true);
992 in.read_Workspace(silent);
993 }
994
995 if (Workspace::get_LX().size()) quad_lx = Workspace::get_LX();
996 }
997 //-----------------------------------------------------------------------------
998 void
copy_WS(ostream & out,LibRef libref,const UCS_string & wsname,UCS_string_vector & lib_ws_objects,bool protection)999 Workspace::copy_WS(ostream & out, LibRef libref, const UCS_string & wsname,
1000 UCS_string_vector & lib_ws_objects, bool protection)
1001 {
1002 // )COPY wsname wsname /absolute or relative
1003 // )COPY libnum wsname wsname relative
1004 // )COPY wsname objects... wsname /absolute or relative
1005 // )COPY libnum wsname objects... wsname relative
1006
1007 UTF8_string filename = LibPaths::get_lib_filename(libref, wsname, true,
1008 ".xml", ".apl");
1009
1010 int dump_fd = -1;
1011 XML_Loading_Archive in(filename.c_str(), dump_fd);
1012 if (dump_fd != -1)
1013 {
1014 load_DUMP(out, filename, dump_fd, no_LX, false, &lib_ws_objects);
1015 // load_DUMP closes dump_fd
1016 return;
1017 }
1018
1019 if (!in.is_open()) // open failed: try filename.xml unless already .xml
1020 {
1021 CERR << ")COPY " << wsname << " (file " << filename
1022 << ") failed: " << strerror(errno) << endl;
1023 return;
1024 }
1025
1026 Log(LOG_command_IN) CERR << "LOADING " << wsname << " from file '"
1027 << filename << "' ..." << endl;
1028
1029 in.set_protection(protection, lib_ws_objects);
1030 in.read_vids();
1031 in.read_Workspace(false);
1032 }
1033 //-----------------------------------------------------------------------------
1034 void
wsid(ostream & out,UCS_string arg,LibRef lib,bool silent)1035 Workspace::wsid(ostream & out, UCS_string arg, LibRef lib, bool silent)
1036 {
1037 arg.remove_leading_and_trailing_whitespaces();
1038
1039 if (arg.size() == 0) // inquire workspace name
1040 {
1041 out << "IS " << the_workspace.WS_name << endl;
1042 return;
1043 }
1044
1045 if (lib == LIB_WSNAME) // i.e. arg may start with a library number
1046 {
1047 if (arg[0] >= '0' && arg[0] <= '9') // it does
1048 {
1049 lib = LibRef(arg[0] - '0');
1050 arg.erase(0); // skip the library number
1051 arg.remove_leading_whitespaces(); // and blanks after it
1052 }
1053 else lib = LIB0;
1054 }
1055
1056 loop(a, arg.size())
1057 {
1058 if (arg[a] <= ' ')
1059 {
1060 out << "Bad WS name '" << arg << "'" << endl;
1061 return;
1062 }
1063 }
1064
1065 if (!silent) out << "WAS " << the_workspace.WS_name << endl;
1066
1067 // prepend the lib number unless it is 0.
1068 //
1069 if (lib != LIB0)
1070 {
1071 arg.prepend(UNI_ASCII_SPACE);
1072 arg.prepend(Unicode('0' + lib));
1073 }
1074 the_workspace.WS_name = arg;
1075 }
1076 //-----------------------------------------------------------------------------
1077 UCS_string &
MORE_ERROR()1078 MORE_ERROR()
1079 {
1080 Workspace::more_error().clear();
1081 return Workspace::more_error();
1082 }
1083 //-----------------------------------------------------------------------------
1084
1085