Mercurial > ~dholland > hg > ag > index.cgi

comparison tests/agcl/oldagsrc/dsl-2.syn @ 0:13d2b8934445

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import AnaGram (near-)release tree into Mercurial.
author David A. Holland
date Sat, 22 Dec 2007 17:52:45 -0500
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:13d2b8934445
1 { // C Prologue
2 /*
3 AnaGram, a System for Syntax Directed Programming
4
5 A Dos Script Language
6
7 Copyright (c) 1993, 1996 Parsifal Software.
8 All Rights Reserved.
9
10 */
11
12
13 #include "stack.h"
14 #include "charsink.h"
15 #include "strdict.h"
16 #include "array.h"
17 #include "symbol.h"
18 #include "query.h"
19 #include <conio.h>
20
21 #ifdef __BCPLUSPLUS__
22 #define ARGS ((char **) args)
23
24 extern unsigned _stklen = 0x4000; // set stack size
25
26 #else
27 #define ARGS ((char const * const *) (char **) args)
28 #endif
29
30
31 // Define stacks for temporary storage
32
33 stack <action_pointer> as(25); // Stack actions
34 stack <int> is(100); // Stack string indices
35 stack <char *> ps(1000,20); // Stack parameter strings
36 stack <query_item> qs(23); // Stack query items
37
38
39 // Define data structures for symbol table
40
41 #define N_STRINGS 2000
42
43 string_accumulator sa(64000U,500);
44 string_dictionary sd(N_STRINGS);
45 array <symbol_table_entry> st(N_STRINGS);
46
47 } // End of C Prologue
48
49
50 // Character Set Definitions
51
52 digit = '0-9'
53 eof = 0 + ^Z
54 letter = 'a-z' + 'A-Z' + '_'
55 not double quote = ~eof - ('"' + '\\' + '\n')
56 not eol = ~(eof + '\n')
57 not paren = ~(eof + '(' + ')')
58 not single quote = ~eof - ('\'' + '\\' + '\n')
59 operator = '#' + '=' + '<' + '>' + '|'
60 punctuation = '(' + ')' + '{' + '}' + '[' + ']' + '"' + '\n'
61 text char = ~(eof + operator + white + punctuation + '@')
62 white = ' ' + '\t' + '\v' + '\f' + '\r'
63
64
65 // Configuration Section
66
67 [
68 // White space control
69 disregard ws
70 lexeme {literal, integer constant, string literal, paren string,
71 character constant, eol, name}
72 distinguish lexemes
73
74 // parser configuration
75 pointer input
76 context type = action_pointer
77 distinguish keywords {letter + digit}
78 parser file name = "#.cpp"
79
80 // Debugging options
81 line numbers
82 test file mask = "*.dsl"
83 ]
84
85
86 // White Space Definitions
87
88 ws
89 -> white | comment
90
91 comment
92 -> comment head, "*/"
93
94 comment head
95 -> "/*"
96 -> comment head, ~eof
97
98 // Comment out one of the following two productions to determine whether
99 // comments nest or not
100
101 comment head
102 -> comment head, comment // comments nest
103
104 /*
105 comment
106 -> comment head, comment // comments do not nest
107 */
108
109 eol
110 -> '\n'
111 -> "//", not eol?..., '\n' // C++ style comments
112
113
114
115 // Script File Description
116
117 script file $
118 -> [execution block | declaration | eol]..., eof
119
120
121 // Dos Command and Parameter Recognition
122
123 word
124 -> paren string
125 -> string literal
126 -> integer variable:v =++sa << sd[v], lookup();
127 -> string variable:v =++sa << sd[v], lookup();
128 -> undeclared variable:v =++sa << sd[v], lookup();
129 -> word, '[', !sa << '[';,
130 parameter string, ']' =concat(sa) << ']', lookup();
131
132 string
133 -> word
134 -> string, '#', word =concat(sa);
135
136 parameter string
137 -> param word
138 -> parameter string, '#',
139 param word =concat(sa);
140
141 literal
142 -> text char:c =++sa << c;
143 -> literal, text char:c =sa << c;
144
145 param word
146 -> word
147 -> action text =action_string();
148
149
150 // Gather, but do not execute, the text of an action block
151
152 action text
153 -> action text head, '}'
154
155 action text head
156 -> '{' =as << CONTEXT;
157 -> action text head, action word
158 -> action text head, eol
159 -> action text head, action text ={action_pointer a; as >> a;}
160 -> action text head, operator+'@'
161
162
163 action word
164 -> paren string =--sa;
165 -> string literal =--sa;
166 -> literal =--sa;
167 -> action word, '[', action parameter string, ']'
168
169 action parameter string
170 -> action param word
171 -> action parameter string, '#',
172 action param word
173
174 action param word
175 -> action word
176 -> action text
177
178
179 /*****
180
181 Parenthesized string
182
183 May contain any characters inside balanced parentheses. If parentheses
184 are included, they must balance. Outer parentheses are stripped before
185 use.
186
187 *****/
188
189 paren string
190 -> paren string chars, ')'
191
192 paren string chars
193 -> '(' =++sa;
194 -> paren string chars, paren string char
195
196 paren string char
197 -> not paren:c =sa << c;
198 -> !sa << '(';, paren string chars, ')' =concat(sa) << ')';
199
200
201 /*****
202
203 String Literal
204
205 Follows the same rules as for string literals in C and C++
206
207 *****/
208
209 string literal
210 -> string chars, '"'
211
212 string chars
213 -> '"' =++sa;
214 -> string chars, string char
215
216 string char
217 -> not double quote:c =sa << c;
218 -> escape sequence:c =sa << c;
219
220 (int) escape sequence
221 -> "\\a" ='\a';
222 -> "\\b" ='\b';
223 -> "\\f" ='\f';
224 -> "\\n" ='\n';
225 -> "\\r" ='\r';
226 -> "\\t" ='\t';
227 -> "\\v" ='\v';
228 -> "\\\\" ='\\';
229 -> "\\?" = '\?';
230 -> "\\'" ='\'';
231 -> "\\\"" ='"';
232 -> octal escape
233 -> hex escape
234
235 (int) octal escape
236 -> one octal | two octal | three octal
237
238 (int) one octal
239 -> '\\', '0-7':d =d-'0';
240
241 (int) two octal
242 -> one octal:n, '0-7':d =8*n + d-'0';
243
244 (int) three octal
245 -> two octal:n, '0-7':d =8*n + d-'0';
246
247 (int) hex escape
248 -> "\\x", hex number:n =(int) n;
249
250 (long) hex number
251 -> hex digit
252 -> hex number:n, hex digit:d =16*n + d;
253
254 [
255 sticky {one octal, two octal, hex number}
256 ]
257
258
259 /*****
260
261 Command Line Interpretation
262
263 The identifier may be the name of a DOS command, internal or external,
264 a path name of an arbitrary executable, or an internal commmand of the
265 scripting language. It may appear literally, or may be the result of
266 string concatenation and substitution.
267
268 command is used in the program logic section, below.
269
270 *****/
271
272 command
273 -> identifier, parameters? =exec();
274 -> identifier, parameters?,
275 '<', parameter string =exec_redirect_in();
276 -> piped command:file, '|',
277 identifier, parameters? =exec_pipe_in(file);
278 -> piped command:file, '>',
279 parameter string =grab_output(file);
280 -> piped command:file, ">>",
281 parameter string =append_output(file);
282
283 (char *) piped command
284 -> identifier, parameters? =exec_pipe_out();
285 -> identifier, parameters?,
286 '<', parameter string =exec_redirect_in_pipe_out();
287 -> piped command:file, '|',
288 identifier, parameters? =exec_pipe_in_pipe_out(file);
289
290 identifier
291 -> string =sa << 0, ++ps << sa;
292
293 parameters
294 -> parameter string =ps << sa, sa << 0;
295 -> parameters, parameter string =ps << sa, sa << 0;
296
297
298 /*****
299
300 Program logic.
301
302 This section of syntax controls the interpretation of a sequence
303 of commands enclosed within braces.
304
305 *****/
306
307 execution block
308 -> '{', eol?...,[command sequence, eol?... | if sequence, eol?...], '}'
309
310
311 /*****
312
313 A command sequence is any sequence of statements and
314 if statements that ends with a statement.
315
316 *****/
317
318 command sequence
319 -> statement
320 -> command sequence, eol..., statement
321 -> if sequence, eol..., statement
322 -> if sequence:pc, eol?...,
323 "else", action text =do_if(pc,1);
324
325 /*****
326
327 An if sequence is any direct sequence of statements and if statements
328 that ends with an if statement. The difference between an "if sequence" and
329 a "command sequence" is that an else clause may follow the "if sequence".
330
331 *****/
332
333 (int) if sequence
334 -> if statement
335 -> if sequence, eol..., if statement:cc =cc;
336 -> command sequence, eol..., if statement:cc =cc;
337 -> if sequence:pc, eol?..., "else", eol?...,
338 if condition:cc, action text =do_if(pc,cc!=0);
339
340 (int) if condition
341 -> "if",
342 '(', conditional exp:cc, ')' =(int) cc;
343
344 (int) if statement
345 -> if condition:cc, action text =do_if(0,cc != 0);
346
347 /*****
348
349 A statement is any command that isn't an if or else statement.
350 The iteration on the while statement is a ruse.
351
352 *****/
353
354 statement
355 -> command
356 -> assignment
357 -> for statement
358 -> declaration
359 -> screen description
360 -> while statement...
361
362
363 /*****
364
365 Assignment statements
366
367 There are four varieties of assignment statement depending on whether
368 or how the variable on the left hand side has been previously declared.
369
370 *****/
371
372 assignment
373 -> undeclared variable:v, '=',
374 parameter string =assign_value(v);
375 -> integer variable:v, '=',
376 conditional exp:x, ';'? =st[v].data.integer = (int) x;
377 -> string variable:v, '=',
378 string exp, ';'? =st[v].data.text = copy(sa--);
379 -> string variable:v, '@',
380 primary exp:n, '=',
381 conditional exp:x, ';'? =st[v].data.text[(unsigned)n] = (char) x;
382
383
384 /*****
385
386 Semantically determined production to determine treatment of variable
387 on left side of assignment statement.
388
389 *****/
390
391 (unsigned) integer variable,
392 string variable,
393 undeclared variable
394 -> literal =check_integer();
395
396
397 /*****
398
399 While Statement
400
401 The While statement loops by simply resetting the input pointer for
402 the parser back to the beginning of the while loop. This is the reason
403 for the iteration of the while statement in the production for "simple
404 command".
405
406 *****/
407
408 while statement
409 -> "while", '(', conditional exp:cc, ')',
410 action text =do_while(cc != 0);
411
412
413 /*****
414
415
416
417 For Statement
418
419 This for statement corresponds to the for statement in the DOS batch
420 programming language, not the for statement in C.
421
422 *****/
423
424 for statement
425 -> "for", name, // !++sa << '(';,
426 "in", parameter string,
427 "do"?, action text =do_for_loop();
428
429
430 /*****
431
432 Declaration statements
433
434 *****/
435
436 declaration
437 -> "action", literals:n,
438 action text =define_action(n);
439 -> "int",
440 name, '=', conditional exp:x, ';'? =define_integer(sa--, x);
441 -> "string",
442 name, '=', string exp, ';'? =define_string();
443
444 (int) literals
445 -> literal =0;
446 -> literals:n, literal =n+1;
447
448
449 name
450 -> letter:c =++sa << c;
451 -> name, letter:c =sa << c;
452 -> name, digit:c =sa << c;
453
454
455 /*****
456
457 Integer and String Expression Logic
458
459 The syntax for expressions is essentially that of C, with the addition
460 of string comparison. The only missing operators are ++, --, and comma.
461
462 *****/
463
464
465 (long) conditional exp
466 -> logical or exp
467 -> logical or exp:c, '?', conditional exp:x, ':',
468 conditional exp:y = c != 0 ? x : y;
469
470 (long) logical or exp
471 -> logical and exp
472 -> logical or exp:x, "||",
473 logical and exp:y =x != 0 || y!=0;
474
475 (long) logical and exp
476 -> inclusive or exp
477 -> logical and exp:x, "&&",
478 inclusive or exp:y =x != 0 && y !=0;
479
480 (long) inclusive or exp
481 -> exclusive or exp
482 -> inclusive or exp:x, '|',
483 exclusive or exp:y =x | y;
484
485 (long) exclusive or exp
486 -> and exp
487 -> exclusive or exp:x, '^', and exp:y =x ^ y;
488
489 (long) and exp
490 -> equality exp
491 -> and exp:x, '&', equality exp:y =x & y;
492
493 (long) equality exp
494 -> relational exp
495 -> equality exp:x, "==", relational exp:y =x == y;
496 -> equality exp:x, "!=", relational exp:y =x != y;
497 -> string exp, "==", string exp =string_comp() == 0;
498 -> string exp, "!=", string exp =string_comp() != 0;
499
500
501 (long) relational exp
502 -> shift exp
503 -> relational exp:x, '<', shift exp:y =x < y;
504 -> relational exp:x, '>', shift exp:y =x > y;
505 -> relational exp:x, "<=", shift exp:y =x <= y;
506 -> relational exp:x, ">=", shift exp:y =x >= y;
507 -> string exp, '<', string exp =string_comp() < 0;
508 -> string exp, '>', string exp =string_comp() > 0;
509 -> string exp, "<=", string exp =string_comp() <= 0;
510 -> string exp, ">=", string exp =string_comp() >= 0;
511
512 (long) shift exp
513 -> additive exp
514 -> shift exp:x, "<<", additive exp:y =x << (int) y;
515 -> shift exp:x, ">>", additive exp:y =x >> (int) y;
516
517 (long) additive exp
518 -> multiplicative exp
519 -> additive exp:x, '+',
520 multiplicative exp:y =x + y;
521 -> additive exp:x, '-',
522 multiplicative exp:y =x - y;
523
524 (long) multiplicative exp
525 -> unary exp
526 -> multiplicative exp:x, '*', unary exp:y =x * y;
527 -> multiplicative exp:x, '/', nonzero:y =x / y;
528 -> multiplicative exp:x, '%', nonzero:y =x % y;
529
530 (long) nonzero
531 -> unary exp: x ={
532 assert(x);
533 return x;
534 }
535
536 (long) unary exp
537 -> primary exp
538 -> '+', unary exp:x =x;
539 -> '-', unary exp:x =-x;
540 -> '~', unary exp:x =~x;
541 -> '!', unary exp:x =!x;
542
543 (long) primary exp
544 -> integer constant
545 -> character constant
546 -> string term,'@', primary exp:n =((unsigned char *) sa--)[(unsigned) n];
547 -> '#', string element ={
548 long temp;
549 sscanf(sa--, "%ld", &temp);
550 return temp;
551 }
552 -> numeric name
553 -> '(', conditional exp:x, ')' =x;
554 -> built_in name:x, built_in argument =(*st[(unsigned)x].data.func)();
555
556 built_in argument
557 -> '(', parameter string, ')'
558
559 (long) numeric name,
560 string name,
561 built_in name,
562 undefined name
563 -> name =name_type();
564
565
566 /*****
567
568 String Expressions
569
570 *****/
571
572 string exp
573 -> string term
574 -> string exp, '#', string term =concat(sa);
575
576 string term
577 -> string element
578 -> string term, '@', '(',
579 conditional exp:first, "..",
580 conditional exp:last, ')' =extract((unsigned)first, (unsigned) last);
581 -> string term, '[', !sa << '[';,
582 parameter string, ']' =concat(sa) << ']', lookup();
583
584 string element
585 -> string literal
586 -> string name:x =++sa << st[(unsigned)x].data.text;
587 -> undefined name:x =++sa << sd[(unsigned)x];
588 -> action text =action_string();
589 -> '=', primary exp:x =++sa,sa.printf("%ld",x);
590 -> '(', string exp, ')'
591
592 /*****
593
594 Integer constants
595
596 The syntax for integer constants is identical to that in C.
597
598 *****/
599
600 integer constant
601 -> hex constant
602 -> octal constant
603 -> decimal constant
604
605 (long) hex constant
606 -> {"0x" | "0X"} =0;
607 -> hex constant:x, hex digit:d =16*x + d-'0';
608
609 (long) hex digit
610 -> '0-9'
611 -> 'a-f' + 'A-F':d =(d&7) + 9;
612
613 (long) octal constant
614 -> '0' =0;
615 -> octal constant:n, '0-7':d =8*n + d-'0';
616
617 (long) decimal constant
618 -> '1-9':d =d-'0';
619 -> decimal constant:n, '0-9':d =10*n + d-'0';
620
621
622 /*****
623
624 Character Constant
625
626 The rules for character constant are the same as in C.
627
628 *****/
629
630 (int) character constant
631 -> '\'', char constant element:c, '\'' =c;
632
633 (int) char constant element
634 -> not single quote
635 -> escape sequence
636
637
638 /*****
639
640 Screen Display
641
642 *****/
643
644 screen description
645 -> screen items:scd, '}' =display_queries(scd);
646
647 (screen_descriptor *) screen items
648 -> "screen", '{' =reset(qs), new screen_descriptor;
649 -> screen items, eol
650 -> screen items:scd,
651 "title", '=',
652 formula, eol =scd->title = formula(), scd;
653 -> screen items:scd,
654 color spec:c, eol =scd->color = (char) c, scd;
655 -> screen items:scd,
656 "entry", color spec:c, eol =scd->entry_color = (char) c, scd;
657 -> screen items:scd,
658 "highlight", color spec:c, eol =scd->highlight_color = (char) c, scd;
659 -> screen items:scd,
660 "size", '=', conditional exp:w,
661 ',', conditional exp:h =scd->width = (unsigned)w, scd->height = (unsigned) h, scd;
662 -> screen items:scd,
663 "location", '=', conditional exp:px,
664 ',', conditional exp:py =scd->pos.x = (unsigned) px,scd->pos.y = (unsigned) py, scd;
665 -> screen items:scd,
666 query line:q, '}', eol =qs << *q, delete q, scd;
667 -> screen items:scd,
668 button line:q, '}', eol =qs << *q, delete q, scd;
669
670 (int) color spec
671 -> "color", '=', conditional exp:fg,
672 ',', conditional exp:bg =COLOR((unsigned)fg,(unsigned)bg);
673
674
675 (query_item *) query line
676 -> "field", '{' =clear(new query_item);
677 -> query line, eol
678 -> query line:q,
679 "variable", '=',
680 literal, eol =q->id = sd << sa--, q;
681 -> query line:q,
682 "default", '=',
683 formula, eol =q->value = formula(), q;
684 -> query line:q,
685 "prompt", '=',
686 formula, eol =q->prompt = formula(), q;
687 -> query line:q,
688 "explanation", '=',
689 formula, eol =q->explanation = formula(),q;
690
691 (query_item *) button line
692 -> "button", '{' =clear(new query_item);
693 -> button line, eol
694 -> button line:q,
695 "prompt", '=', formula, eol =q->prompt = formula(), q;
696 -> button line:q,
697 "explanation", '=',
698 formula, eol =q->explanation = formula(),q;
699 -> button line:q,
700 action text, eol =q->action = copy_action(), q;
701
702 formula
703 -> formula element =reset(is) << (sd << sa--);
704 -> formula, '#', formula element =is << (sd << sa--);
705
706 formula element
707 -> paren string
708 -> string literal
709 -> literal
710 -> formula element, '[', !sa << '[';,
711 parameter string, ']' =concat(sa) << ']';
712
713 {
714
715 #include <process.h>
716 #include <stdlib.h>
717 #include <ctype.h>
718 #include <sys/stat.h>
719 #include <fcntl.h>
720 #include <io.h>
721 #include <conio.h>
722 #include <dos.h>
723 #include <time.h>
724 #include <assert.h>
725 #include <errno.h>
726
727 #include "edit.h"
728
729
730 #include "screen.h"
731 #include "util.h"
732 #include "redirect.h"
733
734 #define GET_CONTEXT CONTEXT.pointer = PCB.pointer;\
735 CONTEXT.line=PCB.line;\
736 CONTEXT.column = PCB.column;
737
738
739 int debug_switch = 0;
740 char *error_msg = NULL;
741 unsigned errorlevel_index;
742 int errorlevel;
743 int exitcode = 0;
744 int exitflag = 0;
745 int first_line = 1;
746 int first_column = 1;
747 unsigned stderr_index;
748
749 void display_queries(screen_descriptor *);
750
751 #define FIRST_LINE first_line
752 #define FIRST_COLUMN first_column
753
754
755 /*****
756
757 Internal Functions
758
759 *****/
760
761 long file_exists(void) {
762 FILE *f = fopen(sa--,"r");
763 if (f != NULL) fclose(f);
764 return f != NULL;
765 }
766
767 long directory_exists(void) {
768 struct find_t ff;
769 int result;
770
771 sa << "\\*.*";
772 result = _dos_findfirst(sa--,_A_SUBDIR,&ff);
773 return result == 0;
774 }
775
776 long string_length(void) {
777 return size(sa--);
778 }
779
780 long get_file_length(void) {
781 int handle = open(sa--, O_RDONLY);
782 long length;
783 if (handle < 0) return 0;
784 length = filelength(handle);
785 close(handle);
786 return length;
787 }
788
789 long disk_space(void) {
790 struct diskfree_t free;
791 int drive = toupper(*(char *)sa--) - 64;
792 long avail;
793
794 _dos_getdiskfree(drive, &free);
795 avail = (long) free.avail_clusters
796 * (long) free.bytes_per_sector
797 * (long) free.sectors_per_cluster;
798 return avail;
799 }
800
801 long file_time(void) {
802 int handle = open(sa--, O_RDONLY);
803 #ifdef __BCPLUSPLUS__
804 unsigned date, time;
805 #else
806 unsigned short date, time;
807 #endif
808 struct tm t;
809
810 if (handle < 0) return 0;
811 _dos_getftime(handle, &date, &time);
812 close(handle);
813 t.tm_year = ((date & 0xfe00) >> 9) + 80;
814 t.tm_mon = ((date & 0x1e00) >> 5) - 1;
815 t.tm_mday = date & 0x001f;
816 ;
817 t.tm_hour = (time & 0xf800) >> 11;
818 t.tm_min = (time & 0x07e0) >> 5;
819 t.tm_sec = (time & 0x001f) << 1;
820 return mktime(&t);
821 }
822
823
824 // Support for reduction procecures
825
826 // Compare top strings on string accumulator
827
828 /*
829 pops top two strings from string accumulator using strcmp
830 and returns
831 -1 if first string is less than top string
832 0 if strings match
833 +1 if top string is greater than first string
834 */
835
836 int string_comp(void) {
837 int n = size(sa);
838 array<char> right_string(sa--, n+1);
839 return strcmp(sa--,right_string);
840 }
841
842 /*
843 replace the top string on the stack, with a substring where the index
844 of the first character in the substring is given by "first" and the index
845 of the last character is given by "last"
846 */
847
848 void extract(unsigned first, unsigned last) {
849 int n = last - first + 1;
850 assert (last >= first);
851 array <char> x((char *) sa-- + first, n+1);
852 x[n] = 0;
853 ++sa << x;
854 }
855
856 /*
857 Look up the top string on the accumulator stack in the string dictionary.
858 If it has a value in the symbol table, replace it with the symbol table
859 value. If the value is numeric, convert it to integer. Otherwise, leave the
860 string untouched on the stack.
861 */
862
863 void lookup(void) {
864 unsigned index = sd[sa];
865 if (index == 0) return;
866 switch (st[index].type) {
867 case string_type:
868 case value_type: {
869 --sa; // discard name
870 ++sa << st[index].data.text; // stack value
871 break;
872 }
873 case integer_type: {
874 --sa; // discard name
875 (++sa).printf("%ld", st[index].data.integer); // convert to ascii
876 break;
877 }
878 }
879 }
880
881 /*
882 Find the data type of a symbol and change the reduction accordingly.
883 Return the dictionary index for strings, and the value itself for integers.
884 */
885
886 long name_type(void) {
887 unsigned index = sd << sa--;
888 switch (st[index].type) {
889 case value_type:
890 case string_type: {
891 CHANGE_REDUCTION(string_name);
892 return index;
893 }
894 case built_in_function_type: {
895 CHANGE_REDUCTION(built_in_name);
896 return index;
897 }
898 case undefined_type: {
899 CHANGE_REDUCTION(undefined_name);
900 return index;
901 }
902 case integer_type: return st[index].data.integer;
903 }
904 return 0;
905 }
906
907 /*
908 Store a string formula. A string formula is a sequence of string identifiers
909 the values of which are to be concatenated. The parser has accumulated the
910 identifiers on the integer_stack, is. The formula is terminated by a zero
911 entry.
912 */
913
914 int *formula(void) {
915 int n = size(is << 0);
916 int *f = new int[n];
917 while (n--) is >> f[n];
918 return f;
919 }
920
921 /*
922 Make a copy of an action that has been identified in the text stream.
923 An action pointer was stacked at the beginning of the action text on the
924 action stack, as.
925 */
926
927 action_pointer copy_action(void) {
928 action_pointer ap;
929 as >> ap; // pop action descriptor
930 unsigned length = (unsigned) (PCB.pointer - ap.pointer);
931 unsigned char *action = memdup(ap.pointer,length + 1);
932 action[length] = 0;
933 ap.pointer = action;
934 return ap;
935 }
936
937
938 // Internal Commands
939
940 int echo(int, char *args[]) {
941 int i;
942 char *cs = "";
943 for (i = 1; args[i]; i++) printf("%s%s", cs, args[i]), cs = " ";
944 printf("\n");
945 fflush(stdout);
946 return 0;
947 }
948
949 int pause(int, char *[]) {
950 int c;
951 while (kbhit()) getch(); // Empty buffer
952 printf("Press any key to continue . . .\n");
953 c = getch();
954 if (c == 3) exit(1);
955 return c;
956 }
957
958 int exit_script(int n_args, char *args[]) {
959 if (n_args > 1) sscanf(args[1], "%ld", &exitcode);
960 exit(exitcode);
961 return exitcode;
962 }
963
964 /*
965 int return_script(int n_args, char *args[]) {
966 if (n_args > 1) sscanf(args[1], "%ld", &exitcode);
967 PCB.exit_flag = AG_SUCCESS_CODE;
968 return exitcode;
969 }
970 */
971
972 int subdirs(int, char *args[]) {
973 struct find_t file_block;
974 int flag;
975 int length = strlen(args[1]);
976 array <char> name(args[1],length + 5);
977
978 strcat(name, "\\*.*");
979 for(flag = _dos_findfirst(name, _A_SUBDIR, &file_block);
980 flag == 0; flag = _dos_findnext(&file_block)) {
981 if ((file_block.attrib & _A_SUBDIR) == 0) continue;
982 if (strcmp(file_block.name, ".") == 0) continue;
983 if (strcmp(file_block.name, "..") == 0) continue;
984 puts(file_block.name);
985 }
986 return 0;
987 }
988
989 int files(int, char *args[]) {
990 struct find_t file_block;
991 int flag;
992 int length = strlen(args[1]);
993 array<char> name(args[1],length + 5);
994
995 strcat(name, "\\*.*");
996 for(flag = _dos_findfirst(name, 0, &file_block);
997 flag == 0; flag = _dos_findnext(&file_block)) {
998 puts(file_block.name);
999 }
1000 return 0;
1001 }
1002
1003
1004 /*****
1005
1006 Execute Command Line
1007
1008 *****/
1009
1010
1011 void perform_action(action_pointer ap) {
1012 dsl_pcb_type save_pcb = PCB;
1013
1014 PCB.pointer = ap.pointer;
1015 first_line = ap.line;
1016 first_column = ap.column;
1017 dsl();
1018 exitflag = PCB.exit_flag != AG_SUCCESS_CODE;
1019 PCB = save_pcb;
1020 if (exitflag) PCB.exit_flag = AG_SEMANTIC_ERROR_CODE;
1021 }
1022
1023 void exec(void) {
1024 int n = size(ps << (char *) NULL);
1025 int n_args = n - 1;
1026 unsigned index;
1027 unsigned uc_index;
1028 int i;
1029
1030 array <char *> args(n);
1031 while (n--) ps >> args[n];
1032
1033 index = sd[args[0]];
1034 while (index && st[index].type == string_type) {
1035 args[0] = st[index].data.text; // stack value
1036 index = sd[args[0]];
1037 }
1038 if (debug_switch) {
1039 for (i = 0; args[i]; i++) fprintf(stderr, "%s ", args[i]);
1040 fprintf(stderr,"\nPress any key to continue\n");
1041 while (!kbhit());
1042 getch();
1043 }
1044 strupr(args[0]);
1045 uc_index = sd[args[0]];
1046 if (n_args == 1 && strlen(args[0]) == 2 && args[0][1] == ':') {
1047 errorlevel = system(args[0]);
1048 }
1049 else if ( *args[0] && uc_index) switch (st[uc_index].type) {
1050 case internal_type: {
1051 errorlevel = (*st[uc_index].data.proc)(n_args, args);
1052 break;
1053 }
1054 case dos_type: {
1055 int i;
1056 for (i = 1; args[i]; i++) args[i][-1] = ' ';
1057 errorlevel = system(args[0]);
1058 if (errorlevel == -1) {
1059 fprintf(stderr,"Error invoking %s: %s\n", args[0], sys_errlist[errno]);
1060 exit(1);
1061 }
1062 break;
1063 }
1064 }
1065 else if ( *args[0] && index) switch (st[index].type) {
1066 case action_type: {
1067 action_descriptor d = *st[index].data.action;
1068 stack <symbol_table_entry> old_entries(d.n_args);
1069 for (i = 0; i < d.n_args && args[i+1]; i++) {
1070 old_entries << st[d.args[i]];
1071 st[d.args[i]].type = value_type;
1072 st[d.args[i]].data.text = memdup(args[i+1], 1 + strlen(args[i+1]));
1073 }
1074 perform_action(d.ap);
1075 for (i = d.n_args; i--;) {
1076 release(st[d.args[i]]);
1077 old_entries >> st[d.args[i]];
1078 }
1079 break;
1080 }
1081 default: {
1082 errorlevel = spawnvp(P_WAIT,args[0],ARGS);
1083 if (errorlevel == -1) {
1084 fprintf(stderr,"Error invoking %s: %s\n", args[0], sys_errlist[errno]);
1085 exit(1);
1086 }
1087 }
1088 }
1089 else {
1090 }
1091 st[errorlevel_index].data.integer = errorlevel;
1092 while (n_args--) --sa;
1093 --ps;
1094 if (kbhit()) {
1095 int c = getch();
1096 if (c == 3) exit(1);
1097 ungetch(c);
1098 }
1099 }
1100
1101 void discard_temp_file(char *file_name) {
1102 unlink(file_name); // Delete file
1103 delete [] file_name; // Free storage for name
1104 }
1105
1106
1107 /*****
1108
1109 Execute Command with piped input
1110
1111 *****/
1112
1113
1114 void exec_pipe_in(char *file_name) {
1115 {
1116 redirect sin(STDIN, file_name);
1117 exec();
1118 }
1119 discard_temp_file(file_name);
1120 }
1121
1122
1123 /*****
1124
1125 Execute Command with redirected I/O
1126
1127 *****/
1128
1129 void exec_redirect_in(void) {
1130 redirect sin(STDIN, sa--);
1131 exec();
1132 }
1133
1134 char *exec_pipe_out(void) {
1135 fflush(stdout);
1136 redirect sout(STDOUT);
1137 exec();
1138 fflush(stdout);
1139 return save_file(sout);
1140 }
1141
1142 char *exec_pipe_in_pipe_out(char *file_name) {
1143 char *result;
1144 {
1145 redirect sin(STDIN, file_name);
1146 fflush(stdout);
1147 redirect sout(STDOUT);
1148 exec();
1149 fflush(stdout);
1150 result = save_file(sout);
1151 }
1152 discard_temp_file(file_name);
1153 return result;
1154 }
1155
1156 char *exec_redirect_in_pipe_out(void) {
1157 fflush(stdout);
1158 redirect sout(STDOUT);
1159 exec_redirect_in();
1160 fflush(stdout);
1161 return save_file(sout);
1162 }
1163
1164 unsigned check_integer(void) {
1165 unsigned index = sd << sa--;
1166 if (st[index].type == integer_type) return index;
1167 CHANGE_REDUCTION(undeclared_variable);
1168 if (st[index].type == string_type) CHANGE_REDUCTION(string_variable);
1169 return index;
1170 }
1171
1172 void assign_value(unsigned index) {
1173 char *text = copy(sa--);
1174 release(st[index]);
1175 st[index].type = value_type;
1176 st[index].data.text = text;
1177 }
1178
1179 void grab_output(char *temp_name) {
1180 unlink(sa); // delete old file
1181 rename(temp_name, sa--); // rename temp file
1182 delete [] temp_name; // discard name string
1183 }
1184
1185 void append_output(char *temp_name) {
1186 fflush(stdout);
1187 redirect sout(STDOUT, sa--, 1); // append to file named on sa
1188 redirect sin(STDIN, temp_name);
1189 char buf[2000];
1190 int n;
1191 while (1) {
1192 n = read(STDIN, buf, 2000);
1193 if (n == 0) break;
1194 write(STDOUT, buf, n);
1195 }
1196 fflush(stdout);
1197 unlink(temp_name);
1198 delete [] temp_name;
1199 }
1200
1201 void action_string(void) {
1202 action_pointer ap;
1203 as >> ap;
1204 unsigned length = (unsigned)(PCB.pointer - ap.pointer);
1205 array <unsigned char> action(ap.pointer,length + 1);
1206 action[length] = 0;
1207 fflush(stdout);
1208 redirect sout(STDOUT);
1209 char *result;
1210
1211 ap.pointer = action;
1212 perform_action(ap);
1213 fflush(stdout);
1214 result = content(sout);
1215 ++sa << result;
1216 delete [] result;
1217 }
1218
1219
1220 // Program Control functions
1221
1222 // If/else statement
1223
1224 int do_if(int pc, int cc) {
1225 action_pointer ap;
1226 as >> ap;
1227 if (!pc && cc && exitflag == 0) {
1228 unsigned length = (unsigned) (PCB.pointer - ap.pointer);
1229 array<unsigned char> q(ap.pointer, length+1);
1230 q[length] = 0;
1231 ap.pointer = q;
1232 perform_action(ap);
1233 }
1234 return pc || cc;
1235 }
1236
1237 // While statement
1238
1239 void do_while(int cc) {
1240 unsigned length;
1241 action_pointer ap;
1242 as >> ap;
1243 if (cc == 0) return;
1244 length = (unsigned) (PCB.pointer - ap.pointer);
1245 array<unsigned char> q(ap.pointer, length+1);
1246 q[length] = 0;
1247 ap.pointer = q;
1248 perform_action(ap);
1249 if (exitflag) return;
1250 PCB.pointer = CONTEXT.pointer;
1251 PCB.line = CONTEXT.line;
1252 PCB.column = CONTEXT.column;
1253 }
1254
1255
1256 // For Statement
1257 // Note that this is the for statement in the DOS batch languange for, not C
1258
1259 void do_for_loop(void) {
1260 int n,k;
1261 char *q;
1262 char *seps = " \t\v\f\r\n";
1263 action_pointer ap;
1264 as >> ap;
1265 unsigned length = (unsigned)(PCB.pointer - ap.pointer);
1266 array <unsigned char> action(ap.pointer, length + 1);
1267 action[length] = 0;
1268
1269 ap.pointer = action;
1270 n = size(sa);
1271 array<char> text(sa--, n + 1);
1272
1273
1274 unsigned index = sd << sa--;
1275
1276 ++ps;
1277 for (q = strtok(text, seps); q != NULL; q = strtok(NULL,seps)) {
1278 if (*q == '(') {
1279 int k = strlen(q) - 1;
1280 assert(q[k] == ')');
1281 q[k] = 0;
1282 q++;
1283 }
1284 else if (*q == '"') {
1285 int k = strlen(q) - 1;
1286 assert(q[k] == '"');
1287 q[k] = 0;
1288 q++;
1289 }
1290 ps << q;
1291 }
1292 k = n = size(ps);
1293 array<char *> args(n);
1294 while (k--) ps >> args[k];
1295 --ps;
1296 symbol_table_entry save_table_entry = st[index];
1297 st[index].type = value_type;
1298
1299 for (k = 0; k < n && exitflag == 0; k++) {
1300 st[index].data.text = args[k];
1301 perform_action(ap);
1302 }
1303 st[index] = save_table_entry;
1304 }
1305
1306 void invoke_script(void) {
1307 int handle = open(sa, O_TEXT | O_RDONLY);
1308 long size;
1309 unsigned n;
1310 action_pointer ap;
1311
1312 if (handle < 0) {
1313 fprintf(stderr,"Cannot open %s\n", (char *) sa--);
1314 exit(1);
1315 }
1316 --sa;
1317 size = filelength(handle);
1318 assert(size < 65536L);
1319 array <unsigned char> data((unsigned) size+1);
1320 n = (unsigned) read(handle,data,(unsigned) size);
1321 data[n] = 0;
1322 close(handle);
1323 exitflag = 0;
1324 ap.pointer = data;
1325 ap.line = ap.column = 1;
1326 perform_action(ap);
1327 st[errorlevel_index].data.integer = exitcode;
1328 exitflag = exitcode = 0;
1329 return;
1330 }
1331
1332 internal_commands_descriptor internal_commands[] = {
1333 {"ECHO", echo},
1334 {"EXIT", exit_script},
1335 {"FILES", files},
1336 {"PAUSE", pause},
1337 // {"RETURN", return_script},
1338 {"SUBDIRS", subdirs},
1339 {NULL, NULL}
1340 };
1341
1342 struct built_ins_descriptor built_ins[] = {
1343 {"file_exists", file_exists},
1344 {"directory_exists", directory_exists},
1345 {"string_length", string_length},
1346 {"file_length", get_file_length},
1347 {"disk_space", disk_space},
1348 {"file_time", file_time},
1349 {NULL, NULL}
1350 };
1351
1352 void set_extension(char *path, char *e) {
1353 char s[_MAX_PATH];
1354 char drive[_MAX_DRIVE];
1355 char dir[_MAX_DIR];
1356 char file[_MAX_FNAME];
1357 char ext[_MAX_EXT];
1358
1359 _splitpath(path,drive,dir,file,ext);
1360 _makepath(s, drive, dir, file, e);
1361 ++sa << s;
1362 }
1363
1364 /*
1365 Note that if this program is called without any arguments, it looks for a
1366 script with the same name as the executable. Thus, to make an install
1367 program that picks up the install script without any arguments, you simply
1368 rename DSL.EXE to INSTALL.EXE. Then when you run it without any arguments
1369 it will run the INSTALL.DSL script.
1370 */
1371
1372 void main(int argc, char *argv[]) {
1373 int arg_number = 0;
1374 int i = 1;
1375 int j = 0;
1376
1377 init_dos_internals();
1378 set_arg(j++, argv[0]);
1379 if (argc > i && (argv[i][0] == '/' || argv[i][0] == '-')) {
1380 if (toupper(argv[i][1]) != 'D') {
1381 printf("Unrecognized switch -- /%s\n",argv[i][1]);
1382 return;
1383 }
1384 debug_switch = 1;
1385 i++;
1386 }
1387 if (argc > i) arg_number = i++;
1388 set_extension(argv[arg_number], "DSL");
1389 set_arg(j++,copy(sa));
1390 while (i < argc) set_arg(j++, argv[i++]);
1391 define_integer("argc", j);
1392 invoke_script(); // Takes file name from sa
1393 exit(exitcode);
1394 }
1395 } // End Embedded C