--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/agcl/oldagsrc/dsl-2.syn	Sat Dec 22 17:52:45 2007 -0500
@@ -0,0 +1,1395 @@
+{                                           // C Prologue
+/*
+ AnaGram, a System for Syntax Directed Programming
+
+ A Dos Script Language
+
+ Copyright (c) 1993, 1996 Parsifal Software.
+ All Rights Reserved.
+
+*/
+
+
+#include "stack.h"
+#include "charsink.h"
+#include "strdict.h"
+#include "array.h"
+#include "symbol.h"
+#include "query.h"
+#include <conio.h>
+
+#ifdef __BCPLUSPLUS__
+  #define ARGS ((char **) args)
+
+  extern unsigned _stklen = 0x4000;              // set stack size
+
+#else
+  #define ARGS ((char const * const *) (char **) args)
+#endif
+
+
+// Define stacks for temporary storage
+
+stack <action_pointer>      as(25);              // Stack actions
+stack <int>                 is(100);             // Stack string indices
+stack <char *>              ps(1000,20);         // Stack parameter strings
+stack <query_item>          qs(23);              // Stack query items
+
+
+// Define data structures for symbol table
+
+#define N_STRINGS 2000
+
+string_accumulator          sa(64000U,500);
+string_dictionary           sd(N_STRINGS);
+array <symbol_table_entry>  st(N_STRINGS);
+
+}                              // End of C Prologue
+
+
+// Character Set Definitions
+
+digit               = '0-9'
+eof                 = 0 + ^Z
+letter              = 'a-z' + 'A-Z' + '_'
+not double quote    = ~eof - ('"' + '\\' + '\n')
+not eol             = ~(eof + '\n')
+not paren           = ~(eof + '(' + ')')
+not single quote    = ~eof - ('\'' + '\\' + '\n')
+operator            = '#' + '=' + '<' + '>' + '|'
+punctuation         = '(' + ')' + '{' + '}' + '[' + ']' + '"' + '\n'
+text char           = ~(eof + operator + white + punctuation + '@')
+white               = ' ' + '\t' + '\v' + '\f' + '\r'
+
+
+// Configuration Section
+
+[
+  // White space control
+  disregard ws
+  lexeme {literal, integer constant, string literal, paren string,
+          character constant, eol, name}
+  distinguish lexemes
+
+  // parser configuration
+  pointer input
+  context type = action_pointer
+  distinguish keywords {letter + digit}
+  parser file name = "#.cpp"
+
+  // Debugging options
+  line numbers
+  test file mask = "*.dsl"
+]
+
+
+//   White Space Definitions
+
+ws
+ -> white | comment
+
+comment
+ -> comment head, "*/"
+
+comment head
+ -> "/*"
+ -> comment head, ~eof
+
+// Comment out one of the following two productions to determine whether
+// comments nest or not
+
+comment head
+ -> comment head, comment                   // comments nest
+
+/*
+comment
+ -> comment head, comment                   // comments do not nest
+*/
+
+eol
+ -> '\n'
+ -> "//", not eol?..., '\n'                 // C++ style comments
+
+
+
+// Script File Description
+
+script file $
+ -> [execution block | declaration | eol]..., eof
+
+
+// Dos Command and Parameter Recognition
+
+word
+ -> paren string
+ -> string literal
+ -> integer variable:v                      =++sa << sd[v], lookup();
+ -> string variable:v                       =++sa << sd[v], lookup();
+ -> undeclared variable:v                   =++sa << sd[v], lookup();
+ -> word, '[',                              !sa << '[';,
+      parameter string, ']'                 =concat(sa) << ']', lookup();
+
+string
+ -> word
+ -> string, '#', word                       =concat(sa);
+
+parameter string
+ -> param word
+ -> parameter string, '#',
+     param word                             =concat(sa);
+
+literal
+ -> text char:c                             =++sa << c;
+ -> literal, text char:c                    =sa << c;
+
+param word
+ -> word
+ -> action text                             =action_string();
+
+
+// Gather, but do not execute, the text of an action block
+
+action text
+ -> action text head, '}'
+
+action text head
+ -> '{'                                     =as << CONTEXT;
+ -> action text head, action word
+ -> action text head, eol
+ -> action text head, action text           ={action_pointer a; as >> a;}
+ -> action text head, operator+'@'
+
+
+action word
+ -> paren string                            =--sa;
+ -> string literal                          =--sa;
+ -> literal                                 =--sa;
+ -> action word, '[', action parameter string, ']'
+
+action parameter string
+ -> action param word
+ -> action parameter string, '#',
+     action param word
+
+action param word
+ -> action word
+ -> action text
+
+
+/*****
+
+ Parenthesized string
+
+ May contain any characters inside balanced parentheses. If parentheses
+ are included, they must balance. Outer parentheses are stripped before
+ use.
+
+*****/
+
+paren string
+ -> paren string chars, ')'
+
+paren string chars
+ -> '('                                     =++sa;
+ -> paren string chars, paren string char
+
+paren string char
+ -> not paren:c                             =sa << c;
+ -> !sa << '(';, paren string chars, ')'    =concat(sa) << ')';
+
+
+/*****
+
+ String Literal
+
+ Follows the same rules as for string literals in C and C++
+
+*****/
+
+string literal
+  -> string chars, '"'
+
+string chars
+  -> '"'                                    =++sa;
+  -> string chars, string char
+
+string char
+ -> not double quote:c                      =sa << c;
+ -> escape sequence:c                       =sa << c;
+
+(int) escape sequence
+ -> "\\a"   ='\a';
+ -> "\\b"   ='\b';
+ -> "\\f"   ='\f';
+ -> "\\n"   ='\n';
+ -> "\\r"   ='\r';
+ -> "\\t"   ='\t';
+ -> "\\v"   ='\v';
+ -> "\\\\"  ='\\';
+ -> "\\?"   = '\?';
+ -> "\\'"   ='\'';
+ -> "\\\""  ='"';
+ -> octal escape
+ -> hex escape
+
+(int) octal escape
+ -> one octal | two octal | three octal
+
+(int) one octal
+ -> '\\', '0-7':d                           =d-'0';
+
+(int) two octal
+ -> one octal:n, '0-7':d                    =8*n + d-'0';
+
+(int) three octal
+ -> two octal:n, '0-7':d                    =8*n + d-'0';
+
+(int) hex escape
+ -> "\\x", hex number:n                     =(int) n;
+
+(long) hex number
+ -> hex digit
+ -> hex number:n, hex digit:d               =16*n + d;
+
+[
+  sticky {one octal, two octal, hex number}
+]
+
+
+/*****
+
+ Command Line Interpretation
+
+ The identifier may be the name of a DOS command, internal or external,
+ a path name of an arbitrary executable, or an internal commmand of the
+ scripting language. It may appear literally, or may be the result of
+ string concatenation and substitution.
+
+ command is used in the program logic section, below.
+
+*****/
+
+command
+ -> identifier, parameters?                 =exec();
+ -> identifier, parameters?,
+      '<', parameter string                 =exec_redirect_in();
+ -> piped command:file, '|',
+      identifier, parameters?               =exec_pipe_in(file);
+ -> piped command:file, '>',
+      parameter string                      =grab_output(file);
+ -> piped command:file, ">>",
+      parameter string                      =append_output(file);
+
+(char *) piped command
+ -> identifier, parameters?                 =exec_pipe_out();
+ -> identifier, parameters?,
+      '<', parameter string                 =exec_redirect_in_pipe_out();
+ -> piped command:file, '|',
+      identifier, parameters?               =exec_pipe_in_pipe_out(file);
+
+identifier
+ -> string                                  =sa << 0, ++ps << sa;
+
+parameters
+ -> parameter string                        =ps << sa, sa << 0;
+ -> parameters, parameter string            =ps << sa, sa << 0;
+
+
+/*****
+
+ Program logic.
+
+ This section of syntax controls the interpretation of a sequence
+ of commands enclosed within braces.
+
+*****/
+
+execution block
+ -> '{', eol?...,[command sequence, eol?... | if sequence, eol?...], '}'
+
+
+/*****
+
+ A command sequence is any sequence of statements and
+ if statements that ends with a statement.
+
+*****/
+
+command sequence
+ -> statement
+ -> command sequence, eol..., statement
+ -> if sequence, eol..., statement
+ -> if sequence:pc, eol?...,
+    "else", action text                   =do_if(pc,1);
+
+/*****
+
+ An if sequence is any direct sequence of statements and if statements
+ that ends with an if statement. The difference between an "if sequence" and
+ a "command sequence" is that an else clause may follow the "if sequence".
+
+*****/
+
+(int) if sequence
+ -> if statement
+ -> if sequence, eol..., if statement:cc      =cc;
+ -> command sequence, eol..., if statement:cc =cc;
+ -> if sequence:pc, eol?..., "else", eol?...,
+     if condition:cc, action text         =do_if(pc,cc!=0);
+
+(int) if condition
+ -> "if",
+    '(', conditional exp:cc, ')'            =(int) cc;
+
+(int) if statement
+ -> if condition:cc, action text          =do_if(0,cc != 0);
+
+/*****
+
+ A statement is any command that isn't an if or else statement.
+ The iteration on the while statement is a ruse.
+
+*****/
+
+statement
+ -> command
+ -> assignment
+ -> for statement
+ -> declaration
+ -> screen description
+ -> while statement...
+
+
+/*****
+
+ Assignment statements
+
+ There are four varieties of assignment statement depending on whether
+ or how the variable on the left hand side has been previously declared.
+
+*****/
+
+assignment
+ -> undeclared variable:v, '=',
+     parameter string                       =assign_value(v);
+ -> integer variable:v, '=',
+     conditional exp:x, ';'?                =st[v].data.integer = (int) x;
+ -> string variable:v, '=',
+    string exp, ';'?                        =st[v].data.text = copy(sa--);
+ -> string variable:v, '@',
+     primary exp:n, '=',
+     conditional exp:x, ';'?                =st[v].data.text[(unsigned)n] = (char) x;
+
+
+/*****
+
+ Semantically determined production to determine treatment of variable
+ on left side of assignment statement.
+
+*****/
+
+(unsigned) integer variable,
+           string variable,
+           undeclared variable
+ -> literal                                 =check_integer();
+
+
+/*****
+
+ While Statement
+
+ The While statement loops by simply resetting the input pointer for
+ the parser back to the beginning of the while loop. This is the reason
+ for the iteration of the while statement in the production for "simple
+ command".
+
+*****/
+
+while statement
+ -> "while", '(', conditional exp:cc, ')',
+     action text                          =do_while(cc != 0);
+
+
+/*****
+
+
+
+ For Statement
+
+ This for statement corresponds to the for statement in the DOS batch
+ programming language, not the for statement in C.
+
+*****/
+
+for statement
+ -> "for", name,                           // !++sa << '(';,
+    "in", parameter string,
+    "do"?, action text                    =do_for_loop();
+
+
+/*****
+
+ Declaration statements
+
+*****/
+
+declaration
+ -> "action", literals:n,
+        action text                         =define_action(n);
+ -> "int",
+       name,  '=', conditional exp:x, ';'?  =define_integer(sa--, x);
+ -> "string",
+       name, '=', string exp, ';'?          =define_string();
+
+(int) literals
+ -> literal                                 =0;
+ -> literals:n, literal              =n+1;
+
+
+name
+ -> letter:c                                =++sa << c;
+ -> name, letter:c                          =sa << c;
+ -> name, digit:c                           =sa << c;
+
+
+/*****
+
+ Integer and String Expression Logic
+
+ The syntax for expressions is essentially that of C, with the addition
+ of string comparison. The only missing operators are ++, --, and comma.
+
+*****/
+
+
+(long) conditional exp
+ -> logical or exp
+ -> logical or exp:c, '?', conditional exp:x, ':',
+    conditional exp:y                       = c != 0 ? x : y;
+
+(long) logical or exp
+ -> logical and exp
+ -> logical or exp:x, "||",
+      logical and exp:y                     =x != 0 || y!=0;
+
+(long) logical and exp
+ -> inclusive or exp
+ -> logical and exp:x, "&&",
+      inclusive or exp:y                    =x != 0 && y !=0;
+
+(long) inclusive or exp
+ -> exclusive or exp
+ -> inclusive or exp:x, '|',
+      exclusive or exp:y                    =x | y;
+
+(long) exclusive or exp
+ -> and exp
+ -> exclusive or exp:x, '^', and exp:y      =x ^ y;
+
+(long) and exp
+ -> equality exp
+ -> and exp:x, '&', equality exp:y          =x & y;
+
+(long) equality exp
+ -> relational exp
+ -> equality exp:x, "==", relational exp:y  =x == y;
+ -> equality exp:x, "!=", relational exp:y  =x != y;
+ -> string exp, "==", string exp            =string_comp() == 0;
+ -> string exp, "!=", string exp            =string_comp() != 0;
+
+
+(long) relational exp
+ -> shift exp
+ -> relational exp:x, '<', shift exp:y      =x < y;
+ -> relational exp:x, '>', shift exp:y      =x > y;
+ -> relational exp:x, "<=", shift exp:y     =x <= y;
+ -> relational exp:x, ">=", shift exp:y     =x >= y;
+ -> string exp, '<', string exp             =string_comp() < 0;
+ -> string exp, '>', string exp             =string_comp() > 0;
+ -> string exp, "<=", string exp            =string_comp() <= 0;
+ -> string exp, ">=", string exp            =string_comp() >= 0;
+
+(long) shift exp
+ -> additive exp
+ -> shift exp:x, "<<", additive exp:y       =x << (int) y;
+ -> shift exp:x, ">>", additive exp:y       =x >> (int) y;
+
+(long) additive exp
+ -> multiplicative exp
+ -> additive exp:x, '+',
+      multiplicative exp:y                  =x + y;
+ -> additive exp:x, '-',
+      multiplicative exp:y                  =x - y;
+
+(long) multiplicative exp
+ -> unary exp
+ -> multiplicative exp:x, '*', unary exp:y  =x * y;
+ -> multiplicative exp:x, '/', nonzero:y    =x / y;
+ -> multiplicative exp:x, '%', nonzero:y    =x % y;
+
+(long) nonzero
+  -> unary exp: x ={
+      assert(x);
+      return x;
+    }
+
+(long) unary exp
+ -> primary exp
+ -> '+', unary exp:x                        =x;
+ -> '-', unary exp:x                        =-x;
+ -> '~', unary exp:x                        =~x;
+ -> '!', unary exp:x                        =!x;
+
+(long) primary exp
+ -> integer constant
+ -> character constant
+ -> string term,'@', primary exp:n =((unsigned char *) sa--)[(unsigned) n];
+ -> '#', string element    ={
+                              long temp;
+                              sscanf(sa--, "%ld", &temp);
+                              return temp;
+                            }
+ -> numeric name
+ -> '(', conditional exp:x, ')'             =x;
+ -> built_in name:x, built_in argument  =(*st[(unsigned)x].data.func)();
+
+built_in argument
+ -> '(', parameter string, ')'
+
+(long) numeric name,
+       string name,
+       built_in name,
+       undefined name
+ -> name                                    =name_type();
+
+
+/*****
+
+ String Expressions
+
+*****/
+
+string exp
+ -> string term
+ -> string exp, '#', string term           =concat(sa);
+
+string term
+ -> string element
+ -> string term, '@', '(',
+    conditional exp:first, "..",
+    conditional exp:last, ')'  =extract((unsigned)first, (unsigned) last);
+ -> string term, '[',                       !sa << '[';,
+      parameter string, ']'                 =concat(sa) << ']', lookup();
+
+string element
+ -> string literal
+ -> string name:x                     =++sa << st[(unsigned)x].data.text;
+ -> undefined name:x                  =++sa << sd[(unsigned)x];
+ -> action text                       =action_string();
+ -> '=', primary exp:x                =++sa,sa.printf("%ld",x);
+ -> '(', string exp, ')'
+
+/*****
+
+ Integer constants
+
+ The syntax for integer constants is identical to that in C.
+
+*****/
+
+integer constant
+ -> hex constant
+ -> octal constant
+ -> decimal constant
+
+(long) hex constant
+ -> {"0x" | "0X"}                           =0;
+ -> hex constant:x, hex digit:d             =16*x + d-'0';
+
+(long) hex digit
+ -> '0-9'
+ -> 'a-f' + 'A-F':d                         =(d&7) + 9;
+
+(long) octal constant
+  -> '0'                                    =0;
+  -> octal constant:n, '0-7':d              =8*n + d-'0';
+
+(long) decimal constant
+ -> '1-9':d                                 =d-'0';
+ -> decimal constant:n, '0-9':d             =10*n + d-'0';
+
+
+/*****
+
+ Character Constant
+
+ The rules for character constant are the same as in C.
+
+*****/
+
+(int) character constant
+ -> '\'', char constant element:c, '\''     =c;
+
+(int) char constant element
+ -> not single quote
+ -> escape sequence
+
+
+/*****
+
+ Screen Display
+
+*****/
+
+screen description
+ -> screen items:scd, '}'                   =display_queries(scd);
+
+(screen_descriptor *) screen items
+ -> "screen", '{'                           =reset(qs), new screen_descriptor;
+ -> screen items, eol
+ -> screen items:scd,
+      "title", '=',
+      formula, eol                          =scd->title = formula(), scd;
+ -> screen items:scd,
+      color spec:c, eol                     =scd->color = (char) c, scd;
+ -> screen items:scd,
+      "entry", color spec:c, eol            =scd->entry_color = (char) c, scd;
+ -> screen items:scd,
+       "highlight", color spec:c, eol       =scd->highlight_color = (char) c, scd;
+ -> screen items:scd,
+       "size", '=', conditional exp:w,
+         ',', conditional exp:h   =scd->width = (unsigned)w, scd->height = (unsigned) h, scd;
+ -> screen items:scd,
+       "location", '=', conditional exp:px,
+         ',', conditional exp:py        =scd->pos.x = (unsigned) px,scd->pos.y = (unsigned) py, scd;
+ -> screen items:scd,
+      query line:q, '}',  eol               =qs << *q, delete q, scd;
+ -> screen items:scd,
+      button line:q, '}', eol               =qs << *q, delete q, scd;
+
+(int) color spec
+ -> "color", '=', conditional exp:fg,
+       ',', conditional exp:bg              =COLOR((unsigned)fg,(unsigned)bg);
+
+
+(query_item *) query line
+ -> "field", '{'                            =clear(new query_item);
+ -> query line, eol
+ -> query line:q,
+      "variable", '=',
+       literal, eol                         =q->id = sd << sa--, q;
+ -> query line:q,
+      "default", '=',
+       formula, eol                         =q->value = formula(), q;
+ -> query line:q,
+      "prompt", '=',
+       formula, eol                         =q->prompt = formula(), q;
+ -> query line:q,
+      "explanation", '=',
+       formula, eol                         =q->explanation = formula(),q;
+
+(query_item *) button line
+ -> "button", '{'                           =clear(new query_item);
+ -> button line,  eol
+ -> button line:q,
+      "prompt", '=', formula, eol           =q->prompt = formula(), q;
+ -> button line:q,
+      "explanation", '=',
+       formula, eol                         =q->explanation = formula(),q;
+ -> button line:q,
+      action text, eol                      =q->action = copy_action(), q;
+
+formula
+ -> formula element                         =reset(is) << (sd << sa--);
+ -> formula, '#', formula element           =is << (sd << sa--);
+
+formula element
+ -> paren string
+ -> string literal
+ -> literal
+ -> formula element, '[',                   !sa << '[';,
+      parameter string, ']'                 =concat(sa) << ']';
+
+{
+
+#include <process.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <io.h>
+#include <conio.h>
+#include <dos.h>
+#include <time.h>
+#include <assert.h>
+#include <errno.h>
+
+#include "edit.h"
+
+
+#include "screen.h"
+#include "util.h"
+#include "redirect.h"
+
+#define GET_CONTEXT CONTEXT.pointer = PCB.pointer;\
+  CONTEXT.line=PCB.line;\
+  CONTEXT.column = PCB.column;
+
+
+int       debug_switch = 0;
+char     *error_msg = NULL;
+unsigned  errorlevel_index;
+int       errorlevel;
+int       exitcode = 0;
+int       exitflag = 0;
+int       first_line = 1;
+int       first_column = 1;
+unsigned  stderr_index;
+
+void      display_queries(screen_descriptor *);
+
+#define FIRST_LINE first_line
+#define FIRST_COLUMN first_column
+
+
+/*****
+
+ Internal Functions
+
+*****/
+
+long file_exists(void) {
+  FILE *f = fopen(sa--,"r");
+  if (f != NULL) fclose(f);
+  return f != NULL;
+}
+
+long directory_exists(void) {
+  struct find_t ff;
+  int result;
+
+  sa << "\\*.*";
+  result = _dos_findfirst(sa--,_A_SUBDIR,&ff);
+  return result == 0;
+}
+
+long string_length(void) {
+  return size(sa--);
+}
+
+long get_file_length(void) {
+  int handle = open(sa--, O_RDONLY);
+  long length;
+  if (handle < 0) return 0;
+  length = filelength(handle);
+  close(handle);
+  return length;
+}
+
+long disk_space(void) {
+  struct diskfree_t free;
+  int drive = toupper(*(char *)sa--) - 64;
+  long avail;
+
+  _dos_getdiskfree(drive, &free);
+  avail = (long) free.avail_clusters
+        * (long) free.bytes_per_sector
+        * (long) free.sectors_per_cluster;
+  return avail;
+}
+
+long file_time(void) {
+  int handle = open(sa--, O_RDONLY);
+#ifdef __BCPLUSPLUS__
+  unsigned date, time;
+#else
+  unsigned short date, time;
+#endif
+  struct tm t;
+
+  if (handle < 0) return 0;
+  _dos_getftime(handle, &date, &time);
+  close(handle);
+  t.tm_year = ((date & 0xfe00) >> 9) + 80;
+  t.tm_mon  = ((date & 0x1e00) >> 5) - 1;
+  t.tm_mday = date & 0x001f;
+  ;
+  t.tm_hour = (time & 0xf800) >> 11;
+  t.tm_min  = (time & 0x07e0) >> 5;
+  t.tm_sec  = (time & 0x001f) << 1;
+  return mktime(&t);
+}
+
+
+// Support for reduction procecures
+
+// Compare top strings on string accumulator
+
+/*
+  pops top two strings from string accumulator using strcmp
+  and returns
+    -1 if first string is less than top string
+     0 if strings match
+    +1 if top string is greater than first string
+*/
+
+int string_comp(void) {
+  int n = size(sa);
+  array<char> right_string(sa--, n+1);
+  return strcmp(sa--,right_string);
+}
+
+/*
+  replace the top string on the stack, with a substring where the index
+  of the first character in the substring is given by "first" and the index
+  of the last character is given by "last"
+*/
+
+void extract(unsigned first, unsigned last) {
+  int n = last - first + 1;
+  assert (last >= first);
+  array <char> x((char *) sa-- + first, n+1);
+  x[n] = 0;
+  ++sa << x;
+}
+
+/*
+ Look up the top string on the accumulator stack in the string dictionary.
+ If it has a value in the symbol table, replace it with the symbol table
+ value. If the value is numeric, convert it to integer. Otherwise, leave the
+ string untouched on the stack.
+*/
+
+void lookup(void) {
+  unsigned index = sd[sa];
+  if (index == 0) return;
+  switch (st[index].type) {
+    case string_type:
+    case value_type: {
+      --sa;                                       // discard name
+      ++sa << st[index].data.text;                // stack value
+      break;
+    }
+    case integer_type: {
+      --sa;                                       // discard name
+      (++sa).printf("%ld", st[index].data.integer); // convert to ascii
+      break;
+    }
+  }
+}
+
+/*
+ Find the data type of a symbol and change the reduction accordingly.
+ Return the dictionary index for strings, and the value itself for integers.
+*/
+
+long name_type(void) {
+  unsigned index = sd << sa--;
+  switch (st[index].type) {
+    case value_type:
+    case string_type: {
+      CHANGE_REDUCTION(string_name);
+      return index;
+    }
+    case built_in_function_type: {
+      CHANGE_REDUCTION(built_in_name);
+      return index;
+    }
+    case undefined_type: {
+      CHANGE_REDUCTION(undefined_name);
+      return index;
+    }
+    case integer_type: return st[index].data.integer;
+  }
+  return 0;
+}
+
+/*
+ Store a string formula. A string formula is a sequence of string identifiers
+ the values of which are to be concatenated. The parser has accumulated the
+ identifiers on the integer_stack, is. The formula is terminated by a zero
+ entry.
+*/
+
+int *formula(void) {
+  int n = size(is << 0);
+  int *f = new int[n];
+  while (n--) is >> f[n];
+  return f;
+}
+
+/*
+ Make a copy of an action that has been identified in the text stream.
+ An action pointer was stacked at the beginning of the action text on the
+ action stack, as.
+*/
+
+action_pointer copy_action(void) {
+  action_pointer ap;
+  as >> ap;                               // pop action descriptor
+  unsigned length = (unsigned) (PCB.pointer - ap.pointer);
+  unsigned char *action = memdup(ap.pointer,length + 1);
+  action[length] = 0;
+  ap.pointer = action;
+  return ap;
+}
+
+
+// Internal Commands
+
+int echo(int, char *args[]) {
+  int i;
+  char *cs = "";
+  for (i = 1; args[i]; i++) printf("%s%s", cs, args[i]), cs = " ";
+  printf("\n");
+  fflush(stdout);
+  return 0;
+}
+
+int pause(int, char *[]) {
+  int c;
+  while (kbhit()) getch();                  // Empty buffer
+  printf("Press any key to continue . . .\n");
+  c = getch();
+  if (c == 3) exit(1);
+  return c;
+}
+
+int exit_script(int n_args, char *args[]) {
+  if (n_args > 1) sscanf(args[1], "%ld", &exitcode);
+  exit(exitcode);
+  return exitcode;
+}
+
+/*
+int return_script(int n_args, char *args[]) {
+  if (n_args > 1) sscanf(args[1], "%ld", &exitcode);
+  PCB.exit_flag = AG_SUCCESS_CODE;
+  return exitcode;
+}
+*/
+
+int subdirs(int, char *args[]) {
+  struct find_t file_block;
+  int flag;
+  int length = strlen(args[1]);
+  array <char> name(args[1],length + 5);
+
+  strcat(name, "\\*.*");
+  for(flag = _dos_findfirst(name, _A_SUBDIR, &file_block);
+       flag == 0; flag = _dos_findnext(&file_block)) {
+    if ((file_block.attrib & _A_SUBDIR) == 0) continue;
+    if (strcmp(file_block.name, ".") == 0) continue;
+    if (strcmp(file_block.name, "..") == 0) continue;
+    puts(file_block.name);
+  }
+  return 0;
+}
+
+int files(int, char *args[]) {
+  struct find_t file_block;
+  int flag;
+  int length = strlen(args[1]);
+  array<char> name(args[1],length + 5);
+
+  strcat(name, "\\*.*");
+  for(flag = _dos_findfirst(name, 0, &file_block);
+       flag == 0; flag = _dos_findnext(&file_block)) {
+    puts(file_block.name);
+  }
+  return 0;
+}
+
+
+/*****
+
+ Execute Command Line
+
+*****/
+
+
+void perform_action(action_pointer ap) {
+  dsl_pcb_type save_pcb = PCB;
+
+  PCB.pointer = ap.pointer;
+  first_line = ap.line;
+  first_column = ap.column;
+  dsl();
+  exitflag = PCB.exit_flag != AG_SUCCESS_CODE;
+  PCB = save_pcb;
+  if (exitflag) PCB.exit_flag = AG_SEMANTIC_ERROR_CODE;
+}
+
+void exec(void) {
+  int n = size(ps << (char *) NULL);
+  int n_args = n - 1;
+  unsigned index;
+  unsigned uc_index;
+  int i;
+
+  array <char *> args(n);
+  while (n--) ps >> args[n];
+
+  index = sd[args[0]];
+  while (index && st[index].type == string_type) {
+     args[0] = st[index].data.text;                // stack value
+     index = sd[args[0]];
+  }
+  if (debug_switch) {
+    for (i = 0; args[i]; i++) fprintf(stderr, "%s ", args[i]);
+    fprintf(stderr,"\nPress any key to continue\n");
+    while (!kbhit());
+    getch();
+  }
+  strupr(args[0]);
+  uc_index = sd[args[0]];
+  if (n_args == 1 && strlen(args[0]) == 2 && args[0][1] == ':') {
+    errorlevel = system(args[0]);
+  }
+  else if ( *args[0] && uc_index) switch (st[uc_index].type) {
+    case internal_type: {
+      errorlevel = (*st[uc_index].data.proc)(n_args, args);
+      break;
+    }
+    case dos_type: {
+      int i;
+      for (i = 1; args[i]; i++) args[i][-1] = ' ';
+      errorlevel = system(args[0]);
+      if (errorlevel == -1) {
+        fprintf(stderr,"Error invoking %s: %s\n", args[0], sys_errlist[errno]);
+        exit(1);
+      }
+      break;
+    }
+  }
+  else if ( *args[0] && index) switch (st[index].type) {
+    case action_type: {
+      action_descriptor d = *st[index].data.action;
+      stack <symbol_table_entry> old_entries(d.n_args);
+			for (i = 0; i < d.n_args && args[i+1]; i++) {
+        old_entries << st[d.args[i]];
+        st[d.args[i]].type = value_type;
+        st[d.args[i]].data.text = memdup(args[i+1], 1 + strlen(args[i+1]));
+      }
+      perform_action(d.ap);
+      for (i = d.n_args; i--;) {
+        release(st[d.args[i]]);
+        old_entries >> st[d.args[i]];
+      }
+      break;
+    }
+    default: {
+      errorlevel = spawnvp(P_WAIT,args[0],ARGS);
+      if (errorlevel == -1) {
+        fprintf(stderr,"Error invoking %s: %s\n", args[0], sys_errlist[errno]);
+        exit(1);
+      }
+    }
+  }
+  else {
+  }
+  st[errorlevel_index].data.integer = errorlevel;
+  while (n_args--) --sa;
+  --ps;
+  if (kbhit()) {
+    int c = getch();
+    if (c == 3) exit(1);
+    ungetch(c);
+  }
+}
+
+void discard_temp_file(char *file_name) {
+  unlink(file_name);                        // Delete file
+  delete [] file_name;                      // Free storage for name
+}
+
+
+/*****
+
+ Execute Command with piped input
+
+*****/
+
+
+void exec_pipe_in(char *file_name) {
+  {
+    redirect sin(STDIN, file_name);
+    exec();
+  }
+  discard_temp_file(file_name);
+}
+
+
+/*****
+
+ Execute Command with redirected I/O
+
+*****/
+
+void exec_redirect_in(void) {
+  redirect sin(STDIN, sa--);
+  exec();
+}
+
+char *exec_pipe_out(void) {
+  fflush(stdout);
+  redirect sout(STDOUT);
+  exec();
+  fflush(stdout);
+  return save_file(sout);
+}
+
+char *exec_pipe_in_pipe_out(char *file_name) {
+  char *result;
+  {
+    redirect sin(STDIN, file_name);
+    fflush(stdout);
+    redirect sout(STDOUT);
+    exec();
+    fflush(stdout);
+    result = save_file(sout);
+  }
+  discard_temp_file(file_name);
+  return result;
+}
+
+char *exec_redirect_in_pipe_out(void) {
+  fflush(stdout);
+  redirect sout(STDOUT);
+  exec_redirect_in();
+  fflush(stdout);
+  return save_file(sout);
+}
+
+unsigned check_integer(void) {
+  unsigned index = sd << sa--;
+  if (st[index].type == integer_type) return index;
+  CHANGE_REDUCTION(undeclared_variable);
+  if (st[index].type == string_type) CHANGE_REDUCTION(string_variable);
+  return index;
+}
+
+void assign_value(unsigned index) {
+  char *text = copy(sa--);
+  release(st[index]);
+  st[index].type = value_type;
+  st[index].data.text = text;
+}
+
+void grab_output(char *temp_name) {
+  unlink(sa);                               // delete old file
+  rename(temp_name, sa--);                  // rename temp file
+  delete [] temp_name;                      // discard name string
+}
+
+void append_output(char *temp_name) {
+  fflush(stdout);
+  redirect sout(STDOUT, sa--, 1);           // append to file named on sa
+  redirect sin(STDIN, temp_name);
+  char buf[2000];
+  int n;
+  while (1) {
+    n = read(STDIN, buf, 2000);
+    if (n == 0) break;
+    write(STDOUT, buf, n);
+  }
+  fflush(stdout);
+  unlink(temp_name);
+  delete [] temp_name;
+}
+
+void action_string(void) {
+  action_pointer ap;
+  as >> ap;
+  unsigned length = (unsigned)(PCB.pointer - ap.pointer);
+  array <unsigned char> action(ap.pointer,length + 1);
+  action[length] = 0;
+  fflush(stdout);
+  redirect sout(STDOUT);
+  char *result;
+
+  ap.pointer = action;
+  perform_action(ap);
+  fflush(stdout);
+  result = content(sout);
+  ++sa << result;
+  delete [] result;
+}
+
+
+// Program Control functions
+
+// If/else statement
+
+int do_if(int pc, int cc) {
+  action_pointer ap;
+  as >> ap;
+  if (!pc && cc && exitflag == 0) {
+    unsigned length = (unsigned) (PCB.pointer - ap.pointer);
+    array<unsigned char> q(ap.pointer, length+1);
+    q[length] = 0;
+    ap.pointer = q;
+    perform_action(ap);
+  }
+  return pc || cc;
+}
+
+// While statement
+
+void do_while(int cc) {
+  unsigned length;
+  action_pointer ap;
+  as >> ap;
+  if (cc == 0) return;
+  length = (unsigned) (PCB.pointer - ap.pointer);
+  array<unsigned char> q(ap.pointer, length+1);
+  q[length] = 0;
+  ap.pointer = q;
+  perform_action(ap);
+  if (exitflag) return;
+  PCB.pointer = CONTEXT.pointer;
+  PCB.line = CONTEXT.line;
+  PCB.column = CONTEXT.column;
+}
+
+
+// For Statement
+// Note that this is the for statement in the DOS batch languange for, not C
+
+void do_for_loop(void) {
+  int n,k;
+  char *q;
+  char *seps = " \t\v\f\r\n";
+  action_pointer ap;
+  as >> ap;
+  unsigned length = (unsigned)(PCB.pointer - ap.pointer);
+  array <unsigned char> action(ap.pointer, length + 1);
+  action[length] = 0;
+
+  ap.pointer = action;
+  n = size(sa);
+  array<char> text(sa--, n + 1);
+
+
+  unsigned index = sd << sa--;
+
+  ++ps;
+  for (q = strtok(text, seps); q != NULL; q = strtok(NULL,seps)) {
+    if (*q == '(') {
+      int k = strlen(q) - 1;
+      assert(q[k] == ')');
+      q[k] = 0;
+      q++;
+    }
+    else if (*q == '"') {
+      int k = strlen(q) - 1;
+      assert(q[k] == '"');
+      q[k] = 0;
+      q++;
+    }
+    ps << q;
+  }
+  k = n = size(ps);
+  array<char *> args(n);
+  while (k--) ps >> args[k];
+  --ps;
+  symbol_table_entry save_table_entry = st[index];
+  st[index].type = value_type;
+
+  for (k = 0; k < n && exitflag == 0; k++) {
+    st[index].data.text = args[k];
+    perform_action(ap);
+  }
+  st[index] = save_table_entry;
+}
+
+void invoke_script(void) {
+  int handle = open(sa, O_TEXT | O_RDONLY);
+  long size;
+  unsigned n;
+  action_pointer ap;
+
+  if (handle < 0) {
+    fprintf(stderr,"Cannot open %s\n", (char *) sa--);
+    exit(1);
+  }
+  --sa;
+  size = filelength(handle);
+  assert(size < 65536L);
+  array <unsigned char> data((unsigned) size+1);
+  n = (unsigned) read(handle,data,(unsigned) size);
+  data[n] = 0;
+  close(handle);
+  exitflag = 0;
+  ap.pointer = data;
+  ap.line = ap.column = 1;
+  perform_action(ap);
+  st[errorlevel_index].data.integer = exitcode;
+  exitflag = exitcode = 0;
+  return;
+}
+
+internal_commands_descriptor internal_commands[] = {
+  {"ECHO", echo},
+  {"EXIT", exit_script},
+  {"FILES", files},
+  {"PAUSE", pause},
+//  {"RETURN", return_script},
+  {"SUBDIRS", subdirs},
+  {NULL, NULL}
+};
+
+struct built_ins_descriptor built_ins[] = {
+  {"file_exists", file_exists},
+  {"directory_exists", directory_exists},
+  {"string_length", string_length},
+  {"file_length", get_file_length},
+  {"disk_space", disk_space},
+  {"file_time", file_time},
+  {NULL, NULL}
+};
+
+void set_extension(char *path, char *e) {
+  char s[_MAX_PATH];
+  char drive[_MAX_DRIVE];
+  char dir[_MAX_DIR];
+  char file[_MAX_FNAME];
+  char ext[_MAX_EXT];
+
+  _splitpath(path,drive,dir,file,ext);
+  _makepath(s, drive, dir, file, e);
+  ++sa << s;
+}
+
+/*
+ Note that if this program is called without any arguments, it looks for a
+ script with the same name as the executable. Thus, to make an install
+ program that picks up the install script without any arguments, you simply
+ rename DSL.EXE to INSTALL.EXE. Then when you run it without any arguments
+ it will run the INSTALL.DSL script.
+*/
+
+void main(int argc, char *argv[]) {
+  int arg_number = 0;
+  int i = 1;
+  int j = 0;
+
+  init_dos_internals();
+  set_arg(j++, argv[0]);
+  if (argc > i && (argv[i][0] == '/' || argv[i][0] == '-')) {
+    if (toupper(argv[i][1]) != 'D') {
+      printf("Unrecognized switch -- /%s\n",argv[i][1]);
+      return;
+    }
+    debug_switch = 1;
+    i++;
+  }
+  if (argc > i) arg_number = i++;
+  set_extension(argv[arg_number], "DSL");
+  set_arg(j++,copy(sa));
+  while (i < argc) set_arg(j++, argv[i++]);
+  define_integer("argc", j);
+  invoke_script();                          // Takes file name from sa
+  exit(exitcode);
+}
+}                                           // End Embedded C