1 //  These routines generate the symbol section and object map.
  2 //  Last modified on 06/06/74 at 18:23:54 by R F Mabee.
  3 //  Modified for 6180 conversion, and installed as Version 3.4 by R F Mabee.
  4 //  First installed as Version 2.7, R F Mabee.
  5 
  6 //  Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc.
  7 
  8 //  General permission is granted to copy and use this program, but not to sell it, provided that the above
  9 //  copyright statement is given.  Contact Information Processing Services, MIT, for further information.
 10 //  Please contact R F Mabee at MIT for information on this program and versions for other machines.
 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 //  This routine writes the symbol section except for the relocation bits at the end.
 42 //  LC must be zero at entry.
 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                           //  Number of words in fixed-format part of header below; must be even.
 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")                     //  Block type.
 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    ")                     //  Compiler name.
 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                  //  For block header.
 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                           //  section_header_pointer only item not self-relocating.
 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 //  End of fixed format header.  Rest is unstructured, pointed to by items above.
 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")                //  Unique ID.
 91                     OutW2 (Info!2, MakeTimeString (lv Info!2))        //  DTM.
 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")               //  Last word of segment.
164      $)