|
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 - 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; }