1// This file is part of SmallBASIC
2//
3// pseudo-compiler: Converts the source to byte-code.
4//
5// This program is distributed under the terms of the GPL v2.0 or later
6// Download the GNU Public License (GPL) from www.gnu.org
7//
8// Copyright(C) 2000 Nicholas Christopoulos
9
10#define SCAN_MODULE
11#include "common/sys.h"
12#include "common/device.h"
13#include "common/kw.h"
14#include "common/bc.h"
15#include "common/scan.h"
16#include "common/smbas.h"
17#include "common/units.h"
18#include "common/extlib.h"
19#include "common/messages.h"
20#include "languages/keywords.en.c"
21
22char *comp_array_uds_field(char *p, bc_t *bc);
23void comp_text_line(char *text, int addLineNo);
24bcip_t comp_search_bc(bcip_t ip, code_t code);
25bcip_t comp_next_bc_cmd(bc_t *bc, bcip_t ip);
26extern void expr_parser(bc_t *bc);
27
28const int LEN_OPTION = STRLEN(LCN_OPTION);
29const int LEN_IMPORT = STRLEN(LCN_IMPORT_WRS);
30const int LEN_UNIT = STRLEN(LCN_UNIT_WRS);
31const int LEN_SBASICPATH = STRLEN(LCN_SBASICPATH);
32const int LEN_INC = STRLEN(LCN_INC);
33const int LEN_SUB_WRS = STRLEN(LCN_SUB_WRS);
34const int LEN_FUNC_WRS = STRLEN(LCN_FUNC_WRS);
35const int LEN_DEF_WRS = STRLEN(LCN_DEF_WRS);
36const int LEN_END_WRS = STRLEN(LCN_END_WRS);
37const int LEN_END_SELECT = STRLEN(LCN_END_SELECT);
38const int LEN_END_TRY = STRLEN(LCN_END_TRY);
39const int LEN_PREDEF = STRLEN(LCN_PREDEF);
40const int LEN_QUIET = STRLEN(LCN_QUIET);
41const int LEN_GRMODE = STRLEN(LCN_GRMODE);
42const int LEN_TEXTMODE = STRLEN(LCN_TEXTMODE);
43const int LEN_COMMAND = STRLEN(LCN_COMMAND);
44const int LEN_SHOWPAGE = STRLEN(LCN_SHOWPAGE);
45const int LEN_ANTIALIAS = STRLEN(LCN_ANTIALIAS);
46const int LEN_LDMODULES = STRLEN(LCN_LOAD_MODULES);
47const int LEN_AUTOLOCAL = STRLEN(LCN_AUTOLOCAL);
48const int LEN_AS_WRS = STRLEN(LCN_AS_WRS);
49const int LEN_CONST = STRLEN(LCN_CONST);
50
51#define KW_TYPE_LINE_BYTES 5
52
53#define SKIP_SPACES(p) \
54 while (*p == ' ' || *p == '\t') { \
55 p++; \
56 }
57
58#define CHKOPT(x) \
59 (strncmp(p, (x), strlen((x))) == 0)
60
61#define GROWSIZE 128
62#define MAX_PARAMS 256
63
64// the offset to a single byte stored in an 32 bit field
65#if defined(CPU_BIGENDIAN)
66 #define BYTE_OFFSET_IN_32 4
67#else
68 #define BYTE_OFFSET_IN_32 1
69#endif
70
71typedef struct {
72 byte *code;
73 uint32_t size;
74} byte_code;
75
76void err_wrongproc(const char *name) {
77 sc_raise(MSG_WRONG_PROCNAME, name);
78}
79
80void err_comp_missing_rp() {
81 sc_raise(MSG_EXP_MIS_RP);
82}
83
84void err_comp_missing_lp() {
85 sc_raise(MSG_EXP_MIS_LP);
86}
87
88void err_comp_missing_rb() {
89 sc_raise(MSG_EXP_MIS_RB);
90}
91
92void err_comp_label_not_def(const char *name) {
93 sc_raise(MSG_LABEL_NOT_DEFINED, name);
94}
95
96// strcat replacement when p is incremented from dest
97void memcat(char *dest, char *p) {
98 int lenb = strlen(dest);
99 int lenp = strlen(p);
100 memmove(dest + lenb, p, lenp);
101 dest[lenb + lenp] = '\0';
102}
103
104/*
105 * reset the external proc/func lists
106 */
107void comp_reset_externals(void) {
108 // reset functions
109 if (comp_extfunctable) {
110 free(comp_extfunctable);
111 }
112 comp_extfunctable = NULL;
113 comp_extfunccount = comp_extfuncsize = 0;
114
115 // reset procedures
116 if (comp_extproctable) {
117 free(comp_extproctable);
118 }
119 comp_extproctable = NULL;
120 comp_extproccount = comp_extprocsize = 0;
121}
122
123// update imports table
124bc_symbol_rec_t *add_imptable_rec(const char *proc_name, int lib_id, int symbol_type) {
125 bc_symbol_rec_t *sym = (bc_symbol_rec_t *)malloc(sizeof(bc_symbol_rec_t));
126 memset(sym, 0, sizeof(bc_symbol_rec_t));
127
128 strlcpy(sym->symbol, proc_name, sizeof(sym->symbol)); // symbol name
129 sym->type = symbol_type; // symbol type
130 sym->lib_id = lib_id; // library id
131 sym->sym_id = comp_impcount; // symbol index
132
133 if (comp_imptable.count) {
134 comp_imptable.elem = (bc_symbol_rec_t **)realloc(comp_imptable.elem,
135 (comp_imptable.count + 1) * sizeof(bc_symbol_rec_t *));
136 } else {
137 comp_imptable.elem = (bc_symbol_rec_t **)malloc(sizeof(bc_symbol_rec_t *));
138 }
139 comp_imptable.elem[comp_imptable.count] = sym;
140 comp_imptable.count++;
141 return sym;
142}
143
144// store lib-record
145void add_libtable_rec(const char *lib, const char *alias, int uid, int type) {
146 bc_lib_rec_t *imlib = (bc_lib_rec_t *)malloc(sizeof(bc_lib_rec_t));
147 memset(imlib, 0, sizeof(bc_lib_rec_t));
148
149 strlcpy(imlib->lib, lib, sizeof(imlib->lib));
150 strlcpy(imlib->alias, alias, sizeof(imlib->alias));
151 imlib->id = uid;
152 imlib->type = type;
153
154 if (comp_libtable.count) {
155 comp_libtable.elem = (bc_lib_rec_t **)realloc(comp_libtable.elem,
156 (comp_libtable.count + 1) * sizeof(bc_lib_rec_t *));
157 } else {
158 comp_libtable.elem = (bc_lib_rec_t **)malloc(sizeof(bc_lib_rec_t *));
159 }
160 comp_libtable.elem[comp_libtable.count] = imlib;
161 comp_libtable.count++;
162}
163
164/*
165 * add an external procedure to the list
166 */
167int comp_add_external_proc(const char *proc_name, int lib_id) {
168 if (comp_extproctable == NULL) {
169 comp_extprocsize = 16;
170 comp_extproctable = (ext_proc_node_t *)malloc(sizeof(ext_proc_node_t) * comp_extprocsize);
171 } else if (comp_extprocsize <= (comp_extproccount + 1)) {
172 comp_extprocsize += 16;
173 comp_extproctable = (ext_proc_node_t *)realloc(comp_extproctable,
174 sizeof(ext_proc_node_t) * comp_extprocsize);
175 }
176
177 comp_extproctable[comp_extproccount].lib_id = lib_id;
178 comp_extproctable[comp_extproccount].symbol_index = comp_impcount;
179 strlcpy(comp_extproctable[comp_extproccount].name, proc_name, sizeof(comp_extproctable[0].name));
180 strupper(comp_extproctable[comp_extproccount].name);
181 comp_extproccount++;
182
183 add_imptable_rec(proc_name, lib_id, stt_procedure);
184 return comp_extproccount - 1;
185}
186
187/*
188 * Add an external function to the list
189 */
190int comp_add_external_func(const char *func_name, int lib_id) {
191 if (comp_extfunctable == NULL) {
192 comp_extfuncsize = 16;
193 comp_extfunctable = (ext_func_node_t *)malloc(sizeof(ext_func_node_t) * comp_extfuncsize);
194 } else if (comp_extfuncsize <= (comp_extfunccount + 1)) {
195 comp_extfuncsize += 16;
196 comp_extfunctable = (ext_func_node_t *)realloc(comp_extfunctable,
197 sizeof(ext_func_node_t) * comp_extfuncsize);
198 }
199
200 comp_extfunctable[comp_extfunccount].lib_id = lib_id;
201 comp_extfunctable[comp_extfunccount].symbol_index = comp_impcount;
202 strlcpy(comp_extfunctable[comp_extfunccount].name, func_name, sizeof(comp_extfunctable[0].name));
203 strupper(comp_extfunctable[comp_extfunccount].name);
204 comp_extfunccount++;
205
206 add_imptable_rec(func_name, lib_id, stt_function);
207 return comp_extfunccount - 1;
208}
209
210/*
211 * returns the external procedure id
212 */
213int comp_is_external_proc(const char *name) {
214 int i;
215
216 for (i = 0; i < comp_extproccount; i++) {
217 if (strcasecmp(comp_extproctable[i].name, name) == 0) {
218 return i;
219 }
220 }
221 return -1;
222}
223
224/*
225 * returns the external function id
226 */
227int comp_is_external_func(const char *name) {
228 int i;
229
230 for (i = 0; i < comp_extfunccount; i++) {
231 if (strcasecmp(comp_extfunctable[i].name, name) == 0) {
232 return i;
233 }
234 }
235 return -1;
236}
237
238/*
239 * Notes:
240 * block_level = the depth of nested block
241 * block_id = unique number of each block (based on stack use)
242 *
243 * Example:
244 * ? xxx ' level 0, id 0
245 * for i=1 to 20 ' level 1, id 1
246 * ? yyy ' level 1, id 1
247 * if a=1 ' level 2, id 2 (our IF uses stack)
248 * ... ' level 2, id 2
249 * else ' level 2, id 2 // not 3
250 * ... ' level 2, id 2
251 * fi ' level 2, id 2
252 * if a=2 ' level 2, id 3
253 * ... ' level 2, id 3
254 * fi ' level 2, id 3
255 * ? zzz ' level 1, id 1
256 * next ' level 1, id 1
257 * ? ooo ' level 0, id 0
258 */
259
260/*
261 * prepare name (keywords, variables, labels, proc/func names)
262 */
263char *comp_prepare_name(char *dest, const char *source, int size) {
264 char *p = (char *)source;
265 SKIP_SPACES(p);
266
267 strncpy(dest, p, size);
268 dest[size] = '\0';
269 p = dest;
270 while (*p && (is_alpha(*p) || is_digit(*p) || *p == '$' || *p == '/' || *p == '_' || *p == '.')) {
271 p++;
272 }
273 *p = '\0';
274
275 str_alltrim(dest);
276 return dest;
277}
278
279/*
280 * returns the ID of the label. If there is no one, then it creates one
281 */
282bid_t comp_label_getID(const char *label_name) {
283 bid_t idx = -1, i;
284 char name[SB_KEYWORD_SIZE + 1];
285
286 comp_prepare_name(name, label_name, SB_KEYWORD_SIZE);
287
288 for (i = 0; i < comp_labtable.count; i++) {
289 if (strcmp(comp_labtable.elem[i]->name, name) == 0) {
290 idx = i;
291 break;
292 }
293 }
294
295 if (idx == -1) {
296 if (opt_verbose) {
297 log_printf(MSG_NEW_LABEL, comp_line, name, comp_labcount);
298 }
299
300 comp_label_t *label = (comp_label_t *)malloc(sizeof(comp_label_t));
301 memset(label, 0, sizeof(comp_label_t));
302 strcpy(label->name, name);
303 label->ip = INVALID_ADDR;
304 label->dp = INVALID_ADDR;
305 label->level = comp_block_level;
306 label->block_id = comp_block_id;
307
308 if (comp_labtable.count == comp_labtable.size) {
309 comp_labtable.size += GROWSIZE;
310 comp_labtable.elem = realloc(comp_labtable.elem, comp_labtable.size * sizeof(comp_label_t *));
311 }
312
313 comp_labtable.elem[comp_labtable.count] = label;
314 idx = comp_labtable.count;
315 comp_labtable.count++;
316 }
317
318 return idx;
319}
320
321/*
322 * set LABEL's position (IP)
323 */
324void comp_label_setip(bid_t idx) {
325 if (idx < comp_labtable.count) {
326 comp_labtable.elem[idx]->ip = comp_prog.count;
327 comp_labtable.elem[idx]->dp = comp_data.count;
328 comp_labtable.elem[idx]->level = comp_block_level;
329 comp_labtable.elem[idx]->block_id = comp_block_id;
330 }
331}
332
333/*
334 * returns the full-path UDP/UDF name
335 */
336void comp_prepare_udp_name(char *dest, const char *basename) {
337 char tmp[SB_SOURCELINE_SIZE + 1];
338
339 comp_prepare_name(tmp, baseof(basename, '/'), SB_KEYWORD_SIZE);
340 if (comp_proc_level) {
341 sprintf(dest, "%s/%s", comp_bc_proc, tmp);
342 } else {
343 strcpy(dest, tmp);
344 }
345}
346
347/*
348 * returns the ID of the UDP/UDF
349 */
350bid_t comp_udp_id(const char *proc_name, int scan_tree) {
351 bid_t i;
352 char *name = comp_bc_temp;
353
354 if (scan_tree) {
355 char base[SB_KEYWORD_SIZE + 1];
356 comp_prepare_name(base, baseof(proc_name, '/'), SB_KEYWORD_SIZE);
357 char *root = strdup(comp_bc_proc);
358 int len;
359 do {
360 // (nested procs) move root down
361 len = strlen(root);
362 if (len != 0) {
363 sprintf(name, "%s/%s", root, base);
364 char *p = strrchr(root, '/');
365 if (p) {
366 *p = '\0';
367 } else {
368 strcpy(root, "");
369 }
370 } else {
371 strcpy(name, base);
372 }
373 // search on local
374 for (i = 0; i < comp_udpcount; i++) {
375 if (strcmp(comp_udptable[i].name, name) == 0) {
376 free(root);
377 return i;
378 }
379 }
380 } while (len);
381
382 // not found
383 free(root);
384 } else {
385 comp_prepare_udp_name(name, proc_name);
386
387 // search on local
388 for (i = 0; i < comp_udpcount; i++) {
389 if (strcmp(comp_udptable[i].name, name) == 0) {
390 return i;
391 }
392 }
393 }
394
395 return -1;
396}
397
398/*
399 * creates a new UDP/UDF node
400 * and returns the new ID
401 */
402bid_t comp_add_udp(const char *proc_name) {
403 char *name = comp_bc_temp;
404 bid_t idx = -1, i;
405 comp_prepare_udp_name(name, proc_name);
406
407 /*
408 * #if !defined(OS_LIMITED) // check variables for conflict for ( i =
409 * 0; i < comp_varcount; i ++ ) { if ( strcmp(comp_vartable[i].name,
410 * name) == 0 ) { sc_raise("User-defined function/procedure name,
411 * '%s', conflicts with variable", name); break; } } #endif
412 */
413
414 // search
415 for (i = 0; i < comp_udpcount; i++) {
416 if (strcmp(comp_udptable[i].name, name) == 0) {
417 idx = i;
418 break;
419 }
420 }
421
422 if (idx == -1) {
423 if (comp_udpcount >= comp_udpsize) {
424 comp_udpsize += GROWSIZE;
425 comp_udptable = realloc(comp_udptable, comp_udpsize * sizeof(comp_udp_t));
426 }
427
428 if (!(is_alpha(name[0]) || name[0] == '_')) {
429 err_wrongproc(name);
430 } else {
431 if (opt_verbose) {
432 log_printf(MSG_NEW_UDP, comp_line, name, comp_udpcount);
433 }
434 comp_udptable[comp_udpcount].name = malloc(strlen(name) + 1);
435 comp_udptable[comp_udpcount].ip = INVALID_ADDR; // bc_prog.count;
436 comp_udptable[comp_udpcount].level = comp_block_level;
437 comp_udptable[comp_udpcount].block_id = comp_block_id;
438 comp_udptable[comp_udpcount].pline = comp_line;
439 strcpy(comp_udptable[comp_udpcount].name, name);
440 idx = comp_udpcount;
441 comp_udpcount++;
442 }
443 }
444
445 return idx;
446}
447
448/*
449 * sets the IP of the user-defined-procedure (or function)
450 */
451bid_t comp_udp_setip(const char *proc_name) {
452 bid_t idx;
453 char *name = comp_bc_temp;
454
455 comp_prepare_udp_name(name, proc_name);
456
457 idx = comp_udp_id(name, 0);
458 if (idx != -1) {
459 comp_udptable[idx].ip = comp_prog.count;
460 comp_udptable[idx].level = comp_block_level;
461 comp_udptable[idx].block_id = comp_block_id;
462 }
463 return idx;
464}
465
466/*
467 * Returns the IP of an UDP/UDF
468 */
469bcip_t comp_udp_getip(const char *proc_name) {
470 bid_t idx;
471 char *name = comp_bc_temp;
472
473 comp_prepare_udp_name(name, proc_name);
474
475 idx = comp_udp_id(name, 1);
476 if (idx != -1) {
477 return comp_udptable[idx].ip;
478 }
479 return INVALID_ADDR;
480}
481
482/*
483 * parameters string-section
484 */
485char *get_param_sect(char *text, const char *delim, char *dest) {
486 char *p = text;
487 char *d = dest;
488 int quotes = 0, level = 0, skip_ch = 0;
489 int curley_brace = 0;
490
491 if (p == NULL) {
492 *dest = '\0';
493 return 0;
494 }
495
496 while (is_space(*p)) {
497 p++;
498 }
499
500 while (*p) {
501 if (quotes) {
502 if (*p == '\\' && (*(p + 1) == '\"' || *(p + 1) == '\\')) {
503 // add the escaped quote or slash and continue
504 *d++ = *p++;
505 } else if (*p == '\"') {
506 quotes = 0;
507 }
508 } else {
509 switch (*p) {
510 case '\"':
511 quotes = 1;
512 break;
513 case '(':
514 level++;
515 break;
516 case ')':
517 level--;
518 break;
519 case '\n':
520 case '\r':
521 skip_ch = 1;
522 break;
523 case '{':
524 curley_brace++;
525 break;
526 case '}':
527 curley_brace--;
528 break;
529 };
530 }
531
532 // delim check
533 if (delim != NULL && level <= 0 && quotes == 0 && curley_brace == 0) {
534 if (strchr(delim, *p) != NULL) {
535 break;
536 }
537 }
538 // copy
539 if (!skip_ch) {
540 *d = *p;
541 d++;
542 } else {
543 skip_ch = 0;
544 }
545 p++;
546 }
547
548 if (quotes) {
549 *d++ = '\"';
550 }
551
552 *d = '\0';
553
554 if (level > 0) {
555 err_comp_missing_rp();
556 }
557 if (level < 0) {
558 err_comp_missing_lp();
559 }
560 if (curley_brace > 0) {
561 err_comp_missing_rb();
562 }
563 str_alltrim(dest);
564 return p;
565}
566
567/*
568 * checking for missing labels
569 */
570int comp_check_labels() {
571 bid_t i;
572
573 for (i = 0; i < comp_labcount; i++) {
574 if (comp_labtable.elem[i]->ip == INVALID_ADDR) {
575 err_comp_label_not_def(comp_labtable.elem[i]->name);
576 return 0;
577 }
578 }
579
580 return 1;
581}
582
583/*
584 * returns 1 if 'name' is a unit, 2 if 'name' c-module otherwise 0
585 */
586int comp_check_lib(const char *name) {
587 char tmp[SB_KEYWORD_SIZE + 1];
588
589 strlcpy(tmp, name, sizeof(tmp));
590 char *p = strchr(tmp, '.');
591 if (p) {
592 *p = '\0';
593 for (int i = 0; i < comp_libcount; i++) {
594 bc_lib_rec_t *lib = comp_libtable.elem[i];
595
596 // remove any file path component from the name
597 char *dir_sep = strrchr(lib->alias, OS_DIRSEP);
598 char *lib_name = dir_sep ? dir_sep + 1 : lib->alias;
599
600 if (strcasecmp(lib_name, tmp) == 0) {
601 return lib->type == 0 ? 2 : 1;
602 }
603 }
604 }
605 return 0;
606}
607
608/**
609 * create a new variable
610 */
611int comp_create_var(const char *name) {
612 int idx = -1;
613 if (!(is_alpha(name[0]) || name[0] == '_')) {
614 sc_raise(MSG_WRONG_VARNAME, name);
615 } else {
616 // realloc table if it is needed
617 if (comp_varcount >= comp_varsize) {
618 comp_varsize += GROWSIZE;
619 comp_vartable = realloc(comp_vartable, comp_varsize * sizeof(comp_var_t));
620 }
621 if (opt_verbose) {
622 log_printf(MSG_NEW_VAR, comp_line, name, comp_varcount);
623 }
624 comp_vartable[comp_varcount].name = malloc(strlen(name) + 1);
625 strcpy(comp_vartable[comp_varcount].name, name);
626 comp_vartable[comp_varcount].dolar_sup = 0;
627 comp_vartable[comp_varcount].lib_id = -1;
628 comp_vartable[comp_varcount].local_id = -1;
629 comp_vartable[comp_varcount].local_proc_level = 0;
630 idx = comp_varcount;
631 comp_varcount++;
632 }
633 return idx;
634}
635
636/**
637 * add external variable
638 */
639int comp_add_external_var(const char *name, int lib_id) {
640 int idx = comp_create_var(name);
641 comp_vartable[idx].lib_id = lib_id;
642
643 if (lib_id & UID_UNIT_BIT) {
644 // update imports table
645 bc_symbol_rec_t *sym = add_imptable_rec(name, lib_id, stt_variable);
646 sym->var_id = idx;
647 }
648
649 return idx;
650}
651
652/*
653 * returns the id of the variable 'name'
654 *
655 * if there is no such variable then creates a new one
656 *
657 * if a new variable must created then if the var_name includes the path then
658 * the new variable created at local space otherwise at globale space
659 */
660bid_t comp_var_getID(const char *var_name) {
661 bid_t idx = -1, i;
662 char tmp[SB_KEYWORD_SIZE + 1];
663 char *name = comp_bc_temp;
664
665 comp_prepare_name(tmp, baseof(var_name, '/'), SB_KEYWORD_SIZE);
666
667 char *dot = strchr(tmp, '.');
668 if (dot != NULL && *(dot + 1) == 0) {
669 // name ends with dot
670 sc_raise(MSG_MEMBER_DOES_NOT_EXIST, tmp);
671 return 0;
672 }
673 //
674 // check for external
675 // external variables are recognized by the 'class' name
676 // example: my_unit.my_var
677 //
678 // If the name is not found in comp_libtable then it
679 // is treated as a structure reference
680 if (dot != NULL) {
681 int module_type = comp_check_lib(tmp);
682 if (module_type) {
683 for (i = 0; i < comp_varcount; i++) {
684 if (strcasecmp(comp_vartable[i].name, tmp) == 0) {
685 return i;
686 }
687 }
688 if (module_type == 2) {
689 *dot = '\0';
690 sc_raise(MSG_MODULE_NO_MEMBER, tmp, dot + 1);
691 } else {
692 sc_raise(MSG_MEMBER_DOES_NOT_EXIST, tmp);
693 }
694 return 0;
695 }
696 }
697 //
698 // search in global name-space
699 //
700 // Note: local space is dynamic,
701 // however a global var-ID per var-name is required
702 //
703 strcpy(name, tmp);
704
705 for (i = 0; i < comp_varcount; i++) {
706 if (strcmp(comp_vartable[i].name, name) == 0) {
707 idx = i;
708 break;
709 }
710
711 if (comp_vartable[i].dolar_sup) {
712 // system variables must be visible with or without '$' suffix
713 char *dollar_name = malloc(strlen(comp_vartable[i].name) + 2);
714 strcpy(dollar_name, comp_vartable[i].name);
715 strcat(dollar_name, "$");
716 if (strcmp(dollar_name, name) == 0) {
717 idx = i;
718 free(dollar_name);
719 break;
720 }
721 free(dollar_name);
722 }
723 }
724
725 if (opt_autolocal) {
726 if (idx == -1) {
727 idx = comp_create_var(tmp);
728 if (comp_bc_proc[0]) {
729 comp_vartable[idx].local_id = idx;
730 comp_vartable[idx].local_proc_level = comp_proc_level;
731 } else {
732 comp_vartable[idx].local_id = -1;
733 }
734 } else if (comp_bc_proc[0] &&
735 comp_vartable[idx].local_id != -1 &&
736 comp_vartable[idx].local_proc_level > comp_proc_level) {
737 // local at higher level now also local at this level
738 comp_vartable[idx].local_proc_level = comp_proc_level;
739 }
740 } else if (idx == -1) {
741 // variable not found; create a new one
742 idx = comp_create_var(tmp);
743 }
744 return idx;
745}
746
747int comp_error_if_keyword(const char *name) {
748 // check if keyword
749 if (!comp_error) {
750 if ((comp_is_func(name) >= 0) ||
751 (comp_is_proc(name) >= 0) ||
752 (comp_is_special_operator(name) >= 0) ||
753 (comp_is_keyword(name) >= 0) ||
754 (comp_is_operator(name) >= 0)) {
755 sc_raise(MSG_IT_IS_KEYWORD, name);
756 }
757 }
758 return comp_error;
759}
760
761/*
762 * add the named variable to the current position in the byte code stream
763 *
764 * if the name 'foo' has already been used in a struct context, eg 'foo.x'
765 * then the foo variable is added as kwTYPE_UDS.
766 *
767 */
768void comp_add_variable(bc_t *bc, const char *var_name) {
769 char *dot = strchr(var_name, '.');
770
771 if (dot != NULL && !comp_check_lib(var_name)) {
772 // uds-element (or sub-element eg foo.x.y.z)
773 // record the uds-parent
774
775 int len = dot - var_name;
776 char name[SB_KEYWORD_SIZE + 1];
777 strncpy(name, var_name, len);
778 name[len] = 0;
779
780 if (comp_error_if_keyword(name)) {
781 return;
782 }
783
784 bid_t var_id = comp_var_getID(name);
785 bc_add_code(bc, kwTYPE_VAR);
786 bc_add_addr(bc, var_id);
787
788 while (dot && dot[0]) {
789 char *dot_end = strchr(dot + 1, '.');
790 if (dot_end) {
791 // next sub-element
792 len = (dot_end - dot) - 1;
793 } else {
794 // final element
795 len = strlen(dot + 1);
796 }
797
798 bc_add_code(bc, kwTYPE_UDS_EL);
799 bc_add_strn(bc, dot + 1, len);
800
801 if (dot_end) {
802 dot = dot_end;
803 } else {
804 dot = NULL;
805 }
806 }
807 } else {
808 // regular variable or uds-container
809 bc_add_code(bc, kwTYPE_VAR);
810 bc_add_addr(bc, comp_var_getID(var_name));
811 }
812}
813
814/*
815 * adds a mark in stack at the current code position
816 */
817void comp_push(bcip_t ip) {
818 comp_pass_node_t *node = (comp_pass_node_t *)malloc(sizeof(comp_pass_node_t));
819 memset(node, 0, sizeof(comp_pass_node_t));
820
821 strlcpy(node->sec, comp_bc_sec, sizeof(node->sec));
822 node->pos = ip;
823 node->level = comp_block_level;
824 node->block_id = comp_block_id;
825 node->line = comp_line;
826
827 if (comp_stack.count == comp_stack.size) {
828 comp_stack.size += GROWSIZE;
829 comp_stack.elem = realloc(comp_stack.elem, comp_stack.size * sizeof(comp_pass_node_t *));
830 }
831
832 comp_stack.elem[comp_stack.count] = node;
833 comp_stack.count++;
834}
835
836/*
837 * returns the keyword code
838 */
839int comp_is_keyword(const char *name) {
840 int i;
841 byte dolar_sup = 0;
842
843 if (name == NULL || name[0] == '\0') {
844 return -1;
845 }
846
847 // Code to enable the $ but not for keywords (INKEY$=INKEY,
848 // PRINT$=PRINT !!!)
849 // I don't want to increase the size of keywords table.
850 int idx = strlen(name) - 1;
851 if (name[idx] == '$') {
852 *((char *)(name + idx)) = '\0';
853 dolar_sup++;
854 }
855
856 for (i = 0; keyword_table[i].name[0] != '\0'; i++) {
857 if (strcmp(keyword_table[i].name, name) == 0) {
858 return keyword_table[i].code;
859 }
860 }
861
862 if (dolar_sup) {
863 *((char *)(name + idx)) = '$';
864 }
865 return -1;
866}
867
868/*
869 * returns the keyword code (buildin functions)
870 */
871bid_t comp_is_func(const char *name) {
872 int i;
873 byte dolar_sup = 0;
874
875 if (name == NULL || name[0] == '\0') {
876 return -1;
877 }
878
879 // Code to enable the $ but not for keywords (INKEY$=INKEY,
880 // PRINT$=PRINT !!!)
881 // I don't want to increase the size of keywords table.
882 int idx = strlen(name) - 1;
883 if (name[idx] == '$') {
884 *((char *)(name + idx)) = '\0';
885 dolar_sup++;
886 }
887
888 for (i = 0; func_table[i].name[0] != '\0'; i++) {
889 if (strcmp(func_table[i].name, name) == 0) {
890 return func_table[i].fcode;
891 }
892 }
893
894 if (dolar_sup) {
895 *((char *)(name + idx)) = '$';
896 }
897
898 return -1;
899}
900
901/*
902 * returns the keyword code (buildin procedures)
903 */
904bid_t comp_is_proc(const char *name) {
905 bid_t i;
906
907 for (i = 0; proc_table[i].name[0] != '\0'; i++) {
908 if (strcmp(proc_table[i].name, name) == 0) {
909 return proc_table[i].pcode;
910 }
911 }
912
913 return -1;
914}
915
916/*
917 * returns the keyword code (special separators)
918 */
919int comp_is_special_operator(const char *name) {
920 int i;
921
922 for (i = 0; spopr_table[i].name[0] != '\0'; i++) {
923 if (strcmp(spopr_table[i].name, name) == 0) {
924 return spopr_table[i].code;
925 }
926 }
927
928 return -1;
929}
930
931/*
932 * returns the keyword code (operators)
933 */
934int comp_is_operator(const char *name) {
935 int i;
936
937 for (i = 0; opr_table[i].name[0] != '\0'; i++) {
938 if (strcmp(opr_table[i].name, name) == 0) {
939 return ((opr_table[i].code << 8) | opr_table[i].opr);
940 }
941 }
942
943 return -1;
944}
945
946/*
947 */
948char *comp_next_char(char *source) {
949 char *p = source;
950
951 while (*p) {
952 if (*p != ' ') {
953 return p;
954 }
955 p++;
956 }
957 return p;
958}
959
960/**
961 * get next word
962 * if buffer's len is zero, then the next element is not a word
963 *
964 * @param text the source
965 * @param dest the buffer to store the result
966 * @return pointer of text to the next element
967 */
968const char *comp_next_word(const char *text, char *dest) {
969 const char *p = text;
970 char *d = dest;
971
972 if (p == NULL) {
973 *dest = '\0';
974 return 0;
975 }
976
977 while (is_space(*p)) {
978 p++;
979 }
980 if (*p == '?') {
981 strcpy(dest, LCN_PRINT);
982 p++;
983 while (is_space(*p)) {
984 p++;
985 }
986 return p;
987 }
988
989 if (*p == '\'' || *p == '#') {
990 strcpy(dest, LCN_REM);
991 p++;
992 while (is_space(*p)) {
993 p++;
994 }
995 return p;
996 }
997
998 if (is_alnum(*p) || *p == '_') {
999 // don't forget the numeric-labels
1000 while (is_alnum(*p) || (*p == '_') || (*p == '.')) {
1001 *d = *p;
1002 d++;
1003 p++;
1004 }
1005 }
1006 // Code to kill the $
1007 // if ( *p == '$' )
1008 // p ++;
1009 // Code to enable the $
1010 if (*p == '$') {
1011 *d++ = *p++;
1012 }
1013 *d = '\0';
1014 while (is_space(*p)) {
1015 p++;
1016 }
1017 return p;
1018}
1019
1020/*
1021 * skips past any leading empty "()" parentheses characters
1022 */
1023char *trim_empty_parentheses(char *text) {
1024 char *result = text;
1025 char *next = comp_next_char(text);
1026 if (*next == '(') {
1027 next = comp_next_char(next + 1);
1028 if (*next == ')') {
1029 result = comp_next_char(next + 1);
1030 }
1031 }
1032 return result;
1033}
1034
1035/*
1036 * return whether the given name is a func or sub
1037 */
1038int comp_is_function(char *name) {
1039 int result = 0;
1040 if (comp_is_proc(name) != -1 ||
1041 comp_is_func(name) != -1 ||
1042 comp_is_external_proc(name) != -1 ||
1043 comp_is_external_func(name) != -1 ||
1044 comp_udp_id(comp_bc_name, 1) != -1) {
1045 result = 1;
1046 }
1047 return result;
1048}
1049
1050/*
1051 * return whether the name is enclosed with parenthesis characters
1052 */
1053int comp_is_parenthesized(char *name) {
1054 int result = 0;
1055 char *p = comp_next_char(name);
1056 if (*p == '(') {
1057 char last = *p;
1058 while (*p) {
1059 if (*p != ' ') {
1060 last = *p;
1061 }
1062 p++;
1063 }
1064 result = (last == ')');
1065 }
1066 return result;
1067}
1068
1069/*
1070 * return whether the following code is a code array declaration
1071 *
1072 * returns true for empty brackets []
1073 */
1074int comp_is_code_array(bc_t *bc, char *p) {
1075 int result = 0;
1076 int is_var = 0;
1077 int last_kw = 0;
1078
1079 for (bcip_t ip = 0; ip < bc->count; ip = comp_next_bc_cmd(bc, ip)) {
1080 last_kw = bc->ptr[ip];
1081 if (bc->ptr[ip] == kwTYPE_VAR) {
1082 is_var = 1;
1083 }
1084 }
1085 if (comp_prog.ptr[comp_prog.count - 1] == '=' && (!bc->count || !is_var)) {
1086 // lvalue assignment is for code array, unless rvalue includes a variable
1087 result = 1;
1088 } else if (last_kw == kwTYPE_LEVEL_BEGIN || last_kw == kwTYPE_SEP) {
1089 // patterns '([' OR ',[' create a code array
1090 result = 1;
1091 } else {
1092 int level = 1;
1093 int count = 0;
1094 while (*p && level) {
1095 switch(*p) {
1096 case '[':
1097 level++;
1098 break;
1099 case ']':
1100 level--;
1101 break;
1102 case ',':
1103 case ';':
1104 result = 1;
1105 break;
1106 default:
1107 count++;
1108 break;
1109 }
1110 p++;
1111 }
1112 if (*p == '.') {
1113 // a[1].foo is not a code array
1114 result = 0;
1115 }
1116 if (!count) {
1117 result = 1;
1118 }
1119 }
1120 return result;
1121}
1122
1123char *comp_scan_json(char *json, bc_t *bc) {
1124 int curley_brace = 1;
1125 char *p = json + 1;
1126
1127 while (*p != '\0' && curley_brace > 0) {
1128 switch (*p) {
1129 case '{':
1130 curley_brace++;
1131 break;
1132 case '}':
1133 curley_brace--;
1134 break;
1135 case V_QUOTE:
1136 // revert hidden quote
1137 *p = '\"';
1138 break;
1139 case V_LINE:
1140 // revert hidden newline
1141 comp_line++;
1142 *p = '\n';
1143 break;
1144 default:
1145 if (strncasecmp("rem ", p, 4) == 0) {
1146 // 'strip' comments
1147 while (*p && *p != V_LINE && *p != '\n') {
1148 *p = ' ';
1149 p++;
1150 }
1151 p--;
1152 }
1153 break;
1154 }
1155 p++;
1156 }
1157 if (curley_brace == 0) {
1158 bc_add_fcode(bc, kwARRAY);
1159 bc_add_code(bc, kwTYPE_LEVEL_BEGIN);
1160 bc_add_strn(bc, json, p - json);
1161 bc_add_code(bc, kwTYPE_LEVEL_END);
1162 } else {
1163 err_comp_missing_rb();
1164 }
1165 return p;
1166}
1167
1168/*
1169 * scan expression
1170 */
1171void comp_expression(char *expr, byte no_parser) {
1172 char *ptr = expr;
1173 int level = 0, check_udf = 0;
1174 int kw_exec_more = 0;
1175 var_int_t lv = 0;
1176 var_num_t dv = 0;
1177 int addr_opr = 0;
1178 bc_t bc;
1179
1180 comp_use_global_vartable = 0; // check local-variables first
1181 str_alltrim(expr);
1182 if (*ptr == '\0') {
1183 return;
1184 }
1185
1186 bc_create(&bc);
1187
1188 while (*ptr) {
1189 if (is_digit(*ptr) || *ptr == '.' || (*ptr == '&' && strchr("XHOB", *(ptr + 1)))) {
1190 // a constant number
1191 int tp;
1192 ptr = get_numexpr(ptr, comp_bc_name, &tp, &lv, &dv);
1193 switch (tp) {
1194 case 1:
1195 bc_add_cint(&bc, lv);
1196 continue;
1197 case 2:
1198 bc_add_creal(&bc, dv);
1199 continue;
1200 default:
1201 sc_raise(MSG_EXP_GENERR);
1202 }
1203 } else if (*ptr == '\'') {
1204 // remarks
1205 break;
1206 } else if (is_alpha(*ptr) || *ptr == '?' || *ptr == '_') {
1207 // a name
1208 ptr = (char *)comp_next_word(ptr, comp_bc_name);
1209 bid_t idx = comp_is_func(comp_bc_name);
1210 // special case for input
1211 if (idx == kwINPUTF) {
1212 if (*comp_next_char(ptr) != '(') {
1213 // INPUT is special separator (OPEN...FOR INPUT...)
1214 idx = -1;
1215 }
1216 }
1217
1218 if (idx != -1) {
1219 // is a function
1220 if (!kw_noarg_func(idx)) {
1221 if (*comp_next_char(ptr) != '(') {
1222 sc_raise(MSG_BF_ARGERR, comp_bc_name);
1223 }
1224 }
1225 if (idx == kwCALLCF) {
1226 bc_add_code(&bc, kwTYPE_CALL_UDF);
1227 bc_add_addr(&bc, idx); // place holder
1228 bc_add_addr(&bc, 0); // return-variable ID
1229 bc_add_code(&bc, kwTYPE_LEVEL_BEGIN);
1230 bc_add_code(&bc, kwTYPE_CALL_PTR);
1231 // next is address
1232 // skip next '(' since we already added kwTYPE_LEVEL_BEGIN
1233 // to allow kwTYPE_CALL_PTR to be the next code
1234 char *par = comp_next_char(ptr);
1235 if (*par == '(') {
1236 ptr = par + 1;
1237 level++;
1238 }
1239 } else {
1240 bc_add_fcode(&bc, idx);
1241 }
1242 check_udf++;
1243 } else {
1244 // check special separators
1245 idx = comp_is_special_operator(comp_bc_name);
1246 if (idx != -1) {
1247 if (idx == kwUSE) {
1248 bc_add_code(&bc, idx);
1249 bc_add_addr(&bc, 0);
1250 bc_add_addr(&bc, 0);
1251 comp_use_global_vartable = 1;
1252 // all the next variables are global (needed for X)
1253 check_udf++;
1254 } else if (idx == kwDO) {
1255 SKIP_SPACES(ptr);
1256 if (strlen(ptr)) {
1257 if (strlen(comp_do_close_cmd)) {
1258 kw_exec_more = 1;
1259 strcpy(comp_bc_tmp2, ptr);
1260 strcat(comp_bc_tmp2, ":");
1261 strcat(comp_bc_tmp2, comp_do_close_cmd);
1262 strcpy(comp_do_close_cmd, "");
1263 } else {
1264 sc_raise(MSG_KEYWORD_DO_ERR);
1265 }
1266 }
1267 break;
1268 } else {
1269 bc_add_code(&bc, idx);
1270 }
1271 } else {
1272 // not a command, check operators
1273 idx = comp_is_operator(comp_bc_name);
1274 if (idx != -1) {
1275 bc_add_code(&bc, idx >> 8);
1276 bc_add_code(&bc, idx & 0xFF);
1277 } else {
1278 // external function
1279 idx = comp_is_external_func(comp_bc_name);
1280 if (idx != -1) {
1281 bc_add_extfcode(&bc, comp_extfunctable[idx].lib_id, comp_extfunctable[idx].symbol_index);
1282 } else {
1283 idx = comp_is_keyword(comp_bc_name);
1284 if (idx == -1) {
1285 idx = comp_is_proc(comp_bc_name);
1286 }
1287 if (idx == kwBYREF) {
1288 bc_add_code(&bc, kwBYREF);
1289 } else if (idx != -1) {
1290 sc_raise(MSG_STATEMENT_ON_RIGHT, comp_bc_name);
1291 } else {
1292 // udf or variable
1293 int udf = comp_udp_id(comp_bc_name, 1);
1294 if (udf != -1) {
1295 // udf
1296 if (addr_opr != 0) {
1297 // pointer to UDF
1298 bc_add_code(&bc, kwTYPE_PTR);
1299 } else {
1300 bc_add_code(&bc, kwTYPE_CALL_UDF);
1301 }
1302 check_udf++;
1303 bc_add_addr(&bc, udf);
1304 bc_add_addr(&bc, 0); // var place holder
1305 ptr = trim_empty_parentheses(ptr);
1306 } else {
1307 // variable
1308 SKIP_SPACES(ptr);
1309 comp_add_variable(&bc, comp_bc_name);
1310 if (ptr[0] == '(' && ptr[1] == ')'
1311 && strchr(comp_bc_name, '.') == NULL) {
1312 // null array on non UDS
1313 ptr += 2;
1314 } else if (ptr[0] == '[') {
1315 // array element using '['
1316 ptr++;
1317 level++;
1318 bc_add_code(&bc, kwTYPE_LEVEL_BEGIN);
1319 }
1320 }
1321 }
1322 }
1323 }
1324 }
1325 }
1326 addr_opr = 0;
1327 // end isalpha block
1328 } else if (*ptr == ',' || *ptr == ';' || *ptr == '#') {
1329 // parameter separator
1330 bc_add_code(&bc, kwTYPE_SEP);
1331 bc_add_code(&bc, *ptr);
1332 ptr++;
1333 } else if (*ptr == '\"') {
1334 // string
1335 ptr = bc_store_string(&bc, ptr);
1336 } else if (*ptr == '[') {
1337 // potential code-defined array
1338 ptr++;
1339 level++;
1340 // can't be a code array if this is already part of a variable
1341 if (comp_is_code_array(&bc, ptr)) {
1342 // otherwise treat as array index
1343 bc_add_fcode(&bc, kwCODEARRAY);
1344 }
1345 bc_add_code(&bc, kwTYPE_LEVEL_BEGIN);
1346 } else if (*ptr == '(') {
1347 // parenthesis
1348 ptr++;
1349 level++;
1350 bc_add_code(&bc, kwTYPE_LEVEL_BEGIN);
1351 } else if (*ptr == ')' || *ptr == ']') {
1352 // parenthesis
1353 bc_add_code(&bc, kwTYPE_LEVEL_END);
1354 level--;
1355 ptr++;
1356 if (*ptr == '.') {
1357 ptr = comp_array_uds_field(ptr + 1, &bc);
1358 }
1359 } else if (*ptr == '{') {
1360 ptr = comp_scan_json(ptr, &bc);
1361 check_udf++;
1362 } else if (*ptr == V_LINE) {
1363 comp_line++;
1364 ptr++;
1365 } else if (is_space(*ptr)) {
1366 // null characters
1367 ptr++;
1368 } else {
1369 // operators
1370 if (*ptr == '+' || *ptr == '-') {
1371 bc_add_code(&bc, kwTYPE_ADDOPR);
1372 bc_add_code(&bc, *ptr);
1373 } else if (*ptr == '*' || *ptr == '/' || *ptr == '\\' || *ptr == '%') {
1374 bc_add_code(&bc, kwTYPE_MULOPR);
1375 bc_add_code(&bc, *ptr);
1376 } else if (*ptr == '^') {
1377 bc_add_code(&bc, kwTYPE_POWOPR);
1378 bc_add_code(&bc, *ptr);
1379 } else if (strncmp(ptr, "<=", 2) == 0 || strncmp(ptr, "=<", 2) == 0) {
1380 bc_add_code(&bc, kwTYPE_CMPOPR);
1381 bc_add_code(&bc, OPLOG_LE);
1382 ptr++;
1383 } else if (strncmp(ptr, ">=", 2) == 0 || strncmp(ptr, "=>", 2) == 0) {
1384 bc_add_code(&bc, kwTYPE_CMPOPR);
1385 bc_add_code(&bc, OPLOG_GE);
1386 ptr++;
1387 } else if (strncmp(ptr, "<>", 2) == 0 || strncmp(ptr, "!=", 2) == 0) {
1388 bc_add_code(&bc, kwTYPE_CMPOPR);
1389 bc_add_code(&bc, OPLOG_NE);
1390 ptr++;
1391 } else if (strncmp(ptr, "<<", 2) == 0) {
1392 ptr += 2;
1393 SKIP_SPACES(ptr);
1394 if (strlen(ptr)) {
1395 kw_exec_more = 1;
1396 strcpy(comp_bc_tmp2, comp_bc_name);
1397 strcat(comp_bc_tmp2, " << ");
1398 strcat(comp_bc_tmp2, ptr);
1399 } else {
1400 sc_raise(MSG_OPR_APPEND_ERR);
1401 }
1402 break;
1403 } else if (strncmp(ptr, "==", 2) == 0) {
1404 // support == syntax to prevent java or c programmers
1405 // getting used to single = thus causing embarrasing
1406 // coding errors in their normal work :)
1407 bc_add_code(&bc, kwTYPE_CMPOPR);
1408 bc_add_code(&bc, *ptr);
1409 ptr++;
1410 } else if (*ptr == '=' || *ptr == '>' || *ptr == '<') {
1411 bc_add_code(&bc, kwTYPE_CMPOPR);
1412 bc_add_code(&bc, *ptr);
1413 } else if (strncmp(ptr, "&&", 2) == 0 || strncmp(ptr, "||", 2) == 0) {
1414 bc_add_code(&bc, kwTYPE_LOGOPR);
1415 bc_add_code(&bc, *ptr);
1416 ptr++;
1417 } else if (*ptr == '&') {
1418 bc_add_code(&bc, kwTYPE_LOGOPR);
1419 bc_add_code(&bc, OPLOG_BAND);
1420 } else if (*ptr == '|') {
1421 bc_add_code(&bc, kwTYPE_LOGOPR);
1422 bc_add_code(&bc, OPLOG_BOR);
1423 } else if (*ptr == '~') {
1424 bc_add_code(&bc, kwTYPE_UNROPR);
1425 bc_add_code(&bc, OPLOG_INV);
1426 } else if (*ptr == '!') {
1427 bc_add_code(&bc, kwTYPE_UNROPR);
1428 bc_add_code(&bc, *ptr);
1429 } else if (*ptr == '@') {
1430 addr_opr = 1;
1431 } else {
1432 sc_raise(MSG_WRONG_OPR, *ptr);
1433 }
1434 ptr++;
1435 }
1436 };
1437
1438 if (level) {
1439 sc_raise(MSG_EXP_MIS_RP);
1440 }
1441 if (!comp_error) {
1442 if (no_parser == 0) {
1443 // optimization
1444 bc_eoc(&bc);
1445 // printf("=== before:\n"); hex_dump(bc.ptr, bc.count);
1446 expr_parser(&bc);
1447 // printf("=== after:\n"); hex_dump(bc.ptr, bc.count);
1448 }
1449 if (bc.count) {
1450 bcip_t stip = comp_prog.count;
1451 bc_append(&comp_prog, &bc); // merge code segments
1452
1453 // update pass2 stack-nodes
1454 if (check_udf) {
1455 bcip_t cip = stip;
1456 while ((cip = comp_search_bc(cip, kwUSE)) != INVALID_ADDR) {
1457 comp_push(cip);
1458 cip += (1 + ADDRSZ + ADDRSZ);
1459 }
1460
1461 cip = stip;
1462 while ((cip = comp_search_bc(cip, kwTYPE_CALL_UDF)) != INVALID_ADDR) {
1463 comp_push(cip);
1464 cip += (1 + ADDRSZ + ADDRSZ);
1465 }
1466
1467 cip = stip;
1468 while ((cip = comp_search_bc(cip, kwTYPE_PTR)) != INVALID_ADDR) {
1469 comp_push(cip);
1470 cip += (1 + ADDRSZ + ADDRSZ);
1471 }
1472 }
1473 }
1474
1475 bc_eoc(&comp_prog);
1476 }
1477 // clean-up
1478 comp_use_global_vartable = 0; // check local-variables first
1479 bc_destroy(&bc);
1480
1481 // do additional steps
1482 if (kw_exec_more) {
1483 comp_text_line(comp_bc_tmp2, 0);
1484 }
1485}
1486
1487/*
1488 * Converts DATA commands to bytecode
1489 */
1490void comp_data_seg(char *source) {
1491 char *ptr = source;
1492 char *commap;
1493 var_int_t lv = 0;
1494 var_num_t dv = 0;
1495 double sign = 1;
1496 char *tmp = comp_bc_temp;
1497 int quotes;
1498 int tp;
1499
1500 while (*ptr) {
1501 SKIP_SPACES(ptr);
1502
1503 if (*ptr == '\0') {
1504 break;
1505 } else if (*ptr == ',') {
1506 bc_eoc(&comp_data);
1507 ptr++;
1508 } else {
1509 // find the end of the element
1510 commap = ptr;
1511 quotes = 0;
1512 while (*commap) {
1513 if (*commap == '\"') {
1514 quotes = !quotes;
1515 } else if ((*commap == ',') && (quotes == 0)) {
1516 break;
1517 }
1518 commap++;
1519 }
1520 if (*commap == '\0') {
1521 commap = NULL;
1522 }
1523 if (commap != NULL) {
1524 *commap = '\0';
1525 }
1526 if ((*ptr == '-' || *ptr == '+') && strchr("0123456789.", *(ptr + 1))) {
1527 if (*ptr == '-') {
1528 sign = -1;
1529 }
1530 ptr++;
1531 } else {
1532 sign = 1;
1533 }
1534 if (is_digit(*ptr) || *ptr == '.' || (*ptr == '&' && strchr("XHOB", *(ptr + 1)))) {
1535 // number - constant
1536 ptr = get_numexpr(ptr, tmp, &tp, &lv, &dv);
1537 switch (tp) {
1538 case 1:
1539 bc_add_cint(&comp_data, lv * sign);
1540 break;
1541 case 2:
1542 bc_add_creal(&comp_data, dv * sign);
1543 break;
1544 default:
1545 sc_raise(MSG_EXP_GENERR);
1546 }
1547 } else {
1548 // add it as string
1549 if (*ptr != '\"') {
1550 strcpy(tmp, "\"");
1551 strcat(tmp, ptr);
1552 strcat(tmp, "\"");
1553 bc_store_string(&comp_data, tmp);
1554 if (commap) {
1555 ptr = commap;
1556 } else {
1557 ptr = ptr + strlen(ptr);
1558 }
1559 } else {
1560 ptr = bc_store_string(&comp_data, ptr);
1561 }
1562 }
1563
1564 if (commap != NULL) {
1565 *commap = ',';
1566 }
1567 }
1568 }
1569
1570 bc_eoc(&comp_data);
1571}
1572
1573/*
1574 * Scans the 'source' for "names" separated by ',' and returns
1575 * the elements (pointer in source) into args array.
1576 *
1577 * Returns the number of items
1578 */
1579int comp_getlist(char *source, char_p_t *args, int maxarg) {
1580 int count = 0;
1581 char *p = source;
1582 char *ps = p;
1583 int square = 0;
1584 int round = 0;
1585 int brace = 0;
1586
1587 while (*p && count < maxarg) {
1588 switch (*p) {
1589 case '[':
1590 square++;
1591 break;
1592 case ']':
1593 square--;
1594 break;
1595 case '(':
1596 round++;
1597 break;
1598 case ')':
1599 round--;
1600 break;
1601 case '{':
1602 brace++;
1603 break;
1604 case '}':
1605 brace--;
1606 break;
1607 case ',':
1608 if (!square && !round && !brace) {
1609 *p = '\0';
1610 SKIP_SPACES(ps);
1611 args[count] = ps;
1612 count++;
1613 ps = p + 1;
1614 }
1615 break;
1616 default:
1617 break;
1618 }
1619 p++;
1620 }
1621
1622 if (*ps) {
1623 if (count == maxarg) {
1624 sc_raise(MSG_PARNUM_LIMIT, maxarg);
1625 } else {
1626 SKIP_SPACES(ps);
1627 if (*ps) {
1628 *p = '\0';
1629 args[count] = ps;
1630 count++;
1631 }
1632 }
1633 }
1634 return count;
1635}
1636
1637/*
1638 * returns a list of names
1639 *
1640 * the list is included between sep[0] and sep[1] characters
1641 * each element is separated by ',' characters
1642 *
1643 * the 'source' is the raw string (null chars will be placed at the end of each name)
1644 * the 'args' is the names (pointers on the 'source')
1645 * maxarg is the maximum number of names (actually the size of args)
1646 * the count is the number of names which are found by this routine.
1647 *
1648 * returns the next position in 'source' (after the sep[1])
1649 */
1650char *comp_getlist_insep(char *source, char_p_t *args, char *sep, int maxarg, int *count) {
1651 *count = 0;
1652 char *p = strchr(source, sep[0]);
1653
1654 if (p) {
1655 int level = 1;
1656 char *ps = p + 1;
1657 p++;
1658
1659 while (*p) {
1660 if (*p == sep[1]) {
1661 level--;
1662 if (level == 0) {
1663 break;
1664 }
1665 } else if (*p == sep[0]) {
1666 level++;
1667 }
1668 p++;
1669 }
1670
1671 if (*p == sep[1]) {
1672 *p = '\0';
1673 if (strlen(ps)) {
1674 SKIP_SPACES(ps);
1675 if (strlen(ps)) {
1676 *count = comp_getlist(ps, args, maxarg);
1677 } else {
1678 sc_raise(MSG_NIL_PAR_ERR);
1679 }
1680 }
1681 } else {
1682 sc_raise(MSG_MISSING_CHAR, sep[1]);
1683 }
1684 } else {
1685 p = source;
1686 }
1687 return p;
1688}
1689
1690/*
1691 * Single-line IFs
1692 *
1693 * converts the string from single-line IF to normal IF syntax
1694 * returns true if there is a single-line IF.
1695 *
1696 * IF expr THEN ... ---> IF expr THEN (:) .... (:FI)
1697 * IF expr THEN ... ELSE ... ---> IF expr THEN (:) .... (:ELSE:) ... (:FI)
1698 */
1699int comp_single_line_if(char *text) {
1700 // *text points to 'expr'
1701 char *p = text;
1702 char *pthen, *pelse;
1703 char buf[SB_SOURCELINE_SIZE + 1];
1704
1705 if (comp_error) {
1706 return 0;
1707 }
1708 pthen = p;
1709 do {
1710 pthen = strstr(pthen + 1, LCN_THEN_WS);
1711 if (pthen) {
1712 // store the expression
1713 SKIP_SPACES(p);
1714 strlcpy(buf, p, sizeof(buf));
1715 p = strstr(buf, LCN_THEN_WS);
1716 *p = '\0';
1717
1718 // check for ':'
1719 p = pthen + 6;
1720 SKIP_SPACES(p);
1721
1722 if (*p != ':' && *p != '\0') {
1723 // store the IF
1724 comp_block_level++;
1725 comp_block_id++;
1726 comp_push(comp_prog.count);
1727 bc_add_ctrl(&comp_prog, kwIF, 0, 0);
1728
1729 comp_expression(buf, 0);
1730 if (comp_error) {
1731 return 0;
1732 }
1733 // store EOC
1734 bc_eoc(&comp_prog);
1735
1736 // auto-goto
1737 p = pthen + 6;
1738 SKIP_SPACES(p);
1739
1740 if (is_digit(*p)) {
1741 // add goto
1742 strlcpy(buf, LCN_GOTO_WRS, sizeof(buf));
1743 strlcat(buf, p, sizeof(buf));
1744 } else {
1745 strlcpy(buf, p, sizeof(buf));
1746 }
1747 // ELSE command
1748 // If there are more inline-ifs (nested) the ELSE belongs
1749 // to the first IF (that's an error)
1750 pelse = strstr(buf + 1, LCN_ELSE);
1751 if (pelse) {
1752 do {
1753 if ((*(pelse - 1) == ' ' || *(pelse - 1) == '\t') &&
1754 (*(pelse + 4) == ' ' || *(pelse + 4) == '\t')) {
1755 *pelse = '\0';
1756
1757 // scan the commands before ELSE
1758 comp_text_line(buf, 0);
1759 // add EOC
1760 bc_eoc(&comp_prog);
1761
1762 // auto-goto
1763 strcpy(buf, LCN_ELSE);
1764 strcat(buf, ":");
1765 p = pelse + 4;
1766 SKIP_SPACES(p);
1767 if (is_digit(*p)) {
1768 // add goto
1769 strcat(buf, LCN_GOTO_WRS);
1770 memcat(buf, p);
1771 } else {
1772 memcat(buf, p);
1773 }
1774 break;
1775 } else {
1776 pelse = strstr(pelse + 1, LCN_ELSE);
1777 }
1778 } while (pelse != NULL);
1779 }
1780 // scan the remaining commands
1781 comp_text_line(buf, 0);
1782 // add EOC
1783 bc_eoc(&comp_prog);
1784
1785 // add ENDIF
1786 comp_push(comp_prog.count);
1787 bc_add_ctrl(&comp_prog, kwENDIF, 0, 0);
1788 comp_block_level--;
1789 comp_block_id--;
1790 return 1;
1791 } else {
1792 // *p == ':'
1793 return 0;
1794 }
1795 } else {
1796 break;
1797 }
1798 } while (pthen != NULL);
1799 return 0;
1800}
1801
1802/**
1803 * Referencing a UDS field via array, eg foo(10).x
1804 */
1805char *comp_array_uds_field(char *p, bc_t *bc) {
1806 char *p_begin = p;
1807
1808 while (1) {
1809 if (*p == 0 || (*p != '_' && !isalnum(*p))) {
1810 int len = (p - p_begin);
1811 if (len) {
1812 bc_add_code(bc, kwTYPE_UDS_EL);
1813 bc_add_strn(bc, p_begin, len);
1814 }
1815 if (*p == '.') {
1816 p_begin = p + 1;
1817 } else {
1818 return p;
1819 }
1820 }
1821 p++;
1822 }
1823
1824 return p;
1825}
1826
1827/*
1828 * array's args
1829 */
1830char *comp_array_params(char *src, char exitChar) {
1831 char *p = src;
1832 char *ss = NULL;
1833 char *se = NULL;
1834 char closeBracket = '\0';
1835 int level = 0;
1836
1837 while (*p) {
1838 switch (*p) {
1839 case '[':
1840 case '(':
1841 if (level == 0) {
1842 ss = p;
1843 }
1844 level++;
1845 closeBracket = *p == '(' ? ')' : ']';
1846 break;
1847 case ')':
1848 case ']':
1849 if (closeBracket == *p) {
1850 level--;
1851 if (level == 0) {
1852 se = p;
1853 // store this index
1854 if (!ss) {
1855 sc_raise(MSG_ARRAY_SE);
1856 } else {
1857 char ssSave = *ss;
1858 char seSave = *se;
1859 *ss = ' ';
1860 *se = '\0';
1861 bc_add_code(&comp_prog, kwTYPE_LEVEL_BEGIN);
1862 comp_expression(ss, 0);
1863 // overwrite kwTYPE_EOC with kwTYPE_LEVEL_END
1864 if (!bc_pop_eoc(&comp_prog)) {
1865 sc_raise(ERR_UNSUPPORTED);
1866 }
1867 bc_add_code(&comp_prog, kwTYPE_LEVEL_END);
1868 comp_prog.eoc_position = 0;
1869 *ss = ssSave;
1870 *se = seSave;
1871 ss = se = NULL;
1872 }
1873 if (*(p + 1) == '.') {
1874 p = comp_array_uds_field(p + 2, &comp_prog);
1875 }
1876 }
1877 }
1878 break;
1879 };
1880 if (*p != exitChar) {
1881 p++;
1882 }
1883 if (*p == exitChar) {
1884 p++;
1885 break;
1886 }
1887 }
1888 if (level > 0) {
1889 sc_raise(MSG_ARRAY_MIS_RP);
1890 } else if (level < 0) {
1891 sc_raise(MSG_ARRAY_MIS_LP);
1892 }
1893 return p;
1894}
1895
1896/*
1897 * run-time options
1898 */
1899void comp_cmd_option(char *src) {
1900 char *p = src;
1901
1902 if (CHKOPT(LCN_BASE_WRS)) {
1903 bc_add_code(&comp_prog, kwOPTION);
1904 bc_add_code(&comp_prog, OPTION_BASE);
1905 bc_add_addr(&comp_prog, xstrtol(src + 5));
1906 } else if (CHKOPT(LCN_PCRE_CASELESS)) {
1907 bc_add_code(&comp_prog, kwOPTION);
1908 bc_add_code(&comp_prog, OPTION_MATCH);
1909 bc_add_addr(&comp_prog, 2);
1910 } else if (CHKOPT(LCN_PCRE)) {
1911 bc_add_code(&comp_prog, kwOPTION);
1912 bc_add_code(&comp_prog, OPTION_MATCH);
1913 bc_add_addr(&comp_prog, 1);
1914 } else if (CHKOPT(LCN_SIMPLE)) {
1915 bc_add_code(&comp_prog, kwOPTION);
1916 bc_add_code(&comp_prog, OPTION_MATCH);
1917 bc_add_addr(&comp_prog, 0);
1918 } else if (CHKOPT(LCN_PREDEF_WRS) || CHKOPT(LCN_IMPORT_WRS)) {
1919 // ignored
1920 } else {
1921 sc_raise(MSG_OPTION_ERR, src);
1922 }
1923}
1924
1925/**
1926 * stores export symbols (in pass2 will be checked again)
1927 */
1928void bc_store_exports(char *slist) {
1929 char_p_t pars[MAX_PARAMS];
1930 int count = comp_getlist(slist, pars, MAX_PARAMS);
1931 int offset;
1932
1933 if (comp_exptable.count) {
1934 offset = comp_exptable.count;
1935 comp_exptable.count += count;
1936 comp_exptable.elem = (unit_sym_t **)realloc(comp_exptable.elem,
1937 comp_exptable.count * sizeof(unit_sym_t *));
1938 } else {
1939 offset = 0;
1940 comp_exptable.count = count;
1941 comp_exptable.elem = (unit_sym_t **)malloc(comp_exptable.count * sizeof(unit_sym_t *));
1942 }
1943
1944 for (int i = 0; i < count; i++) {
1945 unit_sym_t *sym = (unit_sym_t *)malloc(sizeof(unit_sym_t));
1946 memset(sym, 0, sizeof(unit_sym_t));
1947
1948 char var_name[SB_KEYWORD_SIZE + 1];
1949 comp_prepare_name(var_name, pars[i], SB_KEYWORD_SIZE);
1950 if (strncmp(LCN_CONST, var_name, LEN_CONST) == 0) {
1951 char *next = pars[i] + LEN_CONST;
1952 comp_prepare_name(var_name, next, SB_KEYWORD_SIZE);
1953 }
1954 strlcpy(sym->symbol, var_name, sizeof(sym->symbol));
1955 comp_exptable.elem[offset + i] = sym;
1956
1957 if (strlen(var_name) != strlen(pars[i])) {
1958 // handle same line variable assignment, eg export blah = foo
1959 comp_text_line(pars[i], 1);
1960 }
1961 }
1962}
1963
1964void comp_get_unary(const char *p, int *ladd, int *linc, int *ldec, int *leqop) {
1965 *ladd = (strncmp(p, "<<", 2) == 0);
1966 *linc = (strncmp(p, "++", 2) == 0);
1967 *ldec = (strncmp(p, "--", 2) == 0);
1968 if (p[0] != '\0' && p[1] == '=' && strchr("-+/\\*^%&|", p[0])) {
1969 *leqop = p[0];
1970 } else {
1971 *leqop = 0;
1972 }
1973}
1974
1975void comp_text_line_let(bid_t idx, int ladd, int linc, int ldec, int leqop) {
1976 char *p;
1977 char *parms = comp_bc_parm;
1978 char *array_index = NULL;
1979 int array_index_len = 0;
1980 int v_func = 0;
1981
1982 if (parms[0] == '(' || parms[0] == '[') {
1983 char closeBracket = '\0';
1984 int level = 0;
1985 p = parms;
1986 while (*p) {
1987 switch(*p) {
1988 case '[':
1989 level++;
1990 closeBracket = ']';
1991 break;
1992 case '(':
1993 level++;
1994 closeBracket = ')';
1995 break;
1996 case ']':
1997 if (closeBracket == ']') {
1998 level--;
1999 }
2000 break;
2001 case ')':
2002 if (closeBracket == ')') {
2003 level--;
2004 }
2005 break;
2006 case '.':
2007 // advance beyond UDS element
2008 p++;
2009 while (*p == '_' || isalnum(*p)) {
2010 p++;
2011 }
2012 p--;
2013 break;
2014 }
2015 p++;
2016 if (level == 0 && *p != '[' && *p != '(' && *p != '.') {
2017 break;
2018 }
2019 }
2020 if (level == 0) {
2021 p = comp_next_char(p);
2022 if (*p != '=') {
2023 // array(n) unary-operator
2024 array_index_len = (p - parms);
2025 array_index = malloc(array_index_len + 1);
2026 memcpy(array_index, parms, array_index_len);
2027 array_index[array_index_len] = '\0';
2028
2029 // store plain operator in comp_bc_parm
2030 int len = strlen(p);
2031 memmove(comp_bc_parm, p, len);
2032 comp_bc_parm[len] = '\0';
2033
2034 comp_get_unary(comp_bc_parm, &ladd, &linc, &ldec, &leqop);
2035 } else if (idx == -1 && !comp_bc_name[0]) {
2036 // packed assignment - (a,b,c) = [1,2,3]
2037 bc_add_code(&comp_prog, kwPACKED_LET);
2038 comp_array_params(parms, '=');
2039 comp_expression(p + 1, 0);
2040 return;
2041 }
2042 }
2043 }
2044
2045 if (idx == kwCONST) {
2046 // const a=10: b=10
2047 p = (char *)comp_next_word(comp_bc_parm, comp_bc_name);
2048 p = get_param_sect(p, ":", comp_bc_parm);
2049 parms = comp_bc_parm;
2050 bc_add_code(&comp_prog, kwCONST);
2051 } else if (ladd) {
2052 bc_add_code(&comp_prog, kwAPPEND);
2053 parms += 2;
2054 } else if (linc) {
2055 bc_add_code(&comp_prog, kwLET);
2056 strcpy(comp_bc_parm, "=");
2057 strcat(comp_bc_parm, comp_bc_name);
2058 if (array_index != NULL) {
2059 strcat(comp_bc_parm, array_index);
2060 }
2061 strcat(comp_bc_parm, "+1");
2062 } else if (ldec) {
2063 bc_add_code(&comp_prog, kwLET);
2064 strcpy(comp_bc_parm, "=");
2065 strcat(comp_bc_parm, comp_bc_name);
2066 if (array_index != NULL) {
2067 strcat(comp_bc_parm, array_index);
2068 }
2069 strcat(comp_bc_parm, "-1");
2070 } else if (leqop) {
2071 // a += 10: b -= 10 etc
2072 bc_add_code(&comp_prog, kwLET);
2073 int len = strlen(comp_bc_parm) + strlen(comp_bc_name) + 1;
2074 if (array_index != NULL) {
2075 len += array_index_len;
2076 }
2077 char *buf = malloc(len + 1);
2078 memset(buf, 0, len);
2079 strcpy(buf, "=");
2080 strcat(buf, comp_bc_name);
2081 if (array_index != NULL) {
2082 strcat(buf, array_index);
2083 }
2084 buf[strlen(buf)] = leqop;
2085 strcat(buf, comp_bc_parm + 2);
2086 strcpy(comp_bc_parm, buf);
2087 free(buf);
2088 } else if (idx != kwLET
2089 && array_index != NULL
2090 && strchr(comp_bc_name, '.') != NULL) {
2091 // no unary operator found with array index
2092 v_func = 1;
2093 bc_add_pcode(&comp_prog, kwTYPE_CALL_VFUNC);
2094 } else {
2095 bc_add_code(&comp_prog, kwLET);
2096 }
2097
2098 comp_error_if_keyword(comp_bc_name);
2099 comp_add_variable(&comp_prog, comp_bc_name);
2100
2101 if (!comp_error) {
2102 if (v_func) {
2103 // a.b.c()
2104 if (array_index != NULL && array_index_len > 2) {
2105 // more than empty brackets
2106 comp_array_params(array_index, 0);
2107 }
2108 }
2109 else if (parms[0] == '(' || parms[0] == '[') {
2110 if (parms[0] == '(' && *comp_next_char(parms + 1) == ')') {
2111 // vn()=fillarray
2112 p = strchr(parms, '=');
2113 comp_expression(p, 0);
2114 } else {
2115 // array(n) = expr
2116 p = comp_array_params(parms, '=');
2117 if (!comp_error) {
2118 bc_add_code(&comp_prog, kwTYPE_CMPOPR);
2119 bc_add_code(&comp_prog, '=');
2120 comp_expression(p, 0);
2121 }
2122 }
2123 } else {
2124 if (array_index != NULL) {
2125 comp_array_params(array_index, 0);
2126 }
2127 bc_add_code(&comp_prog, kwTYPE_CMPOPR);
2128 bc_add_code(&comp_prog, '=');
2129 if (parms[0] != '=' && parms[0] != ' ') {
2130 // A<<B
2131 comp_expression(parms, 0);
2132 } else {
2133 comp_expression(parms + 1, 0);
2134 }
2135 }
2136 }
2137 if (array_index != NULL) {
2138 free(array_index);
2139 }
2140}
2141
2142// User-defined procedures/functions
2143void comp_text_line_func(bid_t idx, int decl) {
2144 char *lpar_ptr, *eq_ptr;
2145 int count;
2146 char pname[SB_KEYWORD_SIZE + 1];
2147
2148 // single-line function (DEF FN)
2149 if ((eq_ptr = strchr(comp_bc_parm, '='))) {
2150 *eq_ptr = '\0';
2151 }
2152 // parameters start
2153 if ((lpar_ptr = strchr(comp_bc_parm, '('))) {
2154 *lpar_ptr = '\0';
2155 }
2156
2157 comp_prepare_name(pname, baseof(comp_bc_parm, '/'), SB_KEYWORD_SIZE);
2158 comp_error_if_keyword(baseof(comp_bc_parm, '/'));
2159
2160 if (decl) {
2161 // its only a declaration (DECLARE)
2162 if (comp_udp_getip(pname) == INVALID_ADDR) {
2163 comp_add_udp(pname);
2164 }
2165 } else {
2166 // func/sub
2167 if (comp_udp_getip(pname) != INVALID_ADDR) {
2168 sc_raise(MSG_UDP_ALREADY_EXISTS, pname);
2169 } else {
2170 // setup routine's address (and get an id)
2171 int pidx;
2172 if ((pidx = comp_udp_setip(pname)) == -1) {
2173 pidx = comp_add_udp(pname);
2174 comp_udp_setip(pname);
2175 }
2176 // put JMP to the next command after the END
2177 // (now we just keep the rq space, pass2 will update that)
2178 bc_add_code(&comp_prog, kwGOTO);
2179 bc_add_addr(&comp_prog, 0);
2180 bc_add_code(&comp_prog, 0);
2181
2182 comp_block_level++;
2183 comp_block_id++;
2184 // keep it in stack for 'pass2'
2185 comp_push(comp_prog.count);
2186 // store (FUNC/PROC) code
2187 bc_add_code(&comp_prog, idx);
2188
2189 // func/proc name (also, update comp_bc_proc)
2190 if (comp_proc_level) {
2191 strcat(comp_bc_proc, "/");
2192 strcat(comp_bc_proc, baseof(pname, '/'));
2193 } else {
2194 strcpy(comp_bc_proc, pname);
2195 }
2196
2197 if (!comp_error) {
2198 comp_proc_level++;
2199
2200 // if its a function,
2201 // setup the code for the return-value
2202 // (vid={F}/{F})
2203 if (idx == kwFUNC) {
2204 strcpy(comp_bc_tmp2, baseof(pname, '/'));
2205 comp_udptable[pidx].vid = comp_var_getID(comp_bc_tmp2);
2206 } else {
2207 // procedure, no return value here
2208 comp_udptable[pidx].vid = INVALID_ADDR;
2209 }
2210
2211 // parameters
2212 if (lpar_ptr) {
2213 int i;
2214 int vattr;
2215 char vname[SB_KEYWORD_SIZE + 1];
2216 char_p_t pars[MAX_PARAMS];
2217
2218 *lpar_ptr = '(';
2219 comp_getlist_insep(comp_bc_parm, pars, "()", MAX_PARAMS, &count);
2220 bc_add_code(&comp_prog, kwTYPE_PARAM);
2221 bc_add_code(&comp_prog, count);
2222
2223 for (i = 0; i < count; i++) {
2224 if ((strncmp(pars[i], LCN_BYREF_WRS, 6) == 0) || (pars[i][0] == '@')) {
2225 if (pars[i][0] == '@') {
2226 comp_prepare_name(vname, pars[i] + 1, SB_KEYWORD_SIZE);
2227 } else {
2228 comp_prepare_name(vname, pars[i] + 6, SB_KEYWORD_SIZE);
2229 }
2230 vattr = 0x80;
2231 } else {
2232 comp_prepare_name(vname, pars[i], SB_KEYWORD_SIZE);
2233 vattr = 0;
2234 }
2235 if (strchr(pars[i], '(')) {
2236 vattr |= 1;
2237 }
2238
2239 bc_add_code(&comp_prog, vattr);
2240 bc_add_addr(&comp_prog, comp_var_getID(vname));
2241 }
2242 } else {
2243 // no parameters
2244 bc_add_code(&comp_prog, kwTYPE_PARAM);
2245 // params
2246 bc_add_code(&comp_prog, 0);
2247 // pcount = 0
2248 }
2249
2250 bc_eoc(&comp_prog);
2251 // scan for single-line function (DEF FN format)
2252 if (eq_ptr && idx == kwFUNC) {
2253 // *eq_ptr was '\0'
2254 eq_ptr++;
2255 SKIP_SPACES(eq_ptr);
2256 if (strlen(eq_ptr)) {
2257 char *macro = malloc(SB_SOURCELINE_SIZE + 1);
2258 sprintf(macro, "%s=%s:%s", pname, eq_ptr, LCN_END);
2259 // run comp_text_line again
2260 comp_text_line(macro, 0);
2261 free(macro);
2262 } else {
2263 sc_raise(MSG_MISSING_UDP_BODY);
2264 }
2265 }
2266
2267 if (opt_autolocal) {
2268 // jump to local variable handler
2269 comp_push(comp_prog.count);
2270 bc_add_code(&comp_prog, kwGOTO);
2271 bc_add_addr(&comp_prog, 0);
2272 bc_add_code(&comp_prog, 0);
2273 bc_eoc(&comp_prog);
2274 }
2275 }
2276 }
2277 }
2278}
2279
2280void comp_text_line_on() {
2281 char *p;
2282 int count, i, keep_ip;
2283 char_p_t pars[MAX_PARAMS];
2284
2285 comp_push(comp_prog.count);
2286 bc_add_ctrl(&comp_prog, kwONJMP, 0, 0);
2287
2288 if ((p = strstr(comp_bc_parm, LCN_GOTO_WS)) != NULL) {
2289 bc_add_code(&comp_prog, kwGOTO);
2290 // the command
2291 *p = '\0';
2292 p += 6;
2293 keep_ip = comp_prog.count;
2294 bc_add_code(&comp_prog, 0);
2295 count = comp_getlist(p, pars, MAX_PARAMS);
2296 for (i = 0; i < count; i++) {
2297 bc_add_addr(&comp_prog, comp_label_getID(pars[i])); // IDs
2298 }
2299
2300 if (count == 0) {
2301 sc_raise(MSG_ON_GOTO_ERR);
2302 } else {
2303 comp_prog.ptr[keep_ip] = count;
2304 }
2305
2306 comp_expression(comp_bc_parm, 0); // the expression
2307 bc_eoc(&comp_prog);
2308 } else if ((p = strstr(comp_bc_parm, LCN_GOSUB_WS)) != NULL) {
2309 bc_add_code(&comp_prog, kwGOSUB);
2310 // the command
2311 *p = '\0';
2312 p += 7;
2313 keep_ip = comp_prog.count;
2314 bc_add_code(&comp_prog, 0);
2315 // the counter
2316
2317 // count = bc_scan_label_list(p);
2318 count = comp_getlist(p, pars, MAX_PARAMS);
2319 for (i = 0; i < count; i++) {
2320 bc_add_addr(&comp_prog, comp_label_getID(pars[i]));
2321 }
2322 if (count == 0) {
2323 sc_raise(MSG_ON_GOSUB_ERR);
2324 } else {
2325 comp_prog.ptr[keep_ip] = count;
2326 }
2327 comp_expression(comp_bc_parm, 0); // the expression
2328 bc_eoc(&comp_prog);
2329 } else {
2330 sc_raise(MSG_ON_NOTHING);
2331 }
2332}
2333
2334void comp_text_line_for() {
2335 char *p = strchr(comp_bc_parm, '=');
2336 char *p_do = strstr(comp_bc_parm, LCN_DO_WS);
2337
2338 // fix DO bug
2339 if (p_do) {
2340 if (p > p_do) {
2341 p = NULL;
2342 }
2343 }
2344 strcpy(comp_do_close_cmd, LCN_NEXT);
2345 comp_block_level++;
2346 comp_block_id++;
2347 comp_push(comp_prog.count);
2348 bc_add_ctrl(&comp_prog, kwFOR, 0, 0);
2349
2350 if (!p) {
2351 // FOR [EACH] X IN Y
2352 if ((p = strstr(comp_bc_parm, LCN_IN_WS)) == NULL) {
2353 sc_raise(MSG_FOR_NOTHING);
2354 } else {
2355 *p = '\0';
2356 char *n = p;
2357 strcpy(comp_bc_name, comp_bc_parm);
2358 str_alltrim(comp_bc_name);
2359 if (!is_alpha(*comp_bc_name)) {
2360 sc_raise(MSG_FOR_COUNT_ERR, comp_bc_name);
2361 } else {
2362 char *p_lev = comp_bc_name;
2363 while (is_alnum(*p_lev) || *p_lev == ' ') {
2364 p_lev++;
2365 }
2366 if (*p_lev == '(') {
2367 sc_raise(MSG_FOR_ARR_COUNT, comp_bc_name);
2368 } else {
2369 if (!comp_error_if_keyword(comp_bc_name)) {
2370 comp_add_variable(&comp_prog, comp_bc_name);
2371 *n = ' ';
2372 bc_add_code(&comp_prog, kwIN);
2373 comp_expression(n + 4, 0);
2374 }
2375 }
2376 }
2377 }
2378 } else {
2379 // FOR X=Y TO Z [STEP L]
2380 *p = '\0';
2381 char *n = p;
2382
2383 strcpy(comp_bc_name, comp_bc_parm);
2384 str_alltrim(comp_bc_name);
2385 if (!is_alpha(*comp_bc_name)) {
2386 sc_raise(MSG_FOR_COUNT_ERR, comp_bc_name);
2387 } else {
2388 char *p_lev = comp_bc_name;
2389 while (is_alnum(*p_lev) || *p_lev == ' ') {
2390 p_lev++;
2391 }
2392 if (*p_lev == '(') {
2393 sc_raise(MSG_FOR_ARR_COUNT, comp_bc_name);
2394 } else {
2395 if (!comp_error_if_keyword(comp_bc_name)) {
2396 comp_add_variable(&comp_prog, comp_bc_name);
2397 *n = '=';
2398 comp_expression(n + 1, 0);
2399 }
2400 }
2401 }
2402 }
2403}
2404
2405/**
2406 * Insert the local variables detected during sub/func processing
2407 */
2408void comp_insert_locals() {
2409 int count_local = 0;
2410 for (int i = 0; i < comp_varcount; i++) {
2411 if (comp_vartable[i].local_id != -1 &&
2412 comp_vartable[i].local_proc_level == comp_proc_level) {
2413 count_local++;
2414 }
2415 }
2416
2417 comp_pass_node_t *node;
2418 bcip_t pos_goto = INVALID_ADDR;
2419 for (int i = comp_stack.count - 1; i >= 0; i--) {
2420 node = comp_stack.elem[i];
2421 if (comp_prog.ptr[node->pos] == kwGOTO &&
2422 node->block_id != -1 &&
2423 node->level == comp_block_level) {
2424 pos_goto = node->pos;
2425 node->block_id = -1;
2426 break;
2427 }
2428 }
2429
2430 if (pos_goto == INVALID_ADDR) {
2431 sc_raise(ERR_SYNTAX);
2432 } else {
2433 if (!count_local) {
2434 // position the func GOTO to after the EOC
2435 bcip_t ip = - (pos_goto + 1 + ADDRSZ + 1 + 1);
2436 memcpy(comp_prog.ptr + pos_goto + 1, &ip, ADDRSZ);
2437 } else {
2438 // skip over the kwTYPE_CRVAR block
2439 comp_push(comp_prog.count);
2440 bc_add_code(&comp_prog, kwGOTO);
2441 bcip_t pos_end = comp_prog.count;
2442 bc_add_addr(&comp_prog, 0);
2443 bc_add_code(&comp_prog, 0);
2444 bc_eoc(&comp_prog);
2445
2446 // make the func GOTO arrive here at the kwTYPE_CRVAR block
2447 bcip_t ip = -comp_prog.count;
2448 memcpy(comp_prog.ptr + pos_goto + 1, &ip, ADDRSZ);
2449 bc_add_code(&comp_prog, kwTYPE_CRVAR);
2450 bc_add_code(&comp_prog, count_local);
2451 for (int i = 0; i < comp_varcount; i++) {
2452 if (comp_vartable[i].local_id != -1 &&
2453 comp_vartable[i].local_proc_level == comp_proc_level) {
2454 bc_add_addr(&comp_prog, comp_vartable[i].local_id);
2455 }
2456 }
2457 bc_eoc(&comp_prog);
2458
2459 // go back to the start of the func
2460 bcip_t pos_func_start = pos_goto + 1 + ADDRSZ + 1 + 1;
2461 comp_push(comp_prog.count);
2462 bc_add_code(&comp_prog, kwGOTO);
2463 bc_add_addr(&comp_prog, -pos_func_start);
2464 bc_add_code(&comp_prog, 0);
2465 bc_eoc(&comp_prog);
2466
2467 // complete the goto that skips the kwTYPE_CRVAR block
2468 bcip_t pos_func_end = -comp_prog.count;
2469 memcpy(comp_prog.ptr + pos_end, &pos_func_end, ADDRSZ);
2470 }
2471 }
2472}
2473
2474
2475void comp_text_line_end(bid_t idx) {
2476 if (strncmp(comp_bc_parm, LCN_IF, 2) == 0 ||
2477 strncmp(comp_bc_parm, LCN_TRY, 3) == 0 ||
2478 strncmp(comp_bc_parm, LCN_SELECT, 6) == 0) {
2479 idx = strncmp(comp_bc_parm, LCN_IF, 2) == 0 ? kwENDIF :
2480 strncmp(comp_bc_parm, LCN_TRY, 3) == 0 ? kwENDTRY : kwENDSELECT;
2481 comp_push(comp_prog.count);
2482 if (idx == kwENDTRY) {
2483 bc_add_code(&comp_prog, idx);
2484 } else {
2485 bc_add_ctrl(&comp_prog, idx, 0, 0);
2486 }
2487 comp_block_level--;
2488 comp_block_id--;
2489 } else if (comp_proc_level) {
2490 char *dol;
2491
2492 // UDP/F RETURN
2493 dol = strrchr(comp_bc_proc, '/');
2494 if (dol) {
2495 *dol = '\0';
2496 } else {
2497 *comp_bc_proc = '\0';
2498 }
2499 if (opt_autolocal) {
2500 comp_insert_locals();
2501 }
2502 comp_push(comp_prog.count);
2503 bc_add_code(&comp_prog, kwTYPE_RET);
2504 comp_proc_level--;
2505 comp_block_level--;
2506 comp_block_id++; // advance to next block
2507 } else {
2508 // END OF PROG
2509 bc_add_code(&comp_prog, idx);
2510 }
2511}
2512
2513// External or user-defined procedure
2514void comp_text_line_ext_func() {
2515 int udp = comp_is_external_proc(comp_bc_name);
2516 if (udp > -1) {
2517 bc_add_extpcode(&comp_prog, comp_extproctable[udp].lib_id,
2518 comp_extproctable[udp].symbol_index);
2519 char *next = trim_empty_parentheses(comp_bc_parm);
2520 if (comp_is_parenthesized(next)) {
2521 comp_expression(next, 0);
2522 } else {
2523 bc_add_code(&comp_prog, kwTYPE_LEVEL_BEGIN);
2524 comp_expression(next, 0);
2525 bc_add_code(&comp_prog, kwTYPE_LEVEL_END);
2526 }
2527 } else {
2528 udp = comp_udp_id(comp_bc_name, 1);
2529 if (udp == -1) {
2530 udp = comp_add_udp(comp_bc_name);
2531 }
2532 comp_push(comp_prog.count);
2533 bc_add_ctrl(&comp_prog, kwTYPE_CALL_UDP, udp, 0);
2534 char *next = trim_empty_parentheses(comp_bc_parm);
2535 if (comp_is_parenthesized(next)) {
2536 comp_expression(next, 0);
2537 } else {
2538 bc_add_code(&comp_prog, kwTYPE_LEVEL_BEGIN);
2539 comp_expression(next, 0);
2540 bc_add_code(&comp_prog, kwTYPE_LEVEL_END);
2541 }
2542 }
2543}
2544
2545int comp_text_line_command(bid_t idx, int decl, int sharp, char *last_cmd) {
2546 char_p_t pars[MAX_PARAMS];
2547 int index;
2548 int result = 1;
2549
2550 switch (idx) {
2551 case kwLABEL:
2552 str_alltrim(comp_bc_parm);
2553 idx = comp_label_getID(comp_bc_parm);
2554 comp_label_setip(idx);
2555 break;
2556
2557 case kwEXIT:
2558 bc_add_code(&comp_prog, idx);
2559 str_alltrim(comp_bc_parm);
2560 if (strlen(comp_bc_parm) && comp_bc_parm[0] != '\'') {
2561 idx = comp_is_special_operator(comp_bc_parm);
2562 if (idx == kwFORSEP || idx == kwLOOPSEP || idx == kwPROCSEP || idx == kwFUNCSEP) {
2563 bc_add_code(&comp_prog, idx);
2564 } else {
2565 sc_raise(MSG_EXIT_ERR);
2566 }
2567 } else {
2568 bc_add_code(&comp_prog, 0);
2569 }
2570 break;
2571
2572 case kwDECLARE:
2573 break;
2574
2575 case kwPROC:
2576 case kwFUNC:
2577 comp_text_line_func(idx, decl);
2578 break;
2579
2580 case kwLOCAL:
2581 // local variables
2582 if (!opt_autolocal) {
2583 char vname[SB_KEYWORD_SIZE + 1];
2584 int count = comp_getlist(comp_bc_parm, pars, MAX_PARAMS);
2585 bc_add_code(&comp_prog, kwTYPE_CRVAR);
2586 bc_add_code(&comp_prog, count);
2587 for (int i = 0; i < count; i++) {
2588 comp_prepare_name(vname, pars[i], SB_KEYWORD_SIZE);
2589 bc_add_addr(&comp_prog, comp_var_getID(vname));
2590 }
2591 // handle same line variable assignment, eg local blah = foo
2592 for (int i = 0; i < count; i++) {
2593 comp_prepare_name(vname, pars[i], SB_KEYWORD_SIZE);
2594 str_alltrim(pars[i]);
2595 if (strlen(vname) != strlen(pars[i])) {
2596 // kwTYPE_LINE is required for executor
2597 comp_text_line(pars[i], 1);
2598 }
2599 }
2600 }
2601 break;
2602
2603 case kwREM:
2604 result = 0;
2605 break;
2606
2607 case kwEXPORT: // export
2608 if (comp_unit_flag) {
2609 bc_store_exports(comp_bc_parm);
2610 } else {
2611 sc_raise(MSG_UNIT_NAME_MISSING);
2612 }
2613 break;
2614
2615 case kwOPTION:
2616 comp_cmd_option(comp_bc_parm);
2617 break;
2618
2619 case kwGOTO:
2620 str_alltrim(comp_bc_parm);
2621 comp_push(comp_prog.count);
2622 bc_add_code(&comp_prog, idx);
2623 bc_add_addr(&comp_prog, comp_label_getID(comp_bc_parm));
2624 bc_add_code(&comp_prog, comp_block_level);
2625 break;
2626
2627 case kwGOSUB:
2628 str_alltrim(comp_bc_parm);
2629 bc_add_code(&comp_prog, idx);
2630 bc_add_addr(&comp_prog, comp_label_getID(comp_bc_parm));
2631 break;
2632
2633 case kwIF:
2634 strcpy(comp_do_close_cmd, LCN_ENDIF);
2635
2636 // from here, we can scan for inline IF
2637 if (comp_single_line_if(last_cmd)) {
2638 // inline-IFs
2639 result = 0;
2640 } else {
2641 comp_block_level++;
2642 comp_block_id++;
2643 comp_push(comp_prog.count);
2644 bc_add_ctrl(&comp_prog, idx, 0, 0);
2645 comp_expression(comp_bc_parm, 0);
2646 bc_eoc(&comp_prog);
2647 }
2648 break;
2649
2650 case kwON:
2651 comp_text_line_on();
2652 break;
2653
2654 case kwFOR:
2655 comp_text_line_for();
2656 break;
2657
2658 case kwWHILE:
2659 strcpy(comp_do_close_cmd, LCN_WEND);
2660 comp_block_level++;
2661 comp_block_id++;
2662 comp_push(comp_prog.count);
2663 bc_add_ctrl(&comp_prog, idx, 0, 0);
2664 comp_expression(comp_bc_parm, 0);
2665 break;
2666
2667 case kwREPEAT:
2668 // WHILE & REPEAT DOES NOT USE STACK
2669 comp_block_level++;
2670 comp_block_id++;
2671 comp_push(comp_prog.count);
2672 bc_add_ctrl(&comp_prog, idx, 0, 0);
2673 comp_expression(comp_bc_parm, 0);
2674 break;
2675
2676 case kwSELECT:
2677 comp_block_level++;
2678 comp_block_id++;
2679 comp_push(comp_prog.count);
2680 bc_add_code(&comp_prog, idx);
2681 // if comp_bc_parm starts with "CASE ", then skip first 5 chars
2682 index = strncasecmp("CASE ", comp_bc_parm, 5) == 0 ? 5 : 0;
2683 comp_expression(comp_bc_parm + index, 0);
2684 break;
2685
2686 case kwCASE:
2687 // link to matched block or next CASE/END-SELECT
2688 if (!comp_bc_parm || !comp_bc_parm[0] || strncasecmp(LCN_ELSE, comp_bc_parm, 4) == 0) {
2689 comp_push(comp_prog.count);
2690 bc_add_ctrl(&comp_prog, kwCASE_ELSE, 0, 0);
2691 } else {
2692 comp_push(comp_prog.count);
2693 bc_add_ctrl(&comp_prog, idx, 0, 0);
2694 comp_expression(comp_bc_parm, 0);
2695 }
2696 break;
2697
2698 case kwTRY:
2699 comp_block_level++;
2700 comp_block_id++;
2701 comp_push(comp_prog.count);
2702 bc_add_code(&comp_prog, idx);
2703 bc_add_addr(&comp_prog, 0);
2704 comp_expression(comp_bc_parm, 0);
2705 break;
2706
2707 case kwCATCH:
2708 comp_push(comp_prog.count);
2709 bc_add_ctrl(&comp_prog, idx, 0, 0);
2710 comp_expression(comp_bc_parm, 0);
2711 break;
2712
2713 case kwELSE:
2714 case kwELIF:
2715 index = 0;
2716 // handle "ELSE IF"
2717 if (idx == kwELSE && strncasecmp(LCN_IF, comp_bc_parm, 2) == 0) {
2718 idx = kwELIF;
2719 index = 2;
2720 }
2721 // handle error for ELSE xxxx
2722 if (idx == kwELSE && comp_bc_parm[0]) {
2723 sc_raise(ERR_SYNTAX);
2724 break;
2725 }
2726 comp_push(comp_prog.count);
2727 bc_add_ctrl(&comp_prog, idx, 0, 0);
2728 comp_expression(comp_bc_parm + index, 0);
2729 break;
2730
2731 case kwENDIF:
2732 case kwNEXT:
2733 comp_push(comp_prog.count);
2734 bc_add_ctrl(&comp_prog, idx, 0, 0);
2735 comp_block_level--;
2736 comp_block_id--;
2737 break;
2738
2739 case kwWEND:
2740 case kwUNTIL:
2741 comp_push(comp_prog.count);
2742 bc_add_ctrl(&comp_prog, idx, 0, 0);
2743 comp_block_level--;
2744 comp_block_id--;
2745 comp_expression(comp_bc_parm, 0);
2746 break;
2747
2748 case kwSTEP:
2749 case kwTO:
2750 case kwIN:
2751 case kwTHEN:
2752 case kwCOS:
2753 case kwSIN:
2754 case kwLEN:
2755 case kwLOOP:
2756 // functions...
2757 sc_raise(MSG_SPECIAL_KW_ERR, comp_bc_name);
2758 break;
2759
2760 case kwRESTORE:
2761 comp_push(comp_prog.count);
2762 bc_add_code(&comp_prog, idx);
2763 bc_add_addr(&comp_prog, comp_label_getID(comp_bc_parm));
2764 break;
2765
2766 case kwEND:
2767 comp_text_line_end(idx);
2768 break;
2769
2770 case kwDATA:
2771 comp_data_seg(comp_bc_parm);
2772 break;
2773
2774 case kwREAD:
2775 bc_add_code(&comp_prog, sharp ? kwFILEREAD : idx);
2776 comp_expression(comp_bc_parm, 0);
2777 break;
2778
2779 case kwINPUT:
2780 bc_add_code(&comp_prog, sharp ? kwFILEINPUT : idx);
2781 comp_expression(comp_bc_parm, 0);
2782 break;
2783
2784 case kwPRINT:
2785 bc_add_code(&comp_prog, sharp ? kwFILEPRINT : idx);
2786 comp_expression(comp_bc_parm, 0);
2787 break;
2788
2789 case kwLINE:
2790 if (strncmp(comp_bc_parm, LCN_INPUT_WRS, 6) == 0) {
2791 bc_add_code(&comp_prog, kwLINEINPUT);
2792 comp_expression(comp_bc_parm + 6, 0);
2793 } else {
2794 bc_add_code(&comp_prog, idx);
2795 comp_expression(comp_bc_parm, 0);
2796 }
2797 break;
2798
2799 case kwRETURN:
2800 if (comp_bc_proc[0]) {
2801 // synonym for FUNC=result
2802 if (comp_bc_parm[0]) {
2803 bc_add_code(&comp_prog, kwLET);
2804 comp_add_variable(&comp_prog, comp_bc_proc);
2805 bc_add_code(&comp_prog, kwTYPE_CMPOPR);
2806 bc_add_code(&comp_prog, '=');
2807 comp_expression(comp_bc_parm, 0);
2808 }
2809 bc_add_code(&comp_prog, kwRETURN);
2810 comp_push(comp_prog.count);
2811 bc_add_code(&comp_prog, kwFUNC_RETURN);
2812 bc_add_addr(&comp_prog, comp_proc_level);
2813 } else {
2814 // return from GOSUB
2815 bc_add_code(&comp_prog, idx);
2816 comp_expression(comp_bc_parm, 0);
2817 }
2818 break;
2819
2820 case -1:
2821 comp_text_line_ext_func();
2822 break;
2823
2824 default:
2825 // something else
2826 bc_add_code(&comp_prog, idx);
2827 comp_expression(comp_bc_parm, 0);
2828 }
2829
2830 return result;
2831}
2832
2833void add_line_no() {
2834 if (comp_prog.line_position == 0 ||
2835 comp_prog.line_position != (comp_prog.count - KW_TYPE_LINE_BYTES)) {
2836 // not an adjoining kwTYPE_LINE
2837 if (!opt_autolocal && comp_prog.eoc_position == comp_prog.count - 1) {
2838 // overwrite any adjoining kwTYPE_EOC (can't do this with autolocal)
2839 if (!bc_pop_eoc(&comp_prog)) {
2840 sc_raise(ERR_UNSUPPORTED);
2841 }
2842 }
2843
2844 // prevent adjoining kwTYPE_LINEs
2845 comp_prog.line_position = comp_prog.count;
2846 bc_add_code(&comp_prog, kwTYPE_LINE);
2847 bc_add_addr(&comp_prog, comp_line);
2848 }
2849}
2850
2851/*
2852 * Pass 1: scan source line
2853 */
2854void comp_text_line(char *text, int addLineNo) {
2855 bid_t idx;
2856 int decl = 0;
2857
2858 if (comp_error) {
2859 return;
2860 }
2861 str_alltrim(text);
2862 char *p = text;
2863
2864 // EOL
2865 if (*p == ':') {
2866 p++;
2867 comp_text_line(p, 0);
2868 return;
2869 }
2870 // remark
2871 if (*p == '\'' || *p == '#') {
2872 return;
2873 }
2874 // empty line
2875 if (*p == '\0') {
2876 return;
2877 }
2878
2879 char *lb_end = (char *)comp_next_word(text, comp_bc_name);
2880 char *last_cmd = lb_end;
2881 p = get_param_sect(lb_end, ":", comp_bc_parm);
2882
2883 // check old style labels
2884 if (is_all_digits(comp_bc_name)) {
2885 str_alltrim(comp_bc_name);
2886 idx = comp_label_getID(comp_bc_name);
2887 comp_label_setip(idx);
2888 if (comp_error) {
2889 return;
2890 }
2891 // continue
2892 last_cmd = p = (char *)comp_next_word(lb_end, comp_bc_name);
2893 if (strlen(comp_bc_name) == 0) {
2894 if (!p) {
2895 return;
2896 }
2897 if (*p == '\0') {
2898 return;
2899 }
2900 }
2901 p = get_param_sect(p, ":", comp_bc_parm);
2902 }
2903
2904 idx = comp_is_keyword(comp_bc_name);
2905 if (idx == kwREM) {
2906 return;
2907 }
2908 if (addLineNo) {
2909 add_line_no();
2910 }
2911 if (idx == -1) {
2912 idx = comp_is_proc(comp_bc_name);
2913 if (idx != -1) {
2914 if (idx == kwCALLCP) {
2915 bc_add_code(&comp_prog, kwTYPE_CALL_UDP);
2916 bc_add_addr(&comp_prog, idx); // place holder
2917 bc_add_addr(&comp_prog, 0); // return-variable ID
2918 bc_add_code(&comp_prog, kwTYPE_LEVEL_BEGIN);
2919 // allow cmd_udp to find the initial var-ptr arg
2920 bc_add_code(&comp_prog, kwTYPE_CALL_PTR);
2921 char *next = trim_empty_parentheses(comp_bc_parm);
2922 comp_expression(next, 0);
2923 bc_add_code(&comp_prog, kwTYPE_LEVEL_END);
2924 } else {
2925 // simple buildin procedure
2926 // there is no need to check it more...
2927 // save it and return (go to next)
2928 bc_add_pcode(&comp_prog, idx);
2929 char *next = trim_empty_parentheses(comp_bc_parm);
2930 comp_expression(next, 0);
2931 }
2932 if (*p == ':') {
2933 // command separator
2934 bc_eoc(&comp_prog);
2935 p++;
2936 comp_text_line(p, 0);
2937 }
2938 return;
2939 }
2940 }
2941 if (idx == kwLET) {
2942 // old-style keyword LET
2943 idx = -1;
2944 char *p = (char *)comp_next_word(comp_bc_parm, comp_bc_name);
2945 if (p > comp_bc_parm) {
2946 // p is an offset of comp_bc_parm
2947 int len = strlen(p);
2948 memmove(comp_bc_parm, p, len);
2949 comp_bc_parm[len] = '\0';
2950 }
2951 } else if (idx == kwDECLARE) {
2952 // declaration
2953 decl = 1;
2954 char *p = (char *)comp_next_word(comp_bc_parm, comp_bc_name);
2955 idx = comp_is_keyword(comp_bc_name);
2956 if (idx == -1) {
2957 idx = comp_is_proc(comp_bc_name);
2958 }
2959 if (p > comp_bc_parm) {
2960 // p is an offset of comp_bc_parm
2961 int len = strlen(p);
2962 memmove(comp_bc_parm, p, len);
2963 comp_bc_parm[len] = '\0';
2964 }
2965 if (idx != kwPROC && idx != kwFUNC) {
2966 sc_raise(MSG_USE_DECL);
2967 return;
2968 }
2969 }
2970
2971 int sharp, ladd,linc, ldec, leqop;
2972 sharp = (comp_bc_parm[0] == '#'); // if # -> file commands
2973 comp_get_unary(comp_bc_parm, &ladd, &linc, &ldec, &leqop);
2974
2975 if ((comp_bc_parm[0] == '=' || ladd || linc || ldec || leqop) && (idx != -1)) {
2976 sc_raise(MSG_IT_IS_KEYWORD, comp_bc_name);
2977 return;
2978 }
2979 if ((idx == kwCONST) ||
2980 ((comp_bc_parm[0] == '=' ||
2981 ((comp_bc_parm[0] == '(' || comp_bc_parm[0] == '[')
2982 && !comp_is_function(comp_bc_name)) ||
2983 ladd || linc || ldec || leqop) && (idx == -1))) {
2984 comp_text_line_let(idx, ladd, linc, ldec, leqop);
2985 } else {
2986 if (!comp_text_line_command(idx, decl, sharp, last_cmd)) {
2987 p = NULL;
2988 }
2989 }
2990 if (p != NULL && *p == ':') {
2991 // command separator
2992 bc_eoc(&comp_prog);
2993 p++;
2994 comp_text_line(p, 0);
2995 }
2996}
2997
2998/*
2999 * skip command bytes
3000 */
3001bcip_t comp_next_bc_cmd(bc_t *bc, bcip_t ip) {
3002 uint32_t len;
3003 code_t code = bc->ptr[ip];
3004 ip++;
3005
3006 switch (code) {
3007 case kwTYPE_INT: // integer
3008 ip += OS_INTSZ;
3009 break;
3010 case kwTYPE_NUM: // number
3011 ip += OS_REALSZ;
3012 break;
3013 case kwTYPE_STR: // string: [2/4B-len][data]
3014 memcpy(&len, bc->ptr + ip, OS_STRLEN);
3015 len += OS_STRLEN;
3016 ip += len;
3017 break;
3018 case kwTYPE_CALLF:
3019 case kwTYPE_CALLP: // [bid_t]
3020 ip += CODESZ;
3021 break;
3022 case kwTYPE_CALLEXTF:
3023 case kwTYPE_CALLEXTP: // [lib][index]
3024 ip += (ADDRSZ * 2);
3025 break;
3026 case kwEXIT:
3027 case kwTYPE_SEP:
3028 case kwTYPE_LOGOPR:
3029 case kwTYPE_CMPOPR:
3030 case kwTYPE_ADDOPR:
3031 case kwTYPE_MULOPR:
3032 case kwTYPE_POWOPR:
3033 case kwTYPE_UNROPR: // [1B data]
3034 ip++;
3035 break;
3036 case kwTRY:
3037 case kwRESTORE:
3038 case kwGOSUB:
3039 case kwTYPE_LINE:
3040 case kwTYPE_VAR: // [addr|id]
3041 case kwFUNC_RETURN:
3042 ip += ADDRSZ;
3043 break;
3044 case kwTYPE_PTR:
3045 case kwTYPE_CALL_UDP:
3046 case kwTYPE_CALL_UDF: // [true-ip][false-ip]
3047 ip += BC_CTRLSZ;
3048 break;
3049 case kwGOTO: // [addr][pop-count]
3050 ip += (ADDRSZ + 1);
3051 break;
3052 case kwTYPE_CRVAR: // [1B count][addr1][addr2]...
3053 len = bc->ptr[ip];
3054 ip += ((len * ADDRSZ) + 1);
3055 break;
3056 case kwTYPE_PARAM: // [1B count] {[1B-pattr][addr1]} ...
3057 len = bc->ptr[ip];
3058 ip += ((len * (ADDRSZ + 1)) + 1);
3059 break;
3060 case kwONJMP: // [true-ip][false-ip] [GOTO|GOSUB]
3061 // [count] [addr1]...
3062 ip += (BC_CTRLSZ + 1);
3063 ip += (bc->ptr[ip] * ADDRSZ);
3064 break;
3065 case kwOPTION: // [1B-optcode][addr-data]
3066 ip += (ADDRSZ + 1);
3067 break;
3068 case kwIF:
3069 case kwFOR:
3070 case kwWHILE:
3071 case kwREPEAT:
3072 case kwELSE:
3073 case kwELIF:
3074 case kwENDIF:
3075 case kwNEXT:
3076 case kwWEND:
3077 case kwUNTIL:
3078 case kwUSE:
3079 case kwCASE:
3080 case kwCASE_ELSE:
3081 case kwENDSELECT:
3082 case kwCATCH:
3083 ip += BC_CTRLSZ;
3084 break;
3085 case kwTYPE_EVAL_SC:
3086 ip += 2; // kwTYPE_LOGOPR+op
3087 ip += ADDRSZ; // the shortcut address
3088 break;
3089 };
3090 return ip;
3091}
3092
3093/*
3094 * search for command (in byte-code)
3095 */
3096bcip_t comp_search_bc(bcip_t ip, code_t code) {
3097 bcip_t i = ip;
3098 bcip_t result = INVALID_ADDR;
3099 do {
3100 if (i >= comp_prog.count) {
3101 break;
3102 } else if (code == comp_prog.ptr[i]) {
3103 result = i;
3104 break;
3105 }
3106 i = comp_next_bc_cmd(&comp_prog, i);
3107 } while (i < comp_prog.count);
3108 return result;
3109}
3110
3111/*
3112 * search for End-Of-Command mark
3113 */
3114bcip_t comp_search_bc_eoc(bcip_t ip) {
3115 bcip_t i = ip;
3116 code_t code;
3117
3118 do {
3119 code = comp_prog.ptr[i];
3120 if (code == kwTYPE_EOC || code == kwTYPE_LINE) {
3121 return i;
3122 }
3123 i = comp_next_bc_cmd(&comp_prog, i);
3124 } while (i < comp_prog.count);
3125 return comp_prog.count;
3126}
3127
3128/*
3129 * search stack
3130 */
3131bcip_t comp_search_bc_stack(bcip_t start, code_t code, byte level, bid_t block_id) {
3132 for (bcip_t i = start; i < comp_sp; i++) {
3133 comp_pass_node_t *node = comp_stack.elem[i];
3134 if (comp_prog.ptr[node->pos] == code) {
3135 if (node->level == level && (block_id == -1 || block_id == node->block_id)) {
3136 return node->pos;
3137 }
3138 }
3139 }
3140 return INVALID_ADDR;
3141}
3142
3143/*
3144 * search stack backward
3145 */
3146bcip_t comp_search_bc_stack_backward(bcip_t start, code_t code, byte level, bid_t block_id) {
3147 for (bcip_t i = start; i < comp_sp; i--) {
3148 // WARNING: ITS UNSIGNED, SO WE'LL SEARCH
3149 // IN RANGE [0..STK_COUNT]
3150 comp_pass_node_t *node = comp_stack.elem[i];
3151 if (comp_prog.ptr[node->pos] == code) {
3152 if (node->level == level && (block_id == -1 || block_id == node->block_id)) {
3153 return node->pos;
3154 }
3155 }
3156 }
3157 return INVALID_ADDR;
3158}
3159
3160/*
3161 * inspect the byte-code at the given location
3162 */
3163bcip_t comp_next_bc_peek(bcip_t start) {
3164 bcip_t result;
3165 if (start < comp_stack.count) {
3166 comp_pass_node_t *node = comp_stack.elem[start];
3167 result = comp_prog.ptr[node->pos];
3168 } else {
3169 result = -1;
3170 }
3171 return result;
3172}
3173
3174/*
3175 * Advanced error messages:
3176 * Analyze LOOP-END errors
3177 */
3178void print_pass2_stack(bcip_t pos, code_t lcode, int level) {
3179 bcip_t ip;
3180 bcip_t i;
3181 int j;
3182 char cmd[16], cmd2[16];
3183 comp_pass_node_t *node;
3184 code_t ccode[256];
3185 int csum[256];
3186 int cs_count;
3187 code_t start_code[] = { kwWHILE, kwREPEAT, kwIF, kwFOR, kwFUNC, 0 };
3188 code_t end_code[] = { kwWEND, kwUNTIL, kwENDIF, kwNEXT, kwTYPE_RET, 0 };
3189 code_t code = lcode;
3190
3191 if (opt_quiet) {
3192 return;
3193 }
3194
3195 kw_getcmdname(code, cmd);
3196
3197 ip = comp_search_bc_stack(pos + 1, code, level - 1, -1);
3198 if (ip == INVALID_ADDR) {
3199 ip = comp_search_bc_stack(pos + 1, code, level + 1, -1);
3200 if (ip == INVALID_ADDR) {
3201 int cnt = 0;
3202 for (i = pos + 1; i < comp_sp; i++) {
3203 node = comp_stack.elem[i];
3204 if (comp_prog.ptr[node->pos] == code) {
3205 log_printf("\n%s found on level %d (@%d) instead of %d (@%d+)\n",
3206 cmd, node->level, node->pos, level, pos);
3207 cnt++;
3208 if (cnt > 3) {
3209 break;
3210 }
3211 }
3212 }
3213 } else {
3214 log_printf("\n%s found on level %d instead of %d (@%d+)\n",
3215 cmd, level + 1, level, pos);
3216 }
3217 } else {
3218 log_printf("\n%s found on level %d instead of %d (@%d+)\n",
3219 cmd, level - 1, level, pos);
3220 }
3221
3222 // print stack
3223 cs_count = 0;
3224 log_printf("\n");
3225 log_printf("--- Pass 2 - stack ------------------------------------------------------\n");
3226 log_printf("%s%4s %16s %16s %6s %6s %5s %5s %5s\n", " ", " i", "Command", "Section", "Addr", "Line",
3227 "Level", "BlkID", "Count");
3228 log_printf("-------------------------------------------------------------------------\n");
3229
3230 for (i = 0; i < comp_sp; i++) {
3231 node = comp_stack.elem[i];
3232 code = comp_prog.ptr[node->pos];
3233 if (node->pos != INVALID_ADDR) {
3234 kw_getcmdname(code, cmd);
3235 } else {
3236 strcpy(cmd, "---");
3237 }
3238 // sum
3239 int cs_idx = -1;
3240 for (j = 0; j < cs_count; j++) {
3241 if (ccode[j] == code) {
3242 cs_idx = j;
3243 csum[cs_idx]++;
3244 break;
3245 }
3246 }
3247 if (cs_idx == -1) {
3248 cs_idx = cs_count;
3249 cs_count++;
3250 ccode[cs_idx] = code;
3251 csum[cs_idx] = 1;
3252 }
3253 // info
3254 log_printf("%s%4d: %16s %16s %6d %6d %5d %5d %5d\n", ((i == pos) ? ">>" : " "),
3255 i, cmd, node->sec, node->pos, node->line, node->level, node->block_id, csum[cs_idx]);
3256 }
3257
3258 // sum
3259 log_printf("\n");
3260 log_printf("--- Sum -----------------------------------------------------------------\n");
3261 for (i = 0; i < cs_count; i++) {
3262 code = ccode[i];
3263 if (!kw_getcmdname(code, cmd))
3264 sprintf(cmd, "(%d)", code);
3265 log_printf("%16s - %5d\n", cmd, csum[i]);
3266 }
3267
3268 // decide
3269 log_printf("\n");
3270 for (i = 0; start_code[i] != 0; i++) {
3271 int sa, sb;
3272 code_t ca, cb;
3273
3274 ca = start_code[i];
3275 cb = end_code[i];
3276
3277 sa = 0;
3278 for (j = 0; j < cs_count; j++) {
3279 if (ccode[j] == ca)
3280 sa = csum[j];
3281 if (ca == kwFUNC) {
3282 if (ccode[j] == kwPROC)
3283 sa += csum[j];
3284 }
3285 }
3286
3287 sb = 0;
3288 for (j = 0; j < cs_count; j++) {
3289 if (ccode[j] == cb) {
3290 sb = csum[j];
3291 break;
3292 }
3293 }
3294
3295 if (sa - sb != 0) {
3296 kw_getcmdname(ca, cmd);
3297 kw_getcmdname(cb, cmd2);
3298 if (sa > sb) {
3299 log_printf("Hint: Missing %d %s or there is/are %d more %s\n", sa - sb, cmd2, sa - sb, cmd);
3300 } else {
3301 log_printf("Hint: There is/are %d more %s or missing %d %s\n", sb - sa, cmd2, sb - sa, cmd);
3302 }
3303 }
3304 }
3305
3306 log_printf("\n\n");
3307}
3308
3309/*
3310 * PASS 2 (write jumps for IF,FOR,WHILE,REPEAT,etc)
3311 */
3312void comp_pass2_scan() {
3313 bcip_t i = 0, j, true_ip, false_ip, label_id, w;
3314 bcip_t a_ip, b_ip, c_ip, count;
3315 code_t code;
3316 byte level;
3317 comp_pass_node_t *node;
3318 comp_label_t *label;
3319
3320 if (!opt_quiet) {
3321 log_printf(MSG_PASS2_COUNT, i, comp_sp);
3322 }
3323
3324 // for each node in stack
3325 for (i = 0; i < comp_sp; i++) {
3326 if (!opt_quiet) {
3327 if ((i % SB_KEYWORD_SIZE) == 0) {
3328 log_printf(MSG_PASS2_COUNT, i, comp_sp);
3329 }
3330 }
3331
3332 node = comp_stack.elem[i];
3333 comp_line = node->line;
3334 strcpy(comp_bc_sec, node->sec);
3335 code = comp_prog.ptr[node->pos];
3336 if (code == kwTYPE_EOC || code == kwTYPE_LINE) {
3337 continue;
3338 }
3339
3340 // debug (node->pos = the address of the error)
3341 //
3342 // if (node->pos == 360 || node->pos == 361)
3343 // trace("=== stack code %d\n", code);
3344
3345 if (code != kwGOTO &&
3346 code != kwRESTORE &&
3347 code != kwSELECT &&
3348 code != kwONJMP &&
3349 code != kwTYPE_PTR &&
3350 code != kwTYPE_CALL_UDP &&
3351 code != kwTYPE_CALL_UDF &&
3352 code != kwPROC &&
3353 code != kwFUNC &&
3354 code != kwTRY &&
3355 code != kwCATCH &&
3356 code != kwENDTRY &&
3357 code != kwFUNC_RETURN &&
3358 code != kwTYPE_RET) {
3359 // default - calculate true-ip
3360 true_ip = comp_search_bc_eoc(node->pos + (BC_CTRLSZ + 1));
3361 memcpy(comp_prog.ptr + node->pos + 1, &true_ip, ADDRSZ);
3362 }
3363
3364 switch (code) {
3365 case kwPROC:
3366 case kwFUNC:
3367 // update start's GOTO
3368 true_ip = comp_search_bc_stack(i + 1, kwTYPE_RET, node->level, -1) + 1;
3369 if (true_ip == INVALID_ADDR) {
3370 sc_raise(MSG_UDP_MISSING_END);
3371 print_pass2_stack(i, kwTYPE_RET, node->level);
3372 return;
3373 }
3374 memcpy(comp_prog.ptr + node->pos - (ADDRSZ + 1), &true_ip, ADDRSZ);
3375 break;
3376
3377 case kwRESTORE:
3378 // replace the label ID with the real IP
3379 memcpy(&label_id, comp_prog.ptr + node->pos + 1, ADDRSZ);
3380 label = comp_labtable.elem[label_id];
3381 count = comp_first_data_ip + label->dp;
3382 memcpy(comp_prog.ptr + node->pos + 1, &count, ADDRSZ);
3383 // change LABEL-ID with DataPointer
3384 break;
3385
3386 case kwTYPE_PTR:
3387 case kwTYPE_CALL_UDP:
3388 case kwTYPE_CALL_UDF:
3389 memcpy(&label_id, comp_prog.ptr + node->pos + 1, ADDRSZ);
3390 if (label_id < comp_udpcount) {
3391 // update real IP
3392 true_ip = comp_udptable[label_id].ip + (ADDRSZ + 3);
3393 memcpy(comp_prog.ptr + node->pos + 1, &true_ip, ADDRSZ);
3394 // update return-var ID
3395 true_ip = comp_udptable[label_id].vid;
3396 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &true_ip, ADDRSZ);
3397 } else if (label_id != kwCALLCF) {
3398 sc_raise(MSG_EXP_GENERR);
3399 }
3400 break;
3401
3402 case kwONJMP:
3403 // kwONJMP:1 trueip:2 falseip:2 command:1 count:1 label1:2
3404 // label2:2 ...
3405 count = comp_prog.ptr[node->pos + (ADDRSZ + ADDRSZ + 2)];
3406
3407 true_ip = comp_search_bc_eoc(node->pos + BC_CTRLSZ + (count * ADDRSZ) + 3);
3408 memcpy(comp_prog.ptr + node->pos + 1, &true_ip, ADDRSZ);
3409
3410 // change label IDs with the real IPs
3411 for (j = 0; j < count; j++) {
3412 memcpy(&label_id, comp_prog.ptr + node->pos + (j * ADDRSZ) + (ADDRSZ + ADDRSZ + 3), ADDRSZ);
3413 label = comp_labtable.elem[label_id];
3414 w = label->ip;
3415
3416 // adjust the address to compensate for optimisation to remove adjoining kwEOC
3417 if (w > 0 && w < comp_prog.count && comp_prog.ptr[w] != kwTYPE_LINE && comp_prog.ptr[w - 1] == kwTYPE_LINE) {
3418 w--;
3419 }
3420 memcpy(comp_prog.ptr + node->pos + (j * ADDRSZ) + (ADDRSZ + ADDRSZ + 3), &w, ADDRSZ);
3421 }
3422 break;
3423
3424 case kwGOTO:
3425 memcpy(&label_id, comp_prog.ptr + node->pos + 1, ADDRSZ);
3426 if ((int)label_id < 0) {
3427 // specific internal jump value
3428 w = -label_id;
3429 } else {
3430 // change LABEL-ID with IP
3431 label = comp_labtable.elem[label_id];
3432 w = label->ip;
3433
3434 // adjust the address to compensate for optimisation to remove adjoining kwEOC
3435 if (w > 0 && w < comp_prog.count && comp_prog.ptr[w] != kwTYPE_LINE && comp_prog.ptr[w - 1] == kwTYPE_LINE) {
3436 w--;
3437 }
3438
3439 // number of POPs
3440 level = comp_prog.ptr[node->pos + (ADDRSZ + BYTE_OFFSET_IN_32)];
3441 if (level >= label->level) {
3442 comp_prog.ptr[node->pos + (ADDRSZ + 1)] = level - label->level;
3443 } else {
3444 comp_prog.ptr[node->pos + (ADDRSZ + 1)] = 0;
3445 }
3446 }
3447 memcpy(comp_prog.ptr + node->pos + 1, &w, ADDRSZ);
3448 break;
3449
3450 case kwFOR:
3451 a_ip = comp_search_bc(node->pos + (ADDRSZ + ADDRSZ + 1), kwTO);
3452 b_ip = comp_search_bc(node->pos + (ADDRSZ + ADDRSZ + 1), kwIN);
3453 if (a_ip < b_ip) {
3454 b_ip = INVALID_ADDR;
3455 } else if (a_ip > b_ip) {
3456 a_ip = b_ip;
3457 }
3458 false_ip = comp_search_bc_stack(i + 1, kwNEXT, node->level, -1);
3459
3460 if (false_ip == INVALID_ADDR) {
3461 sc_raise(MSG_MISSING_NEXT);
3462 print_pass2_stack(i, kwNEXT, node->level);
3463 return;
3464 }
3465 if (a_ip > false_ip || a_ip == INVALID_ADDR) {
3466 if (b_ip != INVALID_ADDR) {
3467 sc_raise(MSG_MISSING_IN);
3468 } else {
3469 sc_raise(MSG_MISSING_TO);
3470 }
3471 return;
3472 }
3473 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3474 break;
3475
3476 case kwWHILE:
3477 false_ip = comp_search_bc_stack(i + 1, kwWEND, node->level, -1);
3478
3479 if (false_ip == INVALID_ADDR) {
3480 sc_raise(MSG_MISSING_WEND);
3481 print_pass2_stack(i, kwWEND, node->level);
3482 return;
3483 }
3484 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3485 break;
3486
3487 case kwREPEAT:
3488 false_ip = comp_search_bc_stack(i + 1, kwUNTIL, node->level, -1);
3489
3490 if (false_ip == INVALID_ADDR) {
3491 sc_raise(MSG_MISSING_UNTIL);
3492 print_pass2_stack(i, kwUNTIL, node->level);
3493 return;
3494 }
3495 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3496 break;
3497
3498 case kwUSE:
3499 true_ip = node->pos + (ADDRSZ + ADDRSZ + 1);
3500 false_ip = comp_search_bc_eoc(true_ip);
3501 memcpy(comp_prog.ptr + node->pos + 1, &true_ip, ADDRSZ);
3502 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3503 break;
3504
3505 case kwIF:
3506 case kwELIF:
3507 a_ip = comp_search_bc_stack(i + 1, kwENDIF, node->level, -1);
3508 b_ip = comp_search_bc_stack(i + 1, kwELSE, node->level, -1);
3509 c_ip = comp_search_bc_stack(i + 1, kwELIF, node->level, -1);
3510
3511 false_ip = a_ip;
3512 if (b_ip != INVALID_ADDR && b_ip < false_ip) {
3513 false_ip = b_ip;
3514 }
3515 if (c_ip != INVALID_ADDR && c_ip < false_ip) {
3516 false_ip = c_ip;
3517 }
3518 if (false_ip == INVALID_ADDR) {
3519 sc_raise(MSG_MISSING_ENDIF_OR_ELSE);
3520 print_pass2_stack(i, kwENDIF, node->level);
3521 return;
3522 }
3523
3524 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3525 break;
3526
3527 case kwELSE:
3528 false_ip = comp_search_bc_stack(i + 1, kwENDIF, node->level, -1);
3529
3530 if (false_ip == INVALID_ADDR) {
3531 sc_raise(MSG_MISSING_ENDIF);
3532 print_pass2_stack(i, kwENDIF, node->level);
3533 return;
3534 }
3535
3536 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3537 break;
3538
3539 case kwTYPE_RET:
3540 break;
3541
3542 case kwWEND:
3543 false_ip = comp_search_bc_stack_backward(i - 1, kwWHILE, node->level, -1);
3544 if (false_ip == INVALID_ADDR) {
3545 sc_raise(MSG_MISSING_WHILE);
3546 print_pass2_stack(i, kwWHILE, node->level);
3547 return;
3548 }
3549 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3550 break;
3551
3552 case kwUNTIL:
3553 false_ip = comp_search_bc_stack_backward(i - 1, kwREPEAT, node->level, -1);
3554 if (false_ip == INVALID_ADDR) {
3555 sc_raise(MSG_MISSING_REPEAT);
3556 print_pass2_stack(i, kwREPEAT, node->level);
3557 return;
3558 }
3559 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3560 break;
3561
3562 case kwNEXT:
3563 false_ip = comp_search_bc_stack_backward(i - 1, kwFOR, node->level, -1);
3564 if (false_ip == INVALID_ADDR) {
3565 sc_raise(MSG_MISSING_FOR);
3566 print_pass2_stack(i, kwFOR, node->level);
3567 return;
3568 }
3569 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3570 break;
3571
3572 case kwENDIF:
3573 false_ip = comp_search_bc_stack_backward(i - 1, kwIF, node->level, -1);
3574 if (false_ip == INVALID_ADDR) {
3575 sc_raise(MSG_MISSING_IF);
3576 print_pass2_stack(i, kwIF, node->level);
3577 return;
3578 }
3579 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3580 break;
3581
3582 case kwSELECT:
3583 // next instruction should be CASE (or UDF)
3584 false_ip = comp_next_bc_peek(i + 1);
3585 if (false_ip != kwCASE && false_ip != kwCASE_ELSE && false_ip != kwTYPE_CALL_UDF) {
3586 sc_raise(MSG_MISSING_CASE);
3587 print_pass2_stack(i, kwCASE, node->level);
3588 return;
3589 }
3590 break;
3591
3592 case kwCASE:
3593 // false path is either next case statement or "end select"
3594 false_ip = comp_search_bc_stack(i + 1, kwCASE, node->level, node->block_id);
3595
3596 // avoid finding another CASE or CASE ELSE on the same level, but after END SELECT
3597 j = comp_search_bc_stack(i + 1, kwENDSELECT, node->level, node->block_id);
3598
3599 if (false_ip == INVALID_ADDR || false_ip > j) {
3600 false_ip = comp_search_bc_stack(i + 1, kwCASE_ELSE, node->level, node->block_id);
3601 if (false_ip == INVALID_ADDR || false_ip > j) {
3602 false_ip = j;
3603 if (false_ip == INVALID_ADDR) {
3604 sc_raise(MSG_MISSING_END_SELECT);
3605 print_pass2_stack(i, kwCASE, node->level);
3606 return;
3607 }
3608 }
3609 }
3610
3611 // if expression returns false jump to the next case
3612 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3613 break;
3614
3615 case kwCASE_ELSE:
3616 // check for END SELECT statement
3617 false_ip = comp_search_bc_stack(i + 1, kwENDSELECT, node->level, node->block_id);
3618 if (false_ip == INVALID_ADDR) {
3619 sc_raise(MSG_MISSING_END_SELECT);
3620 print_pass2_stack(i, kwCASE, node->level);
3621 return;
3622 }
3623 // validate no futher CASE expr statements
3624 j = comp_search_bc_stack(i + 1, kwCASE, node->level, node->block_id);
3625 if (j != INVALID_ADDR && j < false_ip) {
3626 sc_raise(MSG_CASE_CASE_ELSE);
3627 print_pass2_stack(i, kwCASE, node->level);
3628 return;
3629 }
3630 // validate no futher CASE ELSE expr statements
3631 j = comp_search_bc_stack(i + 1, kwCASE_ELSE, node->level, node->block_id);
3632 if (j != INVALID_ADDR && j < false_ip) {
3633 sc_raise(MSG_CASE_CASE_ELSE);
3634 print_pass2_stack(i, kwCASE_ELSE, node->level);
3635 return;
3636 }
3637 // if the expression is false jump to the end-select
3638 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3639 break;
3640
3641 case kwENDSELECT:
3642 false_ip = comp_search_bc_stack_backward(i - 1, kwSELECT, node->level, node->block_id);
3643 if (false_ip == INVALID_ADDR) {
3644 sc_raise(MSG_MISSING_SELECT);
3645 print_pass2_stack(i, kwSELECT, node->level);
3646 return;
3647 }
3648 break;
3649
3650 case kwTRY:
3651 true_ip = comp_search_bc_stack(i + 1, kwCATCH, node->level, node->block_id);
3652 if (true_ip == INVALID_ADDR) {
3653 sc_raise(MSG_MISSING_CATCH);
3654 print_pass2_stack(i, kwTRY, node->level);
3655 return;
3656 }
3657 memcpy(comp_prog.ptr + node->pos + 1, &true_ip, ADDRSZ);
3658 break;
3659
3660 case kwCATCH:
3661 true_ip = comp_search_bc_stack(i + 1, kwENDTRY, node->level, node->block_id);
3662 if (true_ip == INVALID_ADDR) {
3663 sc_raise(MSG_MISSING_ENDTRY);
3664 print_pass2_stack(i, kwENDTRY, node->level);
3665 return;
3666 }
3667 // address of the end-try
3668 memcpy(comp_prog.ptr + node->pos + 1, &true_ip, ADDRSZ);
3669
3670 // address of the next catch in the same block
3671 false_ip = comp_search_bc_stack(i + 1, kwCATCH, node->level, node->block_id);
3672 if (false_ip > true_ip) {
3673 // not valid if found after end-try
3674 false_ip = INVALID_ADDR;
3675 }
3676 memcpy(comp_prog.ptr + node->pos + (ADDRSZ + 1), &false_ip, ADDRSZ);
3677 break;
3678
3679 case kwFUNC_RETURN:
3680 // address for the FUNCs kwTYPE_RET
3681 level = comp_prog.ptr[node->pos + BYTE_OFFSET_IN_32];
3682 true_ip = comp_search_bc_stack(i + 1, kwTYPE_RET, level, -1);
3683 if (true_ip != INVALID_ADDR) {
3684 // otherwise error handled elsewhere
3685 memcpy(comp_prog.ptr + node->pos + 1, &true_ip, ADDRSZ);
3686 }
3687 break;
3688 };
3689 }
3690
3691 if (!opt_quiet) {
3692 log_printf(MSG_PASS2_COUNT, comp_sp, comp_sp);
3693 log_printf("\n");
3694 }
3695}
3696
3697int comp_read_goto(bcip_t ip, bcip_t *addr, code_t *level) {
3698 memcpy(addr, comp_prog.ptr + ip, sizeof(bcip_t));
3699 ip += sizeof(bcip_t);
3700 *level = comp_prog.ptr[ip];
3701 return ip + 1;
3702}
3703
3704// scan for repeated kwTYPE_LINE... kwGOTO blocks
3705bcip_t comp_optimise_line_goto(bcip_t ip) {
3706 bcip_t addr;
3707 bcip_t new_addr = 0;
3708 bcip_t new_addr_ip = ip + 1;
3709 code_t level;
3710
3711 ip = comp_read_goto(ip + 1, &addr, &level);
3712 bcip_t goto_ip = addr;
3713
3714 // note: INVALID_ADDR is assumed to be > comp_prog.count
3715 if (goto_ip < comp_prog.count && comp_prog.ptr[goto_ip] == kwTYPE_EOC) {
3716 new_addr = goto_ip + 1;
3717 }
3718 while (goto_ip > -1 && comp_prog.ptr[goto_ip] == kwTYPE_LINE) {
3719 goto_ip += 1 + sizeof(bcip_t);
3720 if (goto_ip < comp_prog.count && comp_prog.ptr[goto_ip] == kwGOTO) {
3721 code_t next_level;
3722 comp_read_goto(goto_ip + 1, &addr, &next_level);
3723 goto_ip = addr;
3724 if (next_level == level) {
3725 // found replacement GOTO address
3726 new_addr = addr;
3727 }
3728 } else {
3729 break;
3730 }
3731 }
3732 if (new_addr != 0 && comp_prog.ptr[new_addr] == kwTYPE_EOC) {
3733 new_addr++;
3734 }
3735 if (new_addr != 0) {
3736 // patch in replacement address
3737 memcpy(comp_prog.ptr + new_addr_ip, &new_addr, sizeof(bcip_t));
3738 }
3739 return ip;
3740}
3741
3742// use simpler LET where possible to avoid eval on the right term
3743bcip_t comp_optimise_let(bcip_t ip) {
3744 bcip_t ip_next = ip + 1;
3745 if (comp_prog.ptr[ip_next] == kwTYPE_VAR) {
3746 ip_next += 1 + sizeof(bcip_t);
3747 while (ip_next < comp_prog.count && comp_prog.ptr[ip_next] != kwTYPE_EOC
3748 && comp_prog.ptr[ip_next] != kwTYPE_LINE) {
3749 if (comp_prog.ptr[ip_next] == kwTYPE_CMPOPR &&
3750 comp_prog.ptr[ip_next + 1] == '=') {
3751 ip_next += 2;
3752 if (ip_next < comp_prog.count &&
3753 comp_prog.ptr[ip_next] == kwTYPE_VAR &&
3754 (comp_prog.ptr[ip_next + 1 + sizeof(bcip_t)] == kwTYPE_EOC ||
3755 comp_prog.ptr[ip_next + 1 + sizeof(bcip_t)] == kwTYPE_LINE)) {
3756 comp_prog.ptr[ip] = kwLET_OPT;
3757 ip = ip_next;
3758 }
3759 break;
3760 }
3761 ip_next = comp_next_bc_cmd(&comp_prog, ip_next);
3762 }
3763 }
3764 return ip;
3765}
3766
3767void comp_optimise() {
3768 for (bcip_t ip = 0; !comp_error && ip < comp_prog.count;
3769 ip = comp_next_bc_cmd(&comp_prog, ip)) {
3770 switch (comp_prog.ptr[ip]) {
3771 case kwTYPE_LINE:
3772 if (comp_prog.ptr[ip + 1 + sizeof(bcip_t)] == kwGOTO) {
3773 ip = comp_optimise_line_goto(ip + 1 + sizeof(bcip_t));
3774 }
3775 break;
3776 case kwLET:
3777 ip = comp_optimise_let(ip);
3778 break;
3779 case kwTYPE_EOC:
3780 if (!opt_autolocal &&
3781 (comp_prog.ptr[ip + 1] == kwTYPE_EOC || comp_prog.ptr[ip + 1] == kwTYPE_LINE)) {
3782 sc_raise(ERR_UNSUPPORTED);
3783 }
3784 break;
3785 default:
3786 break;
3787 }
3788 }
3789}
3790
3791/*
3792 * initialize compiler
3793 */
3794void comp_init() {
3795 comp_bc_sec = malloc(SB_KEYWORD_SIZE + 1);
3796 memset(comp_bc_sec, 0, SB_KEYWORD_SIZE + 1);
3797 comp_bc_name = malloc(SB_SOURCELINE_SIZE + 1);
3798 comp_bc_parm = malloc(SB_SOURCELINE_SIZE + 1);
3799 comp_bc_temp = malloc(SB_SOURCELINE_SIZE + 1);
3800 comp_bc_tmp2 = malloc(SB_SOURCELINE_SIZE + 1);
3801 comp_bc_proc = malloc(SB_SOURCELINE_SIZE + 1);
3802
3803 comp_line = 0;
3804 comp_error = 0;
3805 comp_labcount = 0;
3806 comp_expcount = 0;
3807 comp_impcount = 0;
3808 comp_libcount = 0;
3809 comp_varcount = 0;
3810 comp_sp = 0;
3811 comp_udpcount = 0;
3812 comp_block_level = 0;
3813 comp_block_id = 0;
3814 comp_unit_flag = 0;
3815 comp_first_data_ip = INVALID_ADDR;
3816 comp_proc_level = 0;
3817 comp_bc_proc[0] = '\0';
3818
3819 comp_vartable = (comp_var_t *)malloc(GROWSIZE * sizeof(comp_var_t));
3820 comp_udptable = (comp_udp_t *)malloc(GROWSIZE * sizeof(comp_udp_t));
3821
3822 comp_labtable.count = 0;
3823 comp_labtable.size = 256;
3824 comp_labtable.elem = (comp_label_t **)malloc(comp_labtable.size * sizeof(comp_label_t *));
3825
3826 comp_stack.count = 0;
3827 comp_stack.size = 256;
3828 comp_stack.elem = (comp_pass_node_t **)malloc(comp_stack.size * sizeof(comp_pass_node_t *));
3829
3830 comp_libtable.count = 0;
3831 comp_libtable.elem = NULL;
3832
3833 comp_imptable.count = 0;
3834 comp_imptable.elem = NULL;
3835
3836 comp_exptable.count = 0;
3837 comp_exptable.elem = NULL;
3838
3839 comp_varsize = comp_udpsize = GROWSIZE;
3840 comp_varcount = comp_labcount = comp_sp = comp_udpcount = 0;
3841
3842 bc_create(&comp_prog);
3843 bc_create(&comp_data);
3844
3845 // create system variables
3846 comp_var_getID(LCN_SV_SBVER);
3847 comp_var_getID(LCN_SV_PI);
3848 comp_var_getID(LCN_SV_XMAX);
3849 comp_var_getID(LCN_SV_YMAX);
3850 comp_var_getID(LCN_SV_TRUE);
3851 comp_var_getID(LCN_SV_FALSE);
3852 comp_vartable[comp_var_getID(LCN_SV_CWD)].dolar_sup = 1;
3853 comp_vartable[comp_var_getID(LCN_SV_HOME)].dolar_sup = 1;
3854 comp_vartable[comp_var_getID(LCN_SV_COMMAND)].dolar_sup = 1;
3855 comp_var_getID(LCN_SV_X);
3856 comp_var_getID(LCN_SV_Y);
3857 comp_var_getID(LCN_SV_SELF);
3858 comp_var_getID(LCN_SV_NIL);
3859 comp_var_getID(LCN_SV_MAXINT);
3860}
3861
3862/*
3863 * clean up
3864 */
3865void comp_close() {
3866 int i;
3867
3868 bc_destroy(&comp_prog);
3869 bc_destroy(&comp_data);
3870
3871 for (i = 0; i < comp_varcount; i++) {
3872 free(comp_vartable[i].name);
3873 }
3874 free(comp_vartable);
3875
3876 for (i = 0; i < comp_udpcount; i++) {
3877 free(comp_udptable[i].name);
3878 }
3879 free(comp_udptable);
3880
3881 for (i = 0; i < comp_labtable.count; i++) {
3882 free(comp_labtable.elem[i]);
3883 }
3884 free(comp_labtable.elem);
3885
3886 for (i = 0; i < comp_exptable.count; i++) {
3887 free(comp_exptable.elem[i]);
3888 }
3889 free(comp_exptable.elem);
3890
3891 for (i = 0; i < comp_imptable.count; i++) {
3892 free(comp_imptable.elem[i]);
3893 }
3894 free(comp_imptable.elem);
3895
3896 for (i = 0; i < comp_libtable.count; i++) {
3897 free(comp_libtable.elem[i]);
3898 }
3899 free(comp_libtable.elem);
3900
3901 for (i = 0; i < comp_stack.count; i++) {
3902 free(comp_stack.elem[i]);
3903 }
3904 free(comp_stack.elem);
3905
3906 comp_varcount = comp_labcount = comp_sp = comp_udpcount = 0;
3907 comp_libcount = comp_impcount = comp_expcount = 0;
3908
3909 free(comp_bc_proc);
3910 free(comp_bc_tmp2);
3911 free(comp_bc_temp);
3912 free(comp_bc_parm);
3913 free(comp_bc_name);
3914 free(comp_bc_sec);
3915 comp_reset_externals();
3916}
3917
3918/*
3919 * load a source file
3920 */
3921char *comp_load(const char *file_name) {
3922 char *buf;
3923 strlcpy(comp_file_name, file_name, sizeof(comp_file_name));
3924#if defined(IMPL_DEV_READ)
3925 buf = dev_read(file_name);
3926#else
3927 int h = open(comp_file_name, O_BINARY | O_RDONLY, 0644);
3928 if (h == -1) {
3929 buf = NULL;
3930 panic(MSG_CANT_OPEN_FILE, comp_file_name);
3931 } else {
3932 int size;
3933
3934 size = lseek(h, 0, SEEK_END);
3935 lseek(h, 0, SEEK_SET);
3936
3937 buf = (char *)malloc(size + 1);
3938 read(h, buf, size);
3939 buf[size] = '\0';
3940 close(h);
3941 }
3942#endif
3943 return buf;
3944}
3945
3946/**
3947 * format source-code text
3948 *
3949 * space-chars is the only the space
3950 * CR/LF are fixed
3951 * control chars are out
3952 * remove remarks (')
3953 *
3954 * returns a newly created string
3955 */
3956char *comp_format_text(const char *source) {
3957 int quotes = 0;
3958 int last_ch = 0;
3959 int adj_line_num = 0;
3960 int multi_line_string = 0;
3961 int curley_brace = 0;
3962 int square_brace = 0;
3963 int sl = strlen(source);
3964 char *new_text = malloc(sl + 2);
3965 char *ps = new_text;
3966 char *last_nonsp_ptr = new_text;
3967 const char *p = source;
3968
3969 memset(new_text, 0, sl + 2);
3970 comp_line = 0;
3971
3972 while (*p) {
3973 if (!quotes) {
3974 switch (*p) {
3975 case '\n':
3976 if (*last_nonsp_ptr == '&') {
3977 // join lines
3978 p++;
3979 *last_nonsp_ptr = ' ';
3980 if (*(last_nonsp_ptr - 1) == ' ') {
3981 ps = last_nonsp_ptr;
3982 } else {
3983 ps = last_nonsp_ptr + 1;
3984 }
3985 adj_line_num++;
3986 last_ch = '\n';
3987 } else if (square_brace) {
3988 // code array declared over multiple lines
3989 last_ch = *ps = V_LINE;
3990 ps++;
3991 p++;
3992 } else {
3993 for (int i = 0; i <= adj_line_num; i++) {
3994 // at least one nl
3995 *ps++ = '\n';
3996 }
3997 adj_line_num = 0;
3998 p++;
3999 last_ch = '\n';
4000 }
4001 last_nonsp_ptr = ps - 1;
4002 SKIP_SPACES(p);
4003 break;
4004
4005 case '\'':
4006 // remarks - skip the rest line
4007 while (*p) {
4008 if (*p == '\n') {
4009 break;
4010 }
4011 p++;
4012 }
4013 break;
4014
4015 case ' ':
4016 case '\t':
4017 // spaces
4018 if (last_ch == ' ' || last_ch == '\n') {
4019 p++;
4020 } else {
4021 *ps++ = ' ';
4022 p++;
4023 last_ch = ' ';
4024 }
4025 break;
4026
4027 case '\"':
4028 // quotes
4029 if (p[1] == '\"' && p[2] == '\"') {
4030 multi_line_string = 1;
4031 p += 2;
4032 }
4033 quotes = !quotes;
4034 last_nonsp_ptr = ps;
4035 *ps++ = last_ch = *p++;
4036 break;
4037
4038 case '.':
4039 // advance beyond UDS element, copy same character case
4040 last_ch = *p;
4041 last_nonsp_ptr = ps;
4042 *ps++ = *p++;
4043 while (*p == '_' || isalnum(*p)) {
4044 last_ch = *p;
4045 last_nonsp_ptr = ps;
4046 *ps++ = *p++;
4047 }
4048 break;
4049
4050 case '{':
4051 curley_brace++;
4052 quotes = 1;
4053 multi_line_string = 1;
4054 *ps++ = *p++;
4055 break;
4056
4057 case '[':
4058 square_brace++;
4059 *ps++ = *p++;
4060 break;
4061
4062 case ']':
4063 square_brace--;
4064 *ps++ = *p++;
4065 break;
4066
4067 default:
4068 if ((strcaselessn(p, 5, LCN_REM_1, 5) == 0)
4069 || (strcaselessn(p, 5, LCN_REM_2, 5) == 0)
4070 || (strcaselessn(p, 4, LCN_REM_3, 4) == 0 && last_ch == '\n')
4071 || (strcaselessn(p, 4, LCN_REM_4, 4) == 0 && last_ch == '\n')) {
4072 // skip the rest line
4073 while (*p) {
4074 if (*p == '\n') {
4075 break;
4076 }
4077 p++;
4078 }
4079 break;
4080 } else {
4081 if ((*p > ' ') || (*p < 0)) {
4082 // simple code-character
4083 last_nonsp_ptr = ps;
4084 *ps++ = last_ch = to_upper(*p);
4085 p++;
4086 } else {
4087 // else ignore it (\r filtered here)
4088 p++;
4089 }
4090 }
4091 }
4092 } else {
4093 // in quotes
4094 if (*p == '\\' && (*(p + 1) == '\"' || *(p + 1) == '\\')) {
4095 // add the escaped quote or slash and continue
4096 *ps++ = *p++;
4097 } else if (multi_line_string) {
4098 if (p[0] == '\"' && p[1] == '\"' && p[2] == '\"') {
4099 // end of multi-line string
4100 quotes = 0;
4101 multi_line_string = 0;
4102 // add the single final quote character
4103 p += 2;
4104 } else if (p[0] == '\\' && (p[1] == '\r' || p[1] == '\n')) {
4105 // escape adding the newline
4106 if (p[1] == '\r' && p[2] == '\n') {
4107 p++;
4108 }
4109 p += 2;
4110 // maintain line number
4111 *ps++ = V_JOIN_LINE;
4112 continue;
4113 } else if (p[0] == '\r') {
4114 p++;
4115 continue;
4116 } else if (p[0] == '\"') {
4117 // internal quote escape (see bc_store_string)
4118 *ps++ = V_QUOTE;
4119 p++;
4120 continue;
4121 } else if (p[0] == '\n') {
4122 // internal newline escape
4123 *ps++ = V_LINE;
4124 p++;
4125 continue;
4126 } else if (curley_brace && p[0] == '}') {
4127 if (--curley_brace == 0) {
4128 quotes = 0;
4129 multi_line_string = 0;
4130 }
4131 } else if (p[0] == '{') {
4132 curley_brace++;
4133 }
4134 } else if (*p == '\"' || *p == '\n') {
4135 // join to any adjacent quoted text
4136 const char *next = p + 1;
4137 int lineBreak = 0;
4138 while (is_space(*next)) {
4139 if (*next == '\n') {
4140 lineBreak = 1;
4141 }
4142 next++;
4143 }
4144 if (*next == '\"') {
4145 if (lineBreak) {
4146 // maintain line number
4147 *ps++ = V_JOIN_LINE;
4148 }
4149 p = ++next;
4150 continue;
4151 }
4152 // new line auto-ends the quoted string
4153 quotes = !quotes;
4154 }
4155 *ps++ = *p++;
4156 }
4157 }
4158
4159 // close
4160 *ps++ = '\n';
4161 *ps = '\0';
4162
4163 return new_text;
4164}
4165
4166/**
4167 * scans prefered graphics mode paramaters
4168 *
4169 * syntax: XXXXxYYYY
4170 */
4171void err_grmode() {
4172 // log_printf() instead of sc_raise()... it is just a warning...
4173 log_printf(MSG_GRMODE_ERR);
4174}
4175
4176void comp_preproc_grmode(const char *source) {
4177 // prepare the string (copy it to buffer)
4178 // we use second buffer because we want to place some '\0' characters
4179 // into the buffer in a non-SB code, there must be a dynamic allocation
4180 char buffer[32];
4181 strncpy(buffer, source, 32);
4182 buffer[31] = '\0';
4183 char *p = buffer;
4184
4185 // searching the end of the string
4186 while (*p) {
4187 // while *p is not '\0'
4188 if (*p == '\n' || *p == ':') {
4189 // yeap, we must close the string here (enter or // command-seperator)
4190 // it is supposed that remarks had already removed from source
4191 *p = '\0';
4192 break;
4193 }
4194 p++;
4195 }
4196
4197 p = buffer;
4198 SKIP_SPACES(p);
4199
4200 // 'v' points to first letter of 'width', (1024x768)
4201 char *v = p;
4202
4203 // search for the end of 'width' parameter
4204 // (1024x768). Remeber that the string is in upper-case
4205 p = strchr(v, 'X');
4206 if (!p) {
4207 p = strchr(v, 'x');
4208 }
4209 if (!p) {
4210 // we don't accept one parameter, the width must followed by the height
4211 // so, if 'X' delimiter is omitted, there is no height parameter
4212 err_grmode();
4213 return;
4214 }
4215
4216 // we close the string at X position
4217 // (example: "1024x768" it will be "1024\0768")
4218 *p = '\0';
4219
4220 // now the v points to a string-of-digits,
4221 opt_pref_width = xstrtol(v);
4222
4223 // v points to first letter of 'height'
4224 v = ++p;
4225
4226 // now the v points to a string-of-digits,
4227 opt_pref_height = xstrtol(v);
4228}
4229
4230/**
4231 * copy the unit name from the source string to the given buffer
4232 */
4233const char *get_unit_name(const char *p, char *buf_p) {
4234 while (is_alnum(*p) || *p == '_' || *p == '.') {
4235 if (*p == '.') {
4236 *buf_p++ = OS_DIRSEP;
4237 p++;
4238 } else {
4239 *buf_p++ = *p++;
4240 }
4241 }
4242
4243 *buf_p = '\0';
4244 return p;
4245}
4246
4247const char *get_alias(const char *p, char *alias, const char *def) {
4248 SKIP_SPACES(p);
4249 *alias = '\0';
4250 if (CHKOPT(LCN_AS_WRS)) {
4251 p += LEN_AS_WRS;
4252 while (is_alnum(*p) || *p == '_') {
4253 *alias++ = *p++;
4254 }
4255 *alias = '\0';
4256 } else {
4257 strcpy(alias, def);
4258 }
4259 return p;
4260}
4261
4262/**
4263 * imports units
4264 */
4265void comp_preproc_import(const char *slist) {
4266 char buf[OS_PATHNAME_SIZE + 1];
4267 char alias[OS_PATHNAME_SIZE + 1];
4268
4269 const char *p = slist;
4270
4271 SKIP_SPACES(p);
4272
4273 while (is_alpha(*p)) {
4274 // get name - "Import other.Foo => "other/Foo"
4275 p = get_unit_name(p, buf);
4276 p = get_alias(p, alias, buf);
4277
4278 // import name
4279 strlower(buf);
4280 int uid = slib_get_module_id(buf, alias);
4281 if (uid != -1) {
4282 // store C module lib-record
4283 slib_import(uid, 1);
4284 add_libtable_rec(alias, alias, uid, 0);
4285 } else {
4286 uid = open_unit(buf, alias);
4287 if (uid < 0) {
4288 sc_raise(MSG_UNIT_NOT_FOUND, buf);
4289 return;
4290 }
4291 if (import_unit(uid) < 0) {
4292 sc_raise(MSG_IMPORT_FAILED, buf);
4293 close_unit(uid);
4294 return;
4295 }
4296 // store lib-record
4297 add_libtable_rec(buf, alias, uid, 1);
4298
4299 // clean up
4300 close_unit(uid);
4301 }
4302
4303 // skip spaces and commas
4304 while (*p == ' ' || *p == '\t' || *p == ',') {
4305 p++;
4306 }
4307 }
4308}
4309
4310/**
4311 * makes the current line full of spaces
4312 */
4313void comp_preproc_remove_line(char *s, int cmd_sep_allowed) {
4314 char *p = s;
4315
4316 if (cmd_sep_allowed) {
4317 while (*p != '\n' && *p != ':') {
4318 *p = ' ';
4319 p++;
4320 }
4321 } else {
4322 while (*p != '\n') {
4323 *p = ' ';
4324 p++;
4325 }
4326 }
4327}
4328
4329/**
4330 * prepare compiler for UNIT-source
4331 */
4332void comp_preproc_unit(char *name) {
4333 const char *p = name;
4334
4335 SKIP_SPACES(p);
4336
4337 if (is_alpha(*p)) {
4338 p = get_unit_name(p, comp_unit_name);
4339 comp_unit_flag = 1;
4340 SKIP_SPACES(p);
4341 if (*p != '\n' && *p != ':') {
4342 sc_raise(MSG_UNIT_ALREADY_DEFINED);
4343 }
4344 } else {
4345 sc_raise(MSG_INVALID_UNIT_NAME);
4346 }
4347}
4348
4349/**
4350 * Prepare compiler for INCLUDE source
4351 */
4352void comp_preproc_include(char *p) {
4353 char fileName[OS_PATHNAME_SIZE];
4354 char path[OS_PATHNAME_SIZE];
4355
4356 SKIP_SPACES(p);
4357 if (*p == '\"') {
4358 p++;
4359 }
4360 char *fp = fileName;
4361 int size = 0;
4362 while (*p != '\n' &&
4363 *p != '\"' &&
4364 *p != '\0' &&
4365 ++size < OS_PATHNAME_SIZE) {
4366 *fp++ = *p++;
4367 }
4368 *fp = '\0';
4369
4370 str_alltrim(fileName);
4371 strcpy(path, fileName);
4372
4373 int basExists = (access(path, R_OK) == 0);
4374 if (!basExists && gsb_bas_dir[0]) {
4375 strlcpy(path, gsb_bas_dir, sizeof(path));
4376 strlcat(path, fileName, sizeof(path));
4377 basExists = (access(path, R_OK) == 0);
4378 }
4379 if (!basExists) {
4380 sc_raise(MSG_INC_FILE_DNE, comp_file_name, path);
4381 } else if (strcmp(comp_file_name, path) == 0) {
4382 sc_raise(MSG_INC_FILE_INC, comp_file_name, path);
4383 } else {
4384 char oldFileName[OS_PATHNAME_SIZE + 1];
4385 char oldSec[SB_KEYWORD_SIZE + 1];
4386 strlcpy(oldSec, comp_bc_sec, sizeof(oldSec));
4387 strlcpy(oldFileName, comp_file_name, sizeof(oldFileName));
4388 char *source = comp_load(path);
4389 if (source) {
4390 comp_pass1(NULL, source);
4391 free(source);
4392 }
4393 strcpy(comp_file_name, oldFileName);
4394 strcpy(comp_bc_sec, oldSec);
4395 }
4396}
4397
4398/**
4399 * Handle OPTION environment parameters
4400 */
4401char *comp_preproc_options(char *p) {
4402 SKIP_SPACES(p);
4403 if (strncmp(LCN_PREDEF, p, LEN_PREDEF) == 0) {
4404 p += LEN_PREDEF;
4405 SKIP_SPACES(p);
4406 if (strncmp(LCN_QUIET, p, LEN_QUIET) == 0) {
4407 p += LEN_QUIET;
4408 SKIP_SPACES(p);
4409 opt_quiet = (strncmp("OFF", p, 3) != 0);
4410 } else if (strncmp(LCN_GRMODE, p, LEN_GRMODE) == 0) {
4411 p += LEN_GRMODE;
4412 comp_preproc_grmode(p);
4413 opt_graphics = 1;
4414 } else if (strncmp(LCN_TEXTMODE, p, LEN_TEXTMODE) == 0) {
4415 opt_graphics = 0;
4416 } else if (strncmp(LCN_ANTIALIAS, p, LEN_ANTIALIAS) == 0) {
4417 p += LEN_ANTIALIAS;
4418 SKIP_SPACES(p);
4419 opt_antialias = (strncmp("OFF", p, 3) != 0);
4420 } else if (strncmp(LCN_AUTOLOCAL, p, LEN_AUTOLOCAL) == 0) {
4421 p += LEN_AUTOLOCAL;
4422 opt_autolocal = 1;
4423 } else if (strncmp(LCN_COMMAND, p, LEN_COMMAND) == 0) {
4424 p += LEN_COMMAND;
4425 SKIP_SPACES(p);
4426 char *pe = p;
4427 while (*pe != '\0' && *pe != '\n') {
4428 pe++;
4429 }
4430 char lc = *pe;
4431 *pe = '\0';
4432 if (strlen(p) < OPT_CMD_SZ) {
4433 strcpy(opt_command, p);
4434 } else {
4435 memcpy(opt_command, p, OPT_CMD_SZ - 1);
4436 opt_command[OPT_CMD_SZ - 1] = '\0';
4437 }
4438 *pe = lc;
4439 } else if (strncmp(LCN_LOAD_MODULES, p, LEN_LDMODULES) == 0 &&
4440 opt_modpath[0] != '\0') {
4441 if (!opt_loadmod) {
4442 opt_loadmod = 1;
4443 slib_init();
4444 }
4445 } else {
4446 SKIP_SPACES(p);
4447 char *pe = p;
4448 while (*pe != '\0' && *pe != '\n') {
4449 pe++;
4450 }
4451 *pe = '\0';
4452 sc_raise(MSG_OPT_PREDEF_ERR, p);
4453 }
4454 }
4455 return p;
4456}
4457
4458/**
4459 * Setup the SBASICPATH environment variable.
4460 */
4461void comp_preproc_sbasicpath(char *p) {
4462 SKIP_SPACES(p);
4463 if (*p == '=') {
4464 p++;
4465 SKIP_SPACES(p);
4466 }
4467 if (*p == '\"') {
4468 p++;
4469 char upath[SB_SOURCELINE_SIZE + 1];
4470 char *up = upath;
4471 while (*p != '\n' && *p != '\"') {
4472 *up++ = *p++;
4473 }
4474 *up = '\0';
4475 dev_setenv(LCN_SBASICPATH, upath);
4476 }
4477}
4478
4479/**
4480 * SUB/FUNC/DEF - Automatic declaration - BEGIN
4481 */
4482char *comp_preproc_func_begin(char *p) {
4483 char *dp;
4484 int single_line_f = 0;
4485 char pname[SB_KEYWORD_SIZE + 1];
4486
4487 if (strncmp(LCN_SUB_WRS, p, LEN_SUB_WRS) == 0) {
4488 p += LEN_SUB_WRS;
4489 } else if (strncmp(LCN_FUNC_WRS, p, LEN_FUNC_WRS) == 0) {
4490 p += LEN_FUNC_WRS;
4491 } else {
4492 p += LEN_DEF_WRS;
4493 }
4494 SKIP_SPACES(p);
4495
4496 // copy proc/func name
4497 dp = pname;
4498 while (is_alnum(*p) || *p == '_') {
4499 *dp++ = *p++;
4500 }
4501 *dp = '\0';
4502
4503 // search for '='
4504 while (*p != '\n' && *p != '=') {
4505 p++;
4506 }
4507 if (*p == '=') {
4508 single_line_f = 1;
4509 while (*p != '\n') {
4510 p++;
4511 }
4512 }
4513
4514 // add declaration
4515 if (comp_udp_getip(pname) == INVALID_ADDR) {
4516 comp_add_udp(pname);
4517 } else {
4518 sc_raise(MSG_UDP_ALREADY_DECL, pname);
4519 }
4520
4521 // func/proc name (also, update comp_bc_proc)
4522 if (comp_proc_level) {
4523 strcat(comp_bc_proc, "/");
4524 strcat(comp_bc_proc, baseof(pname, '/'));
4525 } else {
4526 strcpy(comp_bc_proc, pname);
4527 }
4528
4529 if (!single_line_f) {
4530 comp_proc_level++;
4531 } else {
4532 // inline (DEF FN)
4533 char *dol = strrchr(comp_bc_proc, '/');
4534 if (dol) {
4535 *dol = '\0';
4536 } else {
4537 *comp_bc_proc = '\0';
4538 }
4539 }
4540 return p;
4541}
4542
4543/**
4544 * SUB/FUNC/DEF - Automatic declaration - END
4545 */
4546void comp_preproc_func_end(char *p) {
4547 // avoid seeing "END SELECT" which doesn't end a SUB/FUNC
4548 if (strncmp(p, LCN_END_SELECT, LEN_END_SELECT) != 0 &&
4549 strncmp(p, LCN_END_TRY, LEN_END_TRY) != 0) {
4550 char *dol = strrchr(comp_bc_proc, '/');
4551 if (dol) {
4552 *dol = '\0';
4553 } else {
4554 *comp_bc_proc = '\0';
4555 }
4556 comp_proc_level--;
4557 }
4558}
4559
4560/**
4561 * Preprocess handler for pass1
4562 */
4563void comp_preproc_pass1(char *p) {
4564 comp_proc_level = 0;
4565 *comp_bc_proc = '\0';
4566
4567 while (*p) {
4568 if (strncmp(LCN_OPTION, p, LEN_OPTION) == 0) {
4569 // options
4570 p = comp_preproc_options(p + LEN_OPTION);
4571 } else if (strncmp(LCN_IMPORT_WRS, p, LEN_IMPORT) == 0) {
4572 // import
4573 comp_preproc_import(p + LEN_IMPORT);
4574 comp_preproc_remove_line(p, 1);
4575 } else if (strncmp(LCN_UNIT_WRS, p, LEN_UNIT) == 0) {
4576 // unit
4577 if (comp_unit_flag) {
4578 sc_raise(MSG_MANY_UNIT_DECL);
4579 } else {
4580 comp_preproc_unit(p + LEN_UNIT);
4581 }
4582 comp_preproc_remove_line(p, 1);
4583 } else if (strncmp(LCN_SBASICPATH, p, LEN_SBASICPATH) == 0) {
4584 // sbasicpath
4585 comp_preproc_sbasicpath(p + LEN_SBASICPATH);
4586 comp_preproc_remove_line(p, 0);
4587 } else if (strncmp(LCN_INC, p, LEN_INC) == 0) {
4588 // include
4589 comp_preproc_include(p + LEN_INC);
4590 comp_preproc_remove_line(p, 0);
4591 } else if ((strncmp(LCN_SUB_WRS, p, LEN_SUB_WRS) == 0) ||
4592 (strncmp(LCN_FUNC_WRS, p, LEN_FUNC_WRS) == 0) ||
4593 (strncmp(LCN_DEF_WRS, p, LEN_DEF_WRS) == 0)) {
4594 // sub/func
4595 p = comp_preproc_func_begin(p);
4596 } else if (comp_proc_level &&
4597 (strncmp(LCN_END_WRS, p, LEN_END_WRS) == 0 ||
4598 strncmp(LCN_END_WNL, p, LEN_END_WRS) == 0)) {
4599 // end sub/func
4600 comp_preproc_func_end(p);
4601 } else if (strncasecmp(LCN_SHOWPAGE, p, LEN_SHOWPAGE) == 0) {
4602 opt_show_page = 1;
4603 }
4604
4605 // skip text line
4606 while (*p != '\0' && *p != '\n') {
4607 p++;
4608 }
4609
4610 if (*p) {
4611 p++;
4612 }
4613 }
4614
4615 if (comp_proc_level) {
4616 sc_raise(MSG_UDP_MIS_END_2, comp_file_name, comp_bc_proc);
4617 }
4618 comp_proc_level = 0;
4619 *comp_bc_proc = '\0';
4620
4621 if (!opt_quiet) {
4622 log_printf("%s: \033[1m%s\033[0m\n", WORD_FILE, comp_file_name);
4623 }
4624}
4625
4626/**
4627 * PASS 1
4628 *
4629 * Check for:
4630 * INCLUDE
4631 * UNITS-DIR (#unit-path:)
4632 * IMPORT
4633 * UDF and UDP declarations
4634 * PREDEF OPTIONS
4635 */
4636int comp_pass1(const char *section, const char *text) {
4637 memset(comp_bc_sec, 0, SB_KEYWORD_SIZE + 1);
4638 if (section) {
4639 strncpy(comp_bc_sec, section, SB_KEYWORD_SIZE);
4640 } else {
4641 strncpy(comp_bc_sec, SYS_MAIN_SECTION_NAME, SB_KEYWORD_SIZE);
4642 }
4643
4644 char *code_line = malloc(SB_SOURCELINE_SIZE + 1);
4645 char *new_text = comp_format_text(text);
4646
4647 comp_preproc_pass1(new_text);
4648 if (!comp_error) {
4649 if (!opt_quiet) {
4650 log_printf(MSG_PASS1_COUNT, comp_line + 1);
4651 }
4652
4653 char *ps = new_text;
4654 char *p = ps;
4655 int line_size = 0;
4656 while (*p) {
4657 if (*p == '\n') {
4658 // proceed
4659 *p = '\0';
4660 comp_line++;
4661 if (!opt_quiet) {
4662 if ((comp_line % 256) == 0) {
4663 log_printf(MSG_PASS1_COUNT, comp_line);
4664 }
4665 }
4666
4667 strcpy(code_line, ps);
4668 comp_text_line(code_line, 1);
4669
4670 if (comp_error) {
4671 break;
4672 }
4673 ps = p + 1;
4674 line_size = 0;
4675 }
4676 if (comp_error) {
4677 break;
4678 }
4679 p++;
4680 if (++line_size >= SB_SOURCELINE_SIZE) {
4681 *p = '\0';
4682 sc_raise(ERR_LINE_LENGTH, p - 50);
4683 break;
4684 }
4685 }
4686 }
4687
4688 free(code_line);
4689 free(new_text);
4690
4691 // undefined keywords by default are UDP - error if no UDP-body
4692 if (!comp_error) {
4693 int i;
4694 for (i = 0; i < comp_udpcount; i++) {
4695 if (comp_udptable[i].ip == INVALID_ADDR) {
4696 comp_line = comp_udptable[i].pline;
4697 char *dot = strchr(comp_udptable[i].name, '.');
4698 if (dot) {
4699 if (comp_check_lib(comp_udptable[i].name) == 2) {
4700 sc_raise(MSG_MODULE_NO_RETURN, comp_udptable[i].name);
4701 } else {
4702 sc_raise(MSG_UNDEFINED_MAP, comp_udptable[i].name);
4703 }
4704 } else {
4705 if (comp_is_func(comp_udptable[i].name) != -1) {
4706 sc_raise(MSG_FUNC_NOT_ASSIGNED, comp_udptable[i].name);
4707 } else {
4708 sc_raise(MSG_UNDEFINED_UDP, comp_udptable[i].name);
4709 }
4710 }
4711 break;
4712 }
4713 }
4714 }
4715
4716 bc_eoc(&comp_prog);
4717 bc_resize(&comp_prog, comp_prog.count);
4718 if (!comp_error && !opt_quiet) {
4719 log_printf(MSG_PASS1_FIN, comp_line + 1);
4720 log_printf("\n");
4721 }
4722
4723 return (comp_error == 0);
4724}
4725
4726/**
4727 * setup export table
4728 */
4729int comp_pass2_exports() {
4730 int i, j;
4731
4732 for (i = 0; i < comp_expcount; i++) {
4733 bid_t pid;
4734 unit_sym_t *sym = comp_exptable.elem[i];
4735
4736 // look on procedures/functions
4737 if ((pid = comp_udp_id(sym->symbol, 0)) != -1) {
4738 if (comp_udptable[pid].vid == INVALID_ADDR) {
4739 sym->type = stt_procedure;
4740 } else {
4741 sym->type = stt_function;
4742 }
4743 sym->address = comp_udptable[pid].ip;
4744 sym->vid = comp_udptable[pid].vid;
4745 } else {
4746 // look on variables
4747 pid = -1;
4748 for (j = 0; j < comp_varcount; j++) {
4749 if (strcmp(comp_vartable[j].name, sym->symbol) == 0) {
4750 pid = j;
4751 break;
4752 }
4753 }
4754
4755 if (pid != -1) {
4756 sym->type = stt_variable;
4757 sym->address = 0;
4758 sym->vid = j;
4759 } else {
4760 sc_raise(MSG_EXP_SYM_NOT_FOUND, sym->symbol);
4761 return 0;
4762 }
4763 }
4764 }
4765
4766 return (comp_error == 0);
4767}
4768
4769/*
4770 * PASS 2
4771 */
4772int comp_pass2() {
4773 if (!opt_quiet) {
4774 log_printf(MSG_PASS2);
4775 }
4776
4777 if (comp_proc_level) {
4778 sc_raise(MSG_MISSING_END_3);
4779 } else if (comp_prog.size) {
4780 bc_add_code(&comp_prog, kwSTOP);
4781 comp_first_data_ip = comp_prog.count;
4782 comp_pass2_scan();
4783 comp_optimise();
4784 }
4785
4786 if (comp_block_level && (comp_error == 0)) {
4787 sc_raise(MSG_LOOPS_OPEN, comp_block_level);
4788 }
4789 if (comp_data.count) {
4790 bc_append(&comp_prog, &comp_data);
4791 }
4792 if (comp_expcount) {
4793 comp_pass2_exports();
4794 }
4795 return (comp_error == 0);
4796}
4797
4798/*
4799 * final, create bytecode
4800 */
4801byte_code comp_create_bin() {
4802 int i;
4803 byte_code bc;
4804 byte *cp;
4805 bc_head_t hdr;
4806 uint32_t size;
4807 unit_file_t uft;
4808
4809 if (!opt_quiet) {
4810 if (comp_unit_flag) {
4811 log_printf(MSG_CREATING_UNIT, comp_unit_name);
4812 } else {
4813 log_printf(MSG_CREATING_BC);
4814 }
4815 }
4816
4817 memcpy(&hdr.sign, "SBEx", 4);
4818 hdr.ver = 2;
4819 hdr.sbver = SB_DWORD_VER;
4820#if defined(CPU_BIGENDIAN)
4821 hdr.flags = 1;
4822#else
4823 hdr.flags = 0;
4824#endif
4825
4826 // executable header
4827 hdr.flags |= 4;
4828 hdr.bc_count = comp_prog.count;
4829 hdr.var_count = comp_varcount;
4830 hdr.lab_count = comp_labcount;
4831 hdr.data_ip = comp_first_data_ip;
4832 hdr.size = sizeof(bc_head_t) + comp_prog.count + (comp_labcount * ADDRSZ) +
4833 sizeof(unit_sym_t) * comp_expcount +
4834 sizeof(bc_lib_rec_t) * comp_libcount +
4835 sizeof(bc_symbol_rec_t) * comp_impcount;
4836 if (comp_unit_flag) {
4837 hdr.size += sizeof(unit_file_t);
4838 }
4839
4840 hdr.lib_count = comp_libcount;
4841 hdr.sym_count = comp_impcount;
4842 if (comp_unit_flag) {
4843 memset(&uft, 0, sizeof(unit_file_t));
4844
4845 // it is a unit... add more info
4846 bc.size = hdr.size;
4847 bc.code = calloc(bc.size, 1);
4848
4849 // unit header
4850 memcpy(&uft.sign, "SBUn", 4);
4851 uft.version = SB_DWORD_VER;
4852
4853 strlcpy(uft.base, comp_unit_name, sizeof(uft.base));
4854 uft.sym_count = comp_expcount;
4855
4856 memcpy(bc.code, &uft, sizeof(unit_file_t));
4857 cp = bc.code + sizeof(unit_file_t);
4858
4859 // unit symbol table (export)
4860 for (i = 0; i < uft.sym_count; i++) {
4861 unit_sym_t *sym = comp_exptable.elem[i];
4862 memcpy(cp, sym, sizeof(unit_sym_t));
4863 cp += sizeof(unit_sym_t);
4864 }
4865
4866 // normal file
4867 memcpy(cp, &hdr, sizeof(bc_head_t));
4868 cp += sizeof(bc_head_t);
4869 } else {
4870 // simple executable
4871 bc.size = hdr.size + 4;
4872 bc.code = calloc(bc.size, 1);
4873 cp = bc.code;
4874 memcpy(cp, &hdr, sizeof(bc_head_t));
4875 cp += sizeof(bc_head_t);
4876 }
4877
4878 // append label table
4879 for (i = 0; i < comp_labcount; i++) {
4880 comp_label_t *label = comp_labtable.elem[i];
4881 memcpy(cp, &label->ip, ADDRSZ);
4882 cp += ADDRSZ;
4883 }
4884
4885 // append library table
4886 for (i = 0; i < comp_libcount; i++) {
4887 bc_lib_rec_t *lib = comp_libtable.elem[i];
4888 memcpy(cp, lib, sizeof(bc_lib_rec_t));
4889 cp += sizeof(bc_lib_rec_t);
4890 }
4891
4892 // append symbol table
4893 for (i = 0; i < comp_impcount; i++) {
4894 bc_symbol_rec_t *sym = comp_imptable.elem[i];
4895 memcpy(cp, sym, sizeof(bc_symbol_rec_t));
4896 cp += sizeof(bc_symbol_rec_t);
4897 }
4898
4899 size = cp - bc.code;
4900
4901 // the program itself
4902 memcpy(cp, comp_prog.ptr, comp_prog.count);
4903
4904 size += comp_prog.count;
4905
4906 // print statistics
4907 if (!opt_quiet) {
4908 log_printf("\n");
4909 log_printf(RES_NUMBER_OF_VARS, comp_varcount, comp_varcount - SYSVAR_COUNT);
4910 log_printf(RES_NUMBER_OF_LABS, comp_labcount);
4911 log_printf(RES_NUMBER_OF_UDPS, comp_udpcount);
4912 log_printf(RES_CODE_SIZE, comp_prog.count);
4913 log_printf("\n");
4914 log_printf(RES_IMPORTED_LIBS, comp_libcount);
4915 log_printf(RES_IMPORTED_SYMS, comp_impcount);
4916 log_printf(RES_EXPORTED_SYMS, comp_expcount);
4917 log_printf("\n");
4918 log_printf(RES_FINAL_SIZE, size);
4919 log_printf("\n");
4920 }
4921
4922 return bc;
4923}
4924
4925/**
4926 * save binary
4927 *
4928 * @param h_bc is the memory-handle of the bytecode (created by create_bin)
4929 * @return non-zero on success
4930 */
4931int comp_save_bin(byte_code bc) {
4932 char fname[OS_FILENAME_SIZE + 1];
4933 int result = 1;
4934
4935 if (opt_nosave && !comp_unit_flag) {
4936 return 1;
4937 }
4938
4939 strlcpy(fname, comp_file_name, sizeof(fname));
4940 char *p = strrchr(fname, '.');
4941 if (p) {
4942 *p = '\0';
4943 }
4944 strcat(fname, comp_unit_flag ? ".sbu" : ".sbx");
4945
4946 int h = open(fname, O_BINARY | O_RDWR | O_TRUNC | O_CREAT, 0660);
4947 if (h != -1) {
4948 write(h, (char *)bc.code, bc.size);
4949 close(h);
4950 if (!opt_quiet) {
4951 log_printf(MSG_BC_FILE_CREATED, fname);
4952 }
4953 } else {
4954 // non-fatal error
4955 result = 0;
4956 }
4957
4958 return result;
4959}
4960
4961/**
4962 * compiler - main
4963 *
4964 * @param sb_file_name the source file-name
4965 * @return non-zero on success
4966 */
4967int comp_compile(const char *sb_file_name) {
4968 char *source;
4969 int tid, prev_tid;
4970 int success = 0;
4971 byte_code bc;
4972
4973 bc.code = NULL;
4974 bc.size = 0;
4975
4976 tid = create_task(sb_file_name);
4977 prev_tid = activate_task(tid);
4978
4979 comp_reset_externals();
4980 comp_init(); // initialize compiler
4981
4982 source = comp_load(sb_file_name); // load file and run pre-processor
4983 if (source) {
4984 success = comp_pass1(NULL, source); // PASS1
4985 free(source);
4986 if (success) {
4987 success = comp_pass2(); // PASS2
4988 }
4989 if (success) {
4990 success = comp_check_labels();
4991 }
4992 if (success) {
4993 bc = comp_create_bin();
4994 success = comp_save_bin(bc);
4995 }
4996 }
4997
4998 int is_unit = comp_unit_flag;
4999 int error = comp_error;
5000 comp_close();
5001 close_task(tid);
5002 activate_task(prev_tid);
5003 ctask->bc_type = is_unit ? 2 : 1;
5004 ctask->error = error;
5005
5006 if (opt_nosave && !is_unit) {
5007 ctask->bytecode = bc.code;
5008 } else if (bc.code) {
5009 free(bc.code);
5010 }
5011
5012 return success;
5013}
5014
5015/**
5016 * compiler - main.
5017 *
5018 * @param source buffer
5019 * @return non-zero on success
5020 */
5021int comp_compile_buffer(const char *source) {
5022 comp_init(); // initialize compiler
5023 int success = comp_pass1(NULL, source); // PASS1
5024 if (success) {
5025 success = comp_pass2(); // PASS2
5026 }
5027 if (success) {
5028 success = comp_check_labels();
5029 }
5030 if (success) {
5031 byte_code bc = comp_create_bin(); // update task's bytecode
5032 ctask->bytecode = bc.code;
5033 }
5034 comp_close();
5035 return success;
5036}
5037