|
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: 64520 (0xfc08)
Types: TextFile
Names: »P4ESTOPR.PAS«
└─⟦037c0ce35⟧ Bits:30010524 DVBS1.SW2114.src.2.6-2 RTP compiler source SW2104+SW2114 Disk#2 30/1-92 HHA
└─⟦this⟧ »RTP\P4ESTOPR.PAS«
└─⟦828f0d3dd⟧ Bits:30010527 DVBS1.SW2114.src.2.6-5 RTP Compiler Source SW2104+SW2114 Disk 2 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\P4ESTOPR.PAS«
└─⟦891417be1⟧ Bits:30010519 DVBS1.SW2114.src.2-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\P4ESTOPR.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\P4ESTOPR.PAS«
{$O+,F+}\r
unit p4estopr;\r
interface\r
uses pscplm,mpaunit,sthunit,p4unit;\r
\r
\r
PROCEDURE Push1Operand;\r
PROCEDURE PushOperands;\r
PROCEDURE SetHighByteTo0(e : ESTelementRef);\r
PROCEDURE ReturnLengthIn( VAR Reg : Register;Ptr : St_elemptr);\r
PROCEDURE PushOperand;\r
PROCEDURE MakeAddr(Niv : integer; Offset : word;VAR Addr: Address;\r
Accesscheck : boolean) ;\r
PROCEDURE Loc(e : ESTelementRef;VAR Addr : Address);\r
\r
PROCEDURE LoadRegister(e : ESTelementRef; RegT : RegisterType;\r
Reg : Register; InstType : InstrucType);\r
PROCEDURE MakeOperationReady(VAR InstType : InstrucType;\r
VAR IntegerOpr : Boolean);\r
PROCEDURE LoadIndAddrUse(e : ESTelementRef; Reg : Register);\r
PROCEDURE LoadAddrUse(e : ESTelementRef; Reg : Register);\r
PROCEDURE AddRegToTopAddr(Reg : Register);\r
PROCEDURE LoadAddrOfTopElems;\r
PROCEDURE LoadAddr2OfTopElems;\r
PROCEDURE UpDateDSAndSP;\r
PROCEDURE PopPackedElement;\r
PROCEDURE PutPackedElement(e : ESTElementRef; Reg : Register);\r
PROCEDURE GetPackedElement(e : ESTElementRef; VAR Reg : Register);\r
\r
PROCEDURE OperationWithReg(Inst : Instruction; InstType : InstrucType);\r
PROCEDURE PushSetOnStack(TypeAddr : St_Address);\r
Procedure MakeSetOprReady;\r
PROCEDURE CMPTopelements(var neg : boolean);\r
PROCEDURE PushAddr(PtrSt : St_ElemPtr);\r
\r
\r
VAR\r
DSChanged : Boolean;\r
NewSp : Register;\r
\r
\r
\r
\r
implementation\r
uses sthcom,p4evalst,p4regadm,p4code,p486bool,p486stat;\r
\r
\r
(********************** PROCEDURE ESTOPR ****************)\r
(* This module impl. operations on the stack elements *)\r
\r
\r
(********************************************************)\r
\r
\r
PROCEDURE Push1Operand;\r
(* The element pointed to by LastOnStack.Forward is loaded onto\r
the runtimestack if it can be changed by a function call *)\r
\r
VAR\r
Kind : OperandKind;\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' START ','Push1Operand');\r
END;\r
(*ENDTEST#*)\r
\r
Kind := LastOnStack^.xForWard^.Kind;\r
\r
IF (( Kind = O_Reg) OR\r
( Kind = O_AbsAddr ) OR\r
((( Kind = O_Addr) OR (Kind = O_IndAddr)) AND \r
( LastOnStack^.xForWard^.IndVar) ))\r
THEN PushOperand\r
ELSE LastOnStack := LastOnStack^.xForWard;\r
\r
\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' SLUT ','Push1Operand');\r
END;\r
(*ENDTEST#*)\r
\r
END; (* Push1Operand *)\r
\r
\r
\r
(* ---------------------------------------------- *)\r
\r
\r
PROCEDURE PushOperands;\r
(* Every operand in EST that can be change by a function call\r
is loaded onto the runtimestack\r
The procedure can not allocated register the normal way *)\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' START ','PushOperands');\r
END;\r
(*ENDTEST#*)\r
\r
\r
MinFreeReg := 0;\r
\r
WHILE LastOnStack <> ESTTop DO Push1Operand;\r
\r
MinFreeReg := NormalMinFreeReg;\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' SLUT ','PushOperands');\r
END;\r
(*ENDTEST#*)\r
END; (* PushOperands *)\r
\r
\r
(* ---------------------------------------------- *)\r
\r
\r
PROCEDURE SetHighByteTo0(e : ESTelementRef);\r
\r
VAR\r
Reg : Register;\r
\r
BEGIN\r
IF e^.Kind <> O_Const THEN\r
BEGIN\r
LoadRegister(e,ABCDRegister,RNil,b);\r
Reg := Register(ord(e^.R) + 12);\r
CodeRegReg(iXOR,b,Reg,Reg);\r
END;\r
END;\r
\r
\r
(* ---------------------------------------------- *)\r
\r
PROCEDURE ReturnLengthIn( VAR Reg : Register;Ptr : St_elemptr);\r
(* Ptr pointes to a sth node for a dynamic type the length of the type\r
is returned in Reg *)\r
VAR\r
Addr : Address;\r
Size : word;\r
BEGIN\r
Size := Ptr^.St_Size;\r
IF is_dynamic(Ptr,Size) THEN\r
(* IF (dynamictype in Ptr^.Spec_Struct) OR\r
(Size = 0) THEN *)\r
BEGIN\r
PushAddr(Ptr);\r
Loc(ESTTop,Addr);\r
SetSourceAddr(Addr);\r
Reg := GetRegister(AllRegister,Reg);\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
ESTPop;\r
ReleaseAddr(Addr);\r
END\r
ELSE\r
BEGIN\r
Reg := GetRegister(AllRegister,Reg);\r
CodeRegConst(iMOV,w,Reg,Size);\r
END;\r
END;\r
\r
\r
(*----------------------------------------------------*)\r
\r
\r
\r
PROCEDURE PushOperand;\r
(* The next element is loaded onto the runtimestack *)\r
\r
VAR\r
Addr : Address;\r
Reg, Reg1 : Register;\r
Opr : ESTelementRef;\r
DSChanged, CXChanged : boolean;\r
Size : Word;\r
PtrST,Ptr : st_elemptr;\r
Lab : St_Address;\r
LengthInCX : Boolean;\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' START ','PushOperand');\r
END;\r
(*ENDTEST#*)\r
IF LastOnStack <> ESTTop THEN\r
BEGIN\r
\r
Opr := LastOnStack^.xForWard;\r
\r
\r
IF ESTSort(Opr) = S_Decode THEN Encode\r
ELSE\r
IF ESTSort(Opr) = S_Const THEN LoadRegister(Opr,AllRegister,Rnil,w)\r
ELSE\r
IF Opr^.IndVar THEN\r
BEGIN\r
St_RetrieveType(Opr^.OprType,PtrSt);\r
Size := PtrSt^.St_Size;\r
IF Size = 1 THEN\r
BEGIN\r
(* if length of base type 2 then set high to 0 *)\r
St_GetBaseType(opr^.OprType,PtrSt);\r
Size := PtrSt^.St_Size;\r
IF Size = 2 THEN \r
BEGIN\r
SetHighByteTo0(Opr);\r
Opr^.OprType := IntegerType;\r
END;\r
END;\r
END;\r
\r
CASE Opr^.Kind OF\r
\r
O_Reg :\r
BEGIN\r
CodeReg(iPUSH,w,Opr^.R);\r
ReleaseRegister(Opr^.R);\r
Opr^.kind := O_Stack;\r
END;\r
\r
\r
O_Addr, O_IndAddr, O_AbsAddr , O_CAddr:\r
BEGIN\r
IF Opr^.IndVar THEN\r
BEGIN\r
\r
IF (Size <= 4) AND not is_dynamic(ptrst,Size) THEN\r
BEGIN\r
(* The operand is pushed by one or two push instruction *)\r
Loc(Opr,Addr);\r
IF Size > 2 THEN\r
BEGIN\r
(* $nocheck *)\r
Addr.Displacement := Addr.Displacement + 2;\r
Addr.Spix := AnonymousSpix;\r
CodeAddr(iPUSH,w,Addr);\r
Addr.Displacement := Addr.Displacement - 2;\r
(* $check *)\r
END;\r
CodeAddr(iPUSH,w,Addr);\r
ReleaseAddr(Addr);\r
END\r
\r
ELSE \r
BEGIN (* Size > 4 or dynamic size *)\r
IF NoOfFreeReg >= 4 THEN\r
BEGIN\r
(* The operand is pushed by the instruction MOVSW *)\r
\r
IF Size = 0 THEN\r
BEGIN\r
Reg := CX;\r
ReturnLengthIn(Reg,PtrSt);\r
\r
CodeReg(iINC,w,CX);\r
CodeReg(iSHR,w,CX);\r
CodeReg(iSHL,w,CX);\r
SubRegToSP(CX);\r
CodeReg(iSHR,w,CX);\r
END\r
ELSE\r
BEGIN\r
CodeRegConst(iSUB,w,SP,Size + ord(odd(Size)));\r
GetReg(CX);\r
CodeRegConst(iMOV,w,CX,(Size + 1) DIV 2);\r
END;\r
\r
LoadAddrUse(Opr,SI);\r
\r
\r
\r
IF ((Opr^.A_Seg <> DS) AND ( Opr^.A_Seg <> SS)) THEN\r
BEGIN\r
IF ord(Opr^.A_Seg) >= Ord(ES) THEN\r
BEGIN\r
(* A Seg register *)\r
Reg := GetRegister(AllRegister,Rnil);\r
CodeRegReg(iMOV,w,Reg,Opr^.A_Seg);\r
ReleaseRegister(Opr^.A_Seg);\r
Opr^.A_Seg := Reg;\r
END;\r
\r
CodeRegReg(iMOV,w,DS,Opr^.A_Seg);\r
ReleaseRegister(Opr^.A_Seg);\r
Opr^.A_Seg := DS;\r
DSChanged := True;\r
END\r
ELSE\r
DSChanged := false;\r
\r
\r
\r
GetReg(DI);\r
GetReg(ES);\r
\r
CodeRegReg(iMOV,w,DI,SS);\r
CodeRegReg(iMOV,w,ES,DI);\r
CodeRegReg(iMOV,w,DI,SP);\r
\r
GenCode(iCLD);\r
GenCode(iREP);\r
GenCode(iMOVSW);\r
\r
\r
ReleaseRegister(ES);\r
ReleaseRegister(DI);\r
ReleaseRegister(SI);\r
ReleaseRegister(CX);\r
\r
\r
\r
IF DSChanged THEN\r
BEGIN\r
CodeRegReg(iMOV,w,DI,SS);\r
CodeRegReg(iMOV,w,DS,DI);\r
END;\r
\r
END\r
ELSE\r
BEGIN\r
(* NoOfFreeReg < 4 *)\r
(* The operand is pushed by the instructions\r
LOOP and PUSH *)\r
IF Size = 0 THEN\r
BEGIN\r
PushAddr(PtrST);\r
IF NoOfFreeReg = 2 THEN\r
BEGIN\r
Loc(ESTTop,Addr);\r
CodeAddr(iPUSH,w,Addr);\r
LengthInCX := false;\r
END\r
ELSE\r
BEGIN\r
Loc(ESTTop,Addr);\r
GetReg(CX);\r
CodeRegAddr(iMOV,w,CX,Addr);\r
LengthInCX := True;\r
CXChanged := false;\r
END;\r
ReleaseAddr(Addr);\r
ESTPop;\r
END\r
ELSE\r
LengthInCX := False;\r
\r
\r
SetSourceEST(Opr);\r
Reg := GetRegister(AddrRegister,Rnil);\r
ReleaseRegister(Reg);\r
\r
LoadAddrUse(Opr,Reg);\r
\r
\r
IF (( Opr^.A_Seg <> SS) AND ( Opr^.A_Seg <> DS)\r
AND ( NoOfFreeReg = 0) AND (LengthInCX = false))\r
THEN\r
BEGIN\r
IF ord(Opr^.A_Seg) >= ord(ES) THEN\r
BEGIN\r
(* A_Seg is a segment register *)\r
CodeReg(iPUSH,w,Opr^.A_Seg);\r
CodeReg(iPOP,w,DS);\r
END\r
ELSE\r
CodeRegReg(iMOV,w,DS,Opr^.A_Seg);\r
\r
ReleaseRegister(Opr^.A_Seg);\r
Opr^.A_Seg := DS;\r
DSChanged := true;\r
END\r
ELSE\r
DSChanged := false;\r
\r
\r
Loc(Opr,Addr);\r
\r
\r
(* The address of the object is given by Addr *)\r
\r
\r
IF LengthInCX = false THEN \r
BEGIN (* Allocate CX *)\r
IF (NoOfFreeReg = 1) AND\r
( RegInf[ES].Status = free) THEN\r
BEGIN\r
(* ES is the only free register. CX can not be \r
allocated the normal way because if must not\r
be substitueded by ES *)\r
CodeRegReg(iMOV,w,ES,CX);\r
CXChanged := true;\r
END\r
ELSE\r
BEGIN\r
GetReg(CX);\r
CXChanged := false;\r
END;\r
\r
IF Size <> 0 THEN\r
BEGIN (* Static length *)\r
CodeRegConst(iMOV,w,CX,(Size + 1) Div 2);\r
CodeRegConst(iADD,w,Reg,Size + ord(odd(Size)));\r
END\r
ELSE\r
CodeReg(iPOP,w,CX);\r
END;\r
\r
\r
IF Size = 0 THEN \r
BEGIN (* Dynamic Length *)\r
CodeReg(iINC,w,CX);\r
CodeReg(iSHR,w,CX);\r
CodeReg(iSHL,w,CX);\r
CodeRegReg(iAdd,w,Reg,CX);\r
CodeReg(iSHR,w,CX);\r
END;\r
\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
GenerateLabel(Lab);\r
\r
CodeRegConst(iSUB,w,Reg,2);\r
CodeAddr(iPUSH,w,Addr);\r
CodeJump(iLOOP,Lab);\r
\r
ReleaseAddr(Addr);\r
\r
IF DSChanged THEN\r
BEGIN\r
CodeRegReg(iMOV,w,Reg,SS);\r
CodeRegReg(iMOV,w,DS,Reg);\r
END;\r
\r
IF CXChanged THEN\r
CodeRegReg(iMOV,w,CX,ES)\r
ELSE\r
ReleaseRegister(CX);\r
\r
END;\r
END;\r
\r
\r
END\r
ELSE\r
BEGIN\r
(* IndVar = false *)\r
(* A pointer is pushed onto the stack *)\r
LoadAddrUse(Opr,Rnil);\r
\r
CodeReg(iPUSH,w,Opr^.A_Seg);\r
ReleaseRegister(Opr^.A_Seg);\r
Reg := Opr^.A_Index;\r
CodeReg(iPUSH,w,Reg);\r
ReleaseRegister(Reg);\r
END; \r
Opr^.Kind := O_Stack;\r
\r
END;\r
\r
(*OTHERWISE*) ELSE ;\r
\r
END; (* end case *)\r
\r
\r
LastOnStack := Opr;\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' SLUT ','PushOperand');\r
END;\r
(*ENDTEST#*)\r
\r
END; (* PushOperand *)\r
\r
(* ---------------------------------------------- *)\r
\r
\r
\r
\r
PROCEDURE MakeAddr(Niv : integer; Offset : word;VAR Addr: Address;\r
Accesscheck : boolean) ;\r
(* Returns an address that can be used as parameter to an\r
instruction If AccessCheck is true accesscheck is made *)\r
\r
VAR\r
Reg : Register;\r
Lab : St_Address;\r
Ptr : St_ElemPtr;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' START ','MakeAddr');\r
END;\r
(*ENDTEST#*)\r
\r
Addr.Spix := Anonymousspix;\r
\r
\r
IF Niv = Program_Level THEN\r
WITH Addr DO\r
BEGIN\r
Seg := DS;\r
Base := RNil;\r
Displacement := Offset;\r
Index := RNil;\r
END\r
ELSE\r
IF Niv = CurrentNiv THEN\r
WITH Addr DO\r
BEGIN\r
Seg := SS;\r
Base := BP;\r
Displacement := Offset;\r
Index := RNil;\r
END\r
ELSE\r
BEGIN\r
Reg := GetRegister(AddrRegister,RNil);\r
WITH Addr DO\r
BEGIN\r
Seg := SS;\r
Base := BP;\r
(* $nocheck *)\r
Displacement := - Niv * 2;\r
(* $check *)\r
Index := RNil;\r
END;\r
\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
\r
WITH Addr DO\r
BEGIN\r
Seg := DS;\r
Displacement := Offset;\r
IF Reg = BX THEN\r
BEGIN\r
Base := BX;\r
Index := RNil;\r
END\r
ELSE\r
BEGIN\r
Base := RNil;\r
Index := Reg;\r
END;\r
END;\r
END;\r
\r
\r
IF AccessCheck THEN\r
BEGIN\r
St_Declaration(CLabel,AnonymousName,Lab,Ptr);\r
(* $nocheck *)\r
Addr.Displacement := Addr.Displacement + 2;\r
(* $check *)\r
CodeAddrConst(iCMP,w,Addr,0);\r
CodeJump(iJNE, Lab);\r
CodeFault(AccessCheckInt,AccessCheckExc);\r
GenerateLabel(Lab);\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' SLUT ','MakeAddr');\r
END;\r
(*ENDTEST#*)\r
\r
\r
END; (* MakeAddr *)\r
\r
\r
\r
(* ---------------------------------------------- *)\r
\r
PROCEDURE Loc(e : ESTelementRef;VAR Addr : Address);\r
(* Can only be used if ESTSort(e) = S_Memery or S_Stack\r
The element is changed to an element of kind O_AbsAddr\r
The function makes an address and returns a\r
pointer to the address *)\r
\r
VAR\r
Reg : Register;\r
OldMinFreeReg : integer;\r
RegT : RegisterType;\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' START ','Loc');\r
END;\r
(*ENDTEST#*)\r
\r
IF e^.Par = P_Share THEN\r
BEGIN\r
e^.Par := P_Normal;\r
LoadIndAddrUse(e,RNil);\r
END;\r
\r
\r
\r
\r
\r
\r
\r
Case e^.Kind OF\r
\r
O_Addr : BEGIN\r
MakeAddr(e^.A_Niv,e^.A_Offset,Addr,False);\r
Addr.Spix := e^.Spix;\r
END;\r
\r
O_IndAddr: BEGIN\r
MakeAddr(e^.I_Niv,e^.I_Offset,Addr,e^.AccessCheck);\r
Addr.Spix := e^.Spix;\r
\r
\r
SetSourceAddr(Addr);\r
Reg := GetRegister(AddrRegister,RNil);\r
GetReg(ES);\r
ReleaseAddr(Addr);\r
\r
CodeRegAddr(iLES,w,Reg,Addr);\r
\r
WITH Addr DO\r
BEGIN\r
Spix := Anonymousspix;\r
Seg := ES;\r
Displacement := e^.I_ObjectOffset;\r
IF Reg = BX THEN\r
BEGIN\r
Base := BX;\r
Index := RNil;\r
END\r
ELSE\r
BEGIN\r
Base := RNil;\r
Index := Reg;\r
END;\r
END;\r
END;\r
\r
O_Stack : BEGIN\r
GetReg(ES);\r
Reg := GetRegister(AddrRegister,RNil);\r
\r
CodeReg(iPOP,w,Reg);\r
CodeReg(iPOP,w,ES);\r
\r
WITH Addr DO\r
BEGIN\r
Spix := Anonymousspix;\r
Seg := ES;\r
Displacement := 0;\r
IF Reg = BX THEN\r
BEGIN\r
Base := BX;\r
Index := RNil;\r
END\r
ELSE\r
BEGIN\r
Base := RNil;\r
Index := Reg;\r
END;\r
END;\r
\r
\r
END;\r
\r
O_AbsAddr: BEGIN\r
(* Seg is set to a segment register *)\r
Reg := e^.A_Seg;\r
IF ord(Reg) < Ord(ES) THEN\r
BEGIN\r
OldMinFreeReg := MinFreeReg;\r
MinFreeReg := 0;\r
GetReg(ES);\r
ReleaseRegister(Reg);\r
MinFreeReg := OldMinFreeReg;\r
\r
CodeRegReg(iMOV,w,ES,Reg);\r
e^.A_Seg := ES;\r
END;\r
\r
\r
\r
(* Index is set to a index register *)\r
Reg := e^.A_Index;\r
IF (( Reg <> SI) AND (Reg <> DI) AND\r
(Reg <> RNil)) THEN\r
BEGIN\r
IF Reg = BX THEN\r
BEGIN\r
IF e^.A_BPUsed THEN \r
CodeRegReg(iADD,w,BX,BP);\r
e^.A_BPUsed := false;\r
END\r
ELSE\r
BEGIN\r
IF e^.A_BPUsed THEN\r
RegT := IndexRegister\r
ELSE\r
RegT := AddrRegister;\r
Reg := GetRegister(RegT,RNil);\r
\r
CodeRegReg(iMOV,w,Reg,e^.A_Index);\r
ReleaseRegister(e^.A_Index);\r
e^.A_Index := Reg;\r
END;\r
END;\r
\r
\r
WITH Addr DO\r
BEGIN\r
Spix := AnonymousSpix;\r
Seg := e^.A_Seg;\r
Displacement := e^.A_Displacement;\r
IF e^.A_index <> BX THEN \r
BEGIN\r
Index := e^.A_Index;\r
Base := RNil;\r
END\r
ELSE \r
BEGIN\r
Base := BX;\r
Index := RNil;\r
END;\r
IF e^.A_BPUsed THEN Base := BP;\r
END;\r
\r
END;\r
\r
\r
\r
O_CAddr : BEGIN\r
Reg := GetRegister(AddrRegister,Rnil);\r
CodeLoadEffAddr(Reg,e^.C_Label,e^.C_ObjectOffset);\r
\r
\r
WITH Addr DO \r
BEGIN\r
Spix := Anonymousspix;\r
Seg := CS;\r
Displacement := 0;\r
IF Reg = BX THEN\r
BEGIN\r
Base := Reg;\r
Index := RNil;\r
END\r
ELSE\r
BEGIN\r
Base := RNil;\r
Index := Reg;\r
END;\r
END;\r
END;\r
\r
END; (* end case *)\r
\r
IF e^.Kind <> O_AbsAddr THEN\r
BEGIN\r
e^.Kind := O_AbsAddr;\r
e^.A_Seg := Addr.Seg;\r
e^.A_Index := Addr.Index;\r
e^.A_BPUsed := Addr.Base = BP;\r
IF Addr.Base = BX THEN e^.A_Index := BX;\r
e^.A_Displacement := Addr.Displacement;\r
END;\r
\r
IF e = LastOnStack THEN LastOnStack := e^.BackWard; \r
\r
\r
(* Update register information *)\r
RegInf[e^.A_Seg].ESTPointer := e;\r
RegInf[e^.A_Index].ESTPointer := e;\r
\r
\r
\r
\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' SLUT ','Loc');\r
END;\r
(*ENDTEST#*)\r
\r
\r
END; (* Loc *)\r
\r
\r
(* ---------------------------------------------- *)\r
\r
\r
\r
PROCEDURE LoadRegister(e : ESTelementRef; RegT : RegisterType;\r
Reg : Register; InstType : InstrucType);\r
(* The function change the element to a element of kind O_Reg\r
if instype = b : Ax, Bx, Cx, Dx is used\r
if instType = w : Ax, Bx, Cx, Dx ,Si, Di is used *)\r
\r
VAR\r
Addr : Address;\r
St_AddrRef : St_elemptr;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' START ','LoadRegister');\r
END;\r
(*ENDTEST#*)\r
\r
IF InstType = b THEN\r
BEGIN\r
IF RegT = AllRegister THEN RegT := ABCDRegister\r
ELSE\r
IF RegT = AddrRegister THEN Reg := BX;\r
END;\r
\r
CASE e^.Kind OF\r
\r
O_Addr, O_IndAddr, O_AbsAddr, O_CAddr :\r
BEGIN (* Address *)\r
Loc(e,Addr);\r
\r
SetSourceEST(e);\r
\r
Reg := GetRegister(RegT,Reg);\r
\r
CodeRegAddr(iMOV,InstType,Reg,Addr);\r
ReleaseAddr(Addr);\r
END;\r
\r
O_Stack :\r
BEGIN\r
Reg := GetRegister(RegT,Reg);\r
\r
CodeReg(iPOP,w,Reg);\r
\r
\r
END;\r
\r
O_Const :\r
BEGIN\r
Reg := GetRegister(RegT,Reg);\r
\r
\r
\r
CodeRegConst(iMOV,InstType,Reg,e^.Value);\r
END;\r
\r
\r
O_Reg : BEGIN\r
SetSource(e^.R);\r
Reg := GetRegister(RegT,Reg);\r
ReleaseRegister(e^.R);\r
IF e^.R <> Reg THEN\r
CodeRegReg(iMOV,w,Reg,e^.R);\r
END;\r
\r
END; (* END CASE *)\r
\r
(* Change e to a element of kind O_Reg *)\r
e^.Kind := O_Reg;\r
e^.R := Reg;\r
\r
\r
\r
IF e = LastOnStack THEN LastOnStack := e^.BackWard;\r
(* Update Reg Inf *)\r
RegInf[e^.R].ESTPointer := e;\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' SLUT ','LoadRegister');\r
END;\r
(*ENDTEST#*)\r
\r
\r
END; (* LoadRegister *)\r
\r
\r
(* ---------------------------------------------- *)\r
\r
\r
\r
\r
PROCEDURE MakeOperationReady(VAR InstType : InstrucType;\r
VAR IntegerOpr : Boolean);\r
(* The procedure is called before code for a operation with two\r
operands is made. The procedure makes sure that the operands\r
type is the same. IntegerOpr and InstType is initilized \r
The procedure can only be used for operands with basetype\r
integer,scalar, word or byte *)\r
\r
VAR PtrST : St_Elemptr;\r
Kind1, Kind2 : Codes;\r
LengthOfBaseType : integer;\r
\r
BEGIN\r
\r
(* Make sure that the operands have the same type *)\r
IntegerOpr := false;\r
St_GetBaseType(EstTop^.OprType,PtrST);\r
Kind1 := PtrST^.St_Kind;\r
LengthOfBaseType := PtrSt^.St_Size;\r
IF LengthOfBaseType = 1 THEN InstType := b\r
ELSE InstType := w;\r
IF (kind1 = cByte) OR (Kind1 = cWord) THEN\r
BEGIN\r
St_GetBaseType(ESTTop^.BackWard^.OprType,PtrSt);\r
Kind2 := PtrSt^.St_Kind;\r
IF Kind1 <> Kind2 THEN\r
BEGIN\r
IF Kind1 = cByte THEN\r
BEGIN\r
SetHighByteTo0(ESTTop);\r
ESTTop^.OprType := WordType;\r
InstType := w;\r
END\r
ELSE\r
BEGIN\r
(* Kind2 = cByte *)\r
SetHighByteTo0(ESTTop^.BackWard);\r
ESTTop^.BackWard^.OprType := WordType;\r
END;\r
END;\r
END\r
ELSE\r
\r
IF ((Kind1 = CInteger) OR (Kind1 = cScalar))THEN\r
BEGIN\r
IntegerOpr := True;\r
St_Retrieve(ESTTop^.OprType,PtrSt);\r
IF PtrSt^.St_Size <> LengthOfBaseType THEN\r
(* SubRange *)\r
BEGIN\r
ESTTop^.OprType := PtrSt^.TypeRef;\r
SetHighByteTo0(ESTTop);\r
ESTTop^.OprType := IntegerType;\r
InstType := w;\r
END;\r
St_Retrieve(ESTTop^.BackWard^.OprType,PtrSt);\r
IF PtrSt^.St_Size <> LengthOfBaseType THEN\r
(* SubRange *)\r
BEGIN\r
ESTTop^.BackWard^.OprType := PtrSt^.TypeRef;\r
SetHighByteTo0(ESTTop^.BackWard);\r
ESTTop^.backward^.OprType := IntegerType;\r
END;\r
END;\r
\r
\r
END;\r
\r
\r
\r
(* --------------------------------------------------------- *)\r
\r
\r
\r
\r
\r
PROCEDURE LoadIndAddrUse(e : ESTelementRef; Reg : Register);\r
(* The e element is a pointer. The procedure loads the pointer\r
IF Reg <> RNil the offset part of the address is loaded into\r
reg else it is loaded into an address register*)\r
\r
VAR\r
Addr : Address;\r
TypeAddr : st_address;\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' START ','LoadIndAddrUse');\r
END;\r
(*ENDTEST#*)\r
\r
\r
Loc(e,Addr);\r
SetSourceAddr(Addr);\r
Reg := GetRegister(AddrRegister,Reg);\r
GetReg(ES);\r
\r
CodeRegAddr(iLES,w,Reg,Addr);\r
\r
ReleaseAddr(Addr);\r
\r
WITH E^ DO\r
BEGIN\r
Spix := AnonymousSpix;\r
A_Seg := ES;\r
A_Index := Reg;\r
A_BPUsed := False;\r
A_Displacement := 0;\r
END;\r
\r
RegInf[ES].ESTPointer := e;\r
RegInf[Reg].ESTPointer := e;\r
\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' SLUT ','LoadIndAddrUse');\r
END;\r
(*ENDTEST#*)\r
\r
END;\r
\r
\r
\r
\r
\r
(* ---------------------------------------------------------- *)\r
\r
\r
\r
\r
PROCEDURE LoadAddrUse(e : ESTelementRef; Reg : Register);\r
(* The e element is an address is specified as an address. The\r
procedure loads the effectiv address into Reg. That is\r
Reg := Base + Displacement + index. e is change to an element\r
of sort AbsAddr *)\r
\r
\r
VAR\r
SegReg, Reg1 : Register;\r
Addr : Address;\r
ptr : St_Elemptr;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' START ','LoadAddrUse');\r
END;\r
(*ENDTEST#*)\r
IF e^.Par = P_Share THEN\r
BEGIN\r
e^.Par := P_Normal;\r
LoadIndAddrUse(e,Reg);\r
END;\r
\r
Case e^.Kind OF\r
\r
O_Addr : BEGIN\r
MakeAddr(e^.A_Niv,e^.A_Offset,Addr,False);\r
Addr.Spix := e^.Spix;\r
\r
SetSourceAddr(Addr);\r
Reg := GetRegister(AllRegister,Reg);\r
CodeRegAddr(iLEA,w,Reg,Addr);\r
\r
SegReg := Addr.Seg;\r
ReleaseAddr(Addr);\r
END;\r
\r
O_IndAddr: BEGIN\r
MakeAddr(e^.I_Niv,e^.I_Offset,Addr,e^.AccessCheck);\r
Addr.Spix := e^.Spix;\r
\r
\r
SetSourceAddr(Addr);\r
Reg := GetRegister(AllRegister,Reg);\r
\r
GetReg(ES);\r
ReleaseAddr(Addr);\r
\r
CodeRegAddr(iLES,w,Reg,Addr);\r
\r
IF e^.I_ObjectOffset <> 0 THEN\r
CodeRegConst(iADD,w,Reg,e^.I_ObjectOffset);\r
SegReg := ES;\r
END;\r
\r
O_Stack : BEGIN\r
Reg := GetRegister(AllRegister,Reg);\r
IF e^.IndVar THEN\r
BEGIN\r
(* return the address of stacktop an pop the element*)\r
\r
CodeRegReg(iMOV,w,Reg,SP);\r
SegReg := SS;\r
\r
\r
IF NewSP = RNil THEN\r
BEGIN\r
NewSP := GetRegister(AllRegister,RNil);\r
CodeRegReg(iMOV,w,NewSP,SP);\r
END;\r
\r
\r
St_RetrieveType(e^.OprType,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 (* dynamic type *)\r
PushAddr(Ptr);\r
Loc(ESTTop,Addr);\r
ESTPop;\r
CodeRegAddr(iADD,w,NewSP,Addr);\r
ReleaseAddr(Addr);\r
(* Make SP even *)\r
CodeReg(iINC,w,NewSP);\r
CodeReg(iSHR,w,NewSP);\r
CodeReg(iSHL,w,NewSP);\r
END\r
ELSE\r
(* Static Type *)\r
CodeRegConst(iADD,w,NewSP, Ptr^.St_Size + ord(odd(\r
Ptr^.St_Size)));\r
END\r
ELSE\r
IF NewSp = RNil THEN\r
BEGIN\r
GetReg(ES);\r
CodeReg(iPOP,w,Reg);\r
CodeReg(iPOP,w,ES);\r
\r
SegReg := ES;\r
END\r
ELSE\r
BEGIN\r
CodeRegReg(iMOV,w,Reg,NewSP);\r
With Addr do \r
BEGIN\r
Spix := AnonymousSpix;\r
Seg := SS;\r
IF Reg = BX THEN \r
BEGIN\r
Base := BX;\r
Index := RNil;\r
END\r
ELSE\r
BEGIN\r
Base := RNil;\r
Index := Reg;\r
END;\r
Displacement := 0;\r
END;\r
GetReg(ES);\r
SegReg := ES;\r
CodeRegAddr(iLES,w,Reg,Addr);\r
CodeRegConst(iADD,w,NewSp,4);\r
END;\r
\r
\r
\r
END;\r
\r
O_AbsAddr: BEGIN\r
IF (( e^.A_Displacement <> 0 ) OR\r
( e^.A_BPUsed )) THEN \r
(* Load the address by LEA *)\r
BEGIN\r
Loc(e,Addr);\r
SetSourceAddr(Addr);\r
Reg := GetRegister(AllRegister,Reg);\r
CodeRegAddr(iLEA,w,Reg,Addr);\r
ReleaseRegister(e^.A_Index);\r
END\r
ELSE\r
BEGIN\r
SetSource(e^.A_Index);\r
Reg := GetRegister(AllRegister,Reg);\r
ReleaseRegister(e^.A_Index);\r
IF e^.A_Index <> Reg THEN\r
BEGIN\r
IF e^.A_Index <> RNil THEN\r
BEGIN\r
CodeRegReg(iMOV,w,Reg,e^.A_Index);\r
END\r
ELSE\r
CodeRegReg(iXOR,w,Reg,Reg);\r
END;\r
\r
END;\r
SegReg := e^.A_Seg;\r
\r
END;\r
\r
\r
\r
O_CAddr : BEGIN\r
Reg := GetRegister(AllRegister,Reg);\r
CodeLoadEffAddr(Reg,e^.C_Label,e^.C_ObjectOffset);\r
\r
\r
SegReg := CS;\r
END;\r
\r
END; (* end case *)\r
\r
\r
\r
e^.Kind := O_AbsAddr;\r
e^.A_Seg := SegReg;\r
e^.A_BPUsed := false;\r
e^.A_Displacement := 0;\r
e^.A_Index := Reg;\r
\r
\r
IF e = LastOnStack THEN LastOnStack := e^.BackWard; \r
\r
\r
(* Update register information *)\r
RegInf[SegReg].ESTPointer := e;\r
RegInf[Reg].ESTPointer := e;\r
\r
RegInf[SegReg].Status := NotFree;\r
\r
\r
\r
\r
\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' SLUT ','LoadAddrUse');\r
END;\r
(*ENDTEST#*)\r
\r
\r
END; (* LoadAddrUse *)\r
\r
\r
\r
\r
\r
(****************************************************************)\r
\r
\r
\r
\r
PROCEDURE AddRegToTopAddr(Reg : Register);\r
(* The ESTTop element is an address . The procedure generate code\r
to add reg to the address' offset *)\r
\r
VAR\r
Addr : Address;\r
Reg1 :Register;\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' START ','AddRegToTopAddr');\r
END;\r
(*ENDTEST#*)\r
\r
IF ESTTop^.Kind <> O_AbsAddr THEN\r
BEGIN\r
loc(ESTTop,Addr);\r
END;\r
\r
ESTTop^.Spix := AnonymousSpix;\r
\r
Reg1 := ESTTop^.A_Index;\r
\r
IF Reg1 = RNil THEN\r
ESTTop^.A_Index := Reg\r
ELSE\r
\r
IF (Reg = BX) AND (ESTTop^.A_BPUsed = false) THEN\r
BEGIN\r
CodeRegReg(iADD,w,BX,Reg1);\r
ReleaseRegister(Reg1);\r
ESTTop^.A_Index := BX;\r
END\r
ELSE\r
IF (( Reg = SI) OR (DI = Reg)) THEN\r
BEGIN\r
CodeRegReg(iADD,w,Reg,Reg1);\r
ReleaseRegister(Reg1);\r
ESTTop^.A_Index := Reg;\r
END\r
ELSE\r
\r
BEGIN\r
CodeRegReg(iADD,w,Reg1,Reg);\r
ReleaseRegister(Reg);\r
END;\r
\r
\r
RegInf[ESTTop^.A_Index].ESTPointer := ESTTop;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 6 THEN\r
BEGIN\r
writeln(TestOutput,' SLUT ','AddRegToTopAddr');\r
END;\r
(*ENDTEST#*)\r
\r
END;\r
\r
\r
\r
\r
PROCEDURE LoadAddrOfTopElems;\r
(* The routine generetes code to load the address of ESTTop into ES : DI\r
and the address of ESTTop - 1 into DS : SI *)\r
\r
VAR \r
FirstOpr : ESTElementRef;\r
Reg : Register;\r
OldMinFreeReg : integer;\r
\r
BEGIN\r
NewSP := RNil;\r
LoadAddrUse(ESTTop,SI);\r
\r
\r
LoadAddrUse(ESTTop^.BackWard,DI);\r
\r
IF ((ESTTop^.A_Seg <> DS) AND\r
(ESTTop^.A_Seg <> SS)) THEN\r
BEGIN\r
(* Move A_Seg to DS *)\r
IF ord(ESTTop^.A_Seg) >= ord(ES) THEN\r
BEGIN\r
(* A_Seg is a segment register *)\r
Reg := GetRegister(AllRegister,RNil);\r
ReleaseRegister(ESTTop^.A_Seg);\r
CodeRegReg(iMOV,w,Reg,ESTTop^.A_Seg);\r
ESTTop^.A_Seg := Reg;\r
END;\r
CodeRegReg(iMOV,w,DS,ESTTop^.A_Seg);\r
ReleaseRegister(ESTTop^.A_Seg);\r
ESTTop^.A_Seg := DS;\r
DSChanged := true;\r
END\r
ELSE\r
BEGIN\r
DSChanged := false;\r
END;\r
\r
\r
(* Address of Secend (first? TOG) operand is in DS: SI *)\r
\r
FirstOpr := ESTTop^.BackWard;\r
\r
IF FirstOpr^.A_Seg <> ES THEN\r
BEGIN\r
IF ord(FirstOpr^.A_Seg) >= ord(ES) THEN\r
BEGIN\r
(* A_Seg is a segment register *)\r
Reg := GetRegister(AllRegister,RNil);\r
IF (DSChanged AND (FirstOpr^.A_Seg = DS)) THEN\r
FirstOpr^.A_Seg := SS;\r
CodeRegReg(iMOV,w,Reg,FirstOpr^.A_Seg);\r
ReleaseRegister(FirstOpr^.A_Seg);\r
FirstOpr^.A_Seg := Reg;\r
END;\r
OldMinFreeReg := MinFreeReg;\r
MinFreeReg := 0;\r
GetReg(ES);\r
MinFreeReg := OldMinFreeReg;\r
ReleaseRegister(FirstOpr^.A_Seg);\r
CodeRegReg(iMOV,w,ES,FirstOpr^.A_Seg);\r
FirstOpr^.A_Seg := ES;\r
END;\r
\r
(* Address of secend operand is in ES: DI *)\r
\r
\r
END;\r
\r
\r
PROCEDURE LoadAddr2OfTopElems;\r
(* The routine generetes code to load the address of ESTTop into DS : SI\r
and the address of ESTTop - 1 into ES : DI *)\r
\r
VAR\r
FirstOpr : ESTElementRef;\r
Reg : Register;\r
OldMinFreeReg : integer;\r
\r
BEGIN\r
NewSP := RNil;\r
LoadAddrUse(ESTTop,DI);\r
\r
\r
LoadAddrUse(ESTTop^.BackWard,SI);\r
\r
FirstOpr := ESTTop^.BackWard;\r
\r
IF ((FirstOpr^.A_Seg <> DS) AND\r
(FirstOpr^.A_Seg <> SS)) THEN\r
BEGIN\r
(* Move A_Seg to DS *)\r
IF ord(FirstOpr^.A_Seg) >= ord(ES) THEN\r
BEGIN\r
(* A_Seg is a segment register *)\r
Reg := GetRegister(AllRegister,RNil);\r
ReleaseRegister(FirstOpr^.A_Seg);\r
CodeRegReg(iMOV,w,Reg,FirstOpr^.A_Seg);\r
FirstOpr^.A_Seg := Reg;\r
END;\r
CodeRegReg(iMOV,w,DS,FirstOpr^.A_Seg);\r
ReleaseRegister(FirstOpr^.A_Seg);\r
FirstOpr^.A_Seg := DS;\r
DSChanged := true;\r
END\r
ELSE\r
BEGIN\r
DSChanged := false;\r
END;\r
\r
\r
(* Address of Second operand is in DS: SI *)\r
\r
\r
IF EstTop^.A_Seg <> ES THEN\r
BEGIN\r
IF ord(EstTop^.A_Seg) >= ord(ES) THEN\r
BEGIN\r
(* A_Seg is a segment register *)\r
Reg := GetRegister(AllRegister,RNil);\r
IF (DSChanged AND (EstTop^.A_Seg = DS)) THEN\r
EstTop^.A_Seg := SS;\r
CodeRegReg(iMOV,w,Reg,EstTop^.A_Seg);\r
ReleaseRegister(EstTop^.A_Seg);\r
EstTop^.A_Seg := Reg;\r
END;\r
OldMinFreeReg := MinFreeReg;\r
MinFreeReg := 0;\r
GetReg(ES);\r
MinFreeReg := OldMinFreeReg;\r
ReleaseRegister(EstTop^.A_Seg);\r
CodeRegReg(iMOV,w,ES,EstTop^.A_Seg);\r
EstTop^.A_Seg := ES;\r
END;\r
\r
(* Address of First operand is in ES: DI *)\r
\r
\r
END;\r
\r
\r
\r
\r
(* ------------------------------------------------------------- *)\r
PROCEDURE UpDateDSAndSP;\r
VAR\r
Reg : Register;\r
\r
BEGIN\r
IF NewSP <> RNil THEN\r
BEGIN\r
CodeRegReg(iMOV,w,SP,NewSP);\r
ReleaseRegister(NewSP);\r
NewSP := RNil;\r
END;\r
IF DsChanged THEN\r
BEGIN\r
Reg := GetRegister(AllRegister,RNil);\r
CodeRegReg(iMOV,w,Reg,SS);\r
CodeRegReg(iMOV,w,DS,Reg);\r
ReleaseRegister(Reg);\r
END;\r
END;\r
\r
\r
\r
\r
\r
\r
(* ---------------------------------------------- *)\r
\r
\r
(* the following routines has to do with packed *)\r
\r
\r
\r
PROCEDURE PopPackedElement;\r
(* The two ESTTop Elements gives an address of a packed element.\r
The two elements is poped *)\r
\r
BEGIN\r
IF ESTTop^.Kind = O_Reg THEN\r
ReleaseRegister(ESTTop^.R);\r
\r
ESTPop;\r
\r
IF ESTTop^.Kind = O_AbsAddr THEN\r
BEGIN\r
ReleaseRegister(ESTTop^.A_Seg);\r
ReleaseRegister(ESTTop^.A_Index);\r
END;\r
\r
ESTPop;\r
END;\r
\r
\r
(******************************************************************)\r
\r
\r
\r
PROCEDURE PutPackedElement(e : ESTElementRef; Reg : Register);\r
(* The two EST Elements Gives an Address of a Packed element.\r
The value in reg is inserted *)\r
VAR\r
MaskConst : word;\r
i , BitLength : integer;\r
step : word;\r
Addr : Address;\r
Reg1 : Register;\r
OldMinFreeReg : integer;\r
Ptr : St_ElemPtr;\r
Procedure swop;\r
BEGIN\r
Loc(e^.BackWard,Addr);\r
IF (ord(Reg) > ord(DX)) THEN\r
BEGIN\r
Reg1 := Reg;\r
OldMinFreeReg := MinFreeReg;\r
MinFreeReg := 0;\r
Reg := GetRegister(ABCDRegister,RNil);\r
MinFreeReg := OldMinFreeReg;\r
CodeRegReg(iMOV,w,Reg,Reg1);\r
ReleaseRegister(Reg1);\r
END;\r
CodeRegReg(iXCHG,b,Reg,register(ord(Reg) + ord(AH)));\r
CodeAddrReg(iMOV,w,Addr,Reg);\r
END;\r
\r
BEGIN\r
BitLength := e^.Bitlength;\r
IF (BitLength = 16) AND (e^.Set_Temp) THEN swop\r
ELSE\r
BEGIN\r
MaskConst := (1 SHL Bitlength) - 1;\r
\r
IF Reg = CX THEN\r
BEGIN\r
Reg := GetRegister(AllRegister,RNil);\r
CodeRegReg(iMOV,w,Reg,CX);\r
ReleaseRegister(CX);\r
END;\r
\r
IF e^.Kind <> O_Const THEN LoadRegister(e,SpecificReg,CX,w);\r
\r
\r
Loc(e^.BackWard,Addr);\r
\r
IF e^.Kind = O_Const THEN\r
BEGIN\r
(* Shift BitOffset Left *)\r
maskconst := maskconst SHL e^.Value;\r
\r
IF e^.value <> 0 THEN\r
BEGIN\r
GetReg(CX);\r
CodeRegConst(iMOV,b,CX,e^.Value);\r
CodeReg(iSHL,vw,Reg);\r
ReleaseRegister(CX);\r
END;\r
St_Retrievetype(e^.Backward^.OprType,Ptr);\r
IF (Ptr^.St_Kind = csubrange) AND\r
(Ptr^.Subr_Low > Maxint) THEN\r
CodeRegConst(iAND,w,Reg,MaskConst);\r
IF (BitLength + e^.Value) <= 8 THEN\r
CodeAddrConst(iAND,b,Addr,((-MaskConst) - 1) AND 255)\r
ELSE\r
CodeAddrConst(iAND,w,Addr,(-MaskConst) - 1);\r
END\r
ELSE\r
BEGIN\r
Reg1 := GetRegister(AllRegister,Rnil);\r
CodeRegConst(iMOV,w,Reg1,MaskConst);\r
CodeReg(iSHL,vw,Reg1);\r
CodeReg(iSHL,vw,Reg);\r
CodeRegReg(iAND,w,Reg,Reg1);\r
CodeReg(iNOT,w,Reg1);\r
CodeAddrReg(iAND,w,Addr,Reg1);\r
ReleaseRegister(Reg1);\r
END;\r
\r
CodeAddrReg(iOR,w,Addr,Reg);\r
END;\r
ReleaseRegister(Reg);\r
END;\r
\r
\r
\r
\r
\r
\r
PROCEDURE GetPackedElement(e : ESTElementRef; VAR Reg : Register);\r
(* e holding the BitOffset. E^.BackWard holding the byte offset address\r
The element is returned in Reg *)\r
VAR\r
BitLength : integer;\r
Addr : Address;\r
Ptr : St_ElemPtr;\r
OldMinFreeReg : integer;\r
Procedure swop;\r
BEGIN\r
Loc(e^.BackWard,Addr);\r
SetSourceAddr(Addr);\r
Reg := GetRegister(ABCDRegister,Rnil);\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
CodeRegReg(iXCHG,b,Reg,register(ord(Reg) + ord(AH)));\r
END;\r
\r
BEGIN\r
BitLength := e^.Bitlength;\r
IF (BitLength = 16) AND (e^.Set_Temp) THEN swop\r
ELSE\r
BEGIN\r
GetReg(CX);\r
\r
IF e^.Kind = O_Stack THEN\r
LoadRegister(e,AllRegister,rnil,w);\r
Loc(e^.BackWard,Addr);\r
IF NoOfFreeReg <= 1 (* TOG = 0 *) THEN\r
BEGIN\r
(* Can only be true when exchanges packed element *)\r
(* Use cx temp. and the push the address *)\r
CodeRegAddr(iMOV,w,CX,Addr);\r
Push1Operand;\r
Reg := GetRegister(AllRegister,RNil);\r
CodeRegReg(iMOV,w,Reg,CX);\r
END\r
ELSE\r
BEGIN\r
OldMinFreeReg := MinFreeReg;\r
MinFreeReg := 0;\r
Reg := GetRegister(AllRegister,RNil);\r
MinFreeReg := OldMinFreeReg;\r
CodeRegAddr(iMOV,w,Reg,Addr);\r
END;\r
\r
\r
IF e^.Kind = O_Const THEN\r
CodeRegConst(iMOV,b,CX,16 - e^.Value - BitLength)\r
ELSE\r
BEGIN\r
CodeRegReg(iMOV,w,CX,e^.R);\r
CodeRegConst(iSUB,b,CX,16 - BitLength);\r
CodeReg(iNEG,b,CX);\r
END;\r
\r
CodeReg(iSHL,vw,Reg);\r
CodeRegConst(iMOV,b,CX,16 - BitLength);\r
\r
St_RetrieveType(e^.BackWard^.OprType,Ptr);\r
IF (Ptr^.St_Kind = csubrange) and (Ptr^.subr_Low >= $8000 ) THEN\r
(* Sign Extent *)\r
CodeReg(iSAR,vw,Reg)\r
ELSE\r
CodeReg(iSHR,vw,Reg);\r
\r
ReleaseRegister(CX);\r
END;\r
END;\r
\r
\r
PROCEDURE OperationWithReg(Inst : Instruction; InstType : InstrucType);\r
(* The procedure generate code for Inst. Inst takes to operands\r
The first operand must be in a register *)\r
\r
VAR Reg1,reg : Register;\r
Addr : Address;\r
Value : Word;\r
TypeAddr : St_Address;\r
BEGIN\r
IF (ESTSort(ESTTop) = S_Memery) AND\r
(ESTSort(ESTTop^.BackWard) = S_Memery) THEN\r
IF (ESTTop^.Kind <> O_AbsAddr) AND\r
(ESTTop^.BackWard^.Kind = O_AbsAddr) THEN\r
LoadRegister(ESTTop^.BackWard,AllRegister,RNil,InstType)\r
ELSE\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
\r
\r
IF ESTSort(ESTTop) = S_Memery THEN\r
BEGIN\r
LoadRegister(ESTTop^.BackWard,AllRegister,RNil,InstType);\r
MinFreeReg := 0;\r
Loc(EstTop,Addr);\r
ESTPop;\r
MinFreeReg := NormalMinFreeReg;\r
CodeRegAddr(Inst,InstType,ESTTop^.R,Addr);\r
ReleaseAddr(Addr);\r
END\r
ELSE\r
IF ESTSort(ESTTop) = S_Const THEN\r
BEGIN\r
Value := ESTTop^.Value;\r
ESTPop;\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
CodeRegConst(Inst,InstType,ESTTop^.R,Value);\r
END\r
ELSE (* ESTSort(ESTTop) = S_Reg *)\r
BEGIN\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
Reg := ESTTop^.R;\r
MinFreeReg := 0;\r
ESTPop;\r
IF (( ESTSort(ESTTop) = S_Stack) OR\r
( ESTSort(ESTTop) = S_Reg)) THEN LoadRegister(ESTTop\r
,AllRegister,RNil,InstType);\r
\r
IF ESTSort(ESTTop) = S_Reg THEN\r
BEGIN\r
CodeRegReg(Inst,InstType,ESTTop^.R,Reg);\r
ReleaseRegister(Reg);\r
END\r
ELSE\r
IF ESTSort(ESTTop) = S_Memery THEN\r
BEGIN\r
Loc(ESTTop,Addr);\r
TypeAddr := ESTTop^.OprType;\r
CodeRegAddr(Inst,InstType,Reg,Addr);\r
ESTPop;\r
ReleaseAddr(Addr);\r
ESTPushReg(TypeAddr,Reg);\r
END\r
ELSE (* ESTSort(ESTTop) = S_Const *)\r
BEGIN\r
Value := ESTTop^.Value;\r
TypeAddr := ESTTop^.Oprtype;\r
CodeRegConst(Inst,InstType,Reg,Value);\r
ESTPop;\r
ESTPushReg(TypeAddr,Reg);\r
END;\r
MinFreeReg := NormalMinFreeReg;\r
END;\r
END;\r
\r
\r
(*******************************************************)\r
\r
\r
Procedure MakeSetOprReady;\r
(* The procedure generates code to push the last setoperand to a set opr. *)\r
\r
\r
BEGIN\r
ESTTop^.IndVar := False;\r
PushOperand;\r
\r
CodeRegConst(iMOV,w,AX,ord(ESTTop^.BackWard^.Set_Temp) +\r
2 * Ord(ESTTop^.Set_Temp) );\r
\r
CodeReg(iPUSH,w,AX);\r
ESTPop;\r
ESTPop;\r
END;\r
\r
\r
\r
PROCEDURE PushSetOnStack(TypeAddr : St_Address);\r
VAR\r
ptr : st_elemptr;\r
low,high : word;\r
reg : Register;\r
BEGIN\r
\r
St_RetrieveType(TypeAddr,Ptr);\r
\r
CodeRegConst(iSUB,w,SP,Ptr^.St_Size + ord(odd(Ptr^.St_Size)));\r
Low := Ptr^.Subr_Low;\r
High := Ptr^.Subr_High;\r
\r
Reg := GetRegister(AllRegister,RNil);\r
CodeRegReg(iMOV,w,Reg,SP);\r
CodeReg(iPUSH,w,SS);\r
CodeReg(iPUSH,w,Reg);\r
\r
ESTTop^.IndVar := false;\r
PushOperand;\r
CodeRegConst(iMOV,w,Reg,ord(ESTTop^.Set_Temp) * 2);\r
CodeReg(iPUSH,w,Reg);\r
ESTPop;\r
\r
CodeRegConst(iMOV,w,Reg,Low);\r
CodeReg(iPush,w,Reg);\r
CodeRegConst(iMOV,w,Reg,High);\r
CodeReg(iPUSH,w,Reg);\r
ReleaseRegister(Reg);\r
\r
CallRoutine(AnonymousSpix,AssignSet,St_Extern);\r
END;\r
\r
\r
\r
(* ---------------------------------------------------------------- *)\r
\r
PROCEDURE CMPTopelements(var neg : boolean);\r
(* The procedure generates code to compare the two topelements\r
neg is set to false if : CMP Top-1 Top\r
neg is set to true if : CMP Top Top - 1.\r
\r
Before generating the CMP instruction we must be sure there is\r
one free accumulator ( If not same code can be made between the\r
CMP instruction and the following jump instruction *)\r
\r
\r
VAR\r
Reg , TempReg : Register;\r
Addr : Address;\r
Value : word;\r
InstType : InstrucType;\r
IntegerOpr : Boolean;\r
Kind : Codes;\r
PtrSt : st_ElemPtr;\r
Length : Word;\r
Inst : Instruction;\r
FirstOpr : ESTelementRef;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 4 THEN\r
BEGIN\r
writeln(TestOutput,' START CMPTopelements');\r
END;\r
(*ENDTEST#*)\r
\r
St_RetrieveType(ESTTop^.OprType,PtrSt);\r
Length := PtrSt^.St_Size;\r
IF (Length = 1) OR (Length = 2) THEN\r
BEGIN\r
MakeOperationReady(InstType,IntegerOpr);\r
IF InstType = b THEN length := 1\r
Else length := 2;\r
END;\r
\r
\r
\r
IF ((Length = 2) or (Length = 1)) THEN\r
BEGIN\r
\r
IF (ESTSort(ESTTop) = S_Memery) AND\r
(ESTSort(ESTTop^.BackWard) = S_Memery) THEN\r
IF (ESTTop^.Kind <> O_AbsAddr) AND\r
(ESTTop^.BackWard^.Kind = O_AbsAddr) THEN\r
LoadRegister(ESTTop^.BackWard,AllRegister,RNil,InstType)\r
ELSE\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
\r
\r
\r
\r
IF ESTSort(ESTTop) = S_Memery THEN\r
BEGIN\r
Loc(ESTTop,Addr);\r
ESTPop;\r
\r
IF ESTSort(ESTTop) = S_Const THEN\r
BEGIN\r
(* To make sure that there is one free Accumulator *)\r
SetSourceAddr(Addr);\r
Reg := GetRegister(ABCDRegister,RNil);\r
ReleaseRegister(Reg);\r
\r
\r
CodeAddrConst(iCMP,InstType,Addr,ESTTop^.Value);\r
ESTPop;\r
ReleaseAddr(Addr);\r
Neg := true;\r
END\r
ELSE\r
BEGIN\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
Reg := ESTTop^.R;\r
\r
(* To make sure that there is one free Accumulator *)\r
SetSourceAddr(Addr);\r
SetSource(Reg);\r
TempReg := GetRegister(ABCDRegister,RNil);\r
ReleaseRegister(TempReg);\r
\r
CodeRegAddr(iCMP,InstType,Reg,Addr);\r
ESTPop;\r
Neg := false;\r
ReleaseRegister(Reg);\r
ReleaseAddr(Addr);\r
END;\r
END\r
\r
ELSE\r
IF ESTSort(ESTTop) = S_Const THEN\r
BEGIN\r
Value := ESTTop^.Value;\r
ESTPop;\r
\r
IF ESTSort(ESTTop) = S_Memery THEN\r
BEGIN\r
Loc(ESTTop,Addr);\r
\r
(* To make sure that there is one free Accumulator *)\r
SetSourceAddr(Addr);\r
Reg := GetRegister(ABCDRegister,RNil);\r
ReleaseRegister(Reg);\r
\r
\r
\r
ESTPop;\r
CodeAddrConst(iCMP,InstType,Addr,Value);\r
Neg := false;\r
ReleaseAddr(Addr);\r
END\r
ELSE\r
BEGIN\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
Reg := ESTTop^.R;\r
\r
(* To make sure that there is one free Accumulator *)\r
SetSource(Reg);\r
TempReg := GetRegister(AllRegister,RNil);\r
ReleaseRegister(TempReg);\r
\r
\r
CodeRegConst(iCMP,InstType,Reg,Value);\r
ESTPop;\r
Neg := False;\r
ReleaseRegister(Reg);\r
END;\r
END\r
\r
ELSE (* ESTSort(ESTTop) = S_Reg or S_Stack *)\r
BEGIN\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
Reg := ESTTop^.R;\r
ESTPop;\r
\r
IF ESTSort(ESTTop) = S_Memery THEN\r
BEGIN\r
Loc(ESTTop,Addr);\r
ESTPop;\r
\r
(* To make sure that there is one free Accumulator *)\r
SetSourceAddr(Addr);\r
SetSource(Reg);\r
TempReg := GetRegister(ABCDRegister,RNil);\r
ReleaseRegister(TempReg);\r
\r
\r
CodeAddrReg(iCMP,InstType,Addr,Reg);\r
Neg := false;\r
ReleaseRegister(Reg);\r
ReleaseAddr(Addr);\r
END\r
ELSE\r
IF ESTSort(ESTTop) = S_Const THEN\r
BEGIN\r
Value := ESTTop^.Value;\r
ESTPop;\r
\r
(* To make sure that there is one free Accumulator *)\r
SetSource(Reg);\r
TempReg := GetRegister(ABCDRegister,RNil);\r
ReleaseRegister(TempReg);\r
\r
CodeRegConst(iCMP,InstType,Reg,Value);\r
Neg := true;\r
ReleaseRegister(Reg);\r
END\r
ELSE\r
BEGIN\r
LoadRegister(ESTTop,AllRegister,RNil,InstType);\r
\r
(* To make sure that there is one free Accumulator *)\r
SetSource(ESTTop^.R);\r
SetSource(Reg);\r
TempReg := GetRegister(AllRegister,RNil);\r
ReleaseRegister(TempReg);\r
\r
\r
CodeRegReg(iCMP,InstType,ESTTop^.R,Reg);\r
Neg := false;\r
ReleaseRegister(ESTTop^.R);\r
ESTPop;\r
ReleaseRegister(Reg);\r
END;\r
\r
END;\r
END\r
\r
ELSE\r
BEGIN\r
IF (( ESTTop <> LastOnStack) AND\r
(ESTTop^.BackWard <> LastOnStack)) THEN\r
WHILE (ESTTop^.BackWard^.BackWard <> LastOnStack) DO\r
Push1Operand;\r
\r
(* Length > 2 or dynamic type *)\r
MinFreereg := 0;\r
\r
IF Length = 0 THEN\r
BEGIN\r
Reg := CX;\r
ReturnLengthIn(Reg,PtrST);\r
\r
Inst := iCMPSB;\r
END\r
ELSE\r
BEGIN\r
GetReg(CX);\r
IF ODD(Length) THEN\r
BEGIN\r
CodeRegConst(iMOV,w,CX,Length);\r
Inst := iCMPSB;\r
END\r
ELSE\r
BEGIN\r
CodeRegConst(iMOV,w,CX,Length DIV 2);\r
Inst := iCMPSW;\r
END;\r
END;\r
\r
LoadAddrOfTopElems;\r
\r
GenCode(iCLD);\r
GenCode(iREP);\r
GenCode(Inst);\r
\r
ESTPop;\r
ESTPop;\r
\r
ReleaseRegister(ES);\r
ReleaseRegister(CX);\r
ReleaseRegister(SI);\r
ReleaseRegister(DI);\r
\r
UpdateDSAndSp;\r
\r
Neg := false;\r
\r
\r
MinFreeReg := NormalMinFreeReg;\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 4 THEN\r
BEGIN\r
writeln(TestOutput,' SLUT CMPTopElements');\r
END;\r
(*ENDTEST#*)\r
\r
END;\r
\r
{$I p486eopr}\r
\r
END.\r
\r
\r
(* -------------END PROCEDURE ESTOPR -------- ESTOPR -- *)\r
\r
«eof»