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