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

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