{                                           // 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, literals}
  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
 -> 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
 -> string literal
 -> literal
 -> action word, '[', parameter string, ']'  

/*****

 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, ws..., 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 "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;
  int i;

  array <char *> args(n);
  while (n--) ps >> args[n];

  strupr(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();
  }
  index = sd[args[0]];
  if (n_args == 1 && strlen(args[0]) == 2 && args[0][1] == ':') {
    errorlevel = system(args[0]);
  }
  else if ( *args[0] && index) switch (st[index].type) {
    case internal_type: {
      errorlevel = (*st[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]);
      assert(errorlevel >= 0);
      break;
    }
    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]];
      }
    }
  }
  else {
    errorlevel = spawnvp(P_WAIT,args[0],ARGS);
    assert(errorlevel >= 0);
  }
  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;

  if (argv[0][0] == '.') argv[0] = "\\agex\\dsl\\wat32\\dsl.exe";
  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