home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPKERMIT / SYSFUNC.PAS < prev    next >
Pascal/Delphi Source File  |  1987-03-25  |  26KB  |  625 lines
  1. (* +FILE+ SYSFUNC.PASMS *)
  2. (* ================================================================= *)
  3. (*  MsDos SYSTEM  dependent Routines for Kermit .                    *)
  4. (* ================================================================= *)
  5. (* Global Declaration  *)
  6. CONST
  7.     (* FLAGS in flag register *)
  8.     Cflag = $0001 ;
  9.     Pflag = $0004 ;
  10.     Aflag = $0010 ;
  11.     Zflag = $0040 ;
  12.     Tflag = $0100 ;
  13.     Iflag = $0200 ;
  14.     Dflag = $0400 ;
  15.     Oflag = $0800 ;
  16.  
  17. TYPE
  18.     regtype = record case layouts of
  19.               one: ( ax,bx,cx,dx,bp,si,di,ds,es,flags          : integer ;);
  20.               two: ( al,ah,bl,bh,cl,ch,dl,dh                   : byte ; ) ;
  21.            three : ( Sectors,Clusters,BytesperSec,TotalClusters: integer;)
  22.               end ;
  23.     ScreenArray = array [1..4000] of byte ;
  24.  
  25. VAR
  26.     register  : regtype ;
  27.     MyDTA : array [1..43] of byte ;
  28.     Remotecursor,LocalCursor : integer ;
  29.  
  30.     Commandline : comstring absolute Cseg:$80 ;
  31.  
  32.  
  33.     MonoScreen      : ScreenArray absolute $B000:$0000 ; (* Monchrome Video *)
  34.     ColorScreen     : ScreenArray absolute $B800:$0000 ; (* Colour graphics *)
  35.     OldLocalScreen  : ScreenArray  ;
  36.     OldRemoteScreen : ScreenArray  ;
  37.     NumLock,ScrollLock : byte ;
  38.  
  39. (* ------------------------------------------------------------------ *)
  40. (* KeyChar - get a character from the Keyboard.                       *)
  41. (*           It returns TRUE if character found and the char is       *)
  42. (*           returned in the parameter.                               *)
  43. (*           It returns FALSE if no keyboard character.               *)
  44. (*                                                                    *)
  45. (* ------------------------------------------------------------------ *)
  46.     Function KeyChar (var Achar,Bchar : byte): boolean ;
  47.     Begin (* KeyChar *)
  48.     with register do
  49.            begin
  50.            ah := 1;
  51.            intr($16,register);
  52.            if (Zflag and flags)=Zflag then
  53.  
  54. (* ------ The following code is required only if we want to us the ----- *)
  55. (* ------ NUMLOCK and SCROLLLOCK key as function keys  ----------------- *)
  56.               begin (* check for Numlck and Scroll Lck *)
  57.               ah := 2;
  58.               intr($16,register);
  59.               If  (al and $10) <> ScrollLock then
  60.                    Case (al and $0F) of
  61.                    0:     Bchar := $46 ; (* not shifted *)
  62.                    1,2,3: Bchar := $86 ; (* shifted *)
  63.                    4,5,6,7: Bchar := $87 ; (* control *)
  64.                    else Bchar := $87 ; (* Alt *)
  65.                    end  (* case *)
  66.                                             else
  67.               If  (al and $20) <> NumLock then
  68.                    Case (al and $0F) of
  69.                     0:     Bchar := $45 ; (* not shifted *)
  70.                     1,2,3: Bchar := $85 ; (* shifted *)
  71.                     4,5,6,7: Bchar := $88 ; (* control *) (* Not Available *)
  72.                     else Bchar := $88 ; (* Alt *)
  73.                    End (* case *)
  74.                                              else Bchar := 0 ;
  75.               ScrollLock := (al and $10) ;
  76.               NumLock := (al and $20) ;
  77.               Achar := 0 ;
  78.               If Bchar <> 0 then   KeyChar := true
  79.                             else   KeyChar := false
  80.               End   (* check for Numlck and Scroll Lck *)
  81. (*------ If you don't need this code, replace it with ------------------ *)
  82. (* --------   KeyChar := False ----------------------------------------- *)
  83.  
  84.                                      else
  85.               begin
  86.               ah := 0;
  87.               intr($16,register);
  88.               Achar := al ;
  89.               Bchar := ah ;
  90.               KeyChar := true;
  91.               end ;
  92.            end;
  93.     End ; (* KeyChar *)
  94.  
  95.  
  96. (* ------------------------------------------------------------------ *)
  97. (* CursorPosition - Returns Cursor Position in Reg DX.                *)
  98. (* ------------------------------------------------------------------ *)
  99.     Procedure CursorPosition ;
  100.     Begin (* CursorPosition *)
  101.     With register do
  102.          begin (* Get position *)
  103.          ah := 3;
  104.          intr($10,register);
  105.          end; (* Get position *)
  106.     End;
  107. (* ------------------------------------------------------------------ *)
  108. (* CursorUp -                                                         *)
  109. (* ------------------------------------------------------------------ *)
  110.     Procedure CursorUp ;
  111.     Begin (* CursorUp *)
  112.     With register do
  113.          begin (* Move up *)
  114.          ah := 3;  (* Function code 3 - Read Cursor Position *)
  115.          intr($10,register);
  116.          if dh > 1 then dh := dh - 1
  117.                    else dh := 24 ;
  118.          ah := 2 ;  (* Function code 2 - Set Cursor Position *)
  119.          intr($10,register);
  120.          end; (* Move up *)
  121.     End;  (* CursorUp *)
  122.  
  123. (* ------------------------------------------------------------------ *)
  124. (* CursorDown -                                                       *)
  125. (* ------------------------------------------------------------------ *)
  126.     Procedure CursorDown ;
  127.     Begin (* CursorDown *)
  128.     With register do
  129.          begin (* Move Down *)
  130.          ah := 3;  (* Function code 3 - Read Cursor Position *)
  131.          intr($10,register);
  132.          if dh < 24 then dh := dh + 1
  133.                    else dh := 1 ;
  134.          ah := 2 ;  (* Function code 2 - Set Cursor Position *)
  135.          intr($10,register);
  136.          end; (* Move Down *)
  137.     End;  (* CursorDown *)
  138.  
  139. (* ------------------------------------------------------------------ *)
  140. (* CursorRight -                                                      *)
  141. (* ------------------------------------------------------------------ *)
  142.     Procedure CursorRight ;
  143.     Begin (* CursorRight *)
  144.     With register do
  145.          begin (* Move Right *)
  146.          ah := 3;  (* Function code 3 - Read Cursor Position *)
  147.          intr($10,register);
  148.          if dl < 80 then dl := dl + 1
  149.                    else dl := 1 ;
  150.          ah := 2 ;  (* Function code 2 - Set Cursor Position *)
  151.          intr($10,register);
  152.          end; (* Move Right *)
  153.     End;  (* CursorRight *)
  154.  
  155. (* ------------------------------------------------------------------ *)
  156. (* CursorLeft -                                                       *)
  157. (* ------------------------------------------------------------------ *)
  158.     Procedure CursorLeft ;
  159.     Begin (* CursorLeft *)
  160.     With register do
  161.          begin (* Move Left *)
  162.          ah := 3;  (* Function code 3 - Read Cursor Position *)
  163.          intr($10,register);
  164.          if dl > 0 then dl := dl - 1
  165.                    else dl := 80 ;
  166.          ah := 2 ;  (* Function code 2 - Set Cursor Position *)
  167.          intr($10,register);
  168.          end; (* Move Left *)
  169.     End;  (* CursorLeft *)
  170. (* ------------------------------------------------------------------ *)
  171. (* FatCursor -                                                       *)
  172. (* ------------------------------------------------------------------ *)
  173.     Procedure FatCursor(flag :boolean);
  174.     Begin (* FatCursor *)
  175.     Port[$3D4] := $B ; (* Select Cursor end Register *)
  176.     If flag then Port[$3D5] := 9
  177.             else Port[$3D5] := 7 ;
  178.     End;  (* FatCursor *)
  179.  
  180.  
  181. (* ------------------------------------------------------------------ *)
  182. (* RemoteScreen - Procedure                                           *)
  183. (*                This procedure save the local screen and restores   *)
  184. (*                the remote screen.                                  *)
  185. (*                Also setup the 25th line to display settings        *)
  186. (* ------------------------------------------------------------------ *)
  187.     Procedure RemoteScreen ;
  188.     Begin (* RemoteScreen *)
  189.     If (OldRemoteScreen[4000]<>1) or (OldRemoteScreen[3999]<>32) then
  190.          Begin (* Initialize OldRemoteScreen *)
  191.          For i := 1 to 4000 do OldRemoteScreen[i] := 32 ;
  192.          OldRemoteScreen[4000] := 1 ;
  193.          RemoteCursor := $0000 ;
  194.          End ; (* Initialize OldRemoteScreen *)
  195.     With register do
  196.          begin (* Switch Screens *)
  197.          bx := 0 ;
  198.          ah := 15;  (* Function code 15 - Return Current video State *)
  199.          intr($10,register);
  200.          if al < 7 then
  201.               Begin (* Color Screen *)
  202.               OldLocalScreen := ColorScreen ;
  203.               ColorScreen := OldRemoteScreen ;
  204.               End  (* Color Screen *)
  205.                    else
  206.               Begin (* MonoChrome Screen *)
  207.               OldLocalScreen := MonoScreen ;
  208.               MonoScreen := OldRemoteScreen ;
  209.               End  (* MonoChrome Screen *)
  210.          end ; (* Switch Screens *)
  211.     With register do
  212.          begin (* Save ? Restore Cursor *)
  213.          bx := 0 ;
  214.          ah := 3;  (* Function code 3 - Read Cursor Position *)
  215.          intr($10,register);
  216.          localcursor := dx ;
  217.  
  218.          (* ---- set up 25th line with status ------ *)
  219.          ah := 2;       (* Function code 2 - Set Cursor Position *)
  220.          DX := $1800;   (* Set the cursor to Row 25 and column 0 *)
  221.          intr($10,Register);
  222.          Textcolor(Blue); Textbackground(Yellow);
  223.          Write  (' Port ');
  224.          If PrimaryPort then Write('One : ')
  225.                         else Write('Two : ');
  226.          Write(Baudrate,' baud, ');
  227.          Case paritytype(parity) of
  228.              OddP : write('Odd  ');
  229.              EvenP: write('Even ');
  230.              MarkP: write('Mark ');
  231.              NoneP: write('None ');
  232.          end ; (* parity case *)
  233.          Write('parity, ');
  234.          If LocalEcho then Write('Half duplex, ')
  235.                       else Write('Full duplex, ');
  236.          If XonXoff then write('Xon-Xoff ')
  237.                     else if Series1 then write('Series/1 ')
  238.                                     else write('Standard ');
  239.          Write  ('    ExitChar=CTL ',chr($40+LocalChar),'  ' ) ;
  240.          Textcolor(LightGreen); Textbackground(0);
  241.  
  242.          (* -------------------------------------------- *)
  243.  
  244.          dx := remotecursor ;
  245.          ah := 2 ;  (* Function code 2 - Set Cursor Position *)
  246.          intr($10,register);
  247.          end; (* Save ? Restore Cursor *)
  248.     Window(1,1,80,24);
  249.     End;  (* RemoteScreen *)
  250.  
  251. (* ------------------------------------------------------------------ *)
  252. (* LocalScreen  - Procedure                                           *)
  253. (*                This procedure save the remote screen and restores  *)
  254. (*                the local  screen.                                  *)
  255. (* ------------------------------------------------------------------ *)
  256.     Procedure LocalScreen ;
  257.     Begin (* LocalScreen *)
  258.     With register do
  259.          begin (* Switch Screens *)
  260.          bx := 0 ;
  261.          ah := 15;  (* Function code 15 - Return Current video State *)
  262.          intr($10,register);
  263.          if al < 7 then
  264.               Begin (* Color Screen *)
  265.               OldRemoteScreen := ColorScreen ;
  266.               ColorScreen := OldLocalScreen ;
  267.               End  (* Color Screen *)
  268.                    else
  269.               Begin (* MonoChrome Screen *)
  270.               OldRemoteScreen := MonoScreen ;
  271.               MonoScreen := OldLocalScreen ;
  272.               End  (* MonoChrome Screen *)
  273.          end ; (* Switch Screens *)
  274.     With register do
  275.          begin (* Save and Restore Cursor *)
  276.          ah := 3;  (* Function code 3 - Read Cursor Position *)
  277.          intr($10,register);
  278.          Remotecursor := dx ;
  279.          dx := Localcursor ;
  280.          ah := 2 ;  (* Function code 2 - Set Cursor Position *)
  281.          intr($10,register);
  282.          end; (* Save and Restore Cursor *)
  283.     TextColor(Yellow); TextBackground(Black);
  284.     Window(1,1,80,25);
  285.     End;  (* LocalScreen *)
  286.  
  287. (* ----------------------------------------------------------------- *)
  288. (* FirstFile - Returns True if file found for file mask Myfile       *)
  289. (*                 and the first file name is returned in Filename   *)
  290. (*           - Returns False if no file Found.                       *)
  291. (* ----------------------------------------------------------------- *)
  292. Function FirstFile(Myfile:Comstring; var Filename:Comstring): Boolean ;
  293. Var
  294.     OldSegment,OldOffset,i : integer ;
  295.  
  296.     Begin (* FirstFile Function *)
  297.     Myfile := concat(myfile,chr(0));
  298.     With Register do
  299.          Begin { Search for File }
  300.  
  301.          Ax := $2F00 ;      { Get DTA Dos Function }
  302.          MsDos(Register);
  303.          OldSegment := Es ; OldOffset := Bx ;  (* save old DTA location *)
  304.  
  305.          Ds := Seg(MyDTA);  Dx := Ofs(MyDTA) ;
  306.          Ax := $1A00 ;      { Set DTA Dos Function }
  307.          MsDos(Register);                      (* set my  DTA location *)
  308.  
  309.          Ax := $4E00 ;      {get first directory entry }
  310.          Ds := Seg(Myfile); { mask location }
  311.          Dx := Ofs(Myfile)+1;
  312.          Cx := 2 ;          {option}
  313.          MsDos(Register);
  314.          if al = 0 then    { Got file }
  315.               Begin (* Got File *)
  316.               i := 1 ;
  317.               Repeat
  318.                  Filename[i] := Chr (MyDTA[30 + i]) ;
  319.                  i := i + 1 ;
  320.               until (not (Filename[i-1] in [' '..'~'])) ;
  321.               Filename[0] := chr(i - 2);
  322.               Firstfile := true ;
  323.               End  (* Got file *)
  324.                  else
  325.               Firstfile := False ;
  326.  
  327.          Ds := OldSegment ;  Dx := OldOffset ;
  328.          Ax := $1A00 ;      { Set DTA Dos Function }
  329.          MsDos(Register);                    (* reset old DTA location *)
  330.          End; { Search for File }
  331.     End; { FirstFile Function }
  332. (* ----------------------------------------------------------------- *)
  333. (*  NextFile - Returns True if file found for file mask Myfile       *)
  334. (*                 and the first file name is returned in Filename   *)
  335. (*           - Returns False if no file Found.                       *)
  336. (* ----------------------------------------------------------------- *)
  337. Function NextFile(Var Myfile, Filename : Comstring): Boolean ;
  338. Var
  339.     OldSegment,OldOffset,i : integer ;
  340.  
  341.     Begin (* NextFile Function *)
  342.     With Register do
  343.          Begin { Search for File }
  344.  
  345.          Ax := $2F00 ;      { Get DTA Dos Function }
  346.          MsDos(Register);
  347.          OldSegment := Es ; OldOffset := Bx ;  (* save old DTA location *)
  348.  
  349.          Ds := Seg(MyDTA);  Dx := Ofs(MyDTA) ;
  350.          Ax := $1A00 ;      { Set DTA Dos Function }
  351.          MsDos(Register);                      (* set my DTA location *)
  352.  
  353.          Ax := $4F00 ;      { get next directory entry }
  354.          MsDos(Register);
  355.          if al = 0 then    { Got file }
  356.               Begin (* Got File *)
  357.               i := 1 ;
  358.               Repeat
  359.                  Filename[i] := chr (MyDTA[30 + i]) ;
  360.                  i := i + 1 ;
  361.               until (not (Filename[i-1] in [' '..'~'])) ;
  362.               Filename[0] := chr(i - 2);
  363.               Nextfile := true ;
  364.               End  (* Got file *)
  365.                  else
  366.               Nextfile := False ;
  367.  
  368.          Ds := OldSegment ;  Dx := OldOffset ;
  369.          Ax := $1A00 ;      { Set DTA Dos Function }
  370.          MsDos(Register);                    (* reset old DTA location *)
  371.          End; { Search for File }
  372.     End; { NextFile Function }
  373.  
  374. (* ------------------------------------------------------------------ *)
  375. (* SetDefaultDrive -                                                  *)
  376. (* ------------------------------------------------------------------ *)
  377.     Procedure SetDefaultDrive (Drive : Byte);
  378.     Begin (* SetDefaultDrive *)
  379.     With register do
  380.          begin (* Select disk *)
  381.          DL := Drive ;
  382.          Ax := $0E00 ;      { Select default drive }
  383.          MsDos(Register);
  384.          end; (* Select disk *)
  385.     End;  (* SetDefaultDrive *)
  386.  
  387. (* ------------------------------------------------------------------ *)
  388. (* DefaultDrive - returns the value of the default drive              *)
  389. (*                 A=0,B=1,C=2 etc.                                   *)
  390. (* ------------------------------------------------------------------ *)
  391.     Function DefaultDrive : Byte ;
  392.     Begin (* DefaultDrive *)
  393.     With register do
  394.          begin (* Current disk *)
  395.          Ax := $1900 ;      { Find default drive }
  396.          MsDos(Register);
  397.          DefaultDrive := al ;
  398.          end; (* Current disk *)
  399.     End;  (* DefaultDrive *)
  400.  
  401. (* ----------------------------------------------------------------- *)
  402. (*  DisplayDiskStatus - Display the disk status for the default disk.*)
  403. (*                                                                   *)
  404. (* ----------------------------------------------------------------- *)
  405. Procedure DisplayDiskStatus  ;
  406. Var
  407.     Freebytes : real ;
  408. Begin (* DisplayDiskStatus *)
  409. With Register do
  410.     Begin { Get disk status }
  411.     dl := DefaultDrive + 1 ;  (* use default drive *)
  412.     Write (' Disk Drive ',chr(DX+$40),':     ');
  413.     Ax := $3600 ;      { Get diskstatus Function }
  414.     MsDos(Register);
  415.     Writeln('Bytes/sector = ',BytesperSec,'  Sector/cluster = ',Sectors);
  416.     Writeln('Total Clusters = ',TotalClusters);
  417.     FreeBytes := BytesperSec*Sectors; (* two steps required due to  *)
  418.     FreeBytes := FreeBytes*Clusters ; (* integer overflow *)
  419.     Writeln('Free Clusters  = ',Clusters,'  i.e. ',Freebytes:7:0,' bytes free');
  420.     End; (* Get disk status *)
  421. End;  (* DisplayDiskStatus *)
  422. (* ----------------------------------------------------------------- *)
  423. (* MkDir - Make Directory.                                           *)
  424. (* ----------------------------------------------------------------- *)
  425. Procedure MkDirFunc(DirName:Comstring) ;
  426.     Begin (* MkDir  *)
  427.     DirName := DirName + chr(0) ;
  428.     With Register do
  429.          Begin { MD  }
  430.          Ds := Seg(DirName);  Dx := Ofs(DirName)+1 ;
  431.          Ax := $3900 ;      { MkDir Function }
  432.          MsDos(Register);
  433.          While Mem[Ds:Dx] <> 0 Do
  434.               Begin Write(Chr(Mem[Ds:Dx])); Dx := Dx + 1 ; End ;
  435.         Case Al of
  436.             0: writeln(' - New Directory Made ');
  437.             3: writeln(' - Path not found');
  438.             5: writeln(' - Acess denied');
  439.             else writeln(' - Return code =',al);
  440.           end; (* case of Ax *)
  441.         End ; { MD }
  442.     End ; (* MkDir *)
  443. (* ----------------------------------------------------------------- *)
  444. (* RmDir - Remove Directory.                                         *)
  445. (* ----------------------------------------------------------------- *)
  446. Procedure RmDirFunc(DirName:Comstring) ;
  447.     Begin (* RmDir  *)
  448.     DirName := DirName + chr(0) ;
  449.     With Register do
  450.          Begin { Remove Directory }
  451.          Ds := Seg(DirName);  Dx := Ofs(DirName)+1 ;
  452.          Ax := $3A00 ;      { RmDir Function }
  453.          MsDos(Register);
  454.          While Mem[Ds:Dx] <> 0 Do
  455.               Begin Write(Chr(Mem[Ds:Dx])); Dx := Dx + 1 ; End ;
  456.          Case Al of
  457.               0: writeln(' - Directory Removed ');
  458.               3: writeln(' - Path not found');
  459.               5: writeln(' - Acess denied');
  460.             else writeln(' - Return code =',al);
  461.             end; (* case of Ax *)
  462.         End ; { Remove Directory }
  463.     End ; (* RmDir *)
  464. (* ----------------------------------------------------------------- *)
  465. (* ChDir - Change Directory.                                         *)
  466. (* ----------------------------------------------------------------- *)
  467. Procedure ChDirFunc(DirName:Comstring) ;
  468.     Begin (* ChDir  *)
  469.     DirName := DirName + chr(0) ;
  470.     With Register do
  471.          Begin { CD  }
  472.          Ds := Seg(DirName);  Dx := Ofs(DirName)+1 ;
  473.          Ax := $3B00 ;      { ChDir Function }
  474.          MsDos(Register);
  475.          While Mem[Ds:Dx] <> 0 Do
  476.               Begin Write(Chr(Mem[Ds:Dx])); Dx := Dx + 1 ; End ;
  477.          Case Al of
  478.               0: writeln(' - Current Directory  ');
  479.               3: writeln(' - Path not found');
  480.               5: writeln(' - Acess denied');
  481.             else writeln(' - Return code =',al);
  482.             end; (* case of Ax *)
  483.         End ; { CD }
  484.     End ; (* ChDir *)
  485.  
  486. (* ----------------------------------------------------------------- *)
  487. (*  EXECFile - Exec a file.                                          *)
  488. (*                                                                   *)
  489. (* ----------------------------------------------------------------- *)
  490. Procedure EXECFile (Var RunString : comstring) ;
  491. Type
  492.      FCB      = record
  493.                 Drive    : char ;
  494.                 filename : array [1..8] of char ;
  495.                 filetype : array [1..3] of char ;
  496.                 Curblock : integer ;
  497.                 Recsize  : integer ;
  498.                 DosUse   : array [1..16] of char ;
  499.                 CurRec   : byte ;
  500.                 Randlow  : integer ;
  501.                 Randhigh : integer ;
  502.                 end ;
  503.      PPBrecord = record
  504.                  SegAddr       : integer ;
  505.                  ComlinePt     : ^Comstring ;
  506.                  FCB1pt,FCB2pt : ^FCB ;
  507.                  end;
  508. Var
  509.     PPB         : PPBrecord ;
  510.     Myfile      : comstring ;
  511.     FCB1,FCB2   : FCB ;
  512.  
  513. Begin (* RunFile *)
  514. Myfile := Gettoken(Runstring);
  515. If Pos('.',Myfile) = 0 then Myfile := Myfile + '.COM' ;
  516. With Register do
  517.     Begin (* SetBlock - Modify allocated Memory Blocks  *)
  518.     Ax := $4A00 ;      (* Set Block - Free up unused memory  *)
  519.     Es := CSeg ;       (* Point to begining of block *)
  520.     Bx := SSeg ;       (* Amount of memory in use *)
  521.     MsDos(Register);
  522.     Writeln(Register.BX,' paragraphs of memory in use .');
  523.     End ;  (* SetBlock - Modify allocated Memory Blocks  *)
  524.  
  525. Writeln(' Exec program  ',Myfile);
  526. Myfile := Myfile + chr($00) ;
  527. With Register do
  528.     Begin (* Set up Run  *)
  529.     Ax := $4B00 ;      (* Load and EXEC Function *)
  530. (*  Ax := $4B03 ;  *)  (* Load Overlay  Function *)
  531.     DS := Seg(Myfile); DX := Ofs(Myfile)+1 ; (* Point to Program name *)
  532.     ES := Seg(PPB) ;   BX := Ofs(PPB);       (* Point to Program Parm block *)
  533.     With PPB do
  534.          BEGIN  (* set up Program Parameter Block *)
  535.          SegAddr   :=  Memw[CSEG :$2C] ;
  536.          Comlinept :=  Addr(RunString);
  537.          FCB1pt    :=  Addr(FCB1);
  538.          FCB2pt    :=  Addr(FCB2);
  539.          End ;  (* set up Program Parameter Block *)
  540.  
  541. (*  MsDos(Register);      *)
  542.      (* The following in line code does the same thing as the MsDos call *)
  543.      (* with the exception that it also save and restores the SS and SP reg. *)
  544.     Inline (  $BF/Register/  (* MOV DI,Register *)
  545.               $1E/           (* PUSH DS *)
  546.               $07/           (* POP  ES *)
  547.               $1E/           (* PUSH DS *)
  548.               $06/           (* PUSH ES *)
  549.               $57/           (* PUSH DI *)
  550.               $55/           (* PUSH BP *)
  551.               $53/           (* PUSH BX *)
  552.               $B9/$09/$00/   (* MOV  CX,0009 *)
  553.               $26/           (* ES:     *)
  554.               $FF/$35/       (* PUSH [DI] *)
  555.               $47/           (* INC  DI *)
  556.               $47/           (* INC  DI *)
  557.               $E2/$F9/       (* LOOP back to PUSH [DI] *)
  558.               $07/           (* POP  ES *)
  559.               $1F/           (* POP  DS *)
  560.               $5F/           (* POP  DI *)
  561.               $5E/           (* POP  SI *)
  562.               $5D/           (* POP  BP *)
  563.               $5A/           (* POP  DX *)
  564.               $59/           (* POP  CX *)
  565.               $5B/           (* POP  BX *)
  566.               $58/           (* POP  AX *)
  567.     (* Now save SS and SP in location 104 of Code Segment *)
  568.               $57/           (* PUSH DI *)
  569.               $BF/$0104/     (* MOV  DI,0104 *)
  570.               $2E/           (* CS:     *)
  571.               $8C/$15/       (* MOV  [DI],SS *)
  572.               $47/           (* INC  DI *)
  573.               $47/           (* INC  DI *)
  574.               $2E/           (* CS:     *)
  575.               $89/$25/       (* MOV  [DI],SP *)
  576.               $5F/           (* POP  DI *)
  577.  
  578.     (*  This dumb msdos call destroys all the register including SS and SP  *)
  579.               $CD/$21/     (*  ********  MsDos Call  ******** *)
  580.  
  581.     (* Restore the SS and SP register from location 104 of Code Segment *)
  582.               $BF/$0104/     (* MOV  DI,0104 *)
  583.               $2E/           (* CS:     *)
  584.               $8E/$15/       (* MOV  SS,[DI] *)
  585.               $47/           (* INC  DI *)
  586.               $47/           (* INC  DI *)
  587.               $2E/           (* CS:     *)
  588.               $8B/$25/       (* MOV  SP,[DI] *)
  589.               $5F/           (* POP  DI *)
  590.     (* Now restore the rest of the registers from the stack *)
  591.               $9C/           (* PUSH F  *)
  592.               $06/           (* PUSH ES *)
  593.               $1E/           (* PUSH DS *)
  594.               $57/           (* PUSH DI *)
  595.               $56/           (* PUSH SI *)
  596.               $55/           (* PUSH BP *)
  597.               $52/           (* PUSH DX *)
  598.               $51/           (* PUSH CX *)
  599.               $53/           (* PUSH BX *)
  600.               $50/           (* PUSH AX *)
  601.               $8B/$EC/       (* MOV  BP,SP *)
  602.               $8B/$7E/$18/   (* MOV  DI,[BP+18] *)
  603.               $8E/$46/$1A/   (* MOV  ES,[BP+1A] *)
  604.               $B9/$0A/$00/   (* MOV  CX,000A *)
  605.               $26/           (* ES:     *)
  606.               $8F/$05/       (* POP  [DI] *)
  607.               $47/           (* INC  DI  *)
  608.               $47/           (* INC  DI  *)
  609.               $E2/$F9/       (* LOOP back to POP [DI] *)
  610.               $5B/           (* POP  BX *)
  611.               $5D/           (* POP  BP *)
  612.               $5F/           (* POP  DI *)
  613.               $07/           (* POP  ES *)
  614.               $1F);          (* POP  DS *)
  615.     Case Ax of
  616.          2: writeln('File >>> ',Myfile, ' <<< not found');
  617.          5: writeln('Acess denied');
  618.          8: writeln('Insufficient Memory to load program');
  619.         10: writeln('Invalid Environment');
  620.         end; (* case of Ax *)
  621.     End; (* Set up Run  *)
  622.  Writeln(' Return from Execution of ',Myfile);
  623. End;  (* RunFile *)
  624.  
  625.