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