|
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: 45130 (0xb04a)
Types: TextFile
Names: »P450.PAS«
└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
└─⟦this⟧ »RTP\P450.PAS«
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
└─⟦this⟧ »RTP\P450.PAS«
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
└─⟦this⟧ »RTP\P450.PAS«
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
└─⟦this⟧ »P450.PAS«
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
└─⟦this⟧ »RTP\P450.PAS«
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
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
(* The following procedure writes on file CodeList *)\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
Str : Ptr_string;\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
write(CodeList,':');\r
END\r
ELSE\r
BEGIN\r
write(CodeList,'?',Lab^.MegaLabel_Offset,':');\r
END;\r
\r
END; (* WriteLabel *)\r
\r
PROCEDURE MegaPutInteger(ww : Longint);\r
VAR w : array[0..4] of byte;\r
i : integer;\r
out : boolean;\r
BEGIN\r
for i := 0 To 4 do\r
w[4 - i] := (ww SHR (7 * i)) AND 127;\r
out := false;\r
for i := 0 to 3 do\r
begin\r
out := Out or (w[i] <> 0) or (w[i + 1] >= 64);\r
if out then put_byte(128 + w[i]);\r
end;\r
put_byte(w[4]);\r
END;\r
\r
Procedure MegaPutIntegerValue(w:Longint);\r
BEGIN\r
Put_byte(117);\r
MegaPutInteger(4);\r
wordbyte.i := w;\r
Put_byte(wordbyte.byte1);\r
Put_byte(wordbyte.byte2);\r
w := w SHR 16;\r
wordbyte.i := w;\r
Put_byte(wordbyte.byte1);\r
Put_byte(wordbyte.byte2);\r
END;\r
\r
PROCEDURE MegaPutName(s: String);\r
VAR i : Integer;\r
BEGIN\r
MegaPutInteger(length(s));\r
FOR i := 1 TO Length(s) DO Put_byte(ORD(s[i]));\r
END;\r
\r
PROCEDURE MegaPutExtName(s: String);\r
VAR i, j : Integer;\r
BEGIN\r
j := Length(s);\r
FOR i := 1 TO Length(s) DO\r
IF s[i] = '_' THEN j := j - 1;\r
MegaPutInteger(j);\r
FOR i := 1 TO Length(s) DO\r
IF s[i] <> '_' THEN Put_byte(ORD(s[i]));\r
END;\r
\r
PROCEDURE MegaPutExt(VAR ext: String);\r
VAR i : integer;\r
BEGIN\r
Put_byte(34);\r
for i := 1 to Length(ext) do\r
BEGIN\r
IF (ord(ext[i]) >= ord('A')) AND (ord(ext[i]) <= ord('Z')) THEN\r
ext[i] := chr(ord(ext[i]) - ord('A') + ord('a') );\r
END;\r
MegaPutExtName(ext);\r
END;\r
\r
PROCEDURE ReadRestSymLine;\r
VAR Ch : char;\r
BEGIN\r
WHILE NOT eoln(TSymFile) DO\r
BEGIN\r
read(TSymFile,ch);\r
write(CodeList,ch);\r
END;\r
readln(TSymFile);\r
writeln(CodeList);\r
CurrentPos := 0;\r
END;\r
\r
PROCEDURE MegaPutCallExt(Inst: CodeFormat;\r
Offz: Longint; ExtNo: Integer);\r
VAR i : Integer;\r
Noop : byte;\r
BEGIN\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
END;\r
\r
If Inst = LongJump THEN Put_byte(0) ELSE Put_byte(9);\r
MegaPutInteger(Offz);\r
Put_byte(37);\r
MegaPutInteger(ExtNo);\r
Put_byte(117);\r
MegaPutInteger(8);\r
noop := MegaInstructionValue[mPFIX] AND 255;\r
FOR i := 1 TO 8 DO Put_byte(noop);\r
Offset := Offset + 8;\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteSpace(CodePos - CurrentPos);\r
FOR i := 1 TO 4 DO WriteHexByte(noop);\r
Writeln(Codelist);\r
Currentpos := 0;\r
WriteHexWord(Offset-4);\r
WriteSpace(CodePos - CurrentPos);\r
FOR i := 1 TO 4 DO WriteHexByte(noop);\r
WriteSpace(CommentPos - CurrentPos + 1);\r
ReadRestSymLine;\r
END;\r
END;\r
\r
PROCEDURE MegaPutDefineExt(VAR routine: String; CodePos: Longint);\r
VAR i: Integer;\r
c : char;\r
BEGIN\r
Put_byte(45);\r
for i := 1 to Length(routine) do\r
BEGIN\r
IF (ord(routine[i]) >= ord('A')) AND\r
(ord(routine[i]) <= ord('Z')) THEN\r
routine[i] := chr(ord(routine[i]) - ord('A') + ord('a') );\r
END;\r
MegaPutExtName(routine);\r
MegaPutInteger(CodePos);\r
END;\r
\r
PROCEDURE MegaPutCode(CodeLength: Integer);\r
VAR i, j, InstLength : Integer;\r
ch : Char;\r
BEGIN\r
Put_byte(117);\r
MegaPutInteger(CodeLength);\r
i := 0;\r
WHILE i < CodeLength DO\r
BEGIN\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
WriteSpace(CodePos - CurrentPos);\r
Read(Tsymfile, InstLength);\r
FOR j := 1 TO InstLength DO\r
BEGIN\r
GetTBinfile;\r
WriteHexByte(Tbinfileptr);\r
Put_byte(Tbinfileptr);\r
END;\r
WriteSpace(CommentPos - CurrentPos);\r
ReadRestSymLine;\r
i := i + InstLength;\r
Offset := Offset + InstLength;\r
END ELSE\r
BEGIN\r
GetTBinfile;\r
Put_byte(Tbinfileptr);\r
i := i + 1;\r
Offset := Offset + 1;\r
END;\r
END;\r
END;\r
\r
Procedure MegaPutPfixInst(Inst : Instruction; Value: Longint;\r
Var InstLength : Integer; minlength : integer);\r
VAR Pfix : Pfix_type;\r
i : Integer;\r
BEGIN\r
IF (Inst = mJ) AND (Value = 0) THEN Inst := mPFIX;\r
MegaPfixCode(Inst, Value, Pfix,Minlength);\r
Put_byte(117);\r
InstLength := Pfix.Prefixes;\r
MegaPutInteger(InstLength);\r
FOR i:=1 TO InstLength DO Put_byte(Pfix.Code[i]);\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(2);\r
WriteSpace(CodePos - CurrentPos);\r
FOR i:=1 TO InstLength DO WriteHexByte(Pfix.Code[i]);\r
WriteSpace(commentPos - CurrentPos);\r
write(Codelist, ' ', MegaInstructionName[Inst],' ');\r
END;\r
\r
END;\r
\r
PROCEDURE MegaPutJump(VAR Rec: Tempbin1_record; Offz: Integer);\r
VAR Inst : Instruction;\r
Pfix : Pfix_type;\r
InstLength, i : Integer;\r
Ptr : St_Elemptr;\r
RelJumpValue,helpoffset : Longint;\r
BEGIN\r
i := Rec.Bin1Param;\r
\r
CASE Rec.Bin1Code OF\r
UnCondJump : Inst := mJ;\r
CondJump : Inst := mCJ;\r
InternalCall: Inst := mCALL;\r
ELSE\r
BEGIN\r
Inst := mLDC;\r
i := i - 2;\r
END;\r
END;\r
\r
RelJumpValue := Offset + Rec.Bin1Param;\r
St_Retrieve(Rec.Bin1Label,Ptr);\r
IF Inst <> mLDC THEN\r
WHILE NOT Equal_Addr(Ptr^.DefAsLabel,St_NillAddr)\r
DO St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
HelpOffset := Offz + Ptr^.MegaLabel_Offset;\r
IF Offset > HelpOffset THEN\r
RelJumpValue := -(RelJumpValue - HelpOffset) ELSE\r
RelJumpValue := HelpOffset - RelJumpValue;\r
\r
\r
MegaPutPfixInst(Inst, RelJumpValue, InstLength, i);\r
\r
IF Inst = mLDC THEN\r
BEGIN\r
Put_byte(117);\r
MegaPutInteger(2);\r
WordByte.w := MegaInstructionValue[mLDPI];\r
Put_Byte(WordByte.Byte2);\r
Put_Byte(WordByte.Byte1);\r
END;\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteLabel(Ptr);\r
IF Offz <> 0 THEN write(Codelist,' + ',Offz);\r
Writeln(Codelist);\r
Offset := Offset +InstLength;\r
CurrentPos := 0;\r
If Inst = mLDC THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
WriteHexWord(MegaInstructionValue[mLDPI]);\r
WriteSpace(commentPos - CurrentPos);\r
writeln(Codelist, ' ', MegaInstructionName[mLDPI]);\r
CurrentPos := 0;\r
Offset := Offset + 2;\r
END;\r
END ELSE\r
BEGIN\r
Offset := Offset + InstLength;\r
IF Inst = mLDC THEN Offset := Offset + 2;\r
END;\r
END;\r
\r
\r
PROCEDURE MakePass4_2;\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, Lab2 : St_Address;\r
Inst : Instruction;\r
Low, High : integer;\r
Off, OtherwiseOffset : Longint;\r
(* Gives the offset of the next byte written to\r
CodeFile *)\r
Str : Ptr_string;\r
LastLBDR : longint;\r
firstlbdr : boolean;\r
CurrentFile1 : Boolean;\r
\r
JumpRec1,Helprec : Tempbin1_record;\r
StartOffset : LongInt;\r
DateAndTime : DateTime;\r
CONST\r
NameEntryLength = 10;\r
LineTabLength = 16;\r
VAR\r
NameEntry :\r
record\r
case b : boolean of\r
true : ( firstOffset : Longint;\r
CodeLength : Longint;\r
blocktype : byte;\r
length : byte);\r
false : ( a : array[1..NameEntryLength] of byte);\r
end;\r
\r
LineTab :\r
Record\r
case b : boolean of\r
true : ( FirstLine : Longint;\r
FirstOffset : Longint;\r
OffsetSpacing : Longint;\r
LastOffset : Longint );\r
False : ( a : array[1..LineTabLength] of byte)\r
End;\r
\r
\r
LengthOfLineTabel : word ;\r
LineTabelAddr, TempLineTabelAddr : St_Address;\r
LineTabelIndex : Word;\r
LineTabelOffset : Longint;\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
CodeDumpLength : integer;\r
skip : boolean;\r
ActivePI3Routines : Integer;\r
ConvertExtNumber:Array[1..NoOfPi3RoutinesAndSetRoutines] OF Integer;\r
help : longint;\r
allignedLengthOfNameTable : word;\r
bigstring : String[255];\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
PROCEDURE ResetBin1Files;\r
BEGIN\r
St_unlock(JumpRec);\r
ST_get(FirstTempPage, JumpRec);\r
tempIndex := 0;\r
ST_lock(JumpRec);\r
END;\r
\r
PROCEDURE ReadJumpRec(VAR r: Tempbin1_record);\r
BEGIN\r
NextTempPage;\r
r := JumpRec^.Jump_data[TempIndex];\r
END;\r
\r
PROCEDURE WriteJumpRec(VAR r: Tempbin1_record);\r
BEGIN\r
JumpRec^.Jump_data[TempIndex] := R;\r
END;\r
\r
PROCEDURE ReadLabelDisp(VAR Disp: Integer);\r
BEGIN\r
NextTempPage;\r
Disp := JumpRec^.Jump_data[TempIndex].Bin1Label.Va_High;\r
END;\r
\r
PROCEDURE InsertJumpSizes;\r
VAR Stable : Boolean;\r
JumpBack : Boolean;\r
InstLength : Integer;\r
InstCode : Pfix_type;\r
noturns : integer;\r
diff : integer;\r
BEGIN\r
\r
noturns := 2;\r
offset := internaloffset;\r
REPEAT\r
(* writeln('stabel fors off: ',offset,' noturns ',noturns,' diff ',diff);*)\r
Stable := True;\r
Offset := 0;\r
diff := 0;\r
ResetBin1Files;\r
\r
WHILE NOT eofTempPage DO\r
BEGIN\r
\r
ReadJumpRec(JumpRec1);\r
Offset := Offset + JumpRec1.Bin2Code;\r
\r
CASE JumpRec1.Bin1Code OF\r
\r
Lineno:;\r
\r
DeclareLabel : (* Label *)\r
BEGIN\r
St_Get(JumpRec1.Bin1Label, Ptr);\r
Ptr^.MegaLabel_offset := Offset;\r
Ptr^.Label_Scope := NoTurns;\r
END;\r
\r
TempSTL:\r
Offset := Offset + MegaPfixNo(JumpRec1.Bin1Label.Va_high);\r
\r
AddLabelToDis :\r
BEGIN\r
St_Retrieve(JumpRec1.Bin1Label,Ptr);\r
WHILE NOT Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) DO\r
St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
ReadJumpRec( Helprec);\r
JumpBack := Ptr^.Label_scope = NoTurns;\r
IF JumpBack then\r
InstLength := 0\r
else\r
InstLength := diff;\r
\r
InstLength := 2 + MegaPfixNo(Ptr^.MegaLabel_Offset +\r
Helprec.Bin1Label.Va_high +\r
Instlength +\r
-(Offset+JumpRec1.Bin1Param));\r
\r
IF (InstLength > JumpRec1.Bin1Param) OR\r
(( noturns > 0) AND (InstLength <> JumpRec1.Bin1Param))THEN\r
BEGIN\r
(* writeln('addlabtodis instlength ' , instlength,\r
' old ',JumpRec1.bin1param,' off ',offset,\r
' label ', Ptr^.MegaLabel_Offset);*)\r
\r
Stable := False;\r
diff := diff + (InstLength - JumpRec1.Bin1Param);\r
JumpRec1.Bin1Param := InstLength;\r
END;\r
Offset := Offset + JumpRec1.Bin1Param;\r
JumpRec^.Jump_data[TempIndex-1] := JumpRec1;\r
JumpRec1 := Helprec;\r
END;\r
\r
\r
UnCondJump, InternalCall, CondJump :\r
BEGIN\r
St_Retrieve(JumpRec1.Bin1Label,Ptr);\r
WHILE NOT Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) DO\r
St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
JumpBack := Ptr^.Label_scope = NoTurns;\r
IF JumpBack then\r
InstLength := 0\r
else\r
InstLength := diff;\r
InstLength := MegaPfixNo(Ptr^.MegaLabel_Offset +\r
InstLength\r
-(Offset+JumpRec1.Bin1Param));\r
\r
IF (InstLength > JumpRec1.Bin1Param) OR\r
(( noturns > 0) AND (InstLength <> JumpRec1.Bin1Param)) THEN\r
BEGIN\r
(*\r
writeln('jump instlength ' , instlength,\r
' old ',JumpRec1.bin1param,'off ' ,offset,\r
' label ', Ptr^.MegaLabel_Offset ,\r
' back ', ord(jumpback),\r
' diff ',diff);*)\r
Stable := False;\r
diff := diff + (InstLength - JumpRec1.Bin1Param);\r
JumpRec1.Bin1Param := InstLength;\r
END;\r
Offset := Offset + JumpRec1.Bin1Param;\r
END;\r
\r
ExternalCall,\r
LongJump:\r
BEGIN\r
Offset := Offset + 8;\r
END;\r
\r
CaseLabList : (* a list of case labels *)\r
BEGIN\r
Offset := Offset + JumpRec1.Bin1Param;\r
END;\r
\r
AllignCode : (* a list of case labels *)\r
BEGIN\r
InstLength := ((Offset+3)DIV 4)*4 - Offset;\r
IF (InstLength <> JumpRec1.Bin1Param) THEN\r
BEGIN\r
(* writeln('allign instlength ' , instlength,\r
' old ',JumpRec1.bin1param,\r
' off ' ,offset);*)\r
Stable := False;\r
Diff := Diff + (InstLength - JumpRec1.Bin1Param);\r
JumpRec1.Bin1Param := InstLength;\r
END;\r
Offset := Offset + JumpRec1.Bin1Param;\r
END;\r
\r
ExternalLBDR: (* external LBDR *)\r
BEGIN\r
Offset := Offset + 40;\r
END;\r
\r
InternalLBDR: (* external LBDR *)\r
BEGIN\r
Offset := Offset + 28;\r
END;\r
\r
ELSE;\r
\r
END; (* end case *)\r
\r
WriteJumpRec(JumpRec1);\r
\r
END; (* while *)\r
\r
CurrentFile1 := NOT CurrentFile1;\r
\r
noturns := noturns - 1;\r
\r
UNTIL Stable;\r
END;\r
PROCEDURE MegaPutAllign(off : integer);\r
Var i : Integer;\r
BEGIN\r
IF CodeOnPass2 THEN\r
IF off > 0 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
END;\r
For i := 1 TO Off DO\r
BEGIN\r
IF CodeOnPass2 THEN WriteHexByte(32);\r
Put_byte(32);\r
Offset := Offset + 1;\r
END;\r
IF CodeOnPass2 THEN\r
IF Off > 0 THEN\r
BEGIN\r
Writespace(CommentPos - CurrentPos);\r
CurrentPos := 0;\r
Writeln(Codelist,' ALLIGNMENT');\r
END;\r
\r
END;\r
\r
PROCEDURE DumpNameEntryOnCodeList;\r
VAR i : integer;\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
\r
For i := 1 to NameEntryLength do writehexbyte(NameEntry.a[i]);\r
writeln(CodeList, ' Firstoff(L), CodeLength(L), Type(B), Length(B)');\r
CurrentPos := 0;\r
WriteHexWord(Offset + NameEntryLength);\r
WriteSpace(CodePos - CurrentPos);\r
For i := 1 to length(Str^) do\r
WriteHexbyte(ord(Str^[i]));\r
WriteSpace(CommentPos - CurrentPos);\r
writeSpace(1);\r
Writeln(CodeList,Str^);\r
CurrentPos := 0;\r
END;\r
\r
\r
PROCEDURE DumpLineTableStartOnCodeList;\r
VAR i : integer;\r
BEGIN\r
Writeln(CodeList,' LineTable:');\r
WriteHexWord(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
FOR i := 1 to LineTabLength do WriteHexbyte(LineTab.a[i]);\r
writeln(CodeList, ' Firstline(L), Firstoff(L), Spacing(L), Lastoff(L)');\r
CurrentPos := 0;\r
END;\r
\r
BEGIN (* MakePass4_2 *)\r
\r
LastLBDR := 0;\r
LengthOfLineTabel := 0;\r
FirstLBDR := true;\r
CurrentFile1 := True;\r
\r
InsertJumpSizes;\r
\r
InternalOffset := Offset;\r
\r
Put_byte(89); (*112*)\r
Put_byte(10); (* For All Transputers: T414, T425, and T800 *)\r
Put_byte(1);\r
MegaPutName('occam 2 product compiler (19th September 1988)');\r
MegaPutName('RTP Compiler to Transputer 414');\r
\r
(* Write the external names to codefile *)\r
St_Retrieve(FirstExtDec,Ptr);\r
\r
j := 0;\r
for i := 1 to NoOfPi3RoutinesAndSetRoutines DO\r
IF Not Equal_Addr(PreExtCalled[i], St_Stopaddr) THEN\r
BEGIN\r
ConvertExtNumber[i] := j;\r
j := j + 1;\r
END;\r
\r
ActivePI3Routines := j;\r
\r
FOR i := 1 TO (NoExtDecl + NoPreExtDecl) DO\r
BEGIN\r
skip := false;\r
IF i > NoPreExtDecl THEN\r
St_NameOfSpix(Ptr^.Ext_Spix,Str)\r
ELSE\r
IF Not Equal_Addr(PreExtCalled[i], St_Stopaddr) THEN\r
St_NameOfSpix(PreExtName[i],Str)\r
else\r
skip := true;\r
\r
if not skip THEN MegaPutExt(Str^);\r
\r
IF i > NoPreExtDecl THEN\r
BEGIN\r
Lab1 := Ptr^.Ext_ref;\r
(* MakeParamDesc(Ptr^.Ext_owner,bigstring);\r
Put_byte(111);\r
MegaPutName(bigstring);\r
*) St_Retrieve(Lab1,Ptr);\r
END;\r
\r
\r
END;\r
\r
\r
CurrentPos := 0;\r
CodeDumpLength:= 0;\r
MakingLineTab := false;\r
Offset := 0;\r
Init_pass4_2;\r
\r
ResetBin1Files;\r
\r
WHILE NOT eofTempPage DO\r
BEGIN\r
\r
ReadJumpRec(JumpRec1);\r
CodeDumpLength := CodeDumpLength + JumpRec1.Bin2Code;\r
IF JumpRec1.Bin1Code <> LineNo THEN\r
BEGIN\r
IF CodeDumpLength <> 0 THEN MegaPutCode(CodeDumpLength);\r
CodeDumpLength := 0;\r
END;\r
CASE JumpRec1.Bin1Code OF\r
\r
LineNo :\r
BEGIN\r
IF MakingLineTab THEN InsertLineDiff;\r
LineNumber := JumpRec1.Bin1Label.va_high;\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
writeln(CodeList,'$L',LineNumber);\r
END;\r
END;\r
\r
\r
DeclareLabel : (* Label *)\r
BEGIN\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
St_Retrieve(JumpRec1.Bin1Label, Ptr);\r
IF Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) THEN\r
BEGIN (* write the label *)\r
WriteHexWord(Offset);\r
WriteSpace(LabelPos - CurrentPos);\r
WriteLabel(Ptr);\r
Writeln(Codelist);\r
CurrentPos := 0;\r
END;\r
END;\r
\r
END;\r
\r
\r
SetCode:\r
BEGIN\r
CodeOnPass2 := JumpRec1.Bin1Label.Va_high <> 255;\r
IF CodeOnPass2 THEN\r
WriteLn(CodeList,'$S',JumpRec1.Bin1Label.Va_high);\r
END;\r
\r
ContextEnd :\r
IF LineTabel THEN\r
BEGIN\r
LengthOfLineTabel := (InternalOffset - offset) DIV Spacing\r
+ 1;\r
(* Start Making linetabel *)\r
St_Reserve(LengthOfLineTabel,LineTabelAddr,Ptr);\r
\r
LineTabelIndex := 1;\r
(* linenumber gives the line of endinclude *)\r
LineTab.FirstLine := LineNumber;\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
END;\r
\r
\r
RoutineStart :\r
BEGIN\r
(* Get Routine node *)\r
St_Get(JumpRec1.Bin1Label,Ptr);\r
IF Ptr^.St_Kind = cType THEN\r
BEGIN\r
Ptr^.MegaT_First_Offset := Offset;\r
Ptr^.t_Name_Entry_List := LastNameEntry;\r
END\r
ELSE\r
BEGIN\r
IF (Ptr^.St_Kind = cProgram) AND\r
(Ptr^.St_Specs = St_Global) THEN\r
StartOffset := Offset;\r
Ptr^.MegaFirst_Offset := Offset;\r
Ptr^.Name_Entry_List := LastNameEntry;\r
END;\r
\r
LastNameEntry := JumpRec1.Bin1Label;\r
(* update lengthofnametabel *)\r
st_NameofSpix(Ptr^.St_Spix,Str);\r
LengthOfNameTabel := LengthOfNameTabel + length(Str^)\r
+ NameEntryLength;\r
END;\r
\r
\r
\r
RoutineStop :\r
BEGIN\r
St_Get(JumpRec1.Bin1Label,Ptr);\r
IF Ptr^.St_Kind = cType THEN\r
BEGIN\r
Ptr^.MegaT_Last_Offset := Offset-1;\r
END\r
ELSE\r
BEGIN\r
IF (Ptr^.St_Kind = cProgram) AND\r
(Ptr^.St_Specs = St_Global) THEN\r
BEGIN\r
Ptr^.St_Size := Offset - StartOffset;\r
Ptr^.Last_offset := (Offset - StartOffset) SHR 16;\r
END;\r
Ptr^.MegaLast_Offset := Offset-1;\r
St_Retrieve(Ptr^.St_Label,Ptr);\r
WHILE Not Equal_Addr(Ptr^.DefAsLabel,St_NillAddr) DO\r
St_Retrieve(Ptr^.DefAsLabel,Ptr);\r
help := ptr^.MegaLabel_Offset;\r
St_Get(JumpRec1.Bin1Label,Ptr);\r
Ptr^.MegaFirst_Offset :=help;\r
END;\r
SizeOfConst := offset;\r
END;\r
\r
TempSTL:\r
BEGIN\r
MegaPutPfixInst(mSTL, JumpRec1.Bin1Label.Va_High, i,0);\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
writeln(Codelist, ' ', JumpRec1.Bin1Label.Va_high);\r
CurrentPos := 0;\r
END;\r
\r
Offset := Offset + i;\r
END;\r
\r
AddLabelToDis :\r
BEGIN\r
ReadLabelDisp(i);\r
MegaPutJump(JumpRec1, i);\r
END;\r
\r
UnCondJump, InternalCall, CondJump :\r
BEGIN\r
MegaPutJump(JumpRec1,0);\r
END;\r
\r
LongJump,\r
ExternalCall:\r
BEGIN\r
i := JumpRec1.Bin1Label.Va_high;\r
IF i < NoOfPI3RoutinesAndSetRoutines THEN\r
BEGIN\r
i := ConvertExtNumber[i+1];\r
END ELSE\r
BEGIN\r
i :=i-NoOfPi3RoutinesAndSetRoutines+ActivePI3Routines;\r
END;\r
MegaPutCallExt(JumpRec1.Bin1Code,Offset,i);\r
END;\r
\r
CaseLabList : (* a list of case labels *)\r
BEGIN\r
Put_byte(117);\r
MegaPutInteger(JumpRec1.Bin1Param);\r
NoLabels := JumpRec1.Bin1Label.Va_High;\r
ReadJumpRec(JumpRec1);\r
Lab := JumpRec1.Bin1Label; (* Casetable *)\r
\r
ReadJumpRec(JumpRec1);\r
Lab1 := JumpRec1.Bin1Label; (* Otherwise *)\r
\r
ReadJumpRec(JumpRec1);\r
Lab2 := JumpRec1.Bin1Label; (* IndJump *)\r
\r
St_Get(Lab2, Ptr);\r
Off := Ptr^.MegaLabel_Offset;\r
\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^.MegaLabel_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^.MegaLabel_Offset - off;\r
Put_Byte(WordByte.Byte1);\r
Put_Byte(WordByte.Byte2);\r
Put_Byte(0);\r
Put_byte(0);\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
WriteHexByte(WordByte.Byte1);\r
WriteHexByte(WordByte.Byte2);\r
WriteHexByte(0);\r
WriteHexByte(0);\r
WriteSpace(CommentPos - CurrentPos);\r
write(CodeList,' DW ');\r
\r
(* write Label *)\r
WriteLabel(Ptr);\r
writeln(CodeList);\r
\r
CurrentPos := 0;\r
END;\r
\r
NoLabels := NoLabels - 1;\r
Offset := Offset + 4;\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 -off;\r
Put_Byte(WordByte.Byte1);\r
Put_Byte(WordByte.Byte2);\r
Put_Byte(0);\r
Put_byte(0);\r
\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
WriteHexByte(WordByte.Byte1);\r
WriteHexByte(WordByte.Byte2);\r
WriteHexByte(0);\r
WriteHexByte(0);\r
WriteSpace(CommentPos - 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 + 4;\r
END;\r
END;\r
Lab := Lab1;\r
END; (* While *)\r
\r
END;\r
\r
AllignCode :\r
BEGIN\r
off := JumpRec1.Bin1Param;\r
IF off <> 0 THEN\r
begin\r
Put_byte(117);\r
MegaPutInteger(off);\r
MegaPutAllign(off);\r
end;\r
END;\r
\r
InternalLBDR,\r
ExternalLBDR: (* external LBDR *)\r
BEGIN\r
St_Retrieve(JumpRec1.Bin1Label, Ptr);\r
St_NameOfSpix(Ptr^.St_Spix,Str);\r
MegaPutDefineExt(Str^, Ptr^.MegaLabel_Offset);\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
writeln(Codelist);\r
writeln(CodeList);\r
writeln(CodeList,' LBDR: ');\r
END;\r
\r
(* EntryPoint *)\r
MegaPutIntegerValue(Ptr^.MegaLabel_Offset - offset);\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','EntryPoint: ');\r
WriteLabel(Ptr);\r
writeln(CodeList);\r
END;\r
\r
(* BlKind *)\r
ReadJumpRec(JumpRec1);\r
off := JumpRec1.Bin1Label.Va_High;\r
MegaPutIntegerValue(off);\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','BlockKind: ');\r
WriteHexByte(JumpRec1.Bin1Label.Va_High);\r
writeln(CodeList);\r
END;\r
\r
(* BlName *)\r
ReadJumpRec(JumpRec1);\r
St_NameOfSpix(JumpRec1.Bin1Label.Va_High,Str);\r
Put_Byte(117);\r
MegaPutInteger(12);\r
FOR i := 1 TO Length(Str^) DO\r
IF i <= 12 THEN Put_byte(ORD(str^[i]));\r
FOR i := Length(Str^) + 1 TO 12 DO Put_Byte(32);\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','BlockName: ');\r
\r
writeln(CodeList,Str^);\r
END;\r
\r
(* Next *)\r
IF not firstLBDR THEN\r
LastLBDR := LastLBDR - (Offset +(5*4))\r
ELSE\r
BEGIN\r
Put_byte(16);\r
MegaPutInteger(Offset+5*4);\r
Put_byte(37);\r
MegaPutInteger(Rtplbdr-1);\r
FirstLBDR := false;\r
END;\r
\r
MegaPutIntegervalue(Lastlbdr);\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','Next: ');\r
WriteHexWord(Lastlbdr);\r
writeln(CodeList);\r
END;\r
\r
\r
(* LineTable *)\r
MegaPutIntegerValue(InternalOffset - offset + lengthofversion);\r
\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','LineTable : ');\r
WriteHexWord(InternalOffset - offset + lengthofversion);\r
writeln(Codelist);\r
END;\r
\r
IF off <> 1 THEN\r
BEGIN\r
(* LinkCount *)\r
MegaPutIntegerValue(0);\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','LinkCount: ');\r
WriteHexByte(0);\r
writeln(CodeList);\r
END;\r
\r
\r
(* Appetite *)\r
ReadJumpRec(JumpRec1);\r
MegaPutIntegerValue(JumpRec1.Bin1Label.Va_High);\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','Appetite: ');\r
WriteHexWord(JumpRec1.Bin1Label.Va_High);\r
writeln(CodeList);\r
END;\r
\r
(* Stackextra *)\r
MegaPutIntegerValue(0);\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','OccamStack: ');\r
WriteHexWord(0);\r
writeln(CodeList);\r
END;\r
\r
END;\r
\r
CurrentPos := 0;\r
LastLBDR := Offset;\r
IF Off = 1 THEN Offset := Offset + 28\r
ELSE Offset := Offset + 40;\r
END;\r
END; (* end case *)\r
\r
END; (* while *)\r
\r
St_nameOfSpix(PreExtName[rtplbdr], Str);\r
MegaPutDefineExt(Str^, LastLBDR);\r
\r
\r
\r
IF CodeDumpLength <> 0 THEN MegaPutCode(CodeDumpLength);\r
\r
(* Dump NameEntry And LineTabel*)\r
j := (((Offset+3)DIV 4) * 4) - Offset;\r
IF j <> 0 THEN\r
BEGIN\r
Put_byte(117);\r
MegaPutInteger(j);\r
MegaPutAllign(j);\r
END;\r
\r
sizeofconst := Offset - SizeOfConst;\r
SizeOfLineTable := Offset;\r
\r
internaloffset := offset;\r
\r
(* Insert Version *)\r
Put_byte(117);\r
MegaPutInteger(LengthOfVersion);\r
\r
UnPackTime(SourceDate,DateAndTime);\r
with DateAndtime Do\r
BEGIN\r
Put_byte(Year - 1900);\r
Put_byte(Month);\r
Put_byte(day); (* Source Date *)\r
Put_byte(hour);\r
Put_byte(min);\r
IF CodeOnPass2 THEN\r
BEGIN\r
writehexword(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
writehexbyte(Year - 1900);\r
writehexbyte(Month);\r
writehexbyte(day);\r
writehexbyte(hour);\r
writehexbyte(min);\r
WriteSpace(CommentPos - CurrentPos + 1);\r
Writeln(Codelist,' Source Date');\r
Currentpos := 0;\r
END;\r
Offset := Offset + 5;\r
END;\r
Put_byte(Call_options.version);\r
Put_Byte(Call_options.subversion ); (* Version *)\r
IF CodeOnPass2 THEN\r
BEGIN\r
writehexword(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
writehexbyte(Call_options.Version);\r
writehexbyte(Call_options.SubVersion);\r
WriteSpace(CommentPos - CurrentPos + 1);\r
Writeln(Codelist,' Version');\r
Currentpos := 0;\r
END;\r
Offset := Offset + 2;\r
with DateAndtime Do\r
BEGIN\r
GetDate(Year,Month,day,stepw);\r
GetTime(Hour,Min,Sec,stepw);\r
Put_byte(Year - 1900);\r
Put_byte(Month);\r
Put_byte(day); (* Object Date *)\r
Put_byte(hour);\r
Put_byte(min);\r
IF CodeOnPass2 THEN\r
BEGIN\r
writehexword(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
writehexbyte(Year - 1900);\r
writehexbyte(Month);\r
writehexbyte(day);\r
writehexbyte(hour);\r
writehexbyte(min);\r
WriteSpace(CommentPos - CurrentPos + 1);\r
Writeln(Codelist,' Object Date');\r
Currentpos := 0;\r
END;\r
END;\r
Offset := Offset + 5;\r
MegaPutIntegerValue(-offset);\r
IF CodeOnPass2 THEN\r
BEGIN\r
writehexword(Offset); Writeln(Codelist);\r
writeln(CodeList,' NameTable and LineTable');\r
write(CodeList,' ','FirstLBDR: ');\r
WriteHexword(-offset);\r
writeln(CodeList);\r
END;\r
allignedLengthofnametable := ((LengthOfNameTabel + 3) DIV 4) * 4;\r
\r
IF LengthOfLineTabel = 0 THEN\r
Help := 0\r
ELSE\r
Help := AllignedLengthOfNameTable+4;\r
MegaPutIntegerValue(help);\r
IF CodeOnPass2 THEN\r
BEGIN\r
write(CodeList,' ','LineTable Pointer: ');\r
WriteHexword(help);\r
writeln(CodeList);\r
CurrentPos := 0;\r
writeln(CodeList,' NameTable:');\r
END;\r
\r
Offset := Offset + 8;\r
Put_byte(117);\r
MegaPutInteger(AllignedLengthOfNameTable + LengthOfLineTabel\r
+ LineTabLength);\r
(* Dump NameTable *)\r
WHILE Not Equal_Addr(LastNameEntry,St_NillAddr) DO\r
BEGIN\r
\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^.MegaT_First_Offset;\r
NameEntry.CodeLength := Ptr^.MegaT_Last_Offset -\r
Ptr^.MegaT_First_Offset + 1;\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^.MegaFirst_Offset;\r
NameEntry.CodeLength := Ptr^.MegaLast_Offset -\r
Ptr^.MegaFirst_Offset + 1;\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
NameEntry.Length := length(Str^);\r
Leng := length(Str^) + NameEntryLength;\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 NameEntryLength do Put_byte(NameEntry.a[i]);\r
For stepw := 1 to length(Str^) do\r
Put_byte(ord(Str^[stepw]));\r
\r
If CodeOnPass2 THEN DumpNameEntryOnCodelist;\r
\r
Offset := offset + leng;\r
END;\r
\r
MegaPutAllign(AllignedLengthOfNameTable - LengthOfNameTabel);\r
\r
IF LengthOfLineTabel <> 0 THEN\r
BEGIN (* Dump LineTabel *)\r
LineTab.LastOffset := InternalOffset - 1;\r
\r
IF InternalOffset > 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 LineTabLength do Put_byte(LineTab.a[i]);\r
\r
If CodeOnPass2 THEN DumpLineTableStartOnCodelist;\r
Offset := Offset + LineTabLength;\r
\r
TempLineTabelAddr := LineTabelAddr;\r
WHILE Not Equal_Addr(TempLineTabelAddr,St_StopAddr) DO\r
BEGIN\r
St_Retrieve(TempLineTabelAddr,Ptr);\r
IF CodeOnPass2 THEN\r
IF Ptr^.St_Size > 0 THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
END;\r
For Stepw := 1 TO Ptr^.St_Size DO\r
BEGIN\r
Put_Byte(Ptr^.Data_area[Stepw]);\r
Offset := Offset + 1;\r
IF CodeOnPass2 THEN\r
BEGIN\r
WriteHexByte(Ptr^.Data_area[Stepw]);\r
IF (stepw MOD 10 = 0) OR (Stepw = Ptr^.St_Size) THEN\r
BEGIN\r
Writeln(CodeList);\r
CurrentPos := 0;\r
IF (Stepw <> Ptr^.St_Size) THEN\r
BEGIN\r
WriteHexWord(Offset);\r
WriteSpace(CodePos - CurrentPos);\r
END;\r
END;\r
END;\r
END;\r
TempLineTabelAddr := Ptr^.ListRef;\r
END;\r
END;\r
\r
j := (((Offset+3)DIV 4) * 4) - Offset;\r
IF j <> 0 THEN\r
BEGIN\r
Put_byte(117);\r
MegaPutInteger(j);\r
MegaPutAllign(j);\r
END;\r
\r
Put_byte(118);\r
MegaPutInteger(Offset);\r
MegaPutInteger(0);\r
\r
SizeOfLineTable := Offset - SizeOfLineTable;\r
END; (* MakePass4_2 *)\r
«eof»