Ejemplo n.º 1
0
/*
 * Usage: showexports libName type-expression
 * Example: showexports libaldor.al 'List(Integer)'
 */
int
main(int argc, char *argv[])
{
	osInit();
	sxiInit();
	keyInit();
	ssymInit();
	dbInit();
	stabInitGlobal();
	tfInit();
	foamInit();
	optInit();
	tinferInit();
	pathInit();

	sposInit();
	ablogInit();
	comsgInit();

	macexInitFile();
	comsgInit();
	scobindInitFile();
	stabInitFile();

	fileAddLibraryDirectory(".");

	String archive = argv[1];
	String expression = argv[2];

	scmdHandleLibrary("LIB", archive);

	AbSyn ab = shexpParse(expression);
	Stab stab = stabFile();
	Syme syme = stabGetArchive(symInternConst("LIB"));
	AbSyn arAbSyn = abNewId(sposNone, symInternConst("LIB"));

	stabImportTForm(stab, tiGetTForm(stab, arAbSyn));
	abPutUse(ab, AB_Use_Value);
	scopeBind(stab, ab);
	typeInfer(stab, ab);
	TForm tf = tiGetTForm(stab, ab);

	SymeList list = tfStabGetDomImports(stab, tf);

	for (; list != listNil(Syme); list = cdr(list)) {
		Syme syme = car(list);
		aprintf("%s %d %d %s\n", symeString(syme),
			symeDefnNum(syme), symeConstNum(syme), tfPretty(symeType(syme)));
	}

	scobindFiniFile();
	stabFiniFile();
	comsgFini();
	macexFiniFile();

}
Ejemplo n.º 2
0
/*
 * Create an explicit export: see gen0DefineRhs and gen0Lambda
 * for more details on how we do this. The code in gf_fortran may
 * also be helpful.
 */
void
gen0ImplicitExport(Syme syme, SymeList context, AbSyn ab)
{
	TForm	tf;
	FoamTag	repTag;
	Foam	lhs, rhs, def;


	/* What is the Rep of this domain? */
	tf = gen1ImplicitRepValue(context);


	/* Get the FOAM type for this Rep */
	if (tf)
		repTag = gen1ImplicitType(tf);
	else
	{
		/* Raise an error because we can't find Rep */
		comsgWarning(ab, ALDOR_E_GenImpNoRep);


		/* Non-fatal so continue */
		repTag = FOAM_Word;
	}


	/* Get the rhs of the export definition */
	rhs = gen1ImplicitExport(syme, repTag);
	if (!rhs) return;


	/* Create the FOAM for the lhs */
	lhs = gen0ExtendSyme(syme);


	/*
	 * If this is a domain export then record the foam loc/lex
	 * used to hold the value of this syme.
	 */
	if (gen0IsDomLevel(gen0State->tag) && gen0State->tag != GF_File)
		gen0SymeSetInit(syme, lhs);


	/* Create a definition */
	def = foamNewDef(lhs, rhs);


	/* Not sure if this hackery is needed anymore */
	def->foamDef.hdr.defnId = symeDefnNum(syme);


	/* Add the definition to the code stream */
	gen0AddStmt(def, (AbSyn)NULL);
}
Ejemplo n.º 3
0
SymeList
genGetSymeInlined(Syme syme)
{
	Length	dindex;

	if (symeExtension(syme)) syme = symeExtension(syme);

	dindex = symeDefnNum(syme);

	if (dindex < gen0SymeTableC && gen0SymeTableV[dindex])
		return symeInlined(gen0SymeTableV[dindex]);
	else
		return listNil(Syme);
}
Ejemplo n.º 4
0
/*
 * This function may be invoked during genfoam as well as during
 * the optimisation phases. During genfoam we never want to change
 * the const number associated with a given syme: if we try to do
 * so, it means that the syme is conditional with more than one
 * implementation and isn't "const". During optimisation however,
 * we must allow the const num to be modified.
 *
 *  unique => changing const num means clobber it
 * ~unique => changing const num works
 */
void
genSetConstNum(Syme syme, int defineIdx, UShort index, Bool unique)
{
	Length	dindex = symeDefnNum(syme);
	ULong	cnum = symeConstNum(syme); /* 0 <= cnum <= 0xffff */


	/* Old way */
	assert(dindex < gen0SymeTableC);

	/*
	 * Conditional symes with multiple implementations are not
	 * const. We detect this here if we see a syme whose const
	 * num is already set and isn't `index', and `unique' is
	 * true. Conditional symes with one possible implementation
	 * are okay: if the type checker allowed the call then we
	 * can inline it.
	 */
	if (unique && (cnum >= 0) && (cnum <= 0x3fff) && (cnum != index)) {
		/*
		 * Conditional syme with multiple implementations.
		 * We have to record the fact that we have stomped
		 * on the stored const num otherwise the next time
		 * we got here we would think the syme was okay.
		 */
		symeClrConstNum(syme);
		symeSetMultiCond(syme);
		gen0SymeTableV[dindex] = (Syme)NULL;
	}
	else if (!symeIsMultiCond(syme)) {
		symeSetConstNum(syme, (int) index);
		gen0SymeTableV[dindex] = syme;
	}


	/* New way */
#if 0	
	SImpl   nimpl;
	if (defineIdx != -1) {
		gen0DefSymeTableV[defineIdx] = syme;
	}
	if (symeImpl(syme)) {
		implSetConstNum(symeImpl(syme), defineIdx, index);
	}
#endif
}
Ejemplo n.º 5
0
Bool
genHasConstNum(Syme syme)
{
	Length	dindex;
	
	if (symeExtension(syme))
		syme = symeExtension(syme);

	if (symeHasConstNum(syme) && 
	    symeConstLib(syme) != NULL)
		return true;

	dindex = symeDefnNum(syme);
	
	if (0 < dindex && dindex < gen0SymeTableC && gen0SymeTableV[dindex]) {
		symeSetConstNum(syme, symeConstNum(gen0SymeTableV[dindex]));
		symeSetHashNum(syme,  symeHashNum(gen0SymeTableV[dindex]));
		symeSetDVMark(syme,   symeDVMark(gen0SymeTableV[dindex]));
	}

	return symeHasConstNum(syme);
}
Ejemplo n.º 6
0
/*
 * This is a debugging function which allows the contents
 * of gen0SymeTable to be seen. This table provides a mapping
 * between constant numbers and definition numbers.
 */
void
symeTablePrintDb(void)
{
	int	i;
	Syme	syme;

	for (i = 0;i < gen0SymeTableC;i++)
        {
		syme = gen0SymeTableV[i];
		if (syme)
		{
			AInt c = (AInt)-1;
			AInt d = symeDefnNum(syme);

			if (symeHasConstNum(syme))
				c = symeConstNum(syme);

			(void)fprintf(dbOut, "[%2d]: ", i);
			(void)fprintf(dbOut, " (Const %2d, ", (int)c);
			(void)fprintf(dbOut, " Defn %2d) ", (int)d);
			symePrintDb(syme);
		}
        }
}
Ejemplo n.º 7
0
local Foam
gen1ImplicitExport(Syme syme, FoamTag repTag)
{
	TForm		tf, tfret;
	AInt		retfmt, index;
	Foam		foam, clos;
	FoamTag		retType;
	AbSyn		params, oldex, id;
	FoamList	pars;
	Length		i, gfTag;
	GenFoamState	saved;
	Hash		hash;


	/* Paranoia */
	assert(syme);


	/* Get the type of this syme */
	tf = symeType(syme);
	assert (tfIsMap(tf));


	/* Name of the export */
	gen0ProgName = strCopy(symeString(syme));


	/* Type hash code */
	hash = tfHash(tf);


	/* Is this something we know about? */
	for (i = gfTag = 0;(i < GFI_LIMIT) && !gfTag; i++)
	{
		struct gf_impl_info *e = &gfImplicitInfoTable[i];

		if (e->type != hash) continue;
		if (!strEqual(e->name, gen0ProgName)) continue;
		gfTag = i + 1;
	}


	/* Did we recognise it? */
	if (!gfTag)
	{
		bug("[%s] %s#%ld not recognised\n",
			"gen1ImplicitExport", gen0ProgName, hash);
		return (Foam)NULL;
	}
	else
		gfTag--;


	/* Note the function signature */
	tfret   = tfMapRet(tf);
	retType = gen0Type(tfret, &retfmt);


	/* Fake up a bit of absyn */
	id = abNewId(sposNone, symIntern(gen0ProgName));
	abSetDefineIdx(id, symeDefnNum(syme));


	/* Not sure if we need this ... */
	oldex = gen0ProgPushExporter(id);


	/* Deal with const number */
	/* gen0AddConst(symeConstNum(syme), gen0NumProgs); */
	genSetConstNum(syme, abDefineIdx(id), (UShort) gen0NumProgs, true);


	/* Create a closure for the function */
	clos = gen0ProgClosEmpty();
	foam = gen0ProgInitEmpty(gen0ProgName, id);


	/* What format number are we using? */
	index = gen0FormatNum;


	/* Save the current state */
	saved = gen0ProgSaveState(PT_ExFn);


	/*
	 * Deal with special return types. None of these
	 * ought to appear at the moment but there is no
	 * point in creating extra work for the future.
	 */
	if (tfIsMulti(tfret))
		retfmt = gen0MultiFormatNumber(tfret);

	if (tfIsGenerator(tfret))
		foamProgSetGenerator(foam);


	/* Create the parameters for this function */
	params = ab0ImplicitExportArgs(tfMapArg(tf));


	/* Initialise the program state */
	gen0State->type    = tf;
	gen0State->param   = params;
	gen0State->program = foam;


	/* Not sure if we really need this ... see below */
#ifdef PUSH_FORAMTS
	gen0PushFormat(index);
#endif


	/* Create the parameter list */
	pars = gen0ImplicitExportArgs(tfMapArg(tf));


	/* Generate code for the body of this export */
	switch (gfTag)
	{
	   case GFI_PackedArrayNew:
		gen0ImplicitPANew(pars, repTag);
		break;
	   case GFI_PackedArrayGet:
		gen0ImplicitPAGet(pars, repTag);
		break;
	   case GFI_PackedArraySet:
		gen0ImplicitPASet(pars, repTag);
		break;
	   case GFI_PackedRecordSet:
		gen0ImplicitPRSet(pars, repTag);
		break;
	   case GFI_PackedRecordGet:
		gen0ImplicitPRGet(pars, repTag);
		break;
	   case GFI_PackedRepSize:
		gen0ImplicitPRSize(pars, repTag);
		break;
	   default:
		bug("[%s] GFI tag #%d not recognised\n",
			"gen1ImplicitExport", gfTag);
	}


#ifdef PUSH_FORAMTS
	gen0ProgAddFormat(index);
	gen0ProgFiniEmpty(foam, retType, retfmt);
#else
	/*
	 * Finish off the FOAM creation. Note that we want to
	 * use a basic machine type for the return type of this
	 * function so that Fortran can understand the result.
	 * This means we use `rtype' in gen0ProgFiniEmpty()
	 * rather than `retType' which we would do normally.
	 */
 	gen0UseStackedFormat(int0); /* These two lines provide a format */
 	gen0ProgPushFormat(int0);   /* for the lexical argument `op'   */
	gen0ProgFiniEmpty(foam, retType, retfmt);
#endif


	/* Optimisation bits */
	/* foam->foamProg.infoBits = IB_INLINEME; */
	foamOptInfo(foam) = inlInfoNew(NULL, foam, NULL, false);


	/* Compute side-effects of this foam */
	/* gen0ComputeSideEffects(foam); */


	/* Restore the saved state before returning */
	gen0ProgRestoreState(saved);
	return clos;
}
Ejemplo n.º 8
0
/*
 * Usage: showexports libName type-expression
 * Example: showexports libaldor.al 'List(Integer)'
 */
int
main(int argc, char *argv[])
{
	osInit();
	sxiInit();
	keyInit();
	ssymInit();
	dbInit();
	stabInitGlobal();
	tfInit();
	foamInit();
	optInit();
	tinferInit();
	pathInit();

	sposInit();
	ablogInit();
	comsgInit();

	macexInitFile();
	comsgInit();
	scobindInitFile();
	stabInitFile();

	fileAddLibraryDirectory(".");

	String archive = argv[1];
	String expression = argv[2];

	scmdHandleLibrary("LIB", archive);

	AbSyn ab = shexpParse(expression);
	Stab stab = stabFile();
	Syme syme = stabGetArchive(symInternConst("LIB"));
	AbSyn arAbSyn = abNewId(sposNone, symInternConst("LIB"));
	AbSyn boolean = abNewId(sposNone, symInternConst("Boolean"));

	stabImportTForm(stab, tiGetTForm(stab, arAbSyn));
	stabImportTForm(stab, tiGetTForm(stab, boolean));
	abPutUse(ab, AB_Use_Value);
	scopeBind(stab, ab);
	typeInfer(stab, ab);
	TForm tf = tiGetTForm(stab, ab);
	aprintf("Type: %s Cat: %d\n", tfPretty(tf), tfSatCat(tf));
	if (tfSatDom(tf)) {
		SymeList list = tfGetCatExports(tf);
		aprintf("Category\n");
		for (; list != listNil(Syme); list = cdr(list)) {
			Syme syme = car(list);
			aprintf("%5s %3d %s %pAbSynList\n", symeString(syme), symeHasDefault(syme),
				tfPretty(symeType(syme)), symeCondition(syme));
		}
	}
	else {
		aprintf(">>> Exports\n");
		SymeList list = tfStabGetDomImports(stab, tf);

		for (; list != listNil(Syme); list = cdr(list)) {
			Syme syme = car(list);
			aprintf("%s %d %d %s\n", symeString(syme),
				symeDefnNum(syme), symeConstNum(syme), tfPretty(symeType(syme)));
		}

		TQualList tqList;
		aprintf(">>> Cascades\n");
		tqList = tfGetDomCascades(tf);

		for (; tqList != listNil(TQual); tqList = cdr(tqList)) {
			TQual tq = car(tqList);
			aprintf("--> %s\n", tfPretty(tqBase(tq)));
		}
	}

	scobindFiniFile();
	stabFiniFile();
	comsgFini();
	macexFiniFile();

}