|
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: 63370 (0xf78a)
Types: TextFile
Names: »RTP86P4C.PAS«
└─⟦037c0ce35⟧ Bits:30010524 DVBS1.SW2114.src.2.6-2 RTP compiler source SW2104+SW2114 Disk#2 30/1-92 HHA
└─⟦this⟧ »RTP\RTP86P4C.PAS«
└─⟦828f0d3dd⟧ Bits:30010527 DVBS1.SW2114.src.2.6-5 RTP Compiler Source SW2104+SW2114 Disk 2 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\RTP86P4C.PAS«
└─⟦891417be1⟧ Bits:30010519 DVBS1.SW2114.src.2-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\RTP86P4C.PAS«
└─⟦a2bcc95d7⟧ Bits:30010511 DVBS1.SW2114.src.2.14-2 SW2114 REAL #2/4 TIME PASCAL SOURCE REL 2.14 92.09.01
└─⟦this⟧ »RTP\RTP86P4C.PAS«
Procedure Do_cField;\r
BEGIN\r
ReadSymbol;\r
\r
IF InCode = CFieldInit THEN\r
BEGIN\r
{$IFDEF PI3}\r
LoadAddrUse(ESTTop,DI);\r
IF (ESTTop^.A_Seg = ES) AND InDeclPart THEN\r
BEGIN\r
ReleaseRegister(ESTTop^.A_Seg);\r
ESTTop^.A_Seg := SS;\r
END;\r
{$ENDIF}\r
ReadCode;\r
LookAHead := true;\r
St_RetrieveType(InSymbol,PtrSt);\r
{$IFDEF PI3}\r
DoNotPopTop := (InCode = cPointerType) AND\r
(PtrSt^.Field_Mode = Stat);\r
IF DoNotPopTop = false THEN\r
BEGIN\r
Reg := ESTTop^.A_Seg;\r
PushOperand;\r
GetReg(DI);\r
IF Reg = ES THEN GetReg(Reg);\r
ESTPushAbsAddr(AnonymousSpix,St_NillAddr,false,P_Normal,\r
Reg,false,0,DI);\r
END;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
ESTTop^.OprType := IntegerType;\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
MakeCopyOfTop;\r
{$ENDIF}\r
END;\r
\r
IF ESTTop^.Par = P_Share THEN\r
BEGIN\r
{$IFDEF PI3}\r
ESTTop^.par := P_Normal;\r
LoadIndAddrUse(ESTTop,RNil);\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
MegaMakeAddr(ESTTop);\r
{$ENDIF}\r
\r
END;\r
\r
St_Retrieve(InSymbol,PtrSt);\r
BitLength := PtrSt^.Bit_size;\r
BitOffset := PtrSt^.Bit_Offset;\r
\r
Packed1 := (PtrSt^.Bit_Size <> 0);\r
RC3502packed := (PtrSt^.St_PackedFiel = Packed3502);\r
TypeAddr := PtrSt^.TypeRef;\r
ESTTop^.OprType := TypeAddr;\r
\r
IF PtrSt^.Field_Mode = Stat THEN\r
BEGIN\r
\r
(* $NoCheck*)\r
CASE ESTTop^.Kind OF\r
O_Addr : ESTTop^.A_Offset := ESTTop^.A_Offset +\r
PtrSt^.Field_Offset;\r
O_IndAddr : ESTTop^.I_ObjectOffset :=\r
ESTTop^.I_ObjectOffset + PtrSt^.Field_Offset;\r
O_AbsAddr : ESTTop^.A_Displacement := ESTTop^.A_Displacement +\r
PtrSt^.Field_Offset;\r
\r
\r
O_CAddr : ESTTop^.C_ObjectOffset :=\r
ESTTop^.C_ObjectOffset + PtrSt^.Field_Offset;\r
{$IFDEF RC35_50}\r
O_Stack,\r
O_StackORTemp,\r
O_Temp : ESTTop^.T_ObjectOffset :=\r
ESTTop^.T_ObjectOffset + PtrSt^.Field_Offset;\r
{$ENDIF}\r
END;\r
(* $Check*)\r
\r
END\r
ELSE\r
BEGIN (* Dynamic field *)\r
PushAddr(PtrSt);\r
{$IFDEF PI3}\r
Loc(ESTTop,Addr);\r
ESTPop;\r
SetSourceAddr(Addr);\r
\r
Reg := GetRegister(AddrRegister,RNil);\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
ReleaseAddr(Addr);\r
\r
AddRegToTopAddr(Reg);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MegaMakeAddr(ESTTop^.Backward);\r
MegaLoad(ESTTop);\r
ESTPop;\r
GenCode(mADD);\r
ESTTop^.T_Allign := false;\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
MegaLoad(ESTTop);\r
ESTPop;\r
GenCode(rUADD);\r
{$ENDIF}\r
END;\r
IF Packed1 THEN\r
BEGIN\r
(* a packed field *)\r
ReadCode;\r
{$IFDEF RC5000}\r
IF InCode = CIndVar THEN\r
BEGIN\r
if ((Bitoffset + bitlength) <= 8) OR\r
((Bitlength = 16) AND RC3502Packed) THEN\r
ESTTop^.OprType := BooleanType\r
ELSE ESTTop^.OprType := IntegerType;\r
MegaTestLoad(False);\r
END ELSE LookAhead := True;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
MegaLoad(ESTTop);\r
LoadAbsAddr(ESTTop);\r
{$ELSE}\r
IF Rc3502Packed THEN\r
BitOffset := 8 - (BitOffset + BitLength);\r
{$ENDIF}\r
\r
\r
ESTPushConst(IntegerType,BitOffset);\r
ESTTop^.BitLength := BitLength;\r
IF Rc3502Packed THEN ESTTop^.Set_Temp := true;\r
{$IFDEF RC3502}\r
LoadPacked(ESTTop);\r
{$ENDIF}\r
\r
IF InCode = CIndVar THEN\r
BEGIN\r
{$IFDEF RC35_50}\r
GetPackedElement(Esttop,TypeAddr);\r
{$ENDIF}\r
\r
{$IFDEF PI3}\r
GetPackedElement(ESTTop,Reg);\r
{$ENDIF}\r
St_RetrieveType(TypeAddr,Ptr);\r
IF Ptr^.St_Kind = cSubRange THEN\r
TypeAddr := Ptr^.TypeRef;\r
PopPackedElement;\r
{$IFDEF PI3}\r
ESTPushReg(TypeAddr,Reg);\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
ESTPushStack(TypeAddr,false);\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTTop^.Indvar := true;\r
{$ENDIF}\r
\r
END\r
ELSE\r
LookAHead := True;\r
END;\r
\r
\r
END;\r
PROCEDURE do_cWithVar;\r
var pointersize : integer;\r
BEGIN\r
pointersize := 4;\r
ReadSymbol;\r
\r
St_Retrieve(InSymbol,PtrSt);\r
\r
TypeAddr := PtrSt^.TypeRef;\r
{$IFDEF PI3}\r
MakeAddr(CurrentNiv,PtrSt^.Var_Offset,Addr,false);\r
\r
\r
LoadAddrUse(ESTTop,RNil);\r
Reg := ESTTop^.A_Index;\r
\r
CodeAddrReg(iMOV,w,Addr,Reg);\r
ReleaseRegister(Reg);\r
\r
Addr.Spix := Anonymousspix;\r
(* $Nocheck*)\r
Addr.Displacement := Addr.Displacement + 2;\r
(* $check*)\r
CodeAddrReg(iMOV,w,Addr,ESTTop^.A_Seg);\r
ReleaseRegister(ESTTop^.A_Seg);\r
\r
ReleaseAddr(Addr);\r
ESTPop;\r
{$ENDIF}\r
\r
{$IFDEF RC3502}\r
LoadAbsAddr(ESTTop);\r
pointersize := 3;\r
{$ENDIF}\r
\r
{$IFDEF RC35_50}\r
PtrSt^.Var_InDir := false;\r
PushAddr(PtrSt);\r
PtrSt^.Var_InDir := true;\r
\r
ExchangeTopElements;\r
PushOperand;\r
ESTTop^.T_Address := false;\r
{$IFDEF RC5000}\r
ESTTop^.OprType := IntegerType;\r
{$ENDIF}\r
MegaStore(pointersize);\r
{$ENDIF}\r
ReadCode;\r
IF InCode = cCheckSize THEN\r
BEGIN\r
ReadSymbol;\r
St_RetrieveType(TypeAddr,Ptr);\r
IF is_dynamic(Ptr, Ptr^.St_size) THEN\r
BEGIN\r
{$IFDEF PI3}\r
Reg := RNil;\r
ReturnLengthIn(Reg,Ptr);\r
ESTPushReg(WordType,Reg);\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
PushAddr(Ptr);\r
{$ENDIF}\r
END\r
ELSE\r
ESTPushConst(WordType,Ptr^.St_Size);\r
\r
St_RetrieveType(InSymbol,Ptr);\r
IF is_dynamic(Ptr,Ptr^.St_size) THEN\r
(* IF (dynamictype in Ptr^.Spec_Struct) OR\r
(Ptr^.St_size = 0) THEN *)\r
BEGIN\r
{$IFDEF PI3}\r
Reg := RNil;\r
ReturnLengthIn(Reg,Ptr);\r
ESTPushReg(WordType,Reg);\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
PushAddr(Ptr);\r
{$ENDIF}\r
END\r
ELSE\r
ESTPushConst(WordType,Ptr^.St_Size);\r
\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
{$IFDEF PI3}\r
CMPTopElements(Neg);\r
IF neg THEN CodeJump(iJAE,Lab)\r
ELSE CodeJump(iJBE,Lab);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
Inst := mGT;\r
CMPTopElements(Inst,false);\r
CodeJump(mCJ,Lab);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
ExchangeTopElements;\r
MegaLoad(ESTTop);\r
ESTPop;\r
ESTPop;\r
GenCode(rULT);\r
CodeJump(rJMZEQ,Lab);\r
St_RetrieveType(InSymbol,Ptr);\r
IF is_dynamic(Ptr, Ptr^.St_size) THEN\r
BEGIN\r
PushAddr(Ptr);\r
END\r
ELSE\r
ESTPushConst(WordType,Ptr^.St_Size);\r
\r
St_RetrieveType(TypeAddr,Ptr);\r
IF is_dynamic(Ptr,Ptr^.St_size) THEN\r
BEGIN\r
PushAddr(Ptr);\r
END\r
ELSE\r
ESTPushConst(WordType,Ptr^.St_Size);\r
MegaLoad(ESTTop);\r
ESTPop;\r
ESTPop;\r
{$ENDIF}\r
CodeFault(WithInt,WithExc);\r
GenerateLabel(Lab);\r
END\r
ELSE\r
LookAHead := true;\r
END;\r
\r
PROCEDURE Do_cUp;\r
BEGIN\r
(* The step variabels address is on the stack *)\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
\r
\r
SSTPushLoop;\r
eLab := SSTTop^.ExitLabel;\r
SSTTop^.RepeatLabel := Lab;\r
SSTTop^.Up := (Incode = cUp);\r
St_RetrieveType(ESTTop^.OprType,PtrST);\r
\r
IF PtrSt^.Subr_Mode = stat THEN\r
BEGIN (* Static subrange *)\r
(* $nocheck*)\r
Low := PtrSt^.Subr_Low;\r
LowInt := Low;\r
High := PtrSt^.Subr_High;\r
HighInt := High;\r
(* $check*)\r
IF ( ((InCode = cUp) AND (LowInt > HighInt)) OR\r
((InCode = cDown) AND (LowInt < HighInt)) ) THEN\r
BEGIN\r
(* Jump to the end of the for loop *)\r
CodeJump(iJMP,ELab);\r
ESTPop;\r
END\r
ELSE\r
BEGIN\r
{$IFDEF PI3}\r
IF PtrSt^.St_Size = 1 THEN InstType := b\r
ELSE InstType := w;\r
Loc(ESTTop,Addr);\r
CodeAddrConst(iMOV,InstType,Addr,Low);\r
ESTPop;\r
ReleaseAddr(Addr);\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
ESTPushConst(IntegerType,Low);\r
MegaStore(wordsize);\r
{$ENDIF}\r
END;\r
END\r
ELSE\r
BEGIN (* Dynamic Subrange *)\r
{$IFDEF PI3}\r
PushAddr(PtrST);\r
Loc(ESTTop,Addr1);\r
ESTPop;\r
Reg := GetRegister(AllRegister,RNil);\r
\r
(* $Nocheck*)\r
Addr1.Displacement := Addr1.Displacement;\r
(* Addr1 gives the address of lower bound *)\r
\r
CodeRegAddr(iMOV,w,Reg,Addr1);\r
Loc(ESTTop,Addr);\r
CodeAddrReg(iMOV,w,Addr,Reg);\r
ESTPop;\r
ReleaseAddr(Addr);\r
\r
Addr1.Displacement := Addr1.Displacement + 2;\r
(* Addr1 gives the address of high bound *)\r
\r
(* $check *)\r
(* Make the check *)\r
CodeRegAddr(iCMP,w,Reg,Addr1);\r
\r
IF InCode = cUP THEN CodeJump(iJG,ELab)\r
ELSE CodeJump(iJL,ELab);\r
\r
ReleaseRegister(Reg);\r
ReleaseAddr(Addr1);\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
\r
PushAddr(PtrSt);\r
PushAddr(PtrSt);\r
ESTTop^.A_Offset := ESTTop^.A_Offset + wordsize;\r
{$IFDEF RC5000}\r
Inst := mGT;\r
CMPTopElements(Inst,incode=cDown);\r
ESTPushDecode(St_NillAddr,St_NillAddr,mEQC);\r
{$ELSE}\r
if incode = cDown THEN Inst := rGE ELSE Inst := rLE;\r
CMPTopElements(Inst,false);\r
{$ENDIF}\r
FallThruTrue;\r
SSTTop^.ExitLabel := ESTTop^.FalseLab;\r
ESTPop;\r
\r
PushAddr(PtrST);\r
MegaStore(wordsize);\r
\r
{$ENDIF}\r
END;\r
\r
GenerateLabel(Lab);\r
\r
END;\r
PROCEDURE Do_cShift;\r
var i : integer;\r
BEGIN\r
{$IFDEF RC5000}\r
\r
IF ESTTop^.Kind = O_Const THEN\r
BEGIN\r
i := ESTTop^.Value;\r
IF i < 0 THEN\r
BEGIN\r
ESTTop^.Value := -i;\r
inst := mSHR;\r
END\r
ELSE inst := mSHL;\r
MegaOperationOnStack(Inst,false);\r
END\r
ELSE\r
BEGIN\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
St_Declaration(CLabel,AnonymousName,SLab,Ptr);\r
MegaLoad(ESTTop);\r
CodeConst(mSTL,ParamIndex,AnonymousSpix);\r
MegaLoad(ESTTop^.Backward);\r
CodeConst(mLDL,ParamIndex,AnonymousSpix);\r
MakeFreeReg(1);\r
CodeConst(mLDC,0,AnonymousSpix);\r
GenCode(mGT);\r
CodeJump(mCJ,Lab);\r
CodeConst(mLDL,ParamIndex,AnonymousSpix);\r
GenCode(mSHL);\r
CodeConst(mLDC,0,AnonymousSpix);\r
CodeJump(mCJ,SLab);\r
GenerateLabel(Lab);\r
CodeConst(mLDL,ParamIndex,AnonymousSpix);\r
gencode(mSUB);\r
GenCode(mSHR);\r
CodeConst(mLDC,0,AnonymousSpix);\r
GenerateLabel(SLab);\r
GenCode(mOR);\r
\r
ESTPop;\r
ESTTop^.oprType := IntegerType;\r
StoreStackToTemp(ESTTop);\r
END;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF ESTTop^.Kind = O_Const THEN\r
BEGIN\r
i := ESTTop^.Value;\r
IF i > 0 THEN\r
BEGIN\r
MegaLoad(ESTTop^.Backward);\r
CodeConst(rRECHW,(-1 SHR i) , anonymousspix);\r
GenCode(rAND);\r
END;\r
MegaOperationOnStack(rSHC,false);\r
IF i < 0 THEN\r
BEGIN\r
CodeConst(rRECHW,(-1) SHR -i , anonymousspix);\r
GenCode(rAND);\r
END;\r
END\r
ELSE\r
BEGIN\r
MegaLoad(ESTTop);\r
CallRoutine(Anonymousspix,shift,st_Extern);\r
ESTPop;\r
ESTTop^.oprType := IntegerType;\r
END;\r
{$ENDIF}\r
{$IFDEF PI3}\r
{$IFNDEF RTP86}\r
MakeOperationReady(InstType,IntegerOpr);\r
{$ELSE}\r
(*St_retrieveType(ESTTop^.BackWard^.Oprtype,PtrSt);*)\r
St_GetBaseType(ESTTop^.BackWard^.Oprtype,PtrSt);\r
IF PtrSt^.St_Kind = cByte\r
(*PtrSt^.St_Size = 1*) THEN InstType := b\r
ELSE InstType := w;\r
{$ENDIF}\r
IF ESTSort(ESTTop) = S_Const THEN\r
BEGIN\r
(* $nocheck*)\r
ValueInt := ESTTop^.Value;\r
ESTPop;\r
\r
IF ValueInt > 0 THEN Inst := iSHL\r
ELSE BEGIN\r
INST := iSHR;\r
ValueInt := -ValueInt;\r
END;\r
\r
IF ValueInt <= 3 THEN\r
BEGIN\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
FOR i := 1 TO ValueInt DO\r
CodeReg(Inst,InstType,ESTTop^.R);\r
END\r
\r
ELSE\r
IF (((ValueInt >= 8 ) AND ( InstType = b)) OR\r
((ValueInt >= 16) AND ( InstType = w))) THEN\r
BEGIN (* Result is 0 *)\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
CodeRegReg(iXOR,InstType,ESTTop^.R,ESTTop^.R);\r
END\r
\r
ELSE\r
BEGIN\r
GetReg(CX);\r
CodeRegConst(iMOV,w,CX,ValueInt);\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
\r
IF InstType = w THEN InstType := vw\r
ELSE InstType := vb;\r
\r
CodeReg(Inst,InstType,ESTTop^.R);\r
ReleaseRegister(CX);\r
END;\r
END\r
\r
(* $Check*)\r
ELSE\r
BEGIN\r
HelpInst := InstType;\r
IF InstType = w THEN\r
BEGIN\r
Value := 16;\r
ShiftInstType := vw;\r
END\r
ELSE\r
BEGIN\r
Value := 8;\r
ShiftInstType := vb;\r
END;\r
St_RetrieveType(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Size = 1 THEN InstType := b\r
ELSE InstType := w;\r
LoadRegister(ESTTop,SpecificReg,CX,InstType);\r
ESTPop;\r
LoadRegister(ESTTop,AllRegister,RNil,HelpInst);\r
Reg := ESTTop^.R;\r
\r
\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
St_Declaration(CLabel,AnonymousName,SLab,Ptr);\r
St_Declaration(CLabel,AnonymousName,ELab,Ptr);\r
\r
(* Code for shift *)\r
CodeRegReg(iOR,InstType,CX,CX);\r
CodeJump(iJLE,SLab);\r
CodeRegConst(iCMP,InstType,CX,Value);\r
CodeJump(iJGE,Lab);\r
CodeReg(iSHL,ShiftInstType,Reg);\r
CodeJump(iJMP,ELab);\r
GenerateLabel(Lab);\r
CodeRegReg(iXOR,HelpInst,Reg,Reg);\r
CodeJump(iJMP,ELab);\r
GenerateLabel(SLab);\r
CodeReg(iNEG,InstType,CX);\r
CodeRegConst(iCMP,InstType,CX,Value);\r
CodeJump(iJGE,Lab);\r
CodeReg(iSHR,ShiftInstType,Reg);\r
GenerateLabel(ELab);\r
\r
ReleaseRegister(CX);\r
END;\r
{$ENDIF}\r
END;\r
\r
\r
\r
PROCEDURE Do_cProgramCall; (* Symbol *)\r
VAR help : integer;\r
BEGIN\r
ReadSymbol;\r
\r
\r
St_Get(InSymbol,Ptr);\r
{$IFDEF PI3}\r
\r
PushAddr(Ptr);\r
{$ENDIF}\r
if Ptr^.st_kind<>cprogram then\r
st_retrievetype(Ptr^.TypeRef, Ptr);\r
{$IFDEF PI3}\r
while Ptr^.st_kind=cpointertype do\r
begin\r
if not functionresultpointer then loadindaddruse(esttop,rnil);\r
st_retrievetype(Ptr^.typeref,Ptr);\r
esttop^.indvar:= false;\r
functionresultpointer:= false;\r
end;\r
Loc(ESTTop,Addr);\r
ReleaseAddr(Addr);\r
ESTPop;\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement + NoParamOffset;\r
(* $check*)\r
Addr.Spix := AnonymousSpix;\r
CodeAddrConst(iMOV,b,Addr,Ptr^.St_ParamSize);\r
\r
IF Ptr^.St_ParamSize <> 0 THEN\r
BEGIN\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement - 4;\r
CodeAddrReg(iMOV,w,Addr,SP);\r
CodeAddrConst(iADD,w,Addr,ParamSizeForCreate);\r
Addr.Displacement := Addr.Displacement + 2;\r
CodeAddrReg(iMOV,w,Addr,SS);\r
(* $check*)\r
END;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTPushAddr(Anonymousspix,Integertype,false,P_Normal,Currentniv,\r
(Paramindex + 2) * 4);\r
PushParam(cVarParam);\r
ESTPushConst(IntegerType,(Ptr^.St_ParamSize + 3) div 4 );\r
PushParam(cValueParam);\r
\r
{$ENDIF}\r
{$IFDEF RC3502}\r
if Ptr^.st_kind<>cprogram then\r
st_retrievetype(Ptr^.TypeRef, Ptr);\r
\r
ParSize := Ptr^.St_ParamSize;\r
MegaLoad(ESTTop);\r
\r
St_Retrieve(InSymbol,Ptr);\r
help := MegaOffset(CurrentNiv,Ptr^.Var_Offset);\r
CodeConst(rSTVLA,Help,Anonymousspix);\r
GenCode(rREAXD);\r
CodeConst(rREASD,-(ParSize + 9),Anonymousspix);\r
CodeConst(rSTVLA,Help + 3,Anonymousspix);\r
CodeConst(rRECHW,ParSize,Anonymousspix);\r
CodeConst(rSTVLW,Help + 6,Anonymousspix);\r
CodeConst(rREALD,Help,Anonymousspix);\r
RC3502programoffset := help;\r
{$ENDIF}\r
END;\r
\r
\r
\r
PROCEDURE do_cendexchange;\r
VAR\r
BitLength,Sign : integer;\r
Routineno : integer;\r
\r
BEGIN\r
\r
IF ESTTop^.BitLength <> 0 THEN\r
BEGIN\r
(* The top element is packed *)\r
{$IFDEF RC3502}\r
SecendOpr := ESTTop^.BackWard;\r
{$ELSE}\r
SecendOpr := ESTTop^.BackWard^.BackWard;\r
{$ENDIF}\r
Packed1 := True;\r
END\r
ELSE\r
BEGIN\r
Packed1 := False;\r
SecendOpr := ESTTop^.BackWard;\r
END;\r
\r
Packed2 := SecendOpr^.BitLength <> 0;\r
{$IFDEF PI3}\r
IF Packed1 OR Packed2 THEN\r
BEGIN\r
(* Packed Exchange *)\r
(* Get The Type *)\r
IF Packed1 THEN TypeAddr := ESTTop^.BackWard^.OprType\r
ELSE TypeAddr := ESTTop^.OprType;\r
St_Retrieve(TypeAddr,Ptr);\r
IF Ptr^.St_Size = 1 THEN InstType := b\r
ELSE InstType := w;\r
\r
\r
\r
MinFreeReg := 0;\r
IF Packed2 THEN GetPackedElement(Secendopr,Reg)\r
ELSE\r
BEGIN\r
Reg := GetRegister(ABCDRegister,RNil);\r
Loc(SecendOpr,Addr);\r
CodeRegAddr(iMOV,InstType,Reg,Addr);\r
END;\r
\r
ESTPushReg(IntegerType,Reg);\r
\r
MinFreeReg := NormalMinFreeReg;\r
WHILE NoOfFreeReg <= NormalMinFreeReg DO\r
Push1Operand;\r
\r
\r
MinFreeReg := 0;\r
IF Packed1 THEN GetPackedElement(ESTTop^.BackWard,Reg)\r
ELSE\r
BEGIN\r
Reg := GetRegister(ABCDRegister,RNil);\r
Loc(ESTTop^.BackWard,Addr);\r
CodeRegAddr(iMOV,InstType,Reg,Addr);\r
END;\r
\r
Reg1 := ESTTop^.R;\r
ESTPop;\r
ESTPushReg(IntegerType,Reg);\r
\r
MinFreeReg := NormalMinFreeReg;\r
WHILE NoOfFreeReg < NormalMinFreeReg DO\r
Push1Operand;\r
\r
\r
\r
MinFreeReg := 0;\r
IF Packed1 THEN PutPackedElement(ESTTop^.BackWard,Reg1)\r
ELSE\r
BEGIN\r
Loc(ESTTop^.BackWard,Addr);\r
CodeAddrReg(iMOV,InstType,Addr,Reg1);\r
ReleaseRegister(Reg1);\r
END;\r
\r
Reg := ESTTop^.R;\r
ESTpop;\r
\r
IF Packed1 THEN PopPackedElement\r
ELSE\r
BEGIN\r
ESTpop;\r
ReleaseAddr(Addr);\r
END;\r
\r
IF Packed2 THEN PutPackedElement(ESTTop,Reg)\r
ELSE\r
BEGIN\r
Loc(ESTTop,Addr);\r
CodeAddrReg(iMOV,InstType,Addr,Reg);\r
ReleaseRegister(Reg);\r
END;\r
\r
\r
IF Packed2 THEN PopPackedElement\r
ELSE\r
BEGIN\r
ESTpop;\r
ReleaseAddr(Addr);\r
END;\r
\r
MinFreeReg := NormalMinFreeReg;\r
END\r
ELSE\r
\r
\r
BEGIN\r
(* not packed exchange *)\r
St_Retrieve(ESTTop^.OprType,PtrSt);\r
Size := PtrSt^.St_Size;\r
\r
MinFreeReg := 0;\r
\r
IF (Size = 0) and not (dynamictype in PtrSt^.spec_struct) then\r
begin\r
estpop; estpop;\r
end else\r
IF (Size = 2) or (Size = 1) THEN\r
BEGIN\r
(* Simpel type *)\r
Loc(ESTTop^.BackWard,Addr);\r
Reg := GetRegister(ABCDRegister,RNil);\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
\r
IF Size = 1 THEN InstType := b\r
ELSE InstType := w;\r
\r
Loc(ESTTop,Addr);\r
CodeRegAddr(iXCHG,InstType,Reg,Addr);\r
\r
TypeAddr := ESTTop^.OprType;\r
ESTPop;\r
ReleaseAddr(Addr);\r
\r
\r
\r
Loc(ESTTop,Addr);\r
CodeAddrReg(iMOV,InstType,Addr,Reg);\r
ESTPop;\r
ReleaseAddr(Addr);\r
\r
ReleaseRegister(Reg);\r
\r
END\r
ELSE\r
(* a struc exchange . Length > 2 or dynamic length *)\r
BEGIN\r
IF (Size = 4) or (Size = 3) THEN\r
BEGIN\r
(* The exchange is made by two xchg *)\r
Loc(ESTTop,Addr);\r
Reg1 := GetRegister(ABCDRegister,RNil);\r
Reg := GetRegister(AllRegister,RNil);\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
\r
IF Size = 3 THEN InstType := b\r
ELSE InstType := w;\r
Addr.Spix := AnonymousSpix;\r
(* $NoCheck*)\r
Addr.Displacement := Addr.Displacement + 2;\r
(* $Check*)\r
CodeRegAddr(iMOV,InstType,Reg1,Addr);\r
\r
Loc(ESTTop^.BackWard,Addr1);\r
\r
\r
CodeRegAddr(iXCHG,w,Reg,Addr1);\r
Addr1.Spix := AnonymousSpix;\r
(* $NoCheck*)\r
Addr1.Displacement := Addr1.Displacement + 2;\r
(* $Check*)\r
\r
CodeRegAddr(iXCHG,InstType,Reg1,Addr1);\r
Loc(ESTTop,Addr);\r
CodeAddrReg(iMOV,w,Addr,Reg);\r
\r
Addr.Spix := AnonymousSpix;\r
(* $NoCheck*)\r
Addr.Displacement := Addr1.Displacement + 2;\r
(* $Check*)\r
\r
CodeAddrReg(iMOV,w,Addr,Reg1);\r
ReleaseAddr(Addr);\r
ReleaseAddr(Addr1);\r
ReleaseRegister(Reg);\r
ReleaseRegister(Reg1);\r
\r
\r
END\r
ELSE\r
BEGIN\r
(* Struc exchange is made by MOVS *)\r
Bool1 := ReferenceType IN PtrSt^.Spec_Struct;\r
Bool := Bool1 OR\r
(ProcessType IN PtrSt^.Spec_Struct)\r
OR (ProgramType IN PtrST^.spec_Struct);\r
if bool and (size>4) then size:=size-4;\r
IF is_dynamic(PtrSt, Size) THEN\r
(* IF Size = 0 THEN *)\r
BEGIN\r
(*if (dynamictype in PtrSt^.Spec_Struct) then*)\r
begin\r
Reg := CX;\r
St_RetrieveType(ESTTop^.OprType,PtrSt);\r
ReturnLengthIn(Reg,PtrSt);\r
Inst := iMOVSB;\r
InstType := b;\r
end;\r
END\r
ELSE\r
BEGIN\r
GetReg(CX);\r
IF ODD(Size) THEN\r
BEGIN\r
CodeRegConst(iMOV,w,CX,Size);\r
Inst := iMOVSB;\r
InstType := b;\r
END\r
ELSE\r
BEGIN\r
CodeRegConst(iMOV,w,CX,Size DIV 2);\r
Inst := iMOVSW;\r
InstType := w;\r
END;\r
END;\r
\r
\r
\r
\r
LoadAddrOfTopElems;\r
\r
(* Release all register *)\r
ReleaseRegister(CX);\r
ReleaseRegister(DI);\r
ReleaseRegister(SI);\r
ReleaseRegister(ESTTop^.A_Seg);\r
ReleaseRegister(ESTTop^.BackWard^.A_Seg);\r
\r
\r
Addr.spix := Anonymousspix;\r
Addr.Seg := DS;\r
Addr.Base := RNil;\r
Addr.Index := SI;\r
\r
Addr1.Spix := ESTTop^.BackWard^.Spix;\r
Addr1.Seg := ES;\r
Addr1.Base := RNil;\r
Addr1.Index := DI;\r
\r
\r
GenCode(iCLD);\r
\r
IF Bool THEN\r
BEGIN\r
GenCode(iCLI);\r
IF Bool1 THEN\r
BEGIN\r
Addr.Displacement := lockedoffset;\r
Addr1.Displacement := lockedoffset;\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
St_Declaration(CLabel,AnonymousName,ELab,Ptr);\r
CodeAddrConst(iCMP,w,Addr,0);\r
CodeJump(iJLE,Lab);\r
GenerateLabel(ELab);\r
CodeFaultAX(IntOnFault,reflockexc);\r
GenerateLabel(Lab);\r
CodeAddrConst(iCMP,w,Addr1,0);\r
CodeJump(iJG,ELab);\r
END;\r
END;\r
\r
IF InstType = b THEN\r
(* $Nocheck*)\r
Addr.Displacement := $FFFF (*-1*)\r
ELSE\r
Addr.Displacement := $FFFE (* -2 *);\r
\r
(* $check*)\r
Addr1.Displacement := 0;\r
\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
\r
GenerateLabel(Lab);\r
\r
\r
CodeRegAddr(iMOV,InstType,AX,Addr1);\r
GenCode(Inst);\r
\r
CodeAddrReg(iMOV,InstType,Addr,AX);\r
CodeJump(iLOOP,Lab);\r
\r
IF Bool THEN GenCode(iSTI);\r
\r
UpDateDSAndSp;\r
\r
\r
END;\r
\r
\r
ESTPop;\r
ESTPop;\r
\r
\r
END;\r
MinFreeReg := NormalMinFreeReg;\r
\r
\r
\r
END;\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
St_Retrieve(ESTTop^.OprType,PtrSt);\r
Size := PtrSt^.St_Size;\r
\r
IF Packed1 OR Packed2 THEN\r
BEGIN\r
{$IFDEF RC5000}\r
sign := ord((PtrSt^.St_Kind = csubrange) and\r
(PtrSt^.subr_Low >= $8000 ));\r
\r
IF Packed1 THEN\r
BEGIN\r
MegaLoad(ESTTop);\r
BitLength := ESTTop^.BitLength;\r
CodeConst(mSTL,1,Anonymousspix);\r
ESTPop;\r
MegaMakeAddr(ESTTop);\r
IF ESTTop^.T_ObjectOffset <> 0 THEN\r
CodeConst(mADC,ESTTop^.T_ObjectOffset,Anonymousspix);\r
ESTpop;\r
CodeConst(mSTL,0,Anonymousspix);\r
CodeConst(mLDC,BitLength,Anonymousspix);\r
CodeConst(mSTL,2,Anonymousspix);\r
END\r
ELSE\r
BEGIN\r
MegaMakeAddr(ESTTop);\r
IF ESTTop^.T_ObjectOffset <> 0 THEN\r
CodeConst(mADC,ESTTop^.T_ObjectOffset,Anonymousspix);\r
ESTpop;\r
CodeConst(mSTL,0,Anonymousspix);\r
CodeConst(mLDC,0,Anonymousspix);\r
CodeConst(mSTL,1,Anonymousspix);\r
CodeConst(mLDC,Size * 8,Anonymousspix);\r
CodeConst(mSTL,2,Anonymousspix);\r
END;\r
IF Packed2 THEN\r
BEGIN\r
IF (ESTSort(ESTTop) = S_Stack) AND\r
(ESTSort(ESTTop^.Backward) = S_Stack)\r
THEN GenCode(mREV);\r
\r
MegaMakeAddr(ESTTop^.Backward);\r
IF ESTTop^.Backward^.T_ObjectOffset <> 0 THEN\r
CodeConst(mADC,ESTTop^.Backward^.T_ObjectOffset,Anonymousspix);\r
\r
IF ESTSort(ESTTop) = S_Stack THEN GenCode(mREV);\r
MegaLoad(ESTTop);\r
BitLength := ESTTop^.BitLength;\r
ESTPop;\r
ESTPop;\r
CodeConst(mLDC,(BitLength SHL 1) + sign ,Anonymousspix);\r
END\r
ELSE\r
BEGIN\r
MegaMakeAddr(ESTTop);\r
IF ESTTop^.T_ObjectOffset <> 0 THEN\r
CodeConst(mADC,ESTTop^.T_ObjectOffset,Anonymousspix);\r
ESTpop;\r
CodeConst(mLDC,0,Anonymousspix);\r
CodeConst(mLDC,((Size * 8) SHL 1) + sign,Anonymousspix);\r
END;\r
CallRoutine(AnonymousSpix,ExcPack,St_Extern);\r
\r
{$ELSE}\r
RoutineNo := ExcPack;\r
IF Not Packed1 THEN\r
BEGIN\r
LoadAbsAddr(ESTTop);\r
RoutineNo := ExcPackRec;\r
END;\r
ESTPop;\r
IF Not Packed2 THEN\r
BEGIN\r
IF (ESTTop^.Kind <> O_Stack) THEN\r
BEGIN\r
LoadAbsAddr(ESTTop);\r
RoutineNo := ExcPackRec;\r
END\r
ELSE\r
RoutineNo := ExcRecPack\r
END;\r
ESTPop;\r
\r
\r
CallRoutine(AnonymousSpix,RoutineNo,St_Extern);\r
\r
{$ENDIF}\r
END\r
ELSE\r
BEGIN\r
(* not packed exchange *)\r
Bool1 := ReferenceType IN PtrSt^.Spec_Struct;\r
Bool := Bool1 OR\r
(ProcessType IN PtrSt^.Spec_Struct)\r
OR (ProgramType IN PtrST^.spec_Struct);\r
{$IFDEF RC5000}\r
if bool and (size>4) then size:=size-4;\r
{$ELSE}\r
if bool and (size>3) then size:=size-3;\r
Bool := bool1;\r
Bool1 := bool1 or (ProcessType IN PtrSt^.Spec_Struct);\r
{$ENDIF}\r
LoadAbsAddr(ESTTop);\r
ESTpop;\r
LoadAbsAddr(ESTTop);\r
St_RetrieveType(ESTTop^.OprType,PtrSt);\r
ESTpop;\r
IF Not Bool1 then\r
BEGIN\r
IF is_dynamic(PtrSt,size) then\r
BEGIN\r
PushAddr(PtrSt);\r
END\r
ELSE\r
ESTPushConst(IntegerType,size);\r
\r
MegaLoad(ESTTop);\r
ESTPop;\r
CallRoutine(AnonymousSpix,ExcRec,St_Extern);\r
END\r
ELSE\r
{$IFDEF RC3502}\r
IF Bool THEN GenCode(rCEXCH)\r
ELSE CallRoutine(AnonymousSpix,ExcProcess,St_Extern);\r
{$ELSE}\r
CallRoutine(AnonymousSpix,Exchange,St_Extern);\r
{$ENDIF}\r
END;\r
{$ENDIF}\r
END;\r
\r
PROCEDURE Do_cRecField;\r
VAR DoAllign : Boolean;\r
BEGIN\r
{$IFDEF PI3}\r
\r
IF NoOfDynFields = 0 THEN\r
BEGIN\r
Reg := GetRegister(AllRegister,RNil);\r
CodeRegConst(iMOV,w,Reg,ESTTop^.Value);\r
ESTPop;\r
END\r
ELSE\r
BEGIN\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(iJB,Lab);\r
\r
Loc(ESTTop,Addr);\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement + 2;\r
CodeAddrReg(iMOV,w,Addr,Reg);\r
ESTTop^.A_Displacement := ESTTop^.A_Displacement + 2;\r
(* $check*)\r
END;\r
NoOfDynFields := NoOfDynFields + 1;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
if incode = crecfield then readsymbol;\r
IF NoOfDynFields = 0 THEN\r
BEGIN\r
CodeConst(mLDC,ESTTop^.Value,AnonymousSpix);\r
allignsize := ((Esttop^.Value+3)DIV 4)*4 - ESTTop^.Value;\r
alligned := true;\r
ESTPop;\r
END\r
ELSE\r
BEGIN\r
if incode = cRecfield THEN\r
St_Retrieve(Insymbol,PtrSt)\r
else\r
St_Retrieve(ELab,PtrSt);\r
doallign := ((shieldType*PtrSt^.Spec_Struct) <> []);\r
\r
IF ESTTop^.Kind = O_Const THEN\r
BEGIN\r
allignsize :=(((Esttop^.Value+3)DIV 4)*4 - ESTTop^.Value +\r
allignsize) mod 4;\r
IF DoAllign THEN\r
IF Alligned THEN\r
BEGIN\r
ESTTop^.Value := ESTTop^.Value + AllignSize;\r
allignSize := 0;\r
doallign := false;\r
END\r
ELSE\r
BEGIN\r
ESTTop^.Value := ESTTop^.Value + 3;\r
END;\r
CodeConst(mADC,ESTTop^.Value,AnonymousSpix);\r
END\r
ELSE\r
BEGIN\r
alligned := false;\r
MegaLoad(ESTTop);\r
GenCode(mADD);\r
IF DoAllign THEN CodeConst(mADC,3,AnonymousSpix);\r
END;\r
IF DoAllign THEN\r
BEGIN\r
CodeConst(mLDC,3,Anonymousspix);\r
GenCode(mNOT);\r
GenCode(mAND);\r
alligned := true;\r
allignsize := 0;\r
END;\r
ESTPop;\r
\r
St_Retrievetype(ELAB,PtrSt);\r
PushAddr(PtrSt);\r
IF incode <> cEndRecord THEN\r
AddOffsetToAddr(ESTTop,NoOfDynFields * 4);\r
ESTPushStack(IntegerType,true);\r
MegaStore(4);\r
\r
IF incode <> cEndRecord THEN\r
BEGIN\r
St_Retrievetype(ELAB,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,NoOfDynFields * 4);\r
MegaLoad(ESTTop);\r
END;\r
ESTPop;\r
END;\r
NoOfDynFields := NoOfDynFields + 1;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
if incode = crecfield then readsymbol;\r
IF NoOfDynFields = 0 THEN\r
BEGIN\r
megaload(ESTTop);\r
Alligned := true;\r
ESTPop;\r
END\r
ELSE\r
BEGIN\r
if incode = cRecfield THEN\r
BEGIN\r
St_Retrieve(Insymbol,PtrSt);\r
doallign := ((shieldType35*PtrSt^.Spec_Struct) <> []);\r
END\r
else\r
doallign := false;\r
\r
IF ESTTop^.Kind = O_Const THEN\r
BEGIN\r
CodeConst(rUADHW,ESTTop^.Value,AnonymousSpix);\r
END\r
ELSE\r
BEGIN\r
MegaLoad(ESTTop);\r
GenCode(rUADD);\r
END;\r
ESTPop;\r
IF DoAllign THEN\r
BEGIN\r
GenCode(rREVPW);\r
CodeConst(rRECHW,1,Anonymousspix);\r
GenCode(rAND);\r
GenCode(rUADD);\r
END;\r
\r
IF incode <> cEndRecord THEN\r
BEGIN\r
St_Retrievetype(ELAB,PtrSt);\r
PushAddr(PtrSt);\r
ESTTop^.IndVar := false;\r
AddOffsetToAddr(ESTTop,NoOfDynFields * 2);\r
GenCode(rREVPW);\r
END;\r
ESTPushStack(IntegerType,false);\r
MegaStore(2);\r
\r
END;\r
NoOfDynFields := NoOfDynFields + 1;\r
{$ENDIF}\r
END;\r
PROCEDURE do_cThunkDecl;\r
var Offset,ParSize : integer;\r
ReadCont : boolean;\r
BEGIN\r
ReadSymbol;\r
St_Retrieve(Insymbol,PtrSt);\r
ReadCont := true;\r
\r
{$IFDEF RC5000}\r
ReadCont := PtrSt^.Fam_Used <> 0;\r
{$ELSE}\r
ReadCont := Odd(PtrSt^.Fam_Used DIV Comp_Unit_Bit);\r
{$ENDIF}\r
IF ReadCont THEN\r
BEGIN\r
\r
SetCodeModeToFalse;\r
\r
RoutineDecl(InSymbol,True);\r
\r
St_Retrieve(InSymbol,PtrSt);\r
{$IFDEF RC3502}\r
SSTPushRoutine(PtrSt^.Type_Label,PtrSt^.St_Size,\r
PtrSt^.St_Type_MaxOffset,false);\r
{$ELSE}\r
SSTPushRoutine(PtrSt^.Type_Label,0,\r
PtrSt^.St_Type_MaxOffset,false);\r
{$ENDIF}\r
IF InContext THEN CurrentNiv := Routine_Level\r
ELSE CurrentNiv := CurrentNiv + 1;\r
SetCodeModeToTrue;\r
(* move the parameter *)\r
{$IFDEF PI3}\r
\r
\r
Addr.Spix := AnonymousSpix;\r
Addr.Seg := ss;\r
Addr.Base := BP;\r
(* TOG *)\r
St_Retrieve(InSymbol,Ptr);\r
if ptr^.st_t_local_near then\r
Addr.Displacement := 4\r
else\r
addr.displacement := 6;\r
Addr.index := RNil;\r
\r
CodeRegAddr(iLES,w,BX,Addr);\r
\r
Addr1.Spix := AnonymousSpix;\r
Addr1.Seg := ES;\r
Addr1.Base := BX;\r
Addr1.Displacement := 0;\r
Addr1.Index := RNil;\r
\r
ListRef := Ptr^.ListRef;\r
WHILE Not Equal_Addr(ListRef,St_StopAddr) DO\r
BEGIN\r
St_Retrieve(ListRef,Ptr);\r
Addr.Displacement := Ptr^.Var_Offset;\r
ListRef := Ptr^.ListRef;\r
CodeRegAddr(iMOV,w,AX,Addr);\r
St_GetBaseType(Ptr^.TypeRef,Ptr);\r
IF Ptr^.St_Size = 1 THEN CodeRegReg(iXOR,b,AH,AH);\r
CodeAddrReg(iMOV,w,Addr1,AX);\r
Addr1.Displacement := Addr1.Displacement + 2;\r
END;\r
{$ENDIF}\r
\r
{$IFDEF RC5000}\r
St_Retrieve(InSymbol,Ptr);\r
parsize := Ptr^.Type_ParamSize div 4;\r
offset := 0;\r
ListRef := Ptr^.ListRef;\r
WHILE Not Equal_Addr(ListRef,St_StopAddr) DO\r
BEGIN\r
St_Retrieve(ListRef,Ptr);\r
PushAddr(Ptr);\r
Megaload(ESTTop);\r
ESTpop;\r
CodeConst(mLDL,VarOff +ParSize + 2 ,Anonymousspix);\r
CodeConst(mSTNL,Offset,AnonymousSpix);\r
offset := Offset + 1;\r
ListRef := Ptr^.ListRef;\r
END;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
St_Retrieve(InSymbol,Ptr);\r
offset := 0;\r
ListRef := Ptr^.ListRef;\r
WHILE Not Equal_Addr(ListRef,St_StopAddr) DO\r
BEGIN\r
St_Retrieve(ListRef,Ptr);\r
PushAddr(Ptr);\r
ESTTop^.IndVar := true;\r
Megaload(ESTTop);\r
ESTpop;\r
CodeConst(rSTVLW,8 + Offset,AnonymousSpix);\r
offset := Offset + 2;\r
ListRef := Ptr^.ListRef;\r
END;\r
{$ENDIF}\r
\r
END ELSE Files_Skip_To(PtrSt^.St_File_Mark);\r
END;\r
\r
\r
PROCEDURE do_cEndFor;\r
BEGIN\r
ReadSymbol;\r
GenerateLabel(SSTTop^.ContLabel);\r
\r
St_Retrieve(InSymbol,PtrSt);\r
{$IFDEF PI3}\r
\r
MakeAddr(CurrentNiv,PtrSt^.Var_Offset,Addr,False);\r
\r
St_RetrieveType(PtrSt^.TypeRef,PtrSt);\r
\r
\r
IF PtrSt^.St_Size = 1 THEN InstType := b\r
ELSE InstType := w;\r
\r
\r
Reg := GetRegister(ABCDRegister,RNil);\r
CodeRegAddr(iMOV,InstType,Reg,Addr);\r
\r
IF SSTTop^.Up THEN CodeAddr(iINC,InstType,Addr)\r
ELSE CodeAddr(iDEC,InstType,Addr);\r
\r
\r
IF PtrSt^.Subr_Mode = Stat THEN\r
CodeRegConst(iCMP,InstType,Reg,PtrSt^.Subr_High)\r
ELSE\r
BEGIN\r
(* Dynamic subrange *)\r
MakeAddr(CurrentNiv,PtrSt^.Subr_Addr.Offset,Addr,False);\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement + 2;\r
(* $check*)\r
(* Addr gives the address of high bound *)\r
\r
CodeRegAddr(iCMP,w,Reg,Addr);\r
END;\r
CodeJump(iJNE,SSTTop^.RepeatLabel);\r
GenerateLabel(SSTTop^.ExitLabel);\r
ReleaseRegister(Reg);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
PushAddr(PtrSt);\r
MakeCopyOfTop;\r
MakeCopyOfTop;\r
MegaLoad(ESTTop);\r
\r
IF SSTTop^.Up THEN CodeConst(mADC,1,Anonymousspix)\r
ELSE CodeConst(mADC,-1,Anonymousspix);\r
MegaStore(4);\r
\r
St_Retrieve(InSymbol,PtrSt);\r
St_RetrieveType(PtrSt^.TypeRef,PtrSt);\r
\r
\r
IF PtrSt^.Subr_Mode = Stat THEN\r
ESTPUSHConst(IntegerType,PtrSt^.Subr_High)\r
ELSE\r
BEGIN\r
PushAddr(PtrSt);\r
ESTTop^.A_Offset := ESTTop^.A_Offset + 4;\r
END;\r
\r
inst := mGT;\r
CMPTopElements(Inst,not SSTTop^.Up);\r
ESTPushDecode(SSTTop^.RepeatLabel,St_NillAddr,iNIL);\r
FallThruTrue;\r
ESTPop;\r
GenerateLabel(SSTTop^.ExitLabel);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
PushAddr(PtrSt);\r
ESTTop^.Indvar := true;\r
PushAddr(PtrSt);\r
MegaLoad(ESTTop);\r
GenCode(rREVPW);\r
ESTPushStack(IntegerType,false);\r
\r
IF SSTTop^.Up THEN CodeConst(rUADHW,1,Anonymousspix)\r
ELSE CodeConst(rUADHW,-1,Anonymousspix);\r
MegaStore(2);\r
\r
St_Retrieve(InSymbol,PtrSt);\r
St_RetrieveType(PtrSt^.TypeRef,PtrSt);\r
\r
\r
IF PtrSt^.Subr_Mode = Stat THEN\r
ESTPUSHConst(IntegerType,PtrSt^.Subr_High)\r
ELSE\r
BEGIN\r
PushAddr(PtrSt);\r
ESTTop^.A_Offset := ESTTop^.A_Offset + 2;\r
END;\r
\r
Inst := rEQ;\r
CMPTopElements(Inst,false);\r
Decode;\r
ESTTop^.FalseLab := SSTTop^.RepeatLabel;\r
FallThruTrue;\r
ESTPop;\r
GenerateLabel(SSTTop^.ExitLabel);\r
{$ENDIF}\r
SSTPop;\r
END;\r
\r
\r
\r
\r
PROCEDURE do_cStrucConst;\r
BEGIN\r
PushOperands;\r
\r
ReadSymbol;\r
St_RetrieveType(InSymbol,Ptr);\r
\r
\r
IF is_dynamic(Ptr, Ptr^.st_size) THEN\r
(* IF (dynamictype in Ptr^.Spec_Struct) OR\r
(Ptr^.st_size = 0) THEN *)\r
BEGIN (* Dynamic Type *)\r
{$IFDEF RC5000}\r
IF ESTTop = Bottom_ESTTop THEN ReleaseStrucDyn;\r
St_RetrieveType(Ptr^.TypeRef,Ptr);\r
\r
PushAddr(Ptr);\r
MakeFreeReg(3);\r
MegaLoad(ESTTop);\r
ESTPop;\r
Callroutine(Anonymousspix,DynAlloc,St_Extern);\r
St_retrieve(InSymbol,Ptr);\r
Ptr^.Var_Indir := false;\r
PushAddr(ptr);\r
Ptr^.Var_Indir := true;\r
IF (StrucInExp = false) THEN\r
BEGIN\r
StrucInExp := true;\r
StrucOffset := ESTTop^.A_Offset DIV 4;\r
END;\r
ESTPushStack(IntegerType,true);\r
MegaStore(4);\r
{$ENDIF}\r
{$IFDEF PI3}\r
Reg := CX;\r
ReturnLengthIn(Reg,Ptr);\r
\r
(* Makes the length even *)\r
CodeReg(iINC,w,Reg);\r
CodeReg(iSHR,w,Reg);\r
CodeReg(iSHL,w,Reg);\r
SubRegToSP(Reg);\r
ReleaseRegister(Reg);\r
{$ENDIF}\r
END\r
ELSE\r
BEGIN\r
{$IFDEF PI3}\r
(* Static type *)\r
CodeRegConst(iSUB,w,SP,Ptr^.St_Size +\r
ord(odd(Ptr^.St_Size)));\r
{$ENDIF}\r
END;\r
{$IFDEF RC5000}\r
St_Retrieve(InSymbol,Ptr);\r
PushAddr(Ptr);\r
PushAddr(Ptr);\r
{$ENDIF}\r
{$IFDEF PI3}\r
GetReg(DI);\r
CodeRegReg(iMOV,w,DI,SP);\r
ESTPushStack(InSymbol,True);\r
ESTPushAbsAddr(AnonymousSpix,InSymbol,False,P_Normal,DS,False\r
,0,DI);\r
{$ENDIF}\r
NotPack := True;\r
InStrucValue := InStrucValue + 1;\r
END;\r
\r
\r
\r
\r
Procedure Do_CNull;\r
VAR Value : integer;\r
BEGIN\r
ReadPar;\r
Value := InPar;\r
ReadCode;\r
\r
IF InCode = cEndAssign THEN\r
BEGIN\r
{$IFDEF PI3}\r
GetReg(AX);\r
GetReg(CX);\r
LoadAddrUse(ESTTop,di (* TOG RNil*));\r
CodeRegReg( iXOR, w, AX, AX );\r
if odd(value) then\r
begin\r
if value>5 then begin\r
CodeRegConst( iMOV, w, CX, value);\r
GenCode(iREP);\r
GenCode(iSTOSB);\r
end else\r
for value:=1 to value do GenCode(iSTOSB);\r
end else begin\r
value:= value div 2;\r
if value>5 then begin\r
CodeRegConst( iMOV, w, CX, value);\r
GenCode(iREP);\r
GenCode(ISTOSW);\r
end else\r
for value:=1 to value do GenCode(iSTOSW);\r
end;\r
ReleaseRegister(CX);\r
ReleaseRegister(AX);\r
(* TOG CodeRegConst(iADD,w,ESTTop^.A_Index,Value); *)\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF ESTSort(ESTTop) = S_Stack THEN\r
CodeConst(mSTL,ParamIndex,Anonymousspix);\r
IF (ESTTop^.Kind = O_Temp) OR (ESTTop^.Kind = O_StackOrTemp) THEN\r
TempOffset := TempOffset + 1;\r
ESTPop;\r
{$ENDIF}\r
END\r
ELSE\r
BEGIN\r
(* Incode = cSaveRep *)\r
ReadPar;\r
{$IFDEF RC5000}\r
MegaLoad(ESTTop);\r
CodeConst(mSTL,ParamIndex,AnonymousSpix);\r
CodeConst(mLDL,ParamIndex,AnonymousSpix);\r
MakeFreeReg(2);\r
CodeConst(mLDL,MegaOffset(CurrentNiv,InPar) DIV 4,AnonymousSpix);\r
GenCode(mADD);\r
CodeConst(mSTL,MegaOffset(CurrentNiv,InPar) DIV 4,AnonymousSpix);\r
ESTPop;\r
CodeConst(mLDL,ParamIndex,AnonymousSpix);\r
CodeConst(mLDC,Value,AnonymousSpix);\r
GenCode(mMUL);\r
MegaMakeAddr(ESTTop);\r
GenCode(mADD);\r
\r
ExchangeTopElements;\r
IF ESTTop^.Kind = O_Temp THEN MegaAlloctemp(1);\r
ESTPop;\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
{$IFDEF PI3}\r
LoadRegister(ESTTop,AllRegister,AX,w);\r
St_RetrieveType(ESTTop^.OprType,Ptr);\r
IF Ptr^.St_Size = 1 THEN SetHighByteTo0(ESTTop);\r
GetReg(CX);\r
GetReg(DX);\r
CodeRegConst(iMOV,w,DX,Value);\r
StoreRepCounter(AX,InPar);\r
CodeReg(iMUL,w,DX);\r
ESTPop;\r
LoadAddrUse(ESTTop,DI (* TOG RNil*) );\r
CodeRegReg( iMOV, w, CX, AX);\r
CodeRegReg( iXOR, w, AX, AX);\r
GenCode(iREP);\r
GenCode(iSTOSB);\r
(* TOG CodeRegReg(iADD,w,ESTTop^.A_Index,AX); *)\r
ReleaseRegister(AX);\r
ReleaseRegister(CX);\r
ReleaseRegister(DX);\r
{$ENDIF}\r
ReadCode; (* Skip endassign *)\r
ReadCode; (* Skip RepStruc *)\r
END;\r
END;\r
\r
\r
PROCEDURE Do_RepStruc;\r
BEGIN\r
{$IFDEF RC5000}\r
St_RetrieveType(ESTTop^.OprType,Ptr);\r
IF Is_Dynamic(Ptr,Ptr^.St_Size) THEN\r
BEGIN\r
PushAddr(Ptr);\r
MegaLoad(ESTTop);\r
ESTPop;\r
END\r
ELSE\r
Codeconst(mLDC,Ptr^.St_Size,AnonymousSpix);\r
\r
CodeConst(mLDL,TempAddrOffset,AnonymousSpix);\r
GenCode(mAdd);\r
CodeConst(mSTL,TempAddrOffset,Anonymousspix);\r
CodeJump(mJ,SSTTop^.ContLabel);\r
GenerateLabel(SSTTop^.EXITLabel);\r
SSTPop;\r
\r
IF ESTTop^.Kind <> O_Temp THEN\r
BEGIN\r
IF ESTTop^.Kind <> O_StackOrTemp THEN MegaAllocTemp(1);\r
IF ESTSort(ESTTop) <> S_Stack THEN\r
BEGIN\r
ESTTop^.T_Allign := (MegaAllign(ESTTop)) AND\r
((Ptr^.St_Size MOD 4) = 0);\r
ESTTop^.T_Address := true;\r
END;\r
ESTTop^.Kind := O_Temp;\r
\r
END;\r
ESTTop^.T_ObjectOffset := OldObjectOffset;\r
ESTTop^.T_Offset := TempAddrOffset;\r
TempOffset := TempOffset + 1;\r
IF TempAddrOffset <> TempOffset THEN\r
begin\r
MegaMakeAddr(ESTTop);\r
storestacktotemp(ESTTop);\r
end;\r
{$ENDIF}\r
{$IFDEF PI3}\r
\r
IF PushReg <> RNil THEN\r
BEGIN\r
GetReg(PushReg);\r
CodeReg(iPOP,w,PushReg);\r
END;\r
GetReg(CX);\r
CodeReg(iPOP,w,CX);\r
CodeJump(iLOOP,SSTTop^.ContLabel);\r
GenerateLabel(SSTTop^.EXITLabel);\r
SSTPop;\r
\r
ReleaseRegister(CX);\r
IF PushReg <> RNIL THEN ReleaseRegister(PushReg);\r
IF OnStack THEN\r
BEGIN\r
CodeReg(iPOP,w,AX);\r
CodeRegReg(iADD,w,SP,AX);\r
END;\r
\r
IF DSIsChange THEN\r
BEGIN\r
CodeRegReg(iMOV,w,AX,SS);\r
CodeRegReg(iMOV,w,DS,AX);\r
DSIsChange := false;\r
END;\r
{$ENDIF}\r
END;\r
\r
\r
PROCEDURE Do_CheckNumber; (* Symbol Offset Diff *) (* cConstCheckNumber :\r
Offset Number *)\r
VAR HelpI : Integer;\r
BEGIN\r
IF InCode = cCheckNumber THEN\r
BEGIN\r
ReadSymbol;\r
St_RetrieveType(InSymbol,Ptr);\r
\r
PushAddr(Ptr);\r
{$IFDEF PI3}\r
Loc(ESTTop,Addr);\r
Addr.Displacement := Addr.Displacement + 4;\r
(* addr gives high *)\r
Reg := GetRegister(AllRegister,RNil);\r
\r
CodeRegAddr(iMOV,w,Reg,Addr); (* TOG *)\r
Addr.Displacement := Addr.Displacement - 2;\r
CodeRegAddr(iSUB,w,Reg,Addr); (* TOG *)\r
\r
ReleaseAddr(Addr);\r
{$ENDIF}\r
\r
{$IFDEF RC5000}\r
AddOffsetToAddr(ESTTop,8);\r
(* addr gives high *)\r
Megaload(ESTTop);\r
PushAddr(Ptr);\r
AddOffsetToAddr(ESTTop,4);\r
(* addr gives low *)\r
Megaload(ESTTop);\r
GenCode(mSUB);\r
ESTPop;\r
{$ENDIF}\r
\r
ESTPop;\r
END;\r
\r
ReadPar;\r
{$IFDEF PI3}\r
MakeAddr(CurrentNiv,InPar,Addr,False);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MakeFreeReg(3);\r
CodeConst(mLDL,MegaOffset(CurrentNiv,InPar) DIV 4,Anonymousspix);\r
{$ENDIF}\r
\r
ReadPar;\r
\r
{$IFDEF RC5000}\r
IF InCode = cCheckNumber THEN\r
BEGIN\r
GenCode(mSUB);\r
InPar := inpar - 1\r
END;\r
{$ENDIF}\r
{$IFDEF PI3}\r
IF InCode = cCheckNumber THEN\r
BEGIN\r
CodeRegAddr(iSUB,w,Reg,Addr);\r
CodeRegConst(iCMP,w,Reg,InPar - 1);\r
ReleaseRegister(Reg);\r
END\r
ELSE\r
CodeAddrConst(iCMP,w,Addr,InPar);\r
{$ENDIF}\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
{$IFDEF PI3}\r
CodeJump(iJE,Lab);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
HelpI := InPar;\r
CodeConst(mLDC,HelpI,AnonymousSpix);\r
GenCode(mDIFF);\r
CodeJump(mCJ,Lab);\r
{$ENDIF}\r
CodeFault(StrucInt,StrucExc);\r
\r
GenerateLabel(Lab);\r
END;\r
\r
\r
\r
PROCEDURE do_cInitShar;\r
BEGIN\r
ESTTop^.Par := P_Normal;\r
{$IFDEF PI3}\r
LoadAddrUse(ESTTop,SI);\r
\r
(* Push paramater to InitShared *)\r
CodeReg(iPUSH,w,SS);\r
CodeReg(iPUSH,w,SI);\r
\r
CodeReg(iPUSH,w,SS);\r
IF InCode = cInitShar THEN\r
CodeRegConst(iADD,w,SI,LengthOfSharedtype + LengthOfSemaphore)\r
ELSE\r
BEGIN\r
CodeRegReg(iMOV,w,SI,SP);\r
CodeRegConst(iADD,w,SI,LengthOfSemaphore + 6 );\r
(* 6 bytes have been pushed after allocdynshare *)\r
END;\r
\r
CodeReg(iPUSH,w,SI);\r
\r
(* Push parameter to InitSemaphore *)\r
CodeRegConst(iSUB,w,SI,LengthOfSemaphore);\r
CodeReg(iPUSH,w,SS);\r
CodeReg(iPUSH,w,SI);\r
CodeRegConst(iMOV,w,SI,1);\r
CodeReg(iPUSH,w,SI);\r
\r
\r
ReleaseRegister(SI);\r
ESTPop;\r
\r
CallRoutine(AnonymousSpix,Init_Semaphore,St_Extern);\r
CallRoutine(AnonymousSpix,Init_Shared,St_Extern);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
(* Push paramater to InitShared *)\r
HelpLong := ESTTop^.A_Offset;\r
ESTPop;\r
CodeConst(rREALD,HelpLong,Anonymousspix);\r
CallRoutine(AnonymousSpix,Init_Reference,St_Extern);\r
IF InCode = cInitShar THEN\r
BEGIN\r
CodeConst(rREALD,helpLong\r
+ LengthOfSharedType + LengthOfSemaphore,Anonymousspix);\r
CodeConst(rSTVLA,HelpLong + referencesize,Anonymousspix);\r
CodeConst(rREALD,helpLong\r
+ LengthOfSharedType,Anonymousspix);\r
\r
END\r
ELSE\r
BEGIN\r
AllocDynamic(SharedAlloc,referencesize,HelpLong + referencesize);\r
CodeConst(rREVLA,HelpLong + referencesize,Anonymousspix);\r
GenCode(rREVPD);\r
CodeConst(rREASD,LengthOfSemaphore,Anonymousspix);\r
CodeConst(rSTVLA,HelpLong + referencesize,Anonymousspix);\r
END;\r
\r
\r
GenCode(rREVPD);\r
CallRoutine(AnonymousSpix,Init_MailBox,St_Extern);\r
\r
(* Push parameter to InitSemaphore *)\r
\r
CodeConst(rRECHW,1,Anonymousspix);\r
CodeConst(rRECHW,0,Anonymousspix);\r
CallRoutine(AnonymousSpix,Init_semaphore,St_Extern);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
(* Push paramater to InitShared *)\r
IF InCode = cInitShar THEN\r
BEGIN\r
MakeCopyOfTop;\r
MakeCopyOfTop;\r
MegaMakeAddr(ESTTop);\r
ESTTop^.T_ObjectOffset := ESTTop^.T_ObjectOffset\r
+ LengthOfSharedType + LengthOfSemaphore;\r
END\r
ELSE\r
BEGIN\r
ESTPushStack(IntegerType,False);\r
ESTTop^.T_Address := True;\r
ESTTop^.T_ObjectOffset := LengthOfSemaphore;\r
CodeConst(mSTL,ParamIndex,Anonymousspix);\r
CodeConst(mLDL,ParamIndex,Anonymousspix);\r
END;\r
PushOperand;\r
ESTPop;\r
PushOperand;\r
ESTPop;\r
CallRoutine(AnonymousSpix,Init_Shared,St_Extern);\r
(* Push parameter to InitSemaphore *)\r
\r
CodeConst(mLDC,1,Anonymousspix);\r
IF InCode = cInitDynShar THEN\r
BEGIN\r
CodeConst(mLDL,ParamIndex,Anonymousspix);\r
END\r
ELSE\r
BEGIN\r
AddOffsetToAddr(ESTTop,LengthOfSharedType);\r
PushOperand;\r
END;\r
ESTPop;\r
CallRoutine(AnonymousSpix,Init_Semaphore,St_Extern);\r
{$ENDIF}\r
END;\r
\r
Procedure Do_cDiv;\r
BEGIN\r
{$IFDEF RC35_50}\r
IF incode = cDIV then Inst := iDIV ELSE Inst := iMOD;\r
MegaOperationOnStack(Inst,false);\r
{$ENDIF}\r
\r
{$IFDEF PI3}\r
\r
LoadRegister(ESTTop^.BackWard,SpecificReg,AX,w);\r
\r
MakeOperationReady(InstType,IntegerOpr);\r
IF InstType = b THEN\r BEGIN\r
CodeRegReg(iXOR,b,AH,AH);\r
Inst := iDIV;\r
END\r
ELSE\r
BEGIN\r
GetReg(DX);\r
IF IntegerOpr THEN\r
BEGIN\r
GenCode(iCWD);\r
Inst := iIDIV;\r
END\r
ELSE\r
BEGIN\r
CodeRegReg(iXOR,w,DX,DX);\r
Inst := iDIV;\r
END;\r
END;\r
\r
IF ESTSort(ESTTop) = S_Memery THEN\r
BEGIN\r
MinFreeReg := 0;\r
Loc(ESTTop,Addr);\r
MinFreeReg := NormalMinFreeReg;\r
ESTPop;\r
CodeAddr(Inst,InstType,Addr);\r
ReleaseAddr(Addr);\r
END\r
\r
ELSE\r
BEGIN\r
LoadRegister(ESTTop,AllRegister,Rnil,InstType);\r
Reg := ESTTop^.R;\r
ESTPop;\r
CodeReg(inst,InstType,Reg);\r
\r
ReleaseRegister(Reg);\r
END;\r
\r
IF InCode = cMOD THEN\r
IF InstType = b THEN\r
CodeRegReg(iMOV,b,AL,AH)\r
ELSE\r
BEGIN\r
TypeAddr := ESTTop^.OprType;\r
ESTPop;\r
ESTPushReg(TypeAddr,DX);\r
ReleaseRegister(AX);\r
END\r
ELSE (* InCode = cDIV *)\r
IF InstType = w THEN ReleaseRegister(DX);\r
{$ENDIF}\r
END;\r
\r
\r
\r
Procedure Do_cprocdecl;\r
BEGIN\r
ReadSymbol;\r
St_Retrieve(InSymbol,ptrSt);\r
\r
(* a normal routine declaration *)\r
SetCodeModeToFalse;\r
\r
RoutineDecl(InSymbol,True);\r
\r
St_Retrieve(InSymbol,ptrSt);\r
\r
SLab := PtrSt^.St_Label;\r
SSTPushRoutine(SLab,PtrSt^.St_VarSize,PtrSt^.Max_Offset,\r
(ReferenceType IN PtrSt^.spec_struct));\r
\r
IF PtrSt^.St_Specs = St_Global THEN\r
BEGIN (* a global routine *)\r
MakeExternalLBDR(InSymbol,SLab,0,0,0,PtrSt^.St_Spix,1);\r
\r
InsertExternalNumber(PtrSt^.St_External_List);\r
\r
\r
GlobalBlockSymbol := InSymbol;\r
\r
CurrentNiv := Routine_Level;\r
\r
{$IFDEF RC5000}\r
SSTTop^.ExternalRoutine := True;\r
\r
IF Comp_Unit_Bit = Last_Comp_Unit_bit THEN\r
{$ENDIF}\r
BEGIN\r
(* Read The context *)\r
OldCurrentNiv := CurrentNiv;\r
oldcode := codeon;\r
oldSourceNumber := SourceNumber;\r
CurrentNiv := Context_Level;\r
\r
InContext := true;\r
NoOfTimesInContext := NoOfTimesInContext + 1;\r
\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
\r
END\r
ELSE\r
CurrentNiv := CurrentNiv + 1;\r
\r
{$IFDEF PI3}\r
if incode=cfuncdecl then\r
if (ptrst^.st_size>4) or (dynamictype in ptrst^.spec_struct) then\r
begin\r
SetCodeModeToTrue;\r
getreg(SI);\r
with ptrst^ do\r
estpushaddr(st_spix,typeref,false,p_normal,currentniv,func_result_offset);\r
loc(esttop,addr);\r
codeaddrreg(imov,w,addr,SI);\r
releaseRegister(SI);\r
addr.displacement:=addr.displacement+2;\r
codeaddrreg(imov,w,addr,DS);\r
releaseaddr(addr);\r
estpop;\r
end;\r
{$ENDIF}\r
\r
END;\r
\r
\r
«eof»