{
  This stuff should be just a new filetransfer and -linker system,
  written especially for designing programs on 8-bit Commodore
  computers. ...This is the third issue, as I begun it in Sphinx C--,
  then changed to Borland C++ when C-- set me up. And at last, I've
  kicked out the C++ source and this is already the TP version.
  ...Well, I don't know yet if this will not set me up... :-(

  ...Mankind has got 2 stay with traditions... :-)
                                                                      }

{$E-        Don't emulate floating-point part                         }
{$N-        as we don't need it for this program                      }
{$I-        I/O checking off. Runtime error sux...                    }

{
                            ° °
                        I  °°°°°  Pascal!!! :-)
                            °°°
                             °                                        }

Program ComLink;

Uses Dos;

Const
           PULLUP        = $E4;  {11100100, default value}
           STROBE        = $FE;  {11111110}
           AUTOFD        = $FD;  {11111101}
           SEL_IN        = $F7;  {11110111}
           BIN           = 0;
           OBJ           = 1;
           X1541cable    = 0;
           DISK64Ecable  = 1;
           Parallelcable = 2;

           OK            = 0;
           BadLptPort    = 1;
           BadInputType  = 2;
           BadCableType  = 3;
           BadStart      = 4;
           BadRun        = 5;
           NoFileName    = 6;
           UnknownSw     = 7;

           Error         = 1;

           timeout       = 1;
           brk           = 2;

           FirstPass     = True;
           SecondPass    = False;

Var
           filename      :string[80];
           LPT_base      :word;
           in_type       :byte;
           cable         :byte;
           start         :word;
           run           :word;
           init          :boolean;
           ATN0,ATN1     :byte;
           DATA0,DATA1   :byte;
           CLK0,CLK1     :byte;
           prmmatrx      :array[1..6] of string[80];
           makefile      :text;
           dptr          :pointer;
           i,j,k         :word;
   {        cn            :byte;  {***}
           prmrow        :string;
           nextrow       :string;


Function C2hex(n1,n2,n3,n4:char):word;
Begin
  If ((n1 >= 'A') and (n1 <= 'F')) Then n1:=Chr(Ord(n1)-7);
  If ((n2 >= 'A') and (n2 <= 'F')) Then n2:=Chr(Ord(n2)-7);
  If ((n3 >= 'A') and (n3 <= 'F')) Then n3:=Chr(Ord(n3)-7);
  If ((n4 >= 'A') and (n4 <= 'F')) Then n4:=Chr(Ord(n4)-7);

  C2hex := ((Ord(n1) - 48) shl 12) +
           ((Ord(n2) - 48) shl 8)  +
           ((Ord(n3) - 48) shl 4)  +
           (Ord(n4) - 48);
End;

Function Hex2c(num:word):string;
Var  i,tmp   :byte;

Begin
  For i := 1 To 4 Do Begin
                     tmp := (num shr ((i-1)*4)) and 15;
                     If tmp <= 9 Then Hex2c[5-i] := Chr(tmp+48)
                                 Else Hex2c[5-i] := Chr(tmp+55);
                     End;
  Hex2c[0] := Chr(4);
End;

Function Traceparams(count:byte; pass:boolean):byte;
Var i,j :byte;
    prm :string[80];
    stp :byte;

Begin
 stp := OK;
 in_type          := BIN;
 start            := $ffff;
 If pass Then run := $fffe
         Else run := $ffff;
 filename         := '';
 init             := false;

 i:=1;
 While ((i <= count) and (stp = OK)) Do
   Begin
   prm := prmmatrx[i];
   For j:=1 To Ord(prm[0])+1 Do If ((prm[j]>='a') and (prm[j]<='z'))
                                Then prm[j] := Chr(Ord(prm[j])-32);

   If prm[1] = '-' Then
     Begin
       Case prm[2] of

         'P': Begin
                LPT_base := C2hex('0',prm[3],prm[4],prm[5]);
                If ((LPT_base <> $0378) and
                    (LPT_base <> $0278) and
                    (LPT_base <> $03bc) and
                    (Ord(prm[0]) <> 5))  Then stp := BadLptPort;
              End;

         'C': Begin
               Case prm[3] of
                 'X': cable := X1541cable;
                 'D': cable := DISK64Ecable;
                 'P': cable := Parallelcable;
                Else stp := BadCableType;
               End;
               If Ord(prm[0]) <> 3 Then stp := BadCableType;
              End;

         'I': init := True;

         'T': Begin
               Case prm[3] of
                 'B': in_type := BIN;
                 'H': in_type := OBJ;
                 Else stp := BadInputType;
               End;
               If Ord(prm[0]) <> 3 Then stp := BadInputType;
              End;

         'S': If Ord(prm[0]) = 6
                 Then start := C2hex(prm[3],prm[4],prm[5],prm[6])
                 Else stp := BadStart;

         'R': If Ord(prm[0]) = 6
                 Then run := C2hex(prm[3],prm[4],prm[5],prm[6])
                 Else stp := BadRun;

         Else stp:=UnknownSw;

       End;
     End
   Else
       filename := prm;

 Inc(i);
 End;

 If (filename = '') and (not init) Then stp := NoFileName;
 TraceParams := stp;
End;

Procedure SendError(ErrorNum:byte);
Begin

 Case ErrorNum of

   BadLptPort  : Writeln('Invalid LPT-baseaddress!');

   BadCableType: Writeln('[X]1541, [D]isk64e and [P]arallel are valid!');

   BadInputType: Writeln('Only types of [B]inary and [H]ex are valid!');

   BadStart    : Writeln('Bad start-address!');

   NoFileName  : Writeln('...No filename');

   UnknownSw   : Writeln('Unknown switch or parameter!');

 End;
 If ErrorNum <> NoFileName Then Writeln('Cannot transfer ',filename);
End;

Procedure InitCon;
Begin

 Asm
      mov dx,LPT_base
      add dx,2
      mov al,PULLUP
      out dx,al
 End;

 If cable = X1541cable Then Begin
                            ATN0     := STROBE;
                            ATN1     := STROBE xor $FF;
                            DATA0    := SEL_IN;
                            DATA1    := SEL_IN xor $FF;
                            CLK0     := AUTOFD;
                            CLK1     := AUTOFD xor $FF;
                            End

                       Else Begin
                            ATN0     := SEL_IN;
                            ATN1     := SEL_IN xor $FF;
                            DATA0    := AUTOFD;
                            DATA1    := AUTOFD xor $FF;
                            CLK0     := STROBE;
                            CLK1     := STROBE xor $FF;
                            End;

End;

{Function OutBlock(dptr:pointer; LPT_base:word; cable:byte; size:word):byte;

{ This short routine was used to test if the linker's functions work
proprerly. I suppose, it should remain here, as I bet I'll work on the
linker someday.
The 'cn' global variable belongs also to this function.}
{Var f:file;
    st:string;
    st2:string;
Begin
  OutBlock := OK;
  str(start,st);
  str(cn,st2);
  Assign(f,st+st2+'.dat');
  Rewrite(f,1);
  BlockWrite(f,dptr^,size);
  Close(f);
  Inc(cn);
End;}

Function OutBlock(dptr:pointer; LPT_base:word; cable:byte; size:word):byte;
Var res,s               :byte;
    old_s,old_o         :word;

Begin
  Write('Transferring block: ');

  Asm
      cli
      xor  ax,ax
      mov  es,ax
      mov  ax,es:[20h]
      mov  old_o,ax
      mov  ax,es:[22h]
      mov  old_s,ax
      mov  ax,offset @newint
      mov  es:[20h],ax
      mov  ax,cs
      mov  es:[22h],ax
      mov  s,0
      mov  dx,ss:LPT_base
      add  dx,2
      mov  al,PULLUP
      out  dx,al
      sti

      mov  res,OK
      les  si,dptr
      mov  cx,size

@main:
      mov  bh,es:[si]
      push cx
      call @outbyte
      pop  cx
      jc   @timeout

      cmp  cl,0
      jne  @nopress

      mov  dl,'#'
      mov  ah,2
      int  21h
      mov  ah,1
      int  16h
      jz   @nopress

      mov  ah,0
      int  16h
      mov  res,brk
      jmp  @endtrans

@nopress:
      inc  si
      loop @main

      jmp  @endtrans

@timeout:
      mov  res,timeout
      jmp  @endtrans


@outbyte:
      mov  dx,LPT_base
      cmp  cable,Parallelcable
      jne  @sr

      mov  al,bh
      out  dx,al
      mov  bl,DATA1
      add  dx,2
      cmp  s,0
      jne  @p1
      call @sync1
      jc   @out
      mov  s,1
      ret
@p1:  call @sync2
      jc   @out
      mov  s,0
      ret

@sr:  add  dx,2
      mov  bl,ATN1
      mov  cx,4

@s1:
      mov  al,PULLUP
      or   al,CLK1
      shl  bh,1
      jnc  @0b1
      or   al,DATA1
@0b1: out  dx,al

      call @sync11
      jc   @out

      mov  al,PULLUP
      shl  bh,1
      jnc  @0b2
      or   al,DATA1
@0b2: out  dx,al
      call @sync21
      jc   @out
      loop @s1

@out: ret


@sync1:
      in   al,dx
      and  al,PULLUP
      or   al,CLK1
      out  dx,al

@sync11:
      mov  al,00111000b
      out  43h,al
      xor  al,al     {set 1 s delay, using as 'watchdog'}
      out  40h,al
      out  40h,al
      mov  cs:byte ptr @cnt,18

@c1:  in   al,dx
      and  al,bl     {...and wait while the actual synchron-bit goes up}
      jnz  @ok
      cmp  cs:byte ptr @cnt,0
      jne  @c1

      mov  al,PULLUP
      out  dx,al
      stc
      ret

@sync2:
      in   al,dx
      and  al,PULLUP
      out  dx,al

@sync21:
      mov  al,00111000b
      out  43h,al
      xor  al,al
      out  40h,al
      out  40h,al
      mov  cs:byte ptr @cnt,18

@c4:  in   al,dx
      and  al,bl
      jz   @ok
      cmp  cs:byte ptr @cnt,0
      jne  @c4

      mov  al,PULLUP
      out  dx,al
      stc
      ret

@ok:  clc
      ret

@newint:
      push ax
      cmp  cs:byte ptr @cnt,0
      je   @i1
      dec  cs:byte ptr @cnt
      mov  al,00111000b
      out  43h,al
      mov  al,0ffh
      out  40h,al
      out  40h,al
@i1:  mov  al,20h
      out  20h,al
      pop  ax
      iret

@cnt: db  0


@endtrans:
      cli
      xor  ax,ax
      mov  es,ax
      mov  ax,old_o
      mov  es:[20h],ax
      mov  ax,old_s
      mov  es:[22h],ax
      mov  al,00110100b
      out  43h,al
      xor  al,al
      out  40h,al
      out  40h,al
      sti

      mov  dx,LPT_base
      add  dx,2
      mov  al,PULLUP
      out  dx,al

  End;
  OutBlock := res;
  Writeln;
  If res = timeout Then Writeln('No response from other computer.');
  If res = brk Then     Writeln('Transfer cancelled...');

End;

Function LoadBBlock(dptr:pointer; var f:file; start,run:word):word;
Begin
 LoadBBlock := 0;

 If start = $ffff Then Begin
                       If FileSize(f) > 65524 Then Begin
                          Writeln(filename,' is too big to transfer!');
                          Exit;
                          End;

                       memw[Seg(dptr^):Ofs(dptr^)  ] := FileSize(f)-2;
                       memw[Seg(dptr^):Ofs(dptr^)+2] := run;
                       dptr := Ptr(Seg(dptr^),Ofs(dptr^)+4);

                       Writeln('Loading ',filename,'...');
                       BlockRead(f,dptr^,FileSize(f));
                       If IOResult <> 0 Then Begin
                                             Writeln('I/O error...');
                                             Exit;
                                             End;
                       LoadBBlock := FileSize(f)+4;
                       End

                  Else Begin
                       If FileSize(f) > 65522 Then Begin
                          Writeln(filename,' is too big to transfer!');
                          Exit;
                          End;

                       memw[Seg(dptr^):Ofs(dptr^)  ] := FileSize(f);
                       memw[Seg(dptr^):Ofs(dptr^)+2] := run;
                       memw[Seg(dptr^):Ofs(dptr^)+4] := start;
                       dptr := Ptr(Seg(dptr^),Ofs(dptr^)+6);
                       Writeln('Loading ',filename,'...');
                       BlockRead(f,dptr^,FileSize(f));
                       If IOResult <> 0 Then Begin
                                             Writeln('I/O error...');
                                             Exit;
                                             End;
                       LoadBBlock := FileSize(f)+6;
                       End;
End;

Function LoadHBlock(dptr:pointer; var f:text; run:word):word;
Var arow          :string;
    size,start    :word;
    count,i       :byte;
    cp            :pointer;

Begin

  LoadHBlock := 0;
  size       := 0;
  If nextrow = '' Then Readln(f,arow)
                  Else arow := nextrow;

  count := C2hex('0','0',arow[2],arow[3]);
  If count = 0 Then Exit;
  start := C2hex(arow[4],arow[5],arow[6],arow[7]);
  memw[Seg(dptr^):Ofs(dptr^)+4] := start;
  cp := Ptr(Seg(dptr^),Ofs(dptr^)+6);

  Write('Loading block from $',Hex2C(start));

  Repeat
    For i := 0 To count-1 Do
       memw[Seg(cp^):Ofs(cp^)+i] :=
                            C2hex('0','0',arow[i shl 1 +10],arow[i shl 1+11]);

    cp := Ptr(Seg(cp^),Ofs(cp^)+count);
    Inc(size,count);
    Readln(f,arow);
    If IOResult <>0 Then Begin
                         Writeln;
                         Writeln('I/O error...');
                         Exit;
                         End;

    count := C2hex('0','0',arow[2],arow[3]);

  Until ((count=0) or (C2hex(arow[4],arow[5],arow[6],arow[7])<>start+size)
                   or (size > 65400));

  nextrow := arow;
  memw[Seg(dptr^):Ofs(dptr^)] := size;
  Writeln(' to $',Hex2C(start+size));

  If count = 0 Then memw[Seg(dptr^):Ofs(dptr^)+2] := run
               Else memw[Seg(dptr^):Ofs(dptr^)+2] := $ffff;

  LoadHblock := size+6;
End;

Function TransferFile(dptr:pointer; filename:string; LPT_base:word;
                                    cable,in_type:byte; start,run:word):byte;
Var size    :word;
    bfile   :file;
    hfile   :text;
    Outres  :byte;

Begin
  TransferFile := Error;
  If in_type = BIN Then
     Begin
       Assign(bfile,filename);
       Reset(bfile,1);
       If IOResult <> 0 Then Begin
                             Writeln('Cannot open ',filename,'!');
                             Exit;
                             End;

       size := LoadBBlock(dptr,bfile,start,run);
       Close(bfile);
       If size = 0 Then Exit;
       TransferFile := OutBlock(dptr,LPT_base,cable,size);
     End
  Else
     Begin
       nextrow := '';
       Assign(hfile,filename);
       Reset(hfile);
       Writeln('Loading ',filename,'...');
       If IOResult <> 0 Then Begin
                             Writeln('Cannot open ',filename,'!');
                             Exit;
                             End;
       Repeat
         size := LoadHblock(dptr,hfile,run);
         If size <> 0 Then OutRes := OutBlock(dptr,LPT_base,cable,size);
       Until ((size = 0) or (Outres <> OK));
       Close(hfile);
       If (Outres = OK) Then Transferfile := OK;

     End;
End;

Begin
 {cn:=0; {***}
 Asm
   in  al,061h
   and al,0fch
   or  al,01h
   out 061h,al
 End;

 LPT_base := $0378;
 cable    := Parallelcable;

  Writeln('ComLink V0.96á. (C)1996 H rsfalvi Levente');
{ASSUME  Versionnumber = (Year-1900)/100   =) }
  Writeln;
  If ParamCount = 0 Then
      Begin
       Writeln('Usage: COMLINK [filename||makefile.mak] [-pxxx] [-cx] [-tx] [-sxxxx] [-rxxxx]');
       Writeln('Or   : COMLINK -i [-pxxx]');
       Writeln('-p: LPT base-address');
       Writeln('-c: [X]1541, [D]isk64E or [P]arallel cable');
       Writeln('-t: [B]inary or [H]exadecimal (object) input-file');
       Writeln('-s: Start address (hex) in the other computers memory');
       Writeln('-r: Run code from hex xxxx');
       Writeln('-i: Just initialize LPT to leave I/O lines.');
       Writeln('You can use some special values as');
       Writeln('-SFFFF : ComLink will use the first bytes of the file as start-address.');
       Writeln('-RFFFE : Back to Basic after transferring.');
       Writeln('-RFFFF : Skip start-procedure after transferring.');
       Writeln('Defaults : -P378 -CP -TB -SFFFF -RFFFF');
       Halt;
       End;

  If ParamCount > 6 Then
      Begin
       Writeln('Too many parameters!');
       Halt;
      End;

  For i:=1 To ParamCount Do prmmatrx[i]:=ParamStr(i);

  j := TraceParams(ParamCount,FirstPass);

  If j <> OK Then Begin
                  SendError(j);
                  Halt;
                  End;

  If init Then Begin
               Asm
                  mov dx,LPT_base
                  add dx,2
                  mov al,PULLUP
                  out dx,al
               End;
               Writeln('Portbits initialized.');
               Halt;
               End;

  If MaxAvail < 65528 Then Begin
                           Writeln('Not enough memory!');
                           Halt;
                           End;
  GetMem(dptr,65528);
  InitCon;

  i := 1;
  While ((filename[i] <> '.') and ( i<= Ord(filename[0]))) Do Inc(i);

  If Copy(filename,i+1,3) = 'MAK'
   Then
    Begin
    Assign(makefile,filename);
    Reset(makefile);
    Repeat
      Readln(makefile,prmrow);
      i := 1;
      k := 0;
      While(i <= Ord(prmrow[0])) Do
        Begin
          If prmrow[i] <> ' ' Then
             Begin
             Inc(k);
             j := 0;
             While ((prmrow[i+j] <> ' ') and ((i+j) <= Ord(prmrow[0]))) Do
              Begin
                prmmatrx[k,j+1] := prmrow[i+j];
                Inc(j);
              End;
             prmmatrx[k,0] := Chr(j);
             Inc(i,j);
             End;
        Inc(i);
        End;

      j := TraceParams(k,SecondPass);
      If j = OK Then j := TransferFile(dptr,filename,LPT_base,cable,in_type,start,run)
                Else SendError(j);

    Until (Eof(makefile) or (j <> OK));
    End

   Else
     j := TransferFile(dptr,filename,LPT_base,cable,in_type,start,run);

  FreeMem(dptr,65528);

End.