1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)p2put.c 1.13 02/28/83"; 4 5 /* 6 * functions to help pi put out 7 * polish postfix binary portable c compiler intermediate code 8 * thereby becoming the portable pascal compiler 9 */ 10 11 #include "whoami.h" 12 #ifdef PC 13 #include "0.h" 14 #include "objfmt.h" 15 #include "pcops.h" 16 #include "pc.h" 17 #include "align.h" 18 #include "tmps.h" 19 20 /* 21 * mash into f77's format 22 * lovely, isn't it? 23 */ 24 #define TOF77( fop,val,rest ) ( ( ( (rest) & 0177777 ) << 16 ) \ 25 | ( ( (val) & 0377 ) << 8 ) \ 26 | ( (fop) & 0377 ) ) 27 28 /* 29 * emits an ftext operator and a string to the pcstream 30 */ 31 puttext( string ) 32 char *string; 33 { 34 int length = str4len( string ); 35 36 if ( !CGENNING ) 37 return; 38 p2word( TOF77( P2FTEXT , length , 0 ) ); 39 # ifdef DEBUG 40 if ( opt( 'k' ) ) { 41 fprintf( stdout , "P2FTEXT | %3d | 0 " , length ); 42 } 43 # endif 44 p2string( string ); 45 } 46 47 int 48 str4len( string ) 49 char *string; 50 { 51 52 return ( ( strlen( string ) + 3 ) / 4 ); 53 } 54 55 /* 56 * put formatted text into a buffer for printing to the pcstream. 57 * a call to putpflush actually puts out the text. 58 * none of arg1 .. arg5 need be present. 59 * and you can add more if you need them. 60 */ 61 /* VARARGS */ 62 putprintf( format , incomplete , arg1 , arg2 , arg3 , arg4 , arg5 ) 63 char *format; 64 int incomplete; 65 { 66 static char ppbuffer[ BUFSIZ ]; 67 static char *ppbufp = ppbuffer; 68 69 if ( !CGENNING ) 70 return; 71 sprintf( ppbufp , format , arg1 , arg2 , arg3 , arg4 , arg5 ); 72 ppbufp = &( ppbuffer[ strlen( ppbuffer ) ] ); 73 if ( ppbufp >= &( ppbuffer[ BUFSIZ ] ) ) 74 panic( "putprintf" ); 75 if ( ! incomplete ) { 76 puttext( ppbuffer ); 77 ppbufp = ppbuffer; 78 } 79 } 80 81 /* 82 * emit a left bracket operator to pcstream 83 * with function number, the maximum temp register, and total local bytes 84 */ 85 putlbracket(ftnno, sizesp) 86 int ftnno; 87 struct om *sizesp; 88 { 89 int maxtempreg; 90 int alignedframesize; 91 92 # ifdef vax 93 maxtempreg = sizesp->curtmps.next_avail[REG_GENERAL]; 94 # endif vax 95 # ifdef mc68000 96 /* 97 * this is a5 and d7 mashed together. 98 */ 99 maxtempreg = (5 << 4) | (7); 100 # endif mc68000 101 alignedframesize = 102 roundup(BITSPERBYTE * -sizesp->curtmps.om_off, BITSPERBYTE * A_STACK); 103 p2word( TOF77( P2FLBRAC , maxtempreg , ftnno ) ); 104 p2word(alignedframesize); 105 # ifdef DEBUG 106 if ( opt( 'k' ) ) { 107 fprintf(stdout, "P2FLBRAC | %3d | %d %d\n", 108 maxtempreg, ftnno, alignedframesize); 109 } 110 # endif 111 } 112 113 /* 114 * emit a right bracket operator 115 * which for the binary (fortran) interface 116 * forces the stack allocate and register mask 117 */ 118 putrbracket( ftnno ) 119 int ftnno; 120 { 121 122 p2word( TOF77( P2FRBRAC , 0 , ftnno ) ); 123 # ifdef DEBUG 124 if ( opt( 'k' ) ) { 125 fprintf( stdout , "P2FRBRAC | 0 | %d\n" , ftnno ); 126 } 127 # endif 128 } 129 130 /* 131 * emit an eof operator 132 */ 133 puteof() 134 { 135 136 p2word( P2FEOF ); 137 # ifdef DEBUG 138 if ( opt( 'k' ) ) { 139 fprintf( stdout , "P2FEOF\n" ); 140 } 141 # endif 142 } 143 144 /* 145 * emit a dot operator, 146 * with a source file line number and name 147 * if line is negative, there was an error on that line, but who cares? 148 */ 149 putdot( filename , line ) 150 char *filename; 151 int line; 152 { 153 int length = str4len( filename ); 154 155 if ( line < 0 ) { 156 line = -line; 157 } 158 p2word( TOF77( P2FEXPR , length , line ) ); 159 # ifdef DEBUG 160 if ( opt( 'k' ) ) { 161 fprintf( stdout , "P2FEXPR | %3d | %d " , length , line ); 162 } 163 # endif 164 p2string( filename ); 165 } 166 167 /* 168 * put out a leaf node 169 */ 170 putleaf( op , lval , rval , type , name ) 171 int op; 172 int lval; 173 int rval; 174 int type; 175 char *name; 176 { 177 if ( !CGENNING ) 178 return; 179 switch ( op ) { 180 default: 181 panic( "[putleaf]" ); 182 case P2ICON: 183 p2word( TOF77( P2ICON , name != NIL , type ) ); 184 p2word( lval ); 185 # ifdef DEBUG 186 if ( opt( 'k' ) ) { 187 fprintf( stdout , "P2ICON | %3d | 0x%x " 188 , name != NIL , type ); 189 fprintf( stdout , "%d\n" , lval ); 190 } 191 # endif 192 if ( name ) 193 p2name( name ); 194 break; 195 case P2NAME: 196 p2word( TOF77( P2NAME , lval != 0 , type ) ); 197 if ( lval ) 198 p2word( lval ); 199 # ifdef DEBUG 200 if ( opt( 'k' ) ) { 201 fprintf( stdout , "P2NAME | %3d | 0x%x " 202 , lval != 0 , type ); 203 if ( lval ) 204 fprintf( stdout , "%d " , lval ); 205 } 206 # endif 207 p2name( name ); 208 break; 209 case P2REG: 210 p2word( TOF77( P2REG , rval , type ) ); 211 # ifdef DEBUG 212 if ( opt( 'k' ) ) { 213 fprintf( stdout , "P2REG | %3d | 0x%x\n" , 214 rval , type ); 215 } 216 # endif 217 break; 218 } 219 } 220 221 /* 222 * rvalues are just lvalues with indirection, except 223 * special cases for registers and for named globals, 224 * whose names are their rvalues. 225 */ 226 putRV( name , level , offset , other_flags , type ) 227 char *name; 228 int level; 229 int offset; 230 char other_flags; 231 int type; 232 { 233 char extname[ BUFSIZ ]; 234 char *printname; 235 int regnumber; 236 237 if ( !CGENNING ) 238 return; 239 if ( other_flags & NREGVAR ) { 240 if ( ( offset < 0 ) || ( offset > P2FP ) ) { 241 panic( "putRV regvar" ); 242 } 243 putleaf( P2REG , 0 , offset , type , 0 ); 244 return; 245 } 246 if ( whereis( level , offset , other_flags ) == GLOBALVAR ) { 247 if ( name != 0 ) { 248 if ( name[0] != '_' ) { 249 sprintf( extname , EXTFORMAT , name ); 250 printname = extname; 251 } else { 252 printname = name; 253 } 254 putleaf( P2NAME , offset , 0 , type , printname ); 255 return; 256 } else { 257 panic( "putRV no name" ); 258 } 259 } 260 putLV( name , level , offset , other_flags , type ); 261 putop( P2UNARY P2MUL , type ); 262 } 263 264 /* 265 * put out an lvalue 266 * given a level and offset 267 * special case for 268 * named globals, whose lvalues are just their names as constants. 269 */ 270 putLV( name , level , offset , other_flags , type ) 271 char *name; 272 int level; 273 int offset; 274 char other_flags; 275 int type; 276 { 277 char extname[ BUFSIZ ]; 278 char *printname; 279 280 if ( !CGENNING ) 281 return; 282 if ( other_flags & NREGVAR ) { 283 panic( "putLV regvar" ); 284 } 285 switch ( whereis( level , offset , other_flags ) ) { 286 case GLOBALVAR: 287 if ( ( name != 0 ) ) { 288 if ( name[0] != '_' ) { 289 sprintf( extname , EXTFORMAT , name ); 290 printname = extname; 291 } else { 292 printname = name; 293 } 294 putleaf( P2ICON , offset , 0 , ADDTYPE( type , P2PTR ) 295 , printname ); 296 return; 297 } else { 298 panic( "putLV no name" ); 299 } 300 case PARAMVAR: 301 if ( level == cbn ) { 302 putleaf( P2REG , 0 , P2AP , ADDTYPE( type , P2PTR ) , 0 ); 303 } else { 304 putleaf( P2NAME , (level * sizeof(struct dispsave)) + AP_OFFSET 305 , 0 , P2PTR | P2CHAR , DISPLAYNAME ); 306 parts[ level ] |= NONLOCALVAR; 307 } 308 putleaf( P2ICON , offset , 0 , P2INT , 0 ); 309 putop( P2PLUS , P2PTR | P2CHAR ); 310 break; 311 case LOCALVAR: 312 if ( level == cbn ) { 313 putleaf( P2REG , 0 , P2FP , ADDTYPE( type , P2PTR ) , 0 ); 314 } else { 315 putleaf( P2NAME , (level * sizeof(struct dispsave)) + FP_OFFSET 316 , 0 , P2PTR | P2CHAR , DISPLAYNAME ); 317 parts[ level ] |= NONLOCALVAR; 318 } 319 putleaf( P2ICON , -offset , 0 , P2INT , 0 ); 320 putop( P2MINUS , P2PTR | P2CHAR ); 321 break; 322 case NAMEDLOCALVAR: 323 if ( level == cbn ) { 324 putleaf( P2REG , 0 , P2FP , ADDTYPE( type , P2PTR ) , 0 ); 325 } else { 326 putleaf( P2NAME , (level * sizeof(struct dispsave)) + FP_OFFSET 327 , 0 , P2PTR | P2CHAR , DISPLAYNAME ); 328 parts[ level ] |= NONLOCALVAR; 329 } 330 putleaf( P2ICON , 0 , 0 , P2INT , name ); 331 putop( P2MINUS , P2PTR | P2CHAR ); 332 break; 333 } 334 return; 335 } 336 337 /* 338 * put out a floating point constant leaf node 339 * the constant is declared in aligned data space 340 * and a P2NAME leaf put out for it 341 */ 342 putCON8( val ) 343 double val; 344 { 345 int label; 346 char name[ BUFSIZ ]; 347 348 if ( !CGENNING ) 349 return; 350 label = getlab(); 351 putprintf( " .data" , 0 ); 352 aligndot(A_DOUBLE); 353 putlab( label ); 354 # ifdef vax 355 putprintf( " .double 0d%.20e" , 0 , val ); 356 # endif vax 357 # ifdef mc68000 358 putprintf( " .long 0x%x,0x%x", 0, val); 359 # endif mc68000 360 putprintf( " .text" , 0 ); 361 sprintf( name , PREFIXFORMAT , LABELPREFIX , label ); 362 putleaf( P2NAME , 0 , 0 , P2DOUBLE , name ); 363 } 364 365 /* 366 * put out either an lvalue or an rvalue for a constant string. 367 * an lvalue (for assignment rhs's) is the name as a constant, 368 * an rvalue (for parameters) is just the name. 369 */ 370 putCONG( string , length , required ) 371 char *string; 372 int length; 373 int required; 374 { 375 char name[ BUFSIZ ]; 376 int label; 377 char *cp; 378 int pad; 379 int others; 380 381 if ( !CGENNING ) 382 return; 383 putprintf( " .data" , 0 ); 384 aligndot(A_STRUCT); 385 label = getlab(); 386 putlab( label ); 387 cp = string; 388 while ( *cp ) { 389 putprintf( " .byte 0%o" , 1 , *cp ++ ); 390 for ( others = 2 ; ( others <= 8 ) && *cp ; others ++ ) { 391 putprintf( ",0%o" , 1 , *cp++ ); 392 } 393 putprintf( "" , 0 ); 394 } 395 pad = length - strlen( string ); 396 while ( pad-- > 0 ) { 397 putprintf( " .byte 0%o" , 1 , ' ' ); 398 for ( others = 2 ; ( others <= 8 ) && ( pad-- > 0 ) ; others++ ) { 399 putprintf( ",0%o" , 1 , ' ' ); 400 } 401 putprintf( "" , 0 ); 402 } 403 putprintf( " .byte 0" , 0 ); 404 putprintf( " .text" , 0 ); 405 sprintf( name , PREFIXFORMAT , LABELPREFIX , label ); 406 if ( required == RREQ ) { 407 putleaf( P2NAME , 0 , 0 , P2ARY | P2CHAR , name ); 408 } else { 409 putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR , name ); 410 } 411 } 412 413 /* 414 * map a pascal type to a c type 415 * this would be tail recursive, but i unfolded it into a for (;;). 416 * this is sort of like isa and lwidth 417 * a note on the types used by the portable c compiler: 418 * they are divided into a basic type (char, short, int, long, etc.) 419 * and qualifications on those basic types (pointer, function, array). 420 * the basic type is kept in the low 4 bits of the type descriptor, 421 * and the qualifications are arranged in two bit chunks, with the 422 * most significant on the right, 423 * and the least significant on the left 424 * e.g. int *foo(); 425 * (a function returning a pointer to an integer) 426 * is stored as 427 * <ptr><ftn><int> 428 * so, we build types recursively 429 * also, we know that /lib/f1 can only deal with 6 qualifications 430 * so we stop the recursion there. this stops infinite type recursion 431 * through mutually recursive pointer types. 432 */ 433 #define MAXQUALS 6 434 int 435 p2type( np ) 436 { 437 438 return typerecur( np , 0 ); 439 } 440 typerecur( np , quals ) 441 struct nl *np; 442 int quals; 443 { 444 445 if ( np == NIL || quals > MAXQUALS ) { 446 return P2UNDEF; 447 } 448 switch ( np -> class ) { 449 case SCAL : 450 case RANGE : 451 if ( np -> type == ( nl + TDOUBLE ) ) { 452 return P2DOUBLE; 453 } 454 switch ( bytes( np -> range[0] , np -> range[1] ) ) { 455 case 1: 456 return P2CHAR; 457 case 2: 458 return P2SHORT; 459 case 4: 460 return P2INT; 461 default: 462 panic( "p2type int" ); 463 } 464 case STR : 465 return ( P2ARY | P2CHAR ); 466 case RECORD : 467 case SET : 468 return P2STRTY; 469 case FILET : 470 return ( P2PTR | P2STRTY ); 471 case CONST : 472 case VAR : 473 case FIELD : 474 return p2type( np -> type ); 475 case TYPE : 476 switch ( nloff( np ) ) { 477 case TNIL : 478 return ( P2PTR | P2UNDEF ); 479 case TSTR : 480 return ( P2ARY | P2CHAR ); 481 case TSET : 482 return P2STRTY; 483 default : 484 return ( p2type( np -> type ) ); 485 } 486 case REF: 487 case WITHPTR: 488 case PTR : 489 return ADDTYPE( typerecur( np -> type , quals + 1 ) , P2PTR ); 490 case ARRAY : 491 return ADDTYPE( typerecur( np -> type , quals + 1 ) , P2ARY ); 492 case FUNC : 493 /* 494 * functions are really pointers to functions 495 * which return their underlying type. 496 */ 497 return ADDTYPE( ADDTYPE( typerecur( np -> type , quals + 2 ) , 498 P2FTN ) , P2PTR ); 499 case PROC : 500 /* 501 * procedures are pointers to functions 502 * which return integers (whether you look at them or not) 503 */ 504 return ADDTYPE( ADDTYPE( P2INT , P2FTN ) , P2PTR ); 505 case FFUNC : 506 case FPROC : 507 /* 508 * formal procedures and functions are pointers 509 * to structures which describe their environment. 510 */ 511 return ( P2PTR | P2STRTY ); 512 default : 513 panic( "p2type" ); 514 } 515 } 516 517 /* 518 * add a most significant type modifier to a type 519 */ 520 long 521 addtype( underlying , mtype ) 522 long underlying; 523 long mtype; 524 { 525 return ( ( ( underlying & ~P2BASETYPE ) << P2TYPESHIFT ) 526 | mtype 527 | ( underlying & P2BASETYPE ) ); 528 } 529 530 /* 531 * put a typed operator to the pcstream 532 */ 533 putop( op , type ) 534 int op; 535 int type; 536 { 537 extern char *p2opnames[]; 538 539 if ( !CGENNING ) 540 return; 541 p2word( TOF77( op , 0 , type ) ); 542 # ifdef DEBUG 543 if ( opt( 'k' ) ) { 544 fprintf( stdout , "%s (%d) | 0 | 0x%x\n" 545 , p2opnames[ op ] , op , type ); 546 } 547 # endif 548 } 549 550 /* 551 * put out a structure operator (STASG, STARG, STCALL, UNARY STCALL ) 552 * which looks just like a regular operator, only the size and 553 * alignment go in the next consecutive words 554 */ 555 putstrop( op , type , size , alignment ) 556 int op; 557 int type; 558 int size; 559 int alignment; 560 { 561 extern char *p2opnames[]; 562 563 if ( !CGENNING ) 564 return; 565 p2word( TOF77( op , 0 , type ) ); 566 p2word( size ); 567 p2word( alignment ); 568 # ifdef DEBUG 569 if ( opt( 'k' ) ) { 570 fprintf( stdout , "%s (%d) | 0 | 0x%x %d %d\n" 571 , p2opnames[ op ] , op , type , size , alignment ); 572 } 573 # endif 574 } 575 576 /* 577 * the string names of p2ops 578 */ 579 char *p2opnames[] = { 580 "", 581 "P2UNDEFINED", /* 1 */ 582 "P2NAME", /* 2 */ 583 "P2STRING", /* 3 */ 584 "P2ICON", /* 4 */ 585 "P2FCON", /* 5 */ 586 "P2PLUS", /* 6 */ 587 "", 588 "P2MINUS", /* 8 also unary == P2NEG */ 589 "", 590 "P2NEG", 591 "P2MUL", /* 11 also unary == P2INDIRECT */ 592 "", 593 "P2INDIRECT", 594 "P2AND", /* 14 also unary == P2ADDROF */ 595 "", 596 "P2ADDROF", 597 "P2OR", /* 17 */ 598 "", 599 "P2ER", /* 19 */ 600 "", 601 "P2QUEST", /* 21 */ 602 "P2COLON", /* 22 */ 603 "P2ANDAND", /* 23 */ 604 "P2OROR", /* 24 */ 605 "", /* 25 */ 606 "", /* 26 */ 607 "", /* 27 */ 608 "", /* 28 */ 609 "", /* 29 */ 610 "", /* 30 */ 611 "", /* 31 */ 612 "", /* 32 */ 613 "", /* 33 */ 614 "", /* 34 */ 615 "", /* 35 */ 616 "", /* 36 */ 617 "", /* 37 */ 618 "", /* 38 */ 619 "", /* 39 */ 620 "", /* 40 */ 621 "", /* 41 */ 622 "", /* 42 */ 623 "", /* 43 */ 624 "", /* 44 */ 625 "", /* 45 */ 626 "", /* 46 */ 627 "", /* 47 */ 628 "", /* 48 */ 629 "", /* 49 */ 630 "", /* 50 */ 631 "", /* 51 */ 632 "", /* 52 */ 633 "", /* 53 */ 634 "", /* 54 */ 635 "", /* 55 */ 636 "P2LISTOP", /* 56 */ 637 "", 638 "P2ASSIGN", /* 58 */ 639 "P2COMOP", /* 59 */ 640 "P2DIV", /* 60 */ 641 "", 642 "P2MOD", /* 62 */ 643 "", 644 "P2LS", /* 64 */ 645 "", 646 "P2RS", /* 66 */ 647 "", 648 "P2DOT", /* 68 */ 649 "P2STREF", /* 69 */ 650 "P2CALL", /* 70 also unary */ 651 "", 652 "P2UNARYCALL", 653 "P2FORTCALL", /* 73 also unary */ 654 "", 655 "P2UNARYFORTCALL", 656 "P2NOT", /* 76 */ 657 "P2COMPL", /* 77 */ 658 "P2INCR", /* 78 */ 659 "P2DECR", /* 79 */ 660 "P2EQ", /* 80 */ 661 "P2NE", /* 81 */ 662 "P2LE", /* 82 */ 663 "P2LT", /* 83 */ 664 "P2GE", /* 84 */ 665 "P2GT", /* 85 */ 666 "P2ULE", /* 86 */ 667 "P2ULT", /* 87 */ 668 "P2UGE", /* 88 */ 669 "P2UGT", /* 89 */ 670 "P2SETBIT", /* 90 */ 671 "P2TESTBIT", /* 91 */ 672 "P2RESETBIT", /* 92 */ 673 "P2ARS", /* 93 */ 674 "P2REG", /* 94 */ 675 "P2OREG", /* 95 */ 676 "P2CCODES", /* 96 */ 677 "P2FREE", /* 97 */ 678 "P2STASG", /* 98 */ 679 "P2STARG", /* 99 */ 680 "P2STCALL", /* 100 also unary */ 681 "", 682 "P2UNARYSTCALL", 683 "P2FLD", /* 103 */ 684 "P2SCONV", /* 104 */ 685 "P2PCONV", /* 105 */ 686 "P2PMCONV", /* 106 */ 687 "P2PVCONV", /* 107 */ 688 "P2FORCE", /* 108 */ 689 "P2CBRANCH", /* 109 */ 690 "P2INIT", /* 110 */ 691 "P2CAST", /* 111 */ 692 }; 693 694 /* 695 * low level routines 696 */ 697 698 /* 699 * puts a long word on the pcstream 700 */ 701 p2word( word ) 702 long word; 703 { 704 705 putw( word , pcstream ); 706 } 707 708 /* 709 * put a length 0 mod 4 null padded string onto the pcstream 710 */ 711 p2string( string ) 712 char *string; 713 { 714 int slen = strlen( string ); 715 int wlen = ( slen + 3 ) / 4; 716 int plen = ( wlen * 4 ) - slen; 717 char *cp; 718 int p; 719 720 for ( cp = string ; *cp ; cp++ ) 721 putc( *cp , pcstream ); 722 for ( p = 1 ; p <= plen ; p++ ) 723 putc( '\0' , pcstream ); 724 # ifdef DEBUG 725 if ( opt( 'k' ) ) { 726 fprintf( stdout , "\"%s" , string ); 727 for ( p = 1 ; p <= plen ; p++ ) 728 fprintf( stdout , "\\0" ); 729 fprintf( stdout , "\"\n" ); 730 } 731 # endif 732 } 733 734 /* 735 * puts a name on the pcstream 736 */ 737 p2name( name ) 738 char *name; 739 { 740 int pad; 741 742 fprintf( pcstream , NAMEFORMAT , name ); 743 pad = strlen( name ) % sizeof (long); 744 for ( ; pad < sizeof (long) ; pad++ ) { 745 putc( '\0' , pcstream ); 746 } 747 # ifdef DEBUG 748 if ( opt( 'k' ) ) { 749 fprintf( stdout , NAMEFORMAT , name ); 750 pad = strlen( name ) % sizeof (long); 751 for ( ; pad < sizeof (long) ; pad++ ) { 752 fprintf( stdout , "\\0" ); 753 } 754 fprintf( stdout , "\n" ); 755 } 756 # endif 757 } 758 759 /* 760 * put out a jump to a label 761 */ 762 putjbr( label ) 763 long label; 764 { 765 766 printjbr( LABELPREFIX , label ); 767 } 768 769 /* 770 * put out a jump to any kind of label 771 */ 772 printjbr( prefix , label ) 773 char *prefix; 774 long label; 775 { 776 777 # ifdef vax 778 putprintf( " jbr " , 1 ); 779 putprintf( PREFIXFORMAT , 0 , prefix , label ); 780 # endif vax 781 # ifdef mc68000 782 putprintf( " jra " , 1 ); 783 putprintf( PREFIXFORMAT , 0 , prefix , label ); 784 # endif mc68000 785 } 786 787 /* 788 * another version of put to catch calls to put 789 */ 790 put( arg1 , arg2 ) 791 { 792 793 panic("put()"); 794 } 795 796 #endif PC 797