|
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: 22975 (0x59bf)
Types: TextFile
Names: »RTP86P4A.PAS«
└─⟦037c0ce35⟧ Bits:30010524 DVBS1.SW2114.src.2.6-2 RTP compiler source SW2104+SW2114 Disk#2 30/1-92 HHA
└─⟦this⟧ »RTP\RTP86P4A.PAS«
└─⟦828f0d3dd⟧ Bits:30010527 DVBS1.SW2114.src.2.6-5 RTP Compiler Source SW2104+SW2114 Disk 2 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\RTP86P4A.PAS«
└─⟦891417be1⟧ Bits:30010519 DVBS1.SW2114.src.2-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\RTP86P4A.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\RTP86P4A.PAS«
\r
\r
\r
\r
(******************* RTPPASS4 ************************)\r
\r
\r
(* The main part of pass4 *)\r
\r
VAR\r
\r
OldInCode,\r
InCode : Codes; (* Variabel containing the last read code *)\r
\r
LookAhead : boolean;\r
(* true if the next incode has been read *)\r
\r
InPar : Word; (* Variabel containing the last read word param *)\r
\r
InSymbol : St_Address; (* Variabel containing the last read symbol *)\r
\r
MoreInput : Boolean; (* false when infile has been read *)\r
\r
PtrST, Ptr : st_elemptr;\r
\r
ELab, SLab, Lab : St_Address; (* Address to label nodes *)\r
\r
Inst : Instruction;\r
\r
Addr, Addr1 : Address;\r
\r
Reg, Reg1,Reg2 : Register;\r
\r
Value : Word;\r
\r
ValueInt : integer;\r
\r
Size, No : Word;\r
\r
IntegerOpr : Boolean;\r
InstType : InstrucType;\r
(* IntegerOpr And InstType describes the operation to be made *)\r
ShiftInstType,helpInst : InstrucType;\r
\r
TypeAddr, TypeAddr1, ListRef : St_Address;\r
\r
Par : ParType;\r
\r
GlobalBlock : Boolean; (* true if the block beeing parsed is global *)\r
\r
FarRoutine : Boolean;\r
\r
TheProgramType : St_declaremode;\r
\r
SSTTemp : SSTelementRef;\r
\r
SecendOpr : ESTelementRef;\r
\r
Packed1, Packed2 : Boolean;\r
\r
neg ,bool, bool1 : boolean;\r
\r
PoolParam : boolean;\r
alligned : boolean;\r
AllignSize : Integer;\r
\r
Low, High : word;\r
LowInt, Highint : integer;\r
\r
BitOffset, BitLength : word;\r
\r
ParSize : word;\r
\r
Dynamic, InitPointer : boolean;\r
esttest : estelementref;\r
i : integer;\r
\r
OldCurrentNiv : integer;\r
\r
NoOfDynFields : integer;\r
\r
NoOfTimesInContext : Integer;\r
\r
\r
OldCode : Boolean;\r
\r
oldSourceNumber : Word;\r
{$IFDEF PI3}\r
InStrucValue : Integer;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
InStrucValue : Integer;\r
helplong : Longint;\r
OwnException : Boolean;\r
ExceptionProc : St_Address;\r
RC3502ProgramOffset : integer;\r
sharedalloc : St_Address;\r
{$ENDIF}\r
rc3502packed : boolean;\r
NotPack,MakingAssign, OnStack : Boolean;\r
\r
PushReg : Register;\r
TempAddrOffset : Integer;\r
OldObjectOffset : longint;\r
\r
InDeclPart : Boolean;\r
\r
DoNotPopTop : Boolean;\r
\r
ProgStat : State;\r
\r
SetRoutine : integer;\r
\r
FunctionResultPointer : Boolean;\r
\r
AssignType : ( Simpelassign, Assignbymov, strucassign );\r
\r
OldLineNumber : Word;\r
\r
Comp_unit_bit : Word;\r
\r
LengthOfProgParam : integer;\r
LowerBoundIndexEq0 : Boolean;\r
(* ----------------------------------------------------------- *)\r
\r
\r
\r
PROCEDURE ReadPar;\r
(* The procedure reads the next parameter from infile *)\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
IF TestPass4 > 1 THEN\r
writeln(TestOutput,' START ','ReadPar');\r
(*ENDTEST#*)\r
\r
InPar := Get_2_Byte;\r
\r
(*#BEGINTEST\r
IF TestPass4 > 1 THEN\r
writeln(TestOutput,' SLUT ','ReadPar ',InPar);\r
(*ENDTEST#*)\r
END;\r
\r
\r
\r
\r
(* ---------------------------------------------------------------- *)\r
\r
\r
\r
PROCEDURE ReadCode;\r
(* The procedure reads the next code from infile *)\r
VAR\r
NewLineNum : boolean;\r
Pass : ModuleRange;\r
Passno : integer;\r
HelpTest : Word;\r
BEGIN\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 > 1 THEN\r
writeln(TestOutput,' START ','ReadCode');\r
(*ENDTEST#*)\r
\r
InCode := codes(Get_Byte);\r
\r
NewLineNum := False;\r
WHILE ((InCode = cNewLine) OR (InCode = cOption) ) DO\r
BEGIN\r
IF (InCode = CNewLine) THEN\r
BEGIN\r
ReadPar;\r
LineNumber := InPar;\r
NewLineNum := true;\r
InCode := Codes(Get_byte);\r
END\r
ELSE\r
IF InCode = cOption THEN\r
BEGIN\r
ReadPar; (* Pass4 or Allpass*)\r
Pass := ModuleRange(InPar);\r
ReadPar; (* option *)\r
\r
CASE Option_Tokens(InPar) OF\r
NoCode_, code_ : BEGIN\r
SetCodeTo(InPar = ord(Code_));\r
ReadPar;\r
END;\r
\r
Test_ :\r
BEGIN\r
ReadPar;\r
IF (Pass = Pass4) AND (TestPass4 >= 0) THEN\r
BEGIN\r
TestPass4 := InPar MOD 256;\r
HelpTest := InPar DIV 256;\r
IF HelpTest = 1 THEN TestSth := true;\r
IF HelpTest = 2 THEN TestSth := false;\r
IF (HelpTest = 3) AND ( original_testvmm = 0)\r
THEN TestvmmUpdate := true;\r
IF (HelpTest = 4 ) AND ( original_testvmm = 0) THEN\r
TestvmmUpdate := false;\r
END\r
\r
\r
ELSE\r
IF (Pass = vmm) AND ( TestvmmUpDate ) THEN\r
Testvmm := InPar;\r
END;\r
SourceNo_ :\r
BEGIN\r
ReadPar;\r
SourceNumber := InPar;\r
END;\r
VersionPass1,VersionPass2 ,VersionPass3 ,VersionPass4 :\r
BEGIN\r
PassNo := InPar - ord(VersionPass1) + 1;\r
ReadPar;\r
IF (PassNo = 3) THEN\r
IF ((InPar DIV 100) <>\r
(Pass4VerNo DIV 100)) THEN\r
Fatal_Error(Pass4,21);\r
VersionNumber[PassNo] := InPar;\r
END;\r
\r
(*Otherwise*) ELSE\r
ReadPar;\r
\r
End; (* case *)\r
\r
\r
InCode := Codes(Get_Byte);\r
END;\r
END;\r
\r
IF NewLineNum THEN NewLine(LineNumber);\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 1 THEN\r
begin\r
writeln(testoutput,'line: ',LineNumber,'code ',ord(incode));\r
end;\r
(*ENDTEST#*)\r
END;\r
\r
\r
\r
(* ----------------------------------------------------------- *)\r
\r
\r
\r
PROCEDURE ReadSymbol;\r
(* The procedure reads the next Symbol from infile *)\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
IF TestPass4 > 1 THEN\r
writeln(TestOutput,' START ','ReadSymbol');\r
(*ENDTEST#*)\r
\r
InSymbol.Va_Low := Get_2_Byte;\r
InSymbol.Va_High := Get_2_Byte;\r
\r
(*#BEGINTEST\r
IF TestPass4 > 1 THEN\r
writeln(TestOutput,' SLUT ','ReadSymbol');\r
(*ENDTEST#*)\r
END;\r
\r
\r
(* ------------------------------------------------------ *)\r
\r
\r
\r
\r
\r
(* ---------------------------------------------------------- *)\r
\r
\r
\r
FUNCTION ResultMustBeEncode : Boolean;\r
(* The function lookahead in the code to see if the result of\r
the last opertion ( which is a boolean result ) must be in\r
Decode form or in encode form *)\r
\r
BEGIN\r
ReadCode;\r
LookAHead := true;\r
IF ((InCode = cWhileExpr) OR (InCode = cEndRepeat) OR\r
(InCode = cIfExpr ) OR (InCode = cPreAnd) OR\r
(InCode = cPreOr) OR (InCode = cAnd) OR (InCode = cOR) OR\r
(InCode = cNOT) )\r
THEN (* In decode forme *)\r
ResultMustBeEncode := false\r
ELSE (* In encode form *)\r
ResultMustBeEncode := true;\r
END;\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
(* ----------------------------------------------------------*)\r
\r
\r
PROCEDURE AndOrOnBoolean;\r
(* The procedure makes the AND and OR operation on boolean *)\r
\r
BEGIN\r
IF ESTTop^.kind <> O_Decode THEN Decode;\r
\r
(* merge ESTTop^.Falselab And ESTTop^.BackWard^.Falselab *)\r
Lab := ESTTop^.FalseLab;\r
IF Equal_Addr(ESTTop^.BackWard^.FalseLab,St_NillAddr) THEN\r
ESTTop^.BackWard^.FalseLab := Lab\r
ELSE\r
IF NOT Equal_Addr(Lab,St_NillAddr) THEN\r
GenAsLabel(Lab,ESTTop^.BackWard^.FalseLab);\r
\r
(* merge ESTTop^.TrueLab And ESTTop^.BackWard^.TrueLab *)\r
Lab := ESTTop^.TrueLab;\r
IF Equal_Addr(ESTTop^.BackWard^.TrueLab,St_NillAddr) THEN\r
ESTTop^.BackWard^.TrueLab := Lab\r
ELSE\r
IF NOT Equal_Addr(Lab,St_NillAddr) THEN\r
GenAsLabel(Lab,ESTTop^.BackWard^.TrueLab);\r
\r
\r
Inst := ESTTop^.Condition;\r
ESTPop;\r
ESTTop^.Condition := Inst;\r
\r
IF ResultMustBeEncode THEN EnCode;\r
END;\r
\r
\r
\r
\r
\r
(*------------------------------------------------------------------ *)\r
\r
\r
\r
\r
\r
PROCEDURE BeforeStringOpr;\r
(* procedure used when assign string, exchange string and compare\r
string *)\r
VAR\r
Reg1,Reg2 : Register;\r
Lab : St_Address;\r
\r
BEGIN\r
{$IFDEF RC5000}\r
MegaMakeAddr(ESTTop);\r
IF ESTTop^.T_ObjectOffset <> 0 THEN\r
CodeConst(mADC,ESTTop^.T_ObjectOffset,AnonymousSpix);\r
CodeConst(mSTL,ParamIndex,AnonymousSpix);\r
Lab := ESTTop^.OprType;\r
ESTPop;\r
MegaMakeAddr(ESTTop);\r
IF ESTTop^.T_ObjectOffset <> 0 THEN\r
CodeConst(mADC,ESTTop^.T_ObjectOffset,AnonymousSpix);\r
MakeFreeReg(2);\r
St_Retrievetype(ESTTop^.OprType,Ptr);\r
ESTPop;\r
IF is_dynamic(Ptr,Ptr^.st_Size) THEN PushAddr(Ptr)\r
ELSE ESTPUSHConst(IntegerType,Ptr^.St_Size);\r
MegaLoad(ESTTop);\r
ESTPop;\r
St_Retrievetype(Lab,Ptr);\r
IF is_dynamic(Ptr,Ptr^.st_Size) THEN PushAddr(Ptr)\r
ELSE ESTPUSHConst(IntegerType,Ptr^.St_Size);\r
MegaLoad(ESTTop);\r
ESTPop;\r
\r
{$ENDIF}\r
{$IFDEF RC3502}\r
MegaLoad(ESTTop);\r
Lab := ESTTop^.OprType;\r
ESTPop;\r
St_Retrievetype(ESTTop^.OprType,Ptr);\r
IF is_dynamic(Ptr,Ptr^.st_Size) THEN PushAddr(Ptr)\r
ELSE ESTPUSHConst(IntegerType,Ptr^.St_Size);\r
MegaLoad(ESTTop);\r
ESTPop;\r
St_Retrievetype(Lab,Ptr);\r
IF is_dynamic(Ptr,Ptr^.st_Size) THEN PushAddr(Ptr)\r
ELSE ESTPUSHConst(IntegerType,Ptr^.St_Size);\r
MegaLoad(ESTTop);\r
ESTPop;\r
ESTPop;\r
{$ENDIF}\r
{$IFDEF pi3}\r
\r
MinFreeReg := 0;\r
\r
if (incode=clt) or (incode=cge) then\r
BEGIN Reg1 := DX; Reg2 := CX END ELSE\r
BEGIN Reg1 := CX; Reg2 := DX END;\r
\r
St_Retrievetype(ESTTop^.OprType,Ptr);\r
ReturnLengthIn(Reg1,Ptr);\r
St_RetrieveType(ESTTop^.BackWard^.OprType,Ptr);\r
ReturnLengthIn(Reg2,Ptr);\r
\r
if Reg1 = CX THEN LoadAddrOfTopElems\r
ELSE LoadAddr2OfTopElems;\r
\r
CodeRegReg(iSUB,w,DX,CX);\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
CodeJump(iJGE,Lab);\r
CodeRegReg(iADD,w,CX,DX);\r
GenerateLabel(Lab);\r
GenCode(iCLD);\r
{$ENDIF}\r
END;\r
\r
\r
\r
\r
\r
PROCEDURE AfterStringOpr;\r
(* procedure used when assign string, exchange string and compare\r
string *)\r
BEGIN\r
{$IFDEF PI3}\r
ReleaseRegister(DX);\r
ReleaseRegister(CX);\r
ReleaseRegister(ES);\r
ReleaseRegister(DI);\r
ReleaseRegister(SI);\r
ESTPop;\r
ESTPop;\r
UpdateDsAndSP;\r
\r
MinFreeReg := NormalMinFreeReg;\r
{$ENDIF}\r
END;\r
\r
\r
\r
(*------------------------------------------------------------------ *)\r
{$IFDEF RC5000}\r
Function BitsInWord(L : Longint): Integer;\r
VAR I, Count : Integer;\r
Begin\r
Count := 0;\r
For i := 0 TO 31 DO\r
If (L AND (1 SHL i)) <> 0 THEN Count := Count + 1;\r
BitsInWord := Count;\r
END;\r
{$ENDIF}\r
\r
PROCEDURE CheckRange(StAddr : St_Address; ErrorInt, ErrorExc : integer);\r
(* StAddr specifies a type node. IF the node is a subrange type\r
the procedure generates code to check if stacktop is in the range *)\r
\r
VAR\r
Low, High : integer;\r
longlow,longhigh : longint;\r
InstType : InstrucType;\r
Static : boolean;\r
Kind : codes;\r
Size : word;\r
two_power : Boolean;\r
\r
BEGIN\r
{$IFDEF pi3}\r
St_RetrieveType(ESTTop^.OprType,PtrSt);\r
Size := PtrSt^.St_Size;\r
\r
IF Size = 1 THEN\r
BEGIN\r
InstType := b;\r
St_GetBaseType(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Size = 2 THEN\r
BEGIN\r
SetHighByteTo0(ESTTop);\r
ESTTop^.OprType := IntegerType;\r
InstType := w;\r
END;\r
END\r
ELSE\r
InstType := w;\r
\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
{$ENDIF}\r
\r
St_RetrieveType(StAddr,PtrSt);\r
\r
Kind := PtrSt^.St_Kind;\r
IF Kind = CArrayType THEN\r
BEGIN\r
IF is_dynamic(PtrSt, Size) THEN\r
Static := false\r
ELSE\r
BEGIN\r
St_RetrieveType(PtrSt^.IType,PtrSt);\r
Kind := PtrSt^.St_Kind;\r
Static := PtrSt^.Subr_Mode = stat;\r
END;\r
END\r
ELSE\r
IF Kind = cSubRange THEN\r
Static := PtrSt^.Subr_Mode = Stat\r
ELSE\r
Static := true;\r
\r
\r
\r
IF Static THEN\r
BEGIN\r
\r
\r
\r
(* Make the check *)\r
IF Kind = cSubrange THEN\r
BEGIN\r
Low := PtrSt^.Subr_Low;\r
High := PtrSt^.Subr_High;\r
END\r
ELSE\r
IF Kind = cScalar THEN\r
BEGIN\r
Low := 0;\r
High := PtrSt^.Scalar_no - 1;\r
END\r
ELSE\r
IF Kind = cBoolean THEN\r
BEGIN\r
Low := 0;\r
High := 1;\r
END;\r
\r
{$IFDEF PI3}\r
\r
Reg := ESTTop^.R;\r
\r
(* Code for Check *)\r
IF Low <> 0 THEN\r
BEGIN\r
CodeRegConst(iCMP,InstType,Reg,Low);\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
CodeJump(iJL,Lab);\r
END;\r
CodeRegConst(iCMP,InstType,Reg,High);\r
St_Declaration(CLabel,AnonymousName,ELab,Ptr);\r
IF Low <> 0 THEN\r
BEGIN\r
CodeJump(iJLE,ELab);\r
GenerateLabel(Lab);\r
END\r
ELSE\r
CodeJump(iJBE,ELab);\r
CodeFault(ErrorInt,ErrorExc);\r
GenerateLabel(ELab);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
MegaLoad(ESTTop);\r
MakeFreeReg(1);\r
\r
longlow := low;\r
longhigh := high;\r
IF (InCode = cRangeCheck) AND\r
(Longhigh = (-longlow - 1)) AND\r
(BitsInWord(-Longlow) = 1) THEN\r
BEGIN\r
CodeConst(mLDC,-Longlow ,Anonymousspix);\r
GenCode(mCWORD);\r
END\r
ELSE\r
BEGIN\r
(* Code for Check *)\r
IF LongLow <> 0 THEN\r
BEGIN\r
CodeConst(mADC,-LongLow,Anonymousspix);\r
END;\r
CodeConst(mLDC,LongHigh - Longlow + 1,Anonymousspix);\r
GenCode(mCSUB0);\r
IF (InCode = cRangeCheck) AND (LongLow <> 0) THEN\r
CodeConst(mADC,Longlow,Anonymousspix);\r
IF (InCode = cIndexCheck) THEN\r
LowerBoundIndexeq0 := true;\r
END;\r
\r
StoreStackToTemp(ESTTop);\r
{$ENDIF}\r
END\r
ELSE\r
BEGIN (* Dynamic subrange *)\r
\r
{$IFDEF RC5000}\r
PushAddr(PtrSt); (* The dopevektores address *)\r
MegaLoad(ESTTop^.Backward);\r
IF Kind = cArrayType THEN AddOffsetToAddr(ESTTop,4);\r
MegaLoad(ESTTop);\r
GenCode(mSUB);\r
ESTPop;\r
PushAddr(PtrSt);\r
IF Kind = cArrayType THEN AddOffsetToAddr(ESTTop,8)\r
ELSE AddOffsetToAddr(ESTTop,4);\r
MegaLoad(ESTTop);\r
CodeConst(mADC, 1, AnonymousSpix);\r
PushAddr(PtrSt);\r
IF Kind = cArrayType THEN AddOffsetToAddr(ESTTop,4);\r
MegaLoad(ESTTop);\r
GenCode(mSUB);\r
ESTPop;\r
GenCode(mCSUB0);\r
ESTPop;\r
IF (InCode = cRangeCheck) THEN\r
BEGIN\r
PushAddr(PtrSt);\r
IF Kind = cArrayType THEN AddOffsetToAddr(ESTTop,4);\r
MegaLoad(ESTTop);\r
GenCode(mADD);\r
ESTPop;\r
END;\r
IF (InCode = cIndexCheck) THEN\r
LowerBoundIndexeq0 := true;\r
StoreStackToTemp(ESTTop);\r
\r
\r
{$ENDIF}\r
{$IFDEF PI3}\r
\r
PushAddr(PtrSt); (* The dopevektores address *)\r
(* Code For Check *)\r
MinFreeReg := 0;\r
Loc(ESTTop,Addr);\r
ESTPop;\r
Reg := ESTTop^.R;\r
\r
(* $nocheck*)\r
IF Kind = CArrayType THEN\r
Addr.Displacement := Addr.Displacement + 2;\r
(* $Check *)\r
\r
(* Addr gives the address of lower *)\r
\r
CodeRegAddr(iCMP,InstType,Reg,Addr);\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
CodeJump(iJL,Lab);\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement + 2;\r
(* $check*)\r
\r
(* Addr gives the address of higher *)\r
\r
CodeRegAddr(iCMP,InstType,Reg,Addr);\r
St_Declaration(cLabel,AnonymousName,ELab,Ptr);\r
CodeJump(iJLE,ELab);\r
GenerateLabel(Lab);\r
CodeFault(ErrorInt,ErrorExc);\r
GenerateLabel(ELab);\r
ReleaseAddr(Addr);\r
MinFreeReg := NormalminFreeReg;\r
{$ENDIF}\r
END;\r
{$IFDEF RC3502}\r
IF Incode = cRangecheck then\r
BEGIN\r
MegaLoad(ESTTop);\r
IF static and (low = 0) THEN\r
BEGIN\r
CodeConst(rINTH0,high,anonymousspix);\r
END\r
ELSE\r
BEGIN\r
st_retrieveType(stAddr,PtrST);\r
pushaddr(ptrST);\r
ESTTop^.IndVar := false;\r
LoadAbsAddr(ESTTop);\r
ESTPop;\r
GenCode(rINTRS);\r
END;\r
END;\r
{$ENDIF}\r
END;\r
(*---------------------------------------------------------------- *)\r
\r
\r
\r
\r
\r
\r
PROCEDURE StoreRepCounter(Reg : Register; Offset : Word);\r
(* Rep Counter is given in Reg. Reg is stored in the word given by\r
offset *)\r
VAR\r
Addr : Address;\r
Ptr : St_elemptr;\r
Lab : St_Address;\r
BEGIN\r
{$IFDEF PI3}\r
MakeAddr(CurrentNiv,Offset,Addr,False);\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
CodeRegConst(iCMP,w,Reg,0);\r
CodeJump(iJGE,Lab);\r
CodeFault(StrucInt,StrucExc);\r
GenerateLabel(Lab);\r
CodeAddrReg(iAdd,w,Addr,Reg);\r
{$ENDIF}\r
END;\r
\r
PROCEDURE InsertExternalNumber(ListOfExt : St_Address);\r
(* the routine initilaize the current number for the external routines *)\r
VAR\r
i : integer;\r
Str : Ptr_String;\r
Ptr : st_elemptr;\r
BEGIN\r
{$IFDEF RC5000}\r
NoExtDecl := 0;\r
{$ENDIF}\r
FirstExtDec := ListOfExt;\r
i := NoPreExtDecl;\r
WHILE Not Equal_Addr(ListOfExt,St_NillAddr) DO\r
BEGIN\r
i := i + 1;\r
St_Retrieve(ListOfExt,Ptr);\r
ListOfExt := Ptr^.Ext_Ref;\r
St_NameOfSpix(Ptr^.Ext_Spix,Str);\r
LengthOfAllExtName := LengthOfAllExtName + Length(Str^);\r
St_Get(Ptr^.Ext_Owner,Ptr);\r
Ptr^.St_CurNo := i;\r
NoExtDecl := NoExtDecl + 1;\r
END;\r
END;\r
\r
Procedure MegaTestLoad(Ahead : Boolean);\r
VAR Size : integer;\r
Int16 : boolean;\r
rangech : boolean;\r
loadkind : (usemegaload,usemove,notload);\r
BEGIN\r
{$IFDEF RC5000}\r
St_RetrieveType(ESTTop^.OprType,Ptr);\r
Size := Ptr^.St_Size;\r
Int16 := (Ptr^.St_Kind = CSubrange) AND (Size = 2);\r
RangeCh := false;\r
\r
IF Ahead then\r
BEGIN\r
readcode;\r
LookAHead := True;\r
IF (InCode = cRangeCheck) AND Int16 THEN\r
BEGIN\r
ReadSymbol;\r
St_RetrieveType(InSymbol,Ptr);\r
IF NOT ((Ptr^.St_Kind = CSubrange) AND (Ptr^.St_Size = 2))\r
THEN\r
BEGIN\r
RangeCh := true;\r
LookAHead := false;\r
END\r
ELSE\r
ReadCode;\r
END;\r
END;\r
IF (InCode <> cEndAssign) THEN\r
BEGIN\r
IF (Int16) THEN\r
BEGIN\r
LoadInt16;\r
END\r
ELSE\r
BEGIN\r
IF Size = 1 THEN LoadKind := usemegaload\r
ELSE\r
IF (Size = 4) THEN\r
IF MegaAllign(ESTTop) THEN\r
LoadKind := usemegaload\r
ELSE\r
LoadKind := UseMove\r
ELSE\r
IF (InCode = cValueParam) AND\r
( (Size = 2) OR\r
(Size = 3)) THEN\r
IF MegaAllign(ESTTop) THEN\r
LoadKind := usemegaload\r
ELSE\r
LoadKind := UseMove\r
ELSE\r
LoadKind := NotLoad;\r
\r
\r
IF LoadKind = UseMove THEN\r
MegaMoveToTemp(ESTTop)\r
ELSE\r
IF (LoadKind = UseMegaLoad) AND\r
((ESTSort(ESTTop) = S_Stack) OR (ESTTop^.Kind = O_Temp)) AND\r
(ESTTop^.T_Address) THEN\r
BEGIN\r
MegaLoad(ESTTop);\r
StoreStackToTemp(ESTTop);\r
END;\r
END;\r
END;\r
IF Rangech then CheckRange(InSymbol,OutOfRangeInt,OutOfRangeExc);\r
{$ENDIF}\r
END;\r
«eof»