projects / unix-history / blame
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
BSD 4_4 release
[unix-history] / usr / src / usr.bin / f77 / pass1.tahoe / putpcc.c
CommitLineData
3e03fb6a
KB		 1/*-
2 * Copyright (c) 1980 The Regents of the University of California.
3 * All rights reserved.
4 *
ad787160
C		 5 * This module is believed to contain source code proprietary to AT&T.
6 * Use and redistribution is subject to the Berkeley Software License
7 * Agreement and your Software Agreement with AT&T (Western Electric).
7d77bf5b
KB		 8 */
9
10#ifndef lint
ad787160 11static char sccsid[] = "@(#)putpcc.c 5.3 (Berkeley) 4/12/91";
3e03fb6a 12#endif /* not lint */
7d77bf5b
KB		 13
14/*
15 * putpcc.c
16 *
17 * Intermediate code generation for S. C. Johnson C compilers
18 * New version using binary polish postfix intermediate
19 *
20 * University of Utah CS Dept modification history:
21 *
22 * $Header: putpcc.c,v 3.2 85/03/25 09:35:57 root Exp $
23 * $Log: putpcc.c,v $
24 * Revision 3.2 85/03/25 09:35:57 root
25 * fseek return -1 on error.
26 *
27 * Revision 3.1 85/02/27 19:06:55 donn
28 * Changed to use pcc.h instead of pccdefs.h.
29 *
30 * Revision 2.12 85/02/22 01:05:54 donn
31 * putaddr() didn't know about intrinsic functions...
32 *
33 * Revision 2.11 84/11/28 21:28:49 donn
34 * Hacked putop() to handle any character expression being converted to int,
35 * not just function calls. Previously it bombed on concatenations.
36 *
37 * Revision 2.10 84/11/01 22:07:07 donn
38 * Yet another try at getting putop() to work right. It appears that the
39 * second pass can't abide certain explicit conversions (e.g. short to long)
40 * so the conversion code in putop() tries to remove them. I think this
41 * version (finally) works.
42 *
43 * Revision 2.9 84/10/29 02:30:57 donn
44 * Earlier fix to putop() for conversions was insufficient -- we NEVER want to
45 * see the type of the left operand of the thing left over from stripping off
46 * conversions...
47 *
48 * Revision 2.8 84/09/18 03:09:21 donn
49 * Fixed bug in putop() where the left operand of an addrblock was being
50 * extracted... This caused an extremely obscure conversion error when
51 * an array of longs was subscripted by a short.
52 *
53 * Revision 2.7 84/08/19 20:10:19 donn
54 * Removed stuff in putbranch that treats STGARG parameters specially -- the
55 * bug in the code generation pass that motivated it has been fixed.
56 *
57 * Revision 2.6 84/08/07 21:32:23 donn
58 * Bumped the size of the buffer for the intermediate code file from 0.5K
59 * to 4K on a VAX.
60 *
61 * Revision 2.5 84/08/04 20:26:43 donn
62 * Fixed a goof in the new putbranch() -- it now calls mkaltemp instead of
63 * mktemp(). Correction due to Jerry Berkman.
64 *
65 * Revision 2.4 84/07/24 19:07:15 donn
66 * Fixed bug reported by Craig Leres in which putmnmx() mistakenly assumed
67 * that mkaltemp() returns tempblocks, and tried to free them with frtemp().
68 *
69 * Revision 2.3 84/07/19 17:22:09 donn
70 * Changed putch1() so that OPPAREN expressions of type CHARACTER are legal.
71 *
72 * Revision 2.2 84/07/19 12:30:38 donn
73 * Fixed a type clash in Bob Corbett's new putbranch().
74 *
75 * Revision 2.1 84/07/19 12:04:27 donn
76 * Changed comment headers for UofU.
77 *
78 * Revision 1.8 84/07/19 11:38:23 donn
79 * Replaced putbranch() routine so that you can ASSIGN into argument variables.
80 * The code is from Bob Corbett, donated by Jerry Berkman.
81 *
82 * Revision 1.7 84/05/31 00:48:32 donn
83 * Fixed an extremely obscure bug dealing with the comparison of CHARACTER*1
84 * expressions -- a foulup in the order of COMOP and the comparison caused
85 * one operand of the comparison to be garbage.
86 *
87 * Revision 1.6 84/04/16 09:54:19 donn
88 * Backed out earlier fix for bug where items in the argtemplist were
89 * (incorrectly) being given away; this is now fixed in mkargtemp().
90 *
91 * Revision 1.5 84/03/23 22:49:48 donn
92 * Took out the initialization of the subroutine argument temporary list in
93 * putcall() -- it needs to be done once per statement instead of once per call.
94 *
95 * Revision 1.4 84/03/01 06:48:05 donn
96 * Fixed bug in Bob Corbett's code for argument temporaries that caused an
97 * addrblock to get thrown out inadvertently when it was needed for recycling
98 * purposes later on.
99 *
100 * Revision 1.3 84/02/26 06:32:38 donn
101 * Added Berkeley changes to move data definitions around and reduce offsets.
102 *
103 * Revision 1.2 84/02/26 06:27:45 donn
104 * Added code to catch TTEMP values passed to putx().
105 *
106 */
107
108#if FAMILY != PCC
109 WRONG put FILE !!!!
110#endif
111
112#include "defs.h"
113#include <pcc.h>
114
115Addrp putcall(), putcxeq(), putcx1(), realpart();
116expptr imagpart();
117ftnint lencat();
118
119#define FOUR 4
120extern int ops2[];
121extern int types2[];
122
123#if HERE==VAX || HERE == TAHOE
124#define PCC_BUFFMAX 1024
125#else
126#define PCC_BUFFMAX 128
127#endif
128static long int p2buff[PCC_BUFFMAX];
129static long int *p2bufp = &p2buff[0];
130static long int *p2bufend = &p2buff[PCC_BUFFMAX];
131
132
133puthead(s, class)
134char *s;
135int class;
136{
137char buff[100];
138#if TARGET == VAX || TARGET == TAHOE
139 if(s)
140 p2ps("\t.globl\t_%s", s);
141#endif
142/* put out fake copy of left bracket line, to be redone later */
143if( ! headerdone )
144 {
145#if FAMILY == PCC
146 p2flush();
147#endif
148 headoffset = ftell(textfile);
149 prhead(textfile);
150 headerdone = YES;
151 p2triple(PCCF_FEXPR, (strlen(infname)+ALILONG-1)/ALILONG, 0);
152 p2str(infname);
153#if TARGET == PDP11
154 /* fake jump to start the optimizer */
155 if(class != CLBLOCK)
156 putgoto( fudgelabel = newlabel() );
157#endif
158
159#if TARGET == VAX || TARGET == TAHOE
160 /* jump from top to bottom */
161 if(s!=CNULL && class!=CLBLOCK)
162 {
163 int proflab = newlabel();
164 p2pass("\t.align\t1");
165 p2ps("_%s:", s);
166 p2pi("\t.word\tLWM%d", procno);
167 prsave(proflab);
168#if TARGET == VAX
169 p2pi("\tjbr\tL%d",
170#else
171 putgoto(
172#endif
173 fudgelabel = newlabel());
174 }
175#endif
176 }
177}
178
179
180
181
182
183/* It is necessary to precede each procedure with a "left bracket"
184 * line that tells pass 2 how many register variables and how
185 * much automatic space is required for the function. This compiler
186 * does not know how much automatic space is needed until the
187 * entire procedure has been processed. Therefore, "puthead"
188 * is called at the begining to record the current location in textfile,
189 * then to put out a placeholder left bracket line. This procedure
190 * repositions the file and rewrites that line, then puts the
191 * file pointer back to the end of the file.
192 */
193
194putbracket()
195{
196long int hereoffset;
197
198#if FAMILY == PCC
199 p2flush();
200#endif
201hereoffset = ftell(textfile);
202if(fseek(textfile, headoffset, 0) == -1)
203 fatal("fseek failed");
204prhead(textfile);
205if(fseek(textfile, hereoffset, 0) == -1)
206 fatal("fseek failed 2");
207}
208
209
210
211
212putrbrack(k)
213int k;
214{
215p2op(PCCF_FRBRAC, k);
216}
217
218
219
220putnreg()
221{
222}
223
224
225
226
227
228
229puteof()
230{
231p2op(PCCF_FEOF, 0);
232p2flush();
233}
234
235
236
237putstmt()
238{
239p2triple(PCCF_FEXPR, 0, lineno);
240}
241
242
243
244
245/* put out code for if( ! p) goto l */
246putif(p,l)
247register expptr p;
248int l;
249{
250register int k;
251
252if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL)
253 {
254 if(k != TYERROR)
255 err("non-logical expression in IF statement");
256 frexpr(p);
257 }
258else
259 {
260 putex1(p);
261 p2icon( (long int) l , PCCT_INT);
262 p2op(PCC_CBRANCH, 0);
263 putstmt();
264 }
265}
266
267
268
269
270
271/* put out code for goto l */
272putgoto(label)
273int label;
274{
275p2triple(PCC_GOTO, 1, label);
276putstmt();
277}
278
279
280/* branch to address constant or integer variable */
281putbranch(p)
282register Addrp p;
283{
284 putex1((expptr) p);
285 p2op(PCC_GOTO, PCCT_INT);
286 putstmt();
287}
288
289
290
291/* put out label l: */
292putlabel(label)
293int label;
294{
295p2op(PCCF_FLABEL, label);
296}
297
298
299
300
301putexpr(p)
302expptr p;
303{
304putex1(p);
305putstmt();
306}
307
308
309
310
311putcmgo(index, nlab, labs)
312expptr index;
313int nlab;
314struct Labelblock *labs[];
315{
316int i, labarray, skiplabel;
317
318if(! ISINT(index->headblock.vtype) )
319 {
320 execerr("computed goto index must be integer", CNULL);
321 return;
322 }
323
324#if TARGET == VAX || TARGET == TAHOE
325 /* use special case instruction */
326 casegoto(index, nlab, labs);
327#else
328 labarray = newlabel();
329 preven(ALIADDR);
330 prlabel(asmfile, labarray);
331 prcona(asmfile, (ftnint) (skiplabel = newlabel()) );
332 for(i = 0 ; i < nlab ; ++i)
333 if( labs[i] )
334 prcona(asmfile, (ftnint)(labs[i]->labelno) );
335 prcmgoto(index, nlab, skiplabel, labarray);
336 putlabel(skiplabel);
337#endif
338}
339\f
340putx(p)
341expptr p;
342{
343char *memname();
344int opc;
345int ncomma;
346int type, k;
347
348if (!p)
349 return;
350
351switch(p->tag)
352 {
353 case TERROR:
354 free( (charptr) p );
355 break;
356
357 case TCONST:
358 switch(type = p->constblock.vtype)
359 {
360 case TYLOGICAL:
361 type = tyint;
362 case TYLONG:
363 case TYSHORT:
b2ab2bea 364 p2icon(p->constblock.constant.ci, types2[type]);
7d77bf5b
KB		 365 free( (charptr) p );
366 break;
367
368 case TYADDR:
369 p2triple(PCC_ICON, 1, PCCT_INT|PCCTM_PTR);
370 p2word(0L);
371 p2name(memname(STGCONST,
b2ab2bea 372 (int) p->constblock.constant.ci) );
7d77bf5b
KB		 373 free( (charptr) p );
374 break;
375
376 default:
377 putx( putconst(p) );
378 break;
379 }
380 break;
381
382 case TEXPR:
383 switch(opc = p->exprblock.opcode)
384 {
385 case OPCALL:
386 case OPCCALL:
387 if( ISCOMPLEX(p->exprblock.vtype) )
388 putcxop(p);
389 else putcall(p);
390 break;
391
392 case OPMIN:
393 case OPMAX:
394 putmnmx(p);
395 break;
396
397
398 case OPASSIGN:
399 if(ISCOMPLEX(p->exprblock.leftp->headblock.vtype)
400 || ISCOMPLEX(p->exprblock.rightp->headblock.vtype) )
401 frexpr( putcxeq(p) );
402 else if( ISCHAR(p) )
403 putcheq(p);
404 else
405 goto putopp;
406 break;
407
408 case OPEQ:
409 case OPNE:
410 if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) ||
411 ISCOMPLEX(p->exprblock.rightp->headblock.vtype) )
412 {
413 putcxcmp(p);
414 break;
415 }
416 case OPLT:
417 case OPLE:
418 case OPGT:
419 case OPGE:
420 if(ISCHAR(p->exprblock.leftp))
421 {
422 putchcmp(p);
423 break;
424 }
425 goto putopp;
426
427 case OPPOWER:
428 putpower(p);
429 break;
430
431 case OPSTAR:
432#if FAMILY == PCC
433 /* m * (2**k) -> m<<k */
434 if(INT(p->exprblock.leftp->headblock.vtype) &&
435 ISICON(p->exprblock.rightp) &&
b2ab2bea 436 ( (k = log2(p->exprblock.rightp->constblock.constant.ci))>0) )
7d77bf5b
KB		 437 {
438 p->exprblock.opcode = OPLSHIFT;
439 frexpr(p->exprblock.rightp);
440 p->exprblock.rightp = ICON(k);
441 goto putopp;
442 }
443#endif
444
445 case OPMOD:
446 goto putopp;
447 case OPPLUS:
448 case OPMINUS:
449 case OPSLASH:
450 case OPNEG:
451 if( ISCOMPLEX(p->exprblock.vtype) )
452 putcxop(p);
453 else goto putopp;
454 break;
455
456 case OPCONV:
457 if( ISCOMPLEX(p->exprblock.vtype) )
458 putcxop(p);
459 else if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) )
460 {
461 ncomma = 0;
462 putx( mkconv(p->exprblock.vtype,
463 realpart(putcx1(p->exprblock.leftp,
464 &ncomma))));
465 putcomma(ncomma, p->exprblock.vtype, NO);
466 free( (charptr) p );
467 }
468 else goto putopp;
469 break;
470
471 case OPNOT:
472 case OPOR:
473 case OPAND:
474 case OPEQV:
475 case OPNEQV:
476 case OPADDR:
477 case OPPLUSEQ:
478 case OPSTAREQ:
479 case OPCOMMA:
480 case OPQUEST:
481 case OPCOLON:
482 case OPBITOR:
483 case OPBITAND:
484 case OPBITXOR:
485 case OPBITNOT:
486 case OPLSHIFT:
487 case OPRSHIFT:
488 putopp:
489 putop(p);
490 break;
491
492 case OPPAREN:
493 putx (p->exprblock.leftp);
494 break;
495 default:
496 badop("putx", opc);
497 }
498 break;
499
500 case TADDR:
501 putaddr(p, YES);
502 break;
503
504 case TTEMP:
505 /*
506 * This type is sometimes passed to putx when errors occur
507 * upstream, I don't know why.
508 */
509 frexpr(p);
510 break;
511
512 default:
513 badtag("putx", p->tag);
514 }
515}
516
517
518
519LOCAL putop(p)
520expptr p;
521{
522int k;
523expptr lp, tp;
524int pt, lt, tt;
525int comma;
526Addrp putch1();
527
528switch(p->exprblock.opcode) /* check for special cases and rewrite */
529 {
530 case OPCONV:
531 tt = pt = p->exprblock.vtype;
532 lp = p->exprblock.leftp;
533 lt = lp->headblock.vtype;
534#if TARGET == VAX
535 if (pt == TYREAL && lt == TYDREAL)
536 {
537 putx(lp);
538 p2op(PCC_SCONV, PCCT_FLOAT);
539 return;
540 }
541#endif
542 while(p->tag==TEXPR && p->exprblock.opcode==OPCONV && (
543#if TARGET != TAHOE
544 (ISREAL(pt)&&ISREAL(lt)) ||
545#endif
546 (INT(pt)&&(ONEOF(lt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) ))
547 {
548#if SZINT < SZLONG
549 if(lp->tag != TEXPR)
550 {
551 if(pt==TYINT && lt==TYLONG)
552 break;
553 if(lt==TYINT && pt==TYLONG)
554 break;
555 }
556#endif
557
558#if TARGET == VAX
559 if(pt==TYDREAL && lt==TYREAL)
560 {
561 if(lp->tag==TEXPR &&
562 lp->exprblock.opcode==OPCONV &&
563 lp->exprblock.leftp->headblock.vtype==TYDREAL)
564 {
565 putx(lp->exprblock.leftp);
566 p2op(PCC_SCONV, PCCT_FLOAT);
567 p2op(PCC_SCONV, PCCT_DOUBLE);
568 free( (charptr) p );
569 return;
570 }
571 else break;
572 }
573#endif
574 if(lt==TYCHAR && lp->tag==TEXPR)
575 {
576 int ncomma = 0;
577 p->exprblock.leftp = (expptr) putch1(lp, &ncomma);
578 putop(p);
579 putcomma(ncomma, pt, NO);
580 free( (charptr) p );
581 return;
582 }
583 free( (charptr) p );
584 p = lp;
585 pt = lt;
586 if (p->tag == TEXPR)
587 {
588 lp = p->exprblock.leftp;
589 lt = lp->headblock.vtype;
590 }
591 }
592 if(p->tag==TEXPR && p->exprblock.opcode==OPCONV)
593 break;
594 putx(p);
595 if (types2[tt] != types2[pt] &&
596 ! ( (ISREAL(tt)&&ISREAL(pt)) ||
597 (INT(tt)&&(ONEOF(pt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) ))
598 p2op(PCC_SCONV,types2[tt]);
599 return;
600
601 case OPADDR:
602 comma = NO;
603 lp = p->exprblock.leftp;
604 if(lp->tag != TADDR)
605 {
606 tp = (expptr) mkaltemp
607 (lp->headblock.vtype,lp->headblock.vleng);
608 putx( mkexpr(OPASSIGN, cpexpr(tp), lp) );
609 lp = tp;
610 comma = YES;
611 }
612 putaddr(lp, NO);
613 if(comma)
614 putcomma(1, TYINT, NO);
615 free( (charptr) p );
616 return;
617#if TARGET == VAX || TARGET == TAHOE
618/* take advantage of a glitch in the code generator that does not check
619 the type clash in an assignment or comparison of an integer zero and
620 a floating left operand, and generates optimal code for the correct
621 type. (The PCC has no floating-constant node to encode this correctly.)
622*/
623 case OPASSIGN:
624 case OPLT:
625 case OPLE:
626 case OPGT:
627 case OPGE:
628 case OPEQ:
629 case OPNE:
630 if(ISREAL(p->exprblock.leftp->headblock.vtype) &&
631 ISREAL(p->exprblock.rightp->headblock.vtype) &&
632 ISCONST(p->exprblock.rightp) &&
b2ab2bea 633 p->exprblock.rightp->constblock.constant.cd[0]==0)
7d77bf5b
KB		 634 {
635 p->exprblock.rightp->constblock.vtype = TYINT;
b2ab2bea 636 p->exprblock.rightp->constblock.constant.ci = 0;
7d77bf5b
KB		 637 }
638#endif
639 }
640
641if( (k = ops2[p->exprblock.opcode]) <= 0)
642 badop("putop", p->exprblock.opcode);
643putx(p->exprblock.leftp);
644if(p->exprblock.rightp)
645 putx(p->exprblock.rightp);
646p2op(k, types2[p->exprblock.vtype]);
647
648if(p->exprblock.vleng)
649 frexpr(p->exprblock.vleng);
650free( (charptr) p );
651}
652\f
653putforce(t, p)
654int t;
655expptr p;
656{
657p = mkconv(t, fixtype(p));
658putx(p);
659p2op(PCC_FORCE,
660#if TARGET == TAHOE
661 (t==TYLONG ? PCCT_LONG : (t==TYREAL ? PCCT_FLOAT : PCCT_DOUBLE)) );
662#else
663 (t==TYSHORT ? PCCT_SHORT : (t==TYLONG ? PCCT_LONG : PCCT_DOUBLE)) );
664#endif
665putstmt();
666}
667
668
669
670LOCAL putpower(p)
671expptr p;
672{
673expptr base;
674Addrp t1, t2;
675ftnint k;
676int type;
677int ncomma;
678
679if(!ISICON(p->exprblock.rightp) ||
b2ab2bea 680 (k = p->exprblock.rightp->constblock.constant.ci)<2)
7d77bf5b
KB		 681 fatal("putpower: bad call");
682base = p->exprblock.leftp;
683type = base->headblock.vtype;
684
685if ((k == 2) && base->tag == TADDR && ISCONST(base->addrblock.memoffset))
686{
687 putx( mkexpr(OPSTAR,cpexpr(base),cpexpr(base)));
688
689 return;
690}
691t1 = mkaltemp(type, PNULL);
692t2 = NULL;
693ncomma = 1;
694putassign(cpexpr(t1), cpexpr(base) );
695
696for( ; (k&1)==0 && k>2 ; k>>=1 )
697 {
698 ++ncomma;
699 putsteq(t1, t1);
700 }
701
702if(k == 2)
703 putx( mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) );
704else
705 {
706 t2 = mkaltemp(type, PNULL);
707 ++ncomma;
708 putassign(cpexpr(t2), cpexpr(t1));
709
710 for(k>>=1 ; k>1 ; k>>=1)
711 {
712 ++ncomma;
713 putsteq(t1, t1);
714 if(k & 1)
715 {
716 ++ncomma;
717 putsteq(t2, t1);
718 }
719 }
720 putx( mkexpr(OPSTAR, cpexpr(t2),
721 mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) ));
722 }
723putcomma(ncomma, type, NO);
724frexpr(t1);
725if(t2)
726 frexpr(t2);
727frexpr(p);
728}
729
730
731
732
733LOCAL Addrp intdouble(p, ncommap)
734Addrp p;
735int *ncommap;
736{
737register Addrp t;
738
739t = mkaltemp(TYDREAL, PNULL);
740++*ncommap;
741putassign(cpexpr(t), p);
742return(t);
743}
744
745
746
747
748
749LOCAL Addrp putcxeq(p)
750register expptr p;
751{
752register Addrp lp, rp;
753int ncomma;
754
755if(p->tag != TEXPR)
756 badtag("putcxeq", p->tag);
757
758ncomma = 0;
759lp = putcx1(p->exprblock.leftp, &ncomma);
760rp = putcx1(p->exprblock.rightp, &ncomma);
761putassign(realpart(lp), realpart(rp));
762if( ISCOMPLEX(p->exprblock.vtype) )
763 {
764 ++ncomma;
765 putassign(imagpart(lp), imagpart(rp));
766 }
767putcomma(ncomma, TYREAL, NO);
768frexpr(rp);
769free( (charptr) p );
770return(lp);
771}
772
773
774
775LOCAL putcxop(p)
776expptr p;
777{
778Addrp putcx1();
779int ncomma;
780
781ncomma = 0;
782putaddr( putcx1(p, &ncomma), NO);
783putcomma(ncomma, TYINT, NO);
784}
785
786
787
788LOCAL Addrp putcx1(p, ncommap)
789register expptr p;
790int *ncommap;
791{
792expptr q;
793Addrp lp, rp;
794register Addrp resp;
795int opcode;
796int ltype, rtype;
797expptr mkrealcon();
798
799if(p == NULL)
800 return(NULL);
801
802switch(p->tag)
803 {
804 case TCONST:
805 if( ISCOMPLEX(p->constblock.vtype) )
806 p = (expptr) putconst(p);
807 return( (Addrp) p );
808
809 case TADDR:
810 if( ! addressable(p) )
811 {
812 ++*ncommap;
813 resp = mkaltemp(tyint, PNULL);
814 putassign( cpexpr(resp), p->addrblock.memoffset );
815 p->addrblock.memoffset = (expptr)resp;
816 }
817 return( (Addrp) p );
818
819 case TEXPR:
820 if( ISCOMPLEX(p->exprblock.vtype) )
821 break;
822 ++*ncommap;
823 resp = mkaltemp(TYDREAL, NO);
824 putassign( cpexpr(resp), p);
825 return(resp);
826
827 default:
828 badtag("putcx1", p->tag);
829 }
830
831opcode = p->exprblock.opcode;
832if(opcode==OPCALL || opcode==OPCCALL)
833 {
834 ++*ncommap;
835 return( putcall(p) );
836 }
837else if(opcode == OPASSIGN)
838 {
839 ++*ncommap;
840 return( putcxeq(p) );
841 }
842resp = mkaltemp(p->exprblock.vtype, PNULL);
843if(lp = putcx1(p->exprblock.leftp, ncommap) )
844 ltype = lp->vtype;
845if(rp = putcx1(p->exprblock.rightp, ncommap) )
846 rtype = rp->vtype;
847
848switch(opcode)
849 {
850 case OPPAREN:
851 frexpr (resp);
852 resp = lp;
853 lp = NULL;
854 break;
855
856 case OPCOMMA:
857 frexpr(resp);
858 resp = rp;
859 rp = NULL;
860 break;
861
862 case OPNEG:
863 putassign( realpart(resp), mkexpr(OPNEG, realpart(lp), ENULL) );
864 putassign( imagpart(resp), mkexpr(OPNEG, imagpart(lp), ENULL) );
865 *ncommap += 2;
866 break;
867
868 case OPPLUS:
869 case OPMINUS:
870 putassign( realpart(resp),
871 mkexpr(opcode, realpart(lp), realpart(rp) ));
872 if(rtype < TYCOMPLEX)
873 putassign( imagpart(resp), imagpart(lp) );
874 else if(ltype < TYCOMPLEX)
875 {
876 if(opcode == OPPLUS)
877 putassign( imagpart(resp), imagpart(rp) );
878 else putassign( imagpart(resp),
879 mkexpr(OPNEG, imagpart(rp), ENULL) );
880 }
881 else
882 putassign( imagpart(resp),
883 mkexpr(opcode, imagpart(lp), imagpart(rp) ));
884
885 *ncommap += 2;
886 break;
887
888 case OPSTAR:
889 if(ltype < TYCOMPLEX)
890 {
891 if( ISINT(ltype) )
892 lp = intdouble(lp, ncommap);
893 putassign( realpart(resp),
894 mkexpr(OPSTAR, cpexpr(lp), realpart(rp) ));
895 putassign( imagpart(resp),
896 mkexpr(OPSTAR, cpexpr(lp), imagpart(rp) ));
897 }
898 else if(rtype < TYCOMPLEX)
899 {
900 if( ISINT(rtype) )
901 rp = intdouble(rp, ncommap);
902 putassign( realpart(resp),
903 mkexpr(OPSTAR, cpexpr(rp), realpart(lp) ));
904 putassign( imagpart(resp),
905 mkexpr(OPSTAR, cpexpr(rp), imagpart(lp) ));
906 }
907 else {
908 putassign( realpart(resp), mkexpr(OPMINUS,
909 mkexpr(OPSTAR, realpart(lp), realpart(rp)),
910 mkexpr(OPSTAR, imagpart(lp), imagpart(rp)) ));
911 putassign( imagpart(resp), mkexpr(OPPLUS,
912 mkexpr(OPSTAR, realpart(lp), imagpart(rp)),
913 mkexpr(OPSTAR, imagpart(lp), realpart(rp)) ));
914 }
915 *ncommap += 2;
916 break;
917
918 case OPSLASH:
919 /* fixexpr has already replaced all divisions
920 * by a complex by a function call
921 */
922 if( ISINT(rtype) )
923 rp = intdouble(rp, ncommap);
924 putassign( realpart(resp),
925 mkexpr(OPSLASH, realpart(lp), cpexpr(rp)) );
926 putassign( imagpart(resp),
927 mkexpr(OPSLASH, imagpart(lp), cpexpr(rp)) );
928 *ncommap += 2;
929 break;
930
931 case OPCONV:
932 putassign( realpart(resp), realpart(lp) );
933 if( ISCOMPLEX(lp->vtype) )
934 q = imagpart(lp);
935 else if(rp != NULL)
936 q = (expptr) realpart(rp);
937 else
938 q = mkrealcon(TYDREAL, 0.0);
939 putassign( imagpart(resp), q);
940 *ncommap += 2;
941 break;
942
943 default:
944 badop("putcx1", opcode);
945 }
946
947frexpr(lp);
948frexpr(rp);
949free( (charptr) p );
950return(resp);
951}
952
953
954
955
956LOCAL putcxcmp(p)
957register expptr p;
958{
959int opcode;
960int ncomma;
961register Addrp lp, rp;
962expptr q;
963
964if(p->tag != TEXPR)
965 badtag("putcxcmp", p->tag);
966
967ncomma = 0;
968opcode = p->exprblock.opcode;
969lp = putcx1(p->exprblock.leftp, &ncomma);
970rp = putcx1(p->exprblock.rightp, &ncomma);
971
972q = mkexpr( opcode==OPEQ ? OPAND : OPOR ,
973 mkexpr(opcode, realpart(lp), realpart(rp)),
974 mkexpr(opcode, imagpart(lp), imagpart(rp)) );
975putx( fixexpr(q) );
976putcomma(ncomma, TYINT, NO);
977
978free( (charptr) lp);
979free( (charptr) rp);
980free( (charptr) p );
981}
982\f
983LOCAL Addrp putch1(p, ncommap)
984register expptr p;
985int * ncommap;
986{
987register Addrp t;
988
989switch(p->tag)
990 {
991 case TCONST:
992 return( putconst(p) );
993
994 case TADDR:
995 return( (Addrp) p );
996
997 case TEXPR:
998 ++*ncommap;
999
1000 switch(p->exprblock.opcode)
1001 {
1002 expptr q;
1003
1004 case OPCALL:
1005 case OPCCALL:
1006 t = putcall(p);
1007 break;
1008
1009 case OPPAREN:
1010 --*ncommap;
1011 t = putch1(p->exprblock.leftp, ncommap);
1012 break;
1013
1014 case OPCONCAT:
1015 t = mkaltemp(TYCHAR, ICON(lencat(p)) );
1016 q = (expptr) cpexpr(p->headblock.vleng);
1017 putcat( cpexpr(t), p );
1018 /* put the correct length on the block */
1019 frexpr(t->vleng);
1020 t->vleng = q;
1021
1022 break;
1023
1024 case OPCONV:
1025 if(!ISICON(p->exprblock.vleng)
b2ab2bea 1026 || p->exprblock.vleng->constblock.constant.ci!=1
7d77bf5b
KB		 1027 || ! INT(p->exprblock.leftp->headblock.vtype) )
1028 fatal("putch1: bad character conversion");
1029 t = mkaltemp(TYCHAR, ICON(1) );
1030 putop( mkexpr(OPASSIGN, cpexpr(t), p) );
1031 break;
1032 default:
1033 badop("putch1", p->exprblock.opcode);
1034 }
1035 return(t);
1036
1037 default:
1038 badtag("putch1", p->tag);
1039 }
1040/* NOTREACHED */
1041}
1042\f
1043
1044
1045
1046LOCAL putchop(p)
1047expptr p;
1048{
1049int ncomma;
1050
1051ncomma = 0;
1052putaddr( putch1(p, &ncomma) , NO );
1053putcomma(ncomma, TYCHAR, YES);
1054}
1055
1056
1057
1058
1059LOCAL putcheq(p)
1060register expptr p;
1061{
1062int ncomma;
1063expptr lp, rp;
1064
1065if(p->tag != TEXPR)
1066 badtag("putcheq", p->tag);
1067
1068ncomma = 0;
1069lp = p->exprblock.leftp;
1070rp = p->exprblock.rightp;
1071if( rp->tag==TEXPR && rp->exprblock.opcode==OPCONCAT )
1072 putcat(lp, rp);
1073else if( ISONE(lp->headblock.vleng) && ISONE(rp->headblock.vleng) )
1074 {
1075 putaddr( putch1(lp, &ncomma) , YES );
1076 putaddr( putch1(rp, &ncomma) , YES );
1077 putcomma(ncomma, TYINT, NO);
1078 p2op(PCC_ASSIGN, PCCT_CHAR);
1079 }
1080else
1081 {
1082 putx( call2(TYINT, "s_copy", lp, rp) );
1083 putcomma(ncomma, TYINT, NO);
1084 }
1085
1086frexpr(p->exprblock.vleng);
1087free( (charptr) p );
1088}
1089
1090
1091
1092
1093LOCAL putchcmp(p)
1094register expptr p;
1095{
1096int ncomma;
1097expptr lp, rp;
1098
1099if(p->tag != TEXPR)
1100 badtag("putchcmp", p->tag);
1101
1102ncomma = 0;
1103lp = p->exprblock.leftp;
1104rp = p->exprblock.rightp;
1105
1106if(ISONE(lp->headblock.vleng) && ISONE(rp->headblock.vleng) )
1107 {
1108 putaddr( putch1(lp, &ncomma) , YES );
1109 putcomma(ncomma, TYINT, NO);
1110 ncomma = 0;
1111 putaddr( putch1(rp, &ncomma) , YES );
1112 putcomma(ncomma, TYINT, NO);
1113 p2op(ops2[p->exprblock.opcode], PCCT_CHAR);
1114 free( (charptr) p );
1115 }
1116else
1117 {
1118 p->exprblock.leftp = call2(TYINT,"s_cmp", lp, rp);
1119 p->exprblock.rightp = ICON(0);
1120 putop(p);
1121 }
1122}
1123
1124
1125
1126
1127
1128LOCAL putcat(lhs, rhs)
1129register Addrp lhs;
1130register expptr rhs;
1131{
1132int n, ncomma;
1133Addrp lp, cp;
1134
1135ncomma = 0;
1136n = ncat(rhs);
1137lp = mkaltmpn(n, TYLENG, PNULL);
1138cp = mkaltmpn(n, TYADDR, PNULL);
1139
1140n = 0;
1141putct1(rhs, lp, cp, &n, &ncomma);
1142
1143putx( call4(TYSUBR, "s_cat", lhs, cp, lp, mkconv(TYLONG, ICON(n)) ) );
1144putcomma(ncomma, TYINT, NO);
1145}
1146
1147
1148
1149
1150
1151LOCAL putct1(q, lp, cp, ip, ncommap)
1152register expptr q;
1153register Addrp lp, cp;
1154int *ip, *ncommap;
1155{
1156int i;
1157Addrp lp1, cp1;
1158
1159if(q->tag==TEXPR && q->exprblock.opcode==OPCONCAT)
1160 {
1161 putct1(q->exprblock.leftp, lp, cp, ip, ncommap);
1162 putct1(q->exprblock.rightp, lp, cp , ip, ncommap);
1163 frexpr(q->exprblock.vleng);
1164 free( (charptr) q );
1165 }
1166else
1167 {
1168 i = (*ip)++;
1169 lp1 = (Addrp) cpexpr(lp);
1170 lp1->memoffset = mkexpr(OPPLUS,lp1->memoffset, ICON(i*SZLENG));
1171 cp1 = (Addrp) cpexpr(cp);
1172 cp1->memoffset = mkexpr(OPPLUS, cp1->memoffset, ICON(i*SZADDR));
1173 putassign( lp1, cpexpr(q->headblock.vleng) );
1174 putassign( cp1, addrof(putch1(q,ncommap)) );
1175 *ncommap += 2;
1176 }
1177}
1178\f
1179LOCAL putaddr(p, indir)
1180register Addrp p;
1181int indir;
1182{
1183int type, type2, funct;
1184ftnint offset, simoffset();
1185expptr offp, shorten();
1186
1187if( p->tag==TERROR || (p->memoffset!=NULL && ISERROR(p->memoffset)) )
1188 {
1189 frexpr(p);
1190 return;
1191 }
1192if (p->tag != TADDR) badtag ("putaddr",p->tag);
1193
1194type = p->vtype;
1195type2 = types2[type];
1196funct = (p->vclass==CLPROC ? PCCTM_FTN<<2 : 0);
1197
1198offp = (p->memoffset ? (expptr) cpexpr(p->memoffset) : (expptr)NULL );
1199
1200
1201#if (FUDGEOFFSET != 1)
1202if(offp)
1203 offp = mkexpr(OPSTAR, ICON(FUDGEOFFSET), offp);
1204#endif
1205
1206offset = simoffset( &offp );
1207#if SZINT < SZLONG
1208 if(offp)
1209 if(shortsubs)
1210 offp = shorten(offp);
1211 else
1212 offp = mkconv(TYINT, offp);
1213#else
1214 if(offp)
1215 offp = mkconv(TYINT, offp);
1216#endif
1217
1218if (p->vclass == CLVAR
1219 && (p->vstg == STGBSS || p->vstg == STGEQUIV)
1220 && SMALLVAR(p->varsize)
1221 && offset >= -32768 && offset <= 32767)
1222 {
1223 anylocals = YES;
1224 if (indir && !offp)
1225 p2ldisp(offset, memname(p->vstg, p->memno), type2);
1226 else
1227 {
1228 p2reg(LVARREG, type2 | PCCTM_PTR);
1229 p2triple(PCC_ICON, 1, PCCT_INT);
1230 p2word(offset);
1231 p2ndisp(memname(p->vstg, p->memno));
1232 p2op(PCC_PLUS, type2 | PCCTM_PTR);
1233 if (offp)
1234 {
1235 putx(offp);
1236 p2op(PCC_PLUS, type2 | PCCTM_PTR);
1237 }
1238 if (indir)
1239 p2op(PCC_DEREF, type2);
1240 }
1241 frexpr((tagptr) p);
1242 return;
1243 }
1244
1245switch(p->vstg)
1246 {
1247 case STGAUTO:
1248 if(indir && !offp)
1249 {
1250 p2oreg(offset, AUTOREG, type2);
1251 break;
1252 }
1253
1254 if(!indir && !offp && !offset)
1255 {
1256 p2reg(AUTOREG, type2 | PCCTM_PTR);
1257 break;
1258 }
1259
1260 p2reg(AUTOREG, type2 | PCCTM_PTR);
1261 if(offp)
1262 {
1263 putx(offp);
1264 if(offset)
1265 p2icon(offset, PCCT_INT);
1266 }
1267 else
1268 p2icon(offset, PCCT_INT);
1269 if(offp && offset)
1270 p2op(PCC_PLUS, type2 | PCCTM_PTR);
1271 p2op(PCC_PLUS, type2 | PCCTM_PTR);
1272 if(indir)
1273 p2op(PCC_DEREF, type2);
1274 break;
1275
1276 case STGARG:
1277 p2oreg(
1278#ifdef ARGOFFSET
1279 ARGOFFSET +
1280#endif
1281 (ftnint) (FUDGEOFFSET*p->memno),
1282 ARGREG, type2 | PCCTM_PTR | funct );
1283
1284 based:
1285 if(offset)
1286 {
1287 p2icon(offset, PCCT_INT);
1288 p2op(PCC_PLUS, type2 | PCCTM_PTR);
1289 }
1290 if(offp)
1291 {
1292 putx(offp);
1293 p2op(PCC_PLUS, type2 | PCCTM_PTR);
1294 }
1295 if(indir)
1296 p2op(PCC_DEREF, type2);
1297 break;
1298
1299 case STGLENG:
1300 if(indir)
1301 {
1302 p2oreg(
1303#ifdef ARGOFFSET
1304 ARGOFFSET +
1305#endif
1306 (ftnint) (FUDGEOFFSET*p->memno),
1307 ARGREG, type2 );
1308 }
1309 else {
1310 p2reg(ARGREG, type2 | PCCTM_PTR );
1311 p2icon(
1312#ifdef ARGOFFSET
1313 ARGOFFSET +
1314#endif
1315 (ftnint) (FUDGEOFFSET*p->memno), PCCT_INT);
1316 p2op(PCC_PLUS, type2 | PCCTM_PTR );
1317 }
1318 break;
1319
1320
1321 case STGBSS:
1322 case STGINIT:
1323 case STGEXT:
1324 case STGINTR:
1325 case STGCOMMON:
1326 case STGEQUIV:
1327 case STGCONST:
1328 if(offp)
1329 {
1330 putx(offp);
1331 putmem(p, PCC_ICON, offset);
1332 p2op(PCC_PLUS, type2 | PCCTM_PTR);
1333 if(indir)
1334 p2op(PCC_DEREF, type2);
1335 }
1336 else
1337 putmem(p, (indir ? PCC_NAME : PCC_ICON), offset);
1338
1339 break;
1340
1341 case STGREG:
1342 if(indir)
1343 p2reg(p->memno, type2);
1344 else
1345 fatal("attempt to take address of a register");
1346 break;
1347
1348 case STGPREG:
1349 if(indir && !offp)
1350 p2oreg(offset, p->memno, type2);
1351 else
1352 {
1353 p2reg(p->memno, type2 | PCCTM_PTR);
1354 goto based;
1355 }
1356 break;
1357
1358 default:
1359 badstg("putaddr", p->vstg);
1360 }
1361frexpr(p);
1362}
1363
1364
1365
1366
1367LOCAL putmem(p, class, offset)
1368expptr p;
1369int class;
1370ftnint offset;
1371{
1372int type2;
1373int funct;
1374char *name, *memname();
1375
1376funct = (p->headblock.vclass==CLPROC ? PCCTM_FTN<<2 : 0);
1377type2 = types2[p->headblock.vtype];
1378if(p->headblock.vclass == CLPROC)
1379 type2 |= (PCCTM_FTN<<2);
1380name = memname(p->addrblock.vstg, p->addrblock.memno);
1381if(class == PCC_ICON)
1382 {
1383 p2triple(PCC_ICON, name[0]!='\0', type2|PCCTM_PTR);
1384 p2word(offset);
1385 if(name[0])
1386 p2name(name);
1387 }
1388else
1389 {
1390 p2triple(PCC_NAME, offset!=0, type2);
1391 if(offset != 0)
1392 p2word(offset);
1393 p2name(name);
1394 }
1395}
1396
1397
1398\f
1399LOCAL Addrp putcall(p)
1400register Exprp p;
1401{
1402chainp arglist, charsp, cp;
1403int n, first;
1404Addrp t;
1405register expptr q;
1406Addrp fval, mkargtemp();
1407int type, type2, ctype, qtype, indir;
1408
1409type2 = types2[type = p->vtype];
1410charsp = NULL;
1411indir = (p->opcode == OPCCALL);
1412n = 0;
1413first = YES;
1414
1415if(p->rightp)
1416 {
1417 arglist = p->rightp->listblock.listp;
1418 free( (charptr) (p->rightp) );
1419 }
1420else
1421 arglist = NULL;
1422
1423for(cp = arglist ; cp ; cp = cp->nextp)
1424 {
1425 q = (expptr) cp->datap;
1426 if(indir)
1427 ++n;
1428 else {
1429 q = (expptr) (cp->datap);
1430 if( ISCONST(q) )
1431 {
1432 q = (expptr) putconst(q);
1433 cp->datap = (tagptr) q;
1434 }
1435 if( ISCHAR(q) && q->headblock.vclass!=CLPROC )
1436 {
1437 charsp = hookup(charsp,
1438 mkchain(cpexpr(q->headblock.vleng),
1439 CHNULL));
1440 n += 2;
1441 }
1442 else
1443 n += 1;
1444 }
1445 }
1446
1447if(type == TYCHAR)
1448 {
1449 if( ISICON(p->vleng) )
1450 {
1451 fval = mkargtemp(TYCHAR, p->vleng);
1452 n += 2;
1453 }
1454 else {
1455 err("adjustable character function");
1456 return;
1457 }
1458 }
1459else if( ISCOMPLEX(type) )
1460 {
1461 fval = mkargtemp(type, PNULL);
1462 n += 1;
1463 }
1464else
1465 fval = NULL;
1466
1467ctype = (fval ? PCCT_INT : type2);
1468putaddr(p->leftp, NO);
1469
1470if(fval)
1471 {
1472 first = NO;
1473 putaddr( cpexpr(fval), NO);
1474 if(type==TYCHAR)
1475 {
1476 putx( mkconv(TYLENG,p->vleng) );
1477 p2op(PCC_CM, type2);
1478 }
1479 }
1480
1481for(cp = arglist ; cp ; cp = cp->nextp)
1482 {
1483 q = (expptr) (cp->datap);
1484 if(q->tag==TADDR && (indir || q->addrblock.vstg!=STGREG) )
1485 putaddr(q, indir && q->addrblock.vtype!=TYCHAR);
1486 else if( ISCOMPLEX(q->headblock.vtype) )
1487 putcxop(q);
1488 else if (ISCHAR(q) )
1489 putchop(q);
1490 else if( ! ISERROR(q) )
1491 {
1492 if(indir)
1493 putx(q);
1494 else {
1495 t = mkargtemp(qtype = q->headblock.vtype,
1496 q->headblock.vleng);
1497 putassign( cpexpr(t), q );
1498 putaddr(t, NO);
1499 putcomma(1, qtype, YES);
1500 }
1501 }
1502 if(first)
1503 first = NO;
1504 else
1505 p2op(PCC_CM, type2);
1506 }
1507
1508if(arglist)
1509 frchain(&arglist);
1510for(cp = charsp ; cp ; cp = cp->nextp)
1511 {
1512 putx( mkconv(TYLENG,cp->datap) );
1513 p2op(PCC_CM, type2);
1514 }
1515frchain(&charsp);
1516#if TARGET == TAHOE
1517if(indir && ctype==PCCT_FLOAT) /* function opcodes */
1518 p2op(PCC_FORTCALL, ctype);
1519else
1520#endif
1521p2op(n>0 ? PCC_CALL : PCC_UCALL , ctype);
1522free( (charptr) p );
1523return(fval);
1524}
1525
1526
1527
1528LOCAL putmnmx(p)
1529register expptr p;
1530{
1531int op, type;
1532int ncomma;
1533expptr qp;
1534chainp p0, p1;
1535Addrp sp, tp;
1536
1537if(p->tag != TEXPR)
1538 badtag("putmnmx", p->tag);
1539
1540type = p->exprblock.vtype;
1541op = (p->exprblock.opcode==OPMIN ? OPLT : OPGT );
1542p0 = p->exprblock.leftp->listblock.listp;
1543free( (charptr) (p->exprblock.leftp) );
1544free( (charptr) p );
1545
1546sp = mkaltemp(type, PNULL);
1547tp = mkaltemp(type, PNULL);
1548qp = mkexpr(OPCOLON, cpexpr(tp), cpexpr(sp));
1549qp = mkexpr(OPQUEST, mkexpr(op, cpexpr(tp),cpexpr(sp)), qp);
1550qp = fixexpr(qp);
1551
1552ncomma = 1;
1553putassign( cpexpr(sp), p0->datap );
1554
1555for(p1 = p0->nextp ; p1 ; p1 = p1->nextp)
1556 {
1557 ++ncomma;
1558 putassign( cpexpr(tp), p1->datap );
1559 if(p1->nextp)
1560 {
1561 ++ncomma;
1562 putassign( cpexpr(sp), cpexpr(qp) );
1563 }
1564 else
1565 putx(qp);
1566 }
1567
1568putcomma(ncomma, type, NO);
1569frexpr(sp);
1570frexpr(tp);
1571frchain( &p0 );
1572}
1573
1574
1575
1576
1577LOCAL putcomma(n, type, indir)
1578int n, type, indir;
1579{
1580type = types2[type];
1581if(indir)
1582 type |= PCCTM_PTR;
1583while(--n >= 0)
1584 p2op(PCC_COMOP, type);
1585}
1586
1587
1588
1589
1590ftnint simoffset(p0)
1591expptr *p0;
1592{
1593ftnint offset, prod;
1594register expptr p, lp, rp;
1595
1596offset = 0;
1597p = *p0;
1598if(p == NULL)
1599 return(0);
1600
1601if( ! ISINT(p->headblock.vtype) )
1602 return(0);
1603
1604if(p->tag==TEXPR && p->exprblock.opcode==OPSTAR)
1605 {
1606 lp = p->exprblock.leftp;
1607 rp = p->exprblock.rightp;
1608 if(ISICON(rp) && lp->tag==TEXPR &&
1609 lp->exprblock.opcode==OPPLUS && ISICON(lp->exprblock.rightp))
1610 {
1611 p->exprblock.opcode = OPPLUS;
1612 lp->exprblock.opcode = OPSTAR;
b2ab2bea
KB		 1613 prod = rp->constblock.constant.ci *
1614 lp->exprblock.rightp->constblock.constant.ci;
1615 lp->exprblock.rightp->constblock.constant.ci = rp->constblock.constant.ci;
1616 rp->constblock.constant.ci = prod;
7d77bf5b
KB		 1617 }
1618 }
1619
1620if(p->tag==TEXPR && p->exprblock.opcode==OPPLUS &&
1621 ISICON(p->exprblock.rightp))
1622 {
1623 rp = p->exprblock.rightp;
1624 lp = p->exprblock.leftp;
b2ab2bea 1625 offset += rp->constblock.constant.ci;
7d77bf5b
KB		 1626 frexpr(rp);
1627 free( (charptr) p );
1628 *p0 = lp;
1629 }
1630
1631if( ISCONST(p) )
1632 {
b2ab2bea 1633 offset += p->constblock.constant.ci;
7d77bf5b
KB		 1634 frexpr(p);
1635 *p0 = NULL;
1636 }
1637
1638return(offset);
1639}
1640\f
1641
1642
1643
1644
1645p2op(op, type)
1646int op, type;
1647{
1648p2triple(op, 0, type);
1649}
1650
1651p2icon(offset, type)
1652ftnint offset;
1653int type;
1654{
1655p2triple(PCC_ICON, 0, type);
1656p2word(offset);
1657}
1658
1659
1660
1661
1662p2oreg(offset, reg, type)
1663ftnint offset;
1664int reg, type;
1665{
1666p2triple(PCC_OREG, reg, type);
1667p2word(offset);
1668p2name("");
1669}
1670
1671
1672
1673
1674p2reg(reg, type)
1675int reg, type;
1676{
1677p2triple(PCC_REG, reg, type);
1678}
1679
1680
1681
1682p2pi(s, i)
1683char *s;
1684int i;
1685{
1686char buff[100];
1687sprintf(buff, s, i);
1688p2pass(buff);
1689}
1690
1691
1692
1693p2pij(s, i, j)
1694char *s;
1695int i, j;
1696{
1697char buff[100];
1698sprintf(buff, s, i, j);
1699p2pass(buff);
1700}
1701
1702
1703
1704
1705p2ps(s, t)
1706char *s, *t;
1707{
1708char buff[100];
1709sprintf(buff, s, t);
1710p2pass(buff);
1711}
1712
1713
1714
1715
1716p2pass(s)
1717char *s;
1718{
1719p2triple(PCCF_FTEXT, (strlen(s) + ALILONG-1)/ALILONG, 0);
1720p2str(s);
1721}
1722
1723
1724
1725
1726p2str(s)
1727register char *s;
1728{
1729union { long int word; char str[SZLONG]; } u;
1730register int i;
1731
1732i = 0;
1733u.word = 0;
1734while(*s)
1735 {
1736 u.str[i++] = *s++;
1737 if(i == SZLONG)
1738 {
1739 p2word(u.word);
1740 u.word = 0;
1741 i = 0;
1742 }
1743 }
1744if(i > 0)
1745 p2word(u.word);
1746}
1747
1748
1749
1750
1751p2triple(op, var, type)
1752int op, var, type;
1753{
1754register long word;
1755word = PCCM_TRIPLE(op, var, type);
1756p2word(word);
1757}
1758
1759
1760
1761
1762
1763p2name(s)
1764register char *s;
1765{
1766register int i;
1767
1768#ifdef UCBPASS2
1769 /* arbitrary length names, terminated by a null,
1770 padded to a full word */
1771
1772# define WL sizeof(long int)
1773 union { long int word; char str[WL]; } w;
1774
1775 w.word = 0;
1776 i = 0;
1777 while(w.str[i++] = *s++)
1778 if(i == WL)
1779 {
1780 p2word(w.word);
1781 w.word = 0;
1782 i = 0;
1783 }
1784 if(i > 0)
1785 p2word(w.word);
1786#else
1787 /* standard intermediate, names are 8 characters long */
1788
1789 union { long int word[2]; char str[8]; } u;
1790
1791 u.word[0] = u.word[1] = 0;
1792 for(i = 0 ; i<8 && *s ; ++i)
1793 u.str[i] = *s++;
1794 p2word(u.word[0]);
1795 p2word(u.word[1]);
1796
1797#endif
1798
1799}
1800
1801
1802
1803
1804p2word(w)
1805long int w;
1806{
1807*p2bufp++ = w;
1808if(p2bufp >= p2bufend)
1809 p2flush();
1810}
1811
1812
1813
1814p2flush()
1815{
1816if(p2bufp > p2buff)
1817 write(fileno(textfile), p2buff, (p2bufp-p2buff)*sizeof(long int));
1818p2bufp = p2buff;
1819}
1820
1821
1822
1823LOCAL
1824p2ldisp(offset, vname, type)
1825ftnint offset;
1826char *vname;
1827int type;
1828{
1829 char buff[100];
1830
1831 sprintf(buff, "%s-v.%d", vname, bsslabel);
1832 p2triple(PCC_OREG, LVARREG, type);
1833 p2word(offset);
1834 p2name(buff);
1835}
1836
1837
1838
1839p2ndisp(vname)
1840char *vname;
1841{
1842 char buff[100];
1843
1844 sprintf(buff, "%s-v.%d", vname, bsslabel);
1845 p2name(buff);
1846}
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.