xref: /original-bsd/usr.bin/pascal/src/p2put.c (revision 6e17b0ce)
1 /*-
2  * Copyright (c) 1980, 1993
3  *	The Regents of the University of California.  All rights reserved.
4  *
5  * %sccs.include.redist.c%
6  */
7 
8 #ifndef lint
9 static char sccsid[] = "@(#)p2put.c	8.1 (Berkeley) 06/06/93";
10 #endif /* not lint */
11 
12     /*
13      *	functions to help pi put out
14      *	polish postfix binary portable c compiler intermediate code
15      *	thereby becoming the portable pascal compiler
16      */
17 
18 #include	"whoami.h"
19 #ifdef PC
20 #include	"0.h"
21 #include	"objfmt.h"
22 #include	<pcc.h>
23 #include	"pc.h"
24 #include	"align.h"
25 #include	"tmps.h"
26 
27     /*
28      *	emits an ftext operator and a string to the pcstream
29      */
puttext(string)30 puttext( string )
31     char	*string;
32     {
33 	int	length = str4len( string );
34 
35 	if ( !CGENNING )
36 	    return;
37 	p2word( PCCM_TRIPLE( PCCF_FTEXT , length , 0 ) );
38 #	ifdef DEBUG
39 	    if ( opt( 'k' ) ) {
40 		fprintf( stdout , "PCCF_FTEXT | %3d | 0	" , length );
41 	    }
42 #	endif
43 	p2string( string );
44     }
45 
46 int
str4len(string)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 */
putprintf(format,incomplete,arg1,arg2,arg3,arg4,arg5)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      */
putlbracket(ftnno,sizesp)84 putlbracket(ftnno, sizesp)
85     int		ftnno;
86     struct om	*sizesp;
87 {
88     int	maxtempreg;
89     int	alignedframesize;
90 
91 #   if defined(vax) || defined(tahoe)
92 	maxtempreg = sizesp->curtmps.next_avail[REG_GENERAL];
93 #   endif vax || tahoe
94 #   ifdef mc68000
95 	    /*
96 	     *	this is how /lib/f1 wants it.
97 	     */
98 	maxtempreg =	(sizesp->curtmps.next_avail[REG_ADDR] << 4)
99 		      | (sizesp->curtmps.next_avail[REG_DATA]);
100 #   endif mc68000
101     alignedframesize = roundup((int)(BITSPERBYTE * -sizesp->curtmps.om_off),
102 	(long)(BITSPERBYTE * A_STACK));
103     p2word( PCCM_TRIPLE( PCCF_FLBRAC , maxtempreg , ftnno ) );
104     p2word(alignedframesize);
105 #   ifdef DEBUG
106 	if ( opt( 'k' ) ) {
107 	    fprintf(stdout, "PCCF_FLBRAC | %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 interface
116      *	forces the stack allocate and register mask
117      */
putrbracket(ftnno)118 putrbracket( ftnno )
119     int	ftnno;
120     {
121 
122 	p2word( PCCM_TRIPLE( PCCF_FRBRAC , 0 , ftnno ) );
123 #	ifdef DEBUG
124 	    if ( opt( 'k' ) ) {
125 		fprintf( stdout , "PCCF_FRBRAC |   0 | %d\n" , ftnno );
126 	    }
127 #	endif
128     }
129 
130     /*
131      *	emit an eof operator
132      */
puteof()133 puteof()
134     {
135 
136 	p2word( PCCF_FEOF );
137 #	ifdef DEBUG
138 	    if ( opt( 'k' ) ) {
139 		fprintf( stdout , "PCCF_FEOF\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      */
putdot(filename,line)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( PCCM_TRIPLE( PCCF_FEXPR , length , line ) );
159 #	ifdef DEBUG
160 	    if ( opt( 'k' ) ) {
161 		fprintf( stdout , "PCCF_FEXPR | %3d | %d	" , length , line );
162 	    }
163 #	endif
164 	p2string( filename );
165     }
166 
167     /*
168      *	put out a leaf node
169      */
putleaf(op,lval,rval,type,name)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 PCC_ICON:
183 		p2word( PCCM_TRIPLE( PCC_ICON , name != NIL , type ) );
184 		p2word( lval );
185 #		ifdef DEBUG
186 		    if ( opt( 'k' ) ) {
187 			fprintf( stdout , "PCC_ICON | %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 PCC_NAME:
196 		p2word( PCCM_TRIPLE( PCC_NAME , lval != 0 , type ) );
197 		if ( lval )
198 		    p2word( lval );
199 #		ifdef DEBUG
200 		    if ( opt( 'k' ) ) {
201 			fprintf( stdout , "PCC_NAME | %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 PCC_REG:
210 		p2word( PCCM_TRIPLE( PCC_REG , rval , type ) );
211 #		ifdef DEBUG
212 		    if ( opt( 'k' ) ) {
213 			fprintf( stdout , "PCC_REG | %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      */
putRV(name,level,offset,other_flags,type)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 
236 	if ( !CGENNING )
237 	    return;
238 	if ( other_flags & NREGVAR ) {
239 	    if ( ( offset < 0 ) || ( offset > P2FP ) ) {
240 		panic( "putRV regvar" );
241 	    }
242 	    putleaf( PCC_REG , 0 , offset , type , (char *) 0 );
243 	    return;
244 	}
245 	if ( whereis( offset , other_flags ) == GLOBALVAR ) {
246 	    if ( name != 0 ) {
247 		if ( name[0] != '_' ) {
248 			sprintf( extname , EXTFORMAT , name );
249 			printname = extname;
250 		} else {
251 			printname = name;
252 		}
253 		putleaf( PCC_NAME , offset , 0 , type , printname );
254 		return;
255 	    } else {
256 		panic( "putRV no name" );
257 	    }
258 	}
259 	putLV( name , level , offset , other_flags , type );
260 	putop( PCCOM_UNARY PCC_MUL , type );
261     }
262 
263     /*
264      *	put out an lvalue
265      *	given a level and offset
266      *	special case for
267      *	    named globals, whose lvalues are just their names as constants.
268      */
putLV(name,level,offset,other_flags,type)269 putLV( name , level , offset , other_flags , type )
270     char	*name;
271     int		level;
272     int		offset;
273     char	other_flags;
274     int		type;
275 {
276     char		extname[ BUFSIZ ];
277     char		*printname;
278 
279     if ( !CGENNING )
280 	return;
281     if ( other_flags & NREGVAR ) {
282 	panic( "putLV regvar" );
283     }
284     switch ( whereis( offset , other_flags ) ) {
285 	case GLOBALVAR:
286 	    if ( ( name != 0 ) ) {
287 		if ( name[0] != '_' ) {
288 			sprintf( extname , EXTFORMAT , name );
289 			printname = extname;
290 		} else {
291 			printname = name;
292 		}
293 		putleaf( PCC_ICON , offset , 0 , PCCM_ADDTYPE( type , PCCTM_PTR )
294 			, printname );
295 		return;
296 	    } else {
297 		panic( "putLV no name" );
298 	    }
299 	case PARAMVAR:
300 	    if ( level == cbn ) {
301 		putleaf( PCC_REG, 0, P2AP, PCCM_ADDTYPE( type , PCCTM_PTR ), (char *) 0 );
302 	    } else {
303 		putleaf( PCC_NAME , (level * sizeof(struct dispsave)) + AP_OFFSET
304 		    , 0 , PCCTM_PTR | PCCT_CHAR , DISPLAYNAME );
305 		parts[ level ] |= NONLOCALVAR;
306 	    }
307 	    putleaf( PCC_ICON , offset , 0 , PCCT_INT , (char *) 0 );
308 	    putop( PCC_PLUS , PCCTM_PTR | PCCT_CHAR );
309 	    break;
310 	case LOCALVAR:
311 	    if ( level == cbn ) {
312 		putleaf( PCC_REG, 0, P2FP, PCCM_ADDTYPE( type , PCCTM_PTR ), (char *) 0 );
313 	    } else {
314 		putleaf( PCC_NAME , (level * sizeof(struct dispsave)) + FP_OFFSET
315 		    , 0 , PCCTM_PTR | PCCT_CHAR , DISPLAYNAME );
316 		parts[ level ] |= NONLOCALVAR;
317 	    }
318 	    putleaf( PCC_ICON , -offset , 0 , PCCT_INT , (char *) 0 );
319 	    putop( PCC_MINUS , PCCTM_PTR | PCCT_CHAR );
320 	    break;
321 	case NAMEDLOCALVAR:
322 	    if ( level == cbn ) {
323 		putleaf( PCC_REG, 0, P2FP, PCCM_ADDTYPE( type , PCCTM_PTR ), (char *) 0 );
324 	    } else {
325 		putleaf( PCC_NAME , (level * sizeof(struct dispsave)) + FP_OFFSET
326 		    , 0 , PCCTM_PTR | PCCT_CHAR , DISPLAYNAME );
327 		parts[ level ] |= NONLOCALVAR;
328 	    }
329 	    putleaf( PCC_ICON , 0 , 0 , PCCT_INT , name );
330 	    putop( PCC_MINUS , PCCTM_PTR | PCCT_CHAR );
331 	    break;
332     }
333     return;
334 }
335 
336     /*
337      *	put out a floating point constant leaf node
338      *	the constant is declared in aligned data space
339      *	and a PCC_NAME leaf put out for it
340      */
putCON8(val)341 putCON8( val )
342     double	val;
343     {
344 	char	*label;
345 	char	name[ BUFSIZ ];
346 
347 	if ( !CGENNING )
348 	    return;
349 	label = getlab();
350 	putprintf( "	.data" , 0 );
351 	aligndot(A_DOUBLE);
352 	(void) putlab( label );
353 #	if defined(vax) || defined(tahoe)
354 	    putprintf( "	.double 0d%.20e" , 0 , val );
355 #	endif vax || tahoe
356 #	ifdef mc68000
357 	    putprintf( "	.long 	0x%x,0x%x", 0, val);
358 #	endif mc68000
359 	putprintf( "	.text" , 0 );
360 	sprintf( name , PREFIXFORMAT , LABELPREFIX , label );
361 	putleaf( PCC_NAME , 0 , 0 , PCCT_DOUBLE , name );
362     }
363 
364 	/*
365 	 * put out either an lvalue or an rvalue for a constant string.
366 	 * an lvalue (for assignment rhs's) is the name as a constant,
367 	 * an rvalue (for parameters) is just the name.
368 	 */
putCONG(string,length,required)369 putCONG( string , length , required )
370     char	*string;
371     int		length;
372     int		required;
373     {
374 	char	name[ BUFSIZ ];
375 	char	*label;
376 	char	*cp;
377 	int	pad;
378 	int	others;
379 
380 	if ( !CGENNING )
381 	    return;
382 	putprintf( "	.data" , 0 );
383 	aligndot(A_STRUCT);
384 	label = getlab();
385 	(void) putlab( label );
386 	cp = string;
387 	while ( *cp ) {
388 	    putprintf( "	.byte	0%o" , 1 , *cp ++ );
389 	    for ( others = 2 ; ( others <= 8 ) && *cp ; others ++ ) {
390 		putprintf( ",0%o" , 1 , *cp++ );
391 	    }
392 	    putprintf( "" , 0 );
393 	}
394 	pad = length - strlen( string );
395 	while ( pad-- > 0 ) {
396 	    putprintf( "	.byte	0%o" , 1 , ' ' );
397 	    for ( others = 2 ; ( others <= 8 ) && ( pad-- > 0 ) ; others++ ) {
398 		putprintf( ",0%o" , 1 , ' ' );
399 	    }
400 	    putprintf( "" , 0 );
401 	}
402 	putprintf( "	.byte	0" , 0 );
403 	putprintf( "	.text"  , 0 );
404 	sprintf( name , PREFIXFORMAT , LABELPREFIX , label );
405 	if ( required == RREQ ) {
406 	    putleaf( PCC_NAME , 0 , 0 , PCCTM_ARY | PCCT_CHAR , name );
407 	} else {
408 	    putleaf( PCC_ICON , 0 , 0 , PCCTM_PTR | PCCT_CHAR , name );
409 	}
410     }
411 
412     /*
413      *	map a pascal type to a c type
414      *	this would be tail recursive, but i unfolded it into a for (;;).
415      *	this is sort of like isa and lwidth
416      *	a note on the types used by the portable c compiler:
417      *	    they are divided into a basic type (char, short, int, long, etc.)
418      *	    and qualifications on those basic types (pointer, function, array).
419      *	    the basic type is kept in the low 4 bits of the type descriptor,
420      *	    and the qualifications are arranged in two bit chunks, with the
421      *	    most significant on the right,
422      *	    and the least significant on the left
423      *		e.g. int *foo();
424      *			(a function returning a pointer to an integer)
425      *		is stored as
426      *		    <ptr><ftn><int>
427      *	so, we build types recursively
428      *	also, we know that /lib/f1 can only deal with 6 qualifications
429      *	so we stop the recursion there.  this stops infinite type recursion
430      *	through mutually recursive pointer types.
431      */
432 #define	MAXQUALS	6
433 int
p2type(np)434 p2type( np )
435     struct nl	*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 PCCT_UNDEF;
447 	}
448 	switch ( np -> class ) {
449 	    case SCAL :
450 	    case RANGE :
451 	    case CRANGE :
452 		if ( np -> type == ( nl + TDOUBLE ) ) {
453 		    return PCCT_DOUBLE;
454 		}
455 		switch ( bytes( np -> range[0] , np -> range[1] ) ) {
456 		    case 1:
457 			return PCCT_CHAR;
458 		    case 2:
459 			return PCCT_SHORT;
460 		    case 4:
461 			return PCCT_INT;
462 		    default:
463 			panic( "p2type int" );
464 			/* NOTREACHED */
465 		}
466 	    case STR :
467 		return ( PCCTM_ARY | PCCT_CHAR );
468 	    case RECORD :
469 	    case SET :
470 		return PCCT_STRTY;
471 	    case FILET :
472 		return ( PCCTM_PTR | PCCT_STRTY );
473 	    case CONST :
474 	    case VAR :
475 	    case FIELD :
476 		return p2type( np -> type );
477 	    case TYPE :
478 		switch ( nloff( np ) ) {
479 		    case TNIL :
480 			return ( PCCTM_PTR | PCCT_UNDEF );
481 		    case TSTR :
482 			return ( PCCTM_ARY | PCCT_CHAR );
483 		    case TSET :
484 			return PCCT_STRTY;
485 		    default :
486 			return ( p2type( np -> type ) );
487 		}
488 	    case REF:
489 	    case WITHPTR:
490 	    case PTR :
491 		return PCCM_ADDTYPE( typerecur( np -> type , quals + 1 ) , PCCTM_PTR );
492 	    case ARRAY :
493 		return PCCM_ADDTYPE( typerecur( np -> type , quals + 1 ) , PCCTM_ARY );
494 	    case FUNC :
495 		    /*
496 		     * functions are really pointers to functions
497 		     * which return their underlying type.
498 		     */
499 		return PCCM_ADDTYPE( PCCM_ADDTYPE( typerecur( np -> type , quals + 2 ) ,
500 					PCCTM_FTN ) , PCCTM_PTR );
501 	    case PROC :
502 		    /*
503 		     * procedures are pointers to functions
504 		     * which return integers (whether you look at them or not)
505 		     */
506 		return PCCM_ADDTYPE( PCCM_ADDTYPE( PCCT_INT , PCCTM_FTN ) , PCCTM_PTR );
507 	    case FFUNC :
508 	    case FPROC :
509 		    /*
510 		     *	formal procedures and functions are pointers
511 		     *	to structures which describe their environment.
512 		     */
513 		return ( PCCTM_PTR | PCCT_STRTY );
514 	    default :
515 		panic( "p2type" );
516 		/* NOTREACHED */
517 	}
518     }
519 
520     /*
521      *	put a typed operator to the pcstream
522      */
putop(op,type)523 putop( op , type )
524     int		op;
525     int		type;
526     {
527 	extern char	*p2opname();
528 
529 	if ( !CGENNING )
530 	    return;
531 	p2word( PCCM_TRIPLE( op , 0 , type ) );
532 #	ifdef DEBUG
533 	    if ( opt( 'k' ) ) {
534 		fprintf( stdout , "%s (%d) |   0 | 0x%x\n"
535 			, p2opname( op ) , op , type );
536 	    }
537 #	endif
538     }
539 
540     /*
541      *	put out a structure operator (STASG, STARG, STCALL, UNARY STCALL )
542      *	which looks just like a regular operator, only the size and
543      *	alignment go in the next consecutive words
544      */
putstrop(op,type,size,alignment)545 putstrop( op , type , size , alignment )
546     int	op;
547     int	type;
548     int	size;
549     int	alignment;
550     {
551 	extern char	*p2opname();
552 
553 	if ( !CGENNING )
554 	    return;
555 	p2word( PCCM_TRIPLE( op , 0 , type ) );
556 	p2word( size );
557 	p2word( alignment );
558 #	ifdef DEBUG
559 	    if ( opt( 'k' ) ) {
560 		fprintf( stdout , "%s (%d) |   0 | 0x%x	%d %d\n"
561 			, p2opname( op ) , op , type , size , alignment );
562 	    }
563 #	endif
564     }
565 
566     /*
567      *	the string names of p2ops
568      */
569 
570 struct p2op {
571     int op;
572     char *name;
573 };
574 
575 static struct p2op	p2opnames[] = {
576 	PCC_ERROR, "PCC_ERROR",
577 	PCC_NAME, "PCC_NAME",
578 	PCC_STRING, "PCC_STRING",
579 	PCC_ICON, "PCC_ICON",
580 	PCC_FCON, "PCC_FCON",
581 	PCC_PLUS, "PCC_PLUS",
582 	PCC_MINUS, "PCC_MINUS",
583 	PCC_UMINUS, "PCC_UMINUS",
584 	PCC_MUL, "PCC_MUL",
585 	PCC_DEREF, "PCC_DEREF",
586 	PCC_AND, "PCC_AND",
587 	PCC_ADDROF, "PCC_ADDROF",
588 	PCC_OR, "PCC_OR",
589 	PCC_ER, "PCC_ER",
590 	PCC_QUEST, "PCC_QUEST",
591 	PCC_COLON, "PCC_COLON",
592 	PCC_ANDAND, "PCC_ANDAND",
593 	PCC_OROR, "PCC_OROR",
594 	PCC_CM, "PCC_CM",
595 	PCC_ASSIGN, "PCC_ASSIGN",
596 	PCC_COMOP, "PCC_COMOP",
597 	PCC_DIV, "PCC_DIV",
598 	PCC_MOD, "PCC_MOD",
599 	PCC_LS, "PCC_LS",
600 	PCC_RS, "PCC_RS",
601 	PCC_DOT, "PCC_DOT",
602 	PCC_STREF, "PCC_STREF",
603 	PCC_CALL, "PCC_CALL",
604 	PCC_UCALL, "PCC_UCALL",
605 	PCC_FORTCALL, "PCC_FORTCALL",
606 	PCC_UFORTCALL, "PCC_UFORTCALL",
607 	PCC_NOT, "PCC_NOT",
608 	PCC_COMPL, "PCC_COMPL",
609 	PCC_INCR, "PCC_INCR",
610 	PCC_DECR, "PCC_DECR",
611 	PCC_EQ, "PCC_EQ",
612 	PCC_NE, "PCC_NE",
613 	PCC_LE, "PCC_LE",
614 	PCC_LT, "PCC_LT",
615 	PCC_GE, "PCC_GE",
616 	PCC_GT, "PCC_GT",
617 	PCC_ULE, "PCC_ULE",
618 	PCC_ULT, "PCC_ULT",
619 	PCC_UGE, "PCC_UGE",
620 	PCC_UGT, "PCC_UGT",
621 	PCC_REG, "PCC_REG",
622 	PCC_OREG, "PCC_OREG",
623 	PCC_CCODES, "PCC_CCODES",
624 	PCC_FREE, "PCC_FREE",
625 	PCC_STASG, "PCC_STASG",
626 	PCC_STARG, "PCC_STARG",
627 	PCC_STCALL, "PCC_STCALL",
628 	PCC_USTCALL, "PCC_USTCALL",
629 	PCC_FLD, "PCC_FLD",
630 	PCC_SCONV, "PCC_SCONV",
631 	PCC_PCONV, "PCC_PCONV",
632 	PCC_PMCONV, "PCC_PMCONV",
633 	PCC_PVCONV, "PCC_PVCONV",
634 	PCC_FORCE, "PCC_FORCE",
635 	PCC_CBRANCH, "PCC_CBRANCH",
636 	PCC_INIT, "PCC_INIT",
637 	PCC_CAST, "PCC_CAST",
638 	-1, ""
639     };
640 
641 char *
p2opname(op)642 p2opname( op )
643     register int	op;
644     {
645 	static char		*p2map[PCC_MAXOP+1];
646 	static bool		mapready = FALSE;
647 	register struct p2op	*pp;
648 
649 	if ( mapready == FALSE ) {
650 	    for ( pp = p2opnames; pp->op >= 0; pp++ )
651 		p2map[ pp->op ] = pp->name;
652 	    mapready = TRUE;
653 	}
654 	return ( p2map[ op ] ? p2map[ op ] : "unknown" );
655     }
656 
657     /*
658      *	low level routines
659      */
660 
661     /*
662      *	puts a long word on the pcstream
663      */
p2word(word)664 p2word( word )
665     int		word;
666     {
667 
668 	putw( word , pcstream );
669     }
670 
671     /*
672      *	put a length 0 mod 4 null padded string onto the pcstream
673      */
p2string(string)674 p2string( string )
675     char	*string;
676     {
677 	int	slen = strlen( string );
678 	int	wlen = ( slen + 3 ) / 4;
679 	int	plen = ( wlen * 4 ) - slen;
680 	char	*cp;
681 	int	p;
682 
683 	for ( cp = string ; *cp ; cp++ )
684 	    putc( *cp , pcstream );
685 	for ( p = 1 ; p <= plen ; p++ )
686 	    putc( '\0' , pcstream );
687 #	ifdef DEBUG
688 	    if ( opt( 'k' ) ) {
689 		fprintf( stdout , "\"%s" , string );
690 		for ( p = 1 ; p <= plen ; p++ )
691 		    fprintf( stdout , "\\0" );
692 		fprintf( stdout , "\"\n" );
693 	    }
694 #	endif
695     }
696 
697     /*
698      *	puts a name on the pcstream
699      */
p2name(name)700 p2name( name )
701     char	*name;
702     {
703 	int	pad;
704 
705 	fprintf( pcstream , NAMEFORMAT , name );
706 	pad = strlen( name ) % sizeof (long);
707 	for ( ; pad < sizeof (long) ; pad++ ) {
708 	    putc( '\0' , pcstream );
709 	}
710 #	ifdef DEBUG
711 	    if ( opt( 'k' ) ) {
712 		fprintf( stdout , NAMEFORMAT , name );
713 		pad = strlen( name ) % sizeof (long);
714 		for ( ; pad < sizeof (long) ; pad++ ) {
715 		    fprintf( stdout , "\\0" );
716 		}
717 		fprintf( stdout , "\n" );
718 	    }
719 #	endif
720     }
721 
722     /*
723      *	put out a jump to a label
724      */
putjbr(label)725 putjbr( label )
726     long	label;
727     {
728 
729 	printjbr( LABELPREFIX , label );
730     }
731 
732     /*
733      *	put out a jump to any kind of label
734      */
printjbr(prefix,label)735 printjbr( prefix , label )
736     char	*prefix;
737     long	label;
738     {
739 
740 #	if defined(vax) || defined(tahoe)
741 	    putprintf( "	jbr	" , 1 );
742 	    putprintf( PREFIXFORMAT , 0 , prefix , label );
743 #	endif vax || tahoe
744 #	ifdef mc68000
745 	    putprintf( "	jra	" , 1 );
746 	    putprintf( PREFIXFORMAT , 0 , prefix , label );
747 #	endif mc68000
748     }
749 
750     /*
751      *	another version of put to catch calls to put
752      */
753 /* VARARGS */
put()754 put()
755     {
756 
757 	panic("put()");
758     }
759 
760 #endif PC
761