head	1.3;
access;
symbols;
locks
	gtoal:1.3; strict;
comment	@ * @;


1.3
date	2021.11.01.01.31.34;	author gtoal;	state Exp;
branches;
next	1.2;

1.2
date	2021.11.01.01.28.34;	author gtoal;	state Exp;
branches;
next	1.1;

1.1
date	2021.11.01.01.05.58;	author gtoal;	state Exp;
branches;
next	;


desc
@parser for cut-down version of C generated by 6809dasm --sbt
@


1.3
log
@minor comment
@
text
@// to do:  JUMP;

/*

# syntax for a very small subset of C as generated by the static binary translator
# after running through both 'dumpf' and 'peephole'...

# Note that expressions must be fully bracketed - no operator precedences allowed.
# If we hit constructs that are too awkward to parse, go back to the code generator
# and modify it so that they are never generated in the first place...
# For instance, "a + b + c" would need to be rewritten as "(a + b) + c"

*/

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <ctype.h>
#include <regex.h>

#ifndef FALSE
#define FALSE (0!=0)
#define TRUE (0==0)
#endif

static int debug = 0;

#define MAX_LINES 100000
#define MAX_LINE  1024

char *prog_line[MAX_LINES]; // max lines in a generated program
int end_of_file = 0; // exclusive upper bound
// for parsing:
int cur_line = 0;
int cur_col = 0;
// for failure message:
int best_line = 0;
int best_col = 0;

void read_file(FILE *in) {
  char s[1024]; // max length of a single line...
  int c;
  int cp; // char position
  for (;;) { // loop over lines
    if (end_of_file == MAX_LINES) {
      // too many lines
      exit(__LINE__);
    }
    cp = 0;
    for (;;) { // loop over chars in a line
      c = fgetc(in);
      if (c == EOF) {
        if (cp == 0) return;
        s[cp] = '\0';
        prog_line[end_of_file++] = strdup(s); // to do: check malloc ok
        return;
      }
      if (c == '\r') continue;
      if (c == '\n') {
        s[cp] = '\0';
        prog_line[end_of_file++] = strdup(s); // to do: check malloc ok
        break; // next line
      }
      s[cp++] = c;
      if (cp == MAX_LINE) {
        // line too long
        exit(__LINE__);
      }
    }
  }
}

enum phrase {
  SS,
    SS_COMMENT,
    SS_BR_LIST,
    SS_CASELAB,
    SS_LAB,
    SS_ASSIG,
    SS_STRINGPROCCALL,
    SS_PROCCALL,
    SS_IF,
    SS_GOTO,
    SS_JUMP,
    SS_NULL, 
  SS_LIST,
  IDENT,
  LABEL,
  VAR,
  VALUE,
  OPT_INDEX,
  FNNAME,
  PROCNAME,
  PARAM_LIST,
  REST_OF_PARAM_LIST,
  EXPR,
  FNCALL,
  TYPED_VAR,
    TYPED_VAR_CAST,
    TYPED_VAR_NORMAL,
  OPT_BINOP,
    OPT_BINOP_PRESENT,
    OPT_BINOP_ABSENT,
  OPT_MONOP,
  CASTNAME,
  BINOP,
  SELECTOR,
  HEX_CONSTANT,
  POSITIVE_INTEGER,
  STRING_LITERAL
};

typedef struct tuple {
  int phraseno;
  int subphrase;
  int line;
  int col;
  char *matched;
  struct tuple *phrase[10]; // max args to a proc, for safety.
} tuple;

tuple *new_tuple(int type) {
  tuple *t;
  t = calloc(1, sizeof(tuple));
  t->phraseno = type;
  return t;
}

static int indent = 0;
char *sp(void) {
  static char string[256];
  int i;
  for (i = 0; i < indent; i++) string[i] = ' ';
  string[indent] = '\0';
  return string;
}

void in(const char *s) {
  int i;
  char *p;


  p = prog_line[cur_line]+cur_col;
  for (;;) {
    if (cur_line >= end_of_file) break;
    while (*p == ' ') { p += 1; cur_col += 1; } // always skip white space on this line before an atom (OK if we leave it skipped)
    // skip newlines as well as spaces
    if (*p == '\0') {
      cur_line += 1; cur_col = 0;
      if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
      if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

      p = prog_line[cur_line]+cur_col;
    } else break;
  }

  if (debug <= 0) return;
  for (i = 0; i < indent; i++) fprintf(stderr, " ");
  fprintf(stderr, ">> %s at: \"%s\"\n", s, (cur_line >= end_of_file ? "<EOF>" : p));
  indent += 2;
}
#define IN in(__FUNCTION__)

int out(int success, const char *s) {
  //int i;
  int line = cur_line, col = cur_col;
  char *p;
  
  p = prog_line[cur_line]+cur_col;
  indent -= 2;
  //for (i = 0; i < indent; i++) fprintf(stderr, " ");
  if (success) {
    for (;;) {
      if (cur_line >= end_of_file) break;
      while (*p == ' ') { p += 1; cur_col += 1; } // always skip white space on this line before an atom (OK if we leave it skipped)
      // skip newlines as well as spaces
      if (*p == '\0') {
        cur_line += 1; cur_col = 0;
        if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
        if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

        p = prog_line[cur_line]+cur_col;
      } else break;
    }
    if (debug >= 1) fprintf(stderr, "%s<< %s MATCHED leaving: @@@@@@\"%s\"@@@@@@\n", sp(), s, (cur_line == end_of_file ? "<EOF>" : p));
  } else {
    if (debug >= 1) fprintf(stderr, "%s<< %s\n", sp(), s);
  }
  cur_line = line; cur_col = col;
  return success;
}
#define OUT(cond) out(cond, __FUNCTION__)

int parse_ss_list(tuple *ss_list);
int parse_selector(tuple *sel);
int parse_rest_of_param_list(tuple *param_list);
int parse_expr(tuple *expr);
int parse_positive_integer(tuple *posint);
int parse_hex_constant(tuple *hex);
int parse_procname(tuple *fnname);
int parse_fnname(tuple *procname);
int parse_param_list(tuple *param_list);
int parse_cond(tuple *cond);

int lex_lit(char *lit) {
  char *p = prog_line[cur_line]+cur_col;
  IN;
  
  if (debug >= 1) fprintf(stderr, "%sLex: Trying \"%s\"\n", sp(), lit);
  
  if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
  if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

  if (*lit == '\0') return OUT(TRUE); // empty string always matches

  for (;;) {
    if (cur_line >= end_of_file) return OUT(FALSE); // non-empty string can't match end of file
    p = prog_line[cur_line]+cur_col;
    while (*p == ' ') { // always skip white space on this line before an atom (OK if we leave it skipped)
      p += 1;
      cur_col += 1;
    }
    if (strcmp(lit, "\n") == 0) { // special case for end-of-line (should always be only char in string)
      if (*p == '\0') {
        cur_line += 1; cur_col = 0;
        if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
        if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

        return OUT(TRUE);
      }
      return OUT(FALSE);
    } else {
      // skip newlines as well as spaces
      if (*p == '\0') {
        cur_line += 1; cur_col = 0;
        if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
        if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

        p = prog_line[cur_line]+cur_col;
        if (debug >= 1) fprintf(stderr, "%s+Lex: Trying \"%s\"\n", sp(), lit);
      } else break;
    }
  }
  
  p = prog_line[cur_line]+cur_col;
  if (strncmp(lit, p, strlen(lit)) == 0) {
    cur_col += strlen(lit);
    if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
    if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

    return OUT(TRUE);
  }
  return OUT(FALSE);
}

char *extract(char *s, int start /* inclusive */, int end /* exclusive */) {
  char *t = malloc(end-start+1);
  int i;
  if (t == NULL) {
    // failure to malloc
    exit(__LINE__);
  }
  for (i = 0; i < end-start; i++) {
    t[i] = s[i+start];
  }
  t[end-start] = '\0';
  return t;
}

