(******************************************************************)
     (*                                                                *)
     (*  Copyright (c) 1978 Regents of the University of California.   *)
     (*  Permission to copy or distribute this software or documen-    *)
     (*  tation in hard or soft copy granted only by written license   *)
     (*  obtained from the Institute for Information Systems.          *)
     (*                                                                *)
     (******************************************************************)

 {
 *  Phase 1 opens host and library files and
 *  reads in seg tables.  All fields are verified
 *  and the hostfile/libfiles file list is built.
 *  The prototype final seg table is set up in
 *  seginfo[*] from the host file and the sep seg
 *  list is set up for searching in later phases.
 }

 procedure phase1;

     {
     *  Build file list opens input code files and reads segtbls.
     *  The var hostfile is set up as head of linked list of file
     *  info recs.  The order of these files determines how id's
     *  will be searched for.  Note that libfiles points at the
     *  list just past the host file front entry.
     }

     procedure buildfilelist;
       label 1;
       var f: 0..MAXFILE;
           i: integer;
           p, q: finfop;
           fname: string[40];

         {
         *  Setupfile opens file and enters new finfo rec in
         *  hostfile list.  Segtbl is read in and validated.
         }

         procedure setupfile(num: integer; kind: filekind; title: string);
           var errs: integer;
               s: segindex;
               cp: filep;
               fp: finfop;
               alllinked: boolean;
               goodkinds: set of segkinds;

             {
             *  Getfilep returns a pointer to a file using unspeakable
             *  methods, but the ends justify the means.
             }

             function getfilep(var f: codefile): filep;
               var a: array [0..0] of filep;
             begin
               {$R-}
               getfilep := a[-1];
               {$R+}
             end { getfilep } ;

         begin { setupfile }
           case num of
             0:  cp := getfilep(f0);
             1:  cp := getfilep(f1);
             2:  cp := getfilep(f2);
             3:  cp := getfilep(f3);
             4:  cp := getfilep(f4);
             5:  cp := getfilep(f5);
             6:  cp := getfilep(f6);
             7:  cp := getfilep(f7)
           end { cases } ;
           reset(cp^, title);
           if IORESULT <> 0 then
             if title <> 'in workspace' then
               begin
                 insert('.CODE', title, length(title)+1);
                 reset(cp^, title)
               end;
           if IORESULT <> 0 then
             begin
               insert('No file ', title, 1);
               error(title);
               if kind <> USERHOST then
                 errcount := errcount-1
             end
           else
             begin { file open ok }
               if talkative then
                 writeln('Opening ', title);
               new(fp);
               fp^.next := hostfile;
               fp^.code := cp;
               fp^.fkind := kind;
               if blockread(cp^, fp^.segtbl, 1, 0) <> 1 then
                 error('segtbl read err')
               else
                 begin { now check segtbl values }
                   s := 0; alllinked := TRUE;
                   errs := errcount;
                   if kind = USERHOST then
                     goodkinds := [LINKED,SEGPROC,SEPRTSEG,HOSTSEG,UNITSEG]
                   else
                     goodkinds := [LINKED,UNITSEG,SEPRTSEG];
                   with fp^.segtbl do
                     repeat
                       alllinked := alllinked and (segkind[s] = LINKED);
                       if (diskinfo[s].codeleng = 0)
                       and (segkind[s] <> LINKED) then
                         if (kind <> USERHOST)
                         or (segkind[s] <> UNITSEG) then
                           error('funny code seg');
                       if (diskinfo[s].codeleng < 0)
                       or (diskinfo[s].codeaddr < 0)
                       or (diskinfo[s].codeaddr > 300) then
                         error('bad diskinfo');
                       if not (segkind[s] in goodkinds) then
                         error('bad seg kind');
                       if not alphabetic(segname[s]) then
                         error('bad seg name');
                       if errcount > errs then
                         s := MAXSEG;
                       s := s+1
                     until s > MAXSEG;
                   if alllinked and (kind = USERHOST) then
                     begin
                       write('All segs linked');
                       exit(linker)
                     end;
                   if errcount = errs then
                     hostfile := fp            { ok file...link in }
                 end
             end
         end { setupfile } ;

     begin { buildfilelist }
       if talkative then
         begin
           for i := 1 to 7 do
             writeln;
           writeln('Linker [I.5]')
         end;
       useworkfile := cmdstate <> SYSPROG;
       with userinfo do
         if useworkfile then
           begin
             if gotcode then
               fname := concat(codevid, ':', codetid)
             else
               fname := 'in workspace';
             setupfile(0, USERHOST, fname);
             setupfile(1, SYSTEMLIB, '*SYSTEM.LIBRARY')
           end
         else
           begin
             write('Host file? ');
             readln(fname);
             if fname = '' then
               if gotcode then
                 fname := concat(codevid, ':', codetid)
               else
                 fname := 'in workspace';
             setupfile(0, USERHOST, fname);
             if errcount > 0 then
               exit(linker); { no host! }
             for f := 1 to MAXFILE do
               begin
                 write('Lib file? ');
                 readln(fname);
                 if fname = '' then
                   goto 1;
                 if fname = '*' then
                   setupfile(f, SYSTEMLIB, '*SYSTEM.LIBRARY')
                 else
                   setupfile(f, USERLIB, fname)
               end;
         1:
             write('Map name? ');
             readln(mapname);
             if mapname <> '' then
               if mapname[length(mapname)] = '.' then
                 delete(mapname, length(mapname), 1)
               else
                 insert('.TEXT', mapname, length(mapname)+1)
           end;

       { now reverse list so host is }
       { first and syslib is last    }

       p := hostfile; hostfile := NIL;
       repeat
         q := p^.next;
         p^.next := hostfile;
         hostfile := p;
         p := q
       until p = NIL;
       libfiles := hostfile^.next;
     end { buildfilelist } ;

     {
     *  Buildseginfo initializes the seginfo table from
     *  the host prototype seg table.  All legal states
     *  are checked, and imported units found.  This
     *  leaves a list of all segs to finally appear in
     *  the output code file.
     }

     procedure buildseginfo;
       label 1;
       var s: segindex;
           errs: integer;
           sp: segp;
     begin
       with hostfile^.segtbl do
         for s := 0 to MAXSEG do
           if (segkind[s] = LINKED)
           and (diskinfo[s].codeleng = 0) then
             seginfo[s] := NIL   { not in use }
           else
             begin { do something with seg }
               errs := errcount;
               new(sp);
               sp^.srcfile := hostfile;
               sp^.srcseg := s;
               sp^.symtab := NIL;
               sp^.segkind := segkind[s];
               case sp^.segkind of
                 SEGPROC,
                 LINKED:    ;  { nothing to check! }

                 HOSTSEG:   if s <> MASTERSEG then
                              error('bad host seg')
                            else
                              if hostsp <> NIL then
                                error('dup host seg')
                              else
                                hostsp := sp;

                 SEPRTSEG:  if s = MASTERSEG then
                              sp^.next := NIL
                            else
                              begin { put into seplist }
                                sp^.next := seplist;
                                seplist := sp;
                                sp := NIL
                              end;

                 UNITSEG:   if diskinfo[s].codeleng = 0 then
                              sp^.srcfile := unitsrch(libfiles,
                                                     segname[s],
                                                     sp^.srcseg)
               end { cases } ;
               if errs = errcount then
                 seginfo[s] := sp
               else
                 seginfo[s] := NIL
             end;

       { now find first assignable seg }

       for s := FIRSTSEG to MAXSEG do
         if seginfo[s] = NIL then
           goto 1;
       s := MAXSEG1;
     1:
       nextseg := s;
       if seginfo[MASTERSEG] = NIL then
         error('wierd host')
     end { buildseginfo } ;

     {
     *  Buildseplist searches through libraries and adds onto
     *  a global list of sep segs that are to be searched
     *  for procs and globals.  They are initially build in
     *  the reverse order, then reversed again so searches
     *  will go in the order the files were specified.
     }

     procedure buildseplist;
       var sp, p, q: segp;
           fp: finfop;
           s: segindex;
     begin
       fp := libfiles;
       while fp <> NIL do
         begin
           for s := 0 to MAXSEG do
             if fp^.segtbl.segkind[s] = SEPRTSEG then
               begin
                 new(sp);
                 sp^.next := seplist;
                 sp^.srcfile := fp;
                 sp^.srcseg := s;
                 sp^.symtab := NIL;
                 sp^.segkind := SEPRTSEG;
                 sp^.next := seplist;
                 seplist := sp
               end;
           fp := fp^.next
         end;

       { now reverse the list to maintain original order }

       p := seplist; seplist := NIL;
       while p <> NIL do
         begin
           q := p^.next;
           p^.next := seplist;
           seplist := p;
           p := q
         end
     end { buildseplist } ;

 begin { phase1 }

   { initialize globals }

   hostfile := NIL;
   libfiles := NIL;
   hostsp := NIL;
   seplist := NIL;
   reflitypes := [UNITREF, GLOBREF, PUBLREF,
                  PRIVREF, CONSTREF,
                  SEPPREF, SEPFREF];
   errcount := 0;
   nextbaselc := 3;
   mapname := '';
   talkative := not userinfo.slowterm;
   mark(heapbase);
   unitwrite(3, heapbase^, 35);

   { build list of input files }

   buildfilelist;
   if errcount > 0 then
     exit(linker);

   { init basic seg info table }

   buildseginfo;
   if errcount > 0 then
     exit(linker);

   { finally build sep seg list }
			
   buildseplist;
   if errcount > 0 then
     exit(linker)
 end { phase1 } ;