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

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