|
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: 61210 (0xef1a)
Types: TextFile
Names: »P4.PAS«
└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
└─⟦this⟧ »RTP\P4.PAS«
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\P4.PAS«
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\P4.PAS«
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
└─⟦this⟧ »P4.PAS«
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
└─⟦this⟧ »RTP\P4.PAS«
{$O+,F+}\r
unit P4; (* pass4_2*)\r
(* This module makes the 2. pass of pass4 . Everything written to CodeFile\r
And CodeList is done by this module.\r
The public part of the module contains common declarations for\r
Codegenerator and pass4_2 *)\r
\r
interface\r
\r
\r
PROCEDURE WriteEmptyRecord(TypeNo : Byte);\r
(* The procedure writes standard records with no substans to codefile *)\r
\r
\r
\r
PROCEDURE InitPass4_2;\r
(* The procedure initialize Pass4_2 *)\r
\r
PROCEDURE MakePass4_2(FileOffset : Word);\r
(* The procedure makes the <OBJECT BLOCK> for Block on file TBinFile.\r
That is the 2 pass is made . FileOffset gives the length of the\r
code *)\r
\r
\r
implementation\r
\r
\r
\r
\r
\r
\r
(* ---------- IMPORTS --------------------IMPORTS ---------*)\r
uses dos, pscplm,mpaunit,files,sthunit,sthcom,sthp34,\r
p4unit,p4code;\r
\r
(* TURBO\r
PUBLIC UDI;\r
Type string8 = Array[1..8] OF Char;\r
TimeType = Record\r
word1,Word2: word;\r
Date,Time : string8;\r
END;\r
Procedure dqdecodetime(var x: TimeType; Var w : word);\r
*)\r
(* ------------IMPORTS END --------------IMPORTS END --------*)\r
\r
\r
\r
(* --------PRIVATE Pass4_2 ----------- Pass4_2 ---------------*)\r
\r
\r
\r
\r
\r
\r
CONST\r
\r
\r
LabelPos = 25;\r
(* Gives the label pos on CodeList *)\r
\r
CodePos = 35;\r
(* Gives the code pos on CodeList *)\r
\r
\r
MaxReData = 1014;\r
(* Gives the max no of databyte in a record of type REDATA *)\r
\r
\r
VAR\r
\r
CodeOnPass2 : Boolean;\r
(* Symbolic code is generated if true *)\r
\r
CheckSum : Word;\r
(* Used to calculated the checksum for a objectfile\r
record *)\r
\r
CurrentPos : integer;\r
(* Gives the possition for the last char written to \r
CodeList *)\r
\r
\r
\r
FirstRheAdr : boolean;\r
\r
HexNumber : ARRAY[ 0 .. 15 ] OF Char;\r
\r
\r
FirstBlock : boolean;\r
\r
\r
WordByte : RECORD\r
CASE Int : integer OF\r
1 : (i : Integer);\r
2 : (Byte1 : 0..255;\r
Byte2 : 0..255);\r
3 : (w : Word);\r
END;\r
(* Used to convert a integer/Word to two bytes or two bytes\r
to a integer/Word *)\r
\r
\r
TBinFileptr : byte;\r
\r
filebufferindex,filebufferlast : Integer;\r
eoftbinfile : boolean;\r
\r
PROCEDURE GetTBinFile;\r
BEGIN\r
if filebufferindex = filebufferlast then\r
BEGIN\r
filebufferindex := 0;\r
if eof(Tbinfile) then\r
begin\r
filebufferlast := 0;\r
eoftbinfile := true;\r
end\r
else\r
begin\r
blockread(TBinFile,Filebufferptr^,lengthoffilebuffer,filebufferlast);\r
if filebufferlast = 0 THEN\r
eoftbinfile := true\r
else\r
eoftbinfile := false;\r
end\r
END;\r
\r
if not eoftbinfile then\r
begin\r
filebufferindex := filebufferindex + 1;\r
tbinfileptr := filebufferptr^[filebufferindex];\r
end;\r
END;\r
\r
(*----------------------------------------------------------- *)\r
\r
\r
PROCEDURE WriteEmptyRecord(TypeNo : Byte);\r
(* The Procedure writes standard records with no substans to \r
codefile *)\r
\r
VAR\r
i : integer;\r
Rec :\r
RECORD\r
CASE b : Boolean OF\r
\r
True : ( RecType : Byte;\r
RecLength : Word;\r
CheckSum : Byte );\r
\r
FALSE : (Byt : ARRAY[1..2] OF WORD);\r
END;\r
\r
BEGIN\r
WITH Rec DO\r
BEGIN\r
RecType := TypeNo;\r
RecLength := 1;\r
CheckSum := MaxByte - (TypeNo + 1);\r
\r
FOR i := 1 TO 2 DO\r
BEGIN\r
Put_2_Byte( Byt[i]);\r
END;\r
\r
END;\r
END;\r
\r
\r
\r
\r
(* ------------------------------------------------------- *)\r
\r
\r
\r
\r
PROCEDURE DumpComment;\r
(* The procedure insert a comment about the version number in the\r
object code *)\r
\r
VAR\r
i,j,Pass,help : word;\r
\r
CommentText : Packed Array[1..20] OF Char;\r
(* contains text comment *)\r
\r
RTPCommentText :\r
Record Case Boolean OF\r
True : ( rtpname : packed array[1..6] Of char;\r
VersionId : VersionsType;\r
Space1 : char;\r
Date : packed Array[1..8] of char;\r
Space2 : Char;\r
Timex : packed array[1..8] of char);\r
False: ( Comtext : Packed array[1..32] Of Byte);\r
END;\r
\r
time: datetime;\r
packedtime: longint;\r
\r
BEGIN\r
\r
(* put the version number into the object file *)\r
Put_Byte($88);\r
Put_2_Byte(35);\r
\r
Put_Byte(1);\r
Put_Byte(0);\r
CheckSum := $88 + 35 + 1;\r
RtpCommentText.RtpName := 'RTP86 ';\r
RtpCommentText.VersionId := VersionsId;\r
RtpCommentText.Space1 := ' ';\r
\r
\r
getftime(comm,packedtime); (* FUSK *)\r
\r
unpacktime(packedtime,time);\r
with RtpCommentText do\r
BEGIN\r
date[1]:= chr((time.year - 1900) div 10 + ord('0'));\r
date[2]:= chr(time.year mod 10 + ord('0'));\r
\r
date[3]:='/';\r
date[4]:=chr(time.month div 10 + ord('0'));\r
date[5]:=chr(time.month mod 10 + ord('0'));\r
date[6]:='/';\r
date[7]:=chr(time.day div 10 + ord('0'));\r
date[8]:=chr(time.day mod 10 + ord('0'));\r
\r
\r
timex[1]:=chr(time.hour div 10 + ord('0'));\r
timex[2]:=chr(time.hour mod 10 + ord('0'));\r
timex[3]:='.';\r
timex[4]:=chr(time.min div 10 + ord('0'));\r
timex[5]:=chr(time.min mod 10 + ord('0'));\r
timex[6]:='.';\r
timex[7]:=chr(time.sec div 10 + ord('0'));\r
timex[8]:=chr(time.sec mod 10 + ord('0'));\r
END;\r
\r
RTpCommentText.Space2 := ' ';\r
FOR i := 1 TO 32 DO\r
BEGIN\r
CheckSum := RtpCommentText.ComText[i] + CheckSum;\r
Put_Byte(RtpCommentText.ComText[i]);\r
END;\r
\r
Put_Byte(MaxByte - (Checksum mod MaxByte));\r
\r
\r
\r
\r
\r
\r
CommentText := ' PASSX VERSION XXXXX';\r
\r
FOR Pass := 1 TO 4 DO \r
BEGIN\r
CommentText[6] := chr(ord('0') + Pass);\r
Help := 10000;\r
FOR i := 1 TO 5 DO\r
BEGIN\r
CommentText[15 + i] := Chr(ord('0') + (VersionNumber[Pass]\r
Div Help));\r
VersionNumber[Pass] := VersionNumber[Pass] MOD Help;\r
Help := Help Div 10;\r
END;\r
\r
Put_Byte($88);\r
Put_2_Byte(23);\r
Put_Byte(1);\r
Put_Byte(0);\r
CheckSum := $88 + 23 + 1;\r
FOR i := 1 To 20 DO\r
BEGIN \r
CheckSum := CheckSum + ord(CommentText[i]);\r
Put_Byte(ord(CommentText[i]));\r
END;\r
\r
Put_Byte(MaxByte - (CheckSum Mod MaxByte));\r
END;\r
FirstRheAdr := false;\r
END;\r
\r
\r
(***************************************************************)\r
\r
\r
PROCEDURE InitPass4_2;\r
(* The procedure initialize Pass4_2 *)\r
\r
VAR\r
i : integer;\r
BEGIN\r
\r
IF Make_Code THEN\r
BEGIN\r
(* Initialize the name tabel *)\r
InstructionName[iXLAT] := 'XLAT ';\r
InstructionName[iCWD] := 'CWD ';\r
InstructionName[iCLD] := 'CLD ';\r
InstructionName[iCLI] := 'CLI ';\r
InstructionName[iSTI] := 'STI ';\r
InstructionName[iINTO] := 'INTO ';\r
InstructionName[iREP] := 'REP ';\r
InstructionName[iMOVSB] := 'MOVSB ';\r
InstructionName[iMOVSW] := 'MOVSW ';\r
InstructionName[iCMPSB] := 'CMPSB ';\r
InstructionName[iCMPSW] := 'CMPSW ';\r
InstructionName[iSTOSB] := 'STOSB ';\r
InstructionName[iSTOSW] := 'STOSW ';\r
InstructionName[iSCASB] := 'SCASB ';\r
InstructionName[iNOOP2] := 'NOOP2 ';\r
InstructionName[iINT] := 'INT ';\r
InstructionName[iRETIS] := 'RETIS ';\r
InstructionName[iRETWS] := 'RETWS ';\r
InstructionName[iJE] := 'JE ';\r
InstructionName[iJL] := 'JL ';\r
InstructionName[iJLE] := 'JLE ';\r
InstructionName[iJB] := 'JB ';\r
InstructionName[iJBE] := 'JBE ';\r
InstructionName[iJNE] := 'JNE ';\r
InstructionName[iJGE] := 'JGE ';\r
InstructionName[iJG] := 'JG ';\r
InstructionName[iJAE] := 'JAE ';\r
InstructionName[iJA] := 'JA ';\r
InstructionName[iLOOP] := 'LOOP ';\r
InstructionName[iJCXZ] := 'JCXZ ';\r
InstructionName[iJMP] := 'JMP ';\r
InstructionName[iCALL] := 'CALL ';\r
InstructionName[iPUSH] := 'PUSH ';\r
InstructionName[iPOP] := 'POP ';\r
InstructionName[iINC] := 'INC ';\r
InstructionName[iDEC] := 'DEC ';\r
InstructionName[iNEG] := 'NEG ';\r
InstructionName[iMUL] := 'MUL ';\r
InstructionName[iIMUL] := 'IMUL ';\r
InstructionName[iDIV] := 'DIV ';\r
InstructionName[iIDIV] := 'IDIV ';\r
InstructionName[iNOT] := 'NOT ';\r
InstructionName[iSHL] := 'SHL ';\r
InstructionName[iSHR] := 'SHR ';\r
InstructionName[iSAR] := 'SAR ';\r
InstructionName[iADD] := 'ADD ';\r
InstructionName[iSUB] := 'SUB ';\r
InstructionName[iCMP] := 'CMP ';\r
InstructionName[iAND] := 'AND ';\r
InstructionName[iTEST] := 'TEST ';\r
InstructionName[iOR] := 'OR ';\r
InstructionName[iXOR] := 'XOR ';\r
InstructionName[iLEA] := 'LEA ';\r
InstructionName[iLES] := 'LES ';\r
InstructionName[iMOV] := 'MOV ';\r
InstructionName[iXCHG] := 'XCHG ';\r
END;\r
\r
\r
\r
\r
\r
\r
\r
\r
FirstExtDec := St_NillAddr;\r
NoExtDecl := 0;\r
\r
LengthOfAllPreExtName := 0;\r
LengthOfAllExtName := 0;\r
\r
FirstFixUpp := St_NillAddr;\r
LastFixUpp := St_NillAddr;\r
NoFixUpp := 0;\r
\r
\r
\r
CodeOnPass2 := false;\r
\r
filebufferindex := 0;\r
filebufferlast := 0;\r
eoftbinfile := false;\r
\r
FirstBlock := true;\r
(* Used when making linetabel *)\r
\r
WriteEmptyRecord(Frstrc);\r
\r
\r
FirstRheAdr := true;\r
\r
FOR i := 0 TO 9 DO\r
HexNumber[ i ] := chr(ord('0') + i);\r
FOR i := 0 TO 5 DO\r
HexNumber[ 10 + i ] := chr(ord('A') + i);\r
\r
\r
\r
\r
END; (* InitPass4_2 *)\r
\r
\r
\r
\r
\r
\r
\r
\r
(* ------------------------------------------------------------ *)\r
\r
\r
\r
PROCEDURE MakePass4_2(FileOffset : Word);\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 . FileOffset gives the length\r
of the code in the block *)\r
\r
VAR\r
Ptr : St_ElemPtr;\r
i, j , CharValue : integer;\r
Leng, NoLabels, StepW : Word;\r
ch : char;\r
Lab, Lab1 : St_Address;\r
IndexReg : Register;\r
codelength : word;\r
Inst : Instruction;\r
Low, High : integer;\r
Off, OtherwiseOffset : Word;\r
Offset : Word;\r
(* Gives the offset of the next byte written to\r
CodeFile *)\r
LBDR : TypeExternalLBDR;\r
Str : Ptr_string;\r
\r
NoFixUppToReData : word;\r
(* Gives the number of Fixupp to the current ReData *)\r
\r
NewReData : Word;\r
(* a new ReData is made when offset is eq NewReData *)\r
\r
StartReData : Word;\r
(* The first byte in ReData have offset StartReData *)\r
\r
NameEntry :\r
record\r
case b : boolean of\r
true : ( firstOffset : word;\r
lastoffset : word;\r
nextname : word;\r
blocktype : byte;\r
length : byte);\r
false : ( a : array[1..8] of byte);\r
end;\r
\r
LineTab :\r
Record\r
case b : boolean of\r
true : ( FirstLine : word;\r
FirstOffset : Word;\r
OffsetSpacing : Word;\r
LastOffset : Word );\r
False : ( a : array[1..8] of byte)\r
End;\r
\r
\r
LengthOfLineTabel : word ;\r
LineTabelAddr, TempLineTabelAddr : St_Address;\r
LineTabelIndex : Word;\r
LineTabelOffset : Word;\r
MakingLineTab : Boolean;\r
LastLine, LineRest, LineDiff : Word;\r
\r
\r
\r
\r
NoSegFixUp : Word;\r
FirstSegFixUp, LastSegFixup : St_Address;\r
SegNumber : Byte;\r
UseLabel : Boolean;\r
RoutineOffset : Word;\r
\r
helplength : integer;\r
(* ---------------------------------------------------------- *)\r
\r
\r
PROCEDURE PutToCodeFile( x : Byte);\r
(* x is written to CodeFile and checksum is updated *)\r
BEGIN\r
Put_Byte(x);\r
CheckSum := (CheckSum + x ) MOD MaxByte;\r
END;\r
\r
\r
\r
\r
(* The following procedure writes on file CodeList *)\r
\r
\r
\r
\r
\r
PROCEDURE WriteHexByte( x : integer );\r
(* The procedure writes a hex byte to codefile *)\r
\r
BEGIN\r
write(CodeList,HexNumber[x DIV Max4Bit MOD Max4Bit]);\r
write(CodeList,HexNumber[x MOD Max4Bit]);\r
\r
CurrentPos := CurrentPos + 2;\r
END; (* WriteHexByte *)\r
\r
\r
(*---------------------------------------------------------*)\r
\r
PROCEDURE WriteHexWord(x : Word);\r
(* The procedure writes a Hex word to CodeList *)\r
\r
VAR\r
\r
WordByte : RECORD\r
CASE Int : integer OF\r
1 : (i : Integer);\r
2 : (Byte1 : 0..255;\r
Byte2 : 0..255);\r
3 : (w : Word);\r
END;\r
(* Used to convert a integer/Word to two bytes or two bytes\r
to a integer/Word *)\r
\r
\r
\r
BEGIN\r
WordByte.w := x;\r
WriteHexByte(WordByte.Byte2);\r
WriteHexByte(WordByte.Byte1);\r
\r
END; (* WriteHexWord *)\r
\r
\r
(* ----------------------------------------------------------- *)\r
\r
\r
\r
\r
PROCEDURE WriteSpace( x : integer);\r
(* The procedure writes x spaces to CodeList *)\r
\r
VAR\r
i : integer;\r
\r
BEGIN\r
FOR i := 1 TO x DO\r
write(CodeList,' ');\r
CurrentPos := CurrentPos + x;\r
END; (* WriteSpace *)\r
\r
\r
\r
\r
(* ---------------------------------------------------------- *)\r
\r
\r
\r
PROCEDURE WriteLabel( Lab : St_elemptr);\r
(* The procedure writes the label pointed to by lab to CodeList *)\r
\r
VAR\r
i : integer;\r
\r
BEGIN\r
IF Lab^.St_Spix <> AnonymousSpix THEN\r
BEGIN\r
St_NameOfSpix(Lab^.St_Spix,Str);\r
(*FOR i := 1 TO Str^.Length DO\r
write(CodeList,Str^.Name[i]); *)\r
(* TURBO *)\r
write(CodeList,str^);\r
writeln(CodeList,':');\r
END\r
ELSE\r
writeln(CodeList,'?',Ptr^.Label_Offset,':');\r
\r
\r
END; (* WriteLabel *)\r
\r
\r
\r
\r
\r
(* ------------------------------------------------------------- *)\r
\r
\r
\r
\r
PROCEDURE ReadSt_Address(VAR Addr : St_Address);\r
(* Read the next St_Address from TBinFile *)\r
\r
VAR\r
\r
WordByte : RECORD\r
CASE Int : integer OF\r
1 : (i : Integer);\r
2 : (Byte1 : 0..255;\r
Byte2 : 0..255);\r
3 : (w : Word);\r
END;\r
(* Used to convert a integer/Word to two bytes or two bytes\r
to a integer/Word *)\r
\r
\r
\r
BEGIN\r
GetTBinFile;\r
WordByte.Byte1 := TBinFileptr;\r
GetTBinFile;\r
WordByte.Byte2 := TBinFileptr;\r
\r
Addr.Va_Low := WordByte.w;\r
\r
GetTBinFile;\r
WordByte.Byte1 := TBinFileptr;\r
GetTBinFile;\r
WordByte.Byte2 := TBinFileptr;\r
Addr.Va_High := WordByte.w;\r
\r
END;\r
\r
(* ------------------------------------------------------------ *)\r
\r
\r
\r
PROCEDURE MakeLastReDataAndFixUpp;\r
(* The procedure makes the last part of ReData and the following\r
Fixupp *)\r
\r
VAR\r
stepw : word; \r
\r
\r
BEGIN\r
(* Make the last part of REDATA *)\r
Put_Byte((MaxByte - CheckSum) MOD MaxByte);\r
\r
\r
\r
(* Make FixUpp Record *)\r
IF (NoFixUppToReData <> 0) OR (NoSegFixUp <> 0 )THEN\r
BEGIN\r
CheckSum := 0;\r
PutToCodeFile($9C);\r
\r
WordByte.w := (NoFixUppToReData * 5) + (NoSegFixUp * 4) + 1;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
\r
FOR stepw := 1 TO NoFixUppToReData DO\r
BEGIN\r
PutToCodeFile(1);\r
st_retrieve(FirstFixUpp,Ptr);\r
\r
WordByte.w := Ptr^.FixUp_Offset - StartReData;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
WordByte.w := Ptr^.FixUp_No;\r
\r
(* make the index number to intel format *)\r
WordByte.Byte2 := WordByte.Byte2 + 128;\r
\r
\r
PutToCodeFile(WordByte.Byte2);\r
PutToCodeFile(WordByte.Byte1);\r
\r
FirstFixUpp := Ptr^.ext_Ref;\r
END;\r
NoFixUpp := NoFixUpp - NoFixUppToReData;\r
\r
FOR stepw := 1 TO NoSegFixUp DO\r
BEGIN\r
PutToCodeFile(0);\r
st_retrieve(FirstSegFixUp,Ptr);\r
\r
WordByte.w := Ptr^.FixUp_Offset - StartReData;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
\r
PutToCodeFile(Ptr^.FixUp_No);\r
\r
FirstSegFixUp := Ptr^.ext_Ref;\r
END;\r
\r
\r
Put_Byte((MaxByte - CheckSum) MOD MaxByte);\r
\r
\r
END;\r
END;\r
\r
\r
(* -------------------------------------------------------------- *)\r
\r
\r
\r
PROCEDURE MakeFirstReData;\r
(* The procedure makes the first part of ReData *)\r
\r
VAR\r
Leng : Word;\r
FixUpp : St_Address;\r
NoFix : word;\r
\r
\r
\r
BEGIN \r
(* Find the length of the REDATA record *)\r
NoSegFixUp := 0;\r
FirstSegFixUp := St_NillAddr;\r
LastSegFixUp := St_NillAddr;\r
\r
NoFixUppToReData := 0;\r
IF Offset = 0 THEN\r
Leng := LengthOFExternalLBDR\r
ELSE\r
IF NoFixUpp = 0 THEN\r
Leng := FileOffset - Offset\r
\r
ELSE\r
BEGIN (* NoFixUpp <> 0 *)\r
IF (FileOffset - Offset) <= MaxReData THEN\r
BEGIN\r
Leng := FileOffset - Offset;\r
NoFixUppToReData := NoFixUpp;\r
END\r
ELSE\r
BEGIN\r
Leng := 0;\r
NoFix := NoFixUpp;\r
FixUpp := FirstFixUpp;\r
\r
WHILE NoFix > 0 DO\r
BEGIN\r
St_Retrieve(FixUpp,Ptr);\r
\r
IF (((Ptr^.FixUp_Offset - 1) - Offset) <= MaxReData) THEN\r
Leng := (Ptr^.FixUp_Offset - 1 ) - Offset;\r
IF (((Ptr^.FixUp_Offset + 4) - Offset) <= MaxReData) THEN\r
BEGIN\r
Leng := (Ptr^.FixUp_Offset + 4) - Offset;\r
NoFixUppToReData := NoFixUpptoReData + 1;\r
NoFix := NoFix - 1;\r
FixUpp := Ptr^.Ext_Ref;\r
END\r
ELSE\r
NoFix := 0;\r
END;\r
IF Leng = 0 THEN Leng := (Ptr^.FixUp_Offset - 1) - Offset;\r
\r
END;\r
END;\r
NewReData := Offset + Leng;\r
StartReData := Offset;\r
\r
(* Make First part of REDATA *) \r
CheckSum := 0;\r
PutToCodeFile($72);\r
\r
\r
\r
WordByte.w := Leng + 4;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
PutToCodeFile(CurrentSegNo);\r
\r
\r
WordByte.w := StartReData;\r
PutToCodeFile(WordByte.byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
\r
\r
END;\r
\r
\r
\r
\r
PROCEDURE InsertLineDiff;\r
(* This procedure is only used when making linetabel. The procedure \r
inserts the next linediff. in the linetabel *)\r
\r
BEGIN\r
WHILE (Offset - LineTabelOffset) >= Spacing DO\r
BEGIN\r
LineDiff := ( LineNumber - LastLine) + LineRest;\r
\r
IF LineDiff > 255 THEN\r
BEGIN\r
LineRest := LineDiff - 255;\r
LineDiff := 255;\r
END\r
ELSE\r
LineRest := 0;\r
LastLine := LineNumber;\r
\r
LineTabelOffset := LineTabelOffset + Spacing;\r
St_Get(TempLineTabelAddr,Ptr);\r
\r
Ptr^.Data_area[LineTabelIndex] := LineDiff;\r
LineTabelIndex := LineTabelIndex + 1;\r
\r
IF LineTabelIndex > Ptr^.St_Size THEN\r
BEGIN\r
TempLineTabelAddr := Ptr^.ListRef;\r
LineTabelIndex := 1;\r
END;\r
END;\r
END;\r
\r
\r
\r
\r
(* -------------------------------------------------------------- *)\r
\r
BEGIN (* MakePass4_2 *)\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
BEGIN\r
writeln(TestOutput,' START ','MakePass4_2');\r
END;\r
(*ENDTEST#*)\r
\r
CurrentPos := 0;\r
\r
\r
MakingLineTab := false;\r
\r
\r
\r
\r
Offset := 0;\r
NewReData := 1;\r
\r
(* TURBO *)\r
GetTBinFile;\r
\r
WHILE NOT eofTBinFile DO\r
BEGIN\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN write(TestOutPut,TBinFileptr,' ');\r
(*ENDTEST#*)\r
IF ((Offset = NewReData) AND (Offset <> FileOffset)) THEN\r
BEGIN\r
MakeLastReDataAndFixUpp;\r
(*#BEGINTEST\r
IF TestPass4 >= 0 THEN write('.');\r
(*ENDTEST#*)\r
MakeFirstReData;\r
END;\r
IF TBinFileptr = 0 THEN\r
BEGIN\r
getTBinFile;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN write(TestOutPut,TBinFileptr,' ');\r
(*ENDTEST#*)\r
\r
\r
CASE CodeFormat(TBinFileptr) OF\r
\r
DeclareLabel : (* Label *)\r
BEGIN\r
ReadSt_Address(Lab);\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
\r
St_Retrieve(Lab,Ptr);\r
IF Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) THEN\r
BEGIN (* write the label *)\r
WriteHexWord(Offset);\r
WriteSpace(LabelPos - CurrentPos);\r
\r
WriteLabel(Ptr);\r
\r
CurrentPos := 0;\r
END;\r
END;\r
\r
END;\r
\r
\r
ShortJump, NearUnCondJump : (* Short jump or near uncond jump *)\r
\r
BEGIN\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
END;\r
\r
IF CodeFormat(TBinFileptr) = ShortJump\r
THEN CodeLength := 2\r
ELSE CodeLength := 3;\r
\r
Offset := Offset + CodeLength;\r
\r
getTBinFile;\r
Inst := Instruction(TBinFileptr);\r
\r
\r
ReadSt_Address(Lab);\r
\r
St_Retrieve(Lab,Ptr);\r
WHILE NOT Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) DO\r
St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
\r
(* $NoCheck *)\r
WordByte.w := Ptr^.Label_Offset - Offset;\r
(* $Check *)\r
\r
IF codelength = 2 THEN\r
BEGIN\r
PutToCodeFile(OpcodeShort[Inst]);\r
\r
PutToCodeFile(WordByte.Byte1);\r
\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexByte(OpcodeShort[Inst]);\r
WriteHexByte(WordByte.Byte1);\r
END;\r
END\r
\r
ELSE (* codelength = 3 *)\r
BEGIN\r
PutToCodeFile(OpcodeNear[Inst]);\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexByte(OpcodeNear[Inst]);\r
\r
(* write Off *)\r
WriteHexByte(WordByte.Byte1);\r
WriteHexByte(WordByte.Byte2);\r
END;\r
END;\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteSpace(CodePos - CurrentPos);\r
write(CodeList, InstructionName[Inst]);\r
\r
(* write Label *)\r
WriteLabel(Ptr);\r
\r
\r
CurrentPos := 0;\r
END;\r
END;\r
\r
\r
\r
\r
NearCondJump : (* Near cond jump *)\r
\r
BEGIN\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
END;\r
\r
(* Make a short cond jump and a near uncond JMP*)\r
\r
Offset := Offset + 2;\r
\r
\r
GetTBinFile;\r
Inst := Instruction(TBinFileptr);\r
Inst := NegInstruction[Inst];\r
\r
PutToCodeFile(OpcodeShort[Inst]);\r
PutToCodeFile(3); (* Offset *)\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexByte(OpcodeShort[Inst]);\r
WriteHexByte(3);\r
WriteSpace(CodePos - CurrentPos);\r
Write(CodeList, InstructionName[Inst]);\r
writeln(CodeList,'?',Offset + 3,':');\r
CurrentPos := 0;\r
\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
END;\r
\r
Offset := Offset + 3;\r
\r
\r
PutToCodeFile(OpcodeNear[iJMP]);\r
\r
\r
ReadSt_Address(Lab);\r
\r
\r
St_Retrieve(Lab,Ptr);\r
WHILE NOT Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) DO\r
St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
\r
\r
(* $NoCheck *)\r
Off := Ptr^.Label_Offset - Offset;\r
(* $Check *)\r
\r
\r
(* Write Offset *)\r
WordByte.w := Off;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexByte(OpcodeNear[iJMP]);\r
\r
(* Write Offset *)\r
WriteHexByte(WordByte.Byte1);\r
WriteHexByte(WordByte.Byte2);\r
\r
WriteSpace(CodePos - Currentpos);\r
write(CodeList,InstructionName[iJMP]);\r
\r
\r
WriteLabel(Ptr);\r
\r
\r
\r
CurrentPos := 0;\r
\r
(* Print label *)\r
WriteHexWord(Offset);\r
WriteSpace(LabelPos - CurrentPos);\r
\r
writeln(CodeList,'?',Offset,':');\r
CurrentPos := 0;\r
END;\r
END;\r
\r
\r
\r
SetCode:\r
BEGIN\r
GetTBinFile;\r
CodeOnPass2 := TBinFileptr <> 255;\r
IF CodeOnPass2 THEN\r
WriteLn(CodeList,'$S',TBinFileptr);\r
END;\r
\r
ContextEnd :\r
IF LineTabel THEN\r
BEGIN\r
\r
(* Start Making linetabel *)\r
St_Reserve(LengthOfLineTabel - 8,LineTabelAddr,Ptr);\r
\r
LineTabelIndex := 1;\r
(* linenumber gives the line of endinclude *)\r
If FirstBlock THEN LineTab.FirstLine := LineNumber\r
ELSE LineNumber := LineTab.FirstLine;\r
LineTab.FirstOffset := Offset;\r
LineTab.OffsetSpacing := Spacing;\r
\r
LineTabelOffset := Offset;\r
MakingLineTab := true;\r
LastLine := LineTab.FirstLine;\r
LineRest := 0;\r
TempLineTabelAddr := LineTabelAddr;\r
FirstBlock := false;\r
END;\r
\r
\r
\r
\r
LineNo :\r
BEGIN\r
IF MakingLineTab THEN InsertLineDiff;\r
GetTBinFile;\r
WordByte.Byte1 := TBinFileptr;\r
GetTBinFile;\r
WordByte.Byte2 := TBinFileptr;\r
\r
LineNumber := wordByte.w;\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
writeln(CodeList,'$L',wordbyte.w);\r
END;\r
END;\r
\r
\r
LongJump :\r
BEGIN\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
END;\r
\r
GetTBinFile;\r
SegNumber := tbinFileptr;\r
GetTBinFile;\r
WordByte.Byte1 := tBinFileptr;\r
GetTBinFile;\r
WordByte.Byte2 := tBinFileptr;\r
RoutineOffset := WordByte.w;\r
\r
\r
PutToCodeFile(OpcodeLongJmp);\r
\r
(* write RoutineOffset *)\r
WordByte.w := RoutineOffset;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
PutToCodeFile(0);\r
PutToCodeFile(0); \r
\r
Offset := Offset + 5;\r
\r
St_New_Fixupp(SegNumber,Offset - 2, FirstSegFixUp,\r
LastSegFixUp);\r
NoSegFixUp := NoSegFixUp + 1;\r
\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexByte(OpCodeLongJmp);\r
WriteHexByte(WordByte.Byte1);\r
WriteHexByte(WordByte.Byte2);\r
WriteHexByte(0);\r
WriteHexByte(0);\r
\r
WriteSpace(CodePos - CurrentPos);\r
write(CodeList,InstructionName[iJMP]);\r
write(CodeList,SegNumber,' : ');\r
writeln(CodeList,RoutineOffset);\r
\r
CurrentPos := 0;\r
END;\r
END;\r
\r
\r
LongCall :\r
BEGIN\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
END;\r
\r
ReadSt_Address(Lab);\r
St_Retrieve(Lab,Ptr);\r
IF Ptr^.St_Kind = cType THEN\r
BEGIN\r
SegNumber := Ptr^.St_t_Seg_nr;\r
Lab := Ptr^.Type_Label;\r
UseLabel := true;\r
END\r
ELSE\r
BEGIN\r
SegNumber := Ptr^.St_Seg_Nr;\r
UseLabel := (Ptr^.St_Logic_nr = 0);\r
IF UseLabel THEN\r
Lab := Ptr^.St_Label\r
ELSE\r
RoutineOffset := LengthOfExternalLBDR +\r
((Ptr^.st_logic_nr - 1) * 3);\r
END;\r
\r
PutToCodeFile(OpcodeCallExt);\r
IF useLabel THEN\r
BEGIN\r
St_Retrieve(Lab,Ptr);\r
WHILE not equal_Addr(Ptr^.DefAsLabel,St_NillAddr) DO\r
St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
\r
RoutineOffset := Ptr^.Label_Offset;\r
END;\r
\r
(* write RoutineOffset *)\r
WordByte.w := RoutineOffset;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
PutToCodeFile(0); \r
PutToCodeFile(0); \r
\r
Offset := Offset + 5;\r
\r
St_New_Fixupp(SegNumber,Offset - 2, FirstSegFixUp,\r
LastSegFixUp);\r
NoSegFixUp := NoSegFixUp + 1;\r
\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexByte(OpCodecallext);\r
WriteHexByte(WordByte.Byte1);\r
WriteHexByte(WordByte.Byte2);\r
WriteHexByte(0);\r
WriteHexByte(0);\r
\r
WriteSpace(CodePos - CurrentPos);\r
write(CodeList,InstructionName[iCall]);\r
write(CodeList,SegNumber,' : ');\r
IF UseLabel THEN\r
WriteLabel(Ptr)\r
ELSE\r
write(CodeList,RoutineOffset);\r
writeln(CodeList);\r
CurrentPos := 0;\r
END;\r
END;\r
\r
\r
\r
\r
\r
AddLabelToDis : \r
\r
BEGIN\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
END;\r
\r
\r
\r
GetTBinFile;\r
\r
(* $NoCheck *)\r
Offset := Offset + TBinFileptr;\r
\r
\r
\r
FOR i := 1 TO (TBinFileptr - 2) DO\r
BEGIN\r
GetTBinFile;\r
PutToCodeFile(TBinFileptr);\r
\r
IF CodeOnPass2 THEN\r
WriteHexByte(TBinFileptr);\r
\r
\r
END;\r
\r
(* $Check *)\r
(* Read Displacement *)\r
GetTBinFile;\r
WordByte.Byte1 := TBinFileptr;\r
GetTBinFile;\r
WordByte.Byte2 := TBinFileptr;\r
Off := WordByte.w;\r
\r
\r
ReadSt_Address(Lab);\r
\r
St_Retrieve(Lab,Ptr);\r
WHILE NOT Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) DO\r
St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
\r
\r
\r
\r
\r
\r
\r
\r
(* Write Displacement *)\r
(* $NoCheck *)\r
WordByte.w := Ptr^.Label_Offset + Off;\r
(* $Check *)\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
\r
(* Write Offset *)\r
WriteHexByte(WordByte.Byte1);\r
WriteHexByte(WordByte.Byte2);\r
\r
WriteSpace(CodePos - Currentpos);\r
WHILE NOT eoln(TSymFile) DO\r
BEGIN\r
read(TSymFile,ch);\r
write(CodeList,ch);\r
END;\r
\r
\r
WriteLabel(Ptr);\r
readln(TSymFile);\r
CurrentPos := 0;\r
\r
END;\r
\r
END;\r
\r
CaseLabList : (* a list of case labels *)\r
BEGIN\r
(* get the number of labels *)\r
getTBinFile;\r
WordByte.Byte1 := TBinFileptr;\r
getTBinFile;\r
WordByte.Byte2 := TBinFileptr;\r
(* number of labels in WordByte.w *)\r
\r
NoLabels := WordByte.w;\r
ReadSt_Address(Lab);\r
ReadSt_Address(Lab1);\r
\r
St_Retrieve(Lab1,Ptr);\r
WHILE NOT Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) \r
DO St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
OtherwiseOffset := Ptr^.Label_Offset;\r
\r
WHILE NoLabels > 0 DO\r
BEGIN\r
St_Retrieve(Lab,Ptr);\r
Low := Ptr^.Label_Low;\r
High := Ptr^.Label_High;\r
\r
Lab1 := Ptr^.ListRef;\r
\r
WHILE NOT Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) \r
DO St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
FOR i := Low TO High DO\r
BEGIN\r
\r
\r
(* put label offset *)\r
WordByte.w := Ptr^.Label_Offset;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
WriteHexByte(WordByte.Byte1);\r
WriteHexByte(WordByte.Byte2);\r
WriteSpace(CodePos - CurrentPos);\r
write(CodeList,'DW ');\r
\r
(* write Label *)\r
WriteLabel(Ptr);\r
\r
CurrentPos := 0;\r
END;\r
\r
NoLabels := NoLabels - 1;\r
Offset := Offset + 2;\r
END;\r
\r
IF NoLabels > 0 THEN\r
BEGIN\r
St_Retrieve(Lab1,Ptr);\r
FOR i := (High + 1) TO (Ptr^.Label_Low - 1) DO\r
BEGIN\r
\r
(* put label offset *)\r
WordByte.w := OtherWiseOffset;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
WriteHexByte(WordByte.Byte1);\r
WriteHexByte(WordByte.Byte2);\r
WriteSpace(CodePos - CurrentPos);\r
write(CodeList,'DW ');\r
\r
(* write Label *)\r
Writeln(CodeList,'?',OtherWiseOffset,':');\r
\r
CurrentPos := 0;\r
END;\r
\r
NoLabels := NoLabels - 1;\r
Offset := Offset + 2;\r
END;\r
END;\r
Lab := Lab1;\r
END; (* While *)\r
\r
END;\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
\r
InternalLBDR: (* internal LBDR *)\r
BEGIN\r
IF CodeOnPass2 THEN\r
BEGIN\r
writeln(Codelist);\r
writeln(CodeList);\r
writeln(CodeList,' INTERNAL LBDR: ');\r
END;\r
\r
ReadSt_Address(Lab);\r
\r
(* Reads the InternalLBDR *)\r
FOR i := 1 TO LengthOfInternalLBDR DO\r
BEGIN\r
getTBinFile;\r
LBDR.Byt[i] := TBinFileptr;\r
END;\r
\r
(* EntryPoint *)\r
St_Retrieve(Lab,Ptr);\r
WHILE NOT Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) DO\r
St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
\r
LBDR.EntryPoint := Ptr^.Label_Offset;\r
\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','EntryPoint: ');\r
\r
WriteLabel(Ptr);\r
writeln(CodeList);\r
END;\r
\r
\r
(* LineTable *)\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','LineTable : ');\r
WriteHexWord(LBDR.LineTable);\r
writeln(Codelist);\r
END;\r
\r
(* GlobalSize *)\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','GlobalSize : ');\r
WriteHexWord(LBDR.GlobalSize);\r
writeln(Codelist);\r
END;\r
\r
(* Appetite *)\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','Appetite: ');\r
WriteHexWord(LBDR.Appetite);\r
writeln(CodeList);\r
\r
CurrentPos := 0;\r
END;\r
\r
\r
\r
(* Write LBDR To CodeFile *)\r
FOR i := 1 TO LengthOfInternalLBDR DO\r
BEGIN\r
PutToCodeFile(LBDR.Byt[i]);\r
END;\r
\r
\r
\r
Offset := Offset + LengthOfInternalLBDR;\r
END;\r
\r
\r
\r
\r
\r
\r
ExternalLBDR: (* external LBDR *)\r
BEGIN\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
writeln(Codelist);\r
writeln(CodeList);\r
writeln(CodeList,' EXTERNAL LBDR: ');\r
END;\r
\r
\r
ReadSt_Address(Lab);\r
\r
\r
(* Reads the ExternalLBDR *)\r
FOR i := 1 TO LengthOfExternalLBDR DO\r
BEGIN\r
getTBinFile;\r
LBDR.Byt[i] := TBinFileptr;\r
END;\r
\r
(* EntryPoint *)\r
St_Retrieve(Lab,Ptr);\r
WHILE NOT Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) DO\r
St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
\r
LBDR.EntryPoint := Ptr^.Label_Offset;\r
\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','EntryPoint: ');\r
\r
\r
WriteLabel(Ptr);\r
END;\r
\r
\r
(* LineTable *)\r
IF LineTabel THEN\r
BEGIN\r
IF FileOffset > (Max_Word - 10) THEN\r
Fatal_Error(Pass4,5);\r
LengthOfLineTabel :=\r
((FileOffset - 1 - ContextendOffset)\r
DIV Spacing) + 9;\r
IF FileOffset > (Max_Word - LengthOfLineTabel) THEN\r
Fatal_Error(Pass4,5);\r
END\r
ELSE\r
LengthOfLineTabel := 0;\r
\r
IF (FileOffset + LengthOfLineTabel) > (Max_Word -\r
LengthOfNameTabel) THEN Fatal_Error(pass4,6);\r
\r
LineTab.FirstLine := LineNumber;\r
\r
LBDR.LineTable := FileOffset + LengthOfLineTabel;\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','LineTable : ');\r
WriteHexWord(LBDR.LineTable);\r
writeln(Codelist);\r
END;\r
\r
(* GlobalSize *)\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','GlobalSize : ');\r
WriteHexWord(LBDR.GlobalSize);\r
writeln(Codelist);\r
END;\r
\r
(* Appetite *)\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','Appetite: ');\r
WriteHexWord(LBDR.Appetite);\r
writeln(CodeList);\r
END;\r
\r
\r
\r
(* SegSize *)\r
LBDR.SegSize := FileOffset + lengthOfnameTabel +\r
LengthOfLineTabel;\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','SegSize: ');\r
WriteHexWord(LBDR.SegSize);\r
writeln(CodeList);\r
END;\r
\r
\r
(* LinkCount *)\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','LinkCount: ');\r
WriteHexByte(LBDR.LinkCount);\r
writeln(CodeList);\r
END;\r
\r
\r
(* Next *)\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','Next: ');\r
WriteHexWord(LBDR.Next1);\r
WriteHexWord(LBDR.Next2);\r
writeln(CodeList);\r
END;\r
\r
\r
\r
(* BlName *)\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','BlockName: ');\r
(*FOR i := 1 TO LBDR.BlName.Length DO\r
write(CodeList,LBDR.BlName.Alfa[i]);\r
writeln(CodeList);*)\r
writeln(CodeList,LBDR.BlName);\r
END;\r
\r
\r
\r
(* BlKind *)\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','BlockKind: ');\r
WriteHexByte(LBDR.BlKind);\r
writeln(CodeList);\r
\r
CurrentPos := 0;\r
END;\r
\r
\r
IF CurrentSegNo = 1 THEN\r
BEGIN\r
\r
\r
(* Make RHEADR *)\r
CheckSum := 0;\r
PutToCodeFile($6E);\r
\r
WordByte.i := length(LBDR.BlName) + 2;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
PutToCodeFile(length(LBDR.BlName));\r
\r
FOR i := 1 TO length(LBDR.BlName)\r
DO\r
BEGIN\r
PutToCodeFile(ord(LBDR.BlName[i]));\r
END;\r
\r
\r
Put_Byte((MaxByte - CheckSum) MOD MaxByte);\r
\r
IF FirstRheAdr THEN DumpComment;\r
\r
FilePtrToSecSegDef := 4 + 5 + length(Lbdr.BlName) +\r
38 + ( 4 * 26) (* length of comment *)\r
+ 6 + 3;\r
\r
FOR stepw := CurrentSegNo TO Last_Segment DO\r
BEGIN\r
(* Make SegDef *)\r
CheckSum := 0;\r
PutToCodeFile($98);\r
\r
WordByte.i := 3;\r
PutToCodeFile(Wordbyte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
WordByte.w := LBDR.SegSize;;\r
PutToCodeFile(Wordbyte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
Put_Byte((MaxByte - CheckSum) MOD MaxByte);\r
END;\r
\r
\r
\r
\r
WriteEmptyRecord(TypDef);\r
\r
\r
\r
\r
\r
\r
(* Make ExtDef *)\r
CheckSum := 0;\r
PutToCodeFile($8C);\r
\r
helplength := LengthOfAllPreExtName;\r
\r
if last_segment = 1 then\r
for stepW := 1 to NoOfPI3Routines do\r
if preextcalled[stepW] =false then\r
begin\r
St_NameOfSpix(PreExtName[stepW],Str);\r
helplength := helpLength -\r
length(str^) +\r
5; (* length of fault *)\r
end;\r
\r
WordByte.w := LengthOfAllExtName + helplength\r
+ ( 2 * (NoExtDecl + NoPreExtDecl)) + 1;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
\r
(* Write the external names to codefile *)\r
St_Retrieve(FirstExtDec,Ptr);\r
\r
FOR StepW := 1 TO (NoExtDecl + NoPreExtDecl) DO\r
BEGIN\r
IF Stepw > NoPreExtDecl THEN\r
St_NameOfSpix(Ptr^.Ext_Spix,Str)\r
ELSE\r
if stepw > NoOfPI3Routines then\r
St_NameOfSpix(PreExtName[StepW],Str)\r
else\r
if preextcalled[stepw] or (last_segment > 1) then\r
St_NameOfSpix(PreExtName[StepW],Str)\r
else St_NameOfSpix(PreExtName[1],Str);\r
\r
\r
PutToCodeFile(length(Str^));\r
\r
FOR j := 1 TO length(Str^) DO\r
BEGIN\r
CharValue := ord(Str^[j]);\r
IF (( ord('a') <= CharValue) AND\r
( CharValue <= ord('z'))) THEN\r
CharValue := CharValue - ord('a') + ord('A');\r
\r
PutToCodeFile(charvalue);\r
\r
END;\r
\r
PutToCodeFile(0);\r
\r
IF Stepw > NoPreExtDecl THEN\r
St_Retrieve(Ptr^.Ext_Ref,Ptr);\r
\r
\r
END;\r
\r
\r
Put_Byte( (MaxByte - CheckSum) MOD MaxByte);\r
\r
\r
\r
\r
\r
\r
(* Make THEADR *)\r
CheckSum := 0;\r
PutToCodeFile($080);\r
\r
WordByte.i := length(LBDR.BlName) + 2;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
PutToCodeFile(length(LBDR.BlName));\r
\r
FOR i := 1 TO length(LBDR.BlName)\r
DO\r
BEGIN\r
PutToCodeFile(ord(LBDR.BlName[i]));\r
END;\r
\r
\r
Put_Byte( (MaxByte - CheckSum) MOD MaxByte);\r
END\r
ELSE\r
Segment_Info[CurrentSegNo].size := LBDR.SegSize;\r
\r
\r
\r
(* Make First part of REDATA *)\r
MakeFirstReData;\r
\r
\r
\r
(* Write LBDR To CodeFile *)\r
FOR i := 1 TO LengthOfExternalLBDR DO\r
BEGIN\r
PutToCodeFile(LBDR.Byt[i]);\r
END;\r
\r
\r
\r
Offset := LengthOfExternalLBDR;\r
END;\r
\r
END; (* end case *)\r
\r
END\r
ELSE\r
BEGIN\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(offset);\r
WriteSpace(2);\r
END;\r
\r
Offset := Offset + TBinFileptr;\r
FOR i := 1 TO TBinFileptr DO\r
BEGIN\r
getTBinFile;\r
PutToCodeFile(TBinFileptr);\r
IF CodeOnPass2 THEN WriteHexByte(TBinFileptr);\r
END;\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteSpace(CodePos - CurrentPos);\r
WHILE NOT eoln(TSymFile) DO\r
BEGIN\r
read(TSymFile,ch);\r
write(CodeList,ch);\r
END;\r
\r
readln(TSymFile);\r
writeln(CodeList);\r
CurrentPos := 0;\r
END;\r
END;\r
\r
IF NOT eofTBinFile THEN getTBinFile;\r
\r
END; (* while *)\r
\r
(* Make the last part of REDATA *)\r
MakeLastReDataAndFixUpp;\r
\r
\r
\r
(* Dump NameEntry And LineTabel*)\r
\r
CheckSum := 0;\r
PutToCodeFile($72);\r
WordByte.w := LengthOfNameTabel + 4 + LengthOfLineTabel;\r
PutToCodeFile(WordByte.byte1);\r
PutToCodeFile(WordByte.byte2);\r
\r
PutToCodeFile(CurrentSegNo);\r
\r
WordByte.w := offset;\r
PutToCodeFile(WordByte.byte1);\r
PutToCodeFile(WordByte.byte2);\r
\r
\r
IF LengthOfLineTabel <> 0 THEN\r
BEGIN (* Dump LineTabel *)\r
LineTab.LastOffset := FileOffset - 1;\r
\r
IF Offset > LineTabelOffset THEN\r
BEGIN\r
(* Insert last line diff. *)\r
LineDiff := LineNumber - LastLine + LineRest;\r
IF LineDiff > 255 THEN LineDiff := 255;\r
St_Get(TempLineTabelAddr,Ptr);\r
Ptr^.Data_Area[LineTabelIndex] := LineDiff;\r
END;\r
\r
FOR i := 1 to 8 do PutToCodeFile(LineTab.a[i]);\r
\r
TempLineTabelAddr := LineTabelAddr;\r
WHILE Not Equal_Addr(TempLineTabelAddr,St_StopAddr) DO\r
BEGIN\r
St_Retrieve(TempLineTabelAddr,Ptr);\r
For Stepw := 1 TO Ptr^.St_Size DO \r
PutToCodeFile(Ptr^.Data_area[Stepw]);\r
TempLineTabelAddr := Ptr^.ListRef;\r
END;\r
END;\r
\r
\r
IF LengthOfLineTabel = 0 THEN\r
WordByte.w := 0\r
ELSE\r
WordByte.w := FileOffset;\r
PutToCodeFile(WordByte.byte1);\r
PutToCodeFile(WordByte.byte2);\r
\r
Offset := offset + LengthOfLineTabel + 2;\r
\r
WHILE Not Equal_Addr(LastNameEntry,St_NillAddr) DO\r
BEGIN\r
St_Retrieve(LastNameEntry,Ptr);\r
IF Ptr^.St_Kind = CType THEN\r
BEGIN\r
LastNameEntry := Ptr^.T_Name_Entry_List;\r
NameEntry.FirstOffset := Ptr^.T_First_Offset;\r
NameEntry.LastOffset := Ptr^.T_Last_Offset;\r
IF Ptr^.St_T_local_near THEN\r
NameEntry.BlockType := 0 (* internal *)\r
ELSE\r
NameEntry.BlockType := 1; (* external *)\r
END\r
ELSE\r
BEGIN\r
LastNameEntry := Ptr^.Name_Entry_List;\r
NameEntry.FirstOffset := Ptr^.First_Offset;\r
NameEntry.LastOffset := Ptr^.Last_Offset;\r
IF (Ptr^.St_Specs = St_Local) AND (Ptr^.St_Local_Near) THEN\r
NameEntry.BlockType := 0 (* internal *)\r
ELSE\r
NameEntry.BlockType := 1; (* External *)\r
END;\r
\r
St_nameOfSpix(Ptr^.St_Spix,Str);\r
\r
NameEntry.Length := length(Str^);\r
Leng := length(Str^) + 8;\r
IF Not Equal_Addr(LastNameEntry,St_NillAddr) THEN\r
NameEntry.NextName := Offset + Leng\r
ELSE\r
NameEntry.NextName := 0; \r
\r
\r
For i := 1 to 8 do PutToCodefile(NameEntry.a[i]);\r
For stepw := 1 to length(Str^) do\r
PutToCodefile(ord(Str^[stepw]));\r
\r
Offset := offset + leng;\r
END;\r
\r
\r
Put_Byte( (MaxByte - CheckSum) MOD MaxByte);\r
\r
IF Last_Segment = 1 THEN\r
BEGIN (* no user segment *)\r
St_Get(GlobalBlockSymbol,Ptr);\r
Ptr^.St_Size := Offset;\r
END\r
ELSE\r
Segment_Info[CurrentSegNo].Code_Size := Offset;\r
\r
\r
IF CurrentSegNo = Last_Segment THEN\r
BEGIN\r
(* Make ModEnd *)\r
CheckSum := 0;\r
PutToCodeFile($8A);\r
\r
WordByte.i := 2;\r
PutToCodeFile(WordByte.Byte1);\r
PutToCodeFile(WordByte.Byte2);\r
\r
PutToCodeFile(1);\r
\r
Put_Byte( (MaxByte - CheckSum) MOD MaxByte);\r
END;\r
\r
(*#BEGINTEST\r
IF TestPass4 >= 10 THEN\r
BEGIN\r
writeln(TestOutput,' START ','MakePass4_2');\r
END;\r
(*ENDTEST#*)\r
\r
\r
END; (* MakePass4_2 *)\r
\r
\r
\r
(* ---------------------------------------------------------- *)\r
\r
\r
\r
\r
END\r
.\r
\r
\r
\r
(* -------- PRIVATE PASS4_2 --------------------- PASS4_2 -------*)\r
\r
\r
\r
\r
\r
«eof»