MODULE LDAGeneration; (* Ch. Jacobi *)

(* Version of 19.1.80 *)
(* last modification 18.5.80 *)

  FROM SYSTEM IMPORT ADDRESS, WORD, ADR;
  FROM Files IMPORT Create, Lookup, Release, ReadBlock, Close;
  FROM SystemTypes IMPORT LoadResultType, FileName, ErrorType;
  FROM PDP11 IMPORT LoaderInfo, InitialStart;
  FROM TTIO IMPORT Write, Read, WriteLn, WriteString;
  FROM FileNames IMPORT ReadFileName;
  FROM Streams IMPORT STREAM, Connect, Disconnect, Reset,
                   WriteChar, EndWrite;

  (*$T-*)


  PROCEDURE ReadOct(VAR i: WORD);
    VAR l,count: CARDINAL; c,f: CHAR;
  BEGIN
    LOOP (* try once to read a number *)
      LOOP
        REPEAT Read(c); Write(c) 
        UNTIL c#" "; 
        l := 0; f := c; count := 0;
        IF (c>"7") OR (c<"0") THEN EXIT END;
        REPEAT INC(count);
          IF (l>17777B) AND (f>"1") OR (count>6) THEN EXIT END;
          l := 8*l+CARDINAL(c)-60B;
          Read(c); Write(c)
        UNTIL (c<"0") OR (c>"7");
        i := WORD(l); 
        IF c=15C THEN Write(12C) END;
        RETURN 
      END;
      (* erronous input *)
      WHILE c<>15C DO Read(c) END;
      Write("?")
    END
  END ReadOct;

  PROCEDURE Halt(l: ARRAY OF CHAR);
    VAR i: CARDINAL;
  BEGIN
    WriteString(l);
    WriteLn;
    HALT
  END Halt;


  CONST  Inf = 0B; Outf = 1B;

  TYPE
    FlagType = (EntryPointFlag,CodeFlag,LinkerTableFlag,
                DebuggerTableFlag,OldLoadKeyFlag,NewLoadKeyFlag,
                FirstFreeLocFlag, OldFirstFreeLocFlag,
                MaxFlag);

   VAR

    LDAStream: STREAM;
    modFile: FileName;
    Buffer: ARRAY [0..255] OF WORD;
    BlockNr: CARDINAL; Index,Limit: INTEGER;
    Reply: INTEGER;

    Checksum, (* checksum of the file to be loaded *)
    OldLoadKey, (* old load key as read from the file to 
                   be loaded *)
    NewLoadKey: CARDINAL; (* new load key as read from the file 
                  to be loaded *)
    CodeFound,NewLoadKeyFound: BOOLEAN;
    EntryPoint: CARDINAL; (* entry point of the overlay 
                           layer to be loaded *)
    Stackbottom: CARDINAL;
    FirstFree: CARDINAL;
    Flag: FlagType; 
    NBytes,i,x: CARDINAL;
    c: CHAR;

  MODULE PutLDAFormat;
    IMPORT LDAStream, WriteChar, WORD;
    EXPORT PutStartBlock, PutWord, PutCheckSum, WriteByte;

    PROCEDURE WriteByte(c: CHAR);
    BEGIN
      WriteChar(LDAStream,c)
    END WriteByte;

    VAR Checksum: CARDINAL;

    PROCEDURE PutStartBlock(size, addr: WORD);
    BEGIN
      Checksum := 1;
      WriteByte(1c);
      WriteByte(0c);
      WriteByte(CHAR(CARDINAL(size) MOD 400B));
      WriteByte(CHAR(CARDINAL(size) DIV 400B));
      WriteByte(CHAR(CARDINAL(addr) MOD 400B));
      WriteByte(CHAR(CARDINAL(addr) DIV 400B));
      Checksum := (1 
                    + CARDINAL(size) MOD 400B 
                    + CARDINAL(size) DIV 400B 
                    + CARDINAL(addr) MOD 400B 
                    + CARDINAL(addr) DIV 400B)
                   MOD 400B
    END PutStartBlock;

    PROCEDURE PutWord(w: WORD);
    BEGIN
      WriteByte(CHAR(CARDINAL(w) MOD 400B));
      WriteByte(CHAR(CARDINAL(w) DIV 400B));
      Checksum := (Checksum 
                    + CARDINAL(w) MOD 400B 
                    + CARDINAL(w) DIV 400B)
                   MOD 400B
    END PutWord;

    PROCEDURE PutCheckSum;
    BEGIN
      WriteByte(CHAR((400B-Checksum)MOD 400B));
    END PutCheckSum;

  END PutLDAFormat;

  PROCEDURE ReadSector;
  BEGIN ReadBlock(Inf,ADR(Buffer),BlockNr,256,Limit);
    INC(BlockNr); Index := 0;
    IF Limit < 256 THEN Limit := 0;
    ELSE Limit := INTEGER(Buffer[255]);
    END;
  END ReadSector;

  PROCEDURE StartRead;
  BEGIN BlockNr := 0; ReadSector;
  END StartRead;

  PROCEDURE Readx(VAR fWord: WORD);
  BEGIN
    IF Index < Limit THEN
      fWord := Buffer[Index]; INC(Index);
      IF (Index=Limit) AND (Limit=255) THEN ReadSector END;
      (*$T-*) INC(Checksum,CARDINAL(fWord)); (*$T=*)
    ELSE Halt("file format")
    END;
  END Readx;

  PROCEDURE ReadAndCheck;
  BEGIN
    IF Index < Limit THEN
      IF Checksum # CARDINAL(Buffer[Index]) THEN
         Halt("checksum") END;
      INC(Index);
      IF (Index=Limit) AND (Limit=255) THEN ReadSector END;
    ELSE Halt("file format")
    END;
  END ReadAndCheck;

  PROCEDURE Eof(): BOOLEAN;
  BEGIN RETURN Index>=Limit;
  END Eof;
 
  PROCEDURE HandleModLodFile;
  BEGIN 
    CodeFound := FALSE;  NewLoadKeyFound := FALSE;
    EntryPoint:= 1; (* Illegal *)
    FirstFree := 1; (* Illegal *)
    Checksum := 0;
     StartRead;
     Readx(x); Flag := FlagType(x); Readx(NBytes); Readx(OldLoadKey);
     IF (Flag<>OldLoadKeyFlag) OR (NBytes<>6) THEN
       Halt("wrong format (oldloadkey)")
     END;
     ReadAndCheck;
     WHILE NOT Eof() DO
       Readx(x); Flag := FlagType(x); Readx(NBytes);
       IF (Flag>=MaxFlag) THEN
         Halt("wrong format (flag)")
       END;
         CASE Flag OF
           CodeFlag:
             Readx(x);
             PutStartBlock(NBytes,x); 
             FOR i := 1 TO (NBytes-6) DIV 2 DO
               Readx(x); PutWord(x);
             END;
             PutCheckSum;
             CodeFound := TRUE;
         | EntryPointFlag:
             IF (NBytes<>6) OR (EntryPoint<>1) THEN
               Halt("wrong format")
             END;
             Readx(EntryPoint); 
         | FirstFreeLocFlag:
             IF (NBytes<>6) OR (FirstFree<>1) THEN 
               Halt("wrong format")
             END;
             Readx(FirstFree); 
         | OldLoadKeyFlag: Halt("wrong format")
         | NewLoadKeyFlag:
              IF (NBytes<>6) OR NewLoadKeyFound THEN
                Halt("wrong format")
              END;
              Readx(NewLoadKey);
              NewLoadKeyFound := TRUE;
         ELSE 
           FOR i := 1 TO (NBytes-4) DIV 2 DO Readx(x) END;
         END;
         ReadAndCheck;
      END (*WHILE*);

      PutStartBlock(14B,ADR(InitialStart));
      PutWord(EntryPoint);    (* Entry *)
      PutWord(Stackbottom);       (* StackBottom *)
      PutWord(FirstFree+10B); (* StackLimit  *)
      PutCheckSum;

      (* dont start because of oddtransfer address *)
      PutStartBlock(6,1); 
      PutCheckSum;

      Release(Inf);
    IF NOT CodeFound THEN Halt(" code not found");
    ELSIF (FirstFree=1) OR (EntryPoint>=FirstFree)
    THEN Halt(" format error (firstfree)");
    END;
  END HandleModLodFile;

BEGIN
    WriteString("Stack start address: ");
    WriteString("(or 0 for default =120000B) ");
    ReadOct(Stackbottom); 
    IF Stackbottom=0 THEN
      Stackbottom := 120000B
    END;
    REPEAT
      WriteString("MOD.LOD file: ");
      ReadFileName(modFile,"DK MOD   LOD"); WriteLn;
      REPEAT Read(c) UNTIL c=15C;
      Lookup(Inf,modFile,Reply);
      IF Reply <= 0 THEN
        WriteString("not found");
      END;
    UNTIL Reply>0;
   modFile[9]  := "L";
   modFile[10] := "D";
   modFile[11] := "A";
   Create(Outf,modFile,Reply);
   IF Reply < 0 THEN Halt(".LDA file not created") END;
   Connect(LDAStream,Outf,FALSE);
   Reset(LDAStream);
   HandleModLodFile;
   EndWrite(LDAStream);
   Disconnect(LDAStream,TRUE);
   WriteString("end LDA generation"); WriteLn;
END LDAGeneration.