PROGRAM TEST;

Const Message : String[128] = '';
Var   Ch      : Char;


PROCEDURE EXEC;

{ Diese Prozedur muss in das Anwenderprogramm eingebunden werden. }

TYPE  String_30  =  String[30];

CONST com = '.COM';

VAR   Pointpos, Blankpos, Count   : Integer;
      Argument, Filename          : String_30;
      Argument_1                  : String_30 absolute $100;
      Ch                          : Char;
      Quit                        : Boolean;
      Buf                         : File;
      Execprog             : Array[1.. 1024] of Byte absolute $8000;



Procedure Get_Name;

Begin
  Writeln;
  Write('Programm : ');
  Readln(Filename);
  Quit := Filename = '';
End; { Get_Name }



Function File_OK (Var Testfile : String_30) : Boolean;

{ ...untersucht, ob das aufgerufene Programm auf der }
{ Diskette ist und liefert in diesen Falle TRUE      }

Begin
  {$I-}
  Assign(buf, Testfile);
  Reset(Buf);
  File OK := IOresult = 0;
  {$I+}
End; { File_OK }

Begin    { EXEC }
  Get_Name;
  If not Quit then
    Begin
      For Count := 1 to Length(Filename) Do
         Filename[Count] := Upcase(Filename[Count]);
      Argument := Filename;
      Blankpos := Pos(' ',Filename);
      If Blankpos > 0 Then
           Filename := Copy(Filename, 1, Blankpos - 1);
      Pointpos := Pos('.',Filename);
      If Pointpos > 0 Then
        Filename := Concat(Copy(Filename, 1,Pointpos - 1),Com)
      Else Filename := Concat(Filename,Com);
      If File_Ok(Filename) Then
        Begin
          Bdos(15,$5C);
          Writeln('Loading ',Filename);
          Argument_1 := Argument;

