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

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