|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 64119 (0xfa77)
Types: TextFile
Names: »RTPP4.PAS«
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\RTPP4.PAS«
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\RTPP4.PAS«
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
└─⟦this⟧ »RTP\RTPP4.PAS«
\r
BEGIN (* RTP86Pass4 *)\r
linenumber := 1;\r
InContext := false;\r
NoOfTimesInContext := 0;\r
Files_Return_To_Mark;\r
Comp_Unit_Bit := Last_Comp_Unit_Bit;\r
LowerBoundIndexEq0 := false;\r
LengthOfProgParam := 0;\r
\r
MoreInput := True;\r
CurrentNiv := Context_Level;\r
LookAhead := false;\r
InitPointer := false;\r
InStrucValue := 0;\r
InDeclPart := true;\r
DoNotPopTop := false;\r
FunctionResultPointer := false;\r
\r
InitCodeGenerator;\r
InitEST;\r
{$IFDEF RC5000}\r
InitParamList;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
InitBoolean;\r
OwnException := False;\r
{$ENDIF}\r
{$IFDEF PI3}\r
NewSp := RNil;\r
DSIsChange := false;\r
\r
\r
InitRegisterAdm;\r
{$ENDIF}\r
InitSST;\r
\r
Bool := STDcode_To_Address(cInteger,IntegerType);\r
Bool := STDcode_To_Address(cWord,WordType);\r
IF Bool = false then (* ny rtp *) WordType := IntegerType;\r
Bool := STDcode_To_Address(cBoolean,BooleanType);\r
Bool := STDcode_To_Address(cdo,DoubleType);\r
{$IFDEF RC3502}\r
St_Declaration(CPointerType,AnonymousName,PointerType,Ptr);\r
Ptr^.St_Size := 3;\r
{$ENDIF}\r
VersionNumber[4] := Pass4VerNo;\r
ReadCode;\r
\r
WHILE MoreInput DO\r
BEGIN\r
CASE InCode OF\r
cAccessCheck :\r
BEGIN\r
IF ESTSort(ESTTop) <> S_Stack THEN\r
ESTTop^.AccessCheck := true;\r
END;\r
\r
cAdd :\r
{$IFDEF RC3502}\r
MegaOperationOnStack(iADD, true);\r
{$ELSE}\r
do_cAdd;\r
{$ENDIF}\r
cAAddr: (* Offset *)\r
begin\r
ReadPar;\r
{$IFDEF RC5000}\r
estpushaddr(anonymousspix, st_nilladdr, false, p_normal,\r
currentniv, MegaOffset(CurrentNiv,inpar));\r
{$ELSE}\r
estpushaddr(anonymousspix, st_nilladdr, false, p_normal, currentniv, inpar);\r
{$ENDIF}\r
end;\r
\r
cAddr: (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
St_Retrieve(InSymbol,PtrSt);\r
\r
PushAddr(PtrSt);\r
\r
END;\r
cAllocDynParam : (* offset Symbol *)\r
BEGIN\r
SetCodeModeToTrue;\r
ReadPar;\r
ReadSymbol;\r
{$IFDEF PI3}\r
ESTPushIndAddr(AnonymousSpix,InSymbol,true,P_Normal,CurrentNiv,\r
InPar,0);\r
PushOperand;\r
ESTPop;\r
MakeAddr(CurrentNiv,InPar,Addr,False);\r
\r
CodeAddrReg(iMOV,w,Addr,SP);\r
Addr.Displacement := Addr.Displacement + 2;\r
CodeAddrReg(iMOV,w,Addr,SS);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTPushIndAddr(AnonymousSpix,InSymbol,true,P_Normal,CurrentNiv,\r
megaoffset(CurrentNiv,InPar),0);\r
MegaMakeAddr(ESTTop);\r
StoreStackToTemp(ESTTop);\r
ESTPushAddr(Anonymousspix,IntegerType,false,P_Normal,CurrentNiv,\r
MegaOffset(CurrentNiv,InPar));\r
allocdynamic(insymbol,0);\r
MegaStore(4);\r
ESTPushIndAddr(Anonymousspix,InSymbol,false,P_Normal,CurrentNiv,\r
MegaOffset(CurrentNiv,InPar),0);\r
ExchangeTopElements;\r
MegaStore(0);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF SSTTop^.VarSize < 4 THEN\r
BEGIN\r
CodeConst(rRENHB,4-SSTTop^.VarSize,Anonymousspix);\r
SSTTop^.VarSize := 4;\r
END;\r
CodeConst(rREVLA, megaoffset(CurrentNiv,InPar),Anonymousspix);\r
CodeConst(rSTVLA, 8,Anonymousspix);\r
AllocDynamic(InSymbol,0,MegaOffset(CurrentNiv,InPar));\r
ESTPushIndAddr(AnonymousSpix,InSymbol,false,P_Normal,CurrentNiv,\r
megaoffset(CurrentNiv,InPar),0);\r
ESTPushIndAddr(AnonymousSpix,InSymbol,true,P_Normal,CurrentNiv,\r
8,0);\r
MegaStore(0);\r
{$ENDIF}\r
END;\r
\r
\r
cAllocDynVar, cAllocDynShared : (* (offset) , Symbol *)\r
do_cAllocDynVar;\r
\r
cAND :\r
BEGIN\r
St_GetBaseType(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Kind <> cBoolean THEN\r
BEGIN\r
{$IFDEF RC35_50}\r
MegaOperationOnStack(iAND,true);\r
{$ENDIF}\r
{$IFDEF PI3}\r
MakeOperationReady(InstType,IntegerOpr);\r
OperationWithReg(iAND,InstType);\r
{$ENDIF}\r
END\r
\r
ELSE\r
AndOrOnBoolean;\r
END;\r
\r
cArrayInit : (* Symbol *)\r
do_carrayInit;\r
\r
cArrayType, cEndArray : (* Symbol *) Do_CarrayType;\r
\r
cAssignStat :\r
BEGIN\r
{$IFDEF RC5000}\r
ReleaseStrucDyn;\r
{$ENDIF}\r
END;\r
\r
cBlock : ;\r
\r
cCAddr : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
St_Retrieve(InSymbol,PtrSt);\r
(* must be changed when st_spix in struc_elem *)\r
ESTPushCAddr((*PtrSt^.St_Spix,*)AnonymousSpix,\r
PtrSt^.TypeRef, false, P_Normal,\r
PtrSt^.St_Const_Label,0);\r
END;\r
\r
cCallThunk : (* Symbol *)\r
BEGIN\r
{$IFDEF PI3}\r
\r
PushOperand;\r
ESTPop;\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
PushParam(cInspectParam);\r
{$ENDIF}\r
ReadSymbol;\r
St_Retrieve(InSymbol,PtrSt);\r
IF (PtrSt^.St_T_Local_Near = false) THEN\r
MakeLongCall(InSymbol)\r
ELSE\r
BEGIN\r
{$IFDEF PI3}\r
CodeJump(iCALL,PtrSt^.Type_Label);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF (CurrentNiv = Program_Level) OR\r
((CurrentNiv + 1) = PtrSt^.Type_Address.Level) THEN\r
CodeJump(rPCALS0,PtrSt^.Type_Label)\r
ELSE\r
IF CurrentNiv = PtrSt^.Type_Address.Level THEN\r
CodeJump(rPCALS1,PtrSt^.Type_Label)\r
ELSE\r
BEGIN\r
CodeConst(rREAID,CurrentNiv-PtrSt^.TYpe_Address.Level + 1, AnonymousSpix);\r
CodeJump(rPCALS, PtrSt^.Type_Label);\r
END;\r
{$ENDIF}\r
\r
{$IFDEF RC5000}\r
LoadFirstParams(PtrSt^.type_ParamSize + 4, St_Local);\r
CodeJump(mCALL,PtrSt^.Type_Label);\r
EndCall(PtrSt^.type_ParamSize + 4);\r
{$ENDIF}\r
END;\r
END;\r
\r
cCaseelement :\r
BEGIN\r
{$IFDEF RC5000}\r
LastJMPOffset := 0;\r
{$ENDIF}\r
CodeJump(iJMP,SSTTop^.CaseEnd);\r
END;\r
\r
\r
cCaseExpr :\r
BEGIN\r
{$IFDEF PI3}\r
St_RetrieveType(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Size = 1 THEN InstType := b\r
ELSE InstType := w;\r
\r
LoadRegister(ESTTop,AddrRegister,Rnil,InstType);\r
IF InstType = b THEN SetHighByteTo0(ESTTop);\r
Reg := ESTTop^.R;\r
CodeRegConst(iSUB,w,Reg,SSTTop^.Lower);\r
CodeJump(iJL,SSTTop^.CaseOtherwise);\r
(* $nocheck*)\r
CodeRegConst(iCMP,w,Reg,SSTTop^.Higher - SSTTop^.Lower);\r
(* $check*)\r
CodeJump(iJG,SSTTop^.CaseOtherwise);\r
CodeReg(iSHL,w,Reg); (* Reg := Reg * 2 *)\r
CodeIndJump(SSTTop^.TabelLabel,Reg);\r
ReleaseRegister(Reg);\r
\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MegaLoad(ESTTop);\r
CodeConst(mSTL,ParamIndex,anonymousspix);\r
CodeConst(mLDL,ParamIndex,Anonymousspix);\r
CodeConst(mLDC,SSTTop^.Lower - 1,AnonymousSpix);\r
GenCode(mGT);\r
CodeJump(mCJ,SSTTop^.CaseOtherwise);\r
\r
CodeConst(mLDC,SSTTop^.higher + 1,AnonymousSpix);\r
CodeConst(mLDL,ParamIndex,Anonymousspix);\r
GenCode(mGT);\r
CodeJump(mCJ,SSTTop^.CaseOtherwise);\r
\r
CodeConst(mLDL,ParamIndex,Anonymousspix);\r
CodeLoadEffAddr(SSTTop^.CaseOtherwise,\r
(SSTTop^.higher + 1) * (-4));\r
GenCode(mWSUB);\r
CodeConst(mLDNL,0,AnonymousSpix);\r
GenCode(mLDPI);\r
\r
GenerateLabel(SSTTop^.TabelLabel);\r
Gencode(mGCALL);\r
\r
{$ENDIF}\r
{$IFDEF RC3502}\r
MegaLoad(ESTTop);\r
CodeJump(rJMCHT,SSTTop^.TabelLabel);\r
{$ENDIF}\r
ESTPop;\r
\r
END;\r
\r
cCaseRange : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
GenerateLabel(InSymbol);\r
END;\r
\r
cCaseList :\r
;\r
\r
cCaseStat : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
SSTPush;\r
SSTTop^.Kind := s_Case;\r
\r
St_Declaration(CLabel,AnonymousName,SSTTop^.TabelLabel,Ptr);\r
St_Declaration(CLabel,AnonymousName,SSTTop^.CaseEnd,Ptr);\r
St_Declaration(CLabel,AnonymousName,SSTTop^.CaseOtherwise,Ptr);\r
\r
(* Find Lower and higher for the case subrange *)\r
St_RetrieveType(InSymbol,PtrSt);\r
\r
\r
SSTTop^.Higher := PtrSt^.Subr_High;\r
SSTTop^.Lower := PtrSt^.Subr_Low;\r
\r
END;\r
\r
\r
cChain :\r
BEGIN\r
PushOperand;\r
CallRoutine(AnonymousSpix,Init_Chain,St_extern);\r
ESTPop;\r
END;\r
\r
\r
cCheckNumber (* Symbol Offset Diff *) , cConstCheckNumber :\r
(* Offset Number *)\r
do_CheckNumber;\r
\r
cCheckParam : Do_CheckParam; (* Symbol *)\r
\r
cCompareSet:\r
BEGIN\r
ReadCode;\r
\r
MakeSetOprReady;\r
{$IFNDEF RC3502}\r
IF InCode = cGE THEN SetRoutine := GESet\r
ELSE\r
IF InCode = cEQ THEN SetRoutine := EQSet\r
ELSE\r
IF InCode = cNE THEN SetRoutine := NESet\r
ELSE\r
SetRoutine := LESet;\r
CallRoutine(AnonymousSpix,SetRoutine,St_Extern);\r
Bool := StdCode_To_Address(cBoolean,TypeAddr);\r
{$ELSE}\r
IF InCode = cGE THEN GenCode(rSETSP)\r
ELSE\r
IF (InCode = cEQ) or (InCode = cNE) THEN GenCode(rSETEQ)\r
ELSE\r
GenCode(rSETSB);\r
IF InCode = cNE THEN Inst := rNOT ELSE Inst := rOR;\r
ESTPushDecode(St_NillAddr,St_NillAddr,Inst);\r
IF ResultMustBeEncode THEN Encode;\r
{$ENDIF}\r
{$IFDEF PI3}\r
GetReg(AX);\r
ESTPushReg(TypeAddr,AX);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
EndCall(16);\r
ESTPushStack(TypeAddr,False);\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
\r
END;\r
\r
\r
{$IFDEF RC3502}\r
cprestring : CodeConst(rRECHW,0,Anonymousspix);\r
{$ENDIF}\r
\r
\r
cCompareString : do_cCompareString;\r
\r
cConstdecl : (* Symbol *)\r
BEGIN\r
{$IFDEF RC5000}\r
MegaAllignCode;\r
IF Not ExternalThunksDumped THEN DumpExternalThunks;\r
{$ENDIF}\r
ReadSymbol;\r
St_Retrieve(InSymbol,Ptr);\r
GenerateLabel(Ptr^.St_Const_Label);\r
DumpConst(InSymbol);\r
END;\r
\r
\r
cContLoop :\r
BEGIN\r
SSTTemp := OutOfRepStat;\r
CodeJump(iJMP,SSTTemp^.ContLabel);\r
END;\r
\r
\r
cDIV: Do_cdiv;\r
\r
cDown : Do_cup;\r
\r
cElse :\r
BEGIN\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
SSTTop^.IfEndLabel := Lab;\r
CodeJump(iJMP,lab);\r
GenerateLabel(SSTTop^.IfFalseLabel);\r
END;\r
\r
\r
cEndArrayInit: (* Symbol *) do_cEndArrayInit;\r
\r
\r
cEndAssign: do_cendassign;\r
\r
cEndAssignSet : do_cEndAssignSet;\r
\r
cEndAssignString :\r
BEGIN\r
BeforeStringOpr;\r
{$IFDEF RC35_50}\r
CallRoutine(Anonymousspix,StStr,st_Extern);\r
{$ENDIF}\r
{$IFDEF PI3}\r
\r
GenCode(iRep);\r
GenCode(iMOVSB);\r
CodeRegReg(iADD,w,CX,DX);\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
CodeJump(iJLE,Lab);\r
CodeRegconst(iMOV,b,AX,32);\r
GenCode(iRep);\r
GenCode(iSTOSB);\r
GenerateLabel(Lab);\r
\r
AfterStringOpr;\r
IF InStrucValue > 0 THEN\r
BEGIN (* a Struc value. Update The Address *)\r
GetReg(DI);\r
ESTPushAbsAddr(AnonymousSpix,St_NillAddr,false\r
,P_Normal,DS,False,0,DI);\r
END;\r
{$ENDIF}\r
END;\r
\r
\r
cEndBlock:\r
BEGIN\r
IF GlobalBlock THEN\r
StopBlock;\r
END;\r
\r
cEndCase:\r
BEGIN\r
GenerateLabel(SSTTop^.CaseEnd);\r
{$IFDEF RC5000}\r
LastLabelOffset := 0;\r
LastJMPOffset := 0;\r
{$ENDIF}\r
SSTPop;\r
END;\r
\r
cEndCompound: (* Symbole *) do_cEndCompound;\r
\r
cEndElse :\r
BEGIN\r
GenerateLabel(SSTTop^.IfEndLabel);\r
SSTPop;\r
END;\r
\r
cEndExchange :\r
do_cendexchange;\r
\r
cEndExchangeString :\r
BEGIN\r
BeforeStringOpr;\r
{$IFDEF RC35_50}\r
CallRoutine(Anonymousspix,ExStr,st_Extern);\r
{$ENDIF}\r
{$IFDEF PI3}\r
\r
St_Declaration(cLabel,AnonymousName,Elab,ptr);\r
CodeJump(iJCXZ,Elab);\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
GenerateLabel(Lab);\r
\r
Loc(ESTTop^.BackWard,Addr);\r
CodeRegAddr(iMOV,b,AX,Addr);\r
GenCode(iMOVSB);\r
Loc(ESTTop,Addr);\r
Addr.Displacement := $FFFF;\r
CodeAddrReg(iMOV,b,Addr,AX);\r
CodeJump(iLOOP,Lab);\r
CodeRegReg(iCMP,w,DX,CX);\r
CodeJump(iJGE,ELab);\r
CodeReg(iNEG,w,DX);\r
CodeRegReg(iMOV,w,DI,SI);\r
CodeRegReg(iMOV,w,SI,DS);\r
CodeRegReg(iMOV,w,ES,SI);\r
GenerateLabel(ELab);\r
CodeRegReg(iMOV,w,CX,DX);\r
CodeRegconst(iMOV,b,AX,32);\r
GenCode(iREP);\r
GenCode(iSTOSB);\r
\r
AfterStringOpr;\r
{$ENDIF}\r
\r
END;\r
\r
cEndFor : (* Symbol *) do_cEndFor;\r
\r
cEndFunccall : Do_cendproccall;\r
\r
cEndIf :\r
BEGIN\r
GenerateLabel(SSTTop^.IfFalseLabel);\r
SSTPop;\r
END;\r
\r
\r
cEndInclude:\r
BEGIN\r
Files_Return_To_Mark;\r
InContext := false;\r
CurrentNiv := OldCurrentNiv;\r
SetCodeTo(OldCode);\r
SourceNumber := OldSourceNumber;\r
ContextStop;\r
END;\r
\r
cEndInit : do_cEndAssign;\r
\r
cEndLock :\r
BEGIN\r
LeaveLock(true,SSTTop^.ESTLockVar);\r
SSTPop;\r
END;\r
\r
cEndLoop :\r
BEGIN\r
CodeJump(iJMP,SSTTop^.ContLabel);\r
GenerateLabel(SSTTop^.ExitLabel);\r
SSTPop;\r
END;\r
\r
cEndProcCall : do_cendproccall;\r
\r
cEndProgramCall : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
St_Get(InSymbol,Ptr);\r
if Ptr^.st_kind<>cprogram then\r
St_RetrieveType(Ptr^.typeref, ptr);\r
{$IFDEF PI3}\r
\r
CodeRegConst(iADD,w,SP,Ptr^.St_ParamSize);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
LengthOfProgParam := Ptr^.St_ParamSize + 8;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
CodeConst(rSTVLW,RC3502ProgramOffset,Anonymousspix);\r
CodeConst(rSTNHB,Ptr^.St_ParamSize,Anonymousspix);\r
CodeConst(rREVLW,RC3502ProgramOffset,Anonymousspix);\r
{$ENDIF}\r
\r
END;\r
\r
\r
cEndRecord :\r
BEGIN\r
{$IFDEF RC35_50}\r
do_cRecfield;\r
{$ENDIF}\r
{$IFDEF PI3}\r
\r
IF ESTTop^.Kind = O_Const THEN\r
CodeRegConst(iADD,w,Reg,ESTTop^.Value)\r
ELSE\r
BEGIN\r
Loc(ESTTop,Addr1);\r
CodeRegAddr(iADD,w,Reg,Addr1);\r
ReleaseAddr(Addr1);\r
END;\r
ESTPop;\r
\r
CodeJump(iJAE,Lab);\r
CodeFaultAX(IntOnFault,DynRecordExc);\r
GenerateLabel(Lab);\r
\r
Loc(ESTTop,Addr);\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement - ((NoOfDynFields\r
- 1) * 2);\r
(* $check*)\r
CodeAddrReg(iMOV,w,Addr,Reg);\r
ReleaseRegister(Reg);\r
ReleaseAddr(Addr);\r
ESTPop;\r
{$ENDIF}\r
END;\r
\r
\r
cEndRecordInit : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
{$IFDEF PI3}\r
\r
IF ESTTop^.Kind = O_Stack THEN\r
CodeRegConst(iADD,w,SP,4)\r
ELSE\r
BEGIN\r
ReleaseRegister(ESTTop^.A_Seg);\r
ReleaseRegister(DI);\r
END;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF (ESTTop^.Kind = O_Temp) OR (ESTTop^.Kind = O_StackOrTemp) THEN\r
TempOffset := TempOffset + 1;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF (ESTTop^.Kind = O_Stack) THEN\r
CodeConst(rSTNHB,4,anonymousspix);\r
{$ENDIF}\r
\r
ESTPop;\r
END;\r
\r
\r
cEndRegion :\r
BEGIN\r
LeaveRegion(SSTTop^.RegVar);\r
SSTPop;\r
END;\r
\r
cEndRepeat :\r
BEGIN\r
FallThruTrue;\r
GenAsLabel(ESTTop^.FalseLab,SSTTop^.RepeatLabel);\r
ESTPop;\r
GenerateLabel(SSTTop^.ExitLabel);\r
SSTPop;\r
END;\r
\r
\r
cEndSegment :\r
BEGIN\r
{$IFDEF PI3}\r
SetCodeModeToTrue;\r
MakeJumpToNextSegment;\r
{$ENDIF}\r
END;\r
\r
\r
cEndStruc:\r
\r
BEGIN\r
InStrucValue := InStrucValue - 1;\r
{$IFDEF PI3}\r
IF NotPack = False THEN\r
BEGIN\r
IF ESTTop^.Kind = O_Reg THEN\r
ReleaseRegister(ESTTop^.R);\r
ESTPop;\r
NotPack := true;\r
END;\r
ReleaseRegister(ESTTop^.A_Seg);\r
ReleaseRegister(ESTTop^.A_Index);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF (ESTTop^.Kind = O_Temp) OR (ESTTop^.Kind = O_StackOrTemp) THEN\r
TempOffset := TempOffset + 1;\r
ESTTop^.Backward^.Indvar := True;\r
{$ENDIF}\r
ESTPop;\r
END;\r
\r
\r
cEndThunk : Do_cendcompound;\r
\r
cEndSetList : (* NoElement *)\r
BEGIN\r
ReadPar;\r
{$IFDEF PI3}\r
\r
CodeRegConst(iMOV,w,AX,InPar);\r
CodeReg(iPUSH,w,AX);\r
CallRoutine(AnonymousSpix,MakeSet,St_Extern);\r
GetReg(ES);\r
GetReg(BX);\r
CodeRegConst(iADD,w,SP,InPar * 4);\r
ESTPushAbsAddr(AnonymousSpix,St_NillAddr,False,P_Normal,ES,\r
false,0,BX);\r
ESTTop^.Set_Temp := true;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTTop^.Kind := O_Stack;\r
ESTTop^.T_Address := false;\r
ESTTop^.Backward^.Value := InPar;\r
LoadFirstParams((InPar * 8) + 8,St_Extern);\r
CallRoutine(AnonymousSpix,MakeSet,St_Extern);\r
EndCall((InPar * 8) + 8);\r
ESTPushStack(ST_NillAddr,false);\r
StoreStackToTemp(ESTTop);\r
ESTTop^.T_Address := True;\r
ESTTOP^.T_ObjectOffset := 0;\r
ESTTop^.Set_Temp := true;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
ESTPushStack(IntegerType,false);\r
{$ENDIF}\r
\r
END;\r
\r
cEndSubRange : (* Symbol *) do_cEndSubRange;\r
\r
cEndWhile:\r
BEGIN\r
CodeJump(iJMP,SSTTop^.ContLabel);\r
GenerateLabel(SSTTop^.ExitLabel);\r
SSTPop;\r
END;\r
\r
cEom : Begin\r
StopCodeGene;\r
MoreInPut := false;\r
END;\r
\r
\r
cEQ : BEGIN\r
{$IFDEF PI3}\r
CMPTopElements(neg);\r
ESTPushDecode(St_NillAddr,St_NillAddr,iJNE);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
inst := mDIFF;\r
CMPTopElements(Inst,false);\r
if Inst = mDIFF THEN inst := iJE ELSE inst := iNil;\r
ESTPushDecode(St_NillAddr,St_NillAddr,inst);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
CMPTopElements(rEQ,neg);\r
{$ENDIF}\r
IF ResultMustBeEncode THEN EnCode;\r
END;\r
\r
\r
cException : (* Symbol *)\r
BEGIN\r
{$IFDEF PI3}\r
SetCodeModeToFalse;\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
GenerateLabel(Lab);\r
\r
CodeReg(iPOP,w,AX);\r
CodeReg(iPop,w,AX);\r
(* ignore PI3 frames *)\r
MakeAddr(Program_Level, Call_Frame, addr, false);\r
CodeRegAddr(imov, w, BP, addr);\r
{$ENDIF}\r
\r
ReadSymbol;\r
{$IFDEF PI3}\r
St_Retrieve(InSymbol,PtrSt);\r
CodeJump(iCALL,PtrSt^.St_Label);\r
CallRoutine(AnonymousSpix,EndProcess,St_Extern);\r
{$ENDIF}\r
{$IFNDEF RC3502}\r
SetCodeModeToTrue;\r
{$ENDIF}\r
{$IFDEF PI3}\r
(* Call Set_Exception *)\r
CodeReg(iPUSH,w,CS);\r
CodeLoadEffAddr(AX,Lab,0);\r
CodeReg(iPUSH,w,AX);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
CodeConst(mLDLP,StaOff,Anonymousspix);\r
St_Retrieve(InSymbol,PtrSt);\r
CodeLoadEffAddr(PtrSt^.St_Label,0);\r
{$ENDIF}\r
{$IFNDEF RC3502}\r
CallRoutine(AnonymousSpix,Set_Exception,St_Extern);\r
{$ELSE}\r
OwnException := True;\r
St_Retrieve(InSymbol,PtrSt);\r
ExceptionProc := PtrSt^.St_Label;\r
{$ENDIF}\r
END;\r
\r
cExchangeStat : ;\r
\r
cExitLoop :\r
BEGIN\r
SSTTemp := OutOfRepStat;\r
CodeJump(iJMP,SSTTemp^.ExitLabel);\r
END;\r
\r
\r
cExitStat :\r
BEGIN\r
SSTTemp := OutOfBlock;\r
CodeJump(iJMP,SSTTemp^.P_ExitLabel);\r
END;\r
\r
\r
cFamilyType : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
St_Retrieve(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
{$IFDEF RC35_50}\r
ESTTop^.IndVar := false;\r
Pushparam(InCode);\r
{$ENDIF}\r
{$IFDEF PI3}\r
PushOperand;\r
ESTPop;\r
{$ENDIF}\r
END;\r
\r
\r
cField ,cFieldInit : (* Symbol *) do_cField;\r
\r
\r
cForStat :\r
BEGIN\r
{$IFDEF RC5000}\r
ReleaseStrucDyn;\r
{$ENDIF}\r
END;\r
\r
\r
cFuncCall :\r
BEGIN\r
{$IFDEF RC5000}\r
StartCall;\r
{$ENDIF}\r
{$IFDEF PI3}\r
PushOperands;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF ESTTop <> Bottom_ESTTOP THEN\r
MegaLoad(ESTTop);\r
Readpar;\r
IF InPar = 0 THEN\r
BEGIN\r
ReadCode;\r
Readpar;\r
CodeConst(rREALD,megaoffset(CurrentNiv,InPar),AnonymousSpix);\r
ESTPushaddr(Anonymousspix,IntegerType,false,P_Normal,\r
CurrentNiv,megaoffset(CurrentNiv,Inpar));\r
END\r
ELSE\r
BEGIN\r
IF InPar = 3 THEN CodeConst(rRECHW,1,Anonymousspix);\r
CodeConst(rRECHW,0,Anonymousspix);\r
END;\r
{$ENDIF}\r
\r
END;\r
\r
cFuncDecl : do_cprocdecl;\r
\r
cGE : BEGIN\r
{$IFDEF PI3}\r
St_GetBaseType(EstTop^.OprType,PtrSt);\r
\r
IF PtrST^.St_Kind = cInteger THEN Inst := iJL\r
ELSE Inst := iJB;\r
CMPTopElements(neg);\r
\r
IF neg THEN\r
BEGIN\r
IF Inst = iJL THEN Inst := iJG ELSE Inst := iJA;\r
END;\r
ESTPushDecode(St_NillAddr,St_NillAddr,Inst);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
Inst := mGT;\r
CMPTopElements(inst,true);\r
ESTPushDecode(St_NillAddr,St_NillAddr,mEQC);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
CMPTopElements(rGE,true);\r
{$ENDIF}\r
IF ResultMustBeEncode THEN EnCode;\r
END;\r
\r
\r
cGoto : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
CodeJump(iJMP,InSymbol);\r
END;\r
\r
\r
cGT : BEGIN\r
{$IFDEF PI3}\r
St_GetBaseType(EstTop^.OprType,PtrSt);\r
IF PtrSt^.St_Kind = cInteger THEN Inst := iJLE\r
ELSE Inst := iJBE;\r
CMPTopElements(neg);\r
\r
\r
IF neg THEN\r
BEGIN\r
IF Inst = iJLE THEN Inst := iJGE ELSE Inst := iJAE;\r
END;\r
\r
ESTPushDecode(St_NillAddr,St_NillAddr,Inst);\r
\r
{$ENDIF}\r
{$IFDEF RC5000}\r
Inst := mGT;\r
CMPTopElements(Inst,false);\r
Inst := iNil;\r
ESTPushDecode(St_NillAddr,St_NillAddr,Inst);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
CMPTopElements(rGT,false);\r
{$ENDIF}\r
\r
IF ResultMustBeEncode THEN EnCode;\r
END;\r
\r
cIfExpr :\r
BEGIN\r
FallThruTrue;\r
SSTPush;\r
SSTTop^.Kind := S_If;\r
SSTTop^.IfFalseLabel := ESTTop^.FalseLab;\r
ESTPop;\r
END;\r
\r
cIfStat : ;\r
\r
cIn :\r
BEGIN\r
ESTTop^.IndVar := false;\r
{$IFDEF PI3}\r
PushOperand;\r
CodeRegConst(iMOV,w,AX,ord(ESTTop^.Set_Temp));\r
CodeReg(iPUSH,w,AX);\r
ESTPop;\r
CallRoutine(AnonymousSpix,InSet,St_Extern);\r
GetReg(AX);\r
ESTPushReg(BooleanType,AX);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
PushSetParam;\r
LoadFirstParams(12,St_Extern);\r
CallRoutine(AnonymousSpix,InSet,St_Extern);\r
EndCall(12);\r
ESTPushStack(BooleanType,True);\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF (ESTSort(ESTTop) = S_Memery) OR\r
( (ESTSort(ESTTop) = S_Stack) AND (ESTTop^.IndVar)) THEN\r
BEGIN\r
MegaLoad(ESTTop^.Backward);\r
LoadAbsAddr(ESTTop);\r
St_Retrieve(ESTTop^.OprType,PtrSt);\r
CodeConst(rRECHW,PtrSt^.St_Size,Anonymousspix);\r
GenCode(rSETATM);\r
ESTPop;\r
END\r
ELSE\r
BEGIN\r
MakeSetOprReady;\r
GenCode(rSETTM);\r
END;\r
ESTPop;\r
ESTPushStack(BooleanType,false);\r
{$ENDIF}\r
END;\r
\r
cIndex : do_cindex;\r
\r
cIndexCheck : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
{$IFNDEF RC3502}\r
CheckRange(InSymbol,IndexOutOfRangeInt,IndexOutOfRangeExc);\r
{$ENDIF}\r
END;\r
\r
cIndVar :\r
BEGIN\r
ESTTop^.IndVar := true;\r
{$IFDEF RC5000}\r
MegaTestLoad(true);\r
{$ENDIF}\r
END;\r
\r
cInit :\r
BEGIN\r
SetCodeModeToTrue;\r
IF InDeclPart = false THEN\r
{$IFDEF RC5000}\r
Makefreereg(3);\r
{$ENDIF}\r
{$IFDEF PI3}\r
PushOperands;\r
{$ENDIF}\r
(* only used when renaming *)\r
END;\r
\r
cInitBlock :\r
BEGIN\r
SetCodeModeToTrue;\r
InDeclPart := false;\r
END;\r
\r
cInitShar, cInitDynShar : Do_cInitShar;\r
\r
cInspectParam :\r
BEGIN\r
ESTTop^.IndVar := false;\r
{$IFDEF RC35_50}\r
Pushparam(InCode);\r
{$ENDIF}\r
{$IFDEF PI3}\r
PushOperand;\r
ESTPop;\r
{$ENDIF}\r
END;\r
\r
{$IFDEF RC3502}\r
CInteger : (* FUSK tag kopi of stack top *)\r
GenCode(rREVPD);\r
{$ENDIF}\r
\r
cLabelDef : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
GenerateLabel(InSymbol);\r
END;\r
\r
\r
cLE : BEGIN\r
{$IFDEF PI3}\r
St_GetBaseType(EstTop^.OprType,PtrSt);\r
\r
IF PtrSt^.St_Kind = cInteger THEN Inst := iJG\r
ELSE Inst := iJA;\r
CMPTopElements(neg);\r
\r
IF neg THEN\r
BEGIN\r
IF Inst = iJG THEN Inst := iJL ELSE Inst := iJB;\r
END;\r
ESTPushDecode(St_NillAddr,St_NillAddr,Inst);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
Inst := mGT;\r
CMPTopElements(Inst,false);\r
ESTPushDecode(St_NillAddr,St_NillAddr,mEQC);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
CMPTopElements(rLE,false);\r
{$ENDIF}\r
IF ResultMustBeEncode THEN EnCode;\r
END;\r
\r
cLockStat, cLockBufStat : (* Symbol *) do_clockstat;\r
\r
cLoopStat :\r
BEGIN\r
SSTPushLoop;\r
GenerateLabel(SSTTop^.ContLabel);\r
END;\r
\r
\r
cLT : BEGIN\r
{$IFDEF PI3}\r
St_GetBaseType(EstTop^.OprType,PtrSt);\r
\r
IF PtrST^.St_Kind = cInteger THEN Inst := iJGE\r
ELSE Inst := iJAE;\r
CMPTopElements(neg);\r
\r
IF neg THEN\r
BEGIN\r
IF Inst = iJGE THEN INST := iJLE ELSE Inst := iJBE;\r
END;\r
ESTPushDecode(St_NillAddr,St_NillAddr,Inst);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
Inst := mGT;\r
CMPTopElements(Inst,true);\r
ESTPushDecode(St_NillAddr,St_NillAddr,iNil);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
CMPTopElements(rLT,true);\r
{$ENDIF}\r
IF ResultMustBeEncode THEN EnCode;\r
END;\r
\r
cMailBox :\r
BEGIN\r
PushOperand;\r
CallRoutine(AnonymousSpix,Init_MailBox,St_extern);\r
ESTPop;\r
END;\r
\r
\r
cMOD: Do_cdiv;\r
\r
cMul:\r
BEGIN\r
{$IFDEF RC35_50}\r
MegaOperationOnStack(iMUL,true);\r
{$ENDIF}\r
{$IFDEF PI3}\r
MakeOperationReady(InstType,IntegerOpr);\r
IF IntegerOpr THEN Inst := iIMUL\r
ELSE Inst := iMUL;\r
\r
IF ((ESTSort(ESTTop) = S_Reg) AND ((ESTTop^.R = AX)\r
OR ( ESTSort(ESTTop^.BackWard) = S_Memery))) THEN\r
BEGIN\r
LoadRegister(ESTTop,SpecificReg,AX,InstType);\r
TypeAddr := ESTTop^.OprType;\r
ESTPop;\r
IF ESTSort(ESTTop) = S_Memery THEN\r
BEGIN\r
Loc(ESTTop,Addr);\r
ESTPop;\r
IF InstType <> b THEN\r
BEGIN\r
MinFreeReg := 0;\r
GetReg(DX);\r
ReleaseRegister(DX);\r
MinFreeReg := NormalMinFreeReg;\r
END;\r
CodeAddr(Inst,InstType,Addr);\r
ReleaseAddr(Addr);\r
END\r
ELSE\r
BEGIN\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
Reg := ESTTop^.R;\r
ESTPop;\r
IF (( Reg <> DX) AND (InstType <> b))\r
THEN\r
BEGIN\r
MinFreeReg := 0;\r
GetReg(DX);\r
ReleaseRegister(DX);\r
MinFreeReg := NormalMinFreeReg;\r
END;\r
CodeReg(Inst,InstType,Reg);\r
ReleaseRegister(Reg);\r
END;\r
\r
ESTPushReg(TypeAddr,AX);\r
END\r
\r
ELSE\r
BEGIN\r
LoadRegister(ESTTop^.BackWard,SpecificReg,AX,InstType);\r
\r
IF ESTSort(ESTTop) = S_Memery THEN\r
BEGIN\r
Loc(ESTTop,Addr);\r
ESTPop;\r
IF InstType <> b THEN\r
BEGIN\r
MinFreeReg := 0;\r
GetReg(DX);\r
ReleaseRegister(DX);\r
MinFreeReg := NormalMinFreeReg;\r
END;\r
CodeAddr(Inst,InstType,Addr);\r
ReleaseAddr(Addr);\r
END\r
ELSE\r
BEGIN\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
Reg := ESTTop^.R;\r
ESTPop;\r
IF ((Reg <> DX) AND (InstType <> b))\r
THEN\r
BEGIN\r
MinFreeReg := 0;\r
GetReg(DX);\r
ReleaseRegister(DX);\r
MinFreeReg := NormalMinFreeReg;\r
END;\r
CodeReg(Inst,InstType,Reg);\r
ReleaseRegister(Reg);\r
END;\r
END;\r
{$ENDIF}\r
\r
END;\r
\r
\r
cNE : BEGIN\r
{$IFDEF PI3}\r
CMPTopElements(neg);\r
ESTPushDecode(St_NillAddr,St_NillAddr,iJE);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
Inst := mDIFF;\r
CMPTopElements(Inst,false);\r
IF Inst = mDIFF THEN Inst := iJNE ELSE Inst := mEQC;\r
ESTPushDecode(St_NillAddr,St_NillAddr,Inst);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
CMPTopElements(rNE,false);\r
{$ENDIF}\r
IF ResultMustBeEncode THEN EnCode;\r
\r
END;\r
\r
cNewtype:\r
BEGIN\r
PushOperand;\r
SetRoutine := Init_Reference;\r
{$IFDEF RC3502}\r
SetRoutine := heapref;\r
{$ENDIF}\r
readcode;\r
CallRoutine(AnonymousSpix,SetRoutine,St_extern);\r
ESTPop;\r
END;\r
\r
cNOT :\r
BEGIN\r
St_GetBaseType(ESTTop^.OprType,PtrSt);\r
\r
IF PtrSt^.St_Kind <> cBoolean THEN\r
BEGIN\r
{$IFDEF PI3}\r
St_GetBaseType(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Size<>1 THEN InstType := w\r
ELSE InstType := b;\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
CodeReg(iNOT,InstType,ESTTop^.R);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MegaLoad(ESTTop);\r
gencode(mNOT);\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
MegaLoad(ESTTop);\r
gencode(rCOMPL);\r
{$ENDIF}\r
END\r
ELSE\r
BEGIN\r
{$IFDEF PI3}\r
IF ESTSort(ESTTop) = S_Decode THEN\r
BEGIN\r
IF ESTTop^.Condition <> iNil THEN\r
ESTTop^.Condition := NegInstruction[ESTTop^.Condition];\r
Lab := ESTTop^.FalseLab;\r
ESTTop^.FalseLab := ESTTop^.TrueLab;\r
ESTTop^.TrueLab := lab;\r
\r
IF ResultMustBeEncode THEN EnCode;\r
END\r
ELSE\r
BEGIN (* ESTSort(ESTTop) <> S_Decode *)\r
LoadRegister(ESTTop,ABCDRegister,RNil,b);\r
Reg := ESTTop^.R;\r
CodeRegConst(iXOR,b,Reg,1);\r
END;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
Decode;\r
IF ESTTop^.Condition = rNOT THEN ESTTop^.Condition := rOR\r
ELSE\r
IF ESTTop^.Condition = rOR THEN ESTTop^.Condition := rNOT\r
ELSE\r
IF ESTTop^.Condition <> iNil THEN\r
ESTTop^.Condition := NegInstruction[ESTTop^.Condition];\r
Lab := ESTTop^.FalseLab;\r
ESTTop^.FalseLab := ESTTop^.TrueLab;\r
ESTTop^.TrueLab := lab;\r
\r
IF ResultMustBeEncode THEN EnCode;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
decode;\r
IF ESTTop^.Condition = iNIL then ESTTop^.Condition := mEQC\r
ELSE\r
IF ESTTop^.Condition = mEQC then ESTTop^.Condition := iNil\r
ELSE\r
IF ESTTop^.Condition = iJNE then ESTTop^.Condition := iJE\r
ELSE\r
ESTTop^.Condition := iJNE;\r
Lab := ESTTop^.FalseLab;\r
ESTTop^.FalseLab := ESTTop^.TrueLab;\r
ESTTop^.TrueLab := lab;\r
\r
IF ResultMustBeEncode THEN EnCode;\r
\r
{$ENDIF}\r
END;\r
END;\r
\r
cNull : Do_CNull;\r
\r
cOR :\r
BEGIN\r
\r
St_GetBaseType(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Kind <> cBoolean THEN\r
BEGIN\r
{$IFDEF RC35_50}\r
MegaOperationOnStack(iOR,true);\r
{$ENDIF}\r
{$IFDEF PI3}\r
MakeOperationReady(InstType,IntegerOpr);\r
OperationWithReg(iOR,InstType);\r
{$ENDIF}\r
END\r
ELSE\r
AndOrOnBoolean;\r
END;\r
\r
\r
cOtherwise : (* Symbol *)\r
BEGIN\r
{$IFNDEF RC5000}\r
GenerateLabel(SSTTop^.TabelLabel);\r
{$ENDIF}\r
ReadSymbol;\r
\r
{$IFDEF PI3}\r
IF not Equal_Addr(St_NillAddr,InSymbol) then\r
DumpCaseTabel(InSymbol,SSTTop^.Higher - SSTTop^.Lower + 1,\r
SSTTop^.CaseOtherwise);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
DumpCaseTabel(InSymbol,SSTTop^.lower,SSTTop^.Higher,\r
SSTTop^.CaseOtherwise);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF not Equal_Addr(St_NillAddr,InSymbol) then\r
BEGIN\r
DumpCaseTabel(InSymbol,SSTTop^.Higher - SSTTop^.Lower + 1,\r
SSTTop^.CaseOtherwise,SSTTop^.TabelLabel);\r
END;\r
{$ENDIF}\r
GenerateLabel(SSTTop^.CaseOtherwise);\r
END;\r
\r
\r
cOtherwiseExc :\r
BEGIN\r
CodeFault(OtherwiseInt,OtherwiseExc);\r
END;\r
\r
\r
cOverFlowCheck :\r
BEGIN\r
{$IFDEF PI3}\r
GenCode(iINTO);\r
{$ENDIF}\r
END;\r
\r
\r
cPointerType :\r
BEGIN\r
{$IFDEF PI3}\r
\r
Loc(ESTTop,Addr);\r
\r
CodeAddrConst(iMOV,w,Addr,0);\r
\r
Addr.Spix := AnonymousSpix;\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement + 2;\r
(* $check*)\r
CodeAddrConst(iMOV,w,Addr,0);\r
\r
IF DoNotPopTop = false THEN\r
BEGIN\r
ReleaseAddr(Addr);\r
ESTPop;\r
END\r
ELSE\r
BEGIN\r
ESTTop^.A_Displacement := 0;\r
DoNotPopTop := false;\r
END;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTPUSHConst(IntegerType,0);\r
MegaStore(4);\r
(* ?????\r
IF DoNotPopTop = false THEN\r
BEGIN\r
ReleaseAddr(Addr);\r
ESTPop;\r
END\r
ELSE\r
BEGIN\r
ESTTop^.A_Displacement := 0;\r
DoNotPopTop := false;\r
END; ****)\r
{$ENDIF}\r
{$IFDEF RC3502}\r
ESTPUSHConst(IntegerType,1);\r
MegaStore(1);\r
{$ENDIF}\r
END;\r
\r
\r
cPool :\r
BEGIN\r
PushOperand;\r
CallRoutine(AnonymousSpix,Init_Pool,St_extern);\r
ESTPop;\r
END;\r
\r
\r
cPort :\r
BEGIN\r
PushOperand;\r
CallRoutine(AnonymousSpix,Init_Port,St_extern);\r
ESTPop;\r
END;\r
\r
cPreAnd : FallThruTrue;\r
\r
cPreBool : PushOperands;\r
\r
cPreExchange:\r
{$IFDEF RC35_50}\r
BEGIN\r
LoadAbsAddr(EstTop);\r
StoreStackToTemp(ESTTop);\r
END\r
{$ENDIF}\r
;\r
\r
cPreIn :\r
BEGIN\r
{$IFDEF PI3}\r
\r
St_Retrieve(ESTTop^.OprType,Ptr);\r
IF Ptr^.St_Size = 1 THEN\r
SetHighByteTo0(ESTTop);\r
loadregister(esttop,allregister,rnil,w); (* insert, TOG *)\r
PushOperands;\r
ESTPop;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
StartCall;\r
PushParam(cValueParam);\r
{$ENDIF}\r
END;\r
\r
cPreOr : FallThruFalse;\r
\r
cPreSet, cPreSetFunc : do_cpreset;\r
\r
cPreXOr : ;\r
\r
cProcCall :\r
BEGIN\r
{$IFDEF RC5000}\r
ReleaseStrucDyn;\r
StartCall;\r
{$ENDIF}\r
END;\r
\r
cProcDecl: Do_cprocdecl;\r
\r
cProcess :\r
BEGIN\r
PushOperand;\r
CallRoutine(AnonymousSpix,Init_Process,St_extern);\r
ESTPop;\r
END;\r
\r
\r
\r
cProgDecl : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
St_Retrieve(InSymbol,PtrST);\r
\r
TheProgramType := PtrSt^.St_Specs;\r
GlobalBlock := TheProgramType = St_Global;\r
\r
IF ((TheprogramType = St_Global) OR\r
(TheProgramType = St_Local)) THEN\r
BEGIN (* a normal Program *)\r
SetCodeModeToFalse;\r
\r
RoutineDecl(InSymbol,True);\r
\r
St_Retrieve(InSymbol,ptrSt);\r
SLab := PtrST^.St_Label;\r
\r
IF TheProgramType = St_Global THEN\r
BEGIN\r
{$IFDEF PI3}\r
MakeExternalLBDR(InSymbol,SLab,0,PtrST^.St_VarSize +\r
PtrST^.St_Paramsize\r
,PtrSt^.Prog_CreateSize, PtrST^.St_Spix,0);\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
MakeExternalLBDR(InSymbol,SLab, 0,\r
PtrSt^.Max_Offset - PtrSt^.St_ParamSize - Prog_Descr_Size\r
,PtrSt^.Prog_CreateSize -Prog_Descr_Size,\r
PtrST^.St_Spix,0);\r
{$ENDIF}\r
InsertExternalNumber(PtrSt^.St_External_List);\r
GlobalBlockSymbol := InSymbol;\r
END\r
ELSE\r
{$IFDEF PI3}\r
MakeInternalLBDR(SLab,0,PtrST^.St_VarSize +\r
PtrST^.st_ParamSize, PtrSt^.Prog_Createsize);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MakeInternalLBDR(SLab,0,\r
PtrSt^.Max_Offset - PtrSt^.St_ParamSize - Prog_Descr_Size\r
,PtrSt^.Prog_CreateSize -Prog_Descr_Size,PtrSt^.St_spix);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
MakeInternalLBDR(InSymbol,SLab, 0,\r
PtrSt^.Max_Offset - PtrSt^.St_ParamSize - Prog_Descr_Size\r
,PtrSt^.Prog_CreateSize -Prog_Descr_Size,\r
PtrST^.St_Spix);\r
{$ENDIF}\r
END;\r
\r
IF ((*(Theprogramtype = St_Extern) OR *)\r
(Theprogramtype = St_Local)) THEN\r
BEGIN\r
SetCodeModeToTrue;\r
(* Make code for initialize the program describtion *)\r
St_Retrieve(InSymbol,ptrSt);\r
\r
(* Check if there are any pool Parameter *)\r
PoolParam := PoolType IN PtrSt^.spec_Struct;\r
\r
\r
IF PtrSt^.St_Specs = St_Extern THEN\r
ProgStat := UnLinked\r
ELSE\r
ProgStat := Internal;\r
Value := PtrSt^.Prog_Descr_Offset;\r
St_Retrieve(PtrSt^.St_Family_Ref,PtrSt);\r
\r
MakeProgramDesc(Value,ProgStat,\r
PoolParam,PtrSt^.St_Const_Label);\r
\r
END;\r
\r
IF ((Theprogramtype = St_Global) OR\r
(Theprogramtype = St_Local)) THEN\r
BEGIN (* a normal Program *)\r
SetCodeModeToFalse;\r
St_Retrieve(InSymbol,ptrSt);\r
\r
CurrentNiv := Program_Level;\r
{$IFDEF PI3}\r
SSTPushRoutine(SLab,0,PtrSt^.Max_Offset\r
- PtrSt^.St_VarSize - PtrSt^.St_ParamSize,false);\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
SSTPushRoutine(SLab,PtrSt^.St_VarSize - Prog_descr_Size,\r
PtrSt^.Max_Offset - PtrSt^.St_ParamSize - Prog_Descr_Size\r
,false);\r
SSTTop^.ParSize := PtrSt^.St_ParamSize ;\r
SSTTop^.GlobalVarSize := PtrSt^.St_VarSize - Prog_Descr_Size;\r
\r
{$ENDIF}\r
SSTTop^.Kind := S_Prog;\r
\r
END;\r
IF GlobalBlock THEN\r
BEGIN\r
(* Read The context *)\r
{$IFDEF RC5000}\r
IF Comp_Unit_Bit = Last_Comp_Unit_bit THEN\r
{$ENDIF}\r
BEGIN\r
InContext := true;\r
NoOfTimesInContext := NoOfTimesInContext + 1;\r
OldCurrentNiv := CurrentNiv;\r
oldcode := codeon;\r
oldSourceNumber := SourceNumber;\r
CurrentNiv := Context_Level;\r
Files_Jump_Start;\r
END;\r
IF Comp_Unit_Bit = Last_Comp_Unit_bit\r
THEN Comp_Unit_Bit := 1\r
ELSE Comp_Unit_Bit := Comp_Unit_bit * 2;\r
{$IFDEF RC5000}\r
Comp_unit_bit := 1;\r
{$ENDIF}\r
END;\r
END;\r
\r
cProgram:\r
BEGIN\r
ReadSymbol;\r
(* Make code for initialize the program describtion *)\r
St_RetrieveType(InSymbol,ptrSt);\r
\r
IF ptrSt^.st_specs=st_extern then\r
begin\r
(* Check if there are any pool Parameter *)\r
PoolParam := PoolType IN PtrSt^.spec_Struct;\r
ProgStat := UnLinked;\r
{$IFDEF RC5000}\r
CodeConst(mLDC,ord(poolparam),anonymousspix);\r
IF ESTSort(ESTTop) = S_Stack THEN GenCode(mREV);\r
{$ENDIF}\r
\r
PushOperand;\r
{$IFDEF PI3}\r
CodeRegConst(iMov,w,AX,ord(poolparam));\r
CodeReg(iPush,w,AX);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
CodeLoadEffAddr(PtrSt^.St_Label,0);\r
{$ENDIF}\r
\r
CallRoutine(anonymousspix,init_external,st_extern);\r
end;\r
estpop;\r
END;\r
\r
\r
cProgramCall : (* Symbol *) do_cProgramCall;\r
\r
cRangeCheck : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
St_RetrieveType(InSymbol,ptr);\r
highInt := ptr^.Subr_High;\r
lowInt := ptr^.Subr_low;\r
St_RetrieveType(ESTTop^.oprType,ptr);\r
ValueInt := Ptr^.Subr_High;\r
i := Ptr^.Subr_Low;\r
IF ((ptr^.St_Kind = cSubrange) AND\r
(highInt >= ValueInt) AND\r
(lowInt <= i)) OR\r
( (wordsize = 2) AND\r
(highInt = maxint) AND\r
(LowInt - 1 = maxInt)) THEN ELSE\r
CheckRange(InSymbol,OutOfRangeInt,OutOfRangeExc);\r
END;\r
\r
\r
CRecField : do_cRecField;\r
\r
\r
cRecordInit : ;\r
\r
\r
cRecordType : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
ESTTop^.IndVar := false;\r
eLab := InSymbol;\r
NoOfDynFields := 0;\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
END;\r
\r
cReference :\r
BEGIN\r
PushOperand;\r
IF (CurrentNiv = 0) THEN SetRoutine := Init_Reference\r
ELSE SetRoutine := Init_LocalRef;\r
CallRoutine(AnonymousSpix,SetRoutine,St_extern);\r
ESTPop;\r
END;\r
\r
\r
cRegionStat : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
St_Retrieve(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
\r
(* Enter region *)\r
ESTTop^.Par := P_Normal;\r
\r
{$IFDEF PI3}\r
\r
Loc(ESTTop,Addr);\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement + SharedCounterOffset;\r
(* $check*)\r
\r
CodeAddr(iINC,w,Addr);\r
CodeAddrConst(iCMP,w,Addr,1);\r
\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
CodeJump(iJNE,Lab);\r
\r
ESTTop^.Par := P_Share;\r
Loc(ESTTop,Addr);\r
\r
(* $nocheck*)\r
ESTTop^.A_Displacement := ESTTop^.A_Displacement -\r
LengthOfSemaphore;\r
\r
(* $check*)\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTTop^.OprType := IntegerType;\r
\r
MakeCopyOfTop;\r
AddOffsetToAddr(ESTTop,SharedCounterOffset);\r
\r
MakeCopyOfTop;\r
MakeCopyOfTop;\r
MegaLoad(ESTTop);\r
CodeConst(mADC,1,Anonymousspix);\r
MegaStore(4);\r
\r
MegaLoad(ESTTop);\r
ESTPop;\r
CodeConst(mEQC,1,Anonymousspix);\r
\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
CodeJump(mCJ,Lab);\r
\r
ESTTop^.Par := P_Share;\r
MegaMakeAddr(ESTTop);\r
ESTTop^.T_ObjectOffset := ESTTop^.T_ObjectOffset -\r
LengthOfSemaphore;\r
{$ENDIF}\r
{$IFNDEF RC3502}\r
PushOperand;\r
CallRoutine(AnonymousSpix,WaitS,St_Extern);\r
GenerateLabel(Lab);\r
{$ELSE}\r
LoadAbsAddr(ESTTop);\r
GenCode(rREVPD);\r
CallRoutine(AnonymousSpix,WaitS,St_Extern);\r
{$ENDIF}\r
ESTPop;\r
\r
SSTPush;\r
SSTTop^.kind := s_Region;\r
SSTTop^.RegVar := InSymbol;\r
END;\r
\r
\r
cRepStruc : Do_RepStruc;\r
\r
cRepeatStat :\r
BEGIN\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
GenerateLabel(Lab);\r
SSTPushLoop;\r
SSTTop^.RepeatLabel := Lab;\r
END;\r
\r
cSegment :\r
BEGIN\r
{$IFDEF PI3}\r
RoutineDecl(GlobalBlockSymbol,False);\r
OldLineNumber := LineNumber;\r
StopBlock;\r
LineNumber := OldLineNumber;\r
RoutineDecl(GlobalBlockSymbol,true);\r
CurrentSegNo := CurrentSegNo + 1;\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
SSTTop^.TempLabel := Lab;\r
NewLine(LineNumber);\r
MakeExternalLBDR(Lab,Lab,0,0,0,\r
Segment_Info[CurrentSegNo].Spix,1);\r
ContextStop;\r
DumpRoutineTabel;\r
{$ENDIF}\r
END;\r
\r
\r
\r
cs_element, cm_element :\r
BEGIN\r
{$IFDEF PI3}\r
\r
St_Retrieve(ESTTop^.OprType,Ptr);\r
IF Ptr^.St_Size = 1 THEN SetHighByteTo0(ESTTop);\r
LoadRegister(EstTop,AllRegister,RNil,w);\r
Reg := ESTTop^.R;\r
ESTPop;\r
IF Incode = cm_Element THEN\r
BEGIN\r
St_Retrieve(ESTTop^.OprType,Ptr);\r
IF Ptr^.St_Size = 1 THEN SetHighByteTo0(ESTTop);\r
LoadRegister(ESTTop,AllRegister,RNil,w);\r
Reg1 := ESTTop^.R;\r
ESTPop;\r
ReleaseRegister(Reg1);\r
END\r
ELSE\r
Reg1 := Reg;\r
\r
CodeReg(iPUSH,w,Reg1);\r
CodeReg(iPUSH,w,Reg);\r
ReleaseRegister(Reg);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
\r
IF Incode = cs_Element THEN\r
BEGIN\r
MakeCopyOfTop;\r
END;\r
ExchangeTopElements;\r
PushParam(cValueParam);\r
PushParam(cValueParam);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
MegaLoad(ESTTop);\r
IF Incode = cs_Element THEN\r
BEGIN\r
GenCode(rREVPW);\r
END\r
ELSE\r
ESTPop;\r
ESTPop;\r
GenCode(rSETCR);\r
GenCode(rSETUN);\r
{$ENDIF}\r
END;\r
\r
\r
cShared :\r
BEGIN\r
{$IFDEF PI3}\r
CodeRegConst(iSUB,w,SP,LengthOfSharedType - 4);\r
PushOperand;\r
ESTPop;\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
PushParam(cShared);\r
{$ENDIF}\r
END;\r
\r
cSharedDecl : (* symbol *)\r
BEGIN\r
SetCodeModeToTrue;\r
ReadSymbol;\r
St_Retrieve(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
ESTTop^.Par := P_Normal;\r
{$IFDEF PI3}\r
LoadAddrUse(ESTTop,DI);\r
Loc(ESTTop,Addr);\r
CodeRegAddr(iLES,w,SI,Addr);\r
PushOperand;\r
CodeReg(iPUSH,w,ES);\r
CodeReg(iPUSH,w,SI);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MakeCopyOfTop;\r
PushOperand;\r
CodeConst(mLDNL,0,Anonymousspix);\r
ESTPop;\r
PushOperand;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
PushParam(cVARParam);\r
CallRoutine(Anonymousspix,Init_Reference,St_Extern);\r
{$ELSE}\r
CallRoutine(AnonymousSpix,Init_Shared,St_Extern);\r
ESTPop;\r
{$ENDIF}\r
END;\r
\r
\r
\r
cSharedParam :\r
BEGIN\r
ESTTop^.Par := P_Normal;\r
\r
{$IFDEF RC35_50}\r
PushParam(cSharedParam);\r
{$ENDIF}\r
{$IFDEF PI3}\r
PushOperand;\r
ESTPop;\r
{$ENDIF}\r
END;\r
\r
cShift : Do_cShift;\r
\r
\r
cSimpleConst: (* value , Symbol *)\r
BEGIN\r
ReadPar;\r
ReadSymbol;\r
ESTPushConst(InSymbol,InPar);\r
END;\r
\r
cSetOperator :\r
BEGIN\r
ReadCode;\r
\r
MakeSetOprReady;\r
{$IFNDEF RC3502}\r
IF InCode = cAdd THEN SetRoutine := AddSet\r
ELSE\r
IF InCode = cSub THEN SetRoutine := SubSet\r
ELSE\r
SetRoutine := MultSet;\r
CallRoutine(AnonymousSpix,SetRoutine,St_Extern);\r
{$ELSE}\r
IF InCode = cAdd THEN GenCode(rSETUN)\r
ELSE\r
IF InCode = cSub THEN GenCode(rSETDI)\r
ELSE\r
GenCode(rSETIN);\r
ESTPushStack(St_NillAddr,False);\r
{$ENDIF}\r
{$IFDEF PI3}\r
GetReg(ES);\r
GetReg(BX);\r
ESTPushAbsAddr(AnonymousSpix,St_NillAddr,False,P_Normal,ES,\r
false,0,BX);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
EndCall(16);\r
ESTPushStack(St_NillAddr,False);\r
ESTTop^.T_Address := True;\r
ESTTOP^.T_ObjectOffset := 0;\r
StorestackToTemp(ESTTop);\r
{$ENDIF}\r
ESTTop^.Set_Temp := true;\r
END;\r
\r
\r
cSetList :\r
BEGIN\r
{$IFDEF PI3}\r
PushOperands;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
StartCall;\r
ESTPushConst(IntegerType,0);\r
Pushparam(cValueParam);\r
ESTPushConst(IntegerType,0);\r
Pushparam(cValueParam);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
Megaload(ESTTop);\r
CodeConst(rRECHW,0,Anonymousspix);\r
{$ENDIF}\r
END;\r
\r
cSetValueParam : (* Symbol *)\r
BEGIN\r
ReadSymbol;\r
PushSetOnStack(InSymbol);\r
END;\r
\r
cSetRep : (* Offset *)\r
BEGIN\r
ReadPar;\r
{$IFDEF PI3}\r
MakeAddr(CurrentNiv,InPar,Addr,False);\r
CodeAddrConst(iMOV,w,Addr,0);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTPushAddr(Anonymousspix,IntegerType,false,P_Normal,CurrentNiv,\r
MegaOffset(CurrentNiv,inpar));\r
ESTPushConst(IntegerType,0);\r
MegaStore(4);\r
{$ENDIF}\r
\r
END;\r
\r
cSetType : (* Symbol *)\r
BEGIN\r
{$IFDEF PI3}\r
\r
Loc(ESTTop,Addr);\r
Reg1 := GetRegister(ABCDRegister,RNil);\r
Reg := GetRegister(ABCDRegister,RNil);\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
Addr.Displacement := Addr.Displacement + 2;\r
CodeRegAddr(iMOV,w,Reg1,Addr);\r
ESTPop;\r
ReleaseAddr(Addr);\r
\r
\r
ReadSymbol;\r
St_RetrieveType(InSymbol,Ptr);\r
PushAddr(Ptr);\r
Loc(ESTTop,Addr);\r
ESTPop;\r
\r
(* High in Reg1 and low in reg *)\r
Addr.Displacement := Addr.Displacement + 2;\r
CodeAddrReg(iMOV,w,Addr,Reg);\r
Addr.Displacement := Addr.Displacement + 2;\r
CodeAddrReg(iMOV,w,Addr,Reg1);\r
\r
(* find the size of an element of this type *)\r
CodeRegConst(iAND,b,Reg,$0F8);\r
CodeRegConst(iAND,b,Reg1,$0F8);\r
\r
CodeRegReg(iSUB,w,Reg1,Reg);\r
For i := 1 TO 3 DO CodeReg(iSHR,w,Reg1);\r
\r
Addr.Displacement := Addr.Displacement - 4;\r
CodeAddrReg(iMOV,w,Addr,Reg1);\r
\r
ReleaseRegister(Reg1);\r
ReleaseRegister(Reg);\r
ReleaseAddr(Addr);\r
{$ENDIF}\r
END;\r
\r
\r
cSkipParam :\r
BEGIN\r
{$IFDEF PI3}\r
\r
CodeRegReg(iXOR,w,AX,AX);\r
CodeReg(iPUSH,w,AX);\r
CodeReg(iPUSH,w,AX);\r
{$ENDIF}\r
ReadCode; (* Skip varparam or inspectparam *)\r
\r
{$IFDEF RC3502}\r
CodeConst(rRECHW,1,AnonymousSpix);\r
CodeConst(rRECHW,0,AnonymousSpix);\r
ReadCode;\r
If Incode = cFamilyType THEN\r
BEGIN\r
ReadSymbol;\r
CodeConst(rRECHW,1,AnonymousSpix);\r
CodeConst(rRECHW,0,AnonymousSpix);\r
END ELSE Lookahead := True;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTPushConst(IntegerType, 0);\r
PushParam(cValueParam);\r
ReadCode;\r
If Incode = cFamilyType THEN\r
BEGIN\r
ReadSymbol;\r
ESTPushConst(IntegerType, 0);\r
PushParam(cValueParam);\r
END ELSE Lookahead := True;\r
{$ENDIF}\r
END;\r
\r
\r
cStrucConst : (* Symbol *) do_cStrucConst;\r
\r
\r
cStrucElem : (* Symbol *) do_cstrucelem;\r
\r
cSaveRep : (* Offset *) do_cSaveRep;\r
\r
\r
cSUB:\r
BEGIN\r
{$IFDEF RC35_50}\r
MegaOperationOnStack(iSUB,false);\r
{$ENDIF}\r
{$IFDEF PI3}\r
\r
MakeOperationReady(InstType,IntegerOpr);\r
\r (* If secend operand is const and 1 code DEC is made *)\r
IF ESTSort(ESTTop) = S_Const THEN\r
BEGIN\r
Value := ESTTop^.Value;\r
ESTPop;\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
Reg := ESTTop^.R;\r
IF Value = 1 THEN CodeReg(iDEC,InstType,Reg)\r
ELSE CodeRegConst(iSUB,InstType,Reg,Value);\r
END\r
ELSE\r
BEGIN\r
LoadRegister(ESTTop^.BackWard,AllRegister,Rnil,InstType);\r
OperationWithReg(iSUB,InstType);\r
END;\r
{$ENDIF}\r
\r
END;\r
\r
cThunkDecl : do_cThunkDecl; (* Symbol *)\r
\r
cTypeselect : (* Symbol *)\r
BEGIN\r
(* drop the address on top of EST and push the address of the\r
type *)\r
{$IFDEF PI3}\r
IF ESTTop^.Kind = o_AbsAddr THEN\r
BEGIN\r
ReleaseRegister(ESTTop^.A_Seg);\r
ReleaseRegister(ESTTop^.A_Index);\r
END;\r
{$ENDIF}\r
\r
TypeAddr := ESTTop^.OprType;\r
{$IFDEF RC5000}\r
IF (ESTTop^.Kind = O_StackOrTemp) OR (ESTTop^.Kind = O_Temp) THEN\r
BEGIN\r
TempOffset := TempOffset + 1;\r
END;\r
IF ESTSort(ESTTop) = S_Stack THEN MakeFreeReg(2);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF ESTTop^.Kind = O_Stack THEN codeconst(rSTNHB,4,Anonymousspix);\r
{$ENDIF}\r
ESTPop;\r
St_Retrieve(TypeAddr,Ptr);\r
PushAddr(Ptr);\r
\r
(* Find The parameters offset in the dopevector *)\r
While Ptr^.St_Node_Copy DO\r
St_Retrieve(Ptr^.St_Family_Ref,Ptr);\r
Value := Ptr^.Type_ParamSize;\r
{$IFDEF PI3}\r
\r
IF Ptr^.St_t_Local_Near THEN\r
Value := Value + 6\r
ELSE\r
Value := Value + 8 ;\r
{$ENDIF}\r
(* Value gives the offset for the first parameter *)\r
\r
\r
ReadSymbol;\r
St_Retrieve(InSymbol,Ptr);\r
{$IFDEF PI3}\r
Value := Value - Ptr^.Var_Offset;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
Value := Ptr^.Var_Offset - 8;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
value := value + 4 + Ptr^.Var_Offset;\r
{$ENDIF}\r
(* Value gives the parameters offset in the dopevector *)\r
\r
ESTTop^.OprType := Ptr^.TypeRef;\r
\r
IF ESTTop^.Kind = O_Addr THEN\r
ESTTop^.A_Offset := ESTTop^.A_Offset + Value\r
ELSE\r
IF ESTTop^.Kind = O_IndAddr THEN\r
ESTTop^.I_ObjectOffset := ESTTop^.I_ObjectOffset + Value\r
ELSE\r
(* ESTTop^.Kind = O_CAddr *)\r
ESTTop^.c_ObjectOffset := ESTTop^.C_ObjectOffset + Value;\r
\r
ESTTop^.IndVar := true;\r
\r
END;\r
\r
cUntil : GenerateLabel(SSTTop^.ContLabel);\r
\r
cuparrow :\r
BEGIN\r
{$IFDEF PI3}\r
\r
IF FunctionResultPointer = false\r
THEN LoadIndAddrUse(EStTop,RNil);\r
\r
(* Make sure the pointer is not nil *)\r
(* Pointer in ES : ESTTop^.A_Index *)\r
St_Declaration(clabel,AnonymousName,Lab,Ptr);\r
Reg := FreeRegister(AllRegister);\r
CodeRegReg(iMOV,w,Reg,ES);\r
CodeRegConst(iCMP,w,Reg,0);\r
CodeJump(iJNE,Lab);\r
CodeFault(PointerNilInt,PointerNilExc);\r
GenerateLabel(Lab);\r
\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF FunctionResultPointer = false\r
THEN\r
BEGIN\r
MegaTestLoad(True);\r
MegaPointer;\r
END;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF FunctionResultPointer = false THEN\r
MegaPointer;\r
{$ENDIF}\r
\r
St_GetBaseType(ESTTop^.OprType,PtrSt);\r
\r
ESTTop^.OprType := PtrSt^.TypeRef;\r
ESTTop^.IndVar := false;\r
FunctionResultPointer := false;\r
END;\r
\r
cUSub : (* the operand is of type integer,word or byte *)\r
BEGIN\r
\r
{$IFDEF RC5000}\r
MegaLoad(ESTTop);\r
GenCode(mNOT);\r
CodeConst(mADC,1,AnonymousSpix);\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
MegaLoad(ESTTop);\r
GenCode(rNEG);\r
{$ENDIF}\r
{$IFDEF PI3}\r
St_GetBaseType(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Size = 1 THEN InstType := b\r
ELSE InstType := w;\r
St_RetrieveType(ESTTop^.OprType,PtrSt);\r
\r
\r
IF (InstType = w) AND (PtrSt^.St_Size = 1) THEN\r
BEGIN\r
SetHighByteTo0(ESTTop);\r
ESTTop^.OprType := IntegerType;\r
END;\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
\r
CodeReg(iNEG,InstType,ESTTop^.R);\r
{$ENDIF}\r
END;\r
\r
cUp : do_cUp;\r
\r
cValueParam :\r
BEGIN\r
{$IFDEF RC35_50}\r
PushParam(cValueParam);\r
{$ENDIF}\r
{$IFDEF PI3}\r
PushOperand;\r
ESTPop;\r
{$ENDIF}\r
END;\r
\r
cVarParam:\r
BEGIN\r
ESTTop^.IndVar := false;\r
{$IFDEF RC35_50}\r
Pushparam(InCode);\r
{$ENDIF}\r
{$IFDEF PI3}\r
PushOperand;\r
ESTPop;\r
{$ENDIF}\r
END;\r
\r
\r
cWhileExpr :\r
BEGIN\r
FallThruTrue;\r
SSTTop^.ExitLabel := ESTTop^.FalseLab;\r
ESTPop;\r
END;\r
\r
cWhileStat :\r
BEGIN\r
SSTPushLoop;\r
GenerateLabel(SSTTop^.ContLabel);\r
END;\r
\r
cWithStat :\r
BEGIN\r
{$IFDEF RC5000}\r
ReleaseStrucDyn;\r
{$ENDIF}\r
END;\r
\r
\r
cWithVar : (* Symbol *) do_cWithVar;\r
\r
\r
cXOR :\r
BEGIN\r
{$IFDEF RC35_50}\r
MegaOperationOnStack(iXOR,true);\r
{$ENDIF}\r
{$IFDEF PI3}\r
St_GetBaseType(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Kind <> cBoolean THEN\r
BEGIN\r
MakeOperationReady(InstType,IntegerOpr);\r
OperationWithReg(iXOR,InstType);\r
END\r
ELSE\r
BEGIN\r
IF NOT ResultMustBeEnCode\r
THEN (* In decode forme *)\r
BEGIN\r
CMPTopElements(neg);\r
IF neg\r
THEN ESTPushDecode(St_NillAddr,St_NillAddr,iJNE)\r
ELSE ESTPushDecode(St_NillAddr,St_NillAddr,iJE);\r
END\r
ELSE (* In EnCode forme *)\r
BEGIN\r
EnCode;\r
InstType := b;\r
OperationWithReg(iXOR,InstType);\r
END;\r
END;\r
{$ENDIF}\r
END;\r
\r
(*OTHERWISE*)ELSE\r
BEGIN\r
Fatal_Error(Pass4,3);\r
END;\r
\r
END; (* end case *)\r
\r
IF LookAhead THEN LookAHead := False\r
ELSE ReadCode;\r
\r
END;\r
END;\r
«eof»