{30/apr - alan - Changed to disregard routine beginning F_ }
{ 10/5/82 - changes to verifyfile }

MODULE ExtHelp;

EXPORTS

IMPORTS FileUtils FROM FileUtils;
IMPORTS Code FROM Code;

CONST
      maxIdLength = 14;
      defIdLength = 8;
      longIdLength = 14;
      maxImports = 50;

TYPE
    Status = (allright,fileNotFound,alreadyImported,
              multiplyDeclaredRoutine,routNotFound);
      
    Name = STRING[maxIdLength];
      
    IsnType = 0..maxImports;

    PModuleDescriptor = ^ModuleDescriptor;
    ModuleDescriptor = RECORD
                        fName : PathName;
                        modName : Name;
                        next : PModuleDescriptor;
                       END;
                       
                       
PROCEDURE ProcessExternals(VAR numImports : IsnType; 
                           VAR extFile : TEXT;
                           VAR mods : PModuleDescriptor;
                           VAR newImports : IsnType;
                           srcRootFileName : PathName);

{ Given the name of the desired routine, this function returns the isn,
  routine number and language of that routine, as well as success status
  ( allright or routNotFound ) }
FUNCTION RoutLookup(desiredRoutine: Name; 
                    VAR isnDesired : INTEGER; 
                    VAR numberDesired : INTEGER;
                    VAR originDesired : Language) : Status;




PRIVATE

IMPORTS CmdParse FROM CmdParse;
IMPORTS Perq_String FROM Perq_String;
IMPORTS Code FROM Code;

CONST
      maxRoutines = 350;
      
TYPE
    
    RNType = 0..maxRoutines;
    
    PRoutDescriptor = ^RoutDescriptor;
    RoutDescriptor = RECORD
                         routName : Name;
                         isn : IsnType;
                         number : RNType;
                         origin : Language;
                     END;
                    
                    
    
    RoutineList = ARRAY[1..maxRoutines] OF PRoutDescriptor;
    
    
VAR 
    numRoutines : RNType;
    routines : RoutineList;



