|
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: 64402 (0xfb92)
Types: TextFile
Names: »RTP86P4B.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\RTP86P4B.PAS«
procedure do_carrayinit;\r
BEGIN\r
ReadSymbol;\r
St_GetBaseType(InSymbol,PtrSt);\r
{$IFDEF RC3502}\r
ReadPar;\r
{$ENDIF}\r
{$IFDEF PI3}\r
ReadCode;\r
InitPointer := (InCode = CPointerType);\r
LookAHead := Not InitPointer;\r
LoadAddrUse(ESTTop,DI);\r
\r
IF InitPointer OR (InDeclPart = false) THEN\r
BEGIN\r
IF ESTTop^.A_Seg <> ES THEN\r
BEGIN\r
GetReg(ES);\r
IF ORD(ESTTop^.A_Seg) >= ORD(ES) THEN\r
BEGIN\r
GetReg(CX);\r
CodeRegReg(iMOV,w,CX,ESTTop^.A_Seg);\r
ESTTop^.A_Seg := CX;\r
END;\r
CodeRegReg(iMOV,w,ES,ESTTop^.A_Seg);\r
ReleaseRegister(ESTTop^.A_Seg);\r
END;\r
END\r
ELSE\r
IF InDeclPart THEN\r
BEGIN\r
ReleaseRegister(ESTTop^.A_Seg);\r
ESTTop^.A_Seg := SS;\r
END;\r
\r
\r
\r
ESTPop;\r
\r
GetReg(CX);\r
IF not is_dynamic(PtrSt, PtrSt^.st_size) THEN\r
BEGIN\r
Dynamic := False;\r
IF InitPointer = False THEN\r
BEGIN\r
CodeRegConst(iMOV,w,CX,PtrSt^.St_Size);\r
St_Retrieve(PtrSt^.TypeRef,PtrSt);\r
GetReg(AX);\r
CodeRegConst(iMOV,w,AX,PtrSt^.St_Size);\r
END\r
ELSE\r
CodeRegConst(iMOV,w,CX,PtrSt^.St_Size div 2);\r
END\r
ELSE\r
BEGIN\r
Dynamic := True;\r
PushAddr(PtrSt);\r
Loc(ESTTop,Addr);\r
CodeRegAddr(iMOV,w,CX,Addr);\r
IF InitPointer = False THEN\r
BEGIN\r
GetReg(AX);\r
Addr.Displacement := Addr.Displacement + 6;\r
CodeRegAddr(iMOV,w,AX,Addr);\r
END;\r
ReleaseAddr(Addr);\r
ESTPop;\r
END;\r
\r
\r
IF InitPointer THEN\r
(* Init the array to - 1 *)\r
BEGIN\r
GetReg(AX);\r
CodeRegReg(iXOR,w,Ax,AX);\r
IF Dynamic THEN CodeReg(iSHR,w,CX);\r
GenCode(iCLD);\r
GenCode(iREP);\r
GenCode(iSTOSW);\r
ReleaseRegister(ES);\r
ReleaseRegister(DI);\r
ReleaseRegister(CX);\r
ReleaseRegister(AX);\r
END\r
ELSE\r
BEGIN\r
\r
SSTPushLoop;\r
IF Dynamic THEN\r
BEGIN\r
CodeRegConst(iCMP,w,CX,0);\r
CodeJump(iJE,SSTTop^.ExitLabel);\r
END;\r
\r
GenerateLabel(SSTTop^.ContLabel);\r
\r
IF InDeclPart THEN Reg := SS\r
ELSE\r
BEGIN\r
CodeReg(iPUSH,w,ES);\r
Reg := ES;\r
END;\r
CodeReg(iPUSH,w,DI);\r
CodeReg(iPUSH,w,CX);\r
CodeReg(iPUSH,w,AX);\r
ReleaseRegister(AX);\r
ReleaseRegister(CX);\r
\r
\r
\r
ESTPushAbsAddr(AnonymousSpix,St_NillAddr,false,P_Normal\r
,Reg,False,0,DI);\r
END;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF (ESTTop^.Kind <> O_StackOrTemp) AND\r
(ESTTop^.Kind <> O_Temp) THEN\r
BEGIN\r
MegaMakeAddr(ESTTop);\r
StoreStackToTemp(ESTTop);\r
END;\r
IF (ESTTop^.Kind <> O_Temp) THEN\r
StoreTempOK(ESTTop^.T_IndexToSTL);\r
ESTTop^.Kind := O_Temp;\r
ESTTop^.T_Address := true;\r
\r
readcode;\r
lookahead := true;\r
ESTPushConst(IntegerType,ord(Incode=CarrayInit));\r
ExchangeTopElements;\r
\r
IF is_Dynamic(PtrSt,PtrSt^.St_Size) THEN\r
BEGIN\r
PushAddr(PtrSt);\r
END\r
ELSE\r
BEGIN\r
ESTPushConst(IntegerType, PtrSt^.St_Size);\r
END;\r
MegaLoad(ESTTop);\r
CodeConst(mSTL,ParamIndex,Anonymousspix);\r
ESTPop;\r
\r
St_Retrievetype(PtrSt^.TypeRef,PtrSt);\r
IF is_Dynamic(PtrSt,PtrSt^.St_Size) THEN\r
BEGIN\r
PushAddr(PtrSt);\r
END\r
ELSE\r
ESTPushConst(IntegerType, PtrSt^.St_Size);\r
\r
ExchangeTopElements;\r
SSTPushLoop;\r
\r
GenerateLabel(SSTTop^.ContLabel);\r
CodeConst(mLDL,ParamIndex,AnonymousSpix);\r
CodeConst(mLDC,0,Anonymousspix);\r
GenCode(mGT);\r
CodeJump(mCJ,SSTTop^.ExitLabel);\r
MegaAllocParam(1);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
\r
LoadAbsAddr(ESTTop);\r
\r
SSTPushLoop;\r
SSTTop^.OffsetOfSize := MegaOffset(CurrentNiv,Inpar);\r
St_Retrievetype(InSymbol, PtrSt);\r
\r
IF is_Dynamic(PtrSt,PtrSt^.St_Size) THEN\r
BEGIN\r
PushAddr(PtrSt);\r
END\r
ELSE\r
BEGIN\r
ESTPushConst(IntegerType, PtrSt^.St_Size);\r
END;\r
MegaLoad(ESTTop);\r
\r
CodeConst(rSTVLW,SSTTop^.OffsetOfSize,Anonymousspix);\r
ESTPop;\r
\r
GenerateLabel(SSTTop^.ContLabel);\r
CodeConst(rREVLW,SSTTop^.OffsetOfSize,AnonymousSpix);\r
CodeJump(rJMZEQ,SSTTop^.ExitLabel);\r
GenCode(rREVPD);\r
{$ENDIF}\r
END;\r
\r
procedure do_cendassign;\r
BEGIN\r
{$IFDEF PI3}\r
IF ESTTop^.BackWard^.BitLength = 0 THEN\r
BEGIN\r
(* Not packed assignment *)\r
St_Retrievetype(ESTTop^.BackWard^.OprType,PtrSt);\r
Size := PtrSt^.St_Size;\r
\r
MinFreeReg := 0;\r
\r
IF (Size = 2) or ( size = 1) THEN\r
BEGIN\r
IF Size = 1 THEN\r
BEGIN\r
Encode;\r
InstType := b;\r
END\r
ELSE InstType := w;\r
\r
IF ESTSort(ESTTop) = S_Const THEN\r
BEGIN\r
Value := ESTTop^.Value;\r
ESTPop;\r
Loc(ESTTop,Addr);\r
CodeAddrConst(iMOV,InstType,Addr,Value);\r
END\r
ELSE\r
BEGIN\r
IF InstType = b THEN\r
LoadRegister(ESTTop,AllRegister,RNil,InstType)\r
ELSE\r
BEGIN\r
St_RetrieveType(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Size = 1 THEN SetHighByteTo0(ESTTop);\r
LoadRegister(ESTTop,AllRegister,RNil,w);\r
END;\r
Reg := ESTTop^.R;\r
ESTPop;\r
Loc(ESTTop,Addr);\r
CodeAddrReg(iMOV,InstType,Addr,Reg);\r
ReleaseRegister(Reg);\r
END;\r
\r
ESTPop;\r
ReleaseAddr(Addr);\r
END\r
ELSE\r
(* a smtruc Assign . Length > 2 or dynamic length *)\r
BEGIN\r
IF (Size = 0) and not (dynamictype in PtrSt^.spec_struct) then\r
begin\r
estpop; estpop;\r
end else\r
IF (Size = 4) or (Size = 3) THEN\r
BEGIN\r
IF Size = 3 THEN InstType := b\r
ELSE InstType := w;\r
(* The assignment is made by two MOV *)\r
IF (ESTTop^.Kind = O_Stack) AND ESTTop^.IndVar THEN\r
BEGIN\r
Reg := GetRegister(AllRegister,RNil);\r
Reg1 := GetRegister(ABCDRegister,RNil);\r
CodeReg(iPOP,w,Reg);\r
CodeReg(iPOP,w,Reg1);\r
ESTPop;\r
END\r
ELSE\r
IF (ESTTop^.IndVar = false) AND\r
(ESTTop^.Kind = O_AbsAddr) THEN\r
BEGIN\r
(* a pointer from a function call *)\r
Loc(ESTTop^.BackWard,Addr);\r
Reg1 := ESTTop^.A_Seg;\r
Reg := ESTTop^.A_Index;\r
ESTpop;\r
END\r
ELSE\r
BEGIN\r
Loc(ESTTop,Addr);\r
Reg := GetRegister(AllRegister,RNil);\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
SetSourceAddr(Addr);\r
Reg1 := GetRegister(ABCDRegister,RNil);\r
\r
Addr.Spix := AnonymousSpix;\r
Addr.Displacement := Addr.Displacement + 2;\r
CodeRegAddr(iMOV,InstType,Reg1,Addr);\r
ReleaseAddr(Addr);\r
ESTPop;\r
END;\r
\r
Loc(ESTTop,Addr);\r
CodeAddrReg(iMOV,w,Addr,Reg);\r
ReleaseRegister(Reg);\r
Addr.Spix := AnonymousSpix;\r
Addr.Displacement := Addr.Displacement + 2;\r
CodeAddrReg(iMOV,InstType,Addr,Reg1);\r
ReleaseRegister(Reg1);\r
ReleaseAddr(Addr);\r
ESTPop;\r
END\r
ELSE\r
BEGIN\r
(* Struc assignment is made by MOVS *)\r
\r
IF is_dynamic(PtrSt, Size) THEN\r
BEGIN\r
Reg := CX;\r
ReturnLengthIn(Reg,PtrSt);\r
Inst := iMOVSB;\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
END\r
ELSE\r
BEGIN\r
CodeRegConst(iMOV,w,CX,Size DIV 2);\r
Inst := iMOVSW;\r
END;\r
END;\r
\r
\r
(* Source must use ES as seg Register and Dist must\r
use DS *)\r
\r
LoadAddrOfTopElems;\r
\r
\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
(* source addr is DS:SI and dist. addr is ES:DI *)\r
GenCode(iCLD);\r
GenCode(iREP);\r
GenCode(Inst);\r
\r
ESTPop;\r
ESTPop;\r
\r
UpdateDSAndSp;\r
\r
\r
END;\r
END;\r
MinFreeReg := NormalMinFreeReg;\r
(* skal slettes *)\r
IF NoOfFreeReg <> 7 THEN Fatal_Error(pass4,20);\r
\r
IF InStrucValue > 0 THEN\r
BEGIN (* a Struc value. Update The Address *)\r
ReadCode;\r
LookAhead := True;\r
Reg := DI;\r
IF (Size <> 0) AND (Size <= 4) THEN\r
BEGIN\r
IF Addr.Base = BX THEN Reg := BX\r
ELSE Reg := Addr.Index;\r
IF InCode <> cEndStruc THEN\r
CodeRegConst(iADD,w,Reg,Size);\r
END;\r
GetReg(Reg);\r
ESTPushAbsAddr(AnonymousSpix,St_NillAddr,false\r
,P_Normal,DS,False,0,Reg);\r
END ELSE\r
(* skal slettes *)\r
IF bottom_esttop <> esttop THEN Fatal_Error(pass4,30);\r
\r
END\r
ELSE\r
BEGIN\r
(* Packed Assignment *)\r
Minfreereg := 0;\r
LoadRegister(ESTTop,ABCDRegister,RNil,w);\r
Reg := ESTTop^.R;\r
ESTpop;\r
PutPackedElement(ESTTop,Reg);\r
MinFreeReg := NormalMinFreeReg;\r
\r
IF InStrucValue > 0 THEN\r
BEGIN (* a Struc value. Update The Address *)\r
ReadCode;\r
LookAhead := True;\r
IF InCode <> cEndStruc THEN\r
BEGIN\r
Reg := ESTTop^.BackWard^.A_Index;\r
IF ESTTop^.Kind = O_Const THEN\r
BEGIN\r
ESTTop^.Value := ESTTop^.Value + ESTTop^.BitLength;\r
WHILE ESTTop^.Value >= 8 DO\r
BEGIN\r
ESTTop^.Value := ESTTop^.Value - 8;\r
CodeReg(iINC,w,Reg);\r
END;\r
END\r
ELSE\r
BEGIN\r
Reg1 := ESTTop^.R;\r
BitLength := ESTTop^.BitLength;\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
IF BitLength <> 11 THEN\r
BEGIN\r
CodeRegConst(iADD,w,Reg1,BitLength);\r
IF BitLength > 8 THEN\r
BEGIN\r
St_Declaration(cLabel,AnonymousName\r
,ELab,Ptr);\r
GenerateLabel(ELab);\r
END;\r
CodeRegConst(iCMP,w,Reg1,8);\r
CodeJump(iJL,Lab);\r
CodeRegConst(iSUB,w,Reg1,8);\r
CodeReg(iINC,w,Reg);\r
IF BitLength > 8 THEN CodeJump(iJMP,ELab);\r
GenerateLabel(Lab);\r
END\r
ELSE\r
BEGIN (* BitLength = 11 *)\r
CodeReg(iINC,w,Reg);\r
CodeRegConst(iCMP,w,Reg1,3);\r
CodeRegConst(iMOV,w,Reg1,3);\r
CodeJump(iJNE,Lab);\r
(* offset 3 . Udfyld tomme bit *)\r
CodeReg(iINC,w,Reg);\r
CodeRegReg(iXOR,w,Reg1,Reg1);\r
GenerateLabel(Lab);\r
END;\r
END;\r
\r
END;\r
END\r
ELSE\r
BEGIN\r
PopPackedElement;\r
(* skal slettes *)\r
IF bottom_esttop <> esttop THEN Fatal_Error(pass4,30);\r
END;\r
END;\r
{$ENDIF}\r
\r
{$IFDEF RC35_50}\r
\r
IF ESTTop^.BackWard^.BitLength = 0 THEN\r
BEGIN\r
(* Not packed assignment *)\r
St_Retrievetype(ESTTop^.BackWard^.OprType,PtrSt);\r
Size := PtrSt^.St_Size;\r
\r
MegaStore(size);\r
END\r
ELSE\r
BEGIN\r
MegaTestLoad(true);\r
PutPackedElement;\r
END;\r
{$ENDIF}\r
END;\r
\r
\r
Procedure do_cindex;\r
\r
\r
BEGIN\r
\r
St_GetBaseType(ESTTop^.BackWard^.OprType,PtrSt);\r
\r
TypeAddr := PtrSt^.TypeRef; (* elementType *)\r
TypeAddr1 := PtrSt^.iType; (* indextype *)\r
\r
BitLength := PtrSt^.eBit_Size;\r
Packed1 := (PtrSt^.St_Packed <> notPacked);\r
Rc3502packed :=(ptrSt^.St_packed = Packed3502);\r
\r
St_Retrieve(TypeAddr,PtrSt);\r
Size := PtrSt^.St_Size;\r
{$IFDEF RC3502}\r
if (PtrSt^.spec_struct*ShieldType35 <> []) THEN\r
If Odd(size) THEN size := size + 1;\r
{$ENDIF}\r
\r
\r
St_RetrieveType(TypeAddr1,PtrSt);\r
\r
\r
IF PtrSt^.St_Kind = CSubrange THEN\r
BEGIN\r
IF PtrSt^.Subr_Mode = Stat THEN\r
BEGIN\r
Value := PtrSt^.Subr_Low;\r
Dynamic := false;\r
high := ptrst^.Subr_high;\r
END\r
ELSE\r
BEGIN\r
Value := 0;\r
Dynamic := true;\r
END;\r
END\r
ELSE\r
BEGIN\r
dynamic := false;\r
IF PtrSt^.St_Kind = cInteger THEN\r
BEGIN\r
Value := MaxInt;\r
Value := value + 1;\r
high := MaxInt;\r
END\r
ELSE\r
BEGIN\r
Value := 0;\r
IF PtrSt^.St_Kind = cScalar THEN\r
BEGIN\r
High := PtrSt^.Scalar_no - 1;\r
END\r
ELSE\r
IF PtrSt^.St_Kind = cBoolean THEN\r
BEGIN\r
High := 1;\r
END;\r
END;\r
END;\r
\r
IF ((ESTTop^.Kind = O_Const) AND\r
(dynamic = false) AND\r
(Size <> 0)) THEN\r
BEGIN\r
ValueInt :=(ESTTop^.Value - Value);\r
IF NOT Packed1 THEN\r
Value := ValueInt * Size\r
ELSE\r
BEGIN (* Packed index *)\r
IF BitLength = 11 THEN\r
BEGIN\r
BitOffset := ( Valueint * 9 ) MOD 6;\r
Value := ( ValueInt * 9) DIV 6;\r
END\r
ELSE\r
BEGIN\r
BitOffset := (ValueInt * BitLength) MOD 8;\r
Value := (ValueInt * BitLength) DIV 8;\r
{$IFDEF RC3502}\r
IF BitLength = 3 THEN\r
BEGIN\r
Value := (ValueInt DIV 5) * 2;\r
BitOffset := (ValueInt MOD 5) * 3;\r
END\r
ELSE\r
IF BitLength = 5 THEN\r
BEGIN\r
Value := (ValueInt DIV 3) * 2;\r
BitOffset := (ValueInt MOD 3) * 5;\r
END;\r
{$ENDIF}\r
END;\r
END;\r
\r
ESTPop;\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
END;\r
\r
CASE ESTTop^.Kind OF\r
O_Addr : ESTTop^.A_Offset := ESTTop^.A_Offset + Value;\r
O_IndAddr : ESTTop^.I_ObjectOffset :=\r
ESTTop^.I_ObjectOffset + Value;\r
O_AbsAddr : ESTTop^.A_Displacement := ESTTop^.A_Displacement +\r
Value;\r
\r
O_CAddr : ESTTop^.C_ObjectOffset :=\r
ESTTop^.C_ObjectOffset + Value;\r
{$IFDEF RC35_50}\r
O_Stack,O_StackOrTemp,O_Temp :\r
ESTTop^.T_ObjectOffset :=\r
ESTTop^.T_ObjectOffset + Value;\r
{$ENDIF}\r
END;\r
\r
IF Packed1 THEN\r
BEGIN\r
{$IFDEF RC5000}\r
ReadCode;\r
IF InCode = CIndVar THEN\r
BEGIN\r
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
END;\r
END\r
ELSE\r
(* variabel index *)\r
IF Packed1 THEN\r
BEGIN\r
{$IFDEF PI3}\r
\r
LoadRegister(ESTTop,SpecificReg,AX,w);\r
St_RetrieveType( ESTTop^.oprtype, ptrst);\r
IF ptrst^.st_size=1\r
THEN CodeRegReg(iXOR, b, ah, ah);\r
ESTPop;\r
\r
IF Value <> 0 THEN CodeRegConst(iSUB,w,AX,Value);\r
GetReg(DX);\r
Reg := GetRegister(AllRegister,RNil);\r
IF BitLength <> 1 THEN\r
BEGIN\r
IF BitLength = 11 THEN CodeRegConst(iMOV,w,Reg,9)\r
ELSE CodeRegConst(iMOV,w,Reg,BitLength);\r
CodeReg(iMUL,w,Reg);\r
END\r
ELSE\r
CodeRegReg(iXOR,w,DX,DX);\r
IF BitLength = 11 THEN CodeRegConst(iMOV,w,Reg,6)\r
ELSE CodeRegConst(iMOV,w,Reg,8);\r
CodeReg(iDIV,w,Reg);\r
AddRegToTopAddr(AX);\r
ReleaseRegister(Reg);\r
IF Rc3502Packed THEN\r
BEGIN\r
CodeReg(iNOT,w,DX);\r
CodeRegConst(iADD,w,DX,8 - BitLength + 1);\r
END;\r
\r
ESTPushReg(IntegerType,DX);\r
ESTTop^.BitLength := BitLength;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MegaLoad(ESTTop);\r
ESTPop;\r
MakeFreeReg(2);\r
\r
IF (value <> 0) and (LowerBoundIndexeq0 = false) THEN\r
BEGIN\r
CodeConst(mLDC,Value,AnonymousSpix);\r
GenCode(mSUB);\r
END;\r
IF BitLength <> 1 THEN\r
BEGIN\r
IF BitLength = 11 THEN CodeConst(mLDC,9,Anonymousspix)\r
ELSE CodeConst(mLDC,BitLength,AnonymousSpix);\r
GenCode(mMUL);\r
END;\r
\r
CodeConst(mSTL,ParamIndex,AnonymousSpix);\r
CodeConst(mLDL,paramindex,AnonymousSpix);\r
IF BitLength = 11 THEN CodeConst(mLDC,6,AnonymousSpix)\r
ELSE CodeConst(mLDC,8,AnonymousSpix);\r
GenCode(mDIV);\r
\r
MegaMakeAddr(ESTTop);\r
GenCode(mADD);\r
IF ESTTop^.T_ObjectOffset <> 0 THEN\r
CodeConst(mADC,ESTTop^.T_ObjectOffset,AnonymousSpix);\r
ESTTop^.T_ObjectOffset := 0;\r
StoreStackToTemp(ESTTop);\r
ESTTop^.T_Allign := false;\r
\r
ReadCode;\r
IF InCode = CIndVar THEN\r
BEGIN\r
ESTTop^.OprType := IntegerType;\r
MegaMoveToTemp(ESTTop);\r
MegaLoad(ESTTop);\r
END ELSE LookAhead := True;\r
MakeFreeReg(2);\r
CodeConst(mLDL,ParamIndex,AnonymousSpix);\r
IF BitLength = 11 THEN CodeConst(mLDC,6,AnonymousSpix)\r
ELSE CodeConst(mLDC,8,AnonymousSpix);\r
GenCode(mREM);\r
IF Rc3502Packed THEN\r
BEGIN\r
GenCode(mNOT);\r
CodeConst(mADC,8 - BitLength + 1,Anonymousspix);\r
END;\r
\r
ESTPushStack(IntegerType,true);\r
StoreStackToTemp(ESTTop);\r
ESTTop^.BitLength := BitLength;\r
{$ENDIF}\r
IF RC3502Packed THEN ESTTop^.Set_Temp := true;\r
{$IFDEF RC3502}\r
MegaLoad(ESTTop);\r
St_Retrievetype(ESTTop^.Backward^.OprType,PtrSt);\r
PushAddr(PtrSt);\r
LoadAbsAddr(ESTTop);\r
ESTPop;\r
ESTPop;\r
GenCode(rINTPA);\r
GenCode(rINPDV);\r
ESTTop^.BitLength := 1;\r
{$ENDIF}\r
END\r
ELSE\r
BEGIN (* Not Packed *)\r
{$IFDEF PI3}\r
St_RetrieveType(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Size = 1 THEN InstType := b Else InstType := w;\r
IF ESTTop^.Kind <> O_Reg THEN\r
BEGIN\r
IF ((Size <> 2) AND (Size <> 1 ) AND (Size <> 4)) THEN\r
LoadRegister(ESTTop,SpecificReg,AX,InstType)\r
ELSE\r
LoadRegister(ESTTop,AddrRegister,RNil,InstType);\r
END;\r
IF InstType = b THEN SetHighByteTo0(ESTTop);\r
{$ENDIF}\r
{$IFDEF rc35_50}\r
MegaLoad(ESTTop);\r
{$ENDIF}\r
{$IFDEF PI3}\r
IF Dynamic or ( Size = 0) THEN\r
BEGIN\r
St_RetrieveType(ESTTop^.BackWard^.OprType,PtrSt);\r
PushAddr(PtrSt);\r
Loc(ESTTop,Addr);\r
ESTPop;\r
END;\r
\r
Reg := ESTTop^.R;\r
\r
IF Dynamic OR ((Size = 0) AND (Value <> 0)) THEN\r
BEGIN\r
Addr.Displacement := Addr.Displacement + 2;\r
CodeRegAddr(iSUB,w,Reg,Addr);\r
Addr.Displacement := Addr.Displacement - 2;\r
END;\r
\r
IF (( Size <> 1 ) AND (Size <> 2 ) AND (Size <> 4)) THEN\r
BEGIN\r
\r
IF Reg = AX THEN\r
BEGIN\r
MinFreeReg := 0;\r
GetReg(DX);\r
MinFreeReg := NormalMinFreeReg;\r
Reg1 := DX;\r
Reg2 := DX;\r
END\r
ELSE\r
BEGIN\r
IF Reg <> DX THEN\r
BEGIN\r
GetReg(AX);\r
Reg1 := AX;\r
MinFreeReg := 0;\r
GetReg(DX);\r
MinFreeReg := NormalMinFreeReg;\r
ReleaseRegister(DX);\r
END\r
ELSE\r
BEGIN\r
MinFreeReg := 0;\r
GetReg(AX);\r
Reg1 := AX;\r
MinFreeReg := NormalMinFreeReg;\r
END;\r
Reg2 := Reg;\r
Reg := AX;\r
END;\r
\r
IF Size = 0 THEN\r
BEGIN\r
Addr.Displacement := Addr.Displacement + 6;\r
CodeRegAddr(iMOV,w,Reg1,Addr);\r
END\r
ELSE\r
BEGIN\r
CodeRegConst(iMOV,w,Reg1,Size);\r
END;\r
\r
CodeReg(iMUL,w,Reg2);\r
ReleaseRegister(Reg2);\r
END\r
ELSE\r
IF Size <> 1 THEN\r
BEGIN (* Size = 2 or 4 *)\r
IF Size = 4 THEN\r
CodeReg(iSHL,w,Reg);\r
CodeReg(iSHL,w,Reg);\r
\r
END;\r
ESTPop;\r
\r
IF Dynamic or ( Size = 0 ) THEN ReleaseAddr(Addr);\r
\r
AddRegToTopAddr(Reg);\r
\r
ValueInt := Value;\r
ESTTop^.A_Displacement := ESTTop^.A_Displacement -\r
( Value * Size );\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF (dynamic or (Size = 0) or ((value <> 0) AND (value <> 1)))\r
THEN\r
BEGIN\r
St_Retrievetype(ESTTop^.Backward^.OprType,PtrSt);\r
PushAddr(PtrSt);\r
IF dynamic OR (size = 0) THEN AddOffsettoAddr(ESTTop,2);\r
LoadAbsAddr(ESTTop);\r
GenCode(rINDEX);\r
ESTPop;\r
END\r
ELSE\r
BEGIN\r
helpLong := high;\r
helplong := (HelpLong SHL 16) + size;\r
IF Value = 1 THEN\r
CodeConst(rINDH1,HelpLong,anonymousspix)\r
ELSE\r
CodeConst(rINDH0,HelpLong,Anonymousspix);\r
END;\r
ESTPop;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF (Dynamic OR ((Size = 0) AND (Value <> 0)))\r
AND ( LowerBoundIndexEq0 = false) THEN\r
BEGIN\r
St_RetrieveType(ESTTop^.BackWard^.OprType,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,4);\r
MegaLoad(ESTTop);\r
ESTPop;\r
GenCode(mSUB);\r
END;\r
\r
IF (( Size <> 1 ) AND (Size <> 4)) THEN\r
BEGIN\r
\r
IF Size = 0 THEN\r
BEGIN\r
St_RetrieveType(ESTTop^.BackWard^.OprType,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,12);\r
MegaLoad(ESTTop);\r
END\r
ELSE\r
BEGIN\r
ESTPushConst(IntegerType,Size);\r
MegaLoad(Esttop);\r
END;\r
\r
GenCode(mPROD);\r
ESTPop;\r
END;\r
\r
IF (ESTSort(ESTTop^.Backward) = S_Stack)\r
THEN\r
BEGIN\r
IF Size = 4 THEN GenCode(mREV);\r
END;\r
MegaMakeAddr(Esttop^.Backward);\r
\r
IF Size = 4 THEN GenCode(mWSUB)\r
ELSE GenCode(mADD);\r
ESTPop;\r
\r
IF LowerBoundIndexEq0 = false THEN\r
ESTTop^.T_ObjectOffset := ESTTop^.T_ObjectOffset -\r
( Value * Size );\r
IF Size <> 0 THEN\r
ESTTop^.T_Allign := ESTTOP^.T_Allign AND\r
(Size MOD 4 = 0)\r
ELSE\r
ESTTop^.T_Allign := false;\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
END;\r
\r
IF Packed1 THEN\r
BEGIN\r
{$IFNDEF RC5000}\r
ReadCode;\r
{$ENDIF}\r
IF InCode = CIndVar THEN\r
BEGIN\r
{$IFDEF PI3}\r
ESTTop^.BackWard^.OprType := TypeAddr;\r
GetPackedElement(ESTTop,Reg);\r
{$ENDIF}\r
{$IFDEF RC35_50}\r
GetPackedElement(ESTTop,TypeAddr);\r
{$ENDIF}\r
St_RetrieveType(TypeAddr,Ptr);\r
IF Ptr^.St_Kind = cSubRange\r
THEN 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
(* Change the type of the stack top *)\r
ESTTop^.oprtype := typeaddr;\r
\r
LowerBoundIndexEq0 := false;\r
END;\r
\r
PROCEDURE do_cstrucElem;\r
BEGIN\r
ReadSymbol;\r
St_RetrieveType(InSymbol,Ptr);\r
{$IFDEF PI3}\r
IF (NotPack = false) AND ((Ptr^.St_Kind = cRecField) OR\r
((Ptr^.St_Kind = cArrayType) AND (ESTTop^.Kind = O_Const)))\r
THEN\r
BEGIN\r
Value := ESTTop^.Value;\r
IF Ptr^.St_Kind = cRecField\r
THEN BitOffset := Ptr^.Bit_Offset\r
ELSE BitOffset := 0;\r
\r
ESTPop;\r
NotPack := True;\r
IF BitOffset <> Value THEN\r
BEGIN (* fill *)\r
CodeReg(iINC,w,ESTTop^.A_Index);\r
END;\r
END;\r
{$ENDIF}\r
IF NotPack THEN\r
BEGIN (* The address on top of stack is not packed *)\r
ESTTop^.OprType := Ptr^.TypeRef;\r
{$IFDEF RC5000}\r
IF (Ptr^.St_Kind = cRecField) and (not megaallign(ESTTop)) THEN\r
BEGIN\r
St_Retrieve(Ptr^.TypeRef,PtrSt);\r
IF ((shieldType*PtrSt^.Spec_Struct) <> []) THEN\r
BEGIN\r
IF ESTTop^.Kind = O_Addr THEN\r
ESTTop^.A_Offset := ((ESTTop^.A_Offset + 3) DIV 4) * 4\r
ELSE\r
BEGIN\r
IF ESTTop^.T_Allign THEN\r
ESTTop^.T_ObjectOffset :=\r
((ESTTop^.T_ObjectOffset + 3) DIV 4) * 4\r
ELSE\r
BEGIN\r
MegaMakeAddr(ESTTop);\r
CodeConst(mADC,3,Anonymousspix);\r
CodeConst(mLDC,3,Anonymousspix);\r
Gencode(mNOT);\r
Gencode(mAND);\r
ESTTop^.T_allign := False;\r
END;\r
END;\r
END;\r
\r
END;\r
ReadCode;\r
LookAHead := True;\r
IF (InCode <> cStrucElem) AND (InCode <> cSetRep) THEN\r
BEGIN\r
MakeCopyOfTop;\r
St_Retrievetype(Ptr^.TypeRef,PtrSt);\r
IF is_Dynamic(PtrSt,PtrSt^.St_Size) THEN\r
BEGIN\r
IF ESTTop^.Backward^.Kind = O_Temp THEN\r
MegaMakeAddr(ESTTop^.Backward);\r
MegaMakeAddr(ESTTop);\r
PushAddr(PtrSt);\r
MegaLoad(ESTTop);\r
GenCode(mADD);\r
ESTPop;\r
ESTTop^.T_Allign := false;\r
StoreStackToTemp(ESTTop);\r
ExchangeTopElements;\r
MakeFreeReg(2);\r
StoreStackToTemp(ESTTop);\r
END\r
ELSE\r
AddOffsetToAddr(ESTTop^.BackWard,PtrSt^.St_Size);\r
END;\r
\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF ((Ptr^.St_Kind = cArrayType) AND\r
(Ptr^.St_Packed <> notPacked)) OR\r
((Ptr^.St_Kind = cRecField) AND\r
(Ptr^.Bit_Size <> 0)) THEN\r
Fatal_Error(Pass4,12);\r
{$ENDIF}\r
{$IFDEF PI3}\r
IF (Ptr^.St_Kind = cArrayType) AND\r
(Ptr^.St_Packed <> notPacked) THEN\r
BEGIN (* Make The Top element Packed *)\r
Reg := GetRegister(AllRegister,RNil);\r
CodeRegReg(iXOR,w,Reg,reg);\r
ESTPushReg(IntegerType,Reg);\r
ESTTop^.BitLength := Ptr^.eBit_Size;\r
NotPack := false;\r
END\r
ELSE\r
IF (Ptr^.St_Kind = cRecField) AND\r
(Ptr^.Bit_Size <> 0) THEN\r
BEGIN (* Make The Top element Packed *)\r
ESTPushConst(IntegerType,Ptr^.Bit_Offset);\r
ESTTop^.BitLength := Ptr^.Bit_Size;\r
NotPack := false;\r
END;\r
{$ENDIF}\r
END;\r
END;\r
\r
PROCEDURE do_cAdd;\r
var help : integer;\r
BEGIN\r
{$IFDEF PI3}\r
MakeOperationReady(InstType,IntegerOpr);\r
{$ENDIF}\r
(* IF operand is const and 1 or -1 code INC and DEC is made *)\r
IF ESTSort(ESTTop) = S_Const THEN\r
BEGIN\r
help := ESTTop^.Value;\r
ESTPop;\r
{$IFDEF PI3}\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
Reg := ESTTop^.R;\r
IF help = 1 THEN CodeReg(iINC,InstType,Reg)\r
ELSE\r
IF help = $FFFF THEN CodeReg(iDEC,InstType,Reg)\r
ELSE\r
CodeRegConst(iADD,InstType,Reg,help);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MegaLoad(ESTTop);\r
CodeConst(mADC,help,Anonymousspix);\r
ESTTop^.OprType := IntegerType;\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
END\r
ELSE\r
IF ESTSort(ESTTop^.BackWard) = S_Const THEN\r
BEGIN\r
{$IFDEF PI3}\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
Reg := ESTTop^.R;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MegaLoad(ESTTop);\r
{$ENDIF}\r
TypeAddr := ESTTop^.OprType;\r
ESTPop;\r
help := ESTTop^.Value;\r
{$IFDEF PI3}\r
IF help = 1 THEN CodeReg(iINC,InstType,Reg)\r
ELSE\r
IF help = $FFFF THEN CodeReg(iDEC,InstType,Reg)\r
ELSE\r
CodeRegConst(iADD,InstType,Reg,help);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
CodeConst(mADC,help,Anonymousspix);\r
{$ENDIF}\r
ESTPop;\r
{$IFDEF PI3}\r
ESTPushReg(TypeAddr,Reg);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTPushStack(IntegerType,true);\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
END\r
ELSE\r
{$IFDEF PI3}\r
OperationWithReg(iADD,InstType);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MegaOperationOnStack(mADD,true);\r
{$ENDIF}\r
END;\r
\r
PROCEDURE do_cAllocDynVar;\r
BEGIN\r
SetCodeModeToTrue;\r
\r
IF InCode = cAllocDynVar THEN ReadPar;\r
ReadSymbol;\r
St_Retrievetype(InSymbol,PtrSt);\r
Reg := RNil;\r
{$IFDEF PI3}\r
\r
ReturnLengthIn(Reg,PtrSt);\r
{$ENDIF}\r
IF InCode = cAllocDynVar THEN\r
BEGIN\r
{$IFDEF PI3}\r
(* Make Reg even *)\r
CodeReg(iINC,w,Reg);\r
CodeReg(iSHR,w,Reg);\r
CodeReg(iSHL,w,Reg);\r
\r
SubRegToSP(Reg);\r
ReleaseRegister(Reg);\r
\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
\r
ReleaseAddr(Addr);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTPushAddr(Anonymousspix,InSymbol,false,P_Normal,CurrentNiv,\r
Megaoffset(CurrentNiv,InPar));\r
allocdynamic(insymbol,0);\r
MegaStore(4);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
allocdynamic(insymbol,0,MegaOffset(CurrentNiv,InPar));\r
{$ENDIF}\r
END\r
ELSE\r
IF InCode = cAllocDynShared THEN\r
BEGIN\r
{$IFDEF PI3}\r
CodeRegConst(iAdd,w,Reg,LengthOfsemaphore + 1);\r
(* add 1 to get an even length *)\r
CodeReg(iSHR,w,Reg);\r
CodeReg(iSHL,w,Reg);\r
SubRegToSP(Reg);\r
\r
ReleaseRegister(Reg);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
AllocDynamic(InSymbol,LengthOfSemaphore);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
SharedAlloc := InSymbol;\r
{$ENDIF}\r
END;\r
END;\r
PROCEDURE do_cArrayType;\r
VAR\r
low,high,size : Integer;\r
lowuse,highuse,sizeuse,addconst : boolean;\r
BEGIN\r
{$IFDEF PI3}\r
LoadRegister(ESTTop,SpecificReg,AX,w);\r
ESTPop;\r
\r
IF inCode = cEndArray THEN\r
BEGIN (* ESTTop gives the address of the indextypes\r
dopevector *)\r
\r
Loc(ESTTop,Addr);\r
Reg := GetRegister(AllRegister,RNil);\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
Addr.Displacement := Addr.Displacement + 2;\r
SetSourceAddr(Addr);\r
Reg1 := GetRegister(AllRegister,RNil);\r
CodeRegAddr(iMOV,w,Reg1,Addr);\r
ReleaseAddr(Addr);\r
ESTPop;\r
END\r
ELSE (* InCode = ArrayType *)\r
BEGIN\r
(* The two top element gives the indextypes range *)\r
St_Retrieve(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Size = 1 THEN SetHighByteTo0(ESTTop);\r
LoadRegister(ESTTop,AllRegister,RNil,w);\r
Reg1 := ESTTop^.R;\r
ESTPop;\r
St_Retrieve(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Size = 1 THEN SetHighByteTo0(ESTTop);\r
LoadRegister(ESTTop,AllRegister,RNil,w);\r
Reg := ESTTop^.R;\r
ESTPop;\r
END;\r
\r
{$ENDIF}\r
ReadSymbol;\r
St_Retrievetype(InSymbol,PtrSt);\r
{$IFDEF PI3}\r
PushAddr(PtrSt);\r
\r
Loc(ESTTop,Addr);\r
ESTPop;\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
Addr.Displacement := Addr.Displacement + 2;\r
CodeAddrReg(iMOV,w,Addr,AX);\r
Addr.Displacement := Addr.Displacement - 6;\r
\r
CodeRegReg(iSUB,w,Reg1,Reg);\r
CodeReg(iINC,w,Reg1);\r
ReleaseRegister(Reg);\r
\r
CodeReg(iMUL,w,Reg1);\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
CodeJump(iJAE,Lab);\r
CodeFaultAX(IntOnFault,DynArrayExc);\r
GenerateLabel(Lab);\r
CodeAddrReg(iMOV,w,Addr,AX);\r
\r
ReleaseRegister(Reg1);\r
ReleaseRegister(AX);\r
ReleaseAddr(Addr);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
SizeUse := false;\r
Lowuse := false;\r
HighUse := false;\r
addconst := false;\r
If ESTTop^.Kind = O_Const THEN\r
BEGIN\r
size := ESTTop^.Value;\r
Sizeuse := true;\r
END;\r
\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,12);\r
ExchangeTopElements;\r
MegaStore(4);\r
\r
IF inCode = cEndArray THEN\r
BEGIN (* ESTTop gives the address of the indextypes\r
dopevector *)\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,4);\r
ExchangeTopElements;\r
MegaStore(8);\r
\r
END\r
ELSE (* InCode = ArrayType *)\r
BEGIN\r
(* The two top element gives the indextypes range *)\r
\r
If ESTTop^.Kind = O_Const THEN\r
BEGIN\r
high := ESTTop^.Value;\r
highuse := true;\r
END;\r
\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,8);\r
ExchangeTopElements;\r
MegaStore(4);\r
\r
If ESTTop^.Kind = O_Const THEN\r
BEGIN\r
low := ESTTop^.Value;\r
lowuse := true;\r
END;\r
\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,4);\r
ExchangeTopElements;\r
MegaStore(4);\r
\r
END;\r
\r
IF Highuse and lowuse then\r
BEGIN\r
CodeConst(mLDC,High - low + 1, anonymousspix);\r
END\r
ELSE\r
BEGIN\r
CodeConst(mLDC,0,AnonymousSpix);\r
\r
IF Highuse THEN\r
BEGIN\r
CodeConst(mLDC,High + 1,AnonymousSpix);\r
AddConst := true;\r
END\r
ELSE\r
BEGIN\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,8);\r
MegaLoad(ESTTop);\r
ESTPop;\r
END;\r
IF Lowuse THEN\r
BEGIN\r
IF not Addconst THEN Low := Low - 1;\r
CodeConst(mLDC,Low,AnonymousSpix);\r
addConst := true;\r
END\r
ELSE\r
BEGIN\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,4);\r
MegaLoad(ESTTop);\r
ESTPop;\r
END;\r
\r
GenCode(mSUB);\r
IF not AddConst THEN CodeConst(mADC,1,AnonymousSpix);\r
GenCode(mXDBLE);\r
GenCode(mREV);\r
\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
CodeJump(mCJ,Lab);\r
GenerateLabel(Lab);\r
GenCode(mREV);\r
END;\r
\r
IF Sizeuse THEN\r
BEGIN\r
if size <> 1 THEN\r
BEGIN\r
CodeConst(mLDC,Size,AnonymousSpix);\r
GenCode(mMUL);\r
END;\r
ESTPushStack(IntegerType,true);\r
END\r
ELSE\r
BEGIN\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,12);\r
MegaLoad(ESTTop);\r
GenCode(mMUL);\r
END;\r
\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
ExchangeTopElements;\r
MegaStore(4);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
SizeUse := false;\r
Lowuse := false;\r
HighUse := false;\r
addconst := false;\r
If ESTTop^.Kind = O_Const THEN\r
BEGIN\r
size := ESTTop^.Value;\r
Sizeuse := true;\r
END;\r
\r
IF InCode = cArrayType THEN\r
BEGIN\r
If ESTTop^.Backward^.Kind = O_Const THEN\r
BEGIN\r
high := ESTTop^.BackWard^.Value;\r
highuse := true;\r
END;\r
If ESTTop^.Backward^.Backward^.Kind = O_Const THEN\r
BEGIN\r
low := ESTTop^.Backward^.Backward^.Value;\r
lowuse := true;\r
END;\r
END\r
ELSE\r
ESTTop^.Backward^.Indvar := false;\r
\r
St_Retrievetype(InSymbol,PtrSt);\r
st_Retrieve(PtrSt^.TypeRef,PtrSt);\r
\r
if (PtrSt^.spec_struct*ShieldType35 <> []) THEN\r
BEGIN\r
IF sizeuse then\r
BEGIN\r
If Odd(size) THEN ESTTop^.Value := size + 1;\r
END\r
ELSE\r
BEGIN\r
MegaLoad(ESTTop);\r
GenCode(rREVPW);\r
CodeConst(rRECHW,1,Anonymousspix);\r
GenCode(rAND);\r
GenCode(rUADD);\r
END;\r
END;\r
St_Retrievetype(InSymbol,PtrSt);\r
\r
PushAddr(PtrSt);\r
ESTTop^.IndVar := false;\r
AddOffsetToAddr(ESTTop,6);\r
ExchangeTopElements;\r
MegaStore(2);\r
\r
IF inCode = cEndArray THEN\r
BEGIN (* ESTTop gives the address of the indextypes\r
dopevector *)\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
ESTTop^.IndVar := false;\r
AddOffsetToAddr(ESTTop,2);\r
ExchangeTopElements;\r
ESTTop^.Indvar := true;\r
ESTTop^.OprType := DoubleType;\r
MegaStore(4);\r
\r
END\r
ELSE (* InCode = ArrayType *)\r
BEGIN\r
(* The two top element gives the indextypes range *)\r
MegaLoad(ESTTop);\r
ESTPop;\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
ESTTop^.Indvar := false;\r
AddOffsetToAddr(ESTTop,2);\r
ExchangeTopElements;\r
MegaStore(4);\r
\r
\r
END;\r
\r
IF Highuse and LowUse THEN\r
BEGIN\r
CodeConst(rRECHW,High - Low + 1, anonymousspix);\r
END\r
ELSE\r
BEGIN\r
IF Highuse THEN\r
BEGIN\r
CodeConst(rRECHW,High + 1,AnonymousSpix);\r
AddConst := true;\r
END\r
ELSE\r
BEGIN\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,4);\r
MegaLoad(ESTTop);\r
ESTPop;\r
END;\r
IF Lowuse THEN\r
BEGIN\r
IF not Addconst THEN Low := Low - 1;\r
CodeConst(rRECHW,Low,AnonymousSpix);\r
addConst := true;\r
END\r
ELSE\r
BEGIN\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,2);\r
MegaLoad(ESTTop);\r
ESTPop;\r
END;\r
\r
GenCode(rMSUB);\r
IF not AddConst THEN CodeConst(rUADHW,1,AnonymousSpix);\r
(* GenCode(rREVPW);\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
CodeJump(rJMZGE,Lab);\r
CodeConst(rRECHW,0,Anonymousspix);\r
GenCode(rAND);\r
GenerateLabel(Lab);*)\r
END;\r
IF Sizeuse THEN\r
BEGIN\r
if size <> 1 THEN\r
BEGIN\r
CodeConst(rRECHW,Size,AnonymousSpix);\r
GenCode(rUMUL);\r
END;\r
ESTPushStack(IntegerType,false);\r
END\r
ELSE\r
BEGIN\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,6);\r
MegaLoad(ESTTop);\r
GenCode(rUMUL);\r
END;\r
\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
ESTTop^.IndVAr := false;\r
ExchangeTopElements;\r
MegaStore(2);\r
{$ENDIF}\r
END;\r
Procedure Do_cEndAssignSet;\r
var i : integer;\r
BEGIN\r
TypeAddr := ESTTop^.BackWard^.OprType;\r
{$IFDEF PI3}\r
\r
IF InStrucValue > 0 THEN\r
BEGIN\r
St_RetrieveType(TypeAddr,Ptr);\r
Reg := GetRegister(AllRegister,RNil);\r
IF not is_dynamic(Ptr, Ptr^.st_size) THEN\r
(* IF not (dynamictype in Ptr^.Spec_Struct) AND\r
( Ptr^.st_size <> 0) THEN *)\r
BEGIN\r
CodeRegConst(iMOV,w,Reg,Ptr^.St_Size);\r
END\r
ELSE\r
ReturnLengthIn(Reg,Ptr);\r
\r
LoadAddrUse(ESTTop^.BackWard,RNil);\r
CodeRegReg(iADD,w,Reg,ESTTop^.BackWard^.A_Index);\r
CodeReg(iPUSH,w,Reg);\r
ReleaseRegister(Reg);\r
Push1Operand;\r
END;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
TypeAddr := ESTTop^.Backward^.Backward^.OprType;\r
St_RetrieveType(TypeAddr,Ptr);\r
i := Ptr^.Subr_low;\r
ESTTop^.Backward^.Value := i;\r
i := Ptr^.Subr_high;\r
CodeConst(mLDC,i,Anonymousspix);\r
CodeConst(mSTL,2,Anonymousspix);\r
{$ENDIF}\r
MakeSetOprReady;\r
\r
{$IFDEF PI3}\r
St_RetrieveType(TypeAddr,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
(* Dynamic Type *)\r
PushAddr(Ptr);\r
Loc(ESTTop,Addr);\r
FOR i := 1 TO 2 DO\r
BEGIN\r
Addr.Displacement := Addr.Displacement + 2;\r
CodeAddr(iPUSH,w,Addr);\r
END;\r
\r
ReleaseAddr(Addr);\r
ESTPop;\r
END\r
ELSE\r
BEGIN\r
CodeRegConst(iMOV,w,AX,Ptr^.Subr_Low);\r
CodeReg(iPUSH,w,AX);\r
CodeRegConst(iMOV,w,AX,Ptr^.Subr_High);\r
CodeReg(iPUSH,w,AX);\r
END;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
St_Retrieve(TypeAddr,Ptr);\r
CodeConst(rRECHW,Ptr^.St_Size,Anonymousspix);\r
GenCode(rSETAD);\r
GenCode(rSETSt);\r
ESTPop;\r
{$ELSE}\r
CallRoutine(AnonymousSpix,AssignSet,St_Extern);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
EndCall(16);\r
{$ENDIF}\r
{$IFDEF PI3}\r
IF InStrucValue > 0 THEN\r
BEGIN\r
GetReg(DI);\r
CodeReg(iPOP,w,DI);\r
ESTPushAbsAddr(AnonymousSpix,St_NillAddr,False,P_Normal,\r
DS,false,0,DI);\r
END;\r
{$ENDIF}\r
END;\r
\r
PROCEDURE do_cEndCompound;\r
VAR oldniv : integer;\r
BEGIN\r
OldNiv := CurrentNiv;\r
InDeclPart := true;\r
\r
IF InCode = cEndCompound THEN\r
BEGIN\r
ELab := SSTTop^.P_ExitLabel;\r
GenerateLabel(ELab);\r
IF SSTTop^.LocalRef THEN\r
CallRoutine(anonymousspix,UnChain_LocalRef,st_Extern);\r
END;\r
\r
ReadSymbol;\r
St_Retrieve(InSymbol,PtrST);\r
GlobalBlock := false;\r
\r
IF InCode = cEndCompound THEN\r
BEGIN\r
ParSize := PtrSt^.St_ParamSize;\r
FarRoutine := not PtrSt^.St_Local_Near;\r
IF PtrST^.St_Specs = St_Global THEN\r
GlobalBlock := true;\r
END\r
ELSE\r
BEGIN\r
ParSize := PtrSt^.Type_ParamSize + 4;\r
FarRoutine := not PtrSt^.St_T_Local_Near;\r
END;\r
\r
{$IFDEF RC5000}\r
IF SSTTop^.DynamicAlloc THEN\r
BEGIN\r
CodeConst(mLDL,VarOff + 1,Anonymousspix);\r
CodeConst(mLDL,StaOff,Anonymousspix);\r
CodeConst(mSTNL,Proc_StackLimit,Anonymousspix);\r
StrucInExp := false;\r
END\r
else\r
ReleaseStrucDyn;\r
{$ENDIF}\r
IF SSTTop^.Kind = S_Prog THEN\r
BEGIN (* Stop the process *)\r
{$IFDEF RC3502}\r
GenCode(rMHALT);\r
CodeJump(iJMP,ELab);\r
St_Declaration(Clabel,Anonymousname,Lab,Ptr);\r
GenerateLabel(Lab);\r
GenCode(rSTSTC);\r
CodeLoadEffAddr(ELab,0);\r
CodeConst(rSTVGA,expoint,AnonymousSpix);\r
ChangeAppetite(ExitAppetite);\r
CodeConst(rREVGW,Excode,AnonymousSpix);\r
IF OwnException THEN CodeJump(rPCALS0,ExceptionProc)\r
ELSE CallRoutine(Anonymousspix,Exception,st_Extern);\r
CodeConst(rREVGW,Excode,AnonymousSpix);\r
CodeConst(rRECHW,47,AnonymousSpix);\r
GenCode(rLE);\r
CodeJump(rJMZGT,ELab);\r
ChangeAppetite(bonAppetite);\r
CodeLoadEffAddr(Lab,0);\r
CodeConst(rSTVGA,Expoint,Anonymousspix);\r
GenCode(rRESTC);\r
CodeConst(rJMPGA,exic,AnonymousSpix);\r
IF GlobalBlock THEN ExceptionLab := lab\r
ELSE\r
BEGIN\r
St_Get(InSymbol,PtrSt);\r
PtrSt^.St_External_List := Lab;\r
END;\r
\r
{$ELSE}\r
CallRoutine(Anonymousspix,EndProcess,St_Extern);\r
{$ENDIF}\r
END\r
ELSE\r
BEGIN (* A function or a procedure *)\r
IF PtrSt^.St_Kind = cFunction THEN\r
BEGIN (* Returns the function value in the correct\r
registeres *)\r
{$IFDEF PI3}\r
Addr.Spix := PtrSt^.St_Spix;\r
Addr.Seg := SS;\r
Addr.Base := BP;\r
Addr.Index := RNil;\r
Addr.Displacement := PtrSt^.Func_result_Offset;\r
\r
St_RetrieveType(PtrSt^.TypeRef,PtrSt);\r
IF (PtrSt^.St_Size > 4) or\r
(ptrst^.st_kind=cpointertype) or (dynamictype in ptrst^.spec_struct) THEN\r
BEGIN (* a pointer *)\r
CodeRegAddr(iLES,w,BX,Addr);\r
END\r
ELSE if (ptrst^.st_size > 2) then\r
begin\r
CodeRegAddr(iMOV,w,AX,Addr);\r
Addr.displacement:= Addr.displacement + 2;\r
CodeRegAddr(iMOV,w,DX,Addr);\r
end else\r
CodeRegAddr(iMOV,w,AX,Addr);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF SimpelFuncRes(PtrSt) THEN\r
BEGIN\r
ESTPushAddr(PtrSt^.St_Spix,\r
PtrSt^.TypeRef,true,P_Normal,CurrentNiv,\r
MegaOffset(CurrentNiv,PtrSt^.Func_result_Offset));\r
MegaLoad(ESTTop);\r
END\r
ELSE\r
BEGIN\r
estpushindaddr(PtrSt^.St_spix,PtrSt^.typeref,false,P_Normal,\r
currentniv,MegaOffset(currentniv,PtrSt^.func_result_offset),0);\r
ESTTop^.I_Allign := true;\r
MegaMakeAddr(ESTTop);\r
END;\r
ESTPop;\r
\r
{$ENDIF}\r
\r
{$IFDEF RC3502}\r
St_RetrieveType(PtrSt^.TypeRef,PtrSt);\r
IF NOT SimpelFuncRes(PtrSt) THEN ParSize := ParSize + 4;\r
{$ENDIF}\r
END\r
ELSE\r
BEGIN\r
{$IFDEF RC3502}\r
IF PtrSt^.St_Kind = cType THEN\r
BEGIN\r
CodeConst(rREVLA,-3,AnonymousSpix);\r
CodeConst(rREALD,8,AnonymousSpix);\r
CodeConst(rRECHW,PtrSt^.St_Size,AnonymousSpix);\r
GenCode(rMOVEG);\r
END;\r
\r
{$ENDIF}\r
END;\r
{$IFDEf PI3}\r
(* Leave The routine *)\r
CodeRegReg(iMOV,w,SP,BP);\r
CodeReg(iPOP,w,BP);\r
\r
IF GlobalBlock or FarRoutine THEN\r
BEGIN\r
IF ParSize = 0 THEN GenCode(iRETIS)\r
ELSE CodeConst(iRetIS,ParSize);\r
END\r
ELSE\r
BEGIN\r
IF ParSize = 0 THEN GenCode(iRETWS)\r
ELSE CodeConst(iRETWS,ParSize);\r
END;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
CodeConst(rPEXIT,ParSize+1,AnonymousSpix);\r
{$ENDIF}\r
CurrentNiv := CurrentNiv - 1;\r
END;\r
{$IFDEF RC5000}\r
CodeConst(mAJW, (SSTTop^.MaxStackSize div 4) +\r
( Oldniv + 2),AnonymousSpix);\r
GenCode(mRET);\r
{$ENDIF}\r
RoutineDecl(Insymbol,False);\r
\r
IF InContext OR GlobalBlock THEN CurrentNiv := Context_Level;\r
\r
SSTPop;\r
CodeMode := False;\r
END;\r
\r
PROCEDURE do_cendprocCall;\r
var parsize : word;\r
ext : boolean;\r
openrout : boolean;\r
resultlength : integer;\r
BEGIN\r
resultlength := 0;\r
ReadSymbol;\r
St_Retrieve(InSymbol,PtrSt);\r
ext := PtrSt^.St_Specs = St_Extern;\r
openrout := PtrSt^.St_Specs = St_Open;\r
if incode=cendfunccall then\r
if Not SimpelFuncRes(ptrst)\r
then begin\r
{$IFDEF PI3}\r
loadaddruse(esttop,SI);\r
releaseregister(SI);\r
estpop;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
PushParam(cVarParam);\r
ResultLength := 4;\r
{$ENDIF}\r
end;\r
{$IFDEF RC5000}\r
ParSize := PtrSt^.St_ParamSize;\r
LoadFirstParams(ParSize + LengthOfProgParam + ResultLength,\r
PtrST^.ST_Specs);\r
IF Ext Then\r
BEGIN\r
CallExtern(InSymbol);\r
St_Retrieve(InSymbol,PtrSt);\r
END;\r
Ext := False;\r
\r
{$ENDIF}\r
IF (Ext) OR (Openrout) THEN\r
BEGIN\r
No := PtrSt^.St_CurNo;\r
{$IFDEF RC3502}\r
IF openrout and ((InStack * 2) < Ptrst^.st_ParamSize) THEN\r
CodeConst(rRESTA,PtrST^.St_ParamSize,Anonymousspix);\r
IF openrout THEN Instack := Instack - (ptrSt^.St_ParamSize DIV 2);\r
{$ENDIF}\r
(* External Routine or Open routine *)\r
CallRoutine(PtrSt^.St_Spix,No,PtrSt^.St_Specs);\r
St_Retrieve(InSymbol,PtrSt);\r
END\r
ELSE\r
BEGIN\r
IF PtrSt^.St_Local_Near = false THEN\r
MakeLongCall(InSymbol)\r
ELSE\r
BEGIN\r
{$IFDEF PI3}\r
IF PtrSt^.St_Specs = St_Global THEN\r
(* push CS to make the return address far *)\r
CodeReg(iPUSH,w,CS);\r
\r
(* a normal routine call *)\r
CodeJump(iCall,PtrSt^.St_Label);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
CodeJump(mCall,PtrSt^.St_Label);\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF (CurrentNiv = Program_Level) OR\r
((CurrentNiv + 1) = PtrSt^.St_Level) THEN\r
CodeJump(rPCALS0,PtrSt^.St_Label)\r
ELSE\r
IF CurrentNiv = PtrSt^.St_Level THEN\r
CodeJump(rPCALS1,PtrSt^.St_Label)\r
ELSE\r
BEGIN\r
CodeConst(rREAID,CurrentNiv-PtrSt^.St_Level + 1, AnonymousSpix);\r
CodeJump(rPCALS, PtrSt^.St_Label);\r
END;\r
{$ENDIF}\r
\r
END;\r
END;\r
\r
IF InCode = cEndFuncCall THEN\r
BEGIN\r
(* The result is returned in the register *)\r
ReadCode;\r
IF InCode = CTypeParam THEN\r
BEGIN\r
ReadSymbol;\r
TypeAddr := InSymbol;\r
END\r
ELSE\r
BEGIN\r
TypeAddr := PtrSt^.TypeRef;\r
LookAHead := true;\r
END;\r
{$IFDEF PI3}\r
St_RetrieveType(TypeAddr,PtrSt);\r
IF (PtrSt^.St_kind = cpointertype) then\r
BEGIN\r
(* Pointer Type *)\r
GetReg(ES);\r
GetReg(BX);\r
IF InCode = cTypeParam THEN\r
BEGIN\r
St_Retrieve(TypeAddr,PtrSt);\r
TypeAddr := PtrSt^.TypeRef;\r
END;\r
ESTPushAbsAddr(AnonymousSpix,TypeAddr,false,P_Normal,\r
ES,false,0,BX);\r
IF InCode = cUpArrow THEN FunctionResultPointer := true;\r
END ELSE\r
IF (ptrst^.st_size>4) or (dynamictype in ptrst^.spec_struct) then\r
BEGIN\r
(* simulated Pointer Type *)\r
GetReg(ES);\r
GetReg(BX);\r
ESTPushAbsAddr(AnonymousSpix,TypeAddr,false,P_Normal,\r
ES,false,0,BX);\r
\r
END\r
ELSE IF (PtrSt^.St_size = 3) or (ptrst^.st_size=4) THEN\r
BEGIN\r
(* double type *)\r
GetReg(AX);\r
GetReg(DX);\r
ESTPushAbsAddr(AnonymousSpix,TypeAddr,false,P_Normal,\r
DX,false,0,AX);\r
END\r
ELSE\r
BEGIN\r
GetReg(AX);\r
ESTPushReg(TypeAddr,AX);\r
END;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTPushStack(TypeAddr,true);\r
IF resultlength <> 0 THEN\r
BEGIN\r
ESTTop^.T_Address := True;\r
ESTTop^.T_ObjectOffset := 0;\r
END;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF OpenRout THEN Instack := Instack + (PtrSt^.St_Size + 1) DIV 2;\r
IF InCode = cUpArrow THEN FunctionResultPointer := true;\r
St_RetrieveType(TypeAddr,PtrSt);\r
IF SimpelFuncRes(PtrSt) THEN\r
ESTPushStack(TypeAddr,false)\r
ELSE\r
BEGIN\r
ESTTOP^.IndVar := True;\r
ESTTop^.OprType := TypeAddr;\r
END;\r
\r
{$ENDIF}\r
\r
END;\r
{$IFDEF RC5000}\r
EndCall(ParSize + LengthOfProgParam+resultlength);\r
LengthOfProgParam := 0;\r
{$ENDIF}\r
END;\r
\r
PROCEDURE Do_cEndSubRange;\r
var i : integer;\r
high,low : integer;\r
highuse,lowuse,addconst : boolean;\r
BEGIN\r
ReadSymbol;\r
ReadCode;\r
{$IFDEF PI3}\r
IF (ESTSort(ESTTop^.BackWard) <> S_Const) OR (InCode = cSubRange)\r
THEN\r
BEGIN\r
St_Retrieve(ESTTop^.BackWard^.OprType,Ptr);\r
\r
IF Ptr^.St_Size = 1 THEN SetHighByteTo0(ESTTop^.BackWard);\r
LoadRegister(ESTTop^.BackWard,AllRegister,RNil,w);\r
Reg1 := ESTTop^.BackWard^.R;\r
END;\r
IF (ESTSort(ESTTop) <> S_Const) OR (InCode = cSubRange) THEN\r
BEGIN\r
St_Retrieve(ESTTop^.OprType,Ptr);\r
\r
IF Ptr^.St_Size = 1 THEN SetHighByteTo0(ESTTop);\r
LoadRegister(ESTTop,AllRegister,RNil,w);\r
Reg := ESTTop^.R;\r
END;\r
\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
\r
Loc(ESTTop,Addr);\r
ESTPop;\r
Addr.Spix := AnonymousSpix;\r
Addr.Displacement := Addr.Displacement + 2;\r
\r
FOR i := 1 TO 2 DO\r
BEGIN\r
IF ESTSort(ESTTop) = S_Const THEN\r
CodeAddrConst(iMOV,w,Addr,ESTTop^.Value)\r
ELSE\r
BEGIN\r
CodeAddrReg(iMOV,w,Addr,ESTTop^.R);\r
ReleaseRegister(ESTTop^.R);\r
END;\r
\r
ESTPop;\r
Addr.Displacement := Addr.Displacement - 2;\r
END;\r
\r
ReleaseAddr(Addr);\r
\r
IF InCode = CSubRange THEN\r
BEGIN\r
(* Check legal subrange *)\r
St_Declaration(Clabel,AnonymousName,Lab,Ptr);\r
CodeRegReg(iCMP,w,Reg,Reg1);\r
CodeJump(iJGE,Lab);\r
CodeReg(iINC,w,Reg);\r
CodeRegReg(iCMP,w,Reg,Reg1);\r
CodeJump(iJE,Lab);\r
CodeFault(SubRangeInt,SubRangeExc);\r
GenerateLabel(Lab);\r
END\r
ELSE\r
LookAHead := True;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
lowuse := false;\r
highuse := false;\r
addconst := false;\r
IF (ESTSort(ESTTop) = S_Const)\r
THEN\r
BEGIN\r
high := ESTtop^.Value;\r
highuse := true;\r
END;\r
\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,4);\r
ExchangeTopElements;\r
MegaStore(4);\r
\r
IF (ESTSort(ESTTop) = S_Const)\r
THEN\r
BEGIN\r
low := ESTtop^.Value;\r
lowuse := true;\r
END;\r
\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
ExchangeTopElements;\r
MegaStore(4);\r
\r
IF InCode = CSubRange THEN\r
BEGIN\r
(* Check legal subrange *)\r
\r
END\r
ELSE\r
LookAHead := True;\r
\r
{$ENDIF}\r
{$IFDEF RC3502}\r
MegaLoad(ESTTop);\r
ESTPop;\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
ExchangeTopElements;\r
MegaStore(4);\r
\r
IF InCode = CSubRange THEN\r
BEGIN\r
(* Check legal subrange *)\r
\r
END\r
ELSE\r
LookAHead := True;\r
\r
{$ENDIF}\r
\r
END;\r
\r
\r
«eof»