bob@reed.UUCP (Bob Ankeney) (04/10/91)
#!/bin/sh
# this is part 3 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file parse.c continued
#
CurArch=3
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
exit 1; fi
( read Scheck
if test "$Scheck" != $CurArch
then echo "Please unpack part $Scheck next!"
exit 1;
else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> parse.c
X out_string = temp_out_string;
X
X /* Check for '=' */
X if ((token_class != OPERATOR) ||
X (token.token_type != EQUAL)) {
X parse_error("Missing '='");
X pop_context();
X return;
X }
X /* Send <ident> '=' <expr> */
X out_str(var_string);
X out_token(&token);
X token_class = parse_expression(&token);
X if ((token_class != RESERVED) ||
X (token.token_type != TO)) {
X parse_error("Missing TO");
X pop_context();
X return;
X }
X
X /* Send <ident> <= <limit> */
X out_str("; ");
X out_str(var_string);
X out_str(" <=");
X token_class = parse_expression(&token);
X out_str("; ");
X
X /* Parse increment */
X if ((token_class == RESERVED) &&
X (token.token_type == BY)) {
X
X /* Send <ident> += <step> */
X out_str(var_string);
X out_str(" +=");
X token_class = parse_expression(&token);
X } else {
X /* Send <ident>++ */
X out_str(var_string);
X out_str("++");
X }
X
X out_str(") {"); /* } for dumb vi */
X out_white_space(&token);
X
X if (token_class != END_OF_LINE) {
X parse_error("BY or ';' expected");
X pop_context();
X return;
X }
X
X parse_to_end();
X break;
X
X case RESERVED :
X switch (token.token_type) {
X
X case CASE :
X /* DO CASE <expr>; */
X out_str("switch (");
X if (parse_expression(&token) != END_OF_LINE) {
X parse_error("';' expected");
X pop_context();
X return;
X }
X out_white_space(&token);
X out_str(") {"); /* } for dumb vi */
X
X case_line = 0;
X while (1) {
X /* Place case statement in out_string */
X temp_out_string1 = out_string;
X case_output[0] = '\0';
X out_string = case_output;
X
X (void) sprintf(case_statement, "case %d :",
X case_line++);
X token_class = parse_new_statement();
X if (token_class == END_OF_FILE) {
X parse_error("Premature end-of-file");
X exit(1);
X }
X if (token_class == END) {
X out_string = temp_out_string1;
X out_str(case_output);
X break;
X }
X out_string = temp_out_string1;
X out_white_space(first_token);
X out_str(case_statement);
X out_str(case_output);
X out_white_space(first_token);
X out_str("break;\n");
X }
X break;
X
X case WHILE :
X /* DO WHILE <expr>; */
X out_str("while (");
X if (parse_expression(&token) != END_OF_LINE) {
X parse_error("';' expected");
X pop_context();
X return;
X }
X out_white_space(&token);
X out_str(") {"); /* } for dumb vi */
X
X parse_to_end();
X break;
X
X default:
X parse_error("Illegal DO clause");
X pop_context();
X return;
X }
X break;
X }
X
X /* End of context */
X pop_context();
X}
X
X/*
X * END statement
X * Handles END [ <identifier> ] ;
X */
Xparse_end(first_token)
XTOKEN *first_token;
X{
X TOKEN token;
X int token_class;
X
X out_white_space(first_token); /* { for dumb vi */
X out_char('}');
X
X /* Check for END <procedure name>; */
X token_class = get_token(&token);
X if (token_class == IDENTIFIER) {
X /* END foo; where foo is a procedure */
X out_white_space(&token);
X out_str("/* ");
X out_token_name(&token);
X out_str(" */");
X token_class = get_token(&token);
X }
X
X if (token_class == END_OF_LINE)
X out_white_space(&token);
X else
X parse_error("';' expected");
X}
X
X/*
X * IF statement
X */
Xparse_if(first_token)
XTOKEN *first_token;
X{
X TOKEN token;
X
X out_white_space(first_token);
X out_str("if (");
X
X if ((parse_expression(&token) != RESERVED) ||
X (token.token_type != THEN))
X parse_error("Missing THEN in IF statement");
X else {
X out_pre_line(&token);
X out_char(')');
X out_white_space(&token);
X }
X}
X
X/*
X * THEN statement
X */
Xparse_then()
X{
X parse_error("Illegal use of THEN");
X}
X
X/*
X * ELSE statement
X */
Xparse_else(first_token)
XTOKEN *first_token;
X{
X out_white_space(first_token);
X out_str("else");
X}
X
X/*
X * GOTO statement
X */
Xparse_goto(first_token)
XTOKEN *first_token;
X{
X TOKEN token;
X
X out_white_space(first_token);
X out_str("goto");
X
X if (get_token(&token) != IDENTIFIER)
X parse_error("Illegal GOTO label");
X else {
X out_token(&token);
X check_eol();
X }
X}
X
X/*
X * GO TO statement
X */
Xparse_go(first_token)
XTOKEN *first_token;
X{
X TOKEN token;
X
X if ((get_token(&token) != RESERVED) || (token.token_type != TO))
X parse_error("Illegal GO TO");
X else
X parse_goto(first_token);
X}
X
X/*
X * CALL statement
X * Handles CALL <procedure name> [ ( <parameter list> ) ] ;
X */
Xparse_call(first_token)
XTOKEN *first_token;
X{
X TOKEN token;
X int token_class;
X DECL_MEMBER *id_type;
X DECL_ID *id_id;
X char *new_func, *tmp_out_string;
X char func_name[MAX_TOKEN_LENGTH];
X
X /* Get procedure name */
X token_class = get_token(&token);
X if (token_class != IDENTIFIER) {
X parse_error("Illegal procedure name");
X return;
X }
X
X out_white_space(first_token);
X
X /* Check for function conversion */
X if (check_cvt_id(&token, &cvt_functions[0], &new_func)) {
X out_str(new_func);
X token_class = get_token(&token);
X } else
X
X if (find_symbol(&token, &id_type, &id_id) &&
X (id_type->type->token_type != PROCEDURE)) {
X
X /* Skip white space */
X token.white_space_start = token.white_space_end;
X
X /* Check for call to pointer */
X func_name[0] = '\0';
X tmp_out_string = out_string;
X out_string = func_name;
X token_class = parse_variable(&token, &id_type, &id_id);
X out_string = tmp_out_string;
X
X if ((id_type->type->token_type == POINTER) ||
X#ifdef OFFSET
X (id_type->type->token_type == OFFSET) ||
X#endif
X (id_type->type->token_type == WORD)) {
X /* Yes - use pointer reference */
X out_str("(*");
X out_str(func_name);
X out_char(')');
X } else {
X parse_error("Illegal procedure reference");
X return;
X }
X } else {
X out_token_name(&token);
X token_class = get_token(&token);
X }
X
X /* Get parameter list (if any) */
X if (token_class == LEFT_PAREN) {
X out_token(&token);
X
X do {
X token_class = parse_expression(&token);
X out_token(&token);
X } while (token_class == COMMA);
X
X if (token_class == RIGHT_PAREN)
X /* Get end of line */
X check_eol();
X else
X parse_error("Illegal parameter list seperator");
X } else
X
X if (token_class == END_OF_LINE) {
X /* No parameter list */
X out_str("()");
X out_token(&token);
X } else
X parse_error("';' expected");
X}
X
X/*
X * RETURN statement
X * Handles RETURN [ <expression> ] ;
X */
Xparse_return(first_token)
XTOKEN *first_token;
X{
X TOKEN token;
X int token_class;
X
X out_white_space(first_token);
X out_str("return");
X
X token_class = parse_expression(&token);
X if (token_class != END_OF_LINE)
X parse_error("';' expected");
X else
X out_token(&token);
X}
X
X/*
X * Parse statement starting with an identifier.
X * Possibilities include:
X * Assignment
X * Procedure statement
X */
Xparse_identifier(first_token)
XTOKEN *first_token;
X{
X TOKEN token, next_token;
X TOKEN param_token, attrib_token, type_token;
X int token_class, next_token_class;
X DECL *decl_list, *extra_decl_list;
X PARAM_LIST *param_list, *param_ptr;
X DECL_MEMBER *decl_ptr;
X DECL_ID *decl_id;
X BOOLEAN extern_proc, got_type, interrupt_proc;
X char *tmp_text_ptr;
X
X /* Check for label or procedure */
X tmp_text_ptr = text_ptr;
X token_class = get_token(&token);
X
X if (token_class == LABEL) {
X /* Determine if label or procedure definition */
X next_token_class = get_token(&next_token);
X if ((next_token_class == RESERVED) &&
X (next_token.token_type == PROCEDURE)) {
X/*
X * Procedure - Check for parameter list
X */
X param_list = NULL;
X token_class = get_token(¶m_token);
X if (token_class == LEFT_PAREN) {
X /* Yes - get parameter list */
X get_param_list(¶m_list);
X
X /* Get token after parameter list */
X token_class = get_token(&attrib_token);
X } else
X /* No param list - save as attribute */
X token_copy(¶m_token, &attrib_token);
X
X out_white_space(first_token);
X extern_proc = FALSE;
X interrupt_proc = FALSE;
X
X got_type = (token_class == RESERVED) &&
X (attrib_token.token_type >= BYTE) &&
X (attrib_token.token_type <= SELECTOR);
X if (got_type) {
X/*
X * Process [ <type> ]
X */
X token_copy(&attrib_token, &type_token);
X token_class = get_token(&attrib_token);
X }
X
X while (token_class == RESERVED) {
X if (attrib_token.token_type == INTERRUPT) {
X/*
X * Process [ <interrupt> ]
X */
X interrupt_proc = TRUE;
X token_class = get_token(&attrib_token);
X if (token_class == NUMERIC)
X /* Interrupt number */
X token_class = get_token(&attrib_token);
X } else
X
X/*
X * Process [ EXTERNAL | { [ PUBLIC ] [ REENTRANT ] } ]
X */
X if (attrib_token.token_type == EXTERNAL) {
X out_str("extern");
X out_must_white(&attrib_token);
X extern_proc = TRUE;
X
X token_class = get_token(&attrib_token);
X } else
X
X if ((attrib_token.token_type == PUBLIC) ||
X (attrib_token.token_type == REENTRANT)) {
X do {
X if (attrib_token.token_type == PUBLIC) {
X /* Ignore for now */
X token_class = get_token(&attrib_token);
X } else
X
X if (attrib_token.token_type == REENTRANT) {
X /* Ignore for now */
X token_class = get_token(&attrib_token);
X } else
X break;
X } while (token_class == RESERVED);
X } else
X break;
X }
X
X if (token_class != END_OF_LINE) {
X parse_error("';' expected");
X return;
X }
X
X if (interrupt_proc && !extern_proc)
X parse_warning("INTERRUPT procedure declared");
X
X /* Create declaration for procedure */
X get_element_ptr(&decl_ptr);
X get_var_ptr(&decl_ptr->name_list);
X /* Type = PROCEDURE */
X get_token_ptr(&decl_ptr->type);
X token_copy(&next_token, decl_ptr->type);
X /* Name = procedure name */
X get_token_ptr(&decl_ptr->name_list->name);
X token_copy(first_token, decl_ptr->name_list->name);
X /* Flag if parameter list */
X if (param_list)
X decl_ptr->initialization = DATA;
X /* Add it to context */
X add_to_context(decl_ptr);
X
X if (got_type) {
X /* Output procedure type */
X out_token_name(&type_token);
X out_must_white(&type_token);
X }
X
X /* Output procedure name */
X out_token_name(first_token);
X
X if (extern_proc) {
X out_str("()");
X
X if (param_list)
X /* Parse parameter declarations */
X parse_param_list(param_list, &decl_list,
X &extra_decl_list);
X
X out_char(';');
X /* Eat closing 'END [<proc name>];' */
X token_class = get_token(&token);
X if ((token_class != RESERVED) ||
X (token.token_type != END)) {
X parse_error("END expected");
X return;
X }
X
X out_white_space(&token);
X token_class = get_token(&token);
X if (token_class == IDENTIFIER) {
X token_class = get_token(&token);
X }
X
X if (token_class != END_OF_LINE) {
X parse_error("';' expected");
X }
X
X return;
X } else
X
X if (param_list) {
X out_token(¶m_token);
X /* Output parameter list */
X param_ptr = param_list;
X while (param_ptr) {
X out_token(¶m_ptr->param);
X param_ptr = param_ptr->next_param;
X if (param_ptr)
X out_char(',');
X }
X out_char(')');
X
X /* Parse parameter declarations */
X parse_param_list(param_list, &decl_list,
X &extra_decl_list);
X
X /* Output declarations */
X if (decl_list) {
X out_decl(decl_list);
X /* Add declarations to context */
X add_decl_to_context(decl_list);
X }
X
X out_str("\n{"); /* } for dumb vi */
X
X if (extra_decl_list) {
X out_decl(extra_decl_list);
X /* Add declarations to context */
X add_decl_to_context(extra_decl_list);
X }
X
X /* Discard declarations */
X free_decl(decl_list);
X free_decl(extra_decl_list);
X } else
X /* No parameter list */
X out_str("()\n{"); /* } for dumb vi */
X
X /* Create new context */
X new_context(PROCEDURE, first_token);
X /* Parse statements to END */
X parse_to_end();
X /* Pop procedure context */
X pop_context();
X } else {
X/*
X * Label - add label name
X */
X out_token(first_token);
X /* Add colon */
X out_token(&token);
X
X /* Is this a defined label or a module? */
X if (find_symbol(first_token, &decl_ptr, &decl_id)) {
X if (decl_ptr->type->token_class == LABEL) {
X /* Label - new context */
X new_context(MODULE, first_token);
X parse_statement(&next_token);
X pop_context();
X } else {
X parse_error("Illegal label name");
X return;
X }
X } else
X parse_statement(&next_token);
X }
X return;
X }
X
X /* Assignment statement */
X text_ptr = tmp_text_ptr;
X token_copy(first_token, &token);
X token_class = parse_variable(&token, &decl_ptr, &decl_id);
X
X /* Check for multiple assignments */
X while (token_class == COMMA) {
X /* Print ' =' instead of ',' */
X out_str(" =");
X out_white_space(&token);
X /* Get identifier part of next assignment variable */
X token_class = get_token(&token);
X if (token_class != IDENTIFIER) {
X parse_error("Illegal assignment");
X return;
X }
X
X /* Parse remainder of variable (if any) */
X token_class = parse_variable(&token, &decl_ptr, &decl_id);
X }
X
X if (token_class == OPERATOR) {
X if (token.token_type != EQUAL) {
X parse_error("Illegal use of identifier");
X return;
X }
X
X out_token(&token);
X
X /* Check for POINTER assignment */
X if (decl_ptr->type->token_type == POINTER) {
X /* Yes - cast it */
X out_str(" (");
X out_str(TYPE_POINTER);
X out_str(" *) ");
X }
X
X if (parse_expression(&token) != END_OF_LINE)
X parse_error("';' expected");
X else
X out_token(&token);
X return;
X } else
X
X if (token_class != LABEL) {
X parse_error("Illegal use of identifier");
X return;
X }
X
X}
X
X/*
X * Statement started with ':'
X */
Xparse_label()
X{
X parse_error("Illegal label");
X}
X
X/*
X * End of line (Null statement)
X */
Xparse_eol(first_token)
XTOKEN *first_token;
X{
X out_white_space(first_token);
X out_char(';');
X}
X
X/*
X * ENABLE or DISABLE statement
X */
Xparse_int_ctl(first_token)
XTOKEN *first_token;
X{
X TOKEN token;
X int token_class;
X
X out_token(first_token);
X out_str("()");
X
X token_class = get_token(&token);
X if (token_class != END_OF_LINE) {
X parse_error("';' expected");
X return;
X }
X out_token(&token);
X}
X
X/*
X * OUTPUT, OUTWORD or OUTHWORD statement of form:
X * OUTPUT(port) = expr;
X */
Xparse_outport()
X{
X TOKEN token;
X int token_class;
X
X if (get_token(&token) != LEFT_PAREN) {
X parse_error("'(' expected");
X return;
X }
X out_token(&token);
X
X /* Get port number */
X if (parse_expression(&token) != RIGHT_PAREN) {
X parse_error("'(' expected");
X return;
X }
X out_char(',');
X
X token_class = get_token(&token);
X if ((token_class != OPERATOR) || (token.token_type != EQUAL)) {
X parse_error("'=' expected");
X return;
X }
X
X /* Get expression */
X if (parse_expression(&token) != END_OF_LINE) {
X parse_error("'(' expected");
X return;
X }
X out_char(')');
X out_token(&token);
X}
X
X/*
X * OUTPUT statement
X */
Xparse_output(first_token)
XTOKEN *first_token;
X{
X out_white_space(first_token);
X out_str(FUNC_OUTPUT);
X parse_outport();
X}
X
X/*
X * OUTWORD statement
X */
Xparse_outword(first_token)
XTOKEN *first_token;
X{
X out_white_space(first_token);
X out_str(FUNC_OUTWORD);
X parse_outport();
X}
X
X/*
X * OUTHWORD statement
X */
Xparse_outhword(first_token)
XTOKEN *first_token;
X{
X out_white_space(first_token);
X out_str(FUNC_OUTHWORD);
X parse_outport();
X}
X
X
SHAR_EOF
chmod 0660 parse.c || echo "restore of parse.c fails"
sed 's/^X//' << 'SHAR_EOF' > struct.h &&
X/*
X * Format of a token returned by get_token().
X */
Xtypedef struct TOKEN {
X /* Class of token (see below) */
X int token_class;
X /* Type of token (see below) */
X int token_type;
X /* Converted token name (when applicable) */
X char token_name[MAX_TOKEN_LENGTH];
X /* Pointer to start of token in text_buffer */
X char *token_start;
X /* Number of characters token_start points to */
X int token_length;
X /* Pointer to start of white space in text_buffer */
X char *white_space_start;
X /* Pointer to char after end of white space in text_buffer */
X char *white_space_end;
X#ifdef LINKED_TOKENS
X /* Pointer for use in linked list */
X struct TOKEN *next_token;
X#endif
X} TOKEN;
X
X/*
X * Format of a procedure parameter list
X */
Xtypedef struct PARAM_LIST {
X /* Parameter name */
X TOKEN param;
X /* Pointer for use in linked list */
X struct PARAM_LIST *next_param;
X} PARAM_LIST;
X
X/*
X * Format of a variable in a DECLARE statement.
X */
Xtypedef struct DECL_ID {
X /* Variable name */
X TOKEN *name;
X /* BASED identifier token */
X TOKEN *based_name;
X /* If declared AT in another module */
X BOOLEAN is_ext_at;
X /* Pointer for use in linked list */
X struct DECL_ID *next_var;
X} DECL_ID;
X
X/*
X * Format of an element in a DECLARE statement.
X */
Xtypedef struct DECL_MEMBER {
X /* Linked list of identifiers of designated type */
X DECL_ID *name_list;
X /* LITERALLY string */
X char *literal;
X#ifdef PARSE_LITERALS
X /* Parsed LITERAL token */
X TOKEN *literal_token;
X#endif
X /* Array bound token */
X TOKEN *array_bound;
X /* Type of variable (INTEGER, WORD, LABEL, LITERALLY, etc.) */
X TOKEN *type;
X /* Attributes (NONE, EXTERNAL or PUBLIC) */
X int attributes;
X /* Initialization attribute (NONE, INITIAL or DATA) */
X /* If PROCEDURE, DATA if has parameters */
X int initialization;
X /* Pointer to linked list of structure elements */
X struct DECL_MEMBER *struct_list;
X /* Pointer to parsed AT expression */
X char *at_ptr;
X /* Pointer in text_buffer to start of INITIAL/DATA values */
X char *init_ptr;
X /* Pointer for use in linked list */
X struct DECL_MEMBER *next_member;
X} DECL_MEMBER;
X
X/*
X * Format of a DECLARE statement.
X */
Xtypedef struct DECL {
X /* DECLARE token */
X TOKEN *decl_token;
X /* Linked list of DECL_MEMBERs */
X DECL_MEMBER *decl_list;
X /* Pointer for use in linked list */
X struct DECL *next_decl;
X} DECL;
X
X/*
X * Format of a context element
X */
Xtypedef struct CONTEXT {
X /* Type of context (MODULE, PROCEDURE or DO) */
X int context_type;
X /* Name of module or procedure */
X TOKEN *context_name;
X /* Pointer to linked list of declaration members */
X DECL_MEMBER *decl_head;
X /* Pointer for use in linked list */
X struct CONTEXT *next_context;
X} CONTEXT;
X
X
X/*
X * Format of a PL/M identifier equivalent
X */
Xtypedef struct {
X char *id_name, *new_id;
X} CVT_ID;
X
X
X/*
X * Format of a PL/M reserved word
X */
Xtypedef struct {
X char *name;
X int token;
X} RESERVED_WORD;
X
X/*
X * Format of a PL/M reserved operator
X */
Xtypedef struct {
X char *operator;
X char *cvt_operator;
X int name;
X} RESERVED_OPERATOR;
X
SHAR_EOF
chmod 0660 struct.h || echo "restore of struct.h fails"
sed 's/^X//' << 'SHAR_EOF' > test.c.out &&
X
X
Xextern farp();
X
X
Xslug()
X{
X void *ptr;
X short i;
X short **iptr = (short **) &ptr;
X float j;
X float k;
X float l;
X WORD mqaFOO;
X DWORD fooBAR;
X
X ptr = (void *) &i;
X (**iptr) = 72;
X iptfil();
X setinterrput(0, farp);
X signal(abs(i), (short) (i));
X j = (float) ((short) (i));
X
X} /* slug */
X
X
SHAR_EOF
chmod 0660 test.c.out || echo "restore of test.c.out fails"
sed 's/^X//' << 'SHAR_EOF' > test.plm &&
XFOO: DO;
X
XFARP: PROCEDURE EXTERNAL;
XEND;
X
XSLUG :PROCEDURE;
X DECLARE PTR POINTER;
X DECLARE I INTEGER;
X DECLARE IPTR BASED PTR INTEGER;
X DECLARE J REAL;
X declare k real;
X declare l REAL;
X declare mqaFOO WORD;
X declare FOObar DWORD;
X
X PTR = @I;
X IPTR = 72;
X CALL IPTFIL;
X CALL SET$INTERRPUT(0, FARP);
X CALL SET$INTERRUPT(IABS(I), FIX(I));
X J = FLOAT(FIX(I));
X
XEND SLUG;
X END FOO;
X
SHAR_EOF
chmod 0660 test.plm || echo "restore of test.plm fails"
sed 's/^X//' << 'SHAR_EOF' > tkn_defs.h &&
X/*
X * Reserved word list
X */
XRESERVED_WORD reserved_words[] = {
X
X /* Statements */
X "DECLARE", DECLARE,
X "DO", DO,
X "END", END,
X "IF", IF,
X "THEN", THEN,
X "ELSE", ELSE,
X "GOTO", GOTO,
X "GO", GO,
X "CALL", CALL,
X "RETURN", RETURN,
X "DISABLE", DISABLE,
X "ENABLE", ENABLE,
X "OUTPUT", OUTPUT,
X "OUTWORD", OUTWORD,
X "OUTHWORD", OUTHWORD,
X
X /* Operators */
X "AND", AND,
X "OR", OR,
X "XOR", XOR,
X "NOT", NOT,
X "MOD", MOD,
X "PLUS", PLUS,
X "MINUS", MINUS,
X
X /* DO options */
X "CASE", CASE,
X "WHILE", WHILE,
X "TO", TO,
X "BY", BY,
X
X /* DECLARE types */
X "BYTE", BYTE,
X "WORD", WORD,
X "DWORD", DWORD,
X "INTEGER", INTEGER,
X "REAL", REAL,
X "SELECTOR", SELECTOR,
X "ADDRESS", ADDRESS,
X "STRUCTURE", STRUCTURE,
X "LABEL", LABEL,
X "POINTER", POINTER,
X "BASED", BASED,
X "LITERALLY", LITERALLY,
X
X /* DECLARE options */
X "DATA", DATA,
X "EXTERNAL", EXTERNAL,
X "INITIAL", INITIAL,
X "PUBLIC", PUBLIC,
X "AT", AT,
X
X /* Misc reserved words */
X "PROCEDURE", PROCEDURE,
X "REENTRANT", REENTRANT,
X "INTERRUPT", INTERRUPT,
X
X /* End of list */
X "", END_OF_FILE
X};
X
X
X/*
X * Operator list
X */
XRESERVED_OPERATOR reserved_operators[] = {
X "+", "+", PLUS,
X "-", "-", MINUS,
X "*", "*", TIMES,
X "/", "/", DIVIDE,
X "<>", "!=", NOT_EQUAL,
X "<=", "<=", LESS_EQUAL,
X ">=", ">=", GREATER_EQUAL,
X "<", "<", LESS,
X ">", ">", GREATER,
X "=", "=", EQUAL,
X ":=", "=", EQUATE,
X "@", "&", AT_OP,
X "", "", END_OF_FILE
X};
X
X/*
X * Control directives list
X */
XRESERVED_WORD control_directives[] = {
X#ifdef USE_ALL_CONTROLS
X "CODE", C_CODE,
X "CO", C_CODE,
X "NOCODE", C_NOCODE,
X "NOCO", C_NOCODE,
X "COND", C_COND,
X "NOCOND", C_NOCOND,
X "DEBUG", C_DEBUG,
X "DB", C_DEBUG,
X "NODEBUG", C_NODEBUG,
X "NODB", C_NODEBUG,
X "EJECT", C_EJECT,
X "EJ", C_EJECT,
X#endif
X "IF", C_IF,
X "ELSEIF", C_ELSEIF,
X "ELSE", C_ELSE,
X "ENDIF", C_ENDIF,
X "INCLUDE", C_INCLUDE,
X "IC", C_INCLUDE,
X#ifdef USE_ALL_CONTROLS
X "INTERFACE", C_INTERFACE,
X "ITF", C_INTERFACE,
X "LEFTMARGIN", C_LEFTMARGIN,
X "LM", C_LEFTMARGIN,
X "LIST", C_LIST,
X "LI", C_LIST,
X "NOLIST", C_NOLIST,
X "NOLI", C_NOLIST,
X "OBJECT", C_OBJECT,
X "OJ", C_OBJECT,
X "NOOBJECT", C_NOOBJECT,
X "NOOJ", C_NOOBJECT,
X "OPTIMIZE", C_OPTIMIZE,
X "OT", C_OPTIMIZE,
X "OVERFLOW", C_OVERFLOW,
X "OV", C_OVERFLOW,
X "NOOVERFLOW", C_NOOVERFLOW,
X "NOOV", C_NOOVERFLOW,
X "PAGELENGTH", C_PAGELENGTH,
X "PL", C_PAGELENGTH,
X "PAGEWIDTH", C_PAGEWIDTH,
X "PW", C_PAGEWIDTH,
X "PAGING", C_PAGING,
X "PI", C_PAGING,
X "NOPAGING", C_NOPAGING,
X "NOPI", C_NOPAGING,
X "PRINT", C_PRINT,
X "PR", C_PRINT,
X "NOPRINT", C_NOPRINT,
X "NOPR", C_NOPRINT,
X "RAM", C_RAM,
X "ROM", C_ROM,
X "SAVE", C_SAVE,
X "SA", C_SAVE,
X "RESTORE", C_RESTORE,
X "RS", C_RESTORE,
X#endif
X "SET", C_SET,
X "RESET", C_RESET,
X#ifdef USE_ALL_CONTROLS
X "SMALL", C_SMALL,
X "SM", C_SMALL,
X "COMPACT", C_COMPACT,
X "CP", C_COMPACT,
X "MEDIUM", C_MEDIUM,
X "MD", C_MEDIUM,
X "LARGE", C_LARGE,
X "LA", C_LARGE,
X "SUBTITLE", C_SUBTITLE,
X "ST", C_SUBTITLE,
X "SYMBOLS", C_SYMBOLS,
X "SB", C_SYMBOLS,
X "NOSYMBOLS", C_NOSYMBOLS,
X "NOSB", C_NOSYMBOLS,
X "TITLE", C_TITLE,
X "TT", C_TITLE,
X "TYPE", C_TYPE,
X "TY", C_TYPE,
X "NOTYPE", C_NOTYPE,
X "NOTY", C_NOTYPE,
X "XREF", C_XREF,
X "XR", C_XREF,
X "NOXREF", C_NOXREF,
X "NOXR", C_NOXREF,
X "INTVECTOR", C_INTVECTOR,
X "IV", C_INTVECTOR,
X "NOINTVECTOR", C_NOINTVECTOR,
X "NOIV", C_NOINTVECTOR,
X "MOD86", C_MOD86,
X "MOD186", C_MOD186,
X "WORD16", C_WORD16,
X "W16", C_WORD16,
X "WORD32", C_WORD32,
X "W32", C_WORD32,
X#endif
X /* End of list */
X "", END_OF_FILE
X};
X
SHAR_EOF
chmod 0660 tkn_defs.h || echo "restore of tkn_defs.h fails"
sed 's/^X//' << 'SHAR_EOF' > tkn_ext.h &&
X
X/*
X * Reserved word list
X */
Xextern RESERVED_WORD reserved_words[];
X
X/*
X * Operator list
X */
Xextern RESERVED_OPERATOR reserved_operators[];
X
X/*
X * Control directives list
X */
Xextern RESERVED_WORD control_directives[];
SHAR_EOF
chmod 0660 tkn_ext.h || echo "restore of tkn_ext.h fails"
sed 's/^X//' << 'SHAR_EOF' > token.c &&
X#include <stdio.h>
X#include <string.h>
X#include "misc.h"
X#include "defs.h"
X#include "cvt.h"
X#include "struct.h"
X#include "tokens.h"
X#include "tkn_ext.h"
X
XBOOLEAN parsing_literal;
XTOKEN literal_token, eof_token;
Xchar *lit_text_ptr;
X
Xextern char *text_buffer, *text_ptr;
Xextern int line_count;
Xextern char *line_ptr;
Xextern char current_file_name[];
X
X/*
X * get_token() - Fetch a token from the buffer and return type,
X * pointer and associated white space.
X */
Xget_token(token)
XTOKEN *token;
X{
X RESERVED_WORD *word_ptr;
X RESERVED_OPERATOR *op_ptr;
X char token_ch, last_token;
X char *token_name_ptr;
X char *op_name;
X BOOLEAN got_fraction;
X BOOLEAN cvt_case;
X char id[MAX_TOKEN_LENGTH], *id_ptr;
X DECL_MEMBER *decl_ptr;
X DECL_ID *decl_id;
X int token_class;
X char *cvt_ptr;
X TOKEN *token_ptr;
X
X /* Point to start of white space (if any) */
X token->white_space_start = text_ptr;
X token->white_space_end = text_ptr;
X
X /* Get first character */
X token_ch = *text_ptr++;
X
X /* Check for white space */
X while ((token_ch == SPACE) || (token_ch == TAB) || (token_ch == CR) ||
X (token_ch == LF) || (token_ch == '$') ||
X ((token_ch == '/') && (*text_ptr == '*'))) {
X
X if (token_ch == '$') {
X /* Check for a control directive */
X if ((text_ptr - 1 == text_buffer) ||
X (*(text_ptr - 2) == '\n')) {
X out_pre_white(token);
X parse_control();
X
X /* Reset start of white space */
X token->white_space_start = text_ptr;
X token->white_space_end = text_ptr;
X } else {
X parse_error("Illegal character");
X return ERROR;
X }
X } else {
X
X *(token->white_space_end++) = token_ch;
X
X if (token_ch == LF) {
X /* Increment input line count */
X line_count++;
X /* Point to start of line */
X line_ptr = text_ptr;
X } else
X
X if (token_ch == '/') {
X /* Comment - search to end */
X /* Add '*' of comment */
X token_ch = *(token->white_space_end++) = *text_ptr++;
X
X do {
X last_token = token_ch;
X token_ch = *(token->white_space_end++) = *text_ptr++;
X if (token_ch == LF) {
X /* Increment input line count */
X line_count++;
X /* Point to start of line */
X line_ptr = text_ptr;
X }
X } while ((token_ch != '/') || (last_token != '*'));
X }
X }
X
X token_ch = *text_ptr++;
X }
X
X
X /* Point to start of current token */
X token->token_start = text_ptr - 1;
X /* Point to start of converted token */
X token_name_ptr = token->token_name;
X
X if (is_a_char(token_ch)) {
X /* Process identifier */
X#ifdef CONVERT_CASE
X /* Convert identifiers starting with an */
X /* upper-case character to opposite case. */
X cvt_case = is_a_uc_char(token_ch);
X#else
X cvt_case = FALSE;
X#endif
X while (TRUE) {
X if (is_a_char(token_ch)) {
X if (cvt_case) {
X if (is_a_uc_char(token_ch))
X /* Convert to lower-case character */
X *token_name_ptr++ = token_ch + ' ';
X else
X
X /* Convert to upper-case character */
X *token_name_ptr++ = token_ch - ' ';
X } else
X *token_name_ptr++ = token_ch;
X } else
X
X if (is_a_digit(token_ch))
X *token_name_ptr++ = token_ch;
X else
X
X if (token_ch == '_')
X *token_name_ptr++ = token_ch;
X else
X
X if (token_ch == '$')
X#ifdef CONVERT_DOLLAR
X *token_name_ptr++ = CONVERT_DOLLAR;
X#else
X ;
X#endif
X else
X break;
X
X token_ch = *text_ptr++;
X }
X
X
X /* Mark end of token */
X text_ptr--;
X token->token_length = text_ptr - token->token_start;
X *token_name_ptr = '\0';
X
X /* Get a copy of identifier */
X (void) strcpy(id, token->token_name);
X /* If lower-case, convert to upper case for comparison */
X if (is_a_lc_char(*id)) {
X for (id_ptr = id; *id_ptr; id_ptr++)
X if (is_a_lc_char(*id_ptr))
X *id_ptr -= ' ';
X }
X
X /* Check for reserved word */
X for (word_ptr = &reserved_words[0]; word_ptr->token != END_OF_FILE;
X word_ptr++)
X {
X if (!strcmp(word_ptr->name, id)) {
X
X token->token_type = word_ptr->token;
X
X /* Check for reserved operator */
X switch (token->token_type) {
X
X case AND :
X op_name = AND_OP;
X break;
X
X case OR :
X op_name = OR_OP;
X break;
X
X case NOT :
X op_name = NOT_OP;
X break;
X
X case XOR :
X op_name = "^";
X break;
X
X case MOD :
X op_name = "%";
X break;
X
X case PLUS :
X parse_error("Cannot convert PLUS operator");
X token->token_class = token->token_type = ERROR;
X return ERROR;
X
X case MINUS :
X parse_error("Cannot convert MINUS operator");
X token->token_class = token->token_type = ERROR;
X return ERROR;
X
X default :
X /* Must not be an operator! */
X token->token_class = RESERVED;
X return RESERVED;
X }
X
X /* Switch to appropriate operator */
X (void) strcpy(token->token_name, op_name);
X token->token_class = OPERATOR;
X return OPERATOR;
X }
X }
X
X /* Not a reserved word - must be an identifier */
X token->token_class = token->token_type = IDENTIFIER;
X
X /* Check for a literal */
X if (!parsing_literal && find_symbol(token, &decl_ptr, &decl_id) &&
X (decl_ptr->type->token_type == LITERALLY)) {
X#ifdef CONVERT_CASE
X /* Convert case of literal */
X for (cvt_ptr = token->token_name; *cvt_ptr;
X cvt_ptr++) {
X if (is_a_uc_char(*cvt_ptr))
X *cvt_ptr += 32;
X else
X if (is_a_lc_char(*cvt_ptr))
X *cvt_ptr -= 32;
X }
X#endif
X#ifdef PARSE_LITERALS
X /* Yes - Has literal been parsed? */
X if (decl_ptr->literal_token) {
X /* Yes - return parsed literal token */
X /* with token_name set to literal name */
X token_ptr = decl_ptr->literal_token;
X token->token_class = token_ptr->token_class;
X token->token_type = token_ptr->token_type;
X return token->token_class;
X }
X#endif
X /* Is literal a single token? */
X lit_text_ptr = text_ptr;
X text_ptr = decl_ptr->literal;
X token_class = get_token(&literal_token);
X if (get_token(&eof_token) == END_OF_FILE) {
X /* Yes - return single token with */
X /* token_name set to literal name */
X token->token_class = token_class;
X token->token_type = literal_token.token_type;
X text_ptr = lit_text_ptr;
X parsing_literal = FALSE;
X return token->token_class;
X }
X
X /* No - parse complex literal and replace */
X /* Use of literal declaration */
X parsing_literal = TRUE;
X text_ptr = lit_text_ptr;
X parse_warning("Literal expanded");
X text_ptr = decl_ptr->literal;
X return get_token(token);
X }
X
X return IDENTIFIER;
X } else
X
X if (is_a_digit(token_ch)) {
X /* Process number */
X /* Flag not a floating point number */
X got_fraction = FALSE;
X
X while (TRUE) {
X if (is_a_digit(token_ch))
X *token_name_ptr++ = token_ch;
X else
X
X if (token_ch == '.') {
X got_fraction = TRUE;
X *token_name_ptr++ = token_ch;
X } else
X
X if ((token_ch == 'E') && got_fraction) {
X /* Process exponent */
X *token_name_ptr++ = token_ch;
X /* Signed exponent? */
X if ((*text_ptr != '+') && (*text_ptr != '-')) {
X /* No - default to + exponent */
X *token_name_ptr++ = '+';
X } else {
X /* Yes - add sign */
X token_ch = *text_ptr++;
X *token_name_ptr++ = token_ch;
X }
X } else
X
X /* Assume it's a hex char or constant designator */
X if (is_a_char(token_ch))
X *token_name_ptr++ = token_ch;
X else
X
X if (token_ch != '$')
X break;
X
X token_ch = *text_ptr++;
X }
X
X /* Point to last character in constant */
X token_name_ptr--;
X token_ch = *token_name_ptr;
X
X if (got_fraction) {
X /* Floating point - add suffix */
X *++token_name_ptr = 'F';
X /* Mark end of token */
X *++token_name_ptr = '\0';
X } else
X
X if (token_ch == 'B') {
X parse_error("Binary constant");
X token->token_class = token->token_type = ERROR;
X return ERROR;
X } else
X
X if ((token_ch == 'O') || (token_ch == 'Q')) {
X /* Octal constant */
X /* Mark end of token */
X *token_name_ptr++ = '\0';
X /* Move constant up 1 character */
X while (token_name_ptr != token->token_name) {
X *token_name_ptr = *(token_name_ptr - 1);
X token_name_ptr--;
X }
X
X /* Make a C octal constant */
X *token_name_ptr = '0';
X } else
X
X if (token_ch == 'H') {
X /* Hex constant */
X /* Mark end of token */
X *token_name_ptr++ = '\0';
X token_name_ptr++;
X /* Move constant up 2 characters */
X while (token_name_ptr != (token->token_name + 1)) {
X *token_name_ptr = *(token_name_ptr - 2);
X token_name_ptr--;
X }
X
X /* Make a C hex constant */
X *token_name_ptr-- = 'x';
X *token_name_ptr = '0';
X } else
X
X if (token_ch == 'D')
X /* Decimal constant - ignore 'D' */
X *token_name_ptr = '\0';
X else
X /* Regular constant */
X *++token_name_ptr = '\0';
X
X /* Mark end of token */
X text_ptr--;
X token->token_length = text_ptr - token->token_start;
X
X token->token_class = token->token_type = NUMERIC;
X return NUMERIC;
X } else {
X
X /* Check for operator */
X for (op_ptr = &reserved_operators[0]; op_ptr->name != END_OF_FILE;
X op_ptr++) {
X token->token_length = strlen(op_ptr->operator);
X if (!strncmp(text_ptr - 1, op_ptr->operator,
X token->token_length)) {
X /* Found operator */
X /* Save converted type */
X (void) strcpy(token->token_name, op_ptr->cvt_operator);
X token->token_type = op_ptr->name;
X /* Point past operator */
X text_ptr += token->token_length - 1;
X
X token->token_class = OPERATOR;
X return OPERATOR;
X }
X }
X
X /* Assume single character token */
X *token_name_ptr++ = token_ch;
X *token_name_ptr = '\0';
X /* Mark end of token so far */
X token->token_length = 1;
X
X
X switch (token_ch) {
X
X case ';' :
X token->token_class = token->token_type = END_OF_LINE;
X return END_OF_LINE;
X
X case ':' :
X token->token_class = token->token_type = LABEL;
X return LABEL;
X
X case ',' :
X token->token_class = token->token_type = COMMA;
X return COMMA;
X
X case '.' :
X token->token_class = token->token_type = PERIOD;
X return PERIOD;
X
X case '(' :
X token->token_class = token->token_type = LEFT_PAREN;
X return LEFT_PAREN;
X
X case ')' :
X token->token_class = token->token_type = RIGHT_PAREN;
X return RIGHT_PAREN;
X
X case '\'' :
X /* String constant */
X token_name_ptr--;
X while (1) {
X if (*text_ptr == '\'') {
X if ((*(text_ptr + 1) == '\''))
X text_ptr++;
X else
X break;
X }
X *token_name_ptr++ = *text_ptr++;
X }
X
X text_ptr++;
X *token_name_ptr++ = '\0';
X token->token_length = strlen(token->token_name);
X
X token->token_class = token->token_type = STRING;
X return STRING;
X
X case 0:
X if (parsing_literal) {
X /* Done parsing literal - */
X /* Switch back to text_ptr */
X parsing_literal = FALSE;
X text_ptr = lit_text_ptr;
X return get_token(token);
X }
X token->token_class = token->token_type = END_OF_FILE;
X return END_OF_FILE;
X
X default:
X parse_error("Illegal character");
X /* Eat the evidence */
X token->token_name[0] = '\0';
X token->token_class = token->token_type = ERROR;
X return ERROR;
X }
X }
X}
X
X/*
X * Copy source token to destination token
X */
Xtoken_copy(src, dest)
XTOKEN *src, *dest;
X{
X dest->token_class = src->token_class;
X dest->token_type = src->token_type;
X (void) strcpy(dest->token_name, src->token_name);
X dest->token_start = src->token_start;
X dest->token_length = src->token_length;
X dest->white_space_start = src->white_space_start;
X dest->white_space_end = src->white_space_end;
X}
X
SHAR_EOF
chmod 0660 token.c || echo "restore of token.c fails"
sed 's/^X//' << 'SHAR_EOF' > tokens.h &&
X/**************************
X * Token classes
X *************************/
X#define END_OF_FILE 0
X#define RESERVED 1
X#define IDENTIFIER 2
X#define NUMERIC 3
X#define OPERATOR 4
X#define STRING 5
X#define LABEL 6
X#define END_OF_LINE 7
X#define COMMA 8
X#define PERIOD 9
X#define LEFT_PAREN 10
X#define RIGHT_PAREN 11
X#define SUBSCRIPT 12
X#define MODULE 13
X#define ERROR 19
X
X
X/**************************
X * Token types
X *************************/
X/*
X * Operators
X */
X#define PLUS 20 /* + */
X#define MINUS 21 /* - */
X#define TIMES 22 /* * */
X#define DIVIDE 23 /* / */
X#define NOT_EQUAL 24 /* <> */
X#define LESS_EQUAL 25 /* <= */
X#define GREATER_EQUAL 26 /* >= */
X#define LESS 27 /* < */
X#define GREATER 28 /* > */
X#define EQUAL 29 /* = */
X#define EQUATE 30 /* := */
X#define COLON 31 /* : */
X#define AT_OP 32 /* @ */
X
X/*
X * Reserved word values
X */
X /* Statements */
X#define DECLARE 40
X#define DO 41
X#define END 42
X#define IF 43
X#define THEN 44
X#define ELSE 45
X#define GOTO 46
X#define GO 47
X#define CALL 48
X#define RETURN 49
X#define DISABLE 50
X#define ENABLE 51
X#define OUTPUT 52
X#define OUTWORD 53
X#define OUTHWORD 54
X
X /* Operators */
X#define AND 60
X#define OR 61
X#define XOR 62
X#define NOT 63
X#define MOD 64
X
X /* DO options */
X#define CASE 70
X#define WHILE 71
X#define TO 72
X#define BY 73
X
X /* DECLARE types */
X#define BYTE 80
X#define WORD 81
X#define DWORD 82
X#define INTEGER 83
X#define REAL 84
X#define ADDRESS 85
X#define SELECTOR 86
X#define POINTER 87
X#define STRUCTURE 88
X
X /* DECLARE options */
X#define BASED 90
X#define LITERALLY 91
X#define DATA 92
X#define EXTERNAL 93
X#define INITIAL 94
X#define PUBLIC 95
X#define AT 96
X
X /* Misc reserved words */
X#define PROCEDURE 101
X#define REENTRANT 102
X#define INTERRUPT 103
X
X /* Control Directives */
X#define C_CODE 200
X#define C_NOCODE 201
X#define C_COND 202
X#define C_NOCOND 203
X#define C_DEBUG 204
X#define C_NODEBUG 205
X#define C_EJECT 206
X#define C_IF 207
X#define C_ELSEIF 208
X#define C_ELSE 209
X#define C_ENDIF 210
X#define C_INCLUDE 211
X#define C_INTERFACE 212
X#define C_LEFTMARGIN 213
X#define C_LIST 214
X#define C_NOLIST 215
X#define C_OBJECT 216
X#define C_NOOBJECT 217
X#define C_OPTIMIZE 218
X#define C_OVERFLOW 219
X#define C_NOOVERFLOW 220
X#define C_PAGELENGTH 221
X#define C_PAGEWIDTH 222
X#define C_PAGING 223
X#define C_NOPAGING 224
X#define C_PRINT 225
X#define C_NOPRINT 226
X#define C_RAM 227
X#define C_ROM 228
X#define C_SAVE 229
X#define C_RESTORE 230
X#define C_SET 231
X#define C_RESET 232
X#define C_SMALL 233
X#define C_COMPACT 234
X#define C_MEDIUM 235
X#define C_LARGE 236
X#define C_SUBTITLE 237
X#define C_SYMBOLS 238
X#define C_NOSYMBOLS 239
X#define C_TITLE 240
X#define C_TYPE 241
X#define C_NOTYPE 242
X#define C_XREF 243
X#define C_NOXREF 244
X#define C_INTVECTOR 245
X#define C_NOINTVECTOR 246
X#define C_MOD86 247
X#define C_MOD186 248
X#define C_WORD16 249
X#define C_WORD32 250
X
SHAR_EOF
chmod 0660 tokens.h || echo "restore of tokens.h fails"
sed 's/^X//' << 'SHAR_EOF' > typedefs.c &&
Xtypedef unsigned char BYTE;
Xtypedef unsigned short WORD;
Xtypedef unsigned int DWORD;
Xtypedef short INTEGER;
Xtypedef float REAL;
X
SHAR_EOF
chmod 0660 typedefs.c || echo "restore of typedefs.c fails"
sed 's/^X//' << 'SHAR_EOF' > version.c &&
Xchar version[] = "Version 1.02 (Alpha)";
SHAR_EOF
chmod 0644 version.c || echo "restore of version.c fails"
rm -f s2_seq_.tmp
echo "You have unpacked the last part"
exit 0