Inline
(
                 { Verschieberoutine                                    }
$31/$00/$01/     {        LD SP, 0100H                                  }
$AF/             {        XOR A              ;0=Bezugslaufwerk          }
$32/*+110/       {        LD (RFCB),A        ;in FCB eintragen          }
$21/*+13/        {        LD HL,PROGRM       ;Das folgende Programm     }
$11/$00/$01/     {        LD DE,0100H        ;wird nach 0100H geschoben }
$01/$7E/$00/     {        LD BC,LIMIT - PROGRM                          }
$ED/$B0/         {        LDIR                                          }
$C3/$00/$01/     {        JP 0100H           ;...und gestartet          }
                 {                                                      }
                 { Dieser Programmteil liegt jetzt in 0100H             }
                 {                                                      }
$0E/$0F/         { PROGRM:LD C,0FH           ;EXECUTE.OVR wird eroeffnet}
$11/$5E/$01/     {        LD DE,FCB                                     }
$CD/$05/$00/     {        CALL BDOS                                     }
$3C/             {        INC A              ;Akku bei Fehler FF nach   }
$28/$50/         {        JR Z,ERROR         ;INC Null                  }
$11/$00/$80/     {        LD DE,08000H       ;TURBO.OVR n. 08000H laden }
$D5/             { LOAD:  PUSH DE            ;DE fuer retten            }
$0E/$1A/         {        LD C,01AH          ;DMA-Adresse setzen        }
$CD/$05/$00/     {        CALL BDOS                                     }
$0E/$14/         {        LD C,014H          ;Block von Diskette lesen  }
$11/$5E/$01/     {        LD DE,FCB                                     }
$CD/$05/$00/     {        CALL BDOS                                     }
$FE/$00/         {        CP 0               ;Akku Null wenn OK         }
$20/$08/         {        JR NZ,READY        ;...sonst letzter Block    }
$21/$80/$00/     {        LD HL,0080H        ;DMA-Adr. um 80H erhoeher, }
$D1/             {        POP DE                                        }
$19/             {        ADD HL,DE                                     }
$EB/             {        EX DE,HL                                      }
$18/$E6/         {        JR LOAD            ;...und neuen Block lesen  }
                 {                                                      }
                 { Parameter-Uebergabe an EXECUTE.OVR auf dem Stack     }
                 {                                                      }
$21/ARGUMENT_1/  { READY: LD HL,ARGUMENT_1   ;Ctrl/Z an das Ende des    }
$16/$00/         {        LD D,0             ;Filenamens setzen         }
$5E/             {        LD E,(HL)          ;HL zeigt auf Laengenbyte  }
$19/             {        ADD HL,DE                                     }
$23/             {        INC H                                         }
$36/$1A/         {        LD (HL),01AH                                  }
$ED/$5B/BLANKPOS/{        LD DE,(BLANKPOS)                              }
$7B/             {        LD A,E                                        }
$B3/             {        OR E               ;Zero, wenn kein Blank     }
$28/$04/         {        JR Z,POINT         ;Pointer uebergeben        }
$21/ARGUMENT_1/  {        LD HL,ARGUMENT_1   ;sonst Zeiger auf Blank    }
$19/             {        ADD HL,DE          ;uebergeben                }
$E5/             { POINT: PUSH HL                                       }
$21/$5C/$00/     {        LD HL,005CH        ;Zeiger auf den CP/M FCB   }
$E5/             {        PUSH HL                                       }
$3A/$5E/$01/     {        LD A,(FCB)         ;Laufwerk                  }
$3C/             {        INC A              ;+ 1                       }
$F5/             {        PUSH AF            ;uebergeben                }
$21/$F3/$03/     {        LD HL,03F3H                                   }
$E5/             {        PUSH HL                                       }
$21/$81/$00/     {        LD HL,0081H        ;Anz. d. ueberg. Parameter }
                 { ;Hier ist die Message $81 Bytes lang. Dieser Wert    }
                 { ;muss wie im Text erklaert angepasst werden. Falls   }
                 { ;keine Daten gerettet werden m}ssen, ist er          }
                 { ;auf $01 zu setzen.                                  }
$E5/             {        PUSH HL                                       }
$21/$E7/$1F/     {        LD HL,1FE7H        ;Adr. d. ueberg. PARAM.    }
                 {                           ;hier ist es $1FE7         }
$E5/             {        PUSH HL                                       }
$21/$00/$01/     {        LD HL,0100H        ;Restart-Adresse           }
$E5/             {        PUSH HL                                       }
$C3/$00/$80/     {        JP 08000H          ;Sprung in EXECUTE.OVR     }
                 {                                                      }
                 { Falls Fehler normalen Warmstart                      }
$C3/$00/$00/     { ERROR: JP 0000H                                      }
$00/             { RFCB:  DB 0                                          }
$45/$58/$45/$43/ {        DB 'EXECUTE OVR'   ;Aendern falls noetig!     }
$55/$54/$45/$20/ {                                                      }
$4F/$56/$52/     {                                                      }
$00/$00/$00/$00/ {        DB 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0    }
$00/$00/$00/$00/ {                                                      }
$00/$00/$00/$00/ {                                                      }
$00/$00/$00/$00/ {                                                      }
$00/$00/$00/$00/ {                                                      }
                 { LIMIT: END                                           }
$00);

       End
      Else
        Begin
          Writeln('Kein Programm : ',Filename);
          Writeln('Taste druecken !');
          Read(KBD,Ch);
        End;
    End;

{ Hier noch angeben, was die Prozedur alternativ tun soll, }
{ falls das aufgerufene Programm nicht auf der Diskette    }
{ gefunden wurde!                                          }

End; {EXEC}

Begin  { Main }
  Writeln(Message);
       {   Message ist beim ersten Aufruf noch leer.       }
       {   Die Message, die Sie gleich eingeben, wird aber }
       {   gerettet und nach Wiedereintritt ausgegeben     }
  Writeln('Schreiben Sie mal was!');
  Readln (Message);
  If Message <>'' Then EXEC
  Else
    Begin
      Writeln('Sie haben nichts eingetippt! Zur Strafe ist das ');
      Writeln('Programm zuende. Tschuesssss!');
    End;
End.