1 //  These routines generate the definitions and linkage sections of the object segment.
  2 //  Last modified on 06/06/74 at 18:23:04 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      $(   NamesList : 398
 17           DefsList : 399
 18      $)
 19 
 20 manifest
 21      $(   NewFlag = 1 lshift 17
 22           IgnoreFlag = 1 lshift 16
 23           EntryFlag = 1 lshift 15
 24           ClassMask = $8777
 25      $)
 26 
 27 
 28 let WriteGetlp () be
 29      $(   SectionHeader ("*nLocal subroutine to find linkage section by looking in LOT")
 30           Complab (GetLpLabel)
 31           Outop3 (Stcd, 18, Sp | Star)
 32           Outop3 (Ldx7, 18, Sp | Star)
 33           Outop3 (Lda, 22, Sb | StarThenReg | X7)
 34           Outop3 (Eablb, 0, Au)
 35           Outop3 (Eablp, 0, Al)
 36           Outop3 (Tra, 0, X0)
 37      $)
 38 and WriteEntry () be
 39      $(   SectionHeader ("*nLocal subroutine to help enter BCPL environment")
 40           Complab (EntryLabel)
 41           Outop4 (Eax7, 2048, 0, "Multics save sequence")
 42           Outop3 (Tsbbp, 32, Sb | Star)
 43           Outop3 (Eax1, 400, Machine = 6180 -> Sp, 0)
 44           Outop3 (Stplp, 24, Sp)        //  Operator pointer.
 45           Outop3 (Eapap, Machine = 6180 -> -3, -2, X0)      //  Def ptr.
 46           Outop3 (Stpap, 22, Sp)        //  Entry pointer.
 47           Outop4 (Tsbbp, 0, X0, "simulate standard BCPL call")
 48           OutData (0)
 49           Compfinish ()
 50      $)
 51 
 52 //  This routine generates the entire definition section.  LC must be zero at entry.
 53 
 54 let WriteDefs (EntriesList) be
 55      $(   let v, w = vec Vmax, vec Vmax
 56           SectionHeader ("*fDefinition section part one - external entry points")
 57           let ZeroWordLab = Nextparam ()
 58           NamesList, DefsList := 0, List4 (0, ZeroWordLab lshift Left | NewFlag | 3, ProgramName, Nextparam ())
 59 
 60 //  Insert each entry point in the appropriate place in DefsList.
 61           let p = EntriesList
 62           until p = 0 do
 63                $(   Split (p!1, v, w)
 64                     let L = p!2
 65                     if Listing do
 66                          $(   Format (OUTPUT, "*tequ*t^s,L^d*n", p!1, L)
 67                               Format (OUTPUT, "*tsegdef*t^s*n", p!1)
 68                          $)
 69                     let q, DefLabel = MainEntriesList, 0
 70                     until q = 0 do                //  Determine whether this definition is referenced from text.
 71                          $(   if q!0 = L do q!0, DefLabel := 0, q!1
 72                               q := q!3
 73                          $)
 74                     AddDefinition (L lshift Left | NewFlag | EntryFlag | 0, StoreString (w), DefLabel, v)
 75                     p := p!0
 76                $)
 77 
 78 //  Insert the symbol_table definition required by certain system tools.
 79           AddDefinition (0 lshift Left | NewFlag | 2, "symbol_table", 0, ProgramName)
 80 
 81 //  If there are any names in MainEntriesList which were not in EntriesList, add dummy definitions for them.
 82           let q = MainEntriesList
 83           until q = 0 do
 84                $(   if q!0 ne 0 do AddDefinition (q!0 lshift Left | NewFlag | EntryFlag | IgnoreFlag | 0, q!2, q!1, ProgramName)
 85                     q := q!3
 86                $)
 87 
 88 //  Put out definitions header.
 89           Param, Reloc := DefsList!3, RelDef lshift Left
 90           OutW2 (0, "pointer to first definition")
 91           OutW2 (NewFlag | IgnoreFlag, "flags: new format, ignore header")
 92           let ZeroWord = LC
 93           DefineLab (ZeroWordLab, ZeroWord)
 94           OutW2 (0, "list terminator*n")
 95 
 96 //  Put out all the names belonging to definitions.
 97           p := DefsList
 98           until p = 0 do
 99                $(   p!3 := p!3 | GetName (p!2) lshift Left
100                     p := p!0
101                $)
102 
103 //  Put out the definitions.
104           let PreviousDef, NextDef, SegnameDef = ZeroWord, LC, nil
105           and RelCodesTable = table RelText lshift Left, RelLink18 lshift Left, RelSymbol lshift Left, RelDef lshift Left
106           p := DefsList
107           until p = 0 do
108                $(   let ThisDef = NextDef
109                     unless ThisDef = LC do CGreport (PhaseError, "WriteDefs")
110                     NextDef := p!0 = 0 -> ZeroWord, ThisDef + 3
111                     let DefLabel, Class = p!3 & Right, p!1 & ClassMask
112                     and SegnameInfo, SegnameComment = nil, nil
113                     test Class = 3                //  I.e., this is a segname definition.
114                     then $(   Concatenate (v, Vmax, "*nSegname definition for ", p!2)
115                               SegnameDef := ThisDef
116                               SegnameInfo, SegnameComment := NextDef, "name pointer, first entry def"
117                          $)
118                     or   $(   Concatenate (v, Vmax, "*nDefinition for ", p!2)
119                               SegnameInfo, SegnameComment := SegnameDef, "name pointer, segname def pointer"
120                          $)
121                     SectionHeader (StoreString (v))
122                     if DefLabel ne 0 do DefineLab (DefLabel, ThisDef)
123                     Reloc := RelDef lshift Left | RelDef
124                     OutW2 (NextDef lshift Left | PreviousDef, "forward, backward threads")
125                     Param, Reloc := p!1 rshift Left, RelCodesTable!Class
126                     OutW2 (p!1 & Right, "value defined, class flags")
127                     Reloc := RelDef lshift Left | RelDef
128                     OutW2 ((p!3 & not Right) | SegnameInfo, SegnameComment)
129                     PreviousDef := ThisDef
130                     p := p!0
131                $)
132 
133 //  Put out link info.
134           SectionHeader ("*fDefinition section part two - symbolic info for external references")
135           p := LinkList
136           until p = 0 do
137                $(   Split (p!1, v, w)
138                     if EqualString (v, ProgramName) do CGreport (LinkRefersThis, p!1)
139                     let x, y, z, r = GetName (StoreString (v)), 0, 3, 0
140                     unless Length (w) = 0 do y, z, r := GetName (StoreString (w)), 4, RelDef
141                     Reloc := RelDef lshift Left
142                     p!3 := LC
143                     OutW (LC + 1 lshift Left)
144                     OutW (z lshift Left)
145                     Reloc := RelDef lshift Left logor r
146                     OutW (x lshift Left logor y)
147                     p := p!0
148                $)
149      $)
150 
151 and Split (s, v, w) be
152      $(   let t, u = vec Vmax, vec Vmax
153           RemoveEscapes (s, t)
154           Unpackstring (t, u)
155           for i = 1 to u!0 if u!i = '$' do
156                $(   let j = u!0 - i               //  Found '$' - separate parts before and after.
157                     for k = 1 to j do t!k := u!(i + k)
158                     u!0, t!0 := i - 1, j
159                     Packstring (u, v)
160                     Packstring (t, w)
161                     return
162                $)
163           Packstring (u, v)             //  No '$' - both parts equal to whole.
164           Packstring (u, w)
165      $)
166 and GetName (s) = valof
167      $(   let p = NamesList
168           until p = 0 do
169                $(   if EqualString (p!0, s) resultis p!1
170                     p := p!2
171                $)
172           NamesList := List3 (s, LC, NamesList)
173           let w = vec Vmax + 4
174           Concatenate (w, Vmax, "*"", s, "*"")
175           Comment := StoreString (w)
176           Unpackstring (s, w)
177           let Len = w!0
178           w!(Len + 1), w!(Len + 2), w!(Len + 3) := 0, 0, 0
179                     //  An ACC string has the length in the first nine bits.
180           for i = 0 to Len by 4 do OutW (w!i lshift 27 | w!(i + 1) lshift 18 | w!(i + 2) lshift 9 | w!(i + 3))
181           resultis NamesList!1
182      $)
183 and AddDefinition (ValueLabel, Name, DefLabel, Segname) be
184      $(   let New = Newvec (3)
185           New!1, New!2, New!3 := ValueLabel, Name, DefLabel
186           let Dp = DefsList                       //  Try to find segname block where this def belongs.
187           until Dp = 0 do
188                $(   if (Dp!1 & ClassMask) = 3 then if EqualString (Dp!2, Segname) do
189                          $(        $(   let q = Dp!0                  //  Find end of block.
190                                         if q = 0 break
191                                         if (q!1 & ClassMask) = 3 break
192                                         Dp := q
193                                    $)   repeat
194                               goto GotSegname
195                          $)
196                     Dp := Dp!0
197                $)
198 
199 //  No match for Segname, must create a new segname definition.
200           Dp := Newvec (3)
201           Dp!0, Dp!1, Dp!2, Dp!3 := DefsList, DefsList!3 lshift Left | NewFlag | 3, StoreString (Segname), Nextparam ()
202           DefsList := Dp
203   GotSegname:
204           New!0 := Dp!0
205           Dp!0 := New
206      $)
207 
208 //  This routine generates the entire linkage section.  LC must be zero at entry.
209 
210 let WriteLinkage (StaticList) be
211      $(   SectionHeader ("*fLinkage section - static variables and external links")
212 
213 //  Calculate lengths of the various components of the linkage section.
214 
215           let HeaderLength, StaticLength, LinksLength = 8, 0, 0
216           and t = StaticList
217           until t = 0 do t, StaticLength := t!0, StaticLength + 1
218           t := LinkList
219           until t = 0 do t, LinksLength := t!0, LinksLength + 2
220           unless LinksLength = 0 do StaticLength := StaticLength + 1 & Even     //  Links must start at evan address.
221           let TotalLength = HeaderLength + StaticLength + LinksLength
222 
223 //  Put out the linkage header.
224           OutW2 (0, "linkage header")
225           Reloc := RelText lshift Left
226           OutW2 ((TextLength + 1 & Even) lshift Left, "address of defs")
227           for i = 1 to 4 do OutW (0)
228           Reloc := RelLink18 lshift Left
229           OutW2 ((HeaderLength + StaticLength) lshift Left | TotalLength, "offset to links, total length")
230           OutW2 (TotalLength, "obsolete length")            //  Still required by lot_maintainer in August 1973.
231 
232           if StaticList ne 0 do
233                $(   SectionHeader ("*nStatic variables")
234                     if Listing do
235                          $(   WriteS ("*tuse*tlinkc*n")
236                               WriteS ("*tjoin*t/link/linkc*n")
237                          $)
238                     t := StaticList
239                     until t = 0 do
240                          $(   unless LC = t!1 + HeaderLength do CGreport (PhaseError, "WriteLinkage")
241                               Comment := t!2
242                               OutData (EvalNumber (t!3, t!4))
243                               t := t!0
244                          $)
245                $)
246 
247           if LinkList ne 0 do
248                $(   unless (LC & 1) = 0 do OutW (0)              //  Force even alignment for links.
249                     SectionHeader ("*nExternal link pairs")
250                     t := LinkList
251                     until t = 0 do
252                          $(   DefineLab (t!2, LC)
253                               PutCode (LabelSwitch, t!2, LC)
254                               Comment := t!1
255                               Reloc := RelNegLink18 lshift Left
256                               OutW (-LC lshift Left logor Ft2)
257                               Reloc := RelDef lshift Left
258                               OutW (t!3 lshift Left)
259                               if Listing do
260                                    $(   let v, w = vec Vmax, vec Vmax
261                                         Split (t!1, v, w)
262                                         Format (OUTPUT, "*tlink*tL^d,<^s>|", t!2, v)
263                                         test Length (w) = 0
264                                         then WriteS (OUTPUT, "0*n")
265                                         or Format (OUTPUT, "[^s]*n", w)
266                                    $)
267                               t := t!0
268                          $)
269                $)
270 
271           unless LC = TotalLength do CGreport (PhaseError, "WriteLinkage")
272      $)