|
|
DataMuseum.dkPresents historical artifacts from the history of: Commodore CBM-900 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Commodore CBM-900 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 10587 (0x295b)
Types: TextFile
Notes: UNIX file
Names: »gram.y«
└─⟦f27320a65⟧ Bits:30001972 Commodore 900 hard disk image with partial source code
└─⟦f4b8d8c84⟧ UNIX Filesystem
└─⟦this⟧ »cmd/bc/gram.y«
/* Bc - an infix desk calculator */
%{
#include <stdio.h>
#include "bc.h"
#define YYTNAMES
static code *breakloc = NULL, /* where to go on break statement */
*contloc = NULL; /* where to go on continue statement */
static dicent *retfrom = NULL, /* what function to return from */
**dvec, /* list of locals */
**pardvec, /* list of formal parameters */
**autdvec; /* list of automatic variables */
static int ldvec, /* length of dvec */
lpardvec, /* length of pardvec */
lautdvec; /* length of autdvec */
%}
%union {
opcode opcode;
rvalue *lvalue;
char *svalue;
dicent *dvalue;
int ivalue;
code *location;
}
%token <lvalue> NUMBER
%token <svalue> STRING
%token <dvalue> IDENTIFIER
%token ADDAB AUTO BREAK CONTINUE DECR DEFINE
%token DIVAB DO DOT ELSE EQP ERROR
%token EXPAB FOR GEP GTP IBASE IF
%token INCR LENGTH_ LEP LTP MULAB NEP
%token OBASE QUIT REMAB RETURN_ SCALE_ SQRT_
%token SUBAB WHILE
%type <opcode> assignment_op special_load special_store
%type <opcode> function_like_primitive relational
%type <dvalue> local
%type <ivalue> argument_list non_empty_argument_list
%type <location> jump_true jump_false else_part
%type <location> goto save_loc save_break
%type <location> save_continue
%right '='
%left '+' '-'
%left '*' '/' '%'
%right '^'
%left INCR DECR UMINUS
%%
session:
/* empty */
| session statement {
emitop(STOP);
if (allok)
interp();
loc = cstream;
allok = TRUE;
breakloc = contloc = retfrom = NULL;
}
| session definition {
emitop(PGLSC);
emitnum(&zero);
emitop(LOAD);
emitop(RETURN);
emitid(retfrom);
if (allok) {
install(&retfrom->globalv.fvalue, pardvec, lpardvec,
autdvec, lautdvec);
mpfree(pardvec);
mpfree(autdvec);
}
loc = cstream;
allok = TRUE;
breakloc = contloc = retfrom = NULL;
}
| session error '\n' {
YYERROK;
loc = cstream;
allok = TRUE;
breakloc = contloc = retfrom = NULL;
}
;
/*
* Statements.
*/
statement:
/*
* The code generated for an IF statement with an else part is as
* follows:
* if not condition, goto L1
* true part of IF statement
* goto L2
* L1: false part of IF statement
* L2:
*
* If there is no ELSE part, then the code generated is as
* follows:
* if not condition, goto L1
* true part of IF statement
* L1:
*/
IF '(' jump_false ')' /* $1 */
statement /* $5 */
else_part { /* $6 */
patch($3, $6);
}
|
/*
* The code generated for the WHILE statement is as
* follows:
* CONTINUE: if condition, goto L1
* BREAK: goto L2
* L1: body of WHILE statement
* goto CONTINUE
* L2:
*/
WHILE save_continue '(' jump_true ')' /* $1 */
save_break goto /* $6 */
save_loc statement /* $8 */
goto { /* $10 */
patch($4, $8);
patch($7, loc);
patch($10, contloc);
breakloc = $6; /* restore break */
contloc = $2; /* restore continue */
}
|
/*
* The code produced for the FOR statement is as
* follows:
* initialization expression
* L1: if condition, goto L3
* BREAK: goto L4
* CONTINUE: increment expression
* goto L1
* L3: body of FOR statement
* goto CONTINUE
* L4:
*/
FOR '(' optional_expression_list';' /* $1 */
save_loc jump_true ';' /* $5 */
save_break goto /* $8 */
save_continue optional_expression_list ')' /* $10 */
goto /* $13 */
save_loc statement /* $14 */
goto { /* $16 */
patch($6, $14);
patch($9, loc);
patch($13, $5);
patch($16, contloc);
breakloc = $8;
contloc = $10;
}
|
/*
* The code produced for the DO-WHILE statement is as
* follows:
* goto L1
* BREAK: goto L3
* CONTINUE: goto L2
* L1: body of DO-WHILE statement
* L2: if condition, goto L1
* L3:
*/
DO goto /* $1 */
save_break goto /* $3 */
save_continue goto /* $5 */
save_loc statement WHILE '(' /* $7 */
save_loc jump_true ')' end_of_statement { /* $11 */
patch($2, $7);
patch($4, loc);
patch($6, $11);
patch($12, $7);
breakloc = $3;
contloc = $5;
}
| BREAK end_of_statement {
if (breakloc == NULL)
gerror("Break not in loop");
emitop(BRALW);
emitaddr(breakloc);
}
| CONTINUE end_of_statement {
if (contloc == NULL)
gerror("Continue not in loop");
emitop(BRALW);
emitaddr(contloc);
}
| RETURN_ end_of_statement {
if (retfrom == NULL)
gerror("Return not in function");
emitop(PGLSC);
emitnum(&zero);
emitop(LOAD);
emitop(RETURN);
emitid(retfrom);
}
| RETURN_ expression end_of_statement {
if (retfrom == NULL)
gerror("Return not in function");
emitop(RETURN);
emitid(retfrom);
}
| assignment_expression end_of_statement {
emitop(POP);
}
| non_assignment_expression end_of_statement {
emitop(PRNUM);
emitop(PRNL);
}
| non_assignment_expression '$' end_of_statement {
emitop(PRNUM);
}
| STRING end_of_statement {
emitop(PRSTR);
emitstr($1);
emitop(PRNL);
}
| STRING '$' end_of_statement {
emitop(PRSTR);
emitstr($1);
}
| '{' statement_list '}'
| QUIT end_of_statement {
return(0);
}
| end_of_statement
;
end_of_statement:
';'
| '\n'
;
statement_list:
/* empty */
| statement_list statement
;
else_part:
/* empty */ {
$$ = loc;
}
| ELSE goto save_loc statement {
$$ = $3;
patch($2, loc);
}
;
optional_expression_list:
/* empty */
| non_empty_expression_list
;
non_empty_expression_list:
expression {
emitop(POP);
}
| non_empty_expression_list ',' expression {
emitop(POP);
}
;
goto:
/* empty */ {
emitop(BRALW);
$$ = emitzap;
}
;
save_loc:
/* empty */ {
$$ = loc;
}
;
save_break:
/* empty */ {
$$ = breakloc;
breakloc = loc;
}
;
save_continue:
/* empty */ {
$$ = contloc;
contloc = loc;
}
;
/*
* Function definition.
*/
definition:
definition_header '(' parameter_list ')' /* $1 */
optional_nl '{' '\n' /* $5 */
optional_auto statement_list '}' /* $8 */
;
definition_header:
DEFINE IDENTIFIER {
chkfunc($2);
retfrom = $2;
ldvec = 0;
}
;
parameter_list:
/* empty */ {
pardvec = NULL;
lpardvec = 0;
}
| non_empty_local_list {
pardvec = dvec;
lpardvec = ldvec;
locaddr(pardvec, lpardvec, 0);
ldvec = 0;
}
;
optional_auto:
/* empty */ {
autdvec = NULL;
lautdvec = 0;
}
| AUTO non_empty_local_list end_of_statement {
autdvec = dvec;
lautdvec = ldvec;
locaddr(autdvec, lautdvec, lpardvec);
}
;
non_empty_local_list:
local {
dvec = (dicent **)mpalc(ldvec * sizeof (*dvec));
dvec += ldvec;
*--dvec = $1;
}
| local ',' non_empty_local_list {
*--dvec = $1;
}
;
local:
IDENTIFIER {
if ($1->localt != UNDEFINED)
gerror("Attempt to redeclare %s", $1->word);
$1->localt = SCALAR;
++ldvec;
/* $$ = $1 */
}
| IDENTIFIER '[' ']' {
if ($1->localt != UNDEFINED)
gerror("Attempt to redeclare %s", $1->word);
$1->localt = ARRAY;
++ldvec;
/* $$ = $1 */
}
;
optional_nl:
/* empty */
| '\n'
;
/*
* Expressions.
*/
expression:
assignment_expression
| non_assignment_expression
;
assignment_expression:
l_value '=' expression {
emitop(STORE);
}
| l_value add_r_value assignment_op expression {
emitop($3);
emitop(STORE);
}
| special_store '=' expression {
emitop($1);
}
| special_load assignment_op expression {
emitop($2);
emitop($1);
}
;
non_assignment_expression:
NUMBER {
emitop(PGLSC);
emitnum($1);
emitop(LOAD);
}
| DOT {
emitop(PGLSC);
emitnum(&dot);
emitop(LOAD);
}
| l_value {
emitop(LOAD);
}
| special_load
| IDENTIFIER '(' argument_list ')' {
chkfunc($1);
emitop(CALL);
emitid($1);
emitcnt($3);
}
| INCR l_value {
emitop(PRVAL);
emitop(INC);
emitop(STORE);
}
| INCR special_load {
emitop(INC);
emitop($2);
}
| DECR l_value {
emitop(PRVAL);
emitop(DEC);
emitop(STORE);
}
| DECR special_load {
emitop(DEC);
emitop($2);
}
| l_value INCR {
emitop(PRVAL);
emitop(INC);
emitop(STORE);
emitop(DEC);
}
| special_load INCR {
emitop(INC);
emitop($1);
emitop(DEC);
}
| l_value DECR {
emitop(PRVAL);
emitop(DEC);
emitop(STORE);
emitop(INC);
}
| special_load DECR {
emitop(DEC);
emitop($1);
emitop(INC);
}
| '-' non_assignment_expression %prec UMINUS {
emitop(NEG);
}
| non_assignment_expression '^' non_assignment_expression {
emitop(EXP);
}
| non_assignment_expression '*' non_assignment_expression {
emitop(MUL);
}
| non_assignment_expression '/' non_assignment_expression {
emitop(DIV);
}
| non_assignment_expression '%' non_assignment_expression {
emitop(REM);
}
| non_assignment_expression '+' non_assignment_expression {
emitop(ADD);
}
| non_assignment_expression '-' non_assignment_expression {
emitop(SUB);
}
| '(' expression ')'
| function_like_primitive '(' expression ')' {
emitop($1);
}
;
l_value:
IDENTIFIER {
sload($1);
}
| IDENTIFIER '[' expression ']' {
aeload($1);
}
;
argument:
expression
| IDENTIFIER '[' ']' {
arload($1);
}
;
argument_list:
/* empty */ {
$$ = 0;
}
| non_empty_argument_list
/* $$ = $1 */
;
non_empty_argument_list:
argument {
$$ = 1;
}
| non_empty_argument_list ',' argument {
$$ = $1 + 1;
}
;
add_r_value:
/* empty */ {
emitop(PRVAL);
}
;
special_store:
IBASE {
$$ = SIBASE;
}
| OBASE {
$$ = SOBASE;
}
| SCALE_ {
$$ = SSCALE;
}
;
special_load:
IBASE {
emitop(LIBASE);
$$ = SIBASE;
}
| OBASE {
emitop(LOBASE);
$$ = SOBASE;
}
| SCALE_ {
emitop(LSCALE);
$$ = SSCALE;
}
;
assignment_op:
ADDAB {
$$ = ADD;
}
| SUBAB {
$$ = SUB;
}
| MULAB {
$$ = MUL;
}
| DIVAB {
$$ = DIV;
}
| REMAB {
$$ = REM;
}
| EXPAB {
$$ = EXP;
}
;
function_like_primitive:
SQRT_ {
$$ = SQRT;
}
| LENGTH_ {
$$ = LENGTH;
}
| SCALE_ {
$$ = SCALE;
}
;
/*
* Conditionals.
*/
jump_true:
/* empty */ {
emitop(BRALW);
$$ = emitzap;
}
| non_assignment_expression relational non_assignment_expression {
emitop($2);
$$ = emitzap;
}
;
jump_false:
/* empty */ {
emitop(BRNEV);
$$ = emitzap;
}
| non_assignment_expression relational non_assignment_expression {
emitop(negate($2));
$$ = emitzap;
}
;
relational:
LTP {
$$ = BRLT;
}
| LEP {
$$ = BRLE;
}
| EQP {
$$ = BREQ;
}
| GEP {
$$ = BRGE;
}
| GTP {
$$ = BRGT;
}
| NEP {
$$ = BRNE;
}
;
%%
/*
* Yyerror is the error routine called on a syntax error by
* yyparse.
*/
yyerror(m)
char *m;
{
register struct yytname *ptr;
fprintf(stderr,"%s", m);
for (ptr = yytnames; ptr->tn_name != NULL; ++ptr)
if (ptr->tn_val == yychar) {
fprintf(stderr," at %s", ptr->tn_name);
break;
}
fprintf(stderr,"\n");
allok = FALSE;
}