PROCEDURE ProcessExternals( VAR numImports : IsnType; 
                            VAR extFile : TEXT;
                            VAR mods : PModuleDescriptor;
                            VAR newImports : IsnType;
                            srcRootFileName : PathName );

  CONST
      defExtensionLength = 4;
      defSegExtension = '.SEG';
      defForExtension = '.FOR';
      defPasExtension = '.PAS';
      defImpExtension = '.IMP';
      
  VAR
      impFileNum : FileId;
      importFileName : PathName;
      initialImport : IsnType;
      nextMod : PModuleDescriptor;


  FUNCTION VerifyFile( importFileName : PathName; 
                       VAR impFileNum : FileId;   
                       VAR nextMod : PModuleDescriptor) : Status;
  
    VAR
        i, maxBlk, bits : INTEGER;
        s : STRING;
        rootFileName : PathName;
        shortName : PathName;
        
    BEGIN
    s := SubStr(importFileName, 
                      length(importFileName)-defExtensionLength+1,
                      defExtensionLength);
    ConvUpper(s);
    IF s <> defSegExtension THEN shortname := importFileName
      ELSE shortname:= SubStr(importFileName,
                                   1,
                                   length(importFileName)-defExtensionLength);
      importfilename:=shortname;
      impFileNum := FSExtSearch(FSSysSearchList, '.SEG .seg ', 
                                importfilename, maxBlk, bits);
     
      IF impFileNum = 0 THEN
        BEGIN
        importfilename:=concat(shortname,'.SEG');
        StdError(ErAnyError,
                 Concat( Concat('** Import file ', importFileName), 
                         ' not found.'),
                 true)
        END ELSE
        BEGIN { File exists }
        rootfilename:=substr(importfilename,
                             1,length(importfilename)-defextensionlength);
        IF rootFileName = srcRootFileName THEN VerifyFile := alreadyImported
          ELSE BEGIN
          IF maxBlk = 0 THEN
              StdError(ErAnyError,
                       Concat(Concat('** Import file ',importFileName), 
                              ' is empty.'),
                       true)
            ELSE BEGIN
            VerifyFile := allright;
            Writeln('  [ ',importFileName,' ]');
            IF nextMod = NIL THEN New(nextMod)
                             ELSE BEGIN
                             New(nextMod^.next);
                             nextMod := nextMod^.next;
                             END;
            WITH nextMod^ DO BEGIN
                     fName := shortName;
                     {$r-}
                     FOR i := 0 TO defIdLength DO
                     modName[i] := shortName[i];
                     {$r=}
                     next := NIL;
                     END
            END
          END
        END { File exists }
      
    END; { VerifyFile }


  PROCEDURE AddRoutine(newRoutine : PRoutDescriptor; 
                      VAR numRoutines : RNType;
                      VAR routines : RoutineList);
    VAR olderIdx,newest : integer;
        sorting : boolean;
        temp : PRoutDescriptor;
        s : string;
    BEGIN
      WITH newRoutine^ DO
        BEGIN
          { writeln('    adding new routine ',routName); }
          { writeln('ISN = ',isn,' RN = ',number,' language = ',ord(origin)); }
        END; { WITH }
        
      numRoutines := numRoutines + 1;
      routines[numRoutines] := newRoutine;
    
      sorting := TRUE;  
      olderIdx := numRoutines - 1;  newest := numRoutines;
      
      WHILE (olderIdx >= 1) and sorting DO
          IF routines[olderIdx]^.routName > routines[newest]^.routName 
              THEN BEGIN     
                     temp := routines[olderIdx];
                     s := SUBSTR(temp^.routname,1,2);        {added 30/4 }
                     { writeln(temp^.routname,' ',s); }
                     if s = 'F_' then exit(Addroutine);
                     routines[olderIdx] := routines[newest];
                     routines[newest] := temp;
                     newest := olderIdx;
                     olderIdx := olderIdx -1;
                   END
              ELSE 
                BEGIN
                  sorting := false;
                  IF routines[olderIdx]^.routName = routines[newest]^.routName
                      THEN StdError(ErAnyError,
                                    Concat( 
                                           Concat('** Routine ',
                                                  routines[newest]^.routName),
                                           ' multiply defined.'),
                                    true);
                END;

            
    END; { AddRoutine }
    

  PROCEDURE ImpSegFile(impFileNum : FileId; 
                       VAR numImports : IsnType;
                       VAR numRoutines : RNType; 
                       VAR routines : RoutineList;
                       VAR nextMod : PModuleDescriptor);
  
    TYPE
       Str14Chars = STRING[14];
       
       PCharAr = ^CharAr;
       CharAr = PACKED ARRAY[0..511] OF CHAR;
       
       PFirstBlock = ^FirstBlock;
       FirstBlock = RECORD
                      rdOffset : INTEGER;
                      numRoutines : INTEGER;
                      rest : ARRAY[3..256] OF INTEGER;
                    END;
                    

       SegBuffer = RECORD
                     CASE INTEGER OF
                       0: (z: PSegBlock);
                       1: (f: PFirstBlock);
                       2: (c: PCharAr);
                       3: (d: PDirBlk)
                     END;
    
    VAR
        buffer : SegBuffer;
        importBlock: INTEGER;
        numSeg: INTEGER;
        isProgram: BOOLEAN;
        i, blk, offset: INTEGER;
        rtn,
        routsInThisSeg : RNType;
        firstRoutine : 0..1;
        nameLength : 1..maxIdLength;
        rout : PRoutDescriptor;
        lang : Language;
    

