%{ #include #include // parser stuff extern yylex(); extern yyerror(char *s); extern int endsrc; extern int lineCount; extern int formal_pars; extern int lineCount; extern char *idtable[]; extern int block_count; extern int memaddr; extern case_flip(int p); int itmp; /* just a temporary variable */ // assembler stuff extern int justz; extern void storesyl(int p1); extern void store2syl(int p1); /* sstore 2-syllable instruction p1 */ extern void qnum(int q); /* confirms that q is a valid Q-store number */ extern int twosylqx(int instr, int q1, int q2); /* evaluate two syllable Q-store instruction with 2 Q-store numbers in it or one Q-store number and a specified lower byte */ extern void store3syl(int instr, int addr); /* takes the output from data loc and embeds in the instruction */ extern void nonums(int i1); // process instructions with no parameters extern void onenum(int i1, int n1); extern int tablocate(unsigned char *s); /* locate this character string as though it were an identifier */ /* fancy characters in instruction mnemonics need unsigned char */ extern int idtablocate(char *s, int id); /* locate the character string formed by concatenating s and id as though it were an identifier */ extern int idtablocate2(char *s, int id1, int id2, int id3); /* joins together all four components like previous routine, id3 can be -ve to indicate null string */ extern int jumptest(int idj, int idz, char *syn); // handles synonyms such as J>=Z -- JGEZ // idj must be "J" and idz "Z" for the instruction to be valid // syn is the all-letters mnemonic that will be used for table lookup extern int codeloc(int lab); // get absolute address of Usercode label extern void startnewword(int n); // round address to multiple of n words void twonums(int i1, int n1, int n2); void justaddr(int i1, int a1); void numaddr(int i1, int n1, int a1); extern void mpmi(int i1, int pm, int i2, int n); /* Only valid for instructions of the form M+Iq, M-Iq */ extern void setinc(int i1, int n1, int n2); // process Iq=+1, etc extern void qval(int n1,int n2,int n3); // process Q-store format word // Compiler stuff (generates C) // we are assuming the int and char* are the same size (not just at the moment) // Type codes // REAL = 2, INTEGER = 1, VOID = 0 // FN = 8, ARRAY = 16, MAP = 24 // NAME = 32 for formal parameter by reference extern void newiden(int i, int l); // creates a new identifier record chained onto idlist (or auxidelist if l == 1) extern void startscope(int t, int id, int pars); // starts scope routine result type is y, identifier is id and params are alredy generated at pars extern void start_pars(); // starts the evaluation of a list of actual parameters extern void end_pars(); // ends the evaluation of a list of actual parameters extern int act_param(int s, int p); // check an actual param for %NAME and insert & if so extern void endscope(); // end of routine or func declaration, or anon block extern void settype(int t); // set type of variables, and output declarations extern int decidlist(char *sep, char *term); // take the identifiers in the idlist into the local scope // and store away declaration code // sep is the separator between declarations, and term the terminator for the last one extern void kdf9code(int addr); // generates code to enter m/c code section at address addr (byte address) extern void statreset(int p); // reset ready for compiling a new statement ??? extern int veval(int id, int pars, int term); // evaluate IDENTIFIER act_pars extern int exprstr(char *s); // create string as stored code extern int exprid(int id); // create identifier as stored code -- unnecessary ??? extern int exprint(int i); // create integer as stored code extern int exprch(int i); // single character as stored code extern int cat2(int s1, int s2); // join 2 strings extern int cat3(int s1, int s2, int s3); // join 3 strings extern int cat4(int s1, int s2, int s3, int s4); // join 4 strings extern int double_condition(int e1, int t1, int ee, int t2, int e2); // double condition like 0 < x < 9 extern void emit(int s); // actually output some C-code extern void fetchvar(int v, int instr); // machine code fetch of AA variable - or its address extern void storevar(int v); // machine code store of AA variable extern int goto_switch(int id, int sub); // goto a switch element extern int goto_label(int lab); // goto an integer label // A label with a P appended, has 32768 added to the integer extern void set_label(int code, int lab); // place an integer label extern void set_switch_label(int lab, int sub); // place a switch element label extern void cond_stat(int iforun, int cond, int stat); // compile conditional statement extern void array_bounds_cc(int lwb, int upb); // store away constant array bound on current identifiers in idlist extern void start_loop(int v, int p1, int e1, int p2, int e2, int p3, int e3); // start a loop using control variable v // p1 is the possible sign and e1 the first expression, etc extern void end_loop(); // %REPEAT matches %CYCLE extern void newline(); // append newline to most recently generated string extern int var_count; extern int caption(int i); // %CAPTION output extern int literal(int i); // diagnostic facility for putting in a line of C %} /* Atlas Autocode ABC Phrase Structure */ /* All Atlas Autocode statements belong to the class P as defined */ /* The built in phrases are */ /* Only the following unimplemented features are actually needed !!! Condition too difficult !!! CYCLE an array element not implemented !!! M CODE not implemented !!! **@v access address !!! **'v what is this? */ /* -> P */ %token P_NAME /* P */ %token P_SEPARATOR /* P */ %token P_CONST /* P */ /* Those above are not used */ %token P_COMMENT_TEXT /* P */ %token P_CAPTION_TEXT /* P */ %token P_UNSIGNED_INTEGER /* P */ /* Tokens corresponding to % words in AA */ %token ADDR %token AND %token ARRAY %token BEGIN %token BOUND %token CAPTION %token CHECKS %token CODE %token COMMENT %token COMPILE %token CYCLE %token END %token FAULT %token FN %token IF %token IGNORE %token INTEGER %token LIST %token LITERAL %token M %token MAP %token MONITOR %token NAME %token OF %token OR %token PERM %token PROGRAM %token QUERIES %token REAL %token REPEAT %token RESULT %token RETURN %token ROUTINE %token SPEC %token STOP %token SWITCH %token THEN %token UNLESS /* Tokens concocted by DH */ %token IDENTIFIER %token NEWLINE %% program : statements ; statements : single_statement | statements single_statement ; flip_case1z : { case_flip(2); $$ = memaddr; var_count = 0; } /* attribute is address of start of sequence */ ; flip_case1 : { case_flip(1); } /* this sets a flag which primes yylex() ... */ ; /* ... to have only letters in identifiers for Usercode */ flip_case0 : { case_flip(0); } ; /* This has to be before single_statement for correct resolution of the reduce/reduce conflict on '*' */ machine_code_sequence : flip_case1z '*' machine_instrn flip_case0 separator | machine_code_sequence flip_case1 '*' machine_instrn flip_case0 separator | machine_code_sequence COMMENT NEWLINE | machine_code_sequence P_UNSIGNED_INTEGER ':' { set_label(1, $2); } | machine_code_sequence NEWLINE /* in case of ; at end of line */ /* | machine_code_sequence '-' '>' P_UNSIGNED_INTEGER { onenum(tablocate("J"), $4); } bad idea?? */ /* | machine_code_sequence '-' '>' IDENTIFIER '(' plus_p exprn ')' { printf("Bad news !!!!\n"); } bad idea?? */ ; single_statement : unconditional_instrn separator { emit($1); statreset(1); } /* value 0 is always the null string */ | if_or_unless condition THEN unconditional_instrn separator { cond_stat($1, $2, $4); statreset(1); } | unconditional_instrn if_or_unless condition separator { cond_stat($2, $3, $1); statreset(1); } /* | CYCLE IDENTIFIER actual_parameters_p '=' plus_p exprn ',' plus_p exprn ',' plus_p exprn separator only need next line */ | CYCLE IDENTIFIER '=' plus_p exprn ',' plus_p exprn ',' plus_p exprn separator { start_loop($2, $4, $5, $7, $8, $10, $11); statreset(1); } | REPEAT separator { end_loop(); statreset(1); } | type name_list separator { settype($1); emit(decidlist(";", ";\n")); statreset(1); } | type_p ARRAY array_list separator { settype($1 + 16); emit(decidlist(";", ";\n")); statreset(1); } | SWITCH switch_list separator { settype(64); decidlist(";", ";\n"); statreset(1); } /* no code output */ | rt SPEC IDENTIFIER formal_parameter_defn_p separator { startscope($1 + 256, $3, $4); statreset(1); } | SPEC IDENTIFIER formal_parameter_defn_p separator { startscope(256, $2, $3); statreset(1); } | rt IDENTIFIER formal_parameter_defn_p separator { startscope($1, $2, $3); statreset(1); } | BEGIN separator { startscope(-1, -1, -1); statreset(1); } | END separator { endscope(); statreset(1); } | P_UNSIGNED_INTEGER ':' { set_label(0, $1); statreset(0); } /* | IDENTIFIER '(' plus_p constant ')' ':' with luck we will not need this -- but we do */ /* so liberalise the grammar, and sort it out semantically */ | IDENTIFIER actual_parameters ':' { set_switch_label($1, $2); statreset(0); } | COMPILE QUERIES separator { printf("!!! QUERIES not implemented\n"); } | IGNORE QUERIES separator { printf("!!! QUERIES not implemented\n"); } | COMMENT /* original was COMMENT P_COMMENT_TEXT separator */ | '!' P_COMMENT_TEXT separator /* not currently possible because of yylex() */ | LIST separator { printf("!!! LIST not implemented\n"); } | END OF LIST separator { printf("!!! LIST not implemented\n"); } | M CODE separator { printf("!!! M CODE not implemented\n"); } | END OF M CODE separator { printf("!!! M CODE not implemented\n"); } | machine_code_sequence { kdf9code($1); statreset(1); } | COMPILE ARRAY BOUND CHECKS separator { printf("!!! ARRAY BOUND CHECKS not implemented\n"); } | IGNORE ARRAY BOUND CHECKS separator { printf("!!! ARRAY BOUND CHECKS not implemented\n"); } | END OF PERM separator { printf("\n// End of PERM -- block count = %d\n\n", block_count); } | FAULT fault_list separator { printf("!!! FAULT list not implemented\n"); } | separator | END OF PROGRAM NEWLINE { endsrc = 1; printf("// Reached end of program\n"); statreset(1); } ; unconditional_instrn : IDENTIFIER actual_parameters '=' plus_p exprn query_p { $$ = cat4(veval($1, $2, '='), $5, $6, exprch(';')); newline(); } | IDENTIFIER actual_parameters { $$ = veval($1, $2, ';'); newline(); } | '-' '>' P_UNSIGNED_INTEGER { $$ = goto_label($3); } | '-' '>' IDENTIFIER '(' plus_p exprn ')' { $$ = goto_switch($3, cat2($5, $6)); } /* | CAPTION P_CAPTION_TEXT -- replaced by rule below */ | CAPTION /* value of token is pointer to string */ { $$ = caption($1); } | LITERAL /* value of token is pointer to string */ { $$ = literal($1); } | RETURN { $$ = exprstr(" return;\n"); } | RESULT '=' plus_p exprn { $$ = cat4(exprstr(" return "), $3, $4, exprch(';')); } | STOP { $$ = exprstr(" exit(0);\n"); } | MONITOR STOP { printf("MONITOR STOP not implemented\n"); } | MONITOR P_UNSIGNED_INTEGER { printf("MONITOR integer not implemented\n"); } ; plus_p : '+' { $$ = exprch('+'); } | '-' { $$ = exprch('-'); } | { $$ = 0; } ; exprn : operand rest_of_exprn { $$ = cat2($1, $2); } | '|' operand '|' { $$ = cat3(exprstr("abs("), $2, exprch(')')); } /* introduced by DH -- there is one occurrence of !N! which DH changed to |N| */ ; rest_of_exprn : operator operand rest_of_exprn { $$ = cat3(exprch($1), $2, $3); } | { $$ = 0; } ; operand : IDENTIFIER actual_parameters_p { $$ = veval($1, $2, 0); } | constant { $$ = exprint($1); } | '(' plus_p exprn ')' { $$ = cat4(exprch('('), $2, $3, exprch(')')); } /* | plus_p exprn this has to be bad news - causes lots of conflicts */ /* | It is not clear under what cireumstances operand can be null */ ; operator : '+' { $$ = '+'; } | '-' { $$ = '-'; } | '*' { $$ = '*'; } | '/' { $$ = '/'; } /* seems not to be in the original syntax */ | '*' '*' { $$ = '^'; } | { $$ = '*'; } /* juxtaposition does multiply */ ; ap_start : '(' { start_pars(); } ; act_param : plus_p exprn { $$ = act_param($1, $2); } ; actual_parameters_p : ap_start list_of_actual_parameters ')' { $$ = $2; end_pars(); } /* TEMP !!! */ | { $$ = -1; } ; list_of_actual_parameters : list_of_actual_parameters ',' act_param { $$ = cat3($1, exprch(','), $3); } | act_param | ; query_p : '?' { $$ = expstr("???"); } | { $$ = 0; } ; comma_p : ',' | ; if_or_unless : IF { $$ = 0; } | UNLESS { $$ = 1; } ; type : INTEGER { $$ = 1; } | REAL { $$ = 2; } ; type_p : INTEGER { $$ = 1; } | REAL { $$ = 2; } | { $$ = 0; } ; /* name_list : IDENTIFIER rest_of_name_list { newiden($1, 0); } old version gave wrong ordering */ name_list : IDENTIFIER { newiden($1, 0); } | name_list ',' IDENTIFIER { newiden($3, 0); } ; array_list : name_list '(' bound_pair_list ')' rest_of_array_list ; rest_of_array_list : ',' array_list | ; bound_pair_list : plus_p exprn ':' plus_p exprn rest_of_bp_list { printf("!!! Lower bound not constant\n"); } | plus_p P_UNSIGNED_INTEGER ':' plus_p exprn rest_of_bp_list { array_bounds_cv($2, cat2($4, $5)); } | plus_p P_UNSIGNED_INTEGER ':' P_UNSIGNED_INTEGER { if ($1 == 0 ) array_bounds_cc($2, $4); else array_bounds_cc(-$2, $4); } ; rest_of_bp_list : ',' bound_pair_list { printf("!!! multi-dimensional array not implemented - line %d\n", lineCount); } /* do not need to do this */ | ; switch_bounds : P_UNSIGNED_INTEGER ':' P_UNSIGNED_INTEGER { array_bounds_cc($1, $3); } | '-' P_UNSIGNED_INTEGER ':' P_UNSIGNED_INTEGER { array_bounds_cc(-$2, $4); } | plus_p constant ':' plus_p constant { printf("!!! Complex switch not implemented\n"); } ; switch_list : name_list '(' switch_bounds ')' rest_of_switch_list ; rest_of_switch_list : ',' switch_list | ; rt : ROUTINE { $$ = 8; } | REAL FN { $$ = 10; } | INTEGER FN { $$ = 9; } | REAL MAP { $$ = 26; } | INTEGER MAP { $$ = 25; } ; fp_start : '(' { formal_pars = 1; } /* flags yylex() to recognise ",%" as ';' */ formal_parameter_defn_p : fp_start fp_list ')' { formal_pars = 0; $$ = 1;} | { $$ = 0; } ; fp_list_part : fp_delimiter name_list { settype($1); } ; fp_list : fp_list_part rest_of_fp_list ; rest_of_fp_list : ';' fp_list /* semicolon introduced by DH to remove ambiguity, introduced by yylex() */ | ; fp_delimiter : comma_p rt { $$ = $2; } | comma_p type NAME { $$ = $2 + 32; } | comma_p type { $$ = $2; } | comma_p type_p ARRAY NAME { $$ = $2 + 16 + 32; } | ADDR { $$ = 128; } /* temp !!! */ ; condition : simple_cond AND and_cond { $$ = cat3($1, exprstr(" && "), $3); } | simple_cond OR or_cond { $$ = cat3($1, exprstr(" || "), $3); } | simple_cond { $$ = $1; } ; and_cond : simple_cond rest_of_and_cond { $$ = cat2($1, $2); } ; rest_of_and_cond : AND and_cond { $$ = cat2(exprstr(" && "), $2); } | { $$ = 0; } ; or_cond : simple_cond rest_of_or_cond { $$ = cat2($1, $2); } ; rest_of_or_cond : OR or_cond { $$ = cat2(exprstr(" || "), $2); } | { $$ = 0; } ; simple_cond : plus_p exprn comparator plus_p exprn { $$ = cat3(cat2($1, $2), $3, cat2($4, $5)); } /*| plus_p exprn comparator plus_p exprn rest_of_simple_cond replaced by production below */ | plus_p exprn comparator plus_p exprn comparator plus_p exprn { $$ = double_condition(cat2($1, $2), $3, cat2($4, $5), $6, cat2($7, $8)); } | '(' or_cond ')' { $$ = cat3(exprch('('), $2, exprch(')')); } /* added by DH, seems to be part of the language */ ; rest_of_simple_cond : comparator plus_p exprn /* plus_p was originally <+'> */ { $$ = cat2($1, $2); } /* | null option subsumed into the above production */ ; comparator : '=' { $$ = exprstr("=="); } | '#' { $$ = exprstr("!="); } | '<' '=' { $$ = exprstr("<="); } | '<' { $$ = exprch('<'); } | '>' '=' { $$ = exprstr(">="); } | '>' { $$ = exprch('>'); } ; fault_list : P_UNSIGNED_INTEGER rest_of_N_list '-' '>' P_UNSIGNED_INTEGER rest_of_fault_list ; rest_of_N_list : ',' P_UNSIGNED_INTEGER | ; rest_of_fault_list : ',' fault_list | ; /* (P machine_instrn See KDF9 programming manual) */ /* productions generated by DH */ separator : ';' | NEWLINE ; machine_instrn : IDENTIFIER ':' /* no idea what this means -- some sort of label */ { printf("Funny * %s :\n", idtable[$1]); } | IDENTIFIER P_UNSIGNED_INTEGER ':' /* e.g. SET 33P: */ { onenum($1, $2); } /* TEMP !!! */ | IDENTIFIER IDENTIFIER P_UNSIGNED_INTEGER /* e.g. SET B33 */ { onenum(idtablocate(idtable[$1], $2), $3); } | flip_case0 '*' '`' IDENTIFIER actual_parameters /* no idea what this means -- why is it different from the next one */ { fetchvar(veval($4, $5, 0), 0305); printf("Address access\n"); } | flip_case0 '*' '@' IDENTIFIER actual_parameters /* pseudo KDF9 instruction to transfer address of C variable to N1 */ { fetchvar(veval($4, $5, 0), 0305); printf("Address access @\n"); } | flip_case0 '*' operand /* fetch variable, etc */ { fetchvar($3, 0306); } /* pseudo KDF9 instruction to transfer value of C variable to N1 */ | flip_case0 '*' '=' IDENTIFIER actual_parameters /* store in variable -- possibly array element */ { storevar(veval($4, $5, 0)); } | IDENTIFIER /* e.g. DUP REV PERM */ { nonums($1); } | '=' IDENTIFIER /* only =TR =LINK */ { nonums(idtablocate("=", $2)); } | IDENTIFIER P_UNSIGNED_INTEGER /* e.g. SET 3 Q12 E456 */{ onenum($1, $2); } | '=' IDENTIFIER P_UNSIGNED_INTEGER /* e.g. =Q12 =E456 */ { onenum(idtablocate("=", $2), $3); } | '=' '+' IDENTIFIER P_UNSIGNED_INTEGER /* e.g. =+Q13 */ { onenum(idtablocate("=+", $3), $4); } | IDENTIFIER P_UNSIGNED_INTEGER IDENTIFIER P_UNSIGNED_INTEGER { twonums(idtablocate(idtable[$1], $3), $2, $4); } /* e.g. M8M9 CI7TOQ11 */ | '=' IDENTIFIER P_UNSIGNED_INTEGER IDENTIFIER P_UNSIGNED_INTEGER { twonums(idtablocate2("=", $2, $4, -1), $3, $5); } /* e.g. =M8M9 */ | IDENTIFIER P_UNSIGNED_INTEGER IDENTIFIER P_UNSIGNED_INTEGER IDENTIFIER { twonums(idtablocate2(idtable[$1], $3, $5, -1), $2, $4); } /* e.g. M8M9QHN J23C14NZ */ | '=' IDENTIFIER P_UNSIGNED_INTEGER IDENTIFIER P_UNSIGNED_INTEGER IDENTIFIER { twonums(idtablocate2("=", $2, $4, $6), $3, $5); } /* e.g. =M8M9Q */ | IDENTIFIER P_UNSIGNED_INTEGER IDENTIFIER IDENTIFIER P_UNSIGNED_INTEGER { twonums(idtablocate2(idtable[$1], $3, $4, -1), $2, $5); } /* e.g. CI7 TO Q11 */ | IDENTIFIER '-' P_UNSIGNED_INTEGER /* e.g. SHL-8 */ { onenum($1, -$3); } | IDENTIFIER '+' P_UNSIGNED_INTEGER /* e.g. SHL+8 SET+7 */ { onenum($1, $3); } | IDENTIFIER P_UNSIGNED_INTEGER '=' IDENTIFIER /* e.g. J44=Z */ { justaddr(jumptest($1, $4, "JEQZ"), codeloc($2)); } | IDENTIFIER P_UNSIGNED_INTEGER '>' IDENTIFIER /* e.g. J44>Z */ { justaddr(jumptest($1, $4, "JGTZ"), codeloc($2)); } | IDENTIFIER P_UNSIGNED_INTEGER '>' '=' IDENTIFIER /* e.g. J44>=Z */ { justaddr(jumptest($1, $5, "JGEZ"), codeloc($2)); } | IDENTIFIER P_UNSIGNED_INTEGER '<' '=' IDENTIFIER /* e.g. J44<=Z */ { justaddr(jumptest($1, $5, "JLEZ"), codeloc($2)); } | IDENTIFIER P_UNSIGNED_INTEGER '<' IDENTIFIER /* e.g. J44