2 /********************************************
4 copyright 1991-94, Michael D. Brennan
6 This is a source file for mawk, an implementation of
7 the AWK programming language.
9 Mawk is distributed without warranty under the terms of
10 the GNU General Public License, version 2, 1991.
11 ********************************************/
14 * Revision 1.11 1995/06/11 22:40:09 mike
15 * change if(dump_code) -> if(dump_code_flag)
17 * add cast to shutup solaris cc compiler on char to int comparison
18 * switch_code_to_main() which cleans up outside_error production
20 * Revision 1.10 1995/04/21 14:20:21 mike
21 * move_level variable to fix bug in arglist patching of moved code.
23 * Revision 1.9 1995/02/19 22:15:39 mike
24 * Always set the call_offset field in a CA_REC (for obscure
25 * reasons in fcall.c (see comments) there.)
27 * Revision 1.8 1994/12/13 00:39:20 mike
28 * delete A statement to delete all of A at once
30 * Revision 1.7 1994/10/08 19:15:48 mike
33 * Revision 1.6 1993/12/01 14:25:17 mike
34 * reentrant array loops
36 * Revision 1.5 1993/07/22 00:04:13 mike
37 * new op code _LJZ _LJNZ
39 * Revision 1.4 1993/07/15 23:38:15 mike
42 * Revision 1.3 1993/07/07 00:07:46 mike
45 * Revision 1.2 1993/07/03 21:18:01 mike
48 * Revision 1.1.1.1 1993/07/03 18:58:17 mike
51 * Revision 5.8 1993/05/03 01:07:18 mike
52 * fix bozo in LENGTH production
54 * Revision 5.7 1993/01/09 19:03:44 mike
55 * code_pop checks if the resolve_list needs relocation
57 * Revision 5.6 1993/01/07 02:50:33 mike
58 * relative vs absolute code
60 * Revision 5.5 1993/01/01 21:30:48 mike
61 * split new_STRING() into new_STRING and new_STRING0
63 * Revision 5.4 1992/08/08 17:17:20 brennan
64 * patch 2: improved timing of error recovery in
65 * bungled function definitions. Fixes a core dump
67 * Revision 5.3 1992/07/08 15:43:41 brennan
68 * patch2: length returns. I am a wimp
70 * Revision 5.2 1992/01/08 16:11:42 brennan
71 * code FE_PUSHA carefully for MSDOS large mode
73 * Revision 5.1 91/12/05 07:50:22 brennan
92 #define YYMAXDEPTH 200
95 extern void PROTO( eat_nl, (void) ) ;
96 static void PROTO( resize_fblock, (FBLOCK *) ) ;
97 static void PROTO( switch_code_to_main, (void)) ;
98 static void PROTO( code_array, (SYMTAB *) ) ;
99 static void PROTO( code_call_id, (CA_REC *, SYMTAB *) ) ;
100 static void PROTO( field_A2I, (void)) ;
101 static void PROTO( check_var, (SYMTAB *) ) ;
102 static void PROTO( check_array, (SYMTAB *) ) ;
103 static void PROTO( RE_as_arg, (void)) ;
106 static FBLOCK *active_funct ;
107 /* when scope is SCOPE_FUNCT */
109 #define code_address(x) if( is_local(x) ) \
110 code2op(L_PUSHA, (x)->offset) ;\
111 else code2(_PUSHA, (x)->stval.cp)
113 #define CDP(x) (code_base+(x))
114 /* WARNING: These CDP() calculations become invalid after calls
115 that might change code_base. Which are: code2(), code2op(),
116 code_jmp() and code_pop().
119 /* this nonsense caters to MSDOS large model */
120 #define CODE_FE_PUSHA() code_ptr->ptr = (PTR) 0 ; code1(FE_PUSHA)
127 int start ; /* code starting address as offset from code_base */
128 PF_CP fp ; /* ptr to a (print/printf) or (sub/gsub) function */
129 BI_REC *bip ; /* ptr to info about a builtin */
130 FBLOCK *fbp ; /* ptr to a function block */
137 /* two tokens to help with errors */
138 %token UNEXPECTED /* unexpected character */
146 %token <ival> IO_OUT /* > or output pipe */
148 %right ASSIGN ADD_ASG SUB_ASG MUL_ASG DIV_ASG MOD_ASG POW_ASG
153 %left <ival> MATCH /* ~ or !~ */
154 %left EQ NEQ LT LTE GT GTE
162 %left <ival> INC_or_DEC
163 %left DOLLAR FIELD /* last to remove a SR conflict
165 %right LPAREN RPAREN /* removes some SR conflicts */
167 %token <ptr> DOUBLE STRING_ RE
169 %token <fbp> FUNCT_ID
170 %token <bip> BUILTIN LENGTH
173 %token PRINT PRINTF SPLIT MATCH_FUNC SUB GSUB
175 %token DO WHILE FOR BREAK CONTINUE IF ELSE IN
176 %token DELETE BEGIN END EXIT NEXT RETURN FUNCTION
178 %type <start> block block_or_separator
179 %type <start> statement_list statement mark
182 %type <start> builtin
183 %type <start> getline_file
184 %type <start> lvalue field fvalue
185 %type <start> expr cat_expr p_expr
186 %type <start> while_front if_front
187 %type <start> for1 for2
188 %type <start> array_loop_front
189 %type <start> return_statement
190 %type <start> split_front re_arg sub_back
191 %type <ival> arglist args
192 %type <fp> print sub_or_gsub
193 %type <fbp> funct_start funct_head
194 %type <ca_p> call_args ca_front ca_back
195 %type <ival> f_arglist f_args
200 program : program_block
201 | program program_block
204 program_block : PA_block /* pattern-action */
206 | outside_error block
210 { /* this do nothing action removes a vacuous warning
215 { be_setup(scope = SCOPE_BEGIN) ; }
218 { switch_code_to_main() ; }
221 { be_setup(scope = SCOPE_END) ; }
224 { switch_code_to_main() ; }
226 | expr /* this works just like an if statement */
227 { code_jmp(_JZ, (INST*)0) ; }
230 { patch_jmp( code_ptr ) ; }
232 /* range pattern, see comment in execute.c near _RANGE */
238 code_push(p1, code_ptr - p1, scope, active_funct) ;
243 len = code_pop(code_ptr) ;
247 p1[2].op = code_ptr - (p1+1) ;
256 p1[3].op = CDP($6) - (p1+1) ;
257 p1[4].op = code_ptr - (p1+1) ;
263 block : LBRACE statement_list RBRACE
265 | LBRACE error RBRACE
266 { $$ = code_offset ; /* does nothing won't be executed */
267 print_flag = getline_flag = paren_cnt = 0 ;
271 block_or_separator : block
272 | separator /* default print action */
274 code1(_PUSHINT) ; code1(0) ;
275 code2(_PRINT, bi_print) ;
279 statement_list : statement
280 | statement_list statement
287 | /* empty */ separator
288 { $$ = code_offset ; }
291 print_flag = getline_flag = 0 ;
296 { $$ = code_offset ; BC_insert('B', code_ptr+1) ;
297 code2(_JMP, 0) /* don't use code_jmp ! */ ; }
299 { $$ = code_offset ; BC_insert('C', code_ptr+1) ;
302 { if ( scope != SCOPE_FUNCT )
303 compile_error("return outside function body") ;
306 { if ( scope != SCOPE_MAIN )
307 compile_error( "improper use of next" ) ;
313 separator : NL | SEMI_COLON
317 | lvalue ASSIGN expr { code1(_ASSIGN) ; }
318 | lvalue ADD_ASG expr { code1(_ADD_ASG) ; }
319 | lvalue SUB_ASG expr { code1(_SUB_ASG) ; }
320 | lvalue MUL_ASG expr { code1(_MUL_ASG) ; }
321 | lvalue DIV_ASG expr { code1(_DIV_ASG) ; }
322 | lvalue MOD_ASG expr { code1(_MOD_ASG) ; }
323 | lvalue POW_ASG expr { code1(_POW_ASG) ; }
324 | expr EQ expr { code1(_EQ) ; }
325 | expr NEQ expr { code1(_NEQ) ; }
326 | expr LT expr { code1(_LT) ; }
327 | expr LTE expr { code1(_LTE) ; }
328 | expr GT expr { code1(_GT) ; }
329 | expr GTE expr { code1(_GTE) ; }
335 if ( p3 == code_ptr - 2 )
337 if ( p3->op == _MATCH0 ) p3->op = _MATCH1 ;
339 else /* check for string */
340 if ( p3->op == _PUSHS )
341 { CELL *cp = ZMALLOC(CELL) ;
343 cp->type = C_STRING ;
344 cp->ptr = p3[1].ptr ;
347 code2(_MATCH1, cp->ptr) ;
350 else code1(_MATCH2) ;
352 else code1(_MATCH2) ;
354 if ( !$2 ) code1(_NOT) ;
357 /* short circuit boolean evaluation */
360 code_jmp(_LJNZ, (INST*)0) ;
363 { code1(_TEST) ; patch_jmp(code_ptr) ; }
367 code_jmp(_LJZ, (INST*)0) ;
370 { code1(_TEST) ; patch_jmp(code_ptr) ; }
372 | expr QMARK { code_jmp(_JZ, (INST*)0) ; }
373 expr COLON { code_jmp(_JMP, (INST*)0) ; }
375 { patch_jmp(code_ptr) ; patch_jmp(CDP($7)) ; }
378 cat_expr : p_expr %prec CAT
379 | cat_expr p_expr %prec CAT
384 { $$ = code_offset ; code2(_PUSHD, $1) ; }
386 { $$ = code_offset ; code2(_PUSHS, $1) ; }
387 | ID %prec AND /* anything less than IN */
391 { code2op(L_PUSHI, $1->offset) ; }
392 else code2(_PUSHI, $1->stval.cp) ;
400 { $$ = code_offset ; code2(_MATCH0, $1) ; }
403 p_expr : p_expr PLUS p_expr { code1(_ADD) ; }
404 | p_expr MINUS p_expr { code1(_SUB) ; }
405 | p_expr MUL p_expr { code1(_MUL) ; }
406 | p_expr DIV p_expr { code1(_DIV) ; }
407 | p_expr MOD p_expr { code1(_MOD) ; }
408 | p_expr POW p_expr { code1(_POW) ; }
410 { $$ = $2 ; code1(_NOT) ; }
411 | PLUS p_expr %prec UMINUS
412 { $$ = $2 ; code1(_UPLUS) ; }
413 | MINUS p_expr %prec UMINUS
414 { $$ = $2 ; code1(_UMINUS) ; }
418 p_expr : ID INC_or_DEC
423 if ( $2 == '+' ) code1(_POST_INC) ;
424 else code1(_POST_DEC) ;
428 if ( $1 == '+' ) code1(_PRE_INC) ;
429 else code1(_PRE_DEC) ;
433 p_expr : field INC_or_DEC
434 { if ($2 == '+' ) code1(F_POST_INC ) ;
435 else code1(F_POST_DEC) ;
439 if ( $1 == '+' ) code1(F_PRE_INC) ;
440 else code1( F_PRE_DEC) ;
452 arglist : /* empty */
457 args : expr %prec LPAREN
464 BUILTIN mark LPAREN arglist RPAREN
467 if ( (int)p->min_args > $4 || (int)p->max_args < $4 )
469 "wrong number of arguments in call to %s" ,
471 if ( p->min_args != p->max_args ) /* variable args */
472 { code1(_PUSHINT) ; code1($4) ; }
473 code2(_BUILTIN , p->fp) ;
475 | LENGTH /* this is an irritation */
478 code1(_PUSHINT) ; code1(0) ;
479 code2(_BUILTIN, $1->fp) ;
483 /* an empty production to store the code_ptr */
485 { $$ = code_offset ; }
488 /* print_statement */
489 statement : print mark pr_args pr_direction separator
490 { code2(_PRINT, $1) ;
491 if ( $1 == bi_printf && $3 == 0 )
492 compile_error("no arguments in call to printf") ;
498 print : PRINT { $$ = bi_print ; print_flag = 1 ;}
499 | PRINTF { $$ = bi_printf ; print_flag = 1 ; }
502 pr_args : arglist { code2op(_PUSHINT, $1) ; }
504 { $$ = $2->cnt ; zfree($2,sizeof(ARG2_REC)) ;
505 code2op(_PUSHINT, $$) ;
508 { $$=0 ; code2op(_PUSHINT, 0) ; }
511 arg2 : expr COMMA expr
512 { $$ = (ARG2_REC*) zmalloc(sizeof(ARG2_REC)) ;
517 { $$ = $1 ; $$->cnt++ ; }
520 pr_direction : /* empty */
522 { code2op(_PUSHINT, $1) ; }
528 if_front : IF LPAREN expr RPAREN
529 { $$ = $3 ; eat_nl() ; code_jmp(_JZ, (INST*)0) ; }
533 statement : if_front statement
534 { patch_jmp( code_ptr ) ; }
537 else : ELSE { eat_nl() ; code_jmp(_JMP, (INST*)0) ; }
540 /* if_else_statement */
541 statement : if_front statement else statement
542 { patch_jmp(code_ptr) ;
551 { eat_nl() ; BC_new() ; }
555 statement : do statement WHILE LPAREN expr RPAREN separator
557 code_jmp(_JNZ, CDP($2)) ;
558 BC_clear(code_ptr, CDP($5)) ; }
561 while_front : WHILE LPAREN expr RPAREN
562 { eat_nl() ; BC_new() ;
565 /* check if const expression */
566 if ( code_ptr - 2 == CDP($3) &&
567 code_ptr[-2].op == _PUSHD &&
568 *(double*)code_ptr[-1].ptr != 0.0
572 { INST *p3 = CDP($3) ;
573 code_push(p3, code_ptr-p3, scope, active_funct) ;
575 code2(_JMP, (INST*)0) ; /* code2() not code_jmp() */
580 /* while_statement */
581 statement : while_front statement
588 if ( p1 != p2 ) /* real test in loop */
590 p1[1].op = code_ptr-(p1+1) ;
591 saved_offset = code_offset ;
592 len = code_pop(code_ptr) ;
594 code_jmp(_JNZ, CDP($2)) ;
595 BC_clear(code_ptr, CDP(saved_offset)) ;
600 BC_clear(code_ptr, CDP($2)) ;
607 statement : for1 for2 for3 statement
609 int cont_offset = code_offset ;
610 unsigned len = code_pop(code_ptr) ;
616 if ( p2 != p4 ) /* real test in for2 */
618 p4[-1].op = code_ptr - p4 + 1 ;
619 len = code_pop(code_ptr) ;
621 code_jmp(_JNZ, CDP($4)) ;
626 BC_clear(code_ptr, CDP(cont_offset)) ;
631 for1 : FOR LPAREN SEMI_COLON { $$ = code_offset ; }
632 | FOR LPAREN expr SEMI_COLON
633 { $$ = $3 ; code1(_POP) ; }
636 for2 : SEMI_COLON { $$ = code_offset ; }
639 if ( code_ptr - 2 == CDP($1) &&
640 code_ptr[-2].op == _PUSHD &&
641 * (double*) code_ptr[-1].ptr != 0.0
647 code_push(p1, code_ptr-p1, scope, active_funct) ;
649 code2(_JMP, (INST*)0) ;
655 { eat_nl() ; BC_new() ;
656 code_push((INST*)0,0, scope, active_funct) ;
659 { INST *p1 = CDP($1) ;
661 eat_nl() ; BC_new() ;
663 code_push(p1, code_ptr - p1, scope, active_funct) ;
664 code_ptr -= code_ptr - p1 ;
676 | LPAREN arg2 RPAREN IN ID
678 code2op(A_CAT, $2->cnt) ;
679 zfree($2, sizeof(ARG2_REC)) ;
687 lvalue : ID mark LBOX args RBOX
690 { code2op(A_CAT, $4) ; }
694 { code2op(LAE_PUSHA, $1->offset) ; }
695 else code2(AE_PUSHA, $1->stval.array) ;
700 p_expr : ID mark LBOX args RBOX %prec AND
703 { code2op(A_CAT, $4) ; }
707 { code2op(LAE_PUSHI, $1->offset) ; }
708 else code2(AE_PUSHI, $1->stval.array) ;
712 | ID mark LBOX args RBOX INC_or_DEC
715 { code2op(A_CAT,$4) ; }
719 { code2op(LAE_PUSHA, $1->offset) ; }
720 else code2(AE_PUSHA, $1->stval.array) ;
721 if ( $6 == '+' ) code1(_POST_INC) ;
722 else code1(_POST_DEC) ;
728 /* delete A[i] or delete A */
729 statement : DELETE ID mark LBOX args RBOX separator
732 if ( $5 > 1 ) { code2op(A_CAT, $5) ; }
737 | DELETE ID separator
746 /* for ( i in A ) statement */
748 array_loop_front : FOR LPAREN ID IN ID RPAREN
749 { eat_nl() ; BC_new() ;
757 code2(SET_ALOOP, (INST*)0) ;
762 statement : array_loop_front statement
766 p2[-1].op = code_ptr - p2 + 1 ;
767 BC_clear( code_ptr+2 , code_ptr) ;
768 code_jmp(ALOOP, p2) ;
774 D_ID is a special token , same as an ID, but yylex()
775 only returns it after a '$'. In essense,
776 DOLLAR D_ID is really one token.
780 { $$ = code_offset ; code2(F_PUSHA, $1) ; }
785 { code2op(L_PUSHI, $2->offset) ; }
786 else code2(_PUSHI, $2->stval.cp) ;
790 | DOLLAR D_ID mark LBOX args RBOX
793 { code2op(A_CAT, $5) ; }
797 { code2op(LAE_PUSHI, $2->offset) ; }
798 else code2(AE_PUSHI, $2->stval.array) ;
805 { $$ = $2 ; CODE_FE_PUSHA() ; }
806 | LPAREN field RPAREN
810 p_expr : field %prec CAT /* removes field (++|--) sr conflict */
814 expr : field ASSIGN expr { code1(F_ASSIGN) ; }
815 | field ADD_ASG expr { code1(F_ADD_ASG) ; }
816 | field SUB_ASG expr { code1(F_SUB_ASG) ; }
817 | field MUL_ASG expr { code1(F_MUL_ASG) ; }
818 | field DIV_ASG expr { code1(F_DIV_ASG) ; }
819 | field MOD_ASG expr { code1(F_MOD_ASG) ; }
820 | field POW_ASG expr { code1(F_POW_ASG) ; }
823 /* split is handled different than a builtin because
824 it takes an array and optionally a regular expression as args */
826 p_expr : split_front split_back
827 { code2(_BUILTIN, bi_split) ; }
830 split_front : SPLIT LPAREN expr COMMA ID
838 { code2(_PUSHI, &fs_shadow) ; }
841 if ( CDP($2) == code_ptr - 2 )
843 if ( code_ptr[-2].op == _MATCH0 )
846 if ( code_ptr[-2].op == _PUSHS )
847 { CELL *cp = ZMALLOC(CELL) ;
849 cp->type = C_STRING ;
850 cp->ptr = code_ptr[-1].ptr ;
852 code_ptr[-2].op = _PUSHC ;
853 code_ptr[-1].ptr = (PTR) cp ;
861 /* match(expr, RE) */
863 p_expr : MATCH_FUNC LPAREN expr COMMA re_arg RPAREN
865 code2(_BUILTIN, bi_match) ;
874 if ( p1 == code_ptr - 2 )
876 if ( p1->op == _MATCH0 ) RE_as_arg() ;
878 if ( p1->op == _PUSHS )
879 { CELL *cp = ZMALLOC(CELL) ;
881 cp->type = C_STRING ;
882 cp->ptr = p1[1].ptr ;
885 p1[1].ptr = (PTR) cp ;
893 statement : EXIT separator
896 | EXIT expr separator
897 { $$ = $2 ; code1(_EXIT) ; }
900 return_statement : RETURN separator
903 | RETURN expr separator
904 { $$ = $2 ; code1(_RET) ; }
909 p_expr : getline %prec GETLINE
911 code2(F_PUSHA, &field[0]) ;
912 code1(_PUSHINT) ; code1(0) ;
913 code2(_BUILTIN, bi_getline) ;
916 | getline fvalue %prec GETLINE
918 code1(_PUSHINT) ; code1(0) ;
919 code2(_BUILTIN, bi_getline) ;
922 | getline_file p_expr %prec IO_IN
923 { code1(_PUSHINT) ; code1(F_IN) ;
924 code2(_BUILTIN, bi_getline) ;
925 /* getline_flag already off in yylex() */
927 | p_expr PIPE GETLINE
928 { code2(F_PUSHA, &field[0]) ;
929 code1(_PUSHINT) ; code1(PIPE_IN) ;
930 code2(_BUILTIN, bi_getline) ;
932 | p_expr PIPE GETLINE fvalue
934 code1(_PUSHINT) ; code1(PIPE_IN) ;
935 code2(_BUILTIN, bi_getline) ;
939 getline : GETLINE { getline_flag = 1 ; } ;
941 fvalue : lvalue | field ;
943 getline_file : getline IO_IN
945 code2(F_PUSHA, field+0) ;
947 | getline fvalue IO_IN
951 /*==========================================
953 ==========================================*/
955 p_expr : sub_or_gsub LPAREN re_arg COMMA expr sub_back
960 if ( p6 - p5 == 2 && p5->op == _PUSHS )
961 { /* cast from STRING to REPL at compile time */
962 CELL *cp = ZMALLOC(CELL) ;
963 cp->type = C_STRING ;
964 cp->ptr = p5[1].ptr ;
967 p5[1].ptr = (PTR) cp ;
969 code2(_BUILTIN, $1) ;
974 sub_or_gsub : SUB { $$ = bi_sub ; }
975 | GSUB { $$ = bi_gsub ; }
979 sub_back : RPAREN /* substitute into $0 */
981 code2(F_PUSHA, &field[0]) ;
984 | COMMA fvalue RPAREN
988 /*================================================
989 user defined functions
990 *=================================*/
992 function_def : funct_start block
996 switch_code_to_main() ;
1001 funct_start : funct_head LPAREN f_arglist RPAREN
1003 scope = SCOPE_FUNCT ;
1005 *main_code_p = active_code ;
1009 $1->typev = (char *)
1010 memset( zmalloc($3), ST_LOCAL_NONE, $3) ;
1011 else $1->typev = (char *) 0 ;
1013 code_ptr = code_base =
1014 (INST *) zmalloc(INST_BYTES(PAGESZ));
1015 code_limit = code_base + PAGESZ ;
1016 code_warn = code_limit - CODEWARN ;
1020 funct_head : FUNCTION ID
1023 if ( $2->type == ST_NONE )
1025 $2->type = ST_FUNCT ;
1026 fbp = $2->stval.fbp =
1027 (FBLOCK *) zmalloc(sizeof(FBLOCK)) ;
1028 fbp->name = $2->name ;
1029 fbp->code = (INST*) 0 ;
1035 /* this FBLOCK will not be put in
1037 fbp = (FBLOCK*) zmalloc(sizeof(FBLOCK)) ;
1046 compile_error("redefinition of %s" , $2->name) ;
1050 f_arglist : /* empty */ { $$ = 0 ; }
1055 { $1 = save_id($1->name) ;
1056 $1->type = ST_LOCAL_NONE ;
1061 { if ( is_local($3) )
1062 compile_error("%s is duplicated in argument list",
1065 { $3 = save_id($3->name) ;
1066 $3->type = ST_LOCAL_NONE ;
1073 outside_error : error
1074 { /* we may have to recover from a bungled function
1076 /* can have local ids, before code scope
1080 switch_code_to_main() ;
1084 /* a call to a user defined function */
1086 p_expr : FUNCT_ID mark call_args
1090 if ( $3 ) code1($3->arg_num+1) ;
1093 check_fcall($1, scope, code_move_level, active_funct,
1098 call_args : LPAREN RPAREN
1099 { $$ = (CA_REC *) 0 ; }
1103 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
1107 /* The funny definition of ca_front with the COMMA bound to the ID is to
1108 force a shift to avoid a reduce/reduce conflict
1111 Or to avoid a decision, if the type of the ID has not yet been
1116 { $$ = (CA_REC *) 0 ; }
1117 | ca_front expr COMMA
1118 { $$ = ZMALLOC(CA_REC) ;
1120 $$->type = CA_EXPR ;
1121 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
1122 $$->call_offset = code_offset ;
1125 { $$ = ZMALLOC(CA_REC) ;
1127 $$->arg_num = $1 ? $1->arg_num+1 : 0 ;
1129 code_call_id($$, $2) ;
1133 ca_back : expr RPAREN
1134 { $$ = ZMALLOC(CA_REC) ;
1135 $$->type = CA_EXPR ;
1136 $$->call_offset = code_offset ;
1140 { $$ = ZMALLOC(CA_REC) ;
1141 code_call_id($$, $1) ;
1150 /* resize the code for a user function */
1152 static void resize_fblock( fbp )
1155 CODEBLOCK *p = ZMALLOC(CODEBLOCK) ;
1158 code2op(_RET0, _HALT) ;
1159 /* make sure there is always a return */
1162 fbp->code = code_shrink(p, &dummy) ;
1163 /* code_shrink() zfrees p */
1165 if ( dump_code_flag ) add_to_fdump_list(fbp) ;
1169 /* convert FE_PUSHA to FE_PUSHI
1170 or F_PUSH to F_PUSHI
1173 static void field_A2I()
1176 if ( code_ptr[-1].op == FE_PUSHA &&
1177 code_ptr[-1].ptr == (PTR) 0)
1178 /* On most architectures, the two tests are the same; a good
1179 compiler might eliminate one. On LM_DOS, and possibly other
1180 segmented architectures, they are not */
1181 { code_ptr[-1].op = FE_PUSHI ; }
1184 cp = (CELL *) code_ptr[-1].ptr ;
1189 SAMESEG(cp,field) &&
1191 cp > NF && cp <= LAST_PFIELD )
1193 code_ptr[-2].op = _PUSHI ;
1195 else if ( cp == NF )
1196 { code_ptr[-2].op = NF_PUSHI ; code_ptr-- ; }
1200 code_ptr[-2].op = F_PUSHI ;
1201 code_ptr -> op = field_addr_to_index( code_ptr[-1].ptr ) ;
1207 /* we've seen an ID in a context where it should be a VAR,
1208 check that's consistent with previous usage */
1210 static void check_var( p )
1211 register SYMTAB *p ;
1215 case ST_NONE : /* new id */
1217 p->stval.cp = ZMALLOC(CELL) ;
1218 p->stval.cp->type = C_NOINIT ;
1221 case ST_LOCAL_NONE :
1222 p->type = ST_LOCAL_VAR ;
1223 active_funct->typev[p->offset] = ST_LOCAL_VAR ;
1227 case ST_LOCAL_VAR : break ;
1235 /* we've seen an ID in a context where it should be an ARRAY,
1236 check that's consistent with previous usage */
1237 static void check_array(p)
1238 register SYMTAB *p ;
1242 case ST_NONE : /* a new array */
1243 p->type = ST_ARRAY ;
1244 p->stval.array = new_ARRAY() ;
1248 case ST_LOCAL_ARRAY :
1251 case ST_LOCAL_NONE :
1252 p->type = ST_LOCAL_ARRAY ;
1253 active_funct->typev[p->offset] = ST_LOCAL_ARRAY ;
1256 default : type_error(p) ; break ;
1260 static void code_array(p)
1261 register SYMTAB *p ;
1263 if ( is_local(p) ) code2op(LA_PUSHA, p->offset) ;
1264 else code2(A_PUSHA, p->stval.array) ;
1268 /* we've seen an ID as an argument to a user defined function */
1270 static void code_call_id( p, ip )
1271 register CA_REC *p ;
1272 register SYMTAB *ip ;
1273 { static CELL dummy ;
1275 p->call_offset = code_offset ;
1276 /* This always get set now. So that fcall:relocate_arglist
1283 code2(_PUSHI, ip->stval.cp) ;
1288 code2op(L_PUSHI, ip->offset) ;
1292 p->type = CA_ARRAY ;
1293 code2(A_PUSHA, ip->stval.array) ;
1296 case ST_LOCAL_ARRAY :
1297 p->type = CA_ARRAY ;
1298 code2op(LA_PUSHA, ip->offset) ;
1301 /* not enough info to code it now; it will have to
1307 code2(_PUSHI, &dummy) ;
1310 case ST_LOCAL_NONE :
1311 p->type = ST_LOCAL_NONE ;
1312 p->type_p = & active_funct->typev[ip->offset] ;
1313 code2op(L_PUSHI, ip->offset) ;
1319 bozo("code_call_id") ;
1325 /* an RE by itself was coded as _MATCH0 , change to
1326 push as an expression */
1328 static void RE_as_arg()
1329 { CELL *cp = ZMALLOC(CELL) ;
1333 cp->ptr = code_ptr[1].ptr ;
1337 /* reset the active_code back to the MAIN block */
1339 switch_code_to_main()
1344 *begin_code_p = active_code ;
1345 active_code = *main_code_p ;
1349 *end_code_p = active_code ;
1350 active_code = *main_code_p ;
1354 active_code = *main_code_p ;
1360 active_funct = (FBLOCK*) 0 ;
1361 scope = SCOPE_MAIN ;
1368 if ( yyparse() || compile_error_count != 0 ) mawk_exit(2) ;
1372 /* code must be set before call to resolve_fcalls() */
1373 if ( resolve_list ) resolve_fcalls() ;
1375 if ( compile_error_count != 0 ) mawk_exit(2) ;
1376 if ( dump_code_flag ) { dump_code() ; mawk_exit(0) ; }