|
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: 54627 (0xd563)
Types: TextFile
Names: »P4CODE1.PAS«
└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
└─⟦this⟧ »RTP\P4CODE1.PAS«
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\P4CODE1.PAS«
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\P4CODE1.PAS«
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
└─⟦this⟧ »P4CODE1.PAS«
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
└─⟦this⟧ »RTP\P4CODE1.PAS«
\r
\r
PROCEDURE MakeInternalLBDR(EntryPoint : St_Address;\r
LineTable : integer;\r
GlobalSize : Word;\r
Appetite : Word);\r
(* The procedure makes a Internal LBDR *)\r
\r
VAR\r
LBDR : TypeExternalLBDR;\r
i : integer;\r
\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' MakeInternalLBDR');\r
(*ENDTEST#*)\r
\r
PutCodeBuffer(0);\r
PutCodeBuffer(Ord(InternalLBDR));\r
\r
(* Put entry point *)\r
\r
WordByte.w := EntryPoint.Va_Low;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
WordByte.w := EntryPoint.Va_High;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2); \r
\r
\r
(* Put LineTable *)\r
LBDR.LineTable := LineTable;\r
\r
\r
\r
(* Put GlobalSize *)\r
LBDR.GlobalSize := GlobalSize;\r
\r
\r
\r
\r
IF (Appetite MOD 16) = 0 THEN LBDR.Appetite := Appetite DIV 16\r
ELSE LBDR.Appetite := (Appetite DIV 16) + 1;\r
(* Appetite is transfere to paragrahps *)\r
\r
FOR i := 1 TO LengthOfInternalLBDR\r
DO\r
BEGIN\r
PutCodeBuffer( LBDR.Byt[i]);\r
END;\r
\r
\r
IF ( InternalOffset > (Max_Word - LengthOfInternalLBDR)) THEN Fatal_Error(Pass4,4);\r
InternalOffset := InternalOffset + LengthOfInternalLBDR;\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' MakeInternalLBDR ');\r
(*ENDTEST#*)\r
END; (* MakeInternalLBDR *)\r
\r
\r
\r
\r
(* --------------------------------------------------- *)\r
\r
\r
PROCEDURE MakeExternalLBDR(SymbolPoint : St_Address;\r
EntryPoint : St_Address;\r
LineTable : integer;\r
GlobalSize : Word;\r
Appetite : Word;\r
BlName : SpixRange;\r
BlKind : integer);\r
(* The procedure makes a external LBDR *)\r
\r
VAR\r
LBDR : TypeExternalLBDR;\r
i : integer;\r
Str : Ptr_String;\r
ch : char;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' MakeExternalLBDR');\r
(*ENDTEST#*)\r
\r
PutCodeBuffer(0);\r
PutCodeBuffer(ord(ExternalLBDR));\r
\r
(* Put entry point *)\r
\r
WordByte.w := EntryPoint.Va_Low;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
WordByte.w := EntryPoint.Va_High;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
\r
(* Put LineTable *)\r
LBDR.LineTable := LineTable;\r
\r
\r
\r
(* Put GlobalSize *)\r
LBDR.GlobalSize := GlobalSize;\r
\r
\r
\r
IF (Appetite MOD 16) = 0 THEN LBDR.Appetite := Appetite DIV 16\r
ELSE LBDR.Appetite := (Appetite DIV 16) + 1;\r
(* Appetite is transfere to paragrahps *)\r
\r
\r
\r
\r
LBDR.LinkCount := 0;\r
LBDR.Next1 := 0;\r
LBDR.Next2 := 0;\r
\r
\r
\r
(* Put BlName *)\r
St_NameOfSpix(BlName,Str);\r
(*IF Str^.length <= 12 THEN LBDR.BlName.Length := Str^.Length\r
ELSE LBDR.BlName.Length := 12;*)\r
\r
(* TURBO *)\r
LBDR.BlName := Str^;\r
\r
FOR i := 1 TO length(LBDR.BlName) DO\r
BEGIN\r
(* transform small letters to great letters *)\r
Ch := Str^[i];\r
IF (( ord('a') <= ord(ch) ) AND (ord(ch) <= ord('z')))\r
THEN Ch := CHR(ord(ch) - ord('a') + ord('A'));\r
\r
LBDR.BlName[i] := Ch;\r
END;\r
\r
\r
FOR i := length(LBDR.BlName) + 1 TO 12 DO\r
LBDR.BLName[i] := ' ';\r
\r
\r
\r
\r
(* Put BlKind *)\r
LBDR.BlKind := BlKind;\r
\r
\r
FOR i := 1 TO LengthOfExternalLBDR\r
DO\r
BEGIN\r
CodeBuffer[BufferIndex] := LBDR.Byt[i];\r
BufferIndex := (BufferIndex + 1) MOD LengthOfCodeBuffer;;\r
END;\r
\r
NoBytesInBuffer := NoBytesInBuffer + LengthOfExternalLBDR;\r
InternalOffset := LengthOfExternalLBDR;\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' MakeExternalLBDR ');\r
(*ENDTEST#*)\r
END; (* MakeExternalLBDR *)\r
\r
\r
\r
(* -------------------------------------------------------------- *)\r
\r
\r
PROCEDURE MakeProgramDesc(ProgOffset : Word; ProgState : State;\r
PoolParam : boolean; lab : St_Address);\r
(* The procedure generate code to make the program describtion at \r
address 'Addr'. This procedure has to be change if the pi3 type\r
programdescribtion is change *)\r
\r
VAR\r
Str : Ptr_String;\r
Ch : Char;\r
Str12 : String[12];\r
i : integer;\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' MakeProgramDesc ');\r
(*ENDTEST#*)\r
\r
IF ProgState = Internal THEN\r
(* Make the buffer empty *)\r
MakeFreeCodeBuffer(LengthOfCodeBuffer);\r
\r
\r
\r
\r
(* Generate code to push the parameter to init_internal or\r
init_external *)\r
\r
CodeReg(iPUSH,w,DS);\r
\r
CodeRegConst(iMOV,w,AX,ProgOffset);\r
CodeReg(iPUSH,w,AX);\r
\r
CodeRegConst(iMOV,w,AX,ord(PoolParam));\r
CodeReg(iPUSH,w,AX);\r
\r
IF ProgState = Internal THEN\r
BEGIN\r
CodeReg(iPUSH,w,CS);\r
CodeRegConst(iMOV,w,AX,LastInternalLBDROffset);\r
CodeReg(iPUSH,w,AX);\r
\r
(* push a pointer to the name *)\r
CodeReg(iPUSH,w,CS);\r
CodeLoadEffAddr(AX,Lab,0); \r
CodeReg(iPUSH,w,AX);\r
\r
\r
\r
\r
CallRoutine(AnonymousSpix,Init_Internal,St_extern);\r
END\r
ELSE\r
CallRoutine(AnonymousSpix,Init_External,St_Extern);\r
\r
\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' MakeProgramDesc ');\r
(*ENDTEST#*)\r
END; (* MakeProgramDesc *)\r
\r
(* ------------------------------------------------------------- *)\r
\r
\r
\r
\r
PROCEDURE StopBlock;\r
(* The procedure is called when there is no more code for\r
the block. The procedure makes the <Object Block> for the block\r
That is the secound pass is made *)\r
\r
BEGIN (* StopBlock *)\r
\r
DumpFaultThunk;\r
InitFaultInfo;\r
\r
MakeFreeCodeBuffer(LengthOfCodeBuffer);\r
\r
EmptyFileBuffer;\r
\r
(* Make <object block > for the block *)\r
\r
reset(TBinFile,1);\r
IF Make_Code THEN reset(TSymFile);\r
\r
\r
\r
MakePass4_2(FileOffset);\r
\r
\r
\r
(* Make ready to the next block *)\r
\r
\r
rewrite(TBinFile,1);\r
IF Make_Code THEN rewrite(TSymFile);\r
\r
\r
InternalOffset := 0;\r
FileOffset := 0;\r
\r
LastJmpOffset := 0;\r
LastLabelOffset := 0;\r
\r
LengthOfAllExtName := 0;\r
NoExtDecl := 0;\r
FirstExtDec := St_NillAddr;\r
\r
FirstFixUpp := St_NillAddr;\r
NoFixUpp := 0;\r
LastFixUpp := St_NillAddr;\r
\r
LastNameEntry := St_NillAddr;\r
LengthOfNameTabel := 2;\r
\r
END; (* StopBlock *)\r
\r
\r
\r
(* ---------------------------------------------------------- *)\r
\r
\r
\r
\r
\r
PROCEDURE StopCodeGene;\r
(* The procedure is called when where is no more code to be\r
generated. *)\r
\r
VAR step : word;\r
checksum : word;\r
\r
BEGIN (* StopCodeGene *)\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' StopCodeGene');\r
(*ENDTEST#*)\r
\r
\r
\r
WriteEmptyRecord(Lastrc);\r
\r
\r
(* insert segdef for segnumber 2... lastsegment *)\r
For step := 2 to Last_Segment do\r
BEGIN\r
wordbyte.w := Segment_Info[step].Size;\r
Files_Abs_Write(FilePtrToSecSegDef,WordByte.byte1);\r
FilePtrToSecSegDef := FilePtrToSecSegDef + 1;\r
Files_Abs_Write(FilePtrToSecSegDef,WordByte.byte2);\r
FilePtrToSecSegDef := FilePtrToSecSegDef + 1;\r
Checksum := ($98 + 3 + WordByte.Byte1 + WordByte.Byte2)\r
MOD MaxByte;\r
CheckSum := MaxByte - CheckSum;\r
Files_Abs_Write(FilePtrToSecSegDef,CheckSum);\r
FilePtrToSecSegDef := FilePtrToSecSegDef + 4;\r
END;\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' StopCodeGene');\r
(*ENDTEST#*)\r
END; (* StopCodeGene *)\r
\r
\r
\r
\r
(*-------------------------------------------------------- *)\r
\r
\r
\r
PROCEDURE GenCode(Inst : Instruction);\r
(* Generate a instruction without parameter *)\r
\r
VAR\r
op : Byte;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' GenCode ', ord(Inst));\r
(*ENDTEST#*)\r
\r
op := OpcodeNoOpr[Inst];\r
\r
\r
(* Put to code buffer *)\r
Put1CodeFormat(op);\r
\r
(* Print to TSymFile *)\r
IF CodeOn THEN writeln(TSymFile,InstructionName[Inst]);\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' GenCode ');\r
(*ENDTEST#*)\r
END; (* GenCode *)\r
\r
\r
(* ---------------------------------------------------- *)\r
\r
\r
PROCEDURE CodeConst(Inst : Instruction; Value : Word );\r
(* Generate a instruction with a constant parametre *)\r
\r
VAR\r
op : Byte;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' CodeConst ', ord(Inst),' '\r
, Value);\r
(*ENDTEST#*)\r
\r
op := OpcodeCOpr[Inst];\r
\r
\r
IF (( Inst = iRETWS) OR ( INST = iRETIS )) THEN\r
BEGIN (* a word constant *)\r
WordByte.w := Value;\r
Put3CodeFormat(op,WordByte.Byte1,WordByte.Byte2);\r
END\r
ELSE\r
BEGIN (* a byte constant *)\r
Put2CodeFormat(op,Value);\r
END;\r
\r
(* Print to TSymFile *)\r
IF CodeOn THEN\r
BEGIN\r
write(TSymFile,InstructionName[Inst]);\r
writeln(TSymFile,' ',Value);\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeConst');\r
(*ENDTEST#*)\r
END; (* CodeConst *)\r
\r
\r
(* ----------------------------------------------------*)\r
\r
\r
\r
PROCEDURE CodeAddr(Inst : Instruction; InstType : InstrucType;\r
VAR a : Address);\r
(* Generate a instruction with a address as parametre *)\r
\r
VAR\r
op : Byte;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' CodeAddr ',ord(Inst),' ',\r
ord(InstType));\r
(*ENDTEST#*)\r
\r
op := OpcodeR_M[Inst];\r
IF ((Inst <> iPUSH) AND (Inst <> iPOP)) THEN\r
op := op + ord(InstType);\r
\r
PutR_MOperand(op, a, OpcodeCRegField[Inst]);\r
\r
(* Print to TSymFile *)\r
IF CodeOn THEN\r
BEGIN\r
write(TSymFile,InstructionName[Inst]);\r
PrintAddr(a);\r
writeln(TSymFile);\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeAddr');\r
(*ENDTEST#*)\r
END; (* CodeAddr *)\r
\r
\r
(* ---------------------------------------------------- *)\r
\r
\r
PROCEDURE CodeReg(Inst : Instruction; InstType : InstrucType;\r
r : Register );\r
(* Generate a instruction with a register as parametre *)\r
\r
VAR\r
op : Byte;\r
x : Byte;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' CodeReg ', ord(Inst),' ',\r
ord(InstType),' ', ord(r));\r
(*ENDTEST#*)\r
\r
IF (( ord(ES) <= ord(r)) AND ( ord(r) <= ord(DS) )) THEN\r
BEGIN (* r is a seg register. Inst is push or pop *)\r
op := OpcodeSROpr[Inst];\r
PackField(op,3,ord(r) - ord(ES));\r
\r
Put1CodeFormat(op);\r
END\r
ELSE\r
IF (( ord(iPUSH) <= ord(Inst)) AND ( ord(Inst) <= ord(iDEC))\r
AND ( InstType <> b ))\r
THEN\r
BEGIN (* Register packed into opcode *)\r
op := OpcodeRegOpr[Inst];\r
PackField(op, 0, RegField(r));\r
\r
Put1CodeFormat(op);\r
END\r
ELSE\r
BEGIN (* operand of R_M type *)\r
op := OpcodeR_M[Inst] + ord(InstType);;\r
\r
x := RegField(r);\r
PackField(x, 6, 3); (* Register mode *)\r
PackField(x, 3, OpcodeCRegField[Inst]);\r
\r
Put2CodeFormat(op,x);\r
END;\r
\r
(* Print to TSymFile *)\r
IF CodeOn THEN\r
BEGIN\r
write(TSymFile, InstructionName[Inst]);\r
PrintReg(r, InstType);\r
IF ((InstType = vb) OR (InstType = vw)) THEN\r
write(TSymFile,', CX');\r
writeln(TSymFile);\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeReg ');\r
(*ENDTEST#*)\r
END; (* CodeReg *)\r
\r
\r
(* ---------------------------------------------- *)\r
\r
\r
\r
\r
PROCEDURE CodeAddrConst(Inst : Instruction; InstType : InstrucType;\r
VAR a : Address; Value : Word );\r
(* Generate a instruction with a address as the first parametre\r
and a constant as the secend parametre *)\r
\r
VAR\r
op : Byte;\r
help : InstrucType;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' CodeAddrConst ', ord(Inst),\r
' ',ord(InstType), ' ',Value);\r
(*ENDTEST#*)\r
\r
op := OpcodeR_MandConst[Inst] + ord(InstType);\r
help := InstType;\r
\r
wordbyte.w := value;\r
\r
IF (( InstType = w ) AND (-128 <= wordbyte.i) AND (wordbyte.i <= 127)\r
AND ( ord(iADD) <= ord(Inst)) AND (ord(Inst) <= ord(iCMP)))\r
THEN\r
BEGIN (* sign extente *)\r
PackField(op, 1, 1);\r
help := b;\r
END;\r
\r
PutR_MOprandConst(op, a, OpcodeCRegField[Inst],\r
help, Value);\r
\r
(* Print to TSymFile *)\r
IF CodeOn THEN\r
BEGIN\r
write(TSymFile,InstructionName[Inst]);\r
PrintAddr(a);\r
write(TSymFile,',');\r
writeln(TSymFile,' ',value);\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeAddrConst ');\r
(*ENDTEST#*)\r
END; (* CodeAddrConst *)\r
\r
\r
(* ----------------------------------------------------- *)\r
\r
\r
\r
\r
PROCEDURE CodeAddrReg(Inst : Instruction; InstType : InstrucType;\r
VAR a : Address; r : Register );\r
(* Generate a instruction with an address as first parametre\r
and an register as secend parameter *)\r
\r
VAR \r
op : Byte;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' CodeAddrReg ', ord(Inst),' ',\r
ord(InstType),' ', ord(r));\r
(*ENDTEST#*)\r
\r
IF ( (ord(ES) <= ord(r)) AND\r
(ord(r) <= ord(DS)) AND\r
(Inst = iMOV)) THEN\r
BEGIN\r
op := OpcodeMovSegToR_M;\r
PutR_MOperand(op,a,ord(r) - ord(ES));\r
END\r
ELSE\r
BEGIN\r
op := OpcodeR_M[Inst] + ord(InstType);\r
\r
(* direction = 0 *)\r
\r
\r
PutR_MOperand(op, a, RegField(r));\r
END;\r
\r
(* Print to TSymFile *)\r
IF CodeOn THEN\r
BEGIN\r
write(TSymFile, InstructionName[Inst]);\r
PrintAddr(a);\r
write(TSymFile,',');\r
PrintReg(r, InstType);\r
writeln(TSymFile);\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeAddrReg ');\r
(*ENDTEST#*)\r
END; (* CodeAddrReg *)\r
\r
\r
(*-------------------------------------------------------- *)\r
\r
\r
\r
PROCEDURE CodeRegAddr(Inst : InStruction; InstType : InstrucType;\r
r : Register; VAR a : Address );\r
(* Generate a instruction with a register as first parametre\r
and an adddress as secend parametre *)\r
\r
VAR \r
op : Byte;\r
SegReg : Register;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' CodeRegAddr ', ord(Inst),\r
' ',ord(InstType),' ',ord(r));\r
(*ENDTEST#*)\r
\r
IF ( (ord(ES) <= ord(r)) AND\r
(ord(r) <= ord(DS)) AND\r
(Inst = iMOV)) THEN\r
BEGIN\r
op := OpcodeMovR_MToSeg;\r
PutR_MOperand(op,a,ord(r) - ord(ES));\r
END\r
ELSE\r
BEGIN\r
op := OpcodeR_M[Inst];\r
\r
IF (( Inst <> iLEA) AND\r
( Inst <> iLDS) AND\r
( Inst <> iLES)) THEN\r
BEGIN\r
op := op + ord(InstType);\r
\r
\r
(* direction = 1 *)\r
IF Inst <> iXCHG THEN PackField(op,1,1);\r
END;\r
\r
IF Inst = iLEA THEN\r
BEGIN (* need not be prefixed *)\r
SegReg := a.Seg;\r
a.Seg := SS; \r
END;\r
PutR_MOperand(op, a, RegField(r));\r
END;\r
\r
(* Print to TSymFile *)\r
IF CodeOn THEN\r
BEGIN\r
write(TSymFile, InstructionName[Inst]);\r
PrintReg(r, InstType);\r
write(TSymFile,' ,');\r
PrintAddr(a);\r
writeln(TSymFile);\r
END;\r
\r
IF Inst = iLEA THEN a.Seg := SegReg;\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeRegAddr ');\r
(*ENDTEST#*)\r
END; (* CodeRegAddr *)\r
\r
\r
(* ------------------------------------------------ *)\r
\r
\r
\r
PROCEDURE CodeRegConst(Inst : Instruction; InstType : InstrucType;\r
r : Register; Value : Word );\r
(* Generate a instruction with a register as the first\r
parametre and a constant as the secend parametre *)\r
\r
VAR\r
op : Byte;\r
length : integer;\r
help : InstrucType;\r
Reg : Byte;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' CodeRegConst ', ord(Inst),\r
' ',ord(InstType),' ',ord(r),' ',Value);\r
(*ENDTEST#*)\r
\r
IF (( INST <> iMOV ) AND ( r = AX )) \r
THEN\r
BEGIN (* Immediate to accumulator *)\r
op := OpcodeConstandAcc[Inst] + ord(InstType);\r
\r
(* Put to Codebuffer *)\r
IF InstType = w\r
THEN (* word constant *)\r
BEGIN\r
WordByte.w := Value;\r
Put3CodeFormat(op,WordByte.Byte1,WordByte.Byte2);\r
END\r
ELSE (* byte constant *)\r
BEGIN\r
Put2CodeFormat(op,Value);\r
END\r
END\r
ELSE\r
IF iMOV = Inst\r
THEN\r
BEGIN (* Move Immediate to register *)\r
op := OpcodeMovImmToReg;\r
PackField(op, 0, RegField(r));\r
IF InstType = w THEN\r
BEGIN\r
PackField(op,3,1);\r
WordByte.i := Value;\r
Put3CodeFormat(op,WordByte.Byte1,WordByte.Byte2);\r
END\r
ELSE\r
BEGIN\r
PackField(op,3,0);\r
Put2CodeFormat(op,Value);\r
END;\r
\r
END\r
ELSE \r
BEGIN\r
op := OpcodeR_MAndConst[Inst] + ord(InstType);\r
help := InstType;\r
\r
wordbyte.w := Value;\r
IF (( InstType = w ) AND (-128 <= wordbyte.i ) AND( wordbyte.i <= 127) AND\r
( ord(iADD) <= ord(Inst)) AND (ord(Inst) <= ord(iCMP)))\r
THEN\r
BEGIN (* Sign extension *)\r
PackField(op,1,1);\r
help := b;\r
END;\r
\r
Reg := RegField(r);\r
PackField(Reg, 3, OpcodeCRegField[Inst]);\r
PackField(Reg, 6, 3); (* register mode *)\r
\r
IF help = b \r
THEN\r
BEGIN (* Byte constant *)\r
Put3CodeFormat(op,Reg,Value);\r
END\r
ELSE\r
BEGIN (* word constant *)\r
Put4CodeFormat(op, Reg, WordByte.Byte1,WordByte.Byte2);\r
END;\r
END;\r
\r
(* Print to TSymFile *)\r
IF CodeOn THEN\r
BEGIN\r
write(TSymFile, InstructionName[Inst]);\r
PrintReg(r,InstType);\r
writeln(TSymFile,' , ',Value);\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeRegConst ');\r
(*ENDTEST#*)\r
END; (* CodeRegConst *)\r
\r
\r
(* -------------------------------------------------------- *)\r
\r
\r
PROCEDURE CodeRegReg(Inst : Instruction; InstType : InstrucType;\r
r1, r2 : Register );\r
(* Generate a instruction where both parametres are registers *)\r
\r
VAR\r
op : Byte;\r
x : Byte;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' CodeRegReg ', ord(Inst),' ',\r
ord(InstType),' ',ord(r1),' ',ord(r2));\r
(*ENDTEST#*)\r
\r
\r
IF ( (ord(ES) <= ord(r1)) AND\r
(ord(r1) <= ord(DS)) AND\r
(Inst = iMOV)) THEN\r
BEGIN\r
op := OpcodeMovR_MToSeg;\r
IF ( (ord(ES) <= ord(r2)) AND\r
(ord(r2) <= ord(DS))) THEN\r
Fatal_Error(Pass4,7)\r
ELSE\r
BEGIN\r
x := RegField(r2);\r
PackField(x,6,3);\r
PackField(x,3,ord(r1) - ord(ES));\r
END;\r
END\r
ELSE\r
IF ( (ord(ES) <= ord(r2)) AND\r
(ord(r2) <= ord(DS)) AND\r
(Inst = iMOV)) THEN\r
BEGIN\r
op := OpcodeMovSegToR_M;\r
IF ( (ord(ES) <= ord(r1)) AND\r
(ord(r1) <= ord(DS))) THEN\r
Fatal_Error(Pass4,7)\r
ELSE\r
BEGIN\r
x := RegField(r1);\r
PackField(x,6,3);\r
PackField(x,3,ord(r2) - ord(ES));\r
END;\r
END\r
ELSE\r
BEGIN\r
op := OpcodeR_M[Inst] + ord(InstType);\r
\r
x := RegField(r1);\r
PackField(x, 6, 3); (* Register mode *)\r
PackField(x, 3, RegField(r2));\r
END;\r
\r
\r
Put2CodeFormat(op,x);\r
\r
\r
(* Print to TSymFile *)\r
IF CodeOn THEN\r
BEGIN\r
write(TSymFile, InstructionName[Inst]);\r
PrintReg(r1,InstType);\r
write(TSymFile,' ,');\r
PrintReg(r2,InstType);\r
writeln(TSymFile);\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeRegReg ');\r
(*ENDTEST#*)\r
END; (* CodeRegReg *)\r
\r
\r
(* ------------------------------------------------------------- *)\r
\r
\r
\r
PROCEDURE CallRoutine(Spix : SpixRange; Number : Word;\r
RKind : St_DeclareMode);\r
(* The procedure generates code for an external or an open routine call*)\r
\r
VAR\r
i :integer;\r
Index, LastIndex , Leng,codelength : Word;\r
dump_symcode: boolean;\r
Str : Ptr_String;\r
BEGIN\r
IF CodeOn THEN\r
BEGIN\r
IF RKind <> St_Open THEN\r
BEGIN\r
IF RKind = St_Jump\r
THEN write(TSymFile,InstructionName[iJMP])\r
ELSE write(TSymFile,InstructionName[iCall]);\r
END\r
ELSE write(TSymFile,'////');\r
IF Spix = AnonymousSpix THEN Spix := PreExtName[Number];\r
\r
St_NameOfSpix(Spix,Str);\r
FOR i := 1 TO length(Str^) DO\r
write(TSymFile,Str^[i]);\r
write(TSymfile,' ');\r
if RKind <> St_open Then writeln(TSymFile);\r
\r
END;\r
\r
IF (RKind = St_Extern) OR (RKind = St_Jump) THEN\r
BEGIN\r
(* an external routine call *)\r
if Number <= noofPI3Routines then\r
PreExtCalled[Number] := true;\r
PutCodeBuffer(0);\r
IF RKind = St_Extern THEN PutCodeBuffer(ord(ExternalCall))\r
ELSE PutCodeBuffer(ord(ExternalJump));\r
wordbyte.w := Number;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
IF ( InternalOffset > (Max_Word - 5)) THEN\r
Fatal_Error(Pass4,4);\r
\r
InternalOffset := InternalOffset + 5;\r
\r
END\r
\r
ELSE\r
(* An open routine call *)\r
BEGIN\r
dump_symcode:= false;\r
WordByte.Byte1 := CodeOfOpenRoutines[(Number * 2) + 2];\r
WordByte.Byte2 := CodeOfOpenRoutines[(Number * 2) + 3];\r
Index := WordByte.w + 2;\r
\r
(* The index to the open routines length is in Index *)\r
\r
WordByte.Byte1 := CodeOfOpenRoutines[Index];\r
WordByte.Byte2 := CodeOfOpenRoutines[Index + 1];\r
\r
LastIndex := Index + WordByte.w - 1;\r
\r
Index := Index + 2;\r
WHILE Index <= LastIndex DO\r
\r
BEGIN\r
WordByte.Byte1 := CodeOfOpenRoutines[Index];\r
WordByte.Byte2 := CodeOfOpenRoutines[Index + 1];\r
Index:= Index+2;\r
leng := WordByte.w;\r
\r
if leng>0 then begin\r
IF dump_symcode THEN\r
BEGIN\r
write(TSymFile,'////');\r
writeln(TSymFile);\r
END\r
else\r
if CodeOn then\r
writeln(TSymFile);\r
dump_symcode:= CodeOn;\r
putcodebuffer(leng);\r
\r
\r
FOR i :=1 TO leng DO\r
BEGIN\r
PutCodeBuffer(CodeOfOpenRoutines[Index]);\r
Index:=Index+1;\r
END;\r
\r
IF ( InternalOffset > (Max_Word - Leng)) THEN\r
Fatal_Error(Pass4,4);\r
\r
InternalOffset := InternalOffset + Leng;\r
end;\r
\r
IF Index <= LastIndex THEN (* Special Dump *)\r
BEGIN\r
WordByte.Byte1 := CodeOfOpenRoutines[Index + 1];\r
WordByte.Byte2 := CodeOfOpenRoutines[Index + 2];\r
\r
callroutine(Anonymousspix,wordbyte.w,st_extern);\r
\r
index := index + 3;\r
\r
END;\r
END;\r
\r
END;\r
END;\r
\r
(* ------------------------------------------------------ *)\r
\r
\r
PROCEDURE CodeJump(Inst : Instruction; Lab : St_Address);\r
(* Generate a instruction with a label as operand *)\r
\r
VAR\r
Ptr : st_ElemPtr;\r
Lab1 : St_Address;\r
Bool : Boolean;\r
InstLength : word;\r
\r
BEGIN\r
IF (( Inst = iJMP ) AND (LastLabelOffset = InternalOffset)) THEN\r
BEGIN\r
(* A superflous is elemined *)\r
(* Make sure lab is not defined as lastlabel *)\r
Bool := true;\r
Lab1 := Lab;\r
WHILE Bool AND Not Equal_Addr(Lab1,St_Nilladdr) DO\r
IF Equal_Addr(Lab1,LastLabel)\r
THEN Bool := false\r
ELSE\r
BEGIN\r
ST_Retrieve(Lab1,Ptr);\r
Lab1 := Ptr^.DefAsLabel;\r
END;\r
\r
IF Bool THEN\r
BEGIN\r
(* The superflous can be elemined *)\r
St_Get(LastLabel,Ptr);\r
Ptr^.Label_Offset := 0;\r
GenAsLabel(LastLabel,Lab);\r
LastLabelOffset := 0;\r
END\r
ELSE\r
(* the jmp may not be delete *)\r
LastJMPOffset := 0;\r
END;\r
\r
(* If this is a JMP instruction and the last instruction was a JMP\r
too this instruction is not generated *)\r
IF not ((Inst = iJMP) AND ( LastJMPOffset = InternalOffset)) THEN\r
BEGIN (* generated the instruction *)\r
\r
PutCodeBuffer(0);\r
\r
(* NEAR jump is assumed *)\r
IF (( Inst = iJMP) OR (Inst = iCALL))\r
THEN\r
BEGIN (* Near uncond jump *)\r
PutCodeBuffer(ord(NearUnCondJump));\r
PutCodeBuffer(ord(Inst));\r
\r
InstLength := 3;\r
END\r
ELSE\r
BEGIN (* Near cond jump *)\r
PutCodeBuffer(ord(NearCondJump));\r
PutCodeBuffer(ord(Inst));\r
\r
InstLength := 5;\r
END;\r
\r
\r
\r
(* Put label *)\r
WordByte.w := Lab.Va_Low;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
\r
WordByte.w := Lab.Va_High;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
\r
\r
IF ( InternalOffset > (Max_Word - InstLength)) THEN\r
Fatal_Error(Pass4,4);\r
InternalOffset := InternalOffset + InstLength;\r
\r
IF Inst = iJMP THEN LastJMPOffset := InternalOffset;\r
\r
END;\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeJump ');\r
(*ENDTEST#*)\r
END; (* CodeJump *)\r
\r
\r
(* --------------------------------------------------------- *)\r
\r
\r
\r
\r
\r
PROCEDURE CodeIndJump(Lab : St_Address; IndexReg : Register);\r
(* Generate a indirect jump at address CS: Lab.Offset [IndexReg] *)\r
\r
VAR\r
R_M : Byte;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' CodeIndJump ');\r
(*ENDTEST#*)\r
\r
PutCodeBuffer(0);\r
PutCodeBuffer(ord(AddLabelToDis));\r
PutCodeBuffer(5); (* length of code *)\r
\r
PutCodeBuffer(OpcodeCSPreFix);\r
PutCodeBuffer(OpcodeJumpIndirect);\r
\r
IF IndexReg = BX \r
THEN R_M := $07 (*111B*)\r
ELSE R_M := $04 (*100B*) + ord(IndexReg) - ord(SI);\r
\r
PackField(R_M,3,CRegFieldJumpIndirect);\r
PackField(R_M,6,$02 (*10B*));\r
\r
PutCodeBuffer(R_M);\r
\r
\r
PutCodeBuffer(0);\r
PutCodeBuffer(0);\r
\r
\r
WordByte.w := Lab.Va_Low;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
\r
WordByte.w := Lab.Va_High;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
\r
\r
IF CodeOn THEN\r
BEGIN\r
write(TSymFile,InstructionName[iJMP]);\r
write(TSymFile,'CS: ');\r
IF IndexReg = BX THEN write(TSymFile,'[BX] ');\r
IF IndexReg = DI THEN write(TSymFile,'[DI]');\r
IF IndexReg = SI THEN write(TSymFile,'[SI]');\r
writeln(TSymFile);\r
END;\r
\r
\r
IF ( InternalOffset > (Max_Word - 5)) THEN Fatal_Error(Pass4,4);\r
InternalOffset := InternalOffset + 5;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeIndJump ');\r
(*ENDTEST#*)\r
END; (* CodeIndJump *)\r
\r
\r
\r
(* --------------------------------------------------------- *)\r
\r
\r
PROCEDURE CodeFaultAX(ErrorInt, ErrorExc: WORD);\r
var s : string;\r
ptr : St_elemPtr;\r
BEGIN\r
(* CodeRegConst(imov,w,AX,ErrorExc);\r
CodeReg(ipush,w,AX);\r
CallRoutine(anonymousspix, fault, st_extern); *)\r
\r
with FaultInfo[ErrorExc] do\r
BEGIN\r
IF not used then\r
BEGIN\r
used := true;\r
str(number,s);\r
s := 'FAULT_'+ s;\r
St_Declaration(cLabel,Anonymousname,FaultThunk,ptr);\r
Ptr^.St_Spix := st_SpixOfName(s);\r
END;\r
CodeJump(iCALL,FaultThunk);\r
END;\r
END;\r
\r
PROCEDURE CodeFault(ErrorInt, ErrorExc: WORD);\r
BEGIN\r
(* if computer=0 then (* PI3 *) (* CodeConst(iint, ErrorInt) else\r
if computer=1 then (* PARTNER *) CodeFaultAX(ErrorInt,ErrorExc) (*else\r
CodeConst(iint, ErrorInt);*)\r
END;\r
\r
\r
(* --------------------------------------------------------- *)\r
\r
\r
\r
PROCEDURE CodeLoadEffAddr(Reg : Register; Lab : St_Address; Offset : Word);\r
(* Generate code to load Reg with the effectiv address of Lab: + offset *)\r
\r
VAR\r
Op : Byte;\r
i : integer;\r
Str : ptr_String;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' CodeLoadEffAddr ');\r
(*ENDTEST#*)\r
\r
PutCodeBuffer(0);\r
PutCodeBuffer(ord(AddLabelToDis));\r
\r
PutCodeBuffer(3); (* length of code *)\r
\r
Op := OpCodeMovImmToReg;\r
PackField(Op,0,RegField(Reg));\r
PackField(Op,3,1);\r
PutCodeBuffer(Op);\r
\r
(* put offset *)\r
WordByte.w := Offset;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
\r
\r
WordByte.w := Lab.Va_Low;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
\r
WordByte.w := Lab.Va_High;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
\r
\r
IF CodeOn THEN\r
BEGIN\r
write(TSymFile,InstructionName[iMOV]);\r
PrintReg(Reg,w);\r
write(TSymFile,' , ');\r
\r
writeln(TSymFile,Offset,' + ');\r
END;\r
\r
\r
IF ( InternalOffset > (Max_Word - 3)) THEN Fatal_Error(Pass4,4);\r
InternalOffset := InternalOffset + 3;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' CodeLoadEffAddr ');\r
(*ENDTEST#*)\r
END; (* CodeLoadEffAddr *)\r
\r
\r
(* --------------------------------------------------------- *)\r
\r
\r
\r
PROCEDURE GenerateLabel(Lab : St_Address);\r
(* Generate the label given by Lab *)\r
\r
VAR Ptr : St_Elemptr;\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' GenerateLabel ');\r
(*ENDTEST#*)\r
\r
IF ((LastLabelOffset = InternalOffset) AND \r
( NOT Equal_Addr(Lab,LastLabel)))THEN\r
BEGIN\r
(* One label has been generated with this offset *)\r
GenAsLabel(Lab,LastLabel);\r
END\r
ELSE\r
BEGIN\r
(* generate the label *)\r
PutCodeBuffer(0);\r
PutCodeBuffer(0);\r
\r
(* Put label *)\r
WordByte.w := Lab.Va_Low;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
\r
WordByte.w := Lab.Va_High;\r
PutCodeBuffer(WordByte.Byte1);\r
PutCodeBuffer(WordByte.Byte2);\r
\r
St_Get(Lab,Ptr);\r
Ptr^.Label_Offset := InternalOffset;\r
\r
LastLabelOffset := InternalOffset;\r
LastLabel := Lab;\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' GenerateLabel ');\r
(*ENDTEST#*)\r
END; (* GenerateLabel *)\r
\r
\r
(* --------------------------------------------------------- *)\r
\r
\r
PROCEDURE GenAsLabel(Lab1, Lab2 : St_Address);\r
(* The offset of Lab1 is defined by the offset of Lab2\r
Lab1 is never generated *)\r
VAR\r
Ptr : St_ElemPtr;\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' GenAsLabel');\r
(*ENDTEST#*)\r
\r
St_Get(Lab1,Ptr);\r
\r
Ptr^.DefAsLabel := Lab2;\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' GenAsLabel');\r
(*ENDTEST#*)\r
END; (* GenAsLabel *)\r
\r
\r
\r
\r
\r
\r
\r
PROCEDURE InitCodeGenerator;\r
(* The procedure initialize the codegenerator *)\r
\r
VAR\r
i : integer;\r
PreName : string[16];\r
\r
\r
\r
BEGIN\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' START',' InitCodeGenerator');\r
(*ENDTEST#*)\r
\r
\r
(* Initialize the ShiftFactor *)\r
ShiftFactor[0] := 1;\r
FOR i := 1 TO 7 DO\r
ShiftFactor[i] := ShiftFactor[i-1] * 2;\r
\r
\r
\r
(* Initialize the NegInst tabel *)\r
NegInstruction[iJE] := iJNE;\r
NegInstruction[iJL] := iJGE;\r
NegInstruction[iJLE] := iJG;\r
NegInstruction[iJB] := iJAE;\r
NegInstruction[iJBE] := iJA;\r
NegInstruction[iJNE] := iJE;\r
NegInstruction[iJGE] := iJL;\r
NegInstruction[iJG] := iJLE;\r
NegInstruction[iJAE] := iJB;\r
NegInstruction[iJA] := iJBE;\r
\r
\r
(* Initialize Opcode tabels *)\r
OpCodeNoOpr[iINTO] := $CE; (*11001110B;*)\r
OpCodeNoOpr[iCWD] := $99; (*10011001B;*)\r
OpcodeNoOpr[iCLD] := $FC; (*11111100B;*)\r
OpcodeNoOpr[iCLI] := $FA; (*11111010B;*)\r
OpcodeNoOpr[iSTI] := $FB; (*11111011B;*)\r
OpcodeNoOpr[iREP] := $F3; (*11110011B;*)\r
OpcodeNoOpr[iMOVSB] := $A4; (*10100100B;*)\r
OpcodeNoOpr[iMOVSW] := $A5; (*10100101B;*)\r
OpcodeNoOpr[iSTOSB] := $AA; (*10101010B;*)\r
OpcodeNoOpr[iSTOSW] := $AB; (*10101011B;*)\r
OpcodeNoOpr[iCMPSB] := $A6; (*10100110B;*)\r
OpcodeNoOpr[iCMPSW] := $A7; (*10100111B;*)\r
OpCodeNoOpr[iSCASB] := $AE; (*10101110B;*)\r
OpCodeNoOpr[iNOOP2] := $BA; (*10111010B*)\r
OpCodeNoOpr[iINT] := $CC; (*11001100B;*)\r
OpCodeNoOpr[iRETWS] := $C3; (*11000011B;*)\r
OpCodeNoOpr[iRETIS] := $CB; (*11001011B;*)\r
\r
\r
OpCodeCOpr[iINT] := $CD; (*11001101B;*)\r
OpCodeCOpr[iRETWS] := $C2; (*11000010B;*)\r
OpCodeCOpr[iRETIS] := $CA; (*11001010B;*)\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
OpCodeShort[iJE] := $74; (*01110100B;*)\r
OpCodeShort[iJL] := $7C; (*01111100B;*)\r
OpCodeShort[iJLE] := $7E; (*01111110B;*)\r
OpCodeShort[iJB] := $72; (*01110010B;*)\r
OpCodeShort[iJBE] := $76; (*01110110B;*)\r
OpCodeShort[iJNE] := $75; (*01110101B;*)\r
OpCodeShort[iJGE] := $7D; (*01111101B;*)\r
OpCodeShort[iJG] := $7F; (*01111111B;*)\r
OpCodeShort[iJAE] := $73; (*01110011B;*)\r
OpCodeShort[iJA] := $77; (*01110111B;*)\r
OpCodeShort[iLOOP] := $E2; (*11100010B;*)\r
OpCodeShort[iJCXZ] := $E3; (*11100011B;*)\r
OpCodeShort[iJMP] := $EB; (*11101011B;*)\r
\r
\r
\r
OpcodeNear[iJMP] := $E9; (*11101001B;*)\r
OpcodeNear[iCALL] := $E8; (*11101000B;*)\r
\r
OpcodeSROpr[iPUSH] := $06; (*00000110B;*)\r
OpcodeSROpr[iPOP] := $07; (*00000111B;*)\r
\r
OpcodeRegOpr[iPUSH] := $50; (*01010000B;*)\r
OpcodeRegOpr[iPOP] := $58; (*01011000B;*)\r
OpcodeRegOpr[iINC] := $40; (*01000000B;*)\r
OpcodeRegOpr[iDEC] := $48; (*01001000B;*)\r
\r
\r
OpcodeR_M[iPUSH] := $FF; (*11111111B;*)\r
OpcodeR_M[iPOP] := $8F; (*10001111B;*)\r
OpcodeR_M[iINC] := $FE; (*11111110B;*)\r
OpcodeR_M[iDEC] := $FE; (*11111110B;*)\r
OpCodeR_M[iNEG] := $F6; (*11110110B;*)\r
OpCodeR_M[iMUL] := $F6; (*11110110B;*)\r
OpCodeR_M[iIMUL] := $F6; (*11110110B;*)\r
OpCodeR_M[iDIV] := $F6; (*11110110B;*)\r
OpCodeR_M[iIDIV] := $F6; (*11110110B;*)\r
OpCodeR_M[iNOT] := $F6; (*11110110B;*)\r
OpCodeR_M[iSHL] := $D0; (*11010000B;*)\r
OpCodeR_M[iSHR] := $D0; (*11010000B;*)\r
OpCodeR_M[iSAR] := $D0; (*11010000B;*)\r
OpcodeR_M[iMOV] := $88; (*10001000B;*)\r
OpcodeR_M[iADD] := $00; (*00000000B;*)\r
OpcodeR_M[iSUB] := $28; (*00101000B;*)\r
OpcodeR_M[iCMP] := $38; (*00111000B;*)\r
OpcodeR_M[iAND] := $20; (*00100000B;*)\r
OpcodeR_M[iTEST] := $10; (*00010000B;*)\r
OpcodeR_M[iOR] := $08; (*00001000B;*)\r
OpcodeR_M[iXOR] := $30; (*00110000B;*)\r
OpcodeR_M[iLEA] := $8D; (*10001101B;*)\r
OpcodeR_M[iLES] := $C4; (*11000100B;*)\r
OpcodeR_M[iXCHG] := $86; (*10000110B;*)\r
\r
\r
OpcodeCRegField[iPUSH] := $6; (*110B;*)\r
OpcodeCRegField[iPOP] := $0; (*000B;*)\r
OpcodeCRegField[iINC] := $0; (*000B;*)\r
OpcodeCRegField[iDEC] := $1; (*001B;*)\r
OpcodeCRegField[iNEG] := $3; (*011B;*)\r
OpcodeCRegField[iMUL] := $4; (*100B;*)\r
OpcodeCRegField[iIMUL] := $5; (*101B;*)\r
OpcodeCRegField[iDIV] := $6; (*110B;*)\r
OpcodeCRegField[iIDIV] := $7; (*111B;*)\r
OpcodeCRegField[iNOT] := $2; (*010B;*)\r
OpcodeCRegField[iSHL] := $4; (*100B;*)\r
OpcodeCRegField[iSHR] := $5; (*101B;*)\r
OpcodeCRegField[iSAR] := $7; (*111B;*)\r
OpcodeCRegField[iMOV] := $0; (*000B;*)\r
OpcodeCRegField[iADD] := $0; (*000B;*)\r
OpcodeCRegField[iSUB] := $5; (*101B;*)\r
OpcodeCRegField[iCMP] := $7; (*111B;*)\r
OpcodeCRegField[iAND] := $4; (*100B;*)\r
OpcodeCRegField[iTEST] := $0; (*000B;*)\r
OpcodeCRegField[iOR] := $1; (*001B;*)\r
OpcodeCRegField[iXOR] := $6; (*110B;*)\r
\r
OpcodeR_MAndConst[iMOV] := $C6; (*11000110B;*)\r
OpcodeR_MAndConst[iADD] := $80; (*10000000B;*)\r
OpcodeR_MAndConst[iSUB] := $80; (*10000000B;*)\r
OpcodeR_MAndConst[iCMP] := $80; (*10000000B;*)\r
OpcodeR_MAndConst[iAND] := $80; (*10000000B;*)\r
OpcodeR_MAndConst[iTEST] := $F6; (*11110110B;*)\r
OpcodeR_MAndConst[iOR] := $80; (*10000000B;*)\r
OpcodeR_MAndConst[iXOR] := $80; (*10000000B;*)\r
\r
\r
\r
OpcodeConstAndAcc[iADD] := $04; (*00000100B;*)\r
OpcodeConstAndAcc[iSUB] := $2C; (*00101100B;*)\r
OpcodeConstAndAcc[iCMP] := $3C; (*00111100B;*)\r
OpcodeConstAndAcc[iAND] := $24; (*00100100B;*)\r
OpcodeConstAndAcc[iTEST] := $A8; (*10101000B;*)\r
OpcodeConstAndAcc[iOR] := $0C; (*00001100B;*)\r
OpcodeConstAndAcc[iXOR] := $34; (*00110100B;*)\r
\r
\r
\r
\r
Filebufferindex := 0;\r
CodeOn := false;\r
InternalOffset := 0;\r
FileOffset := 0;\r
NoBytesInBuffer := 0;\r
BufferIndex := 0;\r
FirstIndex := 0;\r
\r
LastLabelOffset := 0;\r
LastJMPOffset := 0;\r
LastLabel := St_NillAddr;\r
\r
Spacing := Call_Options.Spacing;\r
LineTabel := (Spacing <> 0);\r
LastNameEntry := St_NillAddr;\r
LengthOfNameTabel := 2;\r
\r
CurrentSegNo := 1;\r
\r
InitFaultInfo;\r
\r
(* reads the code for the open routines *)\r
i := 0;\r
WHILE NOT EOF(OpenRoutine) DO\r
BEGIN\r
IF i > MaxLengthOfOpenRoutines THEN\r
Fatal_Error(Pass4,9);\r
\r
read(OpenRoutine,CodeOfOpenRoutines[i]);\r
(*\r
CodeOfOpenRoutines[i] := OpenRoutine^;\r
get(OpenRoutine);*)\r
i := i + 1;\r
END;\r
\r
\r
\r
\r
\r
\r
InitPass4_2;\r
\r
\r
\r
NoPreExtDecl := NoOfPi3Routines;\r
(* Initialize the the list of External Name *)\r
for i := 1 to NoOfPi3Routines do PreExtCalled[i] := false;\r
\r
\r
PreName := 'FAULT';\r
(*Name.Length := 5;\r
FOR i := 1 TO 5 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[fault] := St_SpixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 5;\r
\r
\r
if computer = Partner then\r
begin\r
Prename := 'FAULT';\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 5;\r
end\r
else\r
begin\r
PreName := 'RESUME';\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 6;\r
end;\r
PreExtName[resume] := St_SpixOfName(PreName);\r
\r
\r
PreName := 'ALLOCPOOL';\r
PreExtName[AllocPool] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 9;\r
\r
\r
\r
PreName := 'INIT_SEMAPHORE';\r
PreExtName[INIT_Semaphore] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 14;\r
\r
\r
PreName := 'WAITS';\r
(* Name.Length := 5;\r
FOR i := 1 TO 5 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[WAITS] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 5;\r
\r
\r
PreName := 'SET_EXCEPTION';\r
(* Name.Length := 13;\r
FOR i := 1 TO 13 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Set_Exception ] := St_SpixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 13;\r
\r
\r
PreName := 'INIT_REFERENCE';\r
(* Name.Length := 14;\r
FOR i := 1 TO 14 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Init_Reference] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 14;\r
\r
\r
\r
PreName := 'INIT_CHAIN';\r
(* Name.Length := 10;\r
FOR i := 1 TO 10 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Init_Chain] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 10;\r
\r
\r
\r
PreName := 'INIT_SHARED';\r
(* Name.Length := 11;\r
FOR i := 1 TO 11 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Init_Shared] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 11;\r
\r
\r
\r
PreName := 'INIT_MAILBOX';\r
(* Name.Length := 12;\r
FOR i := 1 TO 12 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Init_MailBox] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 12;\r
\r
\r
\r
\r
PreName := 'INIT_PROCESS';\r
(* Name.Length := 12;\r
FOR i := 1 TO 12 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Init_Process] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 12;\r
\r
\r
\r
PreName := 'INIT_INTERNAL';\r
(* Name.Length := 13;\r
FOR i := 1 TO 13 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Init_Internal] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 13;\r
\r
\r
\r
PreName := 'INIT_EXTERNAL';\r
(* Name.Length := 13;\r
FOR i := 1 TO 13 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Init_External] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 13;\r
\r
\r
\r
PreName := 'INIT_PORT';\r
(* Name.Length := 9;\r
FOR i := 1 TO 9 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Init_Port] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 9;\r
\r
\r
PreName := 'SIGNALS';\r
(* Name.Length := 7;\r
FOR i := 1 TO 7 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[SignalS] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 7;\r
\r
\r
PreName := 'INIT_POOL';\r
(* Name.Length := 9;\r
FOR i := 1 TO 9 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Init_Pool] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 9;\r
\r
\r
PreName := 'ENDPROCESS';\r
(* Name.Length := 10;\r
FOR i := 1 TO 10 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[EndProcess] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 10;\r
\r
\r
PreName := 'MARK_LOCALREF';\r
(* Name.Length := 13;\r
FOR i := 1 TO 13 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Mark_LocalRef] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 13;\r
\r
\r
PreName := 'UNCHAIN_LOCALREF'; (* EF insert *)\r
(* Name.Length := 16;\r
FOR i := 1 TO 14 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
Name.Name[15] := 'E';\r
Name.Name[16] := 'F';\r
*)\r
PreExtName[UnChain_LocalRef] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 16;\r
\r
\r
PreName := 'INIT_LOCALREF';\r
(* Name.Length := 13;\r
FOR i := 1 TO 13 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[Init_LocalRef] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 13;\r
\r
\r
IF Make_Set THEN\r
BEGIN\r
NoPreExtDecl := NoPreExtDecl + NoOfSetRoutines;\r
\r
PreName := 'ASSIGNSET';\r
(* Name.Length := 9;\r
FOR i := 1 TO 9 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[AssignSet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 9;\r
\r
\r
PreName := 'PUSHSET';\r
(* Name.Length := 7;\r
FOR i := 1 TO 7 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[PushSet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 7;\r
\r
\r
PreName := 'ADDSET';\r
(* Name.Length := 6;\r
FOR i := 1 TO 6 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[AddSet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 6;\r
\r
\r
PreName := 'SUBSET';\r
(* Name.Length := 6;\r
FOR i := 1 TO 6 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[SubSet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 6;\r
\r
\r
PreName := 'MULTSET';\r
(* Name.Length := 7;\r
FOR i := 1 TO 7 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[MultSet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 7;\r
\r
\r
PreName := 'GESET';\r
(* Name.Length := 5;\r
FOR i := 1 TO 5 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[GESet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 5;\r
\r
\r
PreName := 'EQSET';\r
(* Name.Length := 5;\r
FOR i := 1 TO 5 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[EQSet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 5;\r
\r
\r
PreName := 'NESET';\r
(* Name.Length := 5;\r
FOR i := 1 TO 5 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[NESet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 5;\r
\r
\r
PreName := 'LESET';\r
(* Name.Length := 5;\r
FOR i := 1 TO 5 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[LESet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 5;\r
\r
\r
PreName := 'INSET';\r
(* Name.Length := 5;\r
FOR i := 1 TO 5 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[INSet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 5;\r
\r
\r
PreName := 'MAKESET';\r
(* Name.Length := 7;\r
FOR i := 1 TO 7 DO\r
BEGIN\r
Name.Name[i] := PreName[i];\r
END;\r
*)\r
PreExtName[MakeSet] := St_spixOfName(PreName);\r
LengthOfAllPreExtName := LengthOfAllPreExtName + 7;\r
\r
\r
END;\r
\r
\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
writeln(TestOutput,' SLUT',' InitCodeGenerator');\r
(*ENDTEST#*)\r
END; (* InitCodeGenerator *)\r
\r
«eof»