Doxygen Source Code Documentation
format.c File Reference
#include "defs.h"#include "p1defs.h"#include "format.h"#include "output.h"#include "names.h"#include "iob.h"Go to the source code of this file.
Define Documentation
|
|
Definition at line 181 of file format.c. Referenced by do_format(). |
Function Documentation
|
|
Definition at line 436 of file format.c. References err, Literal::litnum, Literal::littype, and STGMEMNO. Referenced by do_p1_literal(), and make_int_expr().
00438 {
00439 long memno = addrp->memno;
00440 struct Literal *litp, *lastlit;
00441
00442 lastlit = litpool + nliterals;
00443 for (litp = litpool; litp < lastlit; litp++)
00444 if (litp->litnum == memno) {
00445 addrp->vtype = litp->littype;
00446 *((union Constant *) &(addrp->user)) =
00447 *((union Constant *) &(litp->litval));
00448 addrp->vstg = STGMEMNO;
00449 return;
00450 }
00451 err("addrlit failure!");
00452 }
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
||||||||||||
|
Definition at line 193 of file format.c. References do_p1_addr(), do_p1_asgoto(), do_p1_charp(), do_p1_comment(), do_p1_comp_goto(), do_p1_const(), do_p1_elif(), do_p1_else(), do_p1_end_for(), do_p1_endelse(), do_p1_endif(), do_p1_expr(), do_p1_extern(), do_p1_for(), do_p1_fortran(), do_p1_goto(), do_p1_head(), do_p1_ident(), do_p1_if(), do_p1_label(), do_p1_list(), do_p1_literal(), do_p1_name_pointer(), do_p1_set_line(), do_p1_subr_ret(), ENULL, Fatal(), gflag, gflag1, last_was_label, P1_ADDR, P1_ASGOTO, P1_CHARP, P1_COMMENT, P1_COMP_GOTO, P1_CONST, P1_ELIF, P1_ELSE, P1_ELSEIFSTART, P1_ENDELSE, P1_ENDFOR, P1_ENDIF, P1_EOF, P1_EXPR, P1_EXTERN, P1_FILENAME, P1_FILENAME_MAX, P1_FOR, P1_FORTRAN, P1_GOTO, P1_HEAD, P1_IDENT, P1_IF, P1_LABEL, P1_LIST, P1_LITERAL, P1_NAME_POINTER, P1_PROCODE, P1_SET_LINE, P1_SUBR_RET, P1_UNKNOWN, P1_WHILE1START, P1_WHILE2START, procode(), retval(), SEM_CHECK, and sharp_line. Referenced by do_p1_addr(), do_p1_asgoto(), do_p1_comp_goto(), do_p1_elif(), do_p1_expr(), do_p1_for(), do_p1_if(), do_p1_list(), do_p1_subr_ret(), and start_formatting().
00195 {
00196 int token_type, was_c_token;
00197 expptr retval = ENULL;
00198
00199 token_type = get_p1_token (infile);
00200 was_c_token = 1;
00201 switch (token_type) {
00202 case P1_COMMENT:
00203 do_p1_comment (infile, outfile);
00204 was_c_token = 0;
00205 break;
00206 case P1_SET_LINE:
00207 do_p1_set_line (infile);
00208 was_c_token = 0;
00209 break;
00210 case P1_FILENAME:
00211 p1gets(infile, filename, P1_FILENAME_MAX);
00212 was_c_token = 0;
00213 break;
00214 case P1_NAME_POINTER:
00215 retval = do_p1_name_pointer (infile);
00216 break;
00217 case P1_CONST:
00218 retval = do_p1_const (infile);
00219 break;
00220 case P1_EXPR:
00221 retval = do_p1_expr (infile, outfile);
00222 break;
00223 case P1_IDENT:
00224 retval = do_p1_ident(infile);
00225 break;
00226 case P1_CHARP:
00227 retval = do_p1_charp(infile);
00228 break;
00229 case P1_EXTERN:
00230 retval = do_p1_extern (infile);
00231 break;
00232 case P1_HEAD:
00233 gflag1 = sharp_line = 0;
00234 retval = do_p1_head (infile, outfile);
00235 gflag1 = sharp_line = gflag;
00236 break;
00237 case P1_LIST:
00238 retval = do_p1_list (infile, outfile);
00239 break;
00240 case P1_LITERAL:
00241 retval = do_p1_literal (infile);
00242 break;
00243 case P1_LABEL:
00244 do_p1_label (infile, outfile);
00245 /* last_was_label = 1; -- now set in do_p1_label */
00246 was_c_token = 0;
00247 break;
00248 case P1_ASGOTO:
00249 do_p1_asgoto (infile, outfile);
00250 break;
00251 case P1_GOTO:
00252 do_p1_goto (infile, outfile);
00253 break;
00254 case P1_IF:
00255 do_p1_if (infile, outfile);
00256 break;
00257 case P1_ELSE:
00258 SEM_CHECK(outfile);
00259 do_p1_else (outfile);
00260 break;
00261 case P1_ELIF:
00262 SEM_CHECK(outfile);
00263 do_p1_elif (infile, outfile);
00264 break;
00265 case P1_ENDIF:
00266 SEM_CHECK(outfile);
00267 do_p1_endif (outfile);
00268 break;
00269 case P1_ENDELSE:
00270 SEM_CHECK(outfile);
00271 do_p1_endelse (outfile);
00272 break;
00273 case P1_ADDR:
00274 retval = do_p1_addr (infile, outfile);
00275 break;
00276 case P1_SUBR_RET:
00277 do_p1_subr_ret (infile, outfile);
00278 break;
00279 case P1_COMP_GOTO:
00280 do_p1_comp_goto (infile, outfile);
00281 break;
00282 case P1_FOR:
00283 do_p1_for (infile, outfile);
00284 break;
00285 case P1_ENDFOR:
00286 SEM_CHECK(outfile);
00287 do_p1_end_for (outfile);
00288 break;
00289 case P1_WHILE1START:
00290 do_p1_1while(outfile);
00291 break;
00292 case P1_WHILE2START:
00293 do_p1_2while(infile, outfile);
00294 break;
00295 case P1_PROCODE:
00296 procode(outfile);
00297 break;
00298 case P1_ELSEIFSTART:
00299 SEM_CHECK(outfile);
00300 do_p1_elseifstart(outfile);
00301 break;
00302 case P1_FORTRAN:
00303 do_p1_fortran(infile, outfile);
00304 /* no break; */
00305 case P1_EOF:
00306 was_c_token = 0;
00307 break;
00308 case P1_UNKNOWN:
00309 Fatal("do_format: Unknown token type in intermediate file");
00310 break;
00311 default:
00312 Fatal("do_format: Bad token type in intermediate file");
00313 break;
00314 } /* switch */
00315
00316 if (was_c_token)
00317 last_was_label = 0;
00318 return retval;
00319 } /* do_format */
|
|
||||||||||||
|
Definition at line 644 of file format.c. References do_format(), err, erri(), and TADDR. Referenced by do_format().
00646 {
00647 Addrp addrp = (Addrp) NULL;
00648 int status;
00649
00650 status = p1getn (infile, (int)sizeof(struct Addrblock), (char **) &addrp);
00651
00652 if (status == EOF)
00653 err ("do_p1_addr: Missing Addrp at end of file");
00654 else if (status == 0)
00655 err ("do_p1_addr: Missing Addrp in p1 file");
00656 else if (addrp == (Addrp) NULL)
00657 err ("do_p1_addr: Null addrp in p1 file");
00658 else if (addrp -> tag != TADDR)
00659 erri ("do_p1_addr: bad tag in p1 file '%d'", addrp -> tag);
00660 else {
00661 addrp -> vleng = do_format (infile, outfile);
00662 addrp -> memoffset = do_format (infile, outfile);
00663 }
00664
00665 return (expptr) addrp;
00666 } /* do_p1_addr */
|
|
||||||||||||
|
Definition at line 530 of file format.c. References do_format(), and out_asgoto(). Referenced by do_format().
00532 {
00533 expptr expr;
00534
00535 expr = do_format (infile, outfile);
00536 out_asgoto (outfile, expr);
00537
00538 } /* do_p1_asgoto */
|
|
|
Definition at line 864 of file format.c. References ALLOC, err, errl(), mem(), STGNULL, TADDR, UNAM_CHARP, Addrblock::uname_tag, and Addrblock::user. Referenced by do_format().
00866 {
00867 Addrp addrp;
00868 int status;
00869 long vtype, vstg;
00870 char buf[64];
00871
00872 addrp = ALLOC (Addrblock);
00873 addrp -> tag = TADDR;
00874
00875 status = p1getd (infile, &vtype);
00876 if (status == EOF)
00877 err ("do_p1_ident: Missing identifier type at end of file\n");
00878 else if (status == 0 || vtype < 0 || vtype >= NTYPES)
00879 errl("do_p1_ident: Bad type in intermediate file: %ld\n", vtype);
00880 else
00881 addrp -> vtype = vtype;
00882
00883 status = p1getd (infile, &vstg);
00884 if (status == EOF)
00885 err ("do_p1_ident: Missing identifier storage at end of file\n");
00886 else if (status == 0 || vstg < 0 || vstg > STGNULL)
00887 errl("do_p1_ident: Bad storage in intermediate file: %ld\n", vtype);
00888 else
00889 addrp -> vstg = vstg;
00890
00891 status = p1gets(infile, buf, (int)sizeof(buf));
00892
00893 if (status == EOF)
00894 err ("do_p1_ident: Missing charp ident string at end of file");
00895 else if (status == 0)
00896 err ("do_p1_ident: Missing charp ident string in intermediate file");
00897 addrp->uname_tag = UNAM_CHARP;
00898 addrp->user.Charp = strcpy(mem(strlen(buf)+1,0), buf);
00899 return (expptr) addrp;
00900 }
|
|
||||||||||||
|
Definition at line 328 of file format.c. References c_output_line_length, COMMENT_BUFFER_SIZE, gflag, gflag1, in_comment, margin_printf(), and sharp_line. Referenced by do_format().
00330 {
00331 extern int c_output_line_length, in_comment;
00332
00333 char storage[COMMENT_BUFFER_SIZE + 1];
00334 int length;
00335
00336 if (!p1gets(infile, storage, COMMENT_BUFFER_SIZE + 1))
00337 return;
00338
00339 length = strlen (storage);
00340
00341 gflag1 = sharp_line = 0;
00342 in_comment = 1;
00343 if (length > c_output_line_length - 6)
00344 margin_printf(outfile, "/*%s*/\n", storage);
00345 else
00346 margin_printf(outfile, length ? "/* %s */\n" : "\n", storage);
00347 in_comment = 0;
00348 gflag1 = sharp_line = gflag;
00349 } /* do_p1_comment */
|
|
||||||||||||
|
Definition at line 698 of file format.c. References compgoto_out(), do_format(), ENULL, err, erri(), and TLIST. Referenced by do_format().
00700 {
00701 expptr index;
00702 expptr labels;
00703
00704 index = do_format (infile, outfile);
00705
00706 if (index == ENULL) {
00707 err ("do_p1_comp_goto: no expression for computed goto");
00708 return;
00709 } /* if index == ENULL */
00710
00711 labels = do_format (infile, outfile);
00712
00713 if (labels && labels -> tag != TLIST)
00714 erri ("do_p1_comp_goto: expected list, got tag '%d'", labels -> tag);
00715 else
00716 compgoto_out (outfile, index, labels);
00717 } /* do_p1_comp_goto */
|
|
|
Definition at line 404 of file format.c. Referenced by do_format().
00406 {
00407 struct Constblock *c = (struct Constblock *) NULL;
00408 long type = -1;
00409 int status;
00410
00411 status = p1getd (infile, &type);
00412
00413 if (status == EOF)
00414 err ("do_p1_const: Missing constant type at end of file\n");
00415 else if (status == 0)
00416 errl("do_p1_const: Illegal constant type in p1 file: %ld\n", type);
00417 else {
00418 status = p1get_const (infile, (int)type, &c);
00419
00420 if (status == EOF) {
00421 err ("do_p1_const: Missing constant value at end of file\n");
00422 c = (struct Constblock *) NULL;
00423 } else if (status == 0) {
00424 err ("do_p1_const: Illegal constant value in p1 file\n");
00425 c = (struct Constblock *) NULL;
00426 } /* else */
00427 } /* else */
00428 return (expptr) c;
00429 } /* do_p1_const */
|
|
||||||||||||
|
Definition at line 602 of file format.c. References do_format(), elif_out(), and ENULL. Referenced by do_format().
|
|
|
Definition at line 589 of file format.c. References out_else(). Referenced by do_format().
00591 {
00592 out_else (outfile);
00593 } /* do_p1_else */
|
|
|
Definition at line 743 of file format.c. References out_end_for(). Referenced by do_format().
00745 {
00746 out_end_for (outfile);
00747 } /* do_p1_end_for */
|
|
|
Definition at line 631 of file format.c. References end_else_out(). Referenced by do_format().
00633 {
00634 end_else_out (outfile);
00635 } /* do_p1_endelse */
|
|
|
Definition at line 619 of file format.c. References endif_out(). Referenced by do_format().
00621 {
00622 endif_out (outfile);
00623 } /* do_p1_endif */
|
|
||||||||||||
|
Definition at line 773 of file format.c. References ALLOC, do_format(), ENULL, err, errl(), is_binary_op, is_unary_op, and TEXPR. Referenced by do_format().
00775 {
00776 int status;
00777 long opcode, type;
00778 struct Exprblock *result = (struct Exprblock *) NULL;
00779
00780 status = p1getd (infile, &opcode);
00781
00782 if (status == EOF)
00783 err ("do_p1_expr: Missing expr opcode at end of file");
00784 else if (status == 0)
00785 err ("do_p1_expr: Missing expr opcode in p1 file");
00786 else {
00787
00788 status = p1getd (infile, &type);
00789
00790 if (status == EOF)
00791 err ("do_p1_expr: Missing expr type at end of file");
00792 else if (status == 0)
00793 err ("do_p1_expr: Missing expr type in p1 file");
00794 else if (opcode == 0)
00795 return ENULL;
00796 else {
00797 result = ALLOC (Exprblock);
00798
00799 result -> tag = TEXPR;
00800 result -> vtype = type;
00801 result -> opcode = opcode;
00802 result -> vleng = do_format (infile, outfile);
00803
00804 if (is_unary_op (opcode))
00805 result -> leftp = do_format (infile, outfile);
00806 else if (is_binary_op (opcode)) {
00807 result -> leftp = do_format (infile, outfile);
00808 result -> rightp = do_format (infile, outfile);
00809 } else
00810 errl("do_p1_expr: Illegal opcode %ld", opcode);
00811 } /* else */
00812 } /* else */
00813
00814 return (expptr) result;
00815 } /* do_p1_expr */
|
|
|
Definition at line 908 of file format.c. References ALLOC, CLPROC, err, Addrblock::memno, STGEXT, TADDR, Addrblock::tag, UNAM_EXTERN, Addrblock::uname_tag, Addrblock::vclass, Addrblock::vstg, and Addrblock::vtype. Referenced by do_format().
00910 {
00911 Addrp addrp;
00912
00913 addrp = ALLOC (Addrblock);
00914 if (addrp) {
00915 int status;
00916
00917 addrp->tag = TADDR;
00918 addrp->vstg = STGEXT;
00919 addrp->uname_tag = UNAM_EXTERN;
00920 status = p1getd (infile, &(addrp -> memno));
00921 if (status == EOF)
00922 err ("do_p1_extern: Missing memno at end of file");
00923 else if (status == 0)
00924 err ("do_p1_extern: Missing memno in intermediate file");
00925 if (addrp->vtype = extsymtab[addrp->memno].extype)
00926 addrp->vclass = CLPROC;
00927 } /* if addrp */
00928
00929 return (expptr) addrp;
00930 } /* do_p1_extern */
|
|
||||||||||||
|
Definition at line 726 of file format.c. References do_format(), and out_for(). Referenced by do_format().
|
|
||||||||||||
|
Definition at line 756 of file format.c. References P1_STMTBUFSIZE. Referenced by do_format().
00758 {
00759 char buf[P1_STMTBUFSIZE];
00760 if (!p1gets(infile, buf, P1_STMTBUFSIZE))
00761 return;
00762 /* bypass nice_printf nonsense */
00763 fprintf(outfile, "/*< %s >*/\n", buf+1); /* + 1 to skip by '$' */
00764 }
|
|
||||||||||||
|
Definition at line 547 of file format.c. References err, nice_printf(), and user_label(). Referenced by do_format().
00549 {
00550 int status;
00551 long stateno;
00552
00553 status = p1getd (infile, &stateno);
00554
00555 if (status == EOF)
00556 err ("do_p1_goto: Missing goto label at end of file");
00557 else if (status == 0)
00558 err ("do_p1_goto: Missing goto label in p1 file");
00559 else {
00560 nice_printf (outfile, "goto %s;\n", user_label (stateno));
00561 } /* else */
00562 } /* do_p1_goto */
|
|
||||||||||||
|
Definition at line 940 of file format.c. References c_type_decl(), CLBLOCK, CLMAIN, CLPROC, err, errl(), frchain(), length_comp(), list_arg_types(), listargs(), next_tab, nice_printf(), and this_proc_name. Referenced by do_format().
00942 {
00943 int status;
00944 int add_n_;
00945 long classKRH;
00946 char storage[256];
00947
00948 status = p1getd (infile, &classKRH);
00949 if (status == EOF)
00950 err ("do_p1_head: missing header class at end of file");
00951 else if (status == 0)
00952 err ("do_p1_head: missing header class in p1 file");
00953 else {
00954 status = p1gets (infile, storage, (int)sizeof(storage));
00955 if (status == EOF || status == 0)
00956 storage[0] = '\0';
00957 } /* else */
00958
00959 if (classKRH == CLPROC || classKRH == CLMAIN) {
00960 chainp lengths;
00961
00962 add_n_ = nentry > 1;
00963 lengths = length_comp(entries, add_n_);
00964
00965 if (!add_n_ && protofile && classKRH != CLMAIN)
00966 protowrite(protofile, proctype, storage, entries, lengths);
00967
00968 if (classKRH == CLMAIN)
00969 nice_printf (outfile, "/* Main program */ ");
00970 else
00971 nice_printf(outfile, "%s ", multitype ? "VOID"
00972 : c_type_decl(proctype, 1));
00973
00974 nice_printf(outfile, add_n_ ? "%s0_" : "%s", storage);
00975 if (!Ansi) {
00976 listargs(outfile, entries, add_n_, lengths);
00977 nice_printf (outfile, "\n");
00978 }
00979 list_arg_types (outfile, entries, lengths, add_n_, "\n");
00980 nice_printf (outfile, "{\n");
00981 frchain(&lengths);
00982 next_tab (outfile);
00983 strcpy(this_proc_name, storage);
00984 list_decls (outfile);
00985
00986 } else if (classKRH == CLBLOCK)
00987 next_tab (outfile);
00988 else
00989 errl("do_p1_head: got class %ld", classKRH);
00990
00991 return NULL;
00992 } /* do_p1_head */
|
|
|
Definition at line 823 of file format.c. References ALLOC, err, errl(), IDENT_LEN, STGNULL, TADDR, UNAM_IDENT, Addrblock::uname_tag, and Addrblock::user. Referenced by do_format().
00825 {
00826 Addrp addrp;
00827 int status;
00828 long vtype, vstg;
00829
00830 addrp = ALLOC (Addrblock);
00831 addrp -> tag = TADDR;
00832
00833 status = p1getd (infile, &vtype);
00834 if (status == EOF)
00835 err ("do_p1_ident: Missing identifier type at end of file\n");
00836 else if (status == 0 || vtype < 0 || vtype >= NTYPES)
00837 errl("do_p1_ident: Bad type in intermediate file: %ld\n", vtype);
00838 else
00839 addrp -> vtype = vtype;
00840
00841 status = p1getd (infile, &vstg);
00842 if (status == EOF)
00843 err ("do_p1_ident: Missing identifier storage at end of file\n");
00844 else if (status == 0 || vstg < 0 || vstg > STGNULL)
00845 errl("do_p1_ident: Bad storage in intermediate file: %ld\n", vtype);
00846 else
00847 addrp -> vstg = vstg;
00848
00849 status = p1gets(infile, addrp->user.ident, IDENT_LEN);
00850
00851 if (status == EOF)
00852 err ("do_p1_ident: Missing ident string at end of file");
00853 else if (status == 0)
00854 err ("do_p1_ident: Missing ident string in intermediate file");
00855 addrp->uname_tag = UNAM_IDENT;
00856 return (expptr) addrp;
00857 } /* do_p1_ident */
|
|
||||||||||||
|
Definition at line 571 of file format.c. References do_format(), ENULL, and out_if(). Referenced by do_format().
|
|
||||||||||||
|
Definition at line 492 of file format.c. References err, Labelblock::labused, last_was_label, margin_printf(), Labelblock::stateno, and user_label(). Referenced by do_format().
00494 {
00495 int status;
00496 ftnint stateno;
00497 struct Labelblock *L;
00498 char *fmt;
00499
00500 status = p1getd (infile, &stateno);
00501
00502 if (status == EOF)
00503 err ("do_p1_label: Missing label at end of file");
00504 else if (status == 0)
00505 err ("do_p1_label: Missing label in p1 file ");
00506 else if (stateno < 0) { /* entry */
00507 margin_printf(outfile, "\n%s:\n", user_label(stateno));
00508 last_was_label = 1;
00509 }
00510 else {
00511 L = labeltab + stateno;
00512 if (L->labused) {
00513 fmt = "%s:\n";
00514 last_was_label = 1;
00515 }
00516 else
00517 fmt = "/* %s: */\n";
00518 margin_printf(outfile, fmt, user_label(L->stateno));
00519 } /* else */
00520 } /* do_p1_label */
|
|
||||||||||||
|
Definition at line 1001 of file format.c. References ALLOC, CHNULL, do_format(), err, Expression::listblock, Listblock::listp, and mkchain(). Referenced by do_format().
01003 {
01004 long tag, type, count;
01005 int status;
01006 expptr result;
01007
01008 status = p1getd (infile, &tag);
01009 if (status == EOF)
01010 err ("do_p1_list: missing list tag at end of file");
01011 else if (status == 0)
01012 err ("do_p1_list: missing list tag in p1 file");
01013 else {
01014 status = p1getd (infile, &type);
01015 if (status == EOF)
01016 err ("do_p1_list: missing list type at end of file");
01017 else if (status == 0)
01018 err ("do_p1_list: missing list type in p1 file");
01019 else {
01020 status = p1getd (infile, &count);
01021 if (status == EOF)
01022 err ("do_p1_list: missing count at end of file");
01023 else if (status == 0)
01024 err ("do_p1_list: missing count in p1 file");
01025 } /* else */
01026 } /* else */
01027
01028 result = (expptr) ALLOC (Listblock);
01029 if (result) {
01030 chainp pointer;
01031
01032 result -> tag = tag;
01033 result -> listblock.vtype = type;
01034
01035 /* Assume there will be enough data */
01036
01037 if (count--) {
01038 pointer = result->listblock.listp =
01039 mkchain((char *)do_format(infile, outfile), CHNULL);
01040 while (count--) {
01041 pointer -> nextp =
01042 mkchain((char *)do_format(infile, outfile), CHNULL);
01043 pointer = pointer -> nextp;
01044 } /* while (count--) */
01045 } /* if (count) */
01046 } /* if (result) */
01047
01048 return result;
01049 } /* do_p1_list */
|
|
|
Definition at line 459 of file format.c. References addrlit(), ALLOC, err, TADDR, and UNAM_CONST. Referenced by do_format().
00461 {
00462 int status;
00463 long memno;
00464 Addrp addrp;
00465
00466 status = p1getd (infile, &memno);
00467
00468 if (status == EOF)
00469 err ("do_p1_literal: Missing memno at end of file");
00470 else if (status == 0)
00471 err ("do_p1_literal: Missing memno in p1 file");
00472 else {
00473 addrp = ALLOC (Addrblock);
00474 addrp -> tag = TADDR;
00475 addrp -> vtype = TYUNKNOWN;
00476 addrp -> Field = NULL;
00477 addrp -> memno = memno;
00478 addrlit(addrp);
00479 addrp -> uname_tag = UNAM_CONST;
00480 } /* else */
00481
00482 return (expptr) addrp;
00483 } /* do_p1_literal */
|
|
|
Definition at line 380 of file format.c. Referenced by do_format().
00382 {
00383 Namep namep = (Namep) NULL;
00384 int status;
00385
00386 status = p1getd (infile, (long *) &namep);
00387
00388 if (status == EOF)
00389 err ("do_p1_name_pointer: Missing pointer at end of file\n");
00390 else if (status == 0 || namep == (Namep) NULL)
00391 erri ("do_p1_name_pointer: Illegal name pointer in p1 file: '%x'\n",
00392 (int) namep);
00393
00394 return (expptr) namep;
00395 } /* do_p1_name_pointer */
|
|
|
Definition at line 356 of file format.c. Referenced by do_format().
00358 {
00359 int status;
00360 long new_line_number = -1;
00361
00362 status = p1getd (infile, &new_line_number);
00363
00364 if (status == EOF)
00365 err ("do_p1_set_line: Missing line number at end of file\n");
00366 else if (status == 0 || new_line_number == -1)
00367 errl("do_p1_set_line: Illegal line number in intermediate file: %ld\n",
00368 new_line_number);
00369 else {
00370 lineno = new_line_number;
00371 }
00372 } /* do_p1_set_line */
|
|
||||||||||||
|
Definition at line 676 of file format.c. References do_format(), expr_out(), nice_printf(), and retval(). Referenced by do_format().
00678 {
00679 expptr retval;
00680
00681 nice_printf (outfile, "return ");
00682 retval = do_format (infile, outfile);
00683 if (!multitype)
00684 if (retval)
00685 expr_out (outfile, retval);
00686
00687 nice_printf (outfile, ";\n");
00688 } /* do_p1_subr_ret */
|
|
||||||||||||
|
Definition at line 1058 of file format.c. References a, arg, Nameblock::arginfo, Extsym::arginfo, Entrypoint::arglist, args, Argtypes::atypes, CLPROC, CLUNKNOWN, CLVAR, Atype::cp, Chain::datap, Entrypoint::enamep, Entrypoint::entryname, frchain(), Nameblock::fvarname, mkchain(), Chain::nextp, revchain(), save_argtypes(), STGEXT, Atype::type, Nameblock::vclass, Nameblock::vimpltype, and Nameblock::vtype. Referenced by do_p1_head(), and putentries().
01061 {
01062 chainp lengths;
01063 chainp args, args1;
01064 Namep arg, np;
01065 int nchargs;
01066 Argtypes *at;
01067 Atype *a;
01068 extern int init_ac[TYSUBR+1];
01069
01070 if (!e)
01071 return 0; /* possible only with errors */
01072 args = args1 = add_n ? allargs : e->arglist;
01073 nchargs = 0;
01074 for (lengths = NULL; args; args = args -> nextp)
01075 if (arg = (Namep)args->datap) {
01076 if (arg->vclass == CLUNKNOWN)
01077 arg->vclass = CLVAR;
01078 if (arg->vtype == TYCHAR && arg->vclass != CLPROC) {
01079 lengths = mkchain((char *)arg, lengths);
01080 nchargs++;
01081 }
01082 }
01083 if (!add_n && (np = e->enamep)) {
01084 /* one last check -- by now we know all we ever will
01085 * about external args...
01086 */
01087 save_argtypes(e->arglist, &e->entryname->arginfo,
01088 &np->arginfo, 0, np->fvarname, STGEXT, nchargs,
01089 np->vtype, 1);
01090 at = e->entryname->arginfo;
01091 a = at->atypes + init_ac[np->vtype];
01092 for(; args1; a++, args1 = args1->nextp) {
01093 frchain(&a->cp);
01094 if (arg = (Namep)args1->datap)
01095 switch(arg->vclass) {
01096 case CLPROC:
01097 if (arg->vimpltype
01098 && a->type >= 300)
01099 a->type = TYUNKNOWN + 200;
01100 break;
01101 case CLUNKNOWN:
01102 a->type %= 100;
01103 }
01104 }
01105 }
01106 return revchain(lengths);
01107 }
|
|
||||||||||||||||||||||||
|
Definition at line 1176 of file format.c. References arg, Entrypoint::arglist, args, c_type_decl(), CLPROC, Chain::datap, err, MSKCHAR, MSKCOMPLEX, new_arg_length(), nice_printf(), ONEOF, out_name(), parens, and Nameblock::vimpltype. Referenced by do_p1_head(), and putentries().
01178 {
01179 chainp args;
01180 int last_type = -1, last_class = -1;
01181 int did_one = 0, done_one, is_ext;
01182 char *s, *sep = "", *sep1;
01183
01184 if (outfile == (FILE *) NULL) {
01185 err ("list_arg_types: null output file");
01186 return;
01187 } else if (entryp == (struct Entrypoint *) NULL) {
01188 err ("list_arg_types: null procedure entry pointer");
01189 return;
01190 } /* else */
01191
01192 if (Ansi) {
01193 done_one = 0;
01194 sep1 = ", ";
01195 nice_printf(outfile, "(" /*)*/);
01196 }
01197 else {
01198 done_one = 1;
01199 sep1 = ";\n";
01200 }
01201 args = entryp->arglist;
01202 if (add_n_) {
01203 nice_printf(outfile, "int n__");
01204 did_one = done_one;
01205 sep = sep1;
01206 args = allargs;
01207 }
01208 if (multitype) {
01209 nice_printf(outfile, "%sMultitype *ret_val", sep);
01210 did_one = done_one;
01211 sep = sep1;
01212 }
01213 else if (ONEOF (proctype, MSKCOMPLEX|MSKCHAR)) {
01214 s = xretslot[proctype]->user.ident;
01215 nice_printf(outfile, "%s%s *%s", sep, c_type_decl(proctype, 0),
01216 *s == '(' /*)*/ ? "r_v" : s);
01217 did_one = done_one;
01218 sep = sep1;
01219 if (proctype == TYCHAR)
01220 nice_printf (outfile, "%sftnlen ret_val_len", sep);
01221 } /* if ONEOF proctype */
01222 for (; args; args = args -> nextp) {
01223 Namep arg = (Namep) args->datap;
01224
01225 /* Scalars are passed by reference, and arrays will have their lower bound
01226 adjusted, so nearly everything is printed with a star in front. The
01227 exception is character lengths, which are passed by value. */
01228
01229 if (arg) {
01230 int type = arg -> vtype, classKRH = arg -> vclass;
01231
01232 if (classKRH == CLPROC)
01233 if (arg->vimpltype)
01234 type = Castargs ? TYUNKNOWN : TYSUBR;
01235 else if (type == TYREAL && forcedouble && !Castargs)
01236 type = TYDREAL;
01237
01238 if (type == last_type && classKRH == last_class && did_one)
01239 nice_printf (outfile, ", ");
01240 else
01241 if ((is_ext = classKRH == CLPROC) && Castargs)
01242 nice_printf(outfile, "%s%s ", sep,
01243 usedcasts[type] = casttypes[type]);
01244 else
01245 nice_printf(outfile, "%s%s ", sep,
01246 c_type_decl(type, is_ext));
01247 if (classKRH == CLPROC)
01248 if (Castargs)
01249 out_name(outfile, arg);
01250 else {
01251 nice_printf(outfile, "(*");
01252 out_name(outfile, arg);
01253 nice_printf(outfile, ") %s", parens);
01254 }
01255 else {
01256 nice_printf (outfile, "*");
01257 out_name (outfile, arg);
01258 }
01259
01260 last_type = type;
01261 last_class = classKRH;
01262 did_one = done_one;
01263 sep = sep1;
01264 } /* if (arg) */
01265 } /* for args = entryp -> arglist */
01266
01267 for (args = lengths; args; args = args -> nextp)
01268 nice_printf(outfile, "%sftnlen %s", sep,
01269 new_arg_length((Namep)args->datap));
01270 if (did_one)
01271 nice_printf (outfile, ";\n");
01272 else if (Ansi)
01273 nice_printf(outfile,
01274 /*((*/ sep != sep1 && Ansi == 1 ? "void)%s" : ")%s",
01275 finalnl);
01276 } /* list_arg_types */
|
|
||||||||||||||||||||
|
Definition at line 1117 of file format.c. References arg, Entrypoint::arglist, args, Chain::datap, MSKCHAR, MSKCOMPLEX, new_arg_length(), nice_printf(), ONEOF, and out_name(). Referenced by do_p1_head(), and putentries().
01119 {
01120 chainp args;
01121 char *s;
01122 Namep arg;
01123 int did_one = 0;
01124
01125 nice_printf (outfile, "(");
01126
01127 if (add_n_) {
01128 nice_printf(outfile, "n__");
01129 did_one = 1;
01130 args = allargs;
01131 }
01132 else {
01133 if (!entryp)
01134 return; /* possible only with errors */
01135 args = entryp->arglist;
01136 }
01137
01138 if (multitype)
01139 {
01140 nice_printf(outfile, ", ret_val");
01141 did_one = 1;
01142 args = allargs;
01143 }
01144 else if (ONEOF(proctype, MSKCOMPLEX|MSKCHAR))
01145 {
01146 s = xretslot[proctype]->user.ident;
01147 nice_printf(outfile, did_one ? ", %s" : "%s",
01148 *s == '(' /*)*/ ? "r_v" : s);
01149 did_one = 1;
01150 if (proctype == TYCHAR)
01151 nice_printf (outfile, ", ret_val_len");
01152 }
01153 for (; args; args = args -> nextp)
01154 if (arg = (Namep)args->datap) {
01155 nice_printf (outfile, "%s", did_one ? ", " : "");
01156 out_name (outfile, arg);
01157 did_one = 1;
01158 }
01159
01160 for (args = lengths; args; args = args -> nextp)
01161 nice_printf(outfile, ", %s",
01162 new_arg_length((Namep)args->datap));
01163 nice_printf (outfile, ")");
01164 } /* listargs */
|
|
|
Definition at line 174 of file format.c. References last_was_label, and nice_printf().
00176 {
00177 nice_printf (outfile, ";\n");
00178 last_was_label = 0;
00179 }
|
|
|
Definition at line 87 of file format.c. References CHNULL, do_format(), err, Extsym::extp, Fatal(), ffilecopy(), gflag1, last_was_label, nice_printf(), other_undefs(), out_and_free_statement(), prev_tab, scrub, sharp_line, STGCOMMON, this_proc_name, usedefsforcommon, and wr_abbrevs(). Referenced by endproc().
00088 {
00089 FILE *infile;
00090 static int wrote_one = 0;
00091 extern int usedefsforcommon;
00092 extern char *p1_file, *p1_bakfile;
00093
00094 this_proc_name[0] = '\0';
00095 last_was_label = 0;
00096 ei_next = ei_first;
00097 wh_next = wh_first;
00098
00099 (void) fclose (pass1_file);
00100 if ((infile = fopen (p1_file, binread)) == NULL)
00101 Fatal("start_formatting: couldn't open the intermediate file\n");
00102
00103 if (wrote_one)
00104 nice_printf (c_file, "\n");
00105
00106 while (!feof (infile)) {
00107 expptr this_expr;
00108
00109 this_expr = do_format (infile, c_file);
00110 if (this_expr) {
00111 out_and_free_statement (c_file, this_expr);
00112 } /* if this_expr */
00113 } /* while !feof infile */
00114
00115 (void) fclose (infile);
00116
00117 if (last_was_label)
00118 nice_printf (c_file, ";\n");
00119
00120 prev_tab (c_file);
00121 gflag1 = sharp_line = 0;
00122 if (this_proc_name[0])
00123 nice_printf (c_file, "} /* %s */\n", this_proc_name);
00124
00125
00126 /* Write the #undefs for common variable reference */
00127
00128 if (usedefsforcommon) {
00129 Extsym *ext;
00130 int did_one = 0;
00131
00132 for (ext = extsymtab; ext < nextext; ext++)
00133 if (ext -> extstg == STGCOMMON && ext -> used_here) {
00134 ext -> used_here = 0;
00135 if (!did_one)
00136 nice_printf (c_file, "\n");
00137 wr_abbrevs(c_file, 0, ext->extp);
00138 did_one = 1;
00139 ext -> extp = CHNULL;
00140 } /* if */
00141
00142 if (did_one)
00143 nice_printf (c_file, "\n");
00144 } /* if usedefsforcommon */
00145
00146 other_undefs(c_file);
00147
00148 wrote_one = 1;
00149
00150 /* For debugging only */
00151
00152 if (debugflag && (pass1_file = fopen (p1_bakfile, binwrite)))
00153 if (infile = fopen (p1_file, binread)) {
00154 ffilecopy (infile, pass1_file);
00155 fclose (infile);
00156 fclose (pass1_file);
00157 } /* if infile */
00158
00159 /* End of "debugging only" */
00160
00161 scrub(p1_file); /* optionally unlink */
00162
00163 if ((pass1_file = fopen (p1_file, binwrite)) == NULL)
00164 err ("start_formatting: couldn't reopen the pass1 file");
00165
00166 } /* start_formatting */
|
|
|
Definition at line 1377 of file format.c. References c.
|
|
|
Definition at line 1345 of file format.c. References Chain::datap, Nameblock::fvarname, Chain::nextp, nice_printf(), revchain(), STGAUTO, and Nameblock::vstg.
01347 {
01348 register chainp cp;
01349 Namep np;
01350 char *comma, *type;
01351 int did_one = 0;
01352
01353 cp = assigned_fmts = revchain(assigned_fmts);
01354 nice_printf(outfile, "/* Assigned format variables */\n");
01355 do {
01356 np = (Namep)cp->datap;
01357 if (did_one == np->vstg) {
01358 comma = ", ";
01359 type = "";
01360 }
01361 else {
01362 comma = did_one ? ";\n" : "";
01363 type = np->vstg == STGAUTO ? "char " : "static char ";
01364 did_one = np->vstg;
01365 }
01366 nice_printf(outfile, "%s%s*%s_fmt", comma, type, np->fvarname);
01367 }
01368 while(cp = cp->nextp);
01369 nice_printf(outfile, ";\n\n");
01370 }
|
|
|
Definition at line 1283 of file format.c. References Labelblock::fmtlabused, Labelblock::fmtstring, nice_printf(), and Labelblock::stateno.
01285 {
01286 register struct Labelblock *lp;
01287 int first = 1;
01288 char *fs;
01289
01290 for(lp = labeltab ; lp < highlabtab ; ++lp)
01291 if (lp->fmtlabused) {
01292 if (first) {
01293 first = 0;
01294 nice_printf(outfile, "/* Format strings */\n");
01295 }
01296 nice_printf(outfile, "static char fmt_%ld[] = \"",
01297 lp->stateno);
01298 if (!(fs = lp->fmtstring))
01299 fs = "";
01300 nice_printf(outfile, "%s\";\n", fs);
01301 }
01302 if (!first)
01303 nice_printf(outfile, "\n");
01304 }
|
|
|
Definition at line 1311 of file format.c. References iob_data::fields, L, iob_data::name, iob_data::next, nice_printf(), revchain(), and iob_data::type.
01313 {
01314 register iob_data *L;
01315 register char *f, **s, *sep;
01316
01317 nice_printf(outfile, "/* Fortran I/O blocks */\n");
01318 L = iob_list = (iob_data *)revchain((chainp)iob_list);
01319 do {
01320 nice_printf(outfile, "static %s %s = { ",
01321 L->type, L->name);
01322 sep = 0;
01323 for(s = L->fields; f = *s; s++) {
01324 if (sep)
01325 nice_printf(outfile, sep);
01326 sep = ", ";
01327 if (*f == '"') { /* kludge */
01328 nice_printf(outfile, "\"");
01329 nice_printf(outfile, "%s\"", f+1);
01330 }
01331 else
01332 nice_printf(outfile, "%s", f);
01333 }
01334 nice_printf(outfile, " };\n");
01335 }
01336 while(L = L->next);
01337 nice_printf(outfile, "\n\n");
01338 }
|
Variable Documentation
|
|
|
|
|
Definition at line 35 of file format.c. Referenced by do_p1_comment(). |
|
|
|
|
|
Definition at line 82 of file format.c. Referenced by do_format(), and do_p1_comment(). |
|
|
Definition at line 83 of file format.c. Referenced by do_format(), do_p1_comment(), ind_printf(), and start_formatting(). |
|
|
Definition at line 37 of file format.c. Referenced by do_format(), do_p1_label(), output_rbrace(), put_semi(), and start_formatting(). |
|
|
Definition at line 84 of file format.c. Referenced by list_arg_types(), and main(). |
|
|
Definition at line 82 of file format.c. Referenced by do_format(), do_p1_comment(), ind_printf(), start_formatting(), and write_indent(). |
|
|
Definition at line 39 of file format.c. Referenced by do_p1_head(), and start_formatting(). |