int lex_regex(char *regexs, char **matched) {
#define MAX_MATCHES 32 // or is this always 1 in this code?
  regmatch_t matches[MAX_MATCHES];
  regex_t regex;
  int reti;
  char msgbuf[100];
  char *p = prog_line[cur_line]+cur_col;

  IN;
  if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
  if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

  if (debug >= 1) fprintf(stderr, "%sRegex 1: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
  if (debug >= 1) fprintf(stderr, "%sTrying \"%s\"\n", sp(), regexs);

  if (matched == NULL) {
    exit(__LINE__);
  }
  
  if (*regexs == '\0') {return OUT(TRUE);} // empty string always matches

  /*
              >> parse_goto_statement at: "goto L00C3;"
                >> lex_lit at: "goto L00C3;"
                  Lex: Trying "goto"
                << lex_lit MATCHED leaving: @@@@@@"L00C3;"@@@@@@
                >> lex_regex at: "L00C3;"
                  Regex 1: pending data is: "L00C3;"
                  Trying "^[A-Za-z_][A-Za-z_0-9]*"
                  Regex 2: pending data is: "00C3;"
                  Regex 6: pending data is: "00C3;"
                  Regex: pending data is: "00C3;"
                  Regex "^[A-Za-z_][A-Za-z_0-9]*" matched "L00C3" leaving ***""***
                << lex_regex MATCHED leaving: @@@@@@"}"@@@@@@
                >> lex_lit at: "}"
                  Lex: Trying ";"
                << lex_lit
              << parse_goto_statement
   */
  
  for (;;) {
    p = prog_line[cur_line]+cur_col;
    if (cur_line >= end_of_file) {return OUT(FALSE);} // non-empty string can't match end of file
    while (*p == ' ') {
      p += 1;
      cur_col += 1;
      if (debug >= 1) fprintf(stderr, "%sRegex 2: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
    } // always skip white space on this line before an atom (OK if we leave it skipped)
    if (strcmp(regexs, "^$") == 0) { // special case for end-of-line (should always be only char in string)
      if (*p == '\0') {
        cur_line += 1; cur_col = 0;
        if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
        if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

        if (debug >= 1) fprintf(stderr, "%sRegex 3: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
        return OUT(TRUE);
      }
      if (debug >= 1) fprintf(stderr, "%sRegex 4: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
      return OUT(FALSE);
    } else {
      // skip newlines as well as spaces
      if (*p == '\0') {
        cur_line += 1; cur_col = 0;
        if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
        if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;

        p = prog_line[cur_line]+cur_col;
        if (debug >= 1) fprintf(stderr, "%s+Trying \"%s\"\n", sp(), regexs);
        if (debug >= 1) fprintf(stderr, "%sRegex 5: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
      } else break;
    }
  }

  /* Compile regular expression */
  if (regcomp(&regex, regexs, 0) != 0) {
    fprintf(stderr, "Could not compile regex \"%s\"\n", regexs);
    exit(__LINE__);
  }

  /* Execute regular expression */
  reti = regexec(&regex, p, MAX_MATCHES, matches, 0);

  if (debug >= 1) fprintf(stderr, "%sRegex 6: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);
  if ((!reti) && (matches[0].rm_so == 0)) { // 0 is in case user forgets the "^" anchor ...
    // Step over matched string.

    /*
                >> lex_regex at: "L00C3;"
                  Trying "^[A-Za-z_][A-Za-z_0-9]*"
                  Regex "^[A-Za-z_][A-Za-z_0-9]*" matched "L00C3" leaving ""
                << lex_regex MATCHED leaving: "}"
     */

    if (debug >= 1) fprintf(stderr, "%sRegex: pending data is: \"%s\"\n", sp(), prog_line[cur_line]+cur_col);

    *matched = extract(p, matches[0].rm_so, matches[0].rm_eo);
    cur_col += strlen(*matched);

    if (cur_line > best_line) { best_line = cur_line; best_col = cur_col; }
    if ((cur_line == best_line) && (cur_col > best_col)) best_col = cur_col;
    p = prog_line[cur_line]+cur_col;

    if (debug >= 1) fprintf(stderr, "%sRegex \"%s\" matched \"%s\" leaving ***\"%s\"***\n", sp(), regexs, *matched, p);
    /* Free memory allocated to the pattern buffer by regcomp() */
//  regfree(&regex);
    return OUT(TRUE);
  } else if (reti == REG_NOMATCH) {
    // puts("No match");
    /* Free memory allocated to the pattern buffer by regcomp() */
//  regfree(&regex); // maybe? -  http://redhat.com/archives/libvir-list/2013-September/msg00276.html 
    return OUT(FALSE);
  }
  
  regerror(reti, &regex, msgbuf, sizeof(msgbuf));
  fprintf(stderr, "%sRegex match internal error: %s\n", sp(), msgbuf);
  exit(__LINE__);
  return OUT(FALSE);
}

//\\ stringlit := \"([^\\\"]|\\.)*\";
int parse_stringlit(tuple *stringlit) {
  //  return lex_regex("^\"([^\\\"]|\\.)*\"", &stringlit->matched);
  return lex_regex("^\".*\"", &stringlit->matched);
}

//\\ castname := "[A-Z][A-Z]*[0-9][0-9]*";
int parse_castname(tuple *castname) {
  return lex_regex("^[A-Z][A-Z]*[0-9][0-9]*", &castname->matched);
}

//\\ ident := "[A-Za-z_][A-Za-z_0-9]*";
int parse_ident(tuple *ident) {
  return lex_regex("^[A-Za-z_][A-Za-z_0-9]*", &ident->matched);
}

//\\ label := <ident>;
int parse_label(tuple *labelname) {
  return parse_ident(labelname);
}

//\\ <opt-index> :=
//\\   '[' <expr> ']',
//\\   ;
int parse_opt_index(tuple *opt_index) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  IN;
  if (lex_lit("[") && parse_expr(opt_index) && lex_lit("]")) {
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;
  return OUT(TRUE);
}

int parse_fn_call(tuple *fncall) {
  //\\   <fnname> '(' ')',
  //\\   <fnname> '(' <param-list> ')',
  tuple *fnname, *param_list;
  int line, col;
  IN;
  line = cur_line; col = cur_col;
  fnname = new_tuple(FNNAME);
  param_list = new_tuple(PARAM_LIST);
  if (parse_fnname(fnname) && lex_lit("(") && ((lex_lit(")")) || (parse_param_list(param_list) && lex_lit(")")))) {
    // TO DO: plug in procname and param_list fields here...
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;
  return OUT(FALSE);
}

//\\ var := 
//\\   <ident> <opt-index>;
int parse_var(tuple *var) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *ident = new_tuple(IDENT), *opt_index = new_tuple(OPT_INDEX);
  IN;
  if (parse_ident(ident) && parse_opt_index(opt_index)) {
    var->phrase[0] = ident;
    var->phrase[1] = opt_index;
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;
  return OUT(FALSE);
}

//\\ val := 
//\\   '(' <expr> '?' <expr> : <expr> ')',
//\\   '(' <expr> ')',
//\\   <fncall>,
//\\   <var>,
//\\   <hex-constant>,
//\\   <positive-integer>;
int parse_val(tuple *val) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *fncall = new_tuple(FNCALL), *expr = new_tuple(EXPR),*expr1 = new_tuple(EXPR),*expr2 = new_tuple(EXPR);
  // to do: assign subtypes
  IN;

  if (lex_lit("(") && parse_expr(expr) && lex_lit("?") && parse_expr(expr1) && lex_lit(":") && parse_expr(expr2) && lex_lit(")")) {
    val->phrase[0] = expr;
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;

  if (lex_lit("(") && parse_expr(expr) && lex_lit(")")) {
    val->phrase[0] = expr;
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;

  if (parse_fn_call(fncall)) {
    val->phrase[0] = fncall;
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col; // not needed if fncall cleaned up properly
  if (parse_var(val)) {
    return OUT(TRUE);
  }
  if (parse_hex_constant(val)) {
    return OUT(TRUE);
  }
  if (parse_positive_integer(val)) {
    return OUT(TRUE);
  }

  return OUT(FALSE);
}

//\\ opt-monop :=
//\\   '-', '~', '!'
//\\   ;
int parse_opt_monop(tuple *opt_monop) {
  IN;
  if (lex_lit("-")) {
    opt_monop->matched = "-";
    return OUT(TRUE);
  } else if (lex_lit("~")) {
    opt_monop->matched = "~";
    return OUT(TRUE);
  } else if (lex_lit("!")) {
    opt_monop->matched = "!";
    return OUT(TRUE);
  }

  opt_monop->matched = ""; // or NULL???
  return OUT(TRUE);
}

//\\ typed-val :=
//\\   '(' <castname> ')' <opt-monop> <val>,
//\\   <opt-monop> <val>;
int parse_typed_var(tuple *typed_var) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *castname = new_tuple(CASTNAME), *opt_monop = new_tuple(OPT_MONOP), *val = new_tuple(VALUE);
  // could shorten this...
  IN;
  if (lex_lit("(") && parse_castname(castname) && lex_lit(")") && parse_opt_monop(opt_monop) && parse_val(val)) {
    typed_var->subphrase = TYPED_VAR_CAST;
    typed_var->phrase[0] = castname;
    typed_var->phrase[1] = opt_monop;
    typed_var->phrase[2] = val;
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;
  if (parse_opt_monop(opt_monop) && parse_val(val)) {
    typed_var->subphrase = TYPED_VAR_NORMAL;
    typed_var->phrase[0] = NULL;
    typed_var->phrase[1] = opt_monop;
    typed_var->phrase[2] = val;
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;
  return OUT(FALSE);
}

//\\ binop :=
//\\   '+', '-', '>>', '<<', '&', '|', '^';
int parse_binop(tuple *binop) {
  IN;
  if (lex_lit(">>")) {
    binop->matched = ">>";
    return OUT(TRUE);
  } else if (lex_lit("<<")) {
    binop->matched = "<<";
    return OUT(TRUE);
  } else if (lex_lit("+")) {
    binop->matched = "+";
    return OUT(TRUE);
  } else if (lex_lit("*")) {
    binop->matched = "*";
    return OUT(TRUE);
  } else if (lex_lit("/")) {
    binop->matched = "/";
    return OUT(TRUE);
  } else if (lex_lit("-")) {
    binop->matched = "-";
    return OUT(TRUE);
  } else if (lex_lit("&&")) {
    binop->matched = "&&";
    return OUT(TRUE);
  } else if (lex_lit("||")) {
    binop->matched = "||";
    return OUT(TRUE);
  } else if (lex_lit("&")) {
    binop->matched = "&";
    return OUT(TRUE);
  } else if (lex_lit("|")) {
    binop->matched = "|";
    return OUT(TRUE);
  } else if (lex_lit("^")) {
    binop->matched = "^";
    return OUT(TRUE);
  } else if (lex_lit("<=")) {
    binop->matched = "<=";
    return OUT(TRUE);
  } else if (lex_lit("<")) {
    binop->matched = "<";
    return OUT(TRUE);
  } else if (lex_lit(">=")) {
    binop->matched = ">=";
    return OUT(TRUE);
  } else if (lex_lit(">")) {
    binop->matched = ">";
    return OUT(TRUE);
  } else if (lex_lit("!=")) {
    binop->matched = "!=";
    return OUT(TRUE);
  } else if (lex_lit("==")) {
    binop->matched = "==";
    return OUT(TRUE);
  }

  return OUT(FALSE);
}

//\\ opt-binop :=
//\\   <binop> <typed-val>,
//\\   ;
int parse_opt_binop(tuple *opt_binop) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *binop = new_tuple(BINOP), *typed_var = new_tuple(TYPED_VAR);
  IN;
  if (parse_binop(binop) && parse_typed_var(typed_var)) {
    opt_binop->subphrase = OPT_BINOP_PRESENT;
    opt_binop->phrase[0] = binop;
    opt_binop->phrase[1] = typed_var;
    return OUT(TRUE);
  }
  opt_binop->subphrase = OPT_BINOP_ABSENT;
  opt_binop->phrase[0] = NULL;
  opt_binop->phrase[1] = NULL;
  cur_line = line; cur_col = col;
  return OUT(TRUE);
}

//\\ expr :=
//\\   <typed-val> <opt-binop>;
int parse_expr(tuple *expr) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *typed_var = new_tuple(TYPED_VAR), *opt_binop = new_tuple(OPT_BINOP);
  IN;
  if (parse_typed_var(typed_var) && parse_opt_binop(opt_binop)) {
    expr->phrase[0] = typed_var;
    expr->phrase[1] = opt_binop;
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;
  return OUT(FALSE);
}

//\\ fnname := <ident>;
int parse_fnname(tuple *fnname) {
  return parse_ident(fnname);
}

//\\ procname := <ident>;
int parse_procname(tuple *procname) {
  return parse_ident(procname);
}

// TO DO: string parameters...

//\\ param-list := <expr> <rest-of-param-list>;
int parse_param_list(tuple *param_list) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *expr = new_tuple(EXPR), *rest_of_param_list = new_tuple(REST_OF_PARAM_LIST);
  IN;
  if (parse_expr(expr) && parse_rest_of_param_list(rest_of_param_list)) {
    param_list->phrase[0] = expr;
    param_list->phrase[1] = rest_of_param_list;
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;
  return OUT(FALSE);
}

//\\ rest-of-param-list :=
//\\   ',' <expr> <rest-of-param-list>,
//\\   ;
int parse_rest_of_param_list(tuple *param_list) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *expr = new_tuple(EXPR), *rest_of_param_list = new_tuple(REST_OF_PARAM_LIST);
  IN;
  if (lex_lit(",") && parse_expr(expr) && parse_rest_of_param_list(rest_of_param_list)) {
    param_list->phrase[0] = expr;
    param_list->phrase[1] = rest_of_param_list;
    return OUT(TRUE);
  }
  param_list->phrase[0] = NULL;
  param_list->phrase[1] = NULL;
  cur_line = line; cur_col = col;
  return OUT(TRUE);
}

//\\ ss := 
int parse_ss(tuple *ss) {
  //int line, col; // save current parse position for backtracking...
  
  int parse_comment(tuple *comment) {
//\\   '//' ".*",
    int line, col;
    IN;
    line = cur_line; col = cur_col;
    if (lex_regex("^//.*", &comment->matched) /*&& lex_lit("\n")*/) {
      return OUT(TRUE);
    }
    cur_line = line; cur_col = col;
    return OUT(FALSE);
  }
  
  int parse_bracketed_ss_list(tuple *bss) {
//\\   '{' <ss-list> '}',
    tuple *ssl;
    int line, col;
    IN;
    line = cur_line; col = cur_col;
    ssl = new_tuple(SS_BR_LIST);
    if (lex_lit("{") && parse_ss_list(ssl) && lex_lit("}")) {
      return OUT(TRUE);
    }
    cur_line = line; cur_col = col;
    return OUT(FALSE);
  }
  
  int parse_case_label(tuple *caselab) {
//\\   "case" <selector> ':',
    tuple *sel;
    int line, col;
    IN;
    line = cur_line; col = cur_col;
    sel = new_tuple(SELECTOR);
    if (lex_lit("case") && parse_selector(sel) && lex_lit(":") /*&& lex_lit("\n")*/) {
      return OUT(TRUE);
    }
    cur_line = line; cur_col = col;
    return OUT(FALSE);
  }
  
  int parse_label_statement(tuple *lab_statement) {
//\\   <label> ':',
    tuple *lab;
    int line, col;
    IN;
    line = cur_line; col = cur_col;
    lab = new_tuple(LABEL);
    if (parse_label(lab) && lex_lit(":") /*&& lex_lit("\n")*/) {
      return OUT(TRUE);
    }
    cur_line = line; cur_col = col;
    return OUT(FALSE);
  }
  
  int parse_assignment(tuple *assig) {
    // need to handle &= in code generator instead
//\\   <var> '=' <expr> ';',
    tuple *var, *expr;
    int line, col;
    IN;
    line = cur_line; col = cur_col;
    var = new_tuple(VAR);
    expr = new_tuple(EXPR);
    if (parse_var(var) && (lex_lit("=") || lex_lit("&=")) && parse_expr(expr) && lex_lit(";") /*&& lex_lit("\n")*/) {
      return OUT(TRUE);
    }
    cur_line = line; cur_col = col;
    return OUT(FALSE);
  }
  
  int parse_procedure_call(tuple *proccall) {
//\\   <procname> '(' ')' ';',
//\\   <procname> '(' <param-list> ')' ';',
    tuple *procname, *param_list;
    int line, col;
    IN;
    line = cur_line; col = cur_col;
    procname = new_tuple(PROCNAME);
    param_list = new_tuple(PARAM_LIST);
    if (parse_procname(procname) && lex_lit("(") && ((lex_lit(")")) || (parse_param_list(param_list) && lex_lit(")"))) && lex_lit(";") /*&& lex_lit("\n")*/) {
      // TO DO: plug in procname and param_list fields here...
      return OUT(TRUE);
    }
    cur_line = line; cur_col = col;
    return OUT(FALSE);
  }
  
  int parse_string_procedure_call(tuple *proccall) {
//\\   <procname> '(' <stringlit> ')' ';',
    tuple *procname, *stringlit;
    int line, col;
    IN;
    line = cur_line; col = cur_col;
    procname = new_tuple(PROCNAME);
    stringlit = new_tuple(STRING_LITERAL);
    if (parse_procname(procname) && lex_lit("(") && parse_stringlit(stringlit) && lex_lit(")") && lex_lit(";") /*&& lex_lit("\n")*/) {
      // TO DO: plug in procname and param_list fields here...
      return OUT(TRUE);
    }
    cur_line = line; cur_col = col;
    return OUT(FALSE);
  }
  
  int parse_if_statement(tuple *ifstat) {
    // changing SS to <bracketed-ss-list> as an experiment
//\\   "if" '(' <expr> ')' <SS>,
    tuple *expr, *ss;
    int line, col;
    IN;
    expr = new_tuple(EXPR);
    ss = new_tuple(SS);
    line = cur_line; col = cur_col;
    //if (lex_lit("if") && lex_lit("(") && parse_cond(cond) && lex_lit(")") && parse_ss(ss)) {
    if (lex_lit("if") && lex_lit("(") && parse_expr(expr) && lex_lit(")") && parse_bracketed_ss_list(ss)) {
      // TO DO: plug in cond and ss fields here...
      return OUT(TRUE);
    }
    cur_line = line; cur_col = col;
    return OUT(FALSE);
  }
  
//\\   "goto" <label> ';',
  int parse_goto_statement(tuple *g) {
    tuple *lab;
    int line, col;
    IN;
    lab = new_tuple(LABEL);
    line = cur_line; col = cur_col;
    if (lex_lit("goto") && parse_label(lab) && lex_lit(";") /*&& lex_lit("\n")*/) {
      return OUT(TRUE);
    }
    cur_line = line; cur_col = col;
    return OUT(FALSE);
  }
  
//\\   "JUMP" ';',
  int parse_jump_statement(tuple *g) {
    int line, col;
    IN;
    line = cur_line; col = cur_col;
    if (lex_lit("JUMP") && lex_lit(";") /*&& lex_lit("\n")*/) {
      return OUT(TRUE);
    }
    cur_line = line; cur_col = col;
    return OUT(FALSE);
  }
  
//\\   ';';
  int parse_null_statement(tuple *ns) {
    return lex_lit(";");
  }
  
  IN;
  
  if (parse_comment(ss)) {
    ss->subphrase = SS_COMMENT;
    return OUT(TRUE);
  } else if (parse_bracketed_ss_list(ss)) {
    ss->subphrase = SS_BR_LIST;
    return OUT(TRUE);
  } else if (parse_case_label(ss)) {
    ss->subphrase = SS_CASELAB;
    return OUT(TRUE);
  } else if (parse_label_statement(ss)) {
    ss->subphrase = SS_LAB;
    return OUT(TRUE);
  } else if (parse_if_statement(ss)) {
    ss->subphrase = SS_IF;
    return OUT(TRUE);
  } else if (parse_goto_statement(ss)) {
    ss->subphrase = SS_GOTO;
    return OUT(TRUE);
  } else if (parse_procedure_call(ss)) {
    ss->subphrase = SS_PROCCALL;
    return OUT(TRUE);
  } else if (parse_string_procedure_call(ss)) {
    ss->subphrase = SS_STRINGPROCCALL;
    return OUT(TRUE);
  } else if (parse_jump_statement(ss)) {
    ss->subphrase = SS_JUMP;
    return OUT(TRUE);
  } else if (parse_assignment(ss)) {
    ss->subphrase = SS_ASSIG;
    return OUT(TRUE);
  } else if (parse_null_statement(ss)) {
    ss->subphrase = SS_NULL;
    return OUT(TRUE);
  }

  return OUT(FALSE);
}


//\\ ss-list :=
//\\   <ss> <ss-list>,
//\\   ;

int parse_ss_list(tuple *ss_list) {
  tuple *ss, *more_ss;
  int line, col;
  IN;
  
  line = cur_line; col = cur_col;

  ss = new_tuple(SS);
  more_ss = new_tuple(SS_LIST);

  ss_list->phrase[0] = NULL;
  ss_list->phrase[1] = NULL;

  if (lex_lit("}") || (cur_line >= end_of_file)) { // !lex_regex("^.") ???
    cur_line = line; cur_col = col;
    return OUT(TRUE); // null option
  }
  
  if (parse_ss(ss) && parse_ss_list(more_ss)) {
    ss_list->phrase[0] = ss;
    ss_list->phrase[1] = more_ss;
    return OUT(TRUE);
  }

  // a syntax error.
  cur_line = line; cur_col = col; // backtrack
  return OUT(FALSE);
}

//\\ hex-constant := "0x[0-9A-Fa-f][0-9A-Fa-f]*";
int parse_hex_constant(tuple *hex) {
  return lex_regex("^0x[0-9A-Fa-f][0-9A-Fa-f]*", &hex->matched) && (lex_lit("U") || TRUE);
}

//\\ positive-integer := "[0-9][0-9]*";
int parse_positive_integer(tuple *posint) {
  return lex_regex("^[0-9][0-9]*", &posint->matched);
}


// really 'integer value'. should add another layer for 'selector'...
//\\ selector :=
int parse_selector(tuple *sel) {
  tuple *hex, *posint;
  IN;
  
  hex = new_tuple(HEX_CONSTANT);
  posint = new_tuple(POSITIVE_INTEGER);

//\\   <hex-constant>,
  if (parse_hex_constant(hex)) {
    sel->subphrase = HEX_CONSTANT;
    sel->phrase[0] = hex;
    return OUT(TRUE);
  }

//\\   <positive-integer>;
  if (parse_positive_integer(posint)) {
    sel->subphrase = POSITIVE_INTEGER;
    sel->phrase[0] = posint;
    return OUT(TRUE);
  }

  return OUT(FALSE);
}

int main(int argc, char **argv) {
  tuple *program;

  if ((argc == 2) && (strcmp(argv[1], "-d") == 0)) debug = 1;
  
  read_file(stdin);
  
  program = new_tuple(SS_LIST);
  
  if (parse_ss_list(program) && (cur_line == end_of_file)) {
    // output optimised program
    fprintf(stderr, "%d lines of %d compiled.\n", cur_line, end_of_file);
    exit(0);
  } else {
    int i;
    fprintf(stderr, "Error at line %d, col %d.\n\n", best_line, best_col);
    fprintf(stderr, "%s\n", prog_line[best_line]);
    for (i = 0; i < best_col; i++) fprintf(stderr, " ");
    fprintf(stderr, "^ * Syntax\n");
    exit(1);
  }

  return(1);
}
@


1.2
log
@removed phrase for comparisons, made it part of expr instead, as C does.
@
text
@d11 1
a11 1

@


1.1
log
@Initial revision
@
text
@a106 3
  COND,
  OPT_COMPARE,
  COMPOP,
d464 1
a464 4
  tuple *fncall = new_tuple(FNCALL),
    *expr = new_tuple(EXPR),*expr1 = new_tuple(EXPR),*expr2 = new_tuple(EXPR),
    *cond = new_tuple(COND);

d468 1
a468 1
  if (lex_lit("(") && parse_cond(cond) && lex_lit("?") && parse_expr(expr1) && lex_lit(":") && parse_expr(expr2) && lex_lit(")")) {
a544 50
//\\ compop :=
//\\   '<=', '>=', '<', '>', '!=', '==';
int parse_compop(tuple *compop) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...

  IN;
  line = cur_line; col = cur_col;

  if (lex_lit("<=")) {
    compop->matched = "<=";
    return OUT(TRUE);
  } else if (lex_lit("<")) {
    compop->matched = "<";
    return OUT(TRUE);
  } else if (lex_lit(">=")) {
    compop->matched = ">=";
    return OUT(TRUE);
  } else if (lex_lit(">")) {
    compop->matched = ">";
    return OUT(TRUE);
  } else if (lex_lit("!=")) {
    compop->matched = "!=";
    return OUT(TRUE);
  } else if (lex_lit("==")) {
    compop->matched = "==";
    return OUT(TRUE);
  }

  cur_line = line; cur_col = col;
  return OUT(FALSE);
}

//\\ <opt-compare> :=
//\\   <compop> <expr>,
//\\   ;
int parse_opt_compare(tuple *opt_compare) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *compop = new_tuple(COMPOP), *expr = new_tuple(EXPR);
  IN;
  if (parse_compop(compop) && parse_expr(expr)) {
    opt_compare->phrase[0] = compop;
    opt_compare->phrase[1] = expr;
    return OUT(TRUE);
  }
  opt_compare->phrase[0] = NULL;
  opt_compare->phrase[1] = NULL;
  cur_line = line; cur_col = col;
  return OUT(TRUE);
}

d582 18
a683 15
//\\ cond :=
//\\   <expr> <opt-compare>;
int parse_cond(tuple *cond) {
  int line = cur_line, col = cur_col; // save current parse position for backtracking...
  tuple *expr = new_tuple(EXPR), *opt_compare = new_tuple(OPT_COMPARE);
  IN;
  expr = new_tuple(EXPR);
  opt_compare = new_tuple(OPT_COMPARE);
  if (parse_expr(expr) && parse_opt_compare(opt_compare)) {
    return OUT(TRUE);
  }
  cur_line = line; cur_col = col;
  return OUT(FALSE);
}

d793 2
a794 2
//\\   "if" '(' <cond> ')' <SS>,
    tuple *cond, *ss;
d797 1
a797 1
    cond = new_tuple(COND);
d801 1
a801 1
    if (lex_lit("if") && lex_lit("(") && parse_cond(cond) && lex_lit(")") && parse_bracketed_ss_list(ss)) {
d916 1
a916 1
  return lex_regex("^0x[0-9A-Fa-f][0-9A-Fa-f]*", &hex->matched);
@
