122861Smckusick /* 222861Smckusick * Copyright (c) 1980 Regents of the University of California. 322861Smckusick * All rights reserved. The Berkeley software License Agreement 422861Smckusick * specifies the terms and conditions for redistribution. 522861Smckusick */ 622861Smckusick 722861Smckusick #ifndef lint 8*25103Sdonn static char sccsid[] = "@(#)proc.c 5.4 (Berkeley) 10/06/85"; 922861Smckusick #endif not lint 1022861Smckusick 1122861Smckusick /* 1222861Smckusick * proc.c 1322861Smckusick * 1422861Smckusick * Routines for handling procedures, f77 compiler, pass 1. 1522861Smckusick * 1622861Smckusick * University of Utah CS Dept modification history: 1722861Smckusick * 18*25103Sdonn * $Header: proc.c,v 5.3 85/09/30 23:21:07 donn Exp $ 1922861Smckusick * $Log: proc.c,v $ 20*25103Sdonn * Revision 5.3 85/09/30 23:21:07 donn 21*25103Sdonn * Print space with prspace() in outlocvars() so that alignment is preserved. 22*25103Sdonn * 2324484Sdonn * Revision 5.2 85/08/10 05:03:34 donn 2424484Sdonn * Support for NAMELIST i/o from Jerry Berkman. 2524484Sdonn * 2624484Sdonn * Revision 5.1 85/08/10 03:49:14 donn 2724484Sdonn * 4.3 alpha 2824484Sdonn * 2923477Smckusick * Revision 3.11 85/06/04 03:45:29 donn 3023477Smckusick * Changed retval() to recognize that a function declaration might have 3123477Smckusick * bombed out earlier, leaving an error node behind... 3223477Smckusick * 3322861Smckusick * Revision 3.10 85/03/08 23:13:06 donn 3422861Smckusick * Finally figured out why function calls and array elements are not legal 3522861Smckusick * dummy array dimension declarator elements. Hacked safedim() to stop 'em. 3622861Smckusick * 3722861Smckusick * Revision 3.9 85/02/02 00:26:10 donn 3822861Smckusick * Removed the call to entrystab() in enddcl() -- this was redundant (it was 3922861Smckusick * also done in startproc()) and confusing to dbx to boot. 4022861Smckusick * 4122861Smckusick * Revision 3.8 85/01/14 04:21:53 donn 4222861Smckusick * Added changes to implement Jerry's '-q' option. 4322861Smckusick * 4422861Smckusick * Revision 3.7 85/01/11 21:10:35 donn 4522861Smckusick * In conjunction with other changes to implement SAVE statements, function 4622861Smckusick * nameblocks were changed to make it appear that they are 'saved' too -- 4722861Smckusick * this arranges things so that function return values are forced out of 4822861Smckusick * register before a return. 4922861Smckusick * 5022861Smckusick * Revision 3.6 84/12/10 19:27:20 donn 5122861Smckusick * comblock() signals an illegal common block name by returning a null pointer, 5222861Smckusick * but incomm() wasn't able to handle it, leading to core dumps. I put the 5322861Smckusick * fix in incomm() to pick up null common blocks. 5422861Smckusick * 5522861Smckusick * Revision 3.5 84/11/21 20:33:31 donn 5622861Smckusick * It seems that I/O elements are treated as character strings so that their 5722861Smckusick * length can be passed to the I/O routines... Unfortunately the compiler 5822861Smckusick * assumes that no temporaries can be of type CHARACTER and casually tosses 5922861Smckusick * length and type info away when removing TEMP blocks. This has been fixed... 6022861Smckusick * 6122861Smckusick * Revision 3.4 84/11/05 22:19:30 donn 6222861Smckusick * Fixed a silly bug in the last fix. 6322861Smckusick * 6422861Smckusick * Revision 3.3 84/10/29 08:15:23 donn 6522861Smckusick * Added code to check the type and shape of subscript declarations, 6622861Smckusick * per Jerry Berkman's suggestion. 6722861Smckusick * 6822861Smckusick * Revision 3.2 84/10/29 05:52:07 donn 6922861Smckusick * Added change suggested by Jerry Berkman to report an error when an array 7022861Smckusick * is redimensioned. 7122861Smckusick * 7222861Smckusick * Revision 3.1 84/10/13 02:12:31 donn 7322861Smckusick * Merged Jerry Berkman's version into mine. 7422861Smckusick * 7522861Smckusick * Revision 2.1 84/07/19 12:04:09 donn 7622861Smckusick * Changed comment headers for UofU. 7722861Smckusick * 7822861Smckusick * Revision 1.6 84/07/19 11:32:15 donn 7922861Smckusick * Incorporated fix to setbound() to detect backward array subscript limits. 8022861Smckusick * The fix is by Bob Corbett, donated by Jerry Berkman. 8122861Smckusick * 8222861Smckusick * Revision 1.5 84/07/18 18:25:50 donn 8322861Smckusick * Fixed problem with doentry() where a placeholder for a return value 8422861Smckusick * was not allocated if the first entry didn't require one but a later 8522861Smckusick * entry did. 8622861Smckusick * 8722861Smckusick * Revision 1.4 84/05/24 20:52:09 donn 8822861Smckusick * Installed firewall #ifdef around the code that recycles stack temporaries, 8922861Smckusick * since it seems to be broken and lacks a good fix for the time being. 9022861Smckusick * 9122861Smckusick * Revision 1.3 84/04/16 09:50:46 donn 9222861Smckusick * Fixed mkargtemp() so that it only passes back a copy of a temporary, keeping 9322861Smckusick * the original for its own use. This fixes a set of bugs that are caused by 9422861Smckusick * elements in the argtemplist getting stomped on. 9522861Smckusick * 9622861Smckusick * Revision 1.2 84/02/28 21:12:58 donn 9722861Smckusick * Added Berkeley changes for subroutine call argument temporaries fix. 9822861Smckusick * 9922861Smckusick */ 10022861Smckusick 10122861Smckusick #include "defs.h" 10222861Smckusick 10322861Smckusick #ifdef SDB 10422861Smckusick # include <a.out.h> 10522861Smckusick # ifndef N_SO 10622861Smckusick # include <stab.h> 10722861Smckusick # endif 10822861Smckusick #endif 10922861Smckusick 11022861Smckusick extern flag namesflag; 11122861Smckusick 11222861Smckusick typedef 11322861Smckusick struct SizeList 11422861Smckusick { 11522861Smckusick struct SizeList *next; 11622861Smckusick ftnint size; 11722861Smckusick struct VarList *vars; 11822861Smckusick } 11922861Smckusick sizelist; 12022861Smckusick 12122861Smckusick 12222861Smckusick typedef 12322861Smckusick struct VarList 12422861Smckusick { 12522861Smckusick struct VarList *next; 12622861Smckusick Namep np; 12722861Smckusick struct Equivblock *ep; 12822861Smckusick } 12922861Smckusick varlist; 13022861Smckusick 13122861Smckusick 13222861Smckusick LOCAL sizelist *varsizes; 13322861Smckusick 13422861Smckusick 13522861Smckusick /* start a new procedure */ 13622861Smckusick 13722861Smckusick newproc() 13822861Smckusick { 13922861Smckusick if(parstate != OUTSIDE) 14022861Smckusick { 14122861Smckusick execerr("missing end statement", CNULL); 14222861Smckusick endproc(); 14322861Smckusick } 14422861Smckusick 14522861Smckusick parstate = INSIDE; 14622861Smckusick procclass = CLMAIN; /* default */ 14722861Smckusick } 14822861Smckusick 14922861Smckusick 15022861Smckusick 15122861Smckusick /* end of procedure. generate variables, epilogs, and prologs */ 15222861Smckusick 15322861Smckusick endproc() 15422861Smckusick { 15522861Smckusick struct Labelblock *lp; 15622861Smckusick 15722861Smckusick if(parstate < INDATA) 15822861Smckusick enddcl(); 15922861Smckusick if(ctlstack >= ctls) 16022861Smckusick err("DO loop or BLOCK IF not closed"); 16122861Smckusick for(lp = labeltab ; lp < labtabend ; ++lp) 16222861Smckusick if(lp->stateno!=0 && lp->labdefined==NO) 16322861Smckusick errstr("missing statement number %s", convic(lp->stateno) ); 16422861Smckusick 16522861Smckusick if (optimflag) 16622861Smckusick optimize(); 16722861Smckusick 16822861Smckusick outiodata(); 16922861Smckusick epicode(); 17022861Smckusick procode(); 17122861Smckusick donmlist(); 17222861Smckusick dobss(); 17322861Smckusick 17422861Smckusick #if FAMILY == PCC 17522861Smckusick putbracket(); 17622861Smckusick #endif 17722861Smckusick fixlwm(); 17822861Smckusick procinit(); /* clean up for next procedure */ 17922861Smckusick } 18022861Smckusick 18122861Smckusick 18222861Smckusick 18322861Smckusick /* End of declaration section of procedure. Allocate storage. */ 18422861Smckusick 18522861Smckusick enddcl() 18622861Smckusick { 18722861Smckusick register struct Entrypoint *ep; 18822861Smckusick 18922861Smckusick parstate = INEXEC; 19022861Smckusick docommon(); 19122861Smckusick doequiv(); 19222861Smckusick docomleng(); 19322861Smckusick for(ep = entries ; ep ; ep = ep->entnextp) { 19422861Smckusick doentry(ep); 19522861Smckusick } 19622861Smckusick } 19722861Smckusick 19822861Smckusick /* ROUTINES CALLED WHEN ENCOUNTERING ENTRY POINTS */ 19922861Smckusick 20022861Smckusick /* Main program or Block data */ 20122861Smckusick 20222861Smckusick startproc(prgname, class) 20322861Smckusick Namep prgname; 20422861Smckusick int class; 20522861Smckusick { 20622861Smckusick struct Extsym *progname; 20722861Smckusick register struct Entrypoint *p; 20822861Smckusick 20922861Smckusick if(prgname) 21022861Smckusick procname = prgname->varname; 21122861Smckusick if(namesflag == YES) { 21222861Smckusick fprintf(diagfile, " %s", (class==CLMAIN ? "MAIN" : "BLOCK DATA") ); 21322861Smckusick if(prgname) 21422861Smckusick fprintf(diagfile, " %s", varstr(XL, procname) ); 21522861Smckusick fprintf(diagfile, ":\n"); 21622861Smckusick } 21722861Smckusick 21822861Smckusick if( prgname ) 21922861Smckusick progname = newentry( prgname ); 22022861Smckusick else 22122861Smckusick progname = NULL; 22222861Smckusick 22322861Smckusick p = ALLOC(Entrypoint); 22422861Smckusick if(class == CLMAIN) 22522861Smckusick puthead("MAIN_", CLMAIN); 22622861Smckusick else 22722861Smckusick puthead(CNULL, CLBLOCK); 22822861Smckusick if(class == CLMAIN) 22922861Smckusick newentry( mkname(5, "MAIN") ); 23022861Smckusick p->entryname = progname; 23122861Smckusick p->entrylabel = newlabel(); 23222861Smckusick entries = p; 23322861Smckusick 23422861Smckusick procclass = class; 23522861Smckusick retlabel = newlabel(); 23622861Smckusick #ifdef SDB 23722861Smckusick if(sdbflag) { 23822861Smckusick entrystab(p,class); 23922861Smckusick } 24022861Smckusick #endif 24122861Smckusick } 24222861Smckusick 24322861Smckusick /* subroutine or function statement */ 24422861Smckusick 24522861Smckusick struct Extsym *newentry(v) 24622861Smckusick register Namep v; 24722861Smckusick { 24822861Smckusick register struct Extsym *p; 24922861Smckusick 25022861Smckusick p = mkext( varunder(VL, v->varname) ); 25122861Smckusick 25222861Smckusick if(p==NULL || p->extinit || ! ONEOF(p->extstg, M(STGUNKNOWN)|M(STGEXT)) ) 25322861Smckusick { 25422861Smckusick if(p == 0) 25522861Smckusick dclerr("invalid entry name", v); 25622861Smckusick else dclerr("external name already used", v); 25722861Smckusick return(0); 25822861Smckusick } 25922861Smckusick v->vstg = STGAUTO; 26022861Smckusick v->vprocclass = PTHISPROC; 26122861Smckusick v->vclass = CLPROC; 26222861Smckusick p->extstg = STGEXT; 26322861Smckusick p->extinit = YES; 26422861Smckusick return(p); 26522861Smckusick } 26622861Smckusick 26722861Smckusick 26822861Smckusick entrypt(class, type, length, entname, args) 26922861Smckusick int class, type; 27022861Smckusick ftnint length; 27122861Smckusick Namep entname; 27222861Smckusick chainp args; 27322861Smckusick { 27422861Smckusick struct Extsym *entry; 27522861Smckusick register Namep q; 27622861Smckusick register struct Entrypoint *p, *ep; 27722861Smckusick 27822861Smckusick if(namesflag == YES) { 27922861Smckusick if(class == CLENTRY) 28022861Smckusick fprintf(diagfile, " entry "); 28122861Smckusick if(entname) 28222861Smckusick fprintf(diagfile, " %s", varstr(XL, entname->varname) ); 28322861Smckusick fprintf(diagfile, ":\n"); 28422861Smckusick } 28522861Smckusick 28622861Smckusick if( entname->vclass == CLPARAM ) { 28722861Smckusick errstr("entry name %s used in 'parameter' statement", 28822861Smckusick varstr(XL, entname->varname) ); 28922861Smckusick return; 29022861Smckusick } 29122861Smckusick if( ((type == TYSUBR) || (class == CLENTRY && proctype == TYSUBR)) 29222861Smckusick && (entname->vtype != TYUNKNOWN && entname->vtype != TYSUBR) ) { 29322861Smckusick errstr("subroutine entry %s previously declared", 29422861Smckusick varstr(XL, entname->varname) ); 29522861Smckusick return; 29622861Smckusick } 29722861Smckusick if( (entname->vstg != STGEXT && entname->vstg != STGUNKNOWN) 29822861Smckusick || (entname->vdim != NULL) ) { 29922861Smckusick errstr("subroutine or function entry %s previously declared", 30022861Smckusick varstr(XL, entname->varname) ); 30122861Smckusick return; 30222861Smckusick } 30322861Smckusick 30422861Smckusick if( (class == CLPROC || class == CLENTRY) && type != TYSUBR ) 30522861Smckusick /* arrange to save function return values */ 30622861Smckusick entname->vsave = YES; 30722861Smckusick 30822861Smckusick entry = newentry( entname ); 30922861Smckusick 31022861Smckusick if(class != CLENTRY) 31122861Smckusick puthead( varstr(XL, procname = entry->extname), class); 31222861Smckusick q = mkname(VL, nounder(XL,entry->extname) ); 31322861Smckusick 31422861Smckusick if( (type = lengtype(type, (int) length)) != TYCHAR) 31522861Smckusick length = 0; 31622861Smckusick if(class == CLPROC) 31722861Smckusick { 31822861Smckusick procclass = CLPROC; 31922861Smckusick proctype = type; 32022861Smckusick procleng = length; 32122861Smckusick 32222861Smckusick retlabel = newlabel(); 32322861Smckusick if(type == TYSUBR) 32422861Smckusick ret0label = newlabel(); 32522861Smckusick } 32622861Smckusick 32722861Smckusick p = ALLOC(Entrypoint); 32822861Smckusick if(entries) /* put new block at end of entries list */ 32922861Smckusick { 33022861Smckusick for(ep = entries; ep->entnextp; ep = ep->entnextp) 33122861Smckusick ; 33222861Smckusick ep->entnextp = p; 33322861Smckusick } 33422861Smckusick else 33522861Smckusick entries = p; 33622861Smckusick 33722861Smckusick p->entryname = entry; 33822861Smckusick p->arglist = args; 33922861Smckusick p->entrylabel = newlabel(); 34022861Smckusick p->enamep = q; 34122861Smckusick 34222861Smckusick if(class == CLENTRY) 34322861Smckusick { 34422861Smckusick class = CLPROC; 34522861Smckusick if(proctype == TYSUBR) 34622861Smckusick type = TYSUBR; 34722861Smckusick } 34822861Smckusick 34922861Smckusick q->vclass = class; 35022861Smckusick q->vprocclass = PTHISPROC; 35122861Smckusick settype(q, type, (int) length); 35222861Smckusick /* hold all initial entry points till end of declarations */ 35322861Smckusick if(parstate >= INDATA) { 35422861Smckusick doentry(p); 35522861Smckusick } 35622861Smckusick #ifdef SDB 35722861Smckusick if(sdbflag) 35822861Smckusick { /* may need to preserve CLENTRY here */ 35922861Smckusick entrystab(p,class); 36022861Smckusick } 36122861Smckusick #endif 36222861Smckusick } 36322861Smckusick 36422861Smckusick /* generate epilogs */ 36522861Smckusick 36622861Smckusick LOCAL epicode() 36722861Smckusick { 36822861Smckusick register int i; 36922861Smckusick 37022861Smckusick if(procclass==CLPROC) 37122861Smckusick { 37222861Smckusick if(proctype==TYSUBR) 37322861Smckusick { 37422861Smckusick putlabel(ret0label); 37522861Smckusick if(substars) 37622861Smckusick putforce(TYINT, ICON(0) ); 37722861Smckusick putlabel(retlabel); 37822861Smckusick goret(TYSUBR); 37922861Smckusick } 38022861Smckusick else { 38122861Smckusick putlabel(retlabel); 38222861Smckusick if(multitype) 38322861Smckusick { 38422861Smckusick typeaddr = autovar(1, TYADDR, PNULL); 38522861Smckusick putbranch( cpexpr(typeaddr) ); 38622861Smckusick for(i = 0; i < NTYPES ; ++i) 38722861Smckusick if(rtvlabel[i] != 0) 38822861Smckusick { 38922861Smckusick putlabel(rtvlabel[i]); 39022861Smckusick retval(i); 39122861Smckusick } 39222861Smckusick } 39322861Smckusick else 39422861Smckusick retval(proctype); 39522861Smckusick } 39622861Smckusick } 39722861Smckusick 39822861Smckusick else if(procclass != CLBLOCK) 39922861Smckusick { 40022861Smckusick putlabel(retlabel); 40122861Smckusick goret(TYSUBR); 40222861Smckusick } 40322861Smckusick } 40422861Smckusick 40522861Smckusick 40622861Smckusick /* generate code to return value of type t */ 40722861Smckusick 40822861Smckusick LOCAL retval(t) 40922861Smckusick register int t; 41022861Smckusick { 41122861Smckusick register Addrp p; 41222861Smckusick 41322861Smckusick switch(t) 41422861Smckusick { 41522861Smckusick case TYCHAR: 41622861Smckusick case TYCOMPLEX: 41722861Smckusick case TYDCOMPLEX: 41822861Smckusick break; 41922861Smckusick 42022861Smckusick case TYLOGICAL: 42122861Smckusick t = tylogical; 42222861Smckusick case TYADDR: 42322861Smckusick case TYSHORT: 42422861Smckusick case TYLONG: 42522861Smckusick p = (Addrp) cpexpr(retslot); 42622861Smckusick p->vtype = t; 42722861Smckusick putforce(t, p); 42822861Smckusick break; 42922861Smckusick 43022861Smckusick case TYREAL: 43122861Smckusick case TYDREAL: 43222861Smckusick p = (Addrp) cpexpr(retslot); 43322861Smckusick p->vtype = t; 43422861Smckusick putforce(t, p); 43522861Smckusick break; 43622861Smckusick 43723477Smckusick case TYERROR: 43823477Smckusick return; /* someone else already complained */ 43923477Smckusick 44022861Smckusick default: 44122861Smckusick badtype("retval", t); 44222861Smckusick } 44322861Smckusick goret(t); 44422861Smckusick } 44522861Smckusick 44622861Smckusick 44722861Smckusick /* Allocate extra argument array if needed. Generate prologs. */ 44822861Smckusick 44922861Smckusick LOCAL procode() 45022861Smckusick { 45122861Smckusick register struct Entrypoint *p; 45222861Smckusick Addrp argvec; 45322861Smckusick 45422861Smckusick #if TARGET==GCOS 45522861Smckusick argvec = autovar(lastargslot/SZADDR, TYADDR, PNULL); 45622861Smckusick #else 45722861Smckusick if(lastargslot>0 && nentry>1) 45822861Smckusick #if TARGET == VAX 45922861Smckusick argvec = autovar(1 + lastargslot/SZADDR, TYADDR, PNULL); 46022861Smckusick #else 46122861Smckusick argvec = autovar(lastargslot/SZADDR, TYADDR, PNULL); 46222861Smckusick #endif 46322861Smckusick else 46422861Smckusick argvec = NULL; 46522861Smckusick #endif 46622861Smckusick 46722861Smckusick 46822861Smckusick #if TARGET == PDP11 46922861Smckusick /* for the optimizer */ 47022861Smckusick if(fudgelabel) 47122861Smckusick putlabel(fudgelabel); 47222861Smckusick #endif 47322861Smckusick 47422861Smckusick for(p = entries ; p ; p = p->entnextp) 47522861Smckusick prolog(p, argvec); 47622861Smckusick 47722861Smckusick #if FAMILY == PCC 47822861Smckusick putrbrack(procno); 47922861Smckusick #endif 48022861Smckusick 48122861Smckusick prendproc(); 48222861Smckusick } 48322861Smckusick 48422861Smckusick 48522861Smckusick /* 48622861Smckusick manipulate argument lists (allocate argument slot positions) 48722861Smckusick * keep track of return types and labels 48822861Smckusick */ 48922861Smckusick 49022861Smckusick LOCAL doentry(ep) 49122861Smckusick struct Entrypoint *ep; 49222861Smckusick { 49322861Smckusick register int type; 49422861Smckusick register Namep np; 49522861Smckusick chainp p; 49622861Smckusick register Namep q; 49722861Smckusick Addrp mkarg(); 49822861Smckusick 49922861Smckusick ++nentry; 50022861Smckusick if(procclass == CLMAIN) 50122861Smckusick { 50222861Smckusick if (optimflag) 50322861Smckusick optbuff (SKLABEL, 0, ep->entrylabel, 0); 50422861Smckusick else 50522861Smckusick putlabel(ep->entrylabel); 50622861Smckusick return; 50722861Smckusick } 50822861Smckusick else if(procclass == CLBLOCK) 50922861Smckusick return; 51022861Smckusick 51122861Smckusick impldcl( np = mkname(VL, nounder(XL, ep->entryname->extname) ) ); 51222861Smckusick type = np->vtype; 51322861Smckusick if(proctype == TYUNKNOWN) 51422861Smckusick if( (proctype = type) == TYCHAR) 51522861Smckusick procleng = (np->vleng ? np->vleng->constblock.const.ci : (ftnint) (-1)); 51622861Smckusick 51722861Smckusick if(proctype == TYCHAR) 51822861Smckusick { 51922861Smckusick if(type != TYCHAR) 52022861Smckusick err("noncharacter entry of character function"); 52122861Smckusick else if( (np->vleng ? np->vleng->constblock.const.ci : (ftnint) (-1)) != procleng) 52222861Smckusick err("mismatched character entry lengths"); 52322861Smckusick } 52422861Smckusick else if(type == TYCHAR) 52522861Smckusick err("character entry of noncharacter function"); 52622861Smckusick else if(type != proctype) 52722861Smckusick multitype = YES; 52822861Smckusick if(rtvlabel[type] == 0) 52922861Smckusick rtvlabel[type] = newlabel(); 53022861Smckusick ep->typelabel = rtvlabel[type]; 53122861Smckusick 53222861Smckusick if(type == TYCHAR) 53322861Smckusick { 53422861Smckusick if(chslot < 0) 53522861Smckusick { 53622861Smckusick chslot = nextarg(TYADDR); 53722861Smckusick chlgslot = nextarg(TYLENG); 53822861Smckusick } 53922861Smckusick np->vstg = STGARG; 54022861Smckusick np->vardesc.varno = chslot; 54122861Smckusick if(procleng < 0) 54222861Smckusick np->vleng = (expptr) mkarg(TYLENG, chlgslot); 54322861Smckusick } 54422861Smckusick else if( ISCOMPLEX(type) ) 54522861Smckusick { 54622861Smckusick np->vstg = STGARG; 54722861Smckusick if(cxslot < 0) 54822861Smckusick cxslot = nextarg(TYADDR); 54922861Smckusick np->vardesc.varno = cxslot; 55022861Smckusick } 55122861Smckusick else if(type != TYSUBR) 55222861Smckusick { 55322861Smckusick if(retslot == NULL) 55422861Smckusick retslot = autovar(1, TYDREAL, PNULL); 55522861Smckusick np->vstg = STGAUTO; 55622861Smckusick np->voffset = retslot->memoffset->constblock.const.ci; 55722861Smckusick } 55822861Smckusick 55922861Smckusick for(p = ep->arglist ; p ; p = p->nextp) 56022861Smckusick if(! (( q = (Namep) (p->datap) )->vdcldone) ) 56122861Smckusick q->vardesc.varno = nextarg(TYADDR); 56222861Smckusick 56322861Smckusick for(p = ep->arglist ; p ; p = p->nextp) 56422861Smckusick if(! (( q = (Namep) (p->datap) )->vdcldone) ) 56522861Smckusick { 56622861Smckusick impldcl(q); 56722861Smckusick q->vdcldone = YES; 56822861Smckusick if(q->vtype == TYCHAR) 56922861Smckusick { 57022861Smckusick if(q->vleng == NULL) /* character*(*) */ 57122861Smckusick q->vleng = (expptr) 57222861Smckusick mkarg(TYLENG, nextarg(TYLENG) ); 57322861Smckusick else if(nentry == 1) 57422861Smckusick nextarg(TYLENG); 57522861Smckusick } 57622861Smckusick else if(q->vclass==CLPROC && nentry==1) 57722861Smckusick nextarg(TYLENG) ; 57822861Smckusick #ifdef SDB 57922861Smckusick if(sdbflag) { 58022861Smckusick namestab(q); 58122861Smckusick } 58222861Smckusick #endif 58322861Smckusick } 58422861Smckusick 58522861Smckusick if (optimflag) 58622861Smckusick optbuff (SKLABEL, 0, ep->entrylabel, 0); 58722861Smckusick else 58822861Smckusick putlabel(ep->entrylabel); 58922861Smckusick } 59022861Smckusick 59122861Smckusick 59222861Smckusick 59322861Smckusick LOCAL nextarg(type) 59422861Smckusick int type; 59522861Smckusick { 59622861Smckusick int k; 59722861Smckusick k = lastargslot; 59822861Smckusick lastargslot += typesize[type]; 59922861Smckusick return(k); 60022861Smckusick } 60122861Smckusick 60222861Smckusick /* generate variable references */ 60322861Smckusick 60422861Smckusick LOCAL dobss() 60522861Smckusick { 60622861Smckusick register struct Hashentry *p; 60722861Smckusick register Namep q; 60822861Smckusick register int i; 60922861Smckusick int align; 61022861Smckusick ftnint leng, iarrl; 61122861Smckusick char *memname(); 61222861Smckusick int qstg, qclass, qtype; 61322861Smckusick 61422861Smckusick pruse(asmfile, USEBSS); 61522861Smckusick varsizes = NULL; 61622861Smckusick 61722861Smckusick for(p = hashtab ; p<lasthash ; ++p) 61822861Smckusick if(q = p->varp) 61922861Smckusick { 62022861Smckusick qstg = q->vstg; 62122861Smckusick qtype = q->vtype; 62222861Smckusick qclass = q->vclass; 62322861Smckusick 62422861Smckusick if( (qclass==CLUNKNOWN && qstg!=STGARG) || 62522861Smckusick (qclass==CLVAR && qstg==STGUNKNOWN) ) 62622861Smckusick warn1("local variable %s never used", varstr(VL,q->varname) ); 62722861Smckusick else if(qclass==CLPROC && q->vprocclass==PEXTERNAL && qstg!=STGARG) 62822861Smckusick mkext(varunder(VL, q->varname)) ->extstg = STGEXT; 62922861Smckusick 63022861Smckusick if (qclass == CLVAR && qstg == STGBSS) 63122861Smckusick { 63222861Smckusick if (SMALLVAR(q->varsize)) 63322861Smckusick { 63422861Smckusick enlist(q->varsize, q, NULL); 63522861Smckusick q->inlcomm = NO; 63622861Smckusick } 63722861Smckusick else 63822861Smckusick { 63922861Smckusick if (q->init == NO) 64022861Smckusick { 64122861Smckusick preven(ALIDOUBLE); 64222861Smckusick prlocvar(memname(qstg, q->vardesc.varno), q->varsize); 64322861Smckusick q->inlcomm = YES; 64422861Smckusick } 64522861Smckusick else 64622861Smckusick prlocdata(memname(qstg, q->vardesc.varno), q->varsize, 64722861Smckusick q->vtype, q->initoffset, &(q->inlcomm)); 64822861Smckusick } 64922861Smckusick } 65022861Smckusick else if(qclass==CLVAR && qstg!=STGARG) 65122861Smckusick { 65222861Smckusick if(q->vdim && !ISICON(q->vdim->nelt) ) 65322861Smckusick dclerr("adjustable dimension on non-argument", q); 65422861Smckusick if(qtype==TYCHAR && (q->vleng==NULL || !ISICON(q->vleng))) 65522861Smckusick dclerr("adjustable leng on nonargument", q); 65622861Smckusick } 65722861Smckusick 65822861Smckusick chkdim(q); 65922861Smckusick } 66022861Smckusick 66122861Smckusick for (i = 0 ; i < nequiv ; ++i) 66222861Smckusick if ( (leng = eqvclass[i].eqvleng) != 0 ) 66322861Smckusick { 66422861Smckusick if (SMALLVAR(leng)) 66522861Smckusick enlist(leng, NULL, eqvclass + i); 66622861Smckusick else if (eqvclass[i].init == NO) 66722861Smckusick { 66822861Smckusick preven(ALIDOUBLE); 66922861Smckusick prlocvar(memname(STGEQUIV, i), leng); 67022861Smckusick eqvclass[i].inlcomm = YES; 67122861Smckusick } 67222861Smckusick else 67322861Smckusick prlocdata(memname(STGEQUIV, i), leng, TYDREAL, 67422861Smckusick eqvclass[i].initoffset, &(eqvclass[i].inlcomm)); 67522861Smckusick } 67622861Smckusick 67722861Smckusick outlocvars(); 67822861Smckusick #ifdef SDB 67922861Smckusick if(sdbflag) { 68022861Smckusick for(p = hashtab ; p<lasthash ; ++p) if(q = p->varp) { 68122861Smckusick qstg = q->vstg; 68222861Smckusick qclass = q->vclass; 68322861Smckusick if( ONEOF(qclass, M(CLVAR))) { 68422861Smckusick if (! ONEOF(qstg,M(STGCOMMON)|M(STGARG) ) ) namestab(q); 68522861Smckusick } 68622861Smckusick } 68722861Smckusick } 68822861Smckusick #endif 68922861Smckusick 69022861Smckusick close(vdatafile); 69122861Smckusick close(vchkfile); 69222861Smckusick unlink(vdatafname); 69322861Smckusick unlink(vchkfname); 69422861Smckusick vdatahwm = 0; 69522861Smckusick } 69622861Smckusick 69722861Smckusick 69822861Smckusick 69922861Smckusick donmlist() 70022861Smckusick { 70122861Smckusick register struct Hashentry *p; 70222861Smckusick register Namep q; 70322861Smckusick 70422861Smckusick pruse(asmfile, USEINIT); 70522861Smckusick 70622861Smckusick for(p=hashtab; p<lasthash; ++p) 70722861Smckusick if( (q = p->varp) && q->vclass==CLNAMELIST) 70822861Smckusick namelist(q); 70922861Smckusick } 71022861Smckusick 71122861Smckusick 71222861Smckusick doext() 71322861Smckusick { 71422861Smckusick struct Extsym *p; 71522861Smckusick 71622861Smckusick for(p = extsymtab ; p<nextext ; ++p) 71722861Smckusick prext(p); 71822861Smckusick } 71922861Smckusick 72022861Smckusick 72122861Smckusick 72222861Smckusick 72322861Smckusick ftnint iarrlen(q) 72422861Smckusick register Namep q; 72522861Smckusick { 72622861Smckusick ftnint leng; 72722861Smckusick 72822861Smckusick leng = typesize[q->vtype]; 72922861Smckusick if(leng <= 0) 73022861Smckusick return(-1); 73122861Smckusick if(q->vdim) 73222861Smckusick if( ISICON(q->vdim->nelt) ) 73322861Smckusick leng *= q->vdim->nelt->constblock.const.ci; 73422861Smckusick else return(-1); 73522861Smckusick if(q->vleng) 73622861Smckusick if( ISICON(q->vleng) ) 73722861Smckusick leng *= q->vleng->constblock.const.ci; 73822861Smckusick else return(-1); 73922861Smckusick return(leng); 74022861Smckusick } 74122861Smckusick 74222861Smckusick /* This routine creates a static block representing the namelist. 74322861Smckusick An equivalent declaration of the structure produced is: 74422861Smckusick struct namelist 74522861Smckusick { 74622861Smckusick char namelistname[16]; 74722861Smckusick struct namelistentry 74822861Smckusick { 74924484Sdonn char varname[16]; # 16 plus null padding -> 20 75022861Smckusick char *varaddr; 75124484Sdonn short int type; 75224484Sdonn short int len; # length of type 75322861Smckusick struct dimensions *dimp; # null means scalar 75422861Smckusick } names[]; 75522861Smckusick }; 75622861Smckusick 75722861Smckusick struct dimensions 75822861Smckusick { 75922861Smckusick int numberofdimensions; 76022861Smckusick int numberofelements 76122861Smckusick int baseoffset; 76222861Smckusick int span[numberofdimensions]; 76322861Smckusick }; 76422861Smckusick where the namelistentry list terminates with a null varname 76522861Smckusick If dimp is not null, then the corner element of the array is at 76622861Smckusick varaddr. However, the element with subscripts (i1,...,in) is at 76722861Smckusick varaddr - dimp->baseoffset + sizeoftype * (i1+span[0]*(i2+span[1]*...) 76822861Smckusick */ 76922861Smckusick 77022861Smckusick namelist(np) 77122861Smckusick Namep np; 77222861Smckusick { 77322861Smckusick register chainp q; 77422861Smckusick register Namep v; 77522861Smckusick register struct Dimblock *dp; 77622861Smckusick char *memname(); 77722861Smckusick int type, dimno, dimoffset; 77822861Smckusick flag bad; 77922861Smckusick 78022861Smckusick 78122861Smckusick preven(ALILONG); 78222861Smckusick fprintf(asmfile, LABELFMT, memname(STGINIT, np->vardesc.varno)); 78322861Smckusick putstr(asmfile, varstr(VL, np->varname), 16); 78422861Smckusick dimno = ++lastvarno; 78522861Smckusick dimoffset = 0; 78622861Smckusick bad = NO; 78722861Smckusick 78822861Smckusick for(q = np->varxptr.namelist ; q ; q = q->nextp) 78922861Smckusick { 79022861Smckusick vardcl( v = (Namep) (q->datap) ); 79122861Smckusick type = v->vtype; 79222861Smckusick if( ONEOF(v->vstg, MSKSTATIC) ) 79322861Smckusick { 79422861Smckusick preven(ALILONG); 79522861Smckusick putstr(asmfile, varstr(VL,v->varname), 16); 79622861Smckusick praddr(asmfile, v->vstg, v->vardesc.varno, v->voffset); 79724484Sdonn prconi(asmfile, TYSHORT, type ); 79824484Sdonn prconi(asmfile, TYSHORT, 79922861Smckusick type==TYCHAR ? 80024484Sdonn (v->vleng->constblock.const.ci) : 80124484Sdonn (ftnint) typesize[type]); 80222861Smckusick if(v->vdim) 80322861Smckusick { 80422861Smckusick praddr(asmfile, STGINIT, dimno, (ftnint)dimoffset); 80524484Sdonn dimoffset += (3 + v->vdim->ndim) * SZINT; 80622861Smckusick } 80722861Smckusick else 80822861Smckusick praddr(asmfile, STGNULL,0,(ftnint) 0); 80922861Smckusick } 81022861Smckusick else 81122861Smckusick { 81222861Smckusick dclerr("may not appear in namelist", v); 81322861Smckusick bad = YES; 81422861Smckusick } 81522861Smckusick } 81622861Smckusick 81722861Smckusick if(bad) 81822861Smckusick return; 81922861Smckusick 82022861Smckusick putstr(asmfile, "", 16); 82122861Smckusick 82222861Smckusick if(dimoffset > 0) 82322861Smckusick { 82422861Smckusick fprintf(asmfile, LABELFMT, memname(STGINIT,dimno)); 82522861Smckusick for(q = np->varxptr.namelist ; q ; q = q->nextp) 82622861Smckusick if(dp = q->datap->nameblock.vdim) 82722861Smckusick { 82822861Smckusick int i; 82922861Smckusick prconi(asmfile, TYINT, (ftnint) (dp->ndim) ); 83022861Smckusick prconi(asmfile, TYINT, 83122861Smckusick (ftnint) (dp->nelt->constblock.const.ci) ); 83222861Smckusick prconi(asmfile, TYINT, 83322861Smckusick (ftnint) (dp->baseoffset->constblock.const.ci)); 83422861Smckusick for(i=0; i<dp->ndim ; ++i) 83522861Smckusick prconi(asmfile, TYINT, 83622861Smckusick dp->dims[i].dimsize->constblock.const.ci); 83722861Smckusick } 83822861Smckusick } 83922861Smckusick 84022861Smckusick } 84122861Smckusick 84222861Smckusick LOCAL docommon() 84322861Smckusick { 84422861Smckusick register struct Extsym *p; 84522861Smckusick register chainp q; 84622861Smckusick struct Dimblock *t; 84722861Smckusick expptr neltp; 84822861Smckusick register Namep v; 84922861Smckusick ftnint size; 85022861Smckusick int type; 85122861Smckusick 85222861Smckusick for(p = extsymtab ; p<nextext ; ++p) 85322861Smckusick if(p->extstg==STGCOMMON) 85422861Smckusick { 85522861Smckusick #ifdef SDB 85622861Smckusick if(sdbflag) 85722861Smckusick prstab(varstr(XL,p->extname), N_BCOMM, 0, 0); 85822861Smckusick #endif 85922861Smckusick for(q = p->extp ; q ; q = q->nextp) 86022861Smckusick { 86122861Smckusick v = (Namep) (q->datap); 86222861Smckusick if(v->vdcldone == NO) 86322861Smckusick vardcl(v); 86422861Smckusick type = v->vtype; 86522861Smckusick if(p->extleng % typealign[type] != 0) 86622861Smckusick { 86722861Smckusick dclerr("common alignment", v); 86822861Smckusick p->extleng = roundup(p->extleng, typealign[type]); 86922861Smckusick } 87022861Smckusick v->voffset = p->extleng; 87122861Smckusick v->vardesc.varno = p - extsymtab; 87222861Smckusick if(type == TYCHAR) 87322861Smckusick size = v->vleng->constblock.const.ci; 87422861Smckusick else size = typesize[type]; 87522861Smckusick if(t = v->vdim) 87622861Smckusick if( (neltp = t->nelt) && ISCONST(neltp) ) 87722861Smckusick size *= neltp->constblock.const.ci; 87822861Smckusick else 87922861Smckusick dclerr("adjustable array in common", v); 88022861Smckusick p->extleng += size; 88122861Smckusick #ifdef SDB 88222861Smckusick if(sdbflag) 88322861Smckusick { 88422861Smckusick namestab(v); 88522861Smckusick } 88622861Smckusick #endif 88722861Smckusick } 88822861Smckusick 88922861Smckusick frchain( &(p->extp) ); 89022861Smckusick #ifdef SDB 89122861Smckusick if(sdbflag) 89222861Smckusick prstab(varstr(XL,p->extname), N_ECOMM, 0, 0); 89322861Smckusick #endif 89422861Smckusick } 89522861Smckusick } 89622861Smckusick 89722861Smckusick 89822861Smckusick 89922861Smckusick 90022861Smckusick 90122861Smckusick LOCAL docomleng() 90222861Smckusick { 90322861Smckusick register struct Extsym *p; 90422861Smckusick 90522861Smckusick for(p = extsymtab ; p < nextext ; ++p) 90622861Smckusick if(p->extstg == STGCOMMON) 90722861Smckusick { 90822861Smckusick if(p->maxleng!=0 && p->extleng!=0 && p->maxleng!=p->extleng 90922861Smckusick && !eqn(XL,"_BLNK__ ",p->extname) ) 91022861Smckusick warn1("incompatible lengths for common block %s", 91122861Smckusick nounder(XL, p->extname) ); 91222861Smckusick if(p->maxleng < p->extleng) 91322861Smckusick p->maxleng = p->extleng; 91422861Smckusick p->extleng = 0; 91522861Smckusick } 91622861Smckusick } 91722861Smckusick 91822861Smckusick 91922861Smckusick 92022861Smckusick 92122861Smckusick /* ROUTINES DEALING WITH AUTOMATIC AND TEMPORARY STORAGE */ 92222861Smckusick 92322861Smckusick /* frees a temporary block */ 92422861Smckusick 92522861Smckusick frtemp(p) 92622861Smckusick Tempp p; 92722861Smckusick { 92822861Smckusick Addrp t; 92922861Smckusick 93022861Smckusick if (optimflag) 93122861Smckusick { 93222861Smckusick if (p->tag != TTEMP) 93322861Smckusick badtag ("frtemp",p->tag); 93422861Smckusick t = p->memalloc; 93522861Smckusick } 93622861Smckusick else 93722861Smckusick t = (Addrp) p; 93822861Smckusick 93922861Smckusick /* restore clobbered character string lengths */ 94022861Smckusick if(t->vtype==TYCHAR && t->varleng!=0) 94122861Smckusick { 94222861Smckusick frexpr(t->vleng); 94322861Smckusick t->vleng = ICON(t->varleng); 94422861Smckusick } 94522861Smckusick 94622861Smckusick /* put block on chain of temps to be reclaimed */ 94722861Smckusick holdtemps = mkchain(t, holdtemps); 94822861Smckusick } 94922861Smckusick 95022861Smckusick 95122861Smckusick 95222861Smckusick /* allocate an automatic variable slot */ 95322861Smckusick 95422861Smckusick Addrp autovar(nelt, t, lengp) 95522861Smckusick register int nelt, t; 95622861Smckusick expptr lengp; 95722861Smckusick { 95822861Smckusick ftnint leng; 95922861Smckusick register Addrp q; 96022861Smckusick 96122861Smckusick if(lengp) 96222861Smckusick if( ISICON(lengp) ) 96322861Smckusick leng = lengp->constblock.const.ci; 96422861Smckusick else { 96522861Smckusick fatal("automatic variable of nonconstant length"); 96622861Smckusick } 96722861Smckusick else 96822861Smckusick leng = typesize[t]; 96922861Smckusick autoleng = roundup( autoleng, typealign[t]); 97022861Smckusick 97122861Smckusick q = ALLOC(Addrblock); 97222861Smckusick q->tag = TADDR; 97322861Smckusick q->vtype = t; 97422861Smckusick if(lengp) 97522861Smckusick { 97622861Smckusick q->vleng = ICON(leng); 97722861Smckusick q->varleng = leng; 97822861Smckusick } 97922861Smckusick q->vstg = STGAUTO; 98022861Smckusick q->memno = newlabel(); 98122861Smckusick q->ntempelt = nelt; 98222861Smckusick #if TARGET==PDP11 || TARGET==VAX 98322861Smckusick /* stack grows downward */ 98422861Smckusick autoleng += nelt*leng; 98522861Smckusick q->memoffset = ICON( - autoleng ); 98622861Smckusick #else 98722861Smckusick q->memoffset = ICON( autoleng ); 98822861Smckusick autoleng += nelt*leng; 98922861Smckusick #endif 99022861Smckusick 99122861Smckusick return(q); 99222861Smckusick } 99322861Smckusick 99422861Smckusick 99522861Smckusick 99622861Smckusick /* 99722861Smckusick * create a temporary block (TTEMP) when optimizing, 99822861Smckusick * an ordinary TADDR block when not optimizing 99922861Smckusick */ 100022861Smckusick 100122861Smckusick Tempp mktmpn(nelt, type, lengp) 100222861Smckusick int nelt; 100322861Smckusick register int type; 100422861Smckusick expptr lengp; 100522861Smckusick { 100622861Smckusick ftnint leng; 100722861Smckusick chainp p, oldp; 100822861Smckusick register Tempp q; 100922861Smckusick Addrp altemp; 101022861Smckusick 101122861Smckusick if (! optimflag) 101222861Smckusick return ( (Tempp) mkaltmpn(nelt,type,lengp) ); 101322861Smckusick if(type==TYUNKNOWN || type==TYERROR) 101422861Smckusick badtype("mktmpn", type); 101522861Smckusick 101622861Smckusick if(type==TYCHAR) 101722861Smckusick if( ISICON(lengp) ) 101822861Smckusick leng = lengp->constblock.const.ci; 101922861Smckusick else { 102022861Smckusick err("adjustable length"); 102122861Smckusick return( (Tempp) errnode() ); 102222861Smckusick } 102322861Smckusick else 102422861Smckusick leng = typesize[type]; 102522861Smckusick 102622861Smckusick q = ALLOC(Tempblock); 102722861Smckusick q->tag = TTEMP; 102822861Smckusick q->vtype = type; 102922861Smckusick if(type == TYCHAR) 103022861Smckusick { 103122861Smckusick q->vleng = ICON(leng); 103222861Smckusick q->varleng = leng; 103322861Smckusick } 103422861Smckusick 103522861Smckusick altemp = ALLOC(Addrblock); 103622861Smckusick altemp->tag = TADDR; 103722861Smckusick altemp->vstg = STGUNKNOWN; 103822861Smckusick q->memalloc = altemp; 103922861Smckusick 104022861Smckusick q->ntempelt = nelt; 104122861Smckusick q->istemp = YES; 104222861Smckusick return(q); 104322861Smckusick } 104422861Smckusick 104522861Smckusick 104622861Smckusick 104722861Smckusick Addrp mktemp(type, lengp) 104822861Smckusick int type; 104922861Smckusick expptr lengp; 105022861Smckusick { 105122861Smckusick return( (Addrp) mktmpn(1,type,lengp) ); 105222861Smckusick } 105322861Smckusick 105422861Smckusick 105522861Smckusick 105622861Smckusick /* allocate a temporary location for the given temporary block; 105722861Smckusick if already allocated, return its location */ 105822861Smckusick 105922861Smckusick Addrp altmpn(tp) 106022861Smckusick Tempp tp; 106122861Smckusick 106222861Smckusick { 106322861Smckusick Addrp t, q; 106422861Smckusick 106522861Smckusick if (tp->tag != TTEMP) 106622861Smckusick badtag ("altmpn",tp->tag); 106722861Smckusick 106822861Smckusick t = tp->memalloc; 106922861Smckusick if (t->vstg != STGUNKNOWN) 107022861Smckusick { 107122861Smckusick if (tp->vtype == TYCHAR) 107222861Smckusick { 107322861Smckusick /* 107422861Smckusick * Unformatted I/O parameters are treated like character 107522861Smckusick * strings (sigh) -- propagate type and length. 107622861Smckusick */ 107722861Smckusick t = (Addrp) cpexpr(t); 107822861Smckusick t->vtype = tp->vtype; 107922861Smckusick t->vleng = tp->vleng; 108022861Smckusick t->varleng = tp->varleng; 108122861Smckusick } 108222861Smckusick return (t); 108322861Smckusick } 108422861Smckusick 108522861Smckusick q = mkaltmpn (tp->ntempelt, tp->vtype, tp->vleng); 108622861Smckusick cpn (sizeof(struct Addrblock), (char*)q, (char*)t); 108722861Smckusick free ( (charptr) q); 108822861Smckusick return(t); 108922861Smckusick } 109022861Smckusick 109122861Smckusick 109222861Smckusick 109322861Smckusick /* create and allocate space immediately for a temporary */ 109422861Smckusick 109522861Smckusick Addrp mkaltemp(type,lengp) 109622861Smckusick int type; 109722861Smckusick expptr lengp; 109822861Smckusick { 109922861Smckusick return (mkaltmpn(1,type,lengp)); 110022861Smckusick } 110122861Smckusick 110222861Smckusick 110322861Smckusick 110422861Smckusick Addrp mkaltmpn(nelt,type,lengp) 110522861Smckusick int nelt; 110622861Smckusick register int type; 110722861Smckusick expptr lengp; 110822861Smckusick { 110922861Smckusick ftnint leng; 111022861Smckusick chainp p, oldp; 111122861Smckusick register Addrp q; 111222861Smckusick 111322861Smckusick if(type==TYUNKNOWN || type==TYERROR) 111422861Smckusick badtype("mkaltmpn", type); 111522861Smckusick 111622861Smckusick if(type==TYCHAR) 111722861Smckusick if( ISICON(lengp) ) 111822861Smckusick leng = lengp->constblock.const.ci; 111922861Smckusick else { 112022861Smckusick err("adjustable length"); 112122861Smckusick return( (Addrp) errnode() ); 112222861Smckusick } 112322861Smckusick 112422861Smckusick /* 112522861Smckusick * if a temporary of appropriate shape is on the templist, 112622861Smckusick * remove it from the list and return it 112722861Smckusick */ 112822861Smckusick 112922861Smckusick #ifdef notdef 113022861Smckusick /* 113122861Smckusick * This code is broken until SKFRTEMP slots can be processed in putopt() 113222861Smckusick * instead of in optimize() -- all kinds of things in putpcc.c can 113322861Smckusick * bomb because of this. Sigh. 113422861Smckusick */ 113522861Smckusick for(oldp=CHNULL, p=templist ; p ; oldp=p, p=p->nextp) 113622861Smckusick { 113722861Smckusick q = (Addrp) (p->datap); 113822861Smckusick if(q->vtype==type && q->ntempelt==nelt && 113922861Smckusick (type!=TYCHAR || q->vleng->constblock.const.ci==leng) ) 114022861Smckusick { 114122861Smckusick if(oldp) 114222861Smckusick oldp->nextp = p->nextp; 114322861Smckusick else 114422861Smckusick templist = p->nextp; 114522861Smckusick free( (charptr) p); 114622861Smckusick 114722861Smckusick if (debugflag[14]) 114822861Smckusick fprintf(diagfile,"mkaltmpn reusing offset %d\n", 114922861Smckusick q->memoffset->constblock.const.ci); 115022861Smckusick return(q); 115122861Smckusick } 115222861Smckusick } 115322861Smckusick #endif notdef 115422861Smckusick q = autovar(nelt, type, lengp); 115522861Smckusick q->istemp = YES; 115622861Smckusick 115722861Smckusick if (debugflag[14]) 115822861Smckusick fprintf(diagfile,"mkaltmpn new offset %d\n", 115922861Smckusick q->memoffset->constblock.const.ci); 116022861Smckusick return(q); 116122861Smckusick } 116222861Smckusick 116322861Smckusick 116422861Smckusick 116522861Smckusick /* The following routine is a patch which is only needed because the */ 116622861Smckusick /* code for processing actual arguments for calls does not allocate */ 116722861Smckusick /* the temps it needs before optimization takes place. A better */ 116822861Smckusick /* solution is possible, but I do not have the time to implement it */ 116922861Smckusick /* now. */ 117022861Smckusick /* */ 117122861Smckusick /* Robert P. Corbett */ 117222861Smckusick 117322861Smckusick Addrp 117422861Smckusick mkargtemp(type, lengp) 117522861Smckusick int type; 117622861Smckusick expptr lengp; 117722861Smckusick { 117822861Smckusick ftnint leng; 117922861Smckusick chainp oldp, p; 118022861Smckusick Addrp q; 118122861Smckusick 118222861Smckusick if (type == TYUNKNOWN || type == TYERROR) 118322861Smckusick badtype("mkargtemp", type); 118422861Smckusick 118522861Smckusick if (type == TYCHAR) 118622861Smckusick { 118722861Smckusick if (ISICON(lengp)) 118822861Smckusick leng = lengp->constblock.const.ci; 118922861Smckusick else 119022861Smckusick { 119122861Smckusick err("adjustable length"); 119222861Smckusick return ((Addrp) errnode()); 119322861Smckusick } 119422861Smckusick } 119522861Smckusick 119622861Smckusick oldp = CHNULL; 119722861Smckusick p = argtemplist; 119822861Smckusick 119922861Smckusick while (p) 120022861Smckusick { 120122861Smckusick q = (Addrp) (p->datap); 120222861Smckusick if (q->vtype == type 120322861Smckusick && (type != TYCHAR || q->vleng->constblock.const.ci == leng)) 120422861Smckusick { 120522861Smckusick if (oldp) 120622861Smckusick oldp->nextp = p->nextp; 120722861Smckusick else 120822861Smckusick argtemplist = p->nextp; 120922861Smckusick 121022861Smckusick p->nextp = activearglist; 121122861Smckusick activearglist = p; 121222861Smckusick 121322861Smckusick return ((Addrp) cpexpr(q)); 121422861Smckusick } 121522861Smckusick 121622861Smckusick oldp = p; 121722861Smckusick p = p->nextp; 121822861Smckusick } 121922861Smckusick 122022861Smckusick q = autovar(1, type, lengp); 122122861Smckusick activearglist = mkchain(q, activearglist); 122222861Smckusick return ((Addrp) cpexpr(q)); 122322861Smckusick } 122422861Smckusick 122522861Smckusick /* VARIOUS ROUTINES FOR PROCESSING DECLARATIONS */ 122622861Smckusick 122722861Smckusick struct Extsym *comblock(len, s) 122822861Smckusick register int len; 122922861Smckusick register char *s; 123022861Smckusick { 123122861Smckusick struct Extsym *p; 123222861Smckusick 123322861Smckusick if(len == 0) 123422861Smckusick { 123522861Smckusick s = BLANKCOMMON; 123622861Smckusick len = strlen(s); 123722861Smckusick } 123822861Smckusick p = mkext( varunder(len, s) ); 123922861Smckusick if(p->extstg == STGUNKNOWN) 124022861Smckusick p->extstg = STGCOMMON; 124122861Smckusick else if(p->extstg != STGCOMMON) 124222861Smckusick { 124322861Smckusick errstr("%s cannot be a common block name", s); 124422861Smckusick return(0); 124522861Smckusick } 124622861Smckusick 124722861Smckusick return( p ); 124822861Smckusick } 124922861Smckusick 125022861Smckusick 125122861Smckusick incomm(c, v) 125222861Smckusick struct Extsym *c; 125322861Smckusick Namep v; 125422861Smckusick { 125522861Smckusick if(v->vstg != STGUNKNOWN) 125622861Smckusick dclerr("incompatible common declaration", v); 125722861Smckusick else 125822861Smckusick { 125922861Smckusick if(c == (struct Extsym *) 0) 126022861Smckusick return; /* Illegal common block name upstream */ 126122861Smckusick v->vstg = STGCOMMON; 126222861Smckusick c->extp = hookup(c->extp, mkchain(v,CHNULL) ); 126322861Smckusick } 126422861Smckusick } 126522861Smckusick 126622861Smckusick 126722861Smckusick 126822861Smckusick 126922861Smckusick settype(v, type, length) 127022861Smckusick register Namep v; 127122861Smckusick register int type; 127222861Smckusick register int length; 127322861Smckusick { 127422861Smckusick if(type == TYUNKNOWN) 127522861Smckusick return; 127622861Smckusick 127722861Smckusick if(type==TYSUBR && v->vtype!=TYUNKNOWN && v->vstg==STGARG) 127822861Smckusick { 127922861Smckusick v->vtype = TYSUBR; 128022861Smckusick frexpr(v->vleng); 128122861Smckusick } 128222861Smckusick else if(type < 0) /* storage class set */ 128322861Smckusick { 128422861Smckusick if(v->vstg == STGUNKNOWN) 128522861Smckusick v->vstg = - type; 128622861Smckusick else if(v->vstg != -type) 128722861Smckusick dclerr("incompatible storage declarations", v); 128822861Smckusick } 128922861Smckusick else if(v->vtype == TYUNKNOWN) 129022861Smckusick { 129122861Smckusick if( (v->vtype = lengtype(type, length))==TYCHAR && length>=0) 129222861Smckusick v->vleng = ICON(length); 129322861Smckusick } 129422861Smckusick else if(v->vtype!=type || (type==TYCHAR && v->vleng->constblock.const.ci!=length) ) 129522861Smckusick dclerr("incompatible type declarations", v); 129622861Smckusick } 129722861Smckusick 129822861Smckusick 129922861Smckusick 130022861Smckusick 130122861Smckusick 130222861Smckusick lengtype(type, length) 130322861Smckusick register int type; 130422861Smckusick register int length; 130522861Smckusick { 130622861Smckusick switch(type) 130722861Smckusick { 130822861Smckusick case TYREAL: 130922861Smckusick if(length == 8) 131022861Smckusick return(TYDREAL); 131122861Smckusick if(length == 4) 131222861Smckusick goto ret; 131322861Smckusick break; 131422861Smckusick 131522861Smckusick case TYCOMPLEX: 131622861Smckusick if(length == 16) 131722861Smckusick return(TYDCOMPLEX); 131822861Smckusick if(length == 8) 131922861Smckusick goto ret; 132022861Smckusick break; 132122861Smckusick 132222861Smckusick case TYSHORT: 132322861Smckusick case TYDREAL: 132422861Smckusick case TYDCOMPLEX: 132522861Smckusick case TYCHAR: 132622861Smckusick case TYUNKNOWN: 132722861Smckusick case TYSUBR: 132822861Smckusick case TYERROR: 132922861Smckusick goto ret; 133022861Smckusick 133122861Smckusick case TYLOGICAL: 133222861Smckusick if(length == typesize[TYLOGICAL]) 133322861Smckusick goto ret; 133422861Smckusick break; 133522861Smckusick 133622861Smckusick case TYLONG: 133722861Smckusick if(length == 0) 133822861Smckusick return(tyint); 133922861Smckusick if(length == 2) 134022861Smckusick return(TYSHORT); 134122861Smckusick if(length == 4) 134222861Smckusick goto ret; 134322861Smckusick break; 134422861Smckusick default: 134522861Smckusick badtype("lengtype", type); 134622861Smckusick } 134722861Smckusick 134822861Smckusick if(length != 0) 134922861Smckusick err("incompatible type-length combination"); 135022861Smckusick 135122861Smckusick ret: 135222861Smckusick return(type); 135322861Smckusick } 135422861Smckusick 135522861Smckusick 135622861Smckusick 135722861Smckusick 135822861Smckusick 135922861Smckusick setintr(v) 136022861Smckusick register Namep v; 136122861Smckusick { 136222861Smckusick register int k; 136322861Smckusick 136422861Smckusick if(v->vstg == STGUNKNOWN) 136522861Smckusick v->vstg = STGINTR; 136622861Smckusick else if(v->vstg!=STGINTR) 136722861Smckusick dclerr("incompatible use of intrinsic function", v); 136822861Smckusick if(v->vclass==CLUNKNOWN) 136922861Smckusick v->vclass = CLPROC; 137022861Smckusick if(v->vprocclass == PUNKNOWN) 137122861Smckusick v->vprocclass = PINTRINSIC; 137222861Smckusick else if(v->vprocclass != PINTRINSIC) 137322861Smckusick dclerr("invalid intrinsic declaration", v); 137422861Smckusick if(k = intrfunct(v->varname)) 137522861Smckusick v->vardesc.varno = k; 137622861Smckusick else 137722861Smckusick dclerr("unknown intrinsic function", v); 137822861Smckusick } 137922861Smckusick 138022861Smckusick 138122861Smckusick 138222861Smckusick setext(v) 138322861Smckusick register Namep v; 138422861Smckusick { 138522861Smckusick if(v->vclass == CLUNKNOWN) 138622861Smckusick v->vclass = CLPROC; 138722861Smckusick else if(v->vclass != CLPROC) 138822861Smckusick dclerr("conflicting declarations", v); 138922861Smckusick 139022861Smckusick if(v->vprocclass == PUNKNOWN) 139122861Smckusick v->vprocclass = PEXTERNAL; 139222861Smckusick else if(v->vprocclass != PEXTERNAL) 139322861Smckusick dclerr("conflicting declarations", v); 139422861Smckusick } 139522861Smckusick 139622861Smckusick 139722861Smckusick 139822861Smckusick 139922861Smckusick /* create dimensions block for array variable */ 140022861Smckusick 140122861Smckusick setbound(v, nd, dims) 140222861Smckusick register Namep v; 140322861Smckusick int nd; 140422861Smckusick struct { expptr lb, ub; } dims[ ]; 140522861Smckusick { 140622861Smckusick register expptr q, t; 140722861Smckusick register struct Dimblock *p; 140822861Smckusick int i; 140922861Smckusick 141022861Smckusick if(v->vclass == CLUNKNOWN) 141122861Smckusick v->vclass = CLVAR; 141222861Smckusick else if(v->vclass != CLVAR) 141322861Smckusick { 141422861Smckusick dclerr("only variables may be arrays", v); 141522861Smckusick return; 141622861Smckusick } 141722861Smckusick if(v->vdim) 141822861Smckusick { 141922861Smckusick dclerr("redimensioned array", v); 142022861Smckusick return; 142122861Smckusick } 142222861Smckusick 142322861Smckusick v->vdim = p = (struct Dimblock *) 142422861Smckusick ckalloc( sizeof(int) + (3+6*nd)*sizeof(expptr) ); 142522861Smckusick p->ndim = nd; 142622861Smckusick p->nelt = ICON(1); 142722861Smckusick 142822861Smckusick for(i=0 ; i<nd ; ++i) 142922861Smckusick { 143022861Smckusick #ifdef SDB 143122861Smckusick if(sdbflag) { 143222861Smckusick /* Save the bounds trees built up by the grammar routines for use in stabs */ 143322861Smckusick 143422861Smckusick if(dims[i].lb == NULL) p->dims[i].lb=ICON(1); 143522861Smckusick else p->dims[i].lb= (expptr) cpexpr(dims[i].lb); 143622861Smckusick if(ISCONST(p->dims[i].lb)) p->dims[i].lbaddr = (expptr) PNULL; 143722861Smckusick else p->dims[i].lbaddr = (expptr) autovar(1, tyint, PNULL); 143822861Smckusick 143922861Smckusick if(dims[i].ub == NULL) p->dims[i].ub=ICON(1); 144022861Smckusick else p->dims[i].ub = (expptr) cpexpr(dims[i].ub); 144122861Smckusick if(ISCONST(p->dims[i].ub)) p->dims[i].ubaddr = (expptr) PNULL; 144222861Smckusick else p->dims[i].ubaddr = (expptr) autovar(1, tyint, PNULL); 144322861Smckusick } 144422861Smckusick #endif 144522861Smckusick if( (q = dims[i].ub) == NULL) 144622861Smckusick { 144722861Smckusick if(i == nd-1) 144822861Smckusick { 144922861Smckusick frexpr(p->nelt); 145022861Smckusick p->nelt = NULL; 145122861Smckusick } 145222861Smckusick else 145322861Smckusick err("only last bound may be asterisk"); 145422861Smckusick p->dims[i].dimsize = ICON(1);; 145522861Smckusick p->dims[i].dimexpr = NULL; 145622861Smckusick } 145722861Smckusick else 145822861Smckusick { 145922861Smckusick if(dims[i].lb) 146022861Smckusick { 146122861Smckusick q = mkexpr(OPMINUS, q, cpexpr(dims[i].lb)); 146222861Smckusick q = mkexpr(OPPLUS, q, ICON(1) ); 146322861Smckusick } 146422861Smckusick if( ISCONST(q) ) 146522861Smckusick { 146622861Smckusick if (!ISINT(q->headblock.vtype)) { 146722861Smckusick dclerr("dimension bounds must be integer expression", v); 146822861Smckusick frexpr(q); 146922861Smckusick q = ICON(0); 147022861Smckusick } 147122861Smckusick if ( q->constblock.const.ci <= 0) 147222861Smckusick { 147322861Smckusick dclerr("array bounds out of sequence", v); 147422861Smckusick frexpr(q); 147522861Smckusick q = ICON(0); 147622861Smckusick } 147722861Smckusick p->dims[i].dimsize = q; 147822861Smckusick p->dims[i].dimexpr = (expptr) PNULL; 147922861Smckusick } 148022861Smckusick else { 148122861Smckusick p->dims[i].dimsize = (expptr) autovar(1, tyint, PNULL); 148222861Smckusick p->dims[i].dimexpr = q; 148322861Smckusick } 148422861Smckusick if(p->nelt) 148522861Smckusick p->nelt = mkexpr(OPSTAR, p->nelt, 148622861Smckusick cpexpr(p->dims[i].dimsize) ); 148722861Smckusick } 148822861Smckusick } 148922861Smckusick 149022861Smckusick q = dims[nd-1].lb; 149122861Smckusick if(q == NULL) 149222861Smckusick q = ICON(1); 149322861Smckusick 149422861Smckusick for(i = nd-2 ; i>=0 ; --i) 149522861Smckusick { 149622861Smckusick t = dims[i].lb; 149722861Smckusick if(t == NULL) 149822861Smckusick t = ICON(1); 149922861Smckusick if(p->dims[i].dimsize) 150022861Smckusick q = mkexpr(OPPLUS, t, mkexpr(OPSTAR, cpexpr(p->dims[i].dimsize), q) ); 150122861Smckusick } 150222861Smckusick 150322861Smckusick if( ISCONST(q) ) 150422861Smckusick { 150522861Smckusick p->baseoffset = q; 150622861Smckusick p->basexpr = NULL; 150722861Smckusick } 150822861Smckusick else 150922861Smckusick { 151022861Smckusick p->baseoffset = (expptr) autovar(1, tyint, PNULL); 151122861Smckusick p->basexpr = q; 151222861Smckusick } 151322861Smckusick } 151422861Smckusick 151522861Smckusick 151622861Smckusick 151722861Smckusick /* 151822861Smckusick * Check the dimensions of q to ensure that they are appropriately defined. 151922861Smckusick */ 152022861Smckusick LOCAL chkdim(q) 152122861Smckusick register Namep q; 152222861Smckusick { 152322861Smckusick register struct Dimblock *p; 152422861Smckusick register int i; 152522861Smckusick expptr e; 152622861Smckusick 152722861Smckusick if (q == NULL) 152822861Smckusick return; 152922861Smckusick if (q->vclass != CLVAR) 153022861Smckusick return; 153122861Smckusick if (q->vdim == NULL) 153222861Smckusick return; 153322861Smckusick p = q->vdim; 153422861Smckusick for (i = 0; i < p->ndim; ++i) 153522861Smckusick { 153622861Smckusick #ifdef SDB 153722861Smckusick if (sdbflag) 153822861Smckusick { 153922861Smckusick if (e = p->dims[i].lb) 154022861Smckusick chkdime(e, q); 154122861Smckusick if (e = p->dims[i].ub) 154222861Smckusick chkdime(e, q); 154322861Smckusick } 154422861Smckusick else 154522861Smckusick #endif SDB 154622861Smckusick if (e = p->dims[i].dimexpr) 154722861Smckusick chkdime(e, q); 154822861Smckusick } 154922861Smckusick } 155022861Smckusick 155122861Smckusick 155222861Smckusick 155322861Smckusick /* 155422861Smckusick * The actual checking for chkdim() -- examines each expression. 155522861Smckusick */ 155622861Smckusick LOCAL chkdime(expr, q) 155722861Smckusick expptr expr; 155822861Smckusick Namep q; 155922861Smckusick { 156022861Smckusick register expptr e; 156122861Smckusick 156222861Smckusick e = fixtype(cpexpr(expr)); 156322861Smckusick if (!ISINT(e->exprblock.vtype)) 156422861Smckusick dclerr("non-integer dimension", q); 156522861Smckusick else if (!safedim(e)) 156622861Smckusick dclerr("undefined dimension", q); 156722861Smckusick frexpr(e); 156822861Smckusick return; 156922861Smckusick } 157022861Smckusick 157122861Smckusick 157222861Smckusick 157322861Smckusick /* 157422861Smckusick * A recursive routine to find undefined variables in dimension expressions. 157522861Smckusick */ 157622861Smckusick LOCAL safedim(e) 157722861Smckusick expptr e; 157822861Smckusick { 157922861Smckusick chainp cp; 158022861Smckusick 158122861Smckusick if (e == NULL) 158222861Smckusick return 1; 158322861Smckusick switch (e->tag) 158422861Smckusick { 158522861Smckusick case TEXPR: 158622861Smckusick if (e->exprblock.opcode == OPCALL || e->exprblock.opcode == OPCCALL) 158722861Smckusick return 0; 158822861Smckusick return safedim(e->exprblock.leftp) && safedim(e->exprblock.rightp); 158922861Smckusick case TADDR: 159022861Smckusick switch (e->addrblock.vstg) 159122861Smckusick { 159222861Smckusick case STGCOMMON: 159322861Smckusick case STGARG: 159422861Smckusick case STGCONST: 159522861Smckusick case STGEQUIV: 159622861Smckusick if (e->addrblock.isarray) 159722861Smckusick return 0; 159822861Smckusick return safedim(e->addrblock.memoffset); 159922861Smckusick default: 160022861Smckusick return 0; 160122861Smckusick } 160222861Smckusick case TCONST: 160322861Smckusick case TTEMP: 160422861Smckusick return 1; 160522861Smckusick } 160622861Smckusick return 0; 160722861Smckusick } 160822861Smckusick 160922861Smckusick 161022861Smckusick 161122861Smckusick LOCAL enlist(size, np, ep) 161222861Smckusick ftnint size; 161322861Smckusick Namep np; 161422861Smckusick struct Equivblock *ep; 161522861Smckusick { 161622861Smckusick register sizelist *sp; 161722861Smckusick register sizelist *t; 161822861Smckusick register varlist *p; 161922861Smckusick 162022861Smckusick sp = varsizes; 162122861Smckusick 162222861Smckusick if (sp == NULL) 162322861Smckusick { 162422861Smckusick sp = ALLOC(SizeList); 162522861Smckusick sp->size = size; 162622861Smckusick varsizes = sp; 162722861Smckusick } 162822861Smckusick else 162922861Smckusick { 163022861Smckusick while (sp->size != size) 163122861Smckusick { 163222861Smckusick if (sp->next != NULL && sp->next->size <= size) 163322861Smckusick sp = sp->next; 163422861Smckusick else 163522861Smckusick { 163622861Smckusick t = sp; 163722861Smckusick sp = ALLOC(SizeList); 163822861Smckusick sp->size = size; 163922861Smckusick sp->next = t->next; 164022861Smckusick t->next = sp; 164122861Smckusick } 164222861Smckusick } 164322861Smckusick } 164422861Smckusick 164522861Smckusick p = ALLOC(VarList); 164622861Smckusick p->next = sp->vars; 164722861Smckusick p->np = np; 164822861Smckusick p->ep = ep; 164922861Smckusick 165022861Smckusick sp->vars = p; 165122861Smckusick 165222861Smckusick return; 165322861Smckusick } 165422861Smckusick 165522861Smckusick 165622861Smckusick 165722861Smckusick outlocvars() 165822861Smckusick { 165922861Smckusick 166022861Smckusick register varlist *first, *last; 166122861Smckusick register varlist *vp, *t; 166222861Smckusick register sizelist *sp, *sp1; 166322861Smckusick register Namep np; 166422861Smckusick register struct Equivblock *ep; 166522861Smckusick register int i; 166622861Smckusick register int alt; 166722861Smckusick register int type; 166822861Smckusick char sname[100]; 166922861Smckusick char setbuff[100]; 167022861Smckusick 167122861Smckusick sp = varsizes; 167222861Smckusick if (sp == NULL) 167322861Smckusick return; 167422861Smckusick 167522861Smckusick vp = sp->vars; 167622861Smckusick if (vp->np != NULL) 167722861Smckusick { 167822861Smckusick np = vp->np; 167922861Smckusick sprintf(setbuff, "\t.set\tv.%d,v.%d\n", bsslabel, 168022861Smckusick np->vardesc.varno); 168122861Smckusick } 168222861Smckusick else 168322861Smckusick { 168422861Smckusick i = vp->ep - eqvclass; 168522861Smckusick sprintf(setbuff, "\t.set\tv.%d,q.%d\n", bsslabel, i + eqvstart); 168622861Smckusick } 168722861Smckusick 168822861Smckusick first = last = NULL; 168922861Smckusick alt = NO; 169022861Smckusick 169122861Smckusick while (sp != NULL) 169222861Smckusick { 169322861Smckusick vp = sp->vars; 169422861Smckusick while (vp != NULL) 169522861Smckusick { 169622861Smckusick t = vp->next; 169722861Smckusick if (alt == YES) 169822861Smckusick { 169922861Smckusick alt = NO; 170022861Smckusick vp->next = first; 170122861Smckusick first = vp; 170222861Smckusick } 170322861Smckusick else 170422861Smckusick { 170522861Smckusick alt = YES; 170622861Smckusick if (last != NULL) 170722861Smckusick last->next = vp; 170822861Smckusick else 170922861Smckusick first = vp; 171022861Smckusick vp->next = NULL; 171122861Smckusick last = vp; 171222861Smckusick } 171322861Smckusick vp = t; 171422861Smckusick } 171522861Smckusick sp1 = sp; 171622861Smckusick sp = sp->next; 171722861Smckusick free((char *) sp1); 171822861Smckusick } 171922861Smckusick 172022861Smckusick vp = first; 172122861Smckusick while(vp != NULL) 172222861Smckusick { 172322861Smckusick if (vp->np != NULL) 172422861Smckusick { 172522861Smckusick np = vp->np; 172622861Smckusick sprintf(sname, "v.%d", np->vardesc.varno); 172722861Smckusick if (np->init) 172822861Smckusick prlocdata(sname, np->varsize, np->vtype, np->initoffset, 172922861Smckusick &(np->inlcomm)); 173022861Smckusick else 173122861Smckusick { 173222861Smckusick pralign(typealign[np->vtype]); 1733*25103Sdonn fprintf(initfile, "%s:\n", sname); 1734*25103Sdonn prspace(np->varsize); 173522861Smckusick } 173622861Smckusick np->inlcomm = NO; 173722861Smckusick } 173822861Smckusick else 173922861Smckusick { 174022861Smckusick ep = vp->ep; 174122861Smckusick i = ep - eqvclass; 174222861Smckusick if (ep->eqvleng >= 8) 174322861Smckusick type = TYDREAL; 174422861Smckusick else if (ep->eqvleng >= 4) 174522861Smckusick type = TYLONG; 174622861Smckusick else if (ep->eqvleng >= 2) 174722861Smckusick type = TYSHORT; 174822861Smckusick else 174922861Smckusick type = TYCHAR; 175022861Smckusick sprintf(sname, "q.%d", i + eqvstart); 175122861Smckusick if (ep->init) 175222861Smckusick prlocdata(sname, ep->eqvleng, type, ep->initoffset, 175322861Smckusick &(ep->inlcomm)); 175422861Smckusick else 175522861Smckusick { 175622861Smckusick pralign(typealign[type]); 1757*25103Sdonn fprintf(initfile, "%s:\n", sname); 1758*25103Sdonn prspace(ep->eqvleng); 175922861Smckusick } 176022861Smckusick ep->inlcomm = NO; 176122861Smckusick } 176222861Smckusick t = vp; 176322861Smckusick vp = vp->next; 176422861Smckusick free((char *) t); 176522861Smckusick } 176622861Smckusick fprintf(initfile, "%s\n", setbuff); 176722861Smckusick return; 176822861Smckusick } 1769