home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / pibsoft / terminal / source / dosjump.mod < prev    next >
Encoding:
Text File  |  1988-02-13  |  12.5 KB  |  355 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   SetBlock --- Free up some memory above this program for DOS shell  *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. FUNCTION SetBlock( VAR Paragraphs : WORD ) : BOOLEAN;
  6.  
  7. VAR
  8.    Regs : Registers;
  9.  
  10. BEGIN (* SetBlock *)
  11.  
  12.    WITH Regs DO
  13.       BEGIN
  14.                                    (* Use DOS function $4A to release *)
  15.                                    (* memory                          *)
  16.          AH := $4A;
  17.          ES := PrefixSeg;
  18.          BX := Paragraphs;
  19.  
  20.          MSDOS( Regs );
  21.  
  22.          Paragraphs := BX;
  23.          SetBlock   := ( NOT ODD( Flags ) );
  24.  
  25.       END;
  26.  
  27. END   (* SetBlock *);
  28.  
  29. (*----------------------------------------------------------------------*)
  30. (*         DosExec -- Execute a DOS command or DOS shell                *)
  31. (*----------------------------------------------------------------------*)
  32.  
  33. FUNCTION DosExec( Command : AnyStr ) : INTEGER;
  34.  
  35. VAR
  36.    ComSpecStr     : AnyStr;
  37.    OldHeapEnd     : POINTER;
  38.    SizeOfFreeList : WORD;
  39.    ParasToKeep    : WORD;
  40.    ParasWeHave    : WORD;
  41.    ParasForDos    : WORD;
  42.    M              : WORD;
  43.  
  44. (*----------------------------------------------------------------------*)
  45. (*   SubtractPointers -- Find # of bytes between two pointer addresses  *)
  46. (*----------------------------------------------------------------------*)
  47.  
  48. FUNCTION SubtractPointers( High_Pointer : POINTER;
  49.                            Low_Pointer  : POINTER ) : LONGINT;
  50.  
  51. BEGIN (* SubtractPointers *)
  52.  
  53.    SubtractPointers := ( LONGINT( SEG( High_Pointer^ ) ) SHL 4 +
  54.                                   OFS( High_Pointer^ ) ) -
  55.                        ( LONGINT( SEG( Low_Pointer^  ) ) SHL 4 +
  56.                                   OFS( Low_Pointer^  ) );
  57. END   (* SubtractPointers *);
  58.  
  59. (*----------------------------------------------------------------------*)
  60. (*             HeapEnd --- Return pointer to end of heap                *)
  61. (*----------------------------------------------------------------------*)
  62.  
  63. FUNCTION HeapEnd : POINTER;
  64.  
  65. BEGIN (* HeapEnd *)
  66.  
  67.    IF ( OFS( FreePtr^ ) = 0 ) THEN
  68.  
  69.                                    (* Free list is empty -- add *)
  70.                                    (* $1000 to the segment.     *)
  71.  
  72.       HeapEnd := PTR( SEG( FreePtr^ ) + $1000 , 0 )
  73.    ELSE
  74.       HeapEnd := PTR( SEG( FreePtr^ ) + ( OFS( FreePtr^ ) SHR 4 ) , 0 );
  75.  
  76. END   (* HeapEnd *);
  77.  
  78. (*----------------------------------------------------------------------*)
  79.  
  80. BEGIN (* DosExec *)
  81.                                    (* Calculate # bytes to save *)
  82.  
  83.    SizeOfFreeList := SubtractPointers( HeapTop , HeapEnd );
  84.  
  85.                                    (* Check for sufficient memory in *)
  86.                                    (* unused file transfer buffer to *)
  87.                                    (* save free list                 *)
  88.  
  89.    IF ( MaxSectorLength < LONGINT( SizeOfFreeList ) ) THEN
  90.       BEGIN
  91.                                    (* Not enough memory to store free list *)
  92.         DosExec := -1;
  93.         EXIT;
  94.       END;
  95.                                    (* Save current pointer to end of *)
  96.                                    (* free list                      *)
  97.    OldHeapEnd  := HeapEnd;
  98.                                    (* Get current DOS memory allocation *)
  99.                                    (* from memory control block         *)
  100.  
  101.    ParasWeHave := MemW[ PRED( PrefixSeg ) : 3 ];
  102.  
  103.                                    (* Calculate amount of memory to give up *)
  104.  
  105.    ParasForDos := PRED( SubtractPointers( HeapTop , HeapPtr ) SHR 4 );
  106.  
  107.                                    (* Calculate amount of memory to keep *)
  108.                                    (* while in shell                     *)
  109.  
  110.    ParasToKeep := ParasWeHave - ParasForDos;
  111.  
  112.                                   (* See if enough memory to run DOS *)
  113.  
  114.    IF ( ( ParasForDos > 0 ) AND
  115.         ( ParasForDos < ( MinSpaceForDos SHR 4 ) ) ) THEN
  116.       BEGIN
  117.          DosExec := -4;
  118.          EXIT;
  119.       END;
  120.                                    (* Deallocate memory for DOS *)
  121.  
  122.    IF ( NOT SetBlock( ParasToKeep ) ) THEN
  123.       BEGIN
  124.          DosExec := -2;
  125.          EXIT;
  126.       END;
  127.                                    (* Build the Command string *)
  128.  
  129.    ComSpecStr := GetEnvStr( 'COMSPEC' );
  130.  
  131.    IF ( LENGTH( Command ) > 0 ) THEN
  132.       Command := '/C ' + Command;
  133.  
  134.    M := ( ParasForDos - 240 ) SHR 6;
  135.    WRITELN('Approximate memory available: ', M, 'K');
  136.  
  137.                                    (* Save free list *)
  138.  
  139.    MOVE( OldHeapEnd^, Sector_Data, SizeOfFreeList );
  140.  
  141.                                    (* Call Turbo's EXEC function *)
  142.    EXEC( ComSpecStr , Command );
  143.                                    (* Reallocate memory from DOS *)
  144.  
  145.    IF ( NOT SetBlock( ParasWeHave ) ) THEN
  146.       BEGIN
  147.          DosExec := -3;
  148.          EXIT;
  149.       END;
  150.                                    (* Restore free list *)
  151.  
  152.    MOVE( Sector_Data, OldHeapEnd^, SizeOfFreeList );
  153.  
  154.                                    (* Function result is in DosError *)
  155.    DosExec := DosError;
  156.  
  157. END   (* DosExec *);
  158.  
  159. (*----------------------------------------------------------------------*)
  160. (*                   DosJump --- Jump to Dos                            *)
  161. (*----------------------------------------------------------------------*)
  162.  
  163. PROCEDURE DosJump( Dos_String : AnyStr );
  164.  
  165. (*----------------------------------------------------------------------*)
  166. (*                                                                      *)
  167. (*     Procedure:  DosJump;                                             *)
  168. (*                                                                      *)
  169. (*     Purpose:    Provides facility for jumping to DOS                 *)
  170. (*                                                                      *)
  171. (*     Calling Sequence:                                                *)
  172. (*                                                                      *)
  173. (*        DosJump( Dos_String : AnyStr );                               *)
  174. (*                                                                      *)
  175. (*           Dos_String --- DOS command to execute                      *)
  176. (*                                                                      *)
  177. (*     Calls:                                                           *)
  178. (*                                                                      *)
  179. (*        DosExec                                                       *)
  180. (*        Open_For_Append                                               *)
  181. (*                                                                      *)
  182. (*----------------------------------------------------------------------*)
  183.  
  184. VAR
  185.    I            : INTEGER;
  186.    Ierr         : INTEGER;
  187.    Local_Save   : Saved_Screen_Ptr;
  188.    Open_Flag    : BOOLEAN;
  189.    Save_Cursor  : INTEGER;
  190.    Save_Status  : BOOLEAN;
  191.    Save_Video   : BOOLEAN;
  192.    Save_Border  : INTEGER;
  193.    Save_VidMode : INTEGER;
  194.    Save_Int1B   : POINTER;
  195.  
  196. BEGIN (* DosJump *)
  197.                                    (* Save screen contents. Note that *)
  198.                                    (* EGA contents must actually be   *)
  199.                                    (* saved this time.                *)
  200. {
  201.    Really_Save_EGA := TRUE;
  202. }
  203.    Save_Screen( Local_Save );
  204.  
  205.    Save_VidMode := Current_Video_Mode;
  206.  
  207.    PibTerm_Window( 1, 1, Max_Screen_Col, Max_Screen_Line );
  208.    Scroll( 1, Max_Screen_Line, 1, Max_Screen_Col, 0,
  209.            LightGray, Black );
  210.    Save_Border := Global_Border_Color;
  211.    Set_Border_Color( Black );
  212.    GoToXY( 1 , 1 );
  213.  
  214.    Save_Status    := Do_Status_Time;
  215.    Do_Status_Time := FALSE;
  216.  
  217.    IF ( LENGTH( Dos_String ) = 0 ) THEN
  218.       BEGIN
  219.          WRITELN;
  220.          WRITELN('Jump to DOS:  Enter EXIT to return to PibTerm');
  221.       END;
  222.                                    (* Turn off extended keypad *)
  223.    IF Extended_Keypad THEN
  224.       Remove_Keyboard_Handler;
  225.                                    (* Turn off video handler   *)
  226.  
  227.    Save_Video := Video_Handler_Installed;
  228.  
  229.    IF Save_Video THEN
  230.       Remove_Video_Handler;
  231.                                    (* Close capture file *)
  232.    IF Capture_On THEN
  233.          (*!I-*)
  234.       CLOSE( Capture_File );
  235.          (*!I+*)
  236.                                    (* Close log file *)
  237.    IF Log_File_Open THEN
  238.          (*!I-*)
  239.       CLOSE( Log_File );
  240.          (*!I+*)
  241.  
  242.    I := Int24Result;
  243.                                    (* Remove Int 24 error handler *)
  244.    Int24OFF( FALSE );
  245.                                    (* Close communications if requested *)
  246.    IF Close_Comm_For_Dos THEN
  247.       Async_Close( FALSE );
  248.                                    (* Change cursor to block *)
  249.  
  250.    IF ( Font8x8Loaded OR ( Current_Video_Mode <> 7 ) ) THEN
  251.       CursorSet( $0107 )
  252.    ELSE
  253.       CursorSet( $010D );
  254.                                    (* Allow <CTRL>Break checking *)
  255.    GetIntVec( $1B , Save_Int1B );
  256.    SetIntVec( $1B , SaveInt1B  );
  257.  
  258.                                    (* Jump to DOS *)
  259.    Ierr := DosExec( Dos_String );
  260.  
  261.                                    (* Disallow <CTRL>Break checking *)
  262.    SetIntVec( $1B , Save_Int1B );
  263.  
  264.                                    (* Restore previous video mode *)
  265.  
  266.    IF ( Current_Video_Mode <> Save_VidMode ) THEN
  267.       Set_Text_Mode( Save_VidMode );
  268.  
  269.                                    (* Reset EGA if needed         *)
  270.    IF EGA_Present THEN
  271.       Set_EGA_Text_Mode( Max_Screen_Line );
  272.  
  273.                                    (* Change cursor back to underline *)
  274.    CursorOn;
  275.                                    (* Restore Int24 Error handler *)
  276.    Int24ON;
  277.                                    (* Restore communications.  Port *)
  278.                                    (* opened twice in case major    *)
  279.                                    (* weirdness causes first open   *)
  280.                                    (* to screw up.                  *)
  281.    IF Close_Comm_For_Dos THEN
  282.       FOR I := 1 TO 2 DO
  283.          Open_Flag  := Async_Open( Comm_Port, Baud_Rate, Parity, Data_Bits,
  284.                                    Stop_Bits )
  285.    ELSE
  286.       Async_Clear_Errors;
  287.  
  288.    CASE Ierr OF
  289.       -1: WRITELN('Not enough memory to store free list, DOS jump cannot be done');
  290.       -2: WRITELN('Set Block error, DOS jump cannot be done');
  291.       -3: BEGIN
  292. {
  293.              WRITELN('Set Block error on return from DOS, PibTerm cannot continue.');
  294.              WRITELN('You will probably need to re-boot.');
  295. }
  296.              Halt( BadDosJump );
  297.           END;
  298.       -4: WRITELN('Not enough memory to jump to DOS');
  299.       ELSE
  300.          WRITELN('Back to PibTerm, DOS return code is ',Ierr);
  301.    END (* CASE *);
  302.                                    (* Reopen capture file for append *)
  303.    IF Capture_On THEN
  304.       BEGIN
  305.  
  306.          IF ( NOT Open_For_Append( Capture_File , Capture_File_Name , I ) ) THEN
  307.             BEGIN
  308.                WRITELN('Can''t re-open capture file ',
  309.                         Capture_File_Name);
  310.                WRITELN('Capture option TURNED OFF.');
  311.                Capture_On := FALSE;
  312.                Window_Delay;
  313.             END;
  314.  
  315.       END;
  316.                                    (* Reopen log file for append *)
  317.    IF Logging_On THEN
  318.       Log_File_Open := Open_For_Append( Log_File,
  319.                                         Log_File_Name, I );
  320.  
  321.                                    (* Log this jump to DOS *)
  322.  
  323.    Write_Log('Jump to DOS   : ' + Dos_String, FALSE, FALSE );
  324.    Write_Log('   Return Code: ' + IToS( Ierr ), TRUE, FALSE );
  325.  
  326.                                    (* If we got here from Alt-J,  *)
  327.                                    (* or request for shell in     *)
  328.                                    (* script, then wait for a key *)
  329.                                    (* to be struck.               *)
  330. {
  331.    IF ( LENGTH( Dos_String ) = 0 ) OR
  332.       ( ( ( Err <> 0 ) OR ( Ierr <> 0 ) ) AND Attended_Mode ) AND
  333.       ( NOT Host_Mode ) THEN
  334.       Press_Any;
  335. }
  336.                                    (* Restore screen contents *)
  337.  
  338.    Restore_Screen_And_Colors( Local_Save );
  339.  
  340.    Set_Border_Color( Save_Border );
  341.  
  342.                                    (* Restore status line updating *)
  343.    Do_Status_Time := Save_Status;
  344.                                    (* Restore extended keyboard    *)
  345.    IF Extended_Keypad THEN
  346.       Install_Keyboard_Handler;
  347.                                    (* Restore video handler        *)
  348.    IF Save_Video THEN
  349.       Install_Video_Handler;
  350.                                    (* Turn off save EGA flag       *)
  351. {
  352.    Really_Save_EGA := FALSE;
  353. }
  354. END   (* DosJump *);
  355.