1
2
3
4
5
6
7
8
9
10
11
12 get "bcpl_cg_head"
13 get "bcpl_opcodes"
14
15 global
16 $( Strings : GlobalTemp $)
17
18
19 let LineMapLength () = valof
20 $( LineMapList!1 := 0
21 let q, l = LineMapFirst, 0
22 until q = 0 do l, q := l + 1, q!1
23 resultis l + 1
24 $)
25 and WriteLineMap (MapL) be
26 $( Complab (MapL)
27 let l = LineMapLength () - 1
28 OutW2 (TextLength lshift Left logor l, "text length, map entry count")
29 let q = LineMapFirst
30 until q = 0 do
31 $( OutW (q!0)
32 q := q!1
33 $)
34 $)
35 and SymbolTableLength () = 1
36 and WriteSymbolTable (SymL) be
37 $( Complab (SymL)
38 OutW2 (0, "no symbol table implemented")
39 $)
40
41
42
43
44 let WriteSymbol () be
45 $( SectionHeader ("*fSymbol section header")
46 let SymL = Symbols -> Nextparam (), 0
47 and MapL = LineMap -> Nextparam (), 0
48 let Smap = 20
49 SymbolLength := Smap + 2 + FileCount * 4 + 4
50 Strings := vec 50
51 Strings!0 := 0
52 OutW2 (1, "version number of header structure")
53 OutAlignedString ("symbtree")
54 OutW2 (CompilerVersionNumber, "compiler version number")
55 OutW2 (CompilerDTM!0, "date/time compiler modified")
56 OutW2 (CompilerDTM!1, CompilerDTMString)
57 OutW2 (TimeNow!0, "time of this compilation")
58 OutW2 (TimeNow!1, TimeNowString)
59 OutAlignedString ("bcpl ")
60 OutW2 (RemoteString (CompilerVersionString), "compiler version name - pointer, length")
61 OutW2 (RemoteString (UserID), "user id - pointer, length")
62 OutW2 (RemoteString (OptionString), "comment string - pointer, length")
63 OutW2 (2 lshift Left | 2, "text and linkage boundaries")
64
65 let w = vec 50
66 for i = 0 to FileCount do w!i := RemoteString (FilesInfo!(i * 4))
67 let Tree = 0
68 if Symbols | LineMap do
69 $( Tree := SymbolLength
70 SymbolLength := SymbolLength + 1
71 if Symbols do SymbolLength := SymbolLength + SymbolTableLength ()
72 if LineMap do SymbolLength := SymbolLength + LineMapLength ()
73 $)
74 OutW2 (Smap lshift Left | Tree, "source map, symbol tree root")
75 let Tlen, Llen = CountRelbits (TextRelbits), CountRelbits (LinkageRelbits)
76 Reloc := RelNegSymbol lshift Left
77 OutW2 (SymbolLength, "section header pointer, block size")
78 OutW2 (SymbolLength, "next block pointer, rel_text")
79 OutW2 (SymbolLength + Tlen, "rel_def, rel_link")
80 OutW2 (SymbolLength + Tlen + Llen lshift Left | SymbolLength, "rel_symbol, default truncate")
81 OutW2 (Smap lshift Left, "optional truncate, unused")
82
83
84
85 OutW2 (1, "source files map: version number")
86 OutW2 (FileCount + 1, " number of files")
87 for i = 0 to FileCount do
88 $( let Info = lv FilesInfo!(i * 4)
89 OutW2 (w!i, FileNames!i)
90 OutW2 (Info!1, "last modified on")
91 OutW2 (Info!2, MakeTimeString (lv Info!2))
92 OutW (Info!3)
93 $)
94 for i = 1 to Strings!0 do OutAlignedString (Strings!i)
95
96 if Symbols | LineMap do
97 $( SectionHeader ("*fSymbol table block")
98 Param := SymL
99 OutW2 (LineMap -> LC + 1, 0, "symbol table pointer, line map pointer")
100
101 if LineMap do WriteLineMap (MapL)
102 if Symbols do WriteSymbolTable (SymL)
103 $)
104
105 unless LC = SymbolLength do CGreport (PhaseError, "WriteSymbol")
106 $)
107
108 and RemoteString (s) = valof
109 $( let l = Length (s)
110 let r = SymbolLength lshift Left | l
111 SymbolLength := SymbolLength + (l + 3) / 4
112 Strings!0 := Strings!0 + 1
113 Strings!(Strings!0) := s
114 resultis r
115 $)
116 and OutAlignedString (s) be
117 $( let v = vec Vmax
118 Concatenate (v, Vmax, "*"", s, "*"")
119 Comment := StoreString (v)
120 Unpackstring (s, v)
121 let Len = v!0
122 v!(Len + 1), v!(Len + 2), v!(Len + 3) := '*s', '*s', '*s'
123 for i = 1 to Len by 4 do OutW (v!i lshift 27 | v!(i + 1) lshift 18 | v!(i + 2) lshift 9 | v!(i + 3))
124 $)
125
126 and OutRel (p, c) be
127 $( if p = 0 return
128 SectionHeader (c)
129 OutW2 (2, "version number of rel-bits structure")
130 OutW2 (p!0, "length in bits")
131 p := p!1
132 until p = 0 do
133 $( OutW (p!0)
134 p := p!1
135 $)
136 $)
137 and CountRelbits (p) = valof
138 $( if p = 0 resultis 0
139 let n = 0
140 n, p := n + 1, p!1 repeatuntil p = 0
141 resultis n + 1
142 $)
143 and WriteRelBits () be
144 $( SectionHeader ("*fRelocation information")
145 OutRel (TextRelbits, "*ntext section relocation bits")
146 OutRel (DefsRelbits, "*ndefinitions section relocation bits")
147 OutRel (LinkageRelbits, "linkage relocation bits")
148 OutRel (SymbolRelbits, "symbol relocation bits")
149 $)
150
151 let WriteObjectMap (AbsLC) be
152 $( SectionHeader ("*fObject map")
153 let t, d, l = TextLength + 1 & Even, DefsLength + 1 & Even, LinkageLength + 1 & Even
154 unless t + d + l + SymbolLength = AbsLC do CGreport (PhaseError, "WriteObjectMap")
155 OutW2 (1, "version number of object_map structure")
156 OutAlignedString ("obj_map ")
157 OutW2 (TextLength, "text offset, length")
158 OutW2 (t lshift Left | DefsLength, "def offset, length")
159 OutW2 (t + d lshift Left | LinkageLength, "link offset, length")
160 OutW2 (t + d + l lshift Left | SymbolLength, "symbol offset, length")
161 OutW2 (0, "break map offset, length")
162 OutW2 ($834 lshift 30, "flags: ^bound, relocatable, procedure, standard")
163 OutW2 (AbsLC lshift Left, "object map pointer, unused")
164 $)