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