{$ifc false then }

    FUNCTION DetermineLanguage(fileName : FNString; 
                               fortranSource : BOOLEAN ) : Language;
      CONST
          defPasExtension = '.PAS';
      VAR
          ext : STRING[defExtensionLength];
      BEGIN
        IF Length(fileName) >= defExtensionLength THEN
          BEGIN
            ext := SubStr(FileName, 
                          Length(FileName) - defExtensionLength + 1, 
                          defExtensionLength);
            IF ext = defForExtension THEN DetermineLanguage := fortran
                ELSE IF ext = defPasExtension THEN DetermineLanguage := pascal
                         ELSE IF fortranSource 
                                  THEN DetermineLanguage := fortran
                                  ELSE DetermineLanguage := pascal;
          END
        ELSE IF fortranSource THEN DetermineLanguage := fortran
                              ELSE DetermineLanguage := pascal;
      END;
      {$endc}

    BEGIN { ImpSegFile }
      { writeln('processing imports from segfile ',importFileName); }
      numImports := numImports + 1;
      New(buffer.d);
      
      FSBlkRead(impFileNum, 1, buffer.d);
      routsInThisSeg := buffer.f^.numRoutines;
      { writeln('no. of routines in this seg. is',routsinthisseg); }
      
      FSBlkRead(impFileNum, 0, buffer.d);
      importBlock := buffer.z^.importBlock;
      numSeg := buffer.z^.numSeg;
      {$ifc true then}
      lang := buffer.z^.source;
      {$elsec}
      lang := DetermineLanguage(buffer.z^.fileName,buffer.z^.fortranSource);
      {$endc}
      CASE lang OF 
          pascal  : nextMod^.fName := ConCat(nextMod^.fName,defPasExtension);
          fortran : nextMod^.fName := ConCat(nextMod^.fName,defForExtension);
          imp     : nextMod^.fName := ConCat(nextMod^.fName,defImpExtension);
      END;
      IF buffer.z^.longIds THEN nameLength := longIdLength 
                           ELSE nameLength := defIdLength;
      IF buffer.z^.programSegment THEN firstRoutine := 1
                                  ELSE firstRoutine := 0;
                                  
      FOR rtn :=  firstRoutine TO routsInThisSeg - 1 DO
        BEGIN
          New(rout);
          WITH rout^ DO
            BEGIN
              isn := numImports;
              number := rtn;
              origin := lang;
              
              offset := numSeg*WordSize(CImpInfo)+rtn*(nameLength div 2);
              blk := importBlock + (offset div 256);
              offset := (offset mod 256) * 2;
              routName := '';
              FSBlkRead(impFileNum, blk, buffer.d);
              {$r-}
              routName[0] := chr(0);
              {$r=}
              FOR i := 0 TO nameLength-1 DO
                BEGIN
                  IF offset = 512 THEN BEGIN
                                         offset := 0;
                                         FSBlkRead(impFileNum,blk+1,buffer.d);
                                       END;
                  IF buffer.c^[offset] > ' ' 
                      THEN BEGIN
                             {$r-}
                             routName[0] := chr(ord(routName[0]) + 1);
                             routName[ord(routName[0])] := buffer.c^[offset];
                             {$r=}
                           END;
                offset := offset + 1;
                END;
            END; { WITH }
          AddRoutine(rout,numRoutines,routines);
        END; { FOR }

      Dispose(buffer.d);
      { FOR rtn := 1 TO numRoutines DO Writeln(routines[rtn]^.routName,'@'); }
    END; { ImpSegFile }


  BEGIN { ProcessExternals }
  { writeln('entering processexternals'); }
  
  numRoutines := 0;
  initialImport := numImports;
  mods := NIL;
  nextMod := NIL;
  
  WHILE NOT Eof(extFile) DO
    BEGIN
      Readln(extFile,importFileName);
      CASE VerifyFile(importFileName,impFileNum,nextMod) OF
        allRight : ImpSegFile(impFileNum,
                              numImports,
                              numRoutines,
                              routines,
                              nextMod); 
        alreadyImported :  { Do Nothing }; 
      END; { CASE }
      IF mods = NIL THEN mods := nextMod;
    END; { WHILE }
  newImports := numImports - initialImport;
  
  END; { ProcessExternals }



FUNCTION RoutLookup(desiredRoutine: Name; 
                    VAR isnDesired : INTEGER; 
                    VAR numberDesired : INTEGER;
                    VAR originDesired : Language) : Status;
  VAR
      rtn : RNType;
  BEGIN
{ writeln('numroutines = ', numroutines,' desiredroutine=',desiredroutine,'@');}
    FOR rtn := 1 TO numRoutines DO
        WITH routines[rtn]^ DO
          IF routName = desiredRoutine
              THEN BEGIN
                     isnDesired := isn;
                     numberDesired := number;
                     originDesired := origin;
                     RoutLookup := allright;
                     Exit(RoutLookup);
                   END;
    RoutLookup := routNotFound
  END.