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