program ENT(input,output);
(*
  Wandeln von SOL-ENT-Dateien vom ASCII-Format in eine .COM-Datei

  Format der ENT Datei:

  Erste Zeile : 'ENTER 0000'
  Datenzeilen : '0000: 00 00 00 00 C3 5A 06 19 D2 20 45 20 D6 20 45 20'
  Letzte Zeile: '0DD0: 00 00/'

  Geschrieben fuer CP/M-80 TURBO-PASCAL 3.x
  Werner Cirsovius, Dezember 2002

  Ergaenzung September 2004:
  **************************

  Wegen abweichender Zeilen:

  Erste Zeile : 'EN XXXX'         ++++ Die Adresse XXXX kann aus 1 bis 4 Ziffern bestehen.
  Letzte Zeile: '0DD0: 00 00 /'   ++++ Vor dem Endzeichen '/' kann ein Leerzeichen stehen.

  Ergaenzung Oktober 2004:
  ************************

  Wegen des LF -> CR/LF  und fehlendem EOF-Zeichens beim WEB-Download
  wird die Eingabe-Datei nun zeichenweise gelesen.

  Ergaenzung Mai 2005:
  ********************

  Wegen abweichender Zeilen:

  Letzte Zeile: '/' (Ohne Adresse oder Bytes)

  Es koennen Leerstellen sein zwischen den Zeilen, die jetzt mit Nullen gefuellt werden:

  Zeile n+0 : '1A30: EA 24'
  Zeile n+1 : '1BE4: EA 24 FF 20 00 00 0D F8 1B 01 90 53 45 54 20 4E'

*)

const
  ENT1         = 'ENTER ';
  ENT2         = 'EN ';
  EOFCHR       = $1A;
  RECLEN       = 128;
  HEXLEN       =   4;
  LONGLEN      = 255;
  DOPPOS       =   5;       (* Position des Doppelpunktes in der Zeile *)
  CR           = ^M;
  LF           = ^J ;
  EOC          = ^Z ;
  DateiText    = 'Wandlung von .ENT Datei in .COM Datei';
type
  HexString    = string[HEXLEN];
  FSTR         = string[ 20];
  LSTR         = string[LONGLEN];
  Endset       = (on,off);
var
  FINAME,
  FONAME       : FSTR;
  Fi,
  Fo           : file;
  Iptr,
  Optr         : byte;
  Ibuff,
  Obuff        : array[1..RECLEN] of byte;
  LINE         : LSTR;
  StrAdr,
  EndAdr       : integer;
  EndCode      : boolean;

procedure ABORT(MSG:LSTR);
(*
  Ausgabe einer Fehlermeldung und Abbruch
*)
Begin
  writeln(MSG);
  halt;
End;

procedure FPUT(b:byte);
(*
  Byte in COM-Datei schreiben
*)
Begin
  EndAdr:=EndAdr+1;
  Optr:=Optr+1;
  Obuff[Optr]:=b;
  if (Optr=RECLEN) then
  begin
    blockwrite(Fo,Obuff,1);
    for Optr:=1 to RECLEN do Obuff[Optr]:=EOFCHR;
    Optr:=0;
  end;
End;

function FGETC:char;
(*
  Zeichen aus ENT-Datei lesen
*)
Begin
  if (Iptr=RECLEN) then
  begin
    {$I-}blockread(Fi,Ibuff,1);{$I+}
    if (IOResult<>0) then ABORT('Lesefehler in Datei '+FINAME);
    Iptr:=0;
  end;
  Iptr:=Iptr+1;
  FGETC:=char(Ibuff[Iptr]);
End;

procedure GetFileName;
(*
  Eingabe des Namens der Quelldatei
*)
var
  ErrAdr,
  i            : integer;

  procedure GetErr;
  (*
    Faengt ^C ab bei Konsoleingabe
  *)
  begin
    writeln;
    writeln('*** ABBRUCH');
    halt;
  end;

Begin (* GetFileName *)
  if ParamCount>1 then ABORT(DateiText+cr+lf+'Aufruf mit: ENT1 (Dateiname)');
  if (Paramcount=0) then
  begin
    ErrAdr:=ErrorPtr;
    ErrorPtr:=addr(GetErr);
    repeat
      write('Dateiname zur ',DateiText,'[.ENT] ');
      readln(FINAME);
    until (length(FINAME)>0);
    ErrorPtr:=ErrAdr;
  end else FINAME:=ParamStr(1);
  for i:=1 to length(FINAME) do FINAME[i]:=upcase(FINAME[i]);
End;

procedure CloseFiles;
(*
  Dateien schliessen
*)
Begin
  if (Optr<>0) then blockwrite(Fo,Obuff,1);
  close(Fo);
  close(Fi);
End;

procedure OpenFiles;
(*
  Oeffnen der benoetigten Dateien
*)
var
  p            : integer;
Begin
  p:=pos('.',FINAME);
  if (p=0) then FINAME:=FINAME+'.ENT';
  assign(Fi,FINAME);
  {$I-}reset(Fi);{$I+}
  if (IOResult<>0) then ABORT('Kann Datei '+FINAME+' nicht oeffnen');
  p:=pos('.',FINAME);
  FONAME:=copy(FINAME,1,p-1)+'.COM';
  assign(Fo,FONAME);
  {$I-}rewrite(Fo);{$I+}
  if (IOResult<>0) then ABORT('Kann Datei '+FONAME+' nicht anlegen');
  Iptr:=RECLEN;
  Optr:=0;
  EndCode:=FALSE;
End;

function GetHex(L:LSTR; dig:integer):integer;
(*
  Wandeln einer Zeichenkette in Hex-Wert
*)
var
  i,x,ch        : integer;
Begin
  x:=0;
  for i:=1 to dig do
  begin
    if (L[i] in ['0'..'9','A'..'F']) then
    begin
      ch:=ord(L[i])-ord('0');
      if (ch>9) then ch:=ch-(ord('A')-ord('0')-10);
      x:=x*16+ch;
    end else ABORT('Ungueltiges Hex-Zeichen: '+L[i]);
  end;
  GetHex:=x;
End;

procedure readline(var L:LSTR);
(*
  Zeile einlesen
*)
var
  ch           : char;
Begin
  L:='';
  repeat
    ch:=FGETC;
    if not (ch in [CR,LF,EOC]) then L:=L+ch;
  until (ch in [LF,EOC,'/']);
End;

procedure LineRead(mode:Endset);
(*
  Zeile einlesen, Leerzeilen ignorieren
*)
Begin
  repeat
    readline(LINE);
  until (length(LINE)<>0);
(*  if ((mode=on) and (odd(length(LINE)))) then LINE:=LINE+'.'; *)
End;

procedure Sync;
(*
  Suche nach Start der ENT-DAtei
*)
var
  len          : integer;

  function noENTsync(ENThead:LSTR):boolean;
  begin
    noENTsync:=(pos(ENThead,LINE)=0);
  end;

Begin (* Sync *)
  LineRead(off);
  if noENTsync(ENT1) then
  begin
    if noENTsync(ENT2) then
    begin
      writeln('Ungueltige erste Zeile (',LINE,')');
      writeln('- Erwartet: "',ENT1,'(xxx)x"');
      writeln('      oder: "',ENT2,'(xxx)x"');
      halt;
    end else len:=length(ENT2);
  end else len:=length(ENT1);
  delete(LINE,1,len);
  len:=length(LINE);
  if (len>HEXLEN) then ABORT('Start-Adresse "'+LINE+'" zu lang (In Anfangszeile)');
  StrAdr:=GetHex(LINE,len);
  EndAdr:=StrAdr;
End;

function Hex(Number: integer):HexString;
(*
  Ganze Zahl nach Hex wandeln
*)
const
  HexDigit:array[0..15]of char='0123456789ABCDEF';
var
  N            : integer;
  IntStr       : HexString;
Begin
  IntStr:='0000';
  for N:=HEXLEN downto 1 do
  begin
    IntStr[N]:=HexDigit[Number and $0F];
    Number:=Number shr 4;
  end;
  Hex:=IntStr;
End;

procedure ProcLine;
(*
  ASCII-Zeile bearbeiten
*)
var
  LinAdr,i     : integer;
  AscHex       : LSTR;
  BytHex       : byte;
  SPLINE       : LSTR;
  Chr          : char;

  procedure EraseBlanks;
  (*
    Delete blanks from SPLINE
  *)
  begin
    SPLINE:='';
    for i:=DOPPOS+1 to length(LINE) do
      if (LINE[i]<>' ') then SPLINE:=SPLINE+LINE[i];
  end;

  procedure FillGap;
  (*
    Fuellt Nullen
  *)
  begin
    writeln('Schreibe ',LinAdr-EndAdr,' Nullen - ',Hex(EndAdr),'H - ',Hex(LinAdr-1),'H');
    while (LinAdr<>EndAdr) do FPUT($00);
  end;

Begin (* ProcLine *)
  LineRead(on);
  EndCode:=(LINE[1]='/');
  if not EndCode then
  begin
    LinAdr:=GetHex(LINE,4);
    if (LINE[DOPPOS]<>':') then ABORT('":" fehlt in Zeile: '+LINE);
    if (LinAdr<EndAdr) then ABORT('Ungueltige Start-Adresse: '+Hex(LinAdr)+'H - maximal erwartet: '+Hex(EndAdr)+'H');
    if (LinAdr<>EndAdr) then FillGap;
    EraseBlanks;
    i:=1;
    repeat
      Chr:=SPLINE[i];
      EndCode:=(Chr='/');
      if not EndCode then
      begin
        AscHex:=Chr+SPLINE[i+1];
        BytHex:=GetHex(AscHex,2);
        FPUT(BytHex);
        i:=i+2;
      end;
    until (i>length(SPLINE)) or EndCode;
  end;
End;

BEGIN
(*
  Hauptprogramm
*)
  GetFileName;
  OpenFiles;
  Sync;
  repeat
    ProcLine
  until EndCode;
  CloseFiles;
  writeln('Datei ',FONAME,' beschrieben von ',HEX(StrAdr),'H-',HEX(EndAdr-1),'H');
END.