|
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: 31571 (0x7b53)
Types: TextFile
Names: »RTP86P4D.PAS«
└─⟦037c0ce35⟧ Bits:30010524 DVBS1.SW2114.src.2.6-2 RTP compiler source SW2104+SW2114 Disk#2 30/1-92 HHA
└─⟦this⟧ »RTP\RTP86P4D.PAS«
└─⟦828f0d3dd⟧ Bits:30010527 DVBS1.SW2114.src.2.6-5 RTP Compiler Source SW2104+SW2114 Disk 2 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\RTP86P4D.PAS«
└─⟦891417be1⟧ Bits:30010519 DVBS1.SW2114.src.2-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\RTP86P4D.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\RTP86P4D.PAS«
\r
procedure do_clockstat;\r
BEGIN\r
ReadSymbol;\r
\r
{$IFDEF PI3}\r
\r
LoadAddrUse(ESTTop,SI);\r
Loc(ESTTop,Addr);\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement + LockedOffset;\r
(* $check*)\r
\r
CodeAddrConst(iCMP,w,Addr,$FFFF);\r
\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
CodeJump(iJNE,Lab);\r
CodeFault(LockInt,LockExc);\r
GenerateLabel(Lab);\r
\r
CodeAddr(iINC,w,Addr);\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement - LockedOffset;\r
(* $check*)\r
\r
(* Push the address of th ref variabel *)\r
CodeReg(iPUSH,w,ESTTop^.A_Seg);\r
CodeReg(iPUSH,w,SI);\r
SSTPush;\r
SSTTop^.Kind := S_Lock;\r
\r
SetSourceAddr(Addr);\r
GetReg(ES);\r
CodeRegAddr(iMOV,w,ES,Addr);\r
ReleaseAddr(Addr);\r
ESTPop;\r
\r
\r
(* ES:0 Gives the address of the buffer attribute *)\r
\r
With Addr Do\r
BEGIN\r
Spix := AnonymousSpix;\r
Seg := ES;\r
Base := RNil;\r
Index := RNil;\r
END;\r
\r
\r
Reg := GetRegister(AllRegister,RNil);\r
Addr.Displacement := OffSetOffSet;\r
\r
Reg1 := GetRegister(AllRegister,RNil);\r
IF InCode = cLockBufStat THEN\r
Addr.Displacement := DataSizeOffset\r
ELSE BEGIN\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
Addr.Displacement := TopOffset;\r
END;\r
CodeRegAddr(iMOV,w,Reg1,Addr);\r
\r
Addr.Displacement := DataPartOffset;\r
CodeRegAddr(iMOV,w,ES,Addr);\r
\r
(* Address of the buffer is : ES:0 *)\r
\r
\r
\r
St_Retrieve(InSymbol,Ptr);\r
\r
\r
TypeAddr := Ptr^.TypeRef;\r
MakeAddr(CurrentNiv,Ptr^.Var_Offset,Addr,False);\r
IF InCode = cLockBufStat THEN CodeAddrConst(iMOV,w,Addr,0)\r
ELSE CodeAddrReg(iMOV,w,Addr,Reg);\r
(* $nocheck*)\r
Addr.Displacement := Addr.Displacement + 2;\r
(* $check*)\r
CodeAddrReg(iMOV,w,Addr,ES);\r
ReleaseRegister(ES);\r
\r
\r
OldInCode:= InCode;\r
ReadCode;\r
IF InCode = CNoLocalDecl THEN\r
BEGIN\r
IF OldInCode = CLockBufStat THEN\r
BEGIN\r
{$IFDEF RTP86}\r
CodeReg(iPUSH,w,Reg1);\r
{$ENDIF}\r
END\r
ELSE\r
BEGIN (* CLockStat *)\r
{$IFDEF RTP86}\r
CodeReg(iPUSH,w,Reg);\r
CodeReg(iPUSH,w,Reg1);\r
{$ELSE}\r
CodeRegReg(iSUB,w,Reg1,Reg);\r
{$ENDIF}\r
END;\r
ReleaseRegister(Reg);\r
{$IFNDEF RTP86}\r
St_Retrieve(TypeAddr,ptr);\r
PushAddr(ptr);\r
Loc(ESTTop,Addr);\r
CodeAddrReg(iMOV,w,Addr,Reg1);\r
ReleaseAddr(Addr);\r
ESTPop;\r
{$ENDIF}\r
\r
ReleaseRegister(Reg1);\r
END ELSE\r
\r
IF InCode = CCheckSize THEN\r
BEGIN\r
IF OldInCode = CLockStat THEN\r
CodeRegReg(iSUB,w,Reg1,Reg);\r
ReleaseRegister(Reg);\r
\r
EstPushReg(WordType, Reg1);\r
ReadSymbol;\r
St_RetrieveType(InSymbol, ptr);\r
IF ptr^.st_size=0 THEN\r
BEGIN\r
Reg2 := RNil;\r
ReturnLengthIn( Reg2, ptr);\r
EstPushReg(WordType, Reg2);\r
END ELSE EstPushConst(WordType, ptr^.St_Size);\r
\r
CmpTopElements(neg);\r
St_Declaration(clabel,anonymousname,lab,ptr);\r
IF neg THEN CodeJump(iJBE,Lab)\r
ELSE CodeJump(iJAE,LAB);\r
CodeFault(WithInt,WithExc);\r
GenerateLabel(Lab);\r
END ELSE\r
BEGIN\r
ReleaseRegister(Reg);\r
ReleaseRegister(Reg1);\r
END;\r
\r
(* Call the familye *)\r
\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ReleaseStrucDyn;\r
ESTTop^.OprType := IntegerType;\r
MakeCopyOfTop;\r
ExchangeTopElements;\r
SSTPush;\r
SSTTop^.Kind := S_Lock;\r
SSTTop^.ESTLockVar := ESTTop;\r
ESTTop := ESTTop^.Backward;\r
ESTTop^.xforward := nil;\r
\r
MakeCopyOfTop;\r
\r
MakeCopyOfTop;\r
MegaLoad(ESTTop);\r
CodeConst(mEQC,0,Anonymousspix);\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
CodeJump(mCJ,Lab);\r
CodeFault(LockInt,LockExc);\r
GenerateLabel(Lab);\r
ESTPop;\r
\r
AddOffsetToAddr(ESTTop, LockedOffset);\r
MakeCopyOfTop;\r
\r
MegaLoad(ESTTop);\r
CodeConst(mADC,1,Anonymousspix);\r
MegaStore(4);\r
\r
IF (ESTTop^.Kind = O_Addr) AND (ESTTop^.A_Niv = CurrentNiv) THEN\r
BEGIN\r
MegaPointer;\r
ESTTop^.AccessCheck := false;\r
END\r
ELSE\r
BEGIN\r
MegaLoad(ESTTop);\r
ESTTop^.T_Address := true;\r
ESTTop^.T_ObjectOffset := 0;\r
ESTTop^.T_Allign := true;\r
END;\r
MakeCopyOfTop; (* pointer to header *)\r
IF Incode <> cLockBufStat THEN\r
BEGIN\r
MakeCopyOfTop;\r
AddOffsetToAddr(ESTTop,OffsetOffset);\r
MegaLoad(ESTTop);\r
MegaLoad(ESTTop^.Backward);\r
GenCode(mADD);\r
ESTPop;\r
END\r
ELSE\r
MegaLoad(ESTTop);\r
\r
\r
\r
St_Retrieve(InSymbol,Ptr);\r
\r
\r
TypeAddr := Ptr^.TypeRef;\r
Ptr^.Var_InDir := false;\r
PushAddr(Ptr);\r
Ptr^.Var_InDir := True;\r
ExchangeTopElements;\r
MegaStore(4);\r
\r
\r
OldInCode:= InCode;\r
ReadCode;\r
\r
IF InCode = CNoLocalDecl THEN\r
BEGIN\r
ESTTop^.IndVar := true;\r
IF OldInCode = CLockBufStat THEN\r
BEGIN\r
AddOffsetToAddr(ESTTop, DataSizeOffset);\r
MegaLoad(ESTTop);\r
END\r
ELSE\r
BEGIN (* CLockStat *)\r
MakeCopyOfTop;\r
AddOffsetToAddr(ESTTop,TopOffset);\r
Megaload(ESTTop);\r
ExchangeTopElements;\r
AddOffsetToAddr(ESTTop, OffsetOffset);\r
MegaLoad(ESTTop);\r
GenCode(mSUB);\r
ESTPop;\r
END;\r
St_Retrieve(TypeAddr,Ptr);\r
PushAddr(Ptr);\r
ExchangeTopElements;\r
MegaStore(4);\r
END\r
\r
ELSE\r
\r
IF InCode = CCheckSize THEN\r
BEGIN\r
ReadSymbol;\r
St_RetrieveType(InSymbol, ptr);\r
IF is_dynamic(ptr,ptr^.St_Size) THEN\r
BEGIN\r
PushAddr(Ptr);\r
END ELSE EstPushConst(WordType, ptr^.St_Size);\r
MegaLoad(ESTTop);\r
ExchangeTopElements;\r
\r
IF OldInCode = CLockBufStat THEN\r
BEGIN\r
AddOffsetToAddr(ESTTop,DataSizeOffset);\r
MegaLoad(ESTTop);\r
END\r
ELSE\r
BEGIN (* CLockStat *)\r
MakeCopyOfTop;\r
AddOffsetToAddr(ESTTop,TopOffset);\r
Megaload(ESTTop);\r
ExchangeTopElements;\r
AddOffsetToAddr(ESTTop, OffsetOffset);\r
MegaLoad(ESTTop);\r
GenCode(mSUB);\r
ESTPop;\r
END;\r
Inst := mGT;\r
CmpTopElements(Inst,false);\r
ESTPushDecode(St_NillAddr,St_NillAddr,iNil);\r
FallThruTrue;\r
CodeFault(WithInt,WithExc);\r
GenerateLabel(EstTop^.FalseLab);\r
ESTPop;\r
END\r
ELSE\r
LookAHead := true;\r
(* Call the familye *)\r
\r
{$ENDIF}\r
{$IFDEF RC3502}\r
SSTPush;\r
SSTTop^.Kind := S_Lock;\r
\r
LoadAbsAddr(ESTTop);\r
\r
ESTPop;\r
\r
OldInCode:= InCode;\r
TypeAddr := InSymbol;\r
ReadCode;\r
IF InCode = cCheckSize THEN\r
ReadSymbol;\r
\r
IF OldInCode = CLockBufStat THEN\r
BEGIN\r
IF InCode = CNoLocalDecl THEN\r
BEGIN\r
GenCode(rREVPD);\r
CodeConst(rREVSA,1,Anonymousspix);\r
CodeConst(rREVSW,MSize,Anonymousspix);\r
GenCode(rREVPW);\r
CodeConst(rUADHW,-3,Anonymousspix);\r
CodeConst(rRECHW,2,AnonymousSpix);\r
GenCode(rMUL);\r
END\r
ELSE\r
BEGIN\r
St_RetrieveType(InSymbol, ptr);\r
IF is_dynamic(ptr,ptr^.St_Size) THEN\r
BEGIN\r
PushAddr(Ptr);\r
MegaLoad(ESTTop);\r
CodeConst(rUADHW,6 + 1,AnonymousSpix);\r
CodeConst(rRECHW,2,AnonymousSpix);\r
GenCode(rDIV);\r
END\r
ELSE\r
BEGIN\r
EstPushConst(WordType, (ptr^.St_Size + 1 + 6) div 2);\r
MegaLoad(ESTTop);\r
END;\r
ESTPop;\r
END;\r
END\r
ELSE\r
BEGIN (* LockData *)\r
GenCode(rREVPD);\r
CodeConst(rREVSA,1,Anonymousspix);\r
CodeConst(rREVSD,mstart,Anonymousspix);\r
IF InCode = CNoLocalDecl THEN\r
BEGIN\r
GenCode(rREVPD);\r
CodeConst(rREVSD,MFirst,Anonymousspix);\r
CodeConst(rUADHW,1,Anonymousspix);\r
GenCode(rMSUB);\r
GenCode(rNEG);\r
END;\r
END;\r
\r
IF InCode = CNoLocalDecl THEN\r
BEGIN (* store size *)\r
St_Retrieve(TypeAddr,Ptr);\r
St_retrieve(Ptr^.TypeRef,Ptr);\r
CodeConst(rSTVLW,MegaOffset(CurrentNiv,Ptr^.Record_Addr.Offset),\r
anonymousspix);\r
END;\r
\r
IF OldInCode <> CLockBufStat THEN\r
BEGIN\r
IF InCode = CCheckSize THEN\r
BEGIN\r
CodeConst(rREVSW,MFirst,Anonymousspix);\r
St_RetrieveType(InSymbol, ptr);\r
IF is_dynamic(ptr,ptr^.St_Size) THEN\r
BEGIN\r
PushAddr(Ptr);\r
MegaLoad(ESTTop);\r
GenCode(rAdd);\r
CodeConst(rUADHW,1,AnonymousSpix);\r
ESTpop;\r
END\r
ELSE\r
BEGIN\r
CodeConst(rUADHW,ptr^.St_Size + 1 ,Anonymousspix );\r
END;\r
END\r
ELSE\r
BEGIN\r
CodeConst(rREVSW,MLast,Anonymousspix);\r
CodeConst(rUADHW,1 ,Anonymousspix );\r
END;\r
CodeConst(rRECHW,2,AnonymousSpix);\r
GenCode(rDIV);\r
END;\r
\r
St_retrieve(TypeAddr,Ptr);\r
CodeConst(rLLock,MegaOffset(CurrentNiv,Ptr^.var_Offset),\r
anonymousspix);\r
\r
GenCode(rREVPD);\r
GenCode(rLRESE);\r
\r
IF OldInCode = cLockBufStat THEN\r
BEGIN\r
CodeConst(rREVLA, MegaOffset(CurrentNiv,Ptr^.var_Offset), AnonymousSpix);\r
CodeConst(rRECHW, 6, AnonymousSpix);\r
GenCode(rUADD);\r
CodeConst(rSTVLA, MegaOffset(CurrentNiv,Ptr^.var_Offset), AnonymousSpix);\r
END ELSE\r
BEGIN\r
GenCode(rREVPD);\r
CodeConst(rREVSA, 1, AnonymousSpix);\r
CodeConst(rREVSD, MStart, AnonymousSpix);\r
CodeConst(rREVSW, MFirst, AnonymousSpix);\r
CodeConst(rREVLW, MegaOffset(CurrentNiv,Ptr^.var_Offset)+1, AnonymousSpix);\r
GenCode(rUADD);\r
CodeConst(rSTVLW, MegaOffset(CurrentNiv,Ptr^.var_Offset)+1, AnonymousSpix);\r
END;\r
CodeConst(rRESTA,0,Anonymousspix);\r
\r
{$ENDIF}\r
END;\r
\r
PROCEDURE Do_cSaveRep;\r
VAR RepIx : Integer;\r
BEGIN\r
ReadPar;\r
Value := InPar;\r
\r
ReadCode;\r
LookAHead := True;\r
{$IFDEF PI3}\r
IF InCode = cEndAssignSet THEN\r
BEGIN\r
WHILE LastOnStack <> ESTTop^.BackWard DO Push1Operand;\r
TypeAddr := ESTTop^.BackWard^.BackWard^.OprType;\r
PushSetOnStack(TypeAddr);\r
ESTPushStack(TypeAddr,True);\r
InCode := cEndAssign;\r
END;\r
\r
TypeAddr := ESTTop^.OprType;\r
St_RetrieveType(TypeAddr,Ptr);\r
Size := Ptr^.St_Size;\r
\r
IF ESTTop^.Kind = O_Stack THEN\r
BEGIN (* Last exp was a struc value *)\r
GetReg(SI);\r
CodeRegReg(IMOV,w,SI,SP);\r
IF is_dynamic(Ptr, Size) THEN\r
BEGIN\r
Reg := BX;\r
ReturnLengthIn(Reg,Ptr);\r
(* Make BX Even *)\r
CodeReg(iINC,w,BX);\r
CodeReg(iSHR,w,BX);\r
CodeReg(iSHL,w,BX);\r
END\r
ELSE\r
BEGIN\r
GetReg(BX);\r
CodeRegConst(iMOV,w,BX,Size + ord(odd(Size)));\r
END;\r
ESTpop;\r
GetReg(CX);\r
Addr.Spix := AnonymousSpix;\r
Addr.Base := BX;\r
Addr.Seg := DS;\r
Addr.Index := SI;\r
Addr.Displacement := 0;\r
IF ESTTop^.kind = O_Const THEN\r
CodeRegConst(iMOV,w,CX,ESTTop^.Value)\r
ELSE\r
BEGIN\r
CodeRegAddr(iMOV,w,CX,Addr);\r
Addr.Displacement := 2;\r
END;\r
GetReg(ES);\r
GetReg(DI);\r
CodeRegAddr(iLES,w,DI,Addr);\r
CodeRegConst(iADD,w,BX,4 + Addr.Displacement);\r
ESTPop;\r
TypeAddr1 := ESTTop^.OprType;\r
ESTpop;\r
CodeReg(iPUSH,w,BX);\r
ReleaseRegister(BX);\r
OnStack := true;\r
ESTPushAbsAddr(AnonymousSpix,TypeAddr1,false,P_normal,\r
ES,false,0,DI);\r
ESTPushReg(IntegerType,CX);\r
ESTPushAbsAddr(AnonymousSpix,TypeAddr,true,P_normal,\r
DS,false,0,SI);\r
END\r
ELSE\r
OnStack := false;\r
\r
St_RetrieveType(ESTTop^.BackWard^.OprType,PtrST);\r
IF PtrSt^.St_Size = 1 THEN SetHighByteTo0(ESTTop^.BackWard);\r
LoadRegister(ESTTop^.BackWard,specificReg,CX,w);\r
\r
(* Rep Counter in CX *)\r
StoreRepCounter(CX,Value);\r
\r
MakingAssign := False;\r
IF (Size = 0) OR (Size > 4) OR ( incode = cEndAssignString)\r
THEN AssignType := StrucAssign\r
ELSE\r
IF ( ( Size = 1) OR ( Size = 2)) THEN\r
AssignType := SimpelAssign\r
ELSE\r
AssignType := AssignByMov;\r
\r
PushReg := RNil;\r
\r
IF ESTTop^.BackWard^.BackWard^.BitLength <> 0 THEN\r
BEGIN (* Make Ready for packed assignment *)\r
LoadRegister(ESTTop,ABCDRegister,RNil,w);\r
PushReg := ESTTop^.R;\r
TypeAddr := ESTTop^.OprType;\r
ESTPop;\r
ESTPop;\r
LoadRegister(ESTTop,AllRegister,RNil,w);\r
LoadAddrUse(ESTTop^.BackWard,DI);\r
IF ESTTop^.BackWard^.A_Seg = ES THEN\r
BEGIN\r
ReleaseRegister(ES);\r
ESTTop^.BackWard^.A_Seg := DS;\r
END;\r
ESTPushReg(TypeAddr,PushReg);\r
END\r
ELSE\r
BEGIN\r
Bool := ESTTop^.IndVar; (* if false result of a function*)\r
\r
IF AssignType <> SimpelAssign THEN\r
BEGIN\r
IF Bool THEN LoadAddrUse(ESTTop,SI);\r
IF AssignType = StrucAssign THEN PushReg := SI;\r
END\r
ELSE\r
LoadRegister(ESTTop,SpecificReg,AX,w);\r
\r
LoadAddrUse(ESTTop^.BackWard^.BackWard,DI);\r
Reg := ESTTop^.A_Seg;\r
ESTPop;\r
ESTPop;\r
\r
DSIsChange := false;\r
IF AssignType = strucAssign THEN\r
BEGIN\r
IF (Reg <> DS) AND (Reg <> SS) THEN\r
BEGIN\r
ReleaseRegister(Reg);\r
IF Ord(Reg) >= Ord(ES) THEN\r
BEGIN\r
CodeRegReg(iMOV,w,AX,Reg);\r
Reg := AX;\r
END;\r
CodeRegReg(iMOV,w,DS,Reg);\r
DSIsChange := true;\r
Reg := DS;\r
END;\r
END;\r
\r
Reg1 := ESTTop^.A_Seg;\r
IF (Reg1 <> ES) AND (AssignType <> AssignByMov) THEN\r
BEGIN\r
ReleaseRegister(Reg1);\r
IF Ord(Reg1) >= Ord(ES) THEN\r
BEGIN\r
IF Reg1 = DS THEN Reg1 := SS;\r
CodeRegReg(iMOV,w,BX,Reg1);\r
Reg1 := BX;\r
END;\r
GetReg(ES);\r
CodeRegReg(iMOV,w,ES,Reg1);\r
ESTTop^.A_Seg := ES;\r
END;\r
\r
IF AssignType = SimpelAssign THEN\r
BEGIN\r
MakingAssign := true;\r
St_RetrieveType(ESTTop^.OprType,Ptr);\r
IF Ptr^.St_Size = 1 THEN Inst := iSTOSB ELSE Inst := iSTOSW;\r
\r
GenCode(iCLD);\r
GenCode(iREP);\r
GenCode(Inst);\r
ReadCode;\r
LookAhead := False;\r
ReleaseRegister(ES);\r
ReleaseRegister(AX);\r
ReleaseRegister(CX);\r
ESTTop^.A_Seg := DS;\r
END\r
ELSE\r
BEGIN\r
IF Bool THEN Reg1 := SI ELSE Reg1 := BX;\r
ESTPushAbsAddr(AnonymousSpix,TypeAddr,Bool,P_Normal,\r
Reg,False,0,Reg1);\r
END;\r
\r
END;\r
\r
IF MakingAssign = false THEN\r
BEGIN (* Everthing has been pushed ready for assignment *)\r
SSTPushLoop;\r
CodeJump(iJCXZ,SSTTop^.ExitLabel);\r
GenerateLabel(SSTTop^.ContLabel);\r
ReleaseRegister(CX);\r
CodeReg(iPUSH,w,CX);\r
IF PushReg <> RNil THEN CodeReg(iPUSH,w,PushReg);\r
END;\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF (ESTSort(ESTTop) = S_Stack) AND\r
(ESTSort(ESTTop^.Backward) = S_Stack) THEN GenCode(mREV);\r
ExchangeTopElements;\r
IF (ESTTop^.Kind <> O_StackOrTemp) AND\r
(ESTTop^.Kind <> O_Temp) THEN\r
BEGIN\r
MegaLoad(ESTTop);\r
StoreStackToTemp(ESTTop);\r
END;\r
IF (ESTTop^.Kind <> O_Temp) THEN\r
StoreTempOK(ESTTop^.T_IndexToSTL);\r
RepIx := ESTTop^.T_offset;\r
ESTPop;\r
IF ESTSort(ESTTop) = S_Stack THEN\r
BEGIN\r
StoreStackToTemp(ESTTop);\r
StoreTempOK(ESTTop^.T_IndexToSTL);\r
ESTTop^.Kind := O_Temp;\r
END;\r
IF (ESTTop^.Backward^.Kind <> O_StackOrTemp) AND\r
(ESTTop^.Backward^.Kind <> O_Temp) THEN\r
BEGIN\r
MegaMakeAddr(ESTTop^.BackWard);\r
StoreStackToTemp(ESTTop^.Backward);\r
END;\r
IF (ESTTop^.Backward^.Kind <> O_Temp) THEN\r
StoreTempOK(ESTTop^.Backward^.T_IndexToSTL);\r
ESTTop^.Backward^.Kind := O_Temp;\r
IF MegaAllign(ESTTop^.Backward) THEN\r
BEGIN\r
St_RetrieveType(ESTTop^.Backward^.OprType,Ptr);\r
IF Is_Dynamic(ptr,Ptr^.St_Size) OR\r
((Ptr^.St_Size MOD 4) <> 0) THEN\r
ESTTop^.Backward^.T_Allign := false;\r
END;\r
OldObjectOffset := ESTTop^.Backward^.T_ObjectOffset;\r
TempAddrOffset := ESTTop^.Backward^.T_Offset;\r
\r
SSTPushLoop;\r
\r
GenerateLabel(SSTTop^.ContLabel);\r
CodeConst(mLDL,RepIx,AnonymousSpix);\r
CodeConst(mLDC,0,Anonymousspix);\r
GenCode(mGT);\r
CodeJump(mCJ,SSTTop^.ExitLabel);\r
CodeConst(mLDL,RepIx,AnonymousSpix);\r
CodeConst(mADC,-1,Anonymousspix);\r
CodeConst(mSTL,RepIx,AnonymousSpix);\r
CodeConst(mLDL,MegaOffset(CurrentNiv,Value) DIV 4,AnonymousSpix);\r
CodeConst(mADC,1,Anonymousspix);\r
CodeConst(mSTL,MegaOffset(CurrentNiv,Value) DIV 4,AnonymousSpix);\r
{$ENDIF}\r
END;\r
\r
procedure do_cEndArrayInit;\r
VAR AllignLength : boolean;\r
BEGIN\r
ReadSymbol;\r
{$IFDEF PI3}\r
IF InitPointer = False THEN\r
BEGIN\r
CodeReg(iPOP,w,AX);\r
CodeReg(iPOP,w,CX);\r
CodeReg(iPOP,w,DI);\r
If InDeclPart = false THEN CodeReg(iPOP,w,ES);\r
\r
CodeRegReg(iSUB,w,CX,AX);\r
\r
CodeRegReg(iADD,w,DI,AX);\r
\r
CodeRegConst(iCMP,w,CX,0);\r
CodeJump(iJNE,SSTTop^.ContLabel);\r
GenerateLabel(SSTTop^.ExitLabel);\r
\r
\r
SSTPop;\r
END\r
ELSE\r
InitPointer := false;\r
{$ENDIF}\r
\r
{$IFDEF RC5000}\r
IF ESTTop^.Backward^.Value = 0 THEN\r
BEGIN\r
MakeCopyofTop;\r
CodeConst(mLDL,TempOffset-1,AnonymousSpix);\r
(* addr of the array fusk *)\r
IF ESTTop^.Kind = O_Const THEN\r
CodeConst(mADC,ESTTop^.Value,AnonymousSpix)\r
ELSE\r
BEGIN\r
MegaLoad(ESTTop);\r
GenCode(mADD);\r
END;\r
ESTPop;\r
CodeConst(mSTL,TempOffset-1,Anonymousspix);\r
END;\r
\r
CodeConst(mLDL,Paramindex - 1,Anonymousspix);\r
MegaLoad(ESTTop);\r
GenCode(mSUB);\r
ESTPop;\r
CodeConst(mSTL,ParamIndex - 1,Anonymousspix);\r
CodeJump(mJ,SSTTop^.ContLabel);\r
GenerateLabel(SSTTop^.EXITLabel);\r
SSTPop;\r
ParamIndex := ParamIndex - 1;\r
ESTPop;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF InStack < 2 THEN CodeConst(rRESTA,4,Anonymousspix);\r
St_Retrievetype(InSymbol,PtrSt);\r
St_Retrieve(PtrSt^.TypeRef,PtrSt);\r
allignlength := (PtrSt^.spec_struct*ShieldType35 <> []);\r
St_RetrieveType(PtrSt^.TypeRef,PtrSt);\r
IF is_Dynamic(PtrSt,PtrSt^.St_Size) THEN\r
BEGIN\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,6);\r
END\r
ELSE\r
BEGIN\r
ESTPushConst(IntegerType, PtrSt^.St_Size);\r
if (allignlength) THEN\r
If Odd(ESTTop^.Value) THEN ESTTop^.Value := ESTTop^.Value + 1;\r
END;\r
\r
MegaLoad(ESTTop);\r
Gencode(rUADD);\r
ESTPop;\r
CodeConst(rREVLW,SSTTop^.OffsetOfSize,Anonymousspix);\r
St_Retrievetype(InSymbol,PtrSt);\r
St_Retrievetype(PtrSt^.TypeRef,PtrSt);\r
IF is_Dynamic(PtrSt,PtrSt^.St_Size) THEN\r
BEGIN\r
St_Retrievetype(InSymbol,PtrSt);\r
PushAddr(PtrSt);\r
AddOffsetToAddr(ESTTop,6);\r
END\r
ELSE\r
BEGIN\r
ESTPushConst(IntegerType, PtrSt^.St_Size);\r
if (AllignLength) THEN\r
If Odd(ESTTop^.Value) THEN ESTTop^.Value := ESTTop^.Value + 1;\r
END;\r
MegaLoad(ESTTop);\r
Gencode(rUSUB);\r
ESTPop;\r
\r
CodeConst(rSTVLW,SSTTop^.OffsetOfSize,Anonymousspix);\r
CodeJump(iJMP,SSTTop^.ContLabel);\r
GenerateLabel(SSTTop^.EXITLabel);\r
SSTPop;\r
CodeConst(rSTNHB,4,Anonymousspix);\r
{$ENDIF}\r
END;\r
\r
Procedure Do_CheckParam; (* Symbol, Symbol *)\r
VAR paramsize : integer;\r
BEGIN\r
ReadSymbol;\r
St_Retrieve(InSymbol,Ptr);\r
PushAddr(Ptr);\r
ReadSymbol;\r
St_Retrieve(InSymbol,Ptr);\r
PushAddr(Ptr);\r
WHILE Ptr^.St_Node_Copy DO\r
St_Retrieve(Ptr^.St_Family_Ref,Ptr);\r
ParamSize := Ptr^.Type_ParamSize;\r
{$IFDEF PI3}\r
IF ParamSize <= 2 THEN\r
BEGIN\r
Loc(ESTTop,Addr);\r
Reg := GetRegister(AllRegister,RNil);\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
ReleaseAddr(Addr);\r
ESTPop;\r
Loc(ESTTop,Addr);\r
CodeRegAddr(iCMP,w,Reg,Addr);\r
ReleaseAddr(Addr);\r
ESTPop;\r
ReleaseRegister(Reg);\r
END\r
ELSE\r
BEGIN\r
LoadAddrOFTopElems;\r
GetReg(CX);\r
CodeRegConst(iMOV,w,CX,paramsize div 2);\r
GenCode(iCLD);\r
GenCode(iREP);\r
GenCode(iCMPSW);\r
\r
ReleaseRegister(CX);\r
ReleaseRegister(DI);\r
ReleaseRegister(SI);\r
ReleaseRegister(ES);\r
\r
UpDateDSAndSP;\r
ESTPop;\r
ESTPop;\r
END;\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
CodeJump(iJE,Lab);\r
CodeFault(CheckParamInt,CheckParamExc);\r
GenerateLabel(Lab);\r
{$ENDIF}\r
{$IFDEF RC5000}\r
IF ParamSize <= 4 THEN\r
BEGIN\r
MegaLoad(ESTTop^.Backward);\r
MegaLoad(ESTTop);\r
GenCode(mDIFF);\r
END\r
ELSE\r
BEGIN\r
MegaMakeAddr(ESTTop^.Backward);\r
IF ESTTop^.Backward^.T_ObjectOffset <> 0\r
THEN CodeConst(mADC,ESTTop^.Backward^.T_ObjectOffset, AnonymousSpix);\r
MegaMakeAddr(ESTTop);\r
IF ESTTop^.T_ObjectOffset <> 0\r
THEN CodeConst(mADC,ESTTop^.T_ObjectOffset, AnonymousSpix);\r
CodeConst(mLDC,ParamSize,Anonymousspix);\r
CallRoutine(Anonymousspix,EqRec,St_Extern);\r
CodeConst(mEQC,0,Anonymousspix);\r
END;\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
CodeJump(mCJ,Lab);\r
CodeFault(CheckParamInt,CheckParamExc);\r
GenerateLabel(Lab);\r
ESTPop;\r
ESTPop;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF ParamSize <= 2 THEN\r
BEGIN\r
ESTTop^.Backward^.IndVar := true;\r
ESTTop^.IndVar := true;\r
MegaLoad(ESTTop^.Backward);\r
MegaLoad(ESTTop);\r
GenCode(rNE);\r
END\r
ELSE\r
BEGIN\r
ESTTop^.Backward^.IndVar := false;\r
ESTTop^.IndVar := false;\r
LoadAbsAddr(ESTTop^.Backward);\r
LoadAbsAddr(ESTTop);\r
CodeConst(rRECHW,ParamSize,Anonymousspix);\r
GenCode(rSTCEA);\r
END;\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
CodeJump(rJMZEQ,Lab);\r
CodeFault(CheckParamInt,CheckParamExc);\r
GenerateLabel(Lab);\r
ESTPop;\r
ESTPop;\r
{$ENDIF}\r
END;\r
\r
PROCEDURE Do_cCompareString;\r
BEGIN\r
ReadCode;\r
{$IFDEF RC5000}\r
IF (InCode = cGE) OR (Incode = cLT) THEN\r
BEGIN\r
ExchangeTopElements;\r
IF (ESTSort(ESTTop) = S_Stack) AND\r
(ESTSort(ESTTop^.Backward) = S_Stack) THEN GenCode(mREV);\r
END;\r
{$ENDIF}\r
\r
BeforeStringOpr;\r
{$IFDEF RC5000}\r
IF (InCode = cEQ) OR (Incode = cNE) THEN\r
CallRoutine(Anonymousspix,EqStr,st_Extern)\r
ELSE\r
CallRoutine(Anonymousspix,GtStr,st_Extern);\r
\r
if (incode = cEQ) OR (Incode = cGT) OR (Incode = cLT) THEN\r
Inst := iNIL\r
ELSE\r
Inst := mEQC;\r
ESTPushDecode(St_NillAddr,St_NillAddr,Inst);\r
IF ResultMustBeEncode THEN EnCode;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
IF (InCode = cEQ) OR (Incode = cNE) THEN\r
CallRoutine(Anonymousspix,EqStr,st_Extern)\r
ELSE\r
IF (InCode = cGT) OR (Incode = cLE) THEN\r
CallRoutine(Anonymousspix,GtStr,st_Extern)\r
ELSE\r
IF (InCode = cGE) OR (Incode = cLT) THEN\r
CallRoutine(Anonymousspix,LtStr,st_Extern);\r
\r
if (incode = cLT) OR (Incode = cGT) OR (Incode = cEQ) THEN\r
Inst := rOR\r
ELSE\r
Inst := rNOT;\r
ESTPushDecode(St_NillAddr,St_NillAddr,Inst);\r
IF ResultMustBeEncode THEN EnCode;\r
{$ENDIF}\r
{$IFDEF PI3}\r
GenCode(iREP);\r
GenCode(iCMPSB);\r
St_Declaration(cLabel,AnonymousName,Lab,Ptr);\r
St_Declaration(cLabel,AnonymousName,ELab,Ptr);\r
\r
IF (incode=cEQ) OR (incode=cNE) THEN\r
BEGIN\r
CodeJump(iJNE,Lab);\r
\r
CodeRegReg(iCMP,w,DX,CX);\r
CodeJump(iJGE,ELab);\r
CodeReg(iNEG,w,DX);\r
CodeRegReg(iMOV,w,DI,SI);\r
CodeRegReg(iMOV,w,SI,DS);\r
CodeRegReg(iMOV,w,ES,SI);\r
GenerateLabel(ELab);\r
CodeRegReg(iMOV,w,CX,DX);\r
CodeRegconst(iMOV,b,AX,32);\r
GenCode(iREP);\r
GenCode(iSCASB);\r
\r
(* IF AfterStringOpr generate code Lab must always be generated\r
before this code; *)\r
IF (dsChanged) OR ( NewSp <> RNil) THEN\r
BEGIN\r
GenerateLabel(Lab);\r
Lab := St_NillAddr;\r
END;\r
\r
AfterStringOpr;\r
\r
IF InCode = cEQ THEN ESTPushDecode(Lab,St_NillAddr,iJNE)\r
ELSE ESTPushDecode(St_NillAddr,Lab,iJE);\r
\r
END ELSE (* incode not = or <> *)\r
BEGIN\r
AfterStringOpr;\r
CodeJump(iJNE,ELab);\r
CodeRegReg(iCMP,w,DX,CX); (* use that CX = 0 *)\r
CodeJump(iJLE,Lab);\r
CodeRegReg(iMOV,w,CX,DX);\r
CodeRegconst(iMOV,b,AX,32);\r
GenCode(iREP);\r
GenCode(iSCASB);\r
GenerateLabel(ELab);\r
\r
IF Incode = cLT THEN Inst := iJGE\r
ELSE IF Incode = cLE THEN Inst := iJL\r
ELSE IF Incode = cGT THEN Inst := iJGE\r
ELSE Inst := iJL;\r
\r
IF Inst = iJGE THEN\r
ESTPushDecode(Lab,St_NillAddr,Inst)\r
ELSE\r
ESTPushDecode(St_NillAddr,Lab,Inst);\r
END;\r
{$ENDIF}\r
END;\r
\r
PROCEDURE Do_cPreSet;\r
BEGIN\r
{$IFDEF PI3}\r
\r
While ESTTop^.BackWard <> LastOnStack do Push1Operand;\r
ESTTop^.IndVar := False;\r
PushOperand;\r
\r
{$ENDIF}\r
{$IFDEF RC5000}\r
ESTTop^.IndVar := False;\r
TypeAddr := ESTTop^.OprType;\r
StartCall;\r
PushSetParam;\r
{$ENDIF}\r
{$IFDEF PI3}\r
IF (InCode = cPreSetFunc) AND ( ESTTop^.Set_Temp = False) THEN\r
BEGIN\r
CallRoutine(AnonymousSpix,PushSet,St_Extern);\r
CodeReg(iPUSH,w,ES);\r
CodeReg(iPUSH,w,BX);\r
ESTTop^.Set_Temp := True;\r
END;\r
{$ENDIF}\r
{$IFDEF RC3502}\r
MakeSetOprReady;\r
(* ESTTop^.Set_Temp := True; (* FUSK *)\r
{$ENDIF}\r
END;\r
«eof»