⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pascalcompiler.cpp

📁 C++ mfc 源代码
💻 CPP
📖 第 1 页 / 共 3 页
字号:
***memberof
***history
1.0.0 ; 1999.1.7 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/

void CPascalCompiler::TipRecord(TypeInfo& info)
{
	int temp = m_nVAdrel;	// conserve relative address
	m_nVAdrel = 0;
	if (NextToken() != TT_KW_RECORD)
		throw error(SET_EXPECTED, CString("record"));;
	while (1)
	{
		DeclCamp(info);
		int val = NextToken();
		if (val != ';')
		{
			PushBack();
			break;
		}
	}
	if (NextToken() != TT_KW_END)
		throw error(SET_EXPECTED, CString("end"));
	m_nVAdrel = temp;
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.7 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/

void CPascalCompiler::DeclCamp(TypeInfo&info)
{
	StringList list;
	while (1)
	{
		if (NextToken()!= TT_WORD)
			throw error(SET_EXPECTED, CString("identifier"));
		list.AddTail(GetStrValue());
		if (NextToken()!= ',')
		{
			PushBack();
			break;
		}
	}
	if (NextToken()!=':')
		throw error(SET_EXPECTED, CString(":"));
	TypeInfo secinfo;
	TipSimplu(secinfo);
	// si acum sa introducem un simbol pentru bullshit-ul de camp de record
	POSITION pos = list.GetHeadPosition ();
	while (pos!=NULL)
	{
		CString name = list.GetNext(pos);
		Symbol simb;
		simb.m_sName = name;
		simb.m_nClass = CT_VAR_RECORD_FIELD;
		simb.m_nType  = secinfo.m_nType ;
		simb.m_nDeplRec = m_nVAdrel;
		simb.m_ListaRec .RemoveAll();
		simb.m_ListaRec .AddTail(&info.m_VarList);	// legaturile spre variabilele care sunt de tipul record
		m_nVAdrel += secinfo.m_nSize ;
		InsertSymbol(simb);
	}
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.7 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/

void CPascalCompiler::TermenStatic(ExpStat &ct)
{
	double dResult = 1;
	CString sResult = _T("");
	int nResult = 1;
	int type = 0;
	ExpStat cres;
	int c;
	
	while (1)
	{
		FactorStatic(cres);

		switch (type)	// tipul termenului precedent
		{
		case ET_REAL:
			if (cres.m_nType !=ET_REAL)
				throw error(SET_INVALID_OP_TYPES,CString("real type expected"));
			switch (c)
			{
			case '*':
				dResult *= cres.m_dVal;
				break;
			case '/':
				dResult /= cres.m_dVal;
				break;
			default:
				throw error(SET_INVALID_OP,CString(""));
			}

		case ET_INTEGER:
			if (cres.m_nType !=ET_INTEGER)
				throw error(SET_INVALID_OP_TYPES,CString("integer type expected"));
			switch (c)
			{
			case '*':
				nResult *= cres.m_nVal;
				break;			
			case TT_KW_DIV:
				nResult /= cres.m_nVal;
				break;
			case TT_KW_MOD:
				nResult %= cres.m_nVal;
				break;
			default:
				throw error(SET_INVALID_OP,CString("you can't divide two integers"));
			}
			break;
		case ET_STRING:
			throw error(SET_INVALID_OP,CString("You can't do that with strings"));
			break;
		default:
			sResult = cres.m_sVal;
			dResult = cres.m_dVal;
			nResult = cres.m_nVal;
			type = cres.m_nType;
		}

		int val = NextToken();
		if (val!='*' && val != '/' && val!=TT_KW_MOD && val != TT_KW_DIV)
		{
			PushBack();
			break;
		}
		c = val;
	}
	ct.m_dVal = dResult;
	ct.m_sVal = sResult;
	ct.m_nVal = nResult;
	ct.m_nType = type;
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.7 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/


void CPascalCompiler::FactorStatic(ExpStat &ct)
{
	int val = NextToken();
	if (val == TT_WORD)
	{
		// search for another constant
		Symbol simb;
		if (!RetreaveSymbol(GetStrValue(),simb))
			throw error(SET_GENERAL,CString("Constant expected"));
		if (simb.m_nClass!=CT_CONST)
			throw error(SET_GENERAL,CString("Constant expected"));
		ct = m_ListaConstante.GetAt (simb.m_Val);
		return;	// this can be only a constant
	}
	if (val == TT_INTEGER)
	{
		ct.m_nVal = (int) GetNumValue ();
		ct.m_nType = ET_INTEGER;
		return;
	}
	if (val == TT_REAL)
	{
		ct.m_dVal = GetNumValue ();
		ct.m_nType = ET_REAL;
		return;
	}
	if (val == TT_STRING)
	{
		ct.m_sVal = GetStrValue ();
		ct.m_nType = ET_STRING;
		return;
	}
	if (val == '(')
	{
		ExprStatica(ct);
		if (NextToken()!=')')
			throw error(SET_EXPECTED, CString(")"));
		return;
	}
	throw error(SET_EXPECTED, CString("Identifier or number or constant"));
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.7 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/


void CPascalCompiler::Instr()
{
	int val = NextToken();
	switch (val)
	{
	case TT_KW_WHILE:
		{
			PushBack();
			InstrWhile();
			break;
		}
	case TT_KW_REPEAT:
		{
			PushBack();
			InstrRepeat();
			break;
		}
	case TT_KW_FOR:
		{
			PushBack();
			InstrFor();
			break;
		}
	case TT_KW_CASE:
		{
			PushBack();
			InstrCase();
			break;
		}
	case TT_KW_BEGIN:
		{
			PushBack();
			InstrCompusa();
			break;
		}
	case TT_KW_PRINT:
		{
			PushBack();
			InstrPrint();
			break;
		}
	case TT_KW_READ:
		{
			PushBack();
			InstrRead();
			break;
		}
	case TT_KW_IF:
		{
			PushBack();
			InstrIf();
			break;
		}
	case TT_WORD:
			if (IsProc(GetStrValue()))
			{
				PushBack();
				ApelProcedura();
			}
			else
			{
				PushBack();
				Atribuire();
			}
			break;
	default:		 
			throw error(SET_EXPECTED, CString("Instruction"));
	}
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.7 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/


void CPascalCompiler::InsertSymbol(Symbol &s)
{
	Symbol simb;
	if (m_SymbTableCollection.RetreaveSymbolCL(s.m_sName,simb))
	{
		throw error(SET_GENERAL,CString(s.m_sName)+CString(" item is already declared "));
	}
	m_SymbTableCollection.InsertSymbol (s);
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.8 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/

BOOL CPascalCompiler::IsProc(CString &str)
{
	Symbol simb;
	if (!RetreaveSymbol(str,simb))
		return FALSE;
	return (simb.m_nClass == CT_PROCEDURE);
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.8 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/


void CPascalCompiler::Atribuire()
{
	// Variabila
	ExprType t1;
	ExprType t2;
	Variabila(t1);
	if (NextToken()!=TT_IS)
		throw error(SET_EXPECTED, CString(":="));
	Expr(t2);
	if (t1.m_nAtribLValue == LV_VALUE)
		throw error(SET_GENERAL, CString("Invalid variable"));
	if (t1.m_nAtribTip != t2.m_nAtribTip )
		throw error(SET_GENERAL, CString("Trying to assign between different types"));
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.8 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/

void CPascalCompiler::Variabila(ExprType &type)
{
	if (NextToken()!=TT_WORD)
		throw error(SET_EXPECTED, CString("identifier"));
	CString numevar = GetStrValue();
	int val	= NextToken();
	if (val=='[')
	{
		Expr(type);
		if (NextToken()!=']')
			throw error(SET_EXPECTED, CString("]"));
		if (type.m_nAtribTip != ET_INTEGER)
			throw error(SET_GENERAL,CString("Table must have integer index"));
		Symbol simb;
		if (!RetreaveSymbol(numevar,simb))
			throw error(SET_GENERAL,CString("Undeclared variable: ")+CString(numevar));
		if (simb.m_nClass!=CT_VAR_ARRAY)
				throw error(SET_GENERAL,CString("Invalid variable usage: ")+CString(numevar));
		type.m_nAtribLValue = LV_ADDRESS;
		type.m_nAtribTip = simb.m_nType ;
		return;
	}
	else
		if (val=='.')
		{
			if (NextToken()!=TT_WORD)
				throw error(SET_EXPECTED, CString("identifier"));
			CString numecamp = GetStrValue();
			
			Symbol simb;
			if (!RetreaveSymbol(numevar,simb))
				throw error(SET_GENERAL,CString("Undeclared variable: ")+CString(numevar));
			if (simb.m_nClass!=CT_VAR_RECORD)
				throw error(SET_GENERAL,CString("Invalid variable usage: ")+CString(numevar));

			if (!RetreaveSymbol(numecamp,simb))
				throw error(SET_GENERAL,CString("Invalid record field: ")+CString(numecamp));
			if (simb.m_nClass!=CT_VAR_RECORD_FIELD)
				throw error(SET_GENERAL,CString("Invalid record field: ")+CString(numecamp));
			if (simb.m_ListaRec.Find(numevar)==NULL)
				throw error(SET_GENERAL,CString("Invalid record field: ")+CString(numecamp));
			type.m_nAtribLValue = LV_ADDRESS;
			type.m_nAtribTip = simb.m_nType ;
			return;
		}
		else
		{
			Symbol simb;
			if (!RetreaveSymbol(numevar,simb))
				throw error(SET_GENERAL,CString("Undeclared variable: ")+CString(numevar));
			if (simb.m_nClass!=CT_VAR_SIMP && 
				simb.m_nClass!=CT_PARAM_VAL && 
				simb.m_nClass!=CT_PARAM_ADR &&
				simb.m_nClass!=CT_FUNCTION)
				throw error(SET_GENERAL,CString("Invalid variable : ")+CString(numevar));
			if (simb.m_nClass == CT_FUNCTION)
				type.m_nAtribLValue = LV_VALUE;
			else
				type.m_nAtribLValue = LV_ADDRESS;
			type.m_nAtribTip = simb.m_nType ;
			PushBack();
		}
}


/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.8 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/

void CPascalCompiler::Expr(ExprType& type)
{
	ExprType et;
	int c='+';
	while (1)
	{
		Termen(type);
		switch (et.m_nAtribTip)	// tipul termenului precedent
		{
		case ET_REAL:
			if (type.m_nAtribTip !=ET_REAL && type.m_nAtribTip !=ET_INTEGER)
				throw error(SET_GENERAL,CString("Ivalid operation between incompatible Types"));
			break;
		case ET_INTEGER:
			if (type.m_nAtribTip !=ET_REAL && type.m_nAtribTip !=ET_INTEGER)
				throw error(SET_GENERAL,CString("Ivalid operation between incompatible Types"));
			if (type.m_nAtribTip == ET_REAL)
				et.m_nAtribTip = ET_REAL;
			break;
		case ET_STRING:
			if (type.m_nAtribTip != ET_STRING)
				throw error(SET_GENERAL,CString("Ivalid operation between incompatible Types"));
			if (c == '-')
				throw error(SET_GENERAL,CString("Ivalid operation with strings"));
			break;
		default:
			et.m_nAtribTip  = type.m_nAtribTip ;
			et.m_nAtribLValue = type.m_nAtribLValue ;
		}
		int val = NextToken();
		if (val!='+' && val != '-')
		{
			PushBack();
			break;
		}
		c = val;
		et.m_nAtribLValue = LV_VALUE;
	}
	type = et;
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.8 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/


void CPascalCompiler::Termen(ExprType& type)
{
	ExprType et;
	int c ='*';

	while (1)
	{
		Factor(type);
		switch (et.m_nAtribTip)	// tipul termenului precedent
		{
		case ET_REAL:
			if (type.m_nAtribTip !=ET_REAL && type.m_nAtribTip !=ET_INTEGER)
				throw error(SET_GENERAL,CString("Ivalid operation between incompatible Types"));
			if (c == TT_KW_MOD || TT_KW_MOD)
				throw error(SET_GENERAL,CString("Ivalid operation With real numbers"));
			
			break;
		case ET_INTEGER:
			if (type.m_nAtribTip !=ET_REAL && type.m_nAtribTip !=ET_INTEGER)
				throw error(SET_GENERAL,CString("Ivalid operation between incompatible Types"));
			if (type.m_nAtribTip == ET_REAL)
			{
				if (c == TT_KW_MOD || TT_KW_MOD)
					throw error(SET_GENERAL,CString("Ivalid operation With real numbers"));
				et.m_nAtribTip = ET_REAL;
			}
			break;
		case ET_STRING:
			throw error(SET_GENERAL,CString("Ivalid operation with Strings"));
			break;
		default:
			et.m_nAtribTip  = type.m_nAtribTip ;
			et.m_nAtribLValue = type.m_nAtribLValue ;
		}

		int val = NextToken();
		if (val!='*' && val != '/' && val!=TT_KW_MOD && val != TT_KW_DIV)
		{
			PushBack();
			break;
		}
		et.m_nAtribLValue = LV_VALUE;
		c = val;
	}
	type = et;
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.8 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/

void CPascalCompiler::Factor(ExprType &type)
{
	int val = NextToken();
	if (val == TT_INTEGER)
	{
		type.m_nAtribLValue = LV_VALUE;
		type.m_nAtribTip = ET_INTEGER;
		return;
	}
	if (val == TT_REAL)
	{
		type.m_nAtribLValue = LV_VALUE;
		type.m_nAtribTip = ET_REAL;
		return;
	}
	if (val == TT_STRING)
	{
		type.m_nAtribLValue = LV_VALUE;
		type.m_nAtribTip = ET_STRING;
		return;
	}
	if (val == '(')
	{
		Expr(type);
		if (NextToken()!=')')
			throw error(SET_EXPECTED, CString(")"));
		return;
	}
	if (val == TT_WORD)
		if (IsFunc(GetStrValue()))
		{
			PushBack();
			ApelFunc(type);
			return;
		}
		else 
		{
			PushBack();
			Variabila(type);
			return;
		}
	
	throw error(SET_EXPECTED, CString("number or constant or identifier or function or variable "));;
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.8 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/


BOOL CPascalCompiler::IsFunc(CString &str)
{
	Symbol simb;
	if (!RetreaveSymbol(str,simb))
		return FALSE;
	return (simb.m_nClass == CT_FUNCTION);
}

/*
***header
***name
***memberof
***history
1.0.0 ; 1999.1.8 ; FZ ; Creation
***description
***notes
***uses
***var_in
***var_out
***err_out
***flags
***specifications
***documents
*/

void CPascalCompiler::ApelFunc(ExprType &type)
{
	if (NextToken()!=TT_WORD)
		throw error(SET_EXPECTED, CString("identifier"));
	Symbol simb;
	RetreaveSymbol(GetStrValue(),simb);
	POSITION pos = simb.m_ListaPar.GetHeadPosition ();
	if (NextToken()=='(')
	{
		while (1)
		{
			if (pos == NULL)
				throw error(SET_GENERAL, CString("Too many parameters"));
			Param par = simb.m_ListaPar .GetNext(pos);
			Expr(type);
			if (type.m_nAtribTip != par.m_nType )
				throw error(SET_GENERAL, CString("Invalid Parameter type"));
			if (par.m_nTransmisie == LV_ADDRESS && type.m_nAtribLValue== LV_VALUE )
				throw error(SET_GENERAL, CString("Invalid Parameter, must be a variable"));
			if (NextToken()!=',')
			{
				PushBack();
				if (pos != NULL)
					throw error(SET_GENERAL, CString("Too few parameters"));
				break;
			}

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -