home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / STAY50.ZIP / SR50.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-11-28  |  66.1 KB  |  1,440 lines
  1.  
  2. {$I direct.inc}
  3.   {──────────────────────────────────────────────────────────────────────}
  4.   {     Turbo Pascal Stay Resident Shell Interrupt Service Routines      }
  5.   {                                                                      }
  6.   {                Copyright (c) 1988 Lane H. Ferris                     }
  7.   {──────────────────────────────────────────────────────────────────────}
  8.  
  9.    unit SR50  ;
  10.  
  11.   {──────────────────────────────────────────────────────────────────────}
  12.                           interface
  13.   {──────────────────────────────────────────────────────────────────────}
  14.  
  15.   type
  16.  
  17.    bool    = boolean   ;
  18.    string8 = string[8] ;
  19.  
  20.    RUTidblktype = record       { aRe yoU There id block }
  21.    RUTidstr  : string[9] ;     { string identifier      }
  22.    RUTtermbyte : boolean ;     { quit this pgm byte     }
  23.    end {RUTblktype}      ;
  24.  
  25.   const
  26.  
  27.    debug    : boolean = false ;  { show interesting addrs     }
  28.  
  29.    RUTidblk  : RUTidblktype =
  30.      (RUTidstr:'SR 5.00  '; RUTTermbyte:false ) ;
  31.  
  32.    DftWindow : array[1..4] of            { default window coordinates   }
  33.                    byte = (1,1,80,25) ;
  34.  
  35.    Reserve = 1 ;         { Reserve/Release a resource }
  36.    Rlse    = 2 ;
  37.    _CRT    = 1 ;         { Resource id s              }
  38.    _KBD    = 2 ;
  39.  
  40.    border   = true  ;    { border or not for makewindow }
  41.    noborder = false ;
  42.  
  43.   type
  44.  
  45.    stackframe =  record                { picture of a stack frame }
  46.         Bp,ES,DS,Di,Si,Dx,Cx,Bx,Ax,Ip,CS,flags :word ;
  47.         end {stackframe}  ;
  48.    stackptr = ^stackframe ;       { points to a stack frame  }
  49.  
  50.    SRBptr    = ^SRBlock        ;
  51.    SRBlock   = record             { Stay Resident Block  }
  52.      SRBstackptr:stackptr      ;  { Stack pointer offset }
  53.      SRBlink    :SRBptr        ;  { Chain to next block  }
  54.      Procid     :word          ;  { Thread id number     }
  55.      Procptr    :pointer       ;  { pointer to procedure }
  56.      POPproc    :pointer       ;  { pointer to popupdn routine   }
  57.      PSP        :word          ;  { segment  Prefix storage area }
  58.      DTA        :pointer       ;  { pointer  disk transfer area  }
  59.      INT22ptr   :pointer       ;  { tasks terminate vector       }
  60.      INT23ptr   :pointer       ;  { tasks CtrlBreak vector       }
  61.      INT24ptr   :pointer       ;  { tasks Critical error vector  }
  62.      INT1Bptr   :pointer       ;  { tasks CtrlBreak 1B vector    }
  63.      CursorType   : word       ;  { Cursor scan lines from bios  }
  64.      CursorX      : byte       ;  { Cursor position X,Y          }
  65.      CursorY      : byte       ;
  66.      SRBVideoPage : byte       ;  { Active Video Page            }
  67.                                   { Extended error registers     }
  68.      ExtErrInfo   : array[1..8] of word;
  69.      CtrlCstatus  : byte       ;  { Control-C on or off          }
  70.      VerifyStatus : byte       ;  { Disk Verify status on/off    }
  71.      SRBname      : String[8]  ;  { Character name of Thread     }
  72.      SRBsuspended : word       ;  { Non-Dispatchability bits     }
  73.      SRBtype      : word       ;  { Task Type, timer,hotkey etc  }
  74.      KeyValue     : word       ;  { HotKey or timer value        }
  75.      END {SRB record}          ;
  76.  
  77.   const {for SRBsuspended word }  { Dispatchabe status          }
  78.    Suspended  = 0001           ;  { SRB is suspended            }
  79.    TimerWait  = 0002           ;  { SRB is doing a Delay        }
  80.    DosOwned   = 0004           ;  { DOS is owned by one task    }
  81.    MsgWait    = 0008           ;  { Waiting receieve in mailbox }
  82.  
  83.   var
  84.    CurrentSRB        : SRBptr   ;  { Ptr to Current Active SRB  }
  85.    Videoseg          : word     ;  { Upper Left of scrn      }
  86.  
  87.   const {for SRBtype }
  88.    TimerType  = 0001     ;              { Task activates on timer  }
  89.    KeyType    = 0002     ;              { Task activates on hotkey }
  90.    Systype    = 0004     ;              { Task is an internal task }
  91.  
  92.    TimerTicks    : word    =    0  ;    { Interrupt 8 ticks        }
  93.  
  94.    Procedure Attach( pUserPgmPtr:pointer; TsrType:word;
  95.                      TsrValue:word  ; pPopproc:pointer ; pName:string8) ;
  96.    Procedure Freeze                           ;
  97.    Procedure UnFreeze                         ;
  98.    Function  GetSRBaddr : pointer             ;
  99.    Function  GetSRBid   : word                ;
  100.    Procedure StartTSR                         ;
  101.    Procedure Resource (operation,resourceid : integer )  ;
  102.    Procedure Suspend  (pSRBid : word ; pSuspendbits : word ) ;
  103.    Procedure UnSuspend(pSRBid : word ; pSuspendbits : word ) ;
  104.    Procedure Yield                            ;
  105.    Procedure SingleTask                       ;
  106.    Procedure MultiTask                        ;
  107.    Procedure SR50_Xit                         ;
  108.   {──────────────────────────────────────────────────────────────────────}
  109.                           implementation
  110.   {──────────────────────────────────────────────────────────────────────}
  111.    uses crt ,
  112.         dos ,
  113.         macros,
  114.         SR50subs,
  115.         SRmsgu  ;
  116.  
  117.   const
  118.    BIOSI8          = 8;       { Bios Timer interrupt         }
  119.    BIOSI16         = $16;     { Bios Keyboard interrupt      }
  120.    BIOSI13         = $13;     { Bios Disk interrupt          }
  121.    DOSI1B          = $1B;     { Bios Ctrl-Break intr id      }
  122.    DOSI21          = $21;     { DOS service router interrupt }
  123.    DOSI22          = $22;     { DOS terminate address        }
  124.    DOSI23          = $23;     { DOS Ctrl-C  interrupt id     }
  125.    DOSI24          = $24;     { DOS critical interrupt id    }
  126.    DOSI28          = $28;     { DOS Idle interrupt id        }
  127.  
  128.    DosIdle      :boolean = false ;  { Dos is idle in INT 28     }
  129.    DosIdleDelay :integer =    10 ;  { 10 milsec delay in INT 28 }
  130.  
  131.    NumActiveSRBs:integer =     0 ;  { number of active tasks    }
  132.  
  133.        { character Rotor on screen to show dispatching }
  134.  
  135.    Rotreller      : array[0..3] of byte = ($11,$1E,$10,$1f) ;
  136.    Rotrposition   : byte   = 0     ; { Rotreller position      }
  137.    PutRotr        : pointer = nil  ; { Upper right of scrn ptr }
  138.  
  139.    stacksize      : integer = 1024 ; { stack size for each task }
  140.    stackOverhead  : integer = $200 ; { size of Turbo overhead   }
  141.  
  142.   const
  143.    zflag = $40   ;              { zero flag in 8086 flags    }
  144.  
  145.    Status     : byte = 0 ;             { Status of current TSR activity }
  146.     Inuse     =  02      ;             { TSR single process is active   }
  147.     frozen    =  04      ;             { Someone froze the system       }
  148.    Hotkeyon   : boolean = false   ;    { Received the HotKey            }
  149.  
  150.    Ints_Busy  : byte = 0 ;             { Active interrupts flags        }
  151.     INT13on   =     04   ;             { Disk  interrupt is active      }
  152.     INT16on   =     02   ;             { Int16 critical code busy       }
  153.     Foxs      =     $FF  ;
  154.  
  155.   Int8Busy      : boolean = false ;    { Semaphor in interrupt 8        }
  156.   Int8Waiting   : word    =     0 ;    { Int 8 missed dispatch count    }
  157.   Tick_request  : word    =    19 ;    { activate user on  count        }
  158.   DosIdleCount  : word    =     0 ;    { Dos Idle routine semaphore     }
  159.                                        { byte in seg $50                }
  160.  
  161.   Resources : array[_CRT.._KBD] of byte = (0,1) ;
  162.  
  163.   Var
  164.    VideoCols    : byte absolute $40:$4A ; { number of bios video columes }
  165.    VideoRows    : byte absolute $40:$84 ; { number of bios video rows    }
  166.    VideoPage    : byte absolute $40:$62 ; { active video page            }
  167.    VideoX       : byte absolute $40:$50 ; { cursor location x page 1     }
  168.    VideoY       : byte absolute $40:$51 ; { cursor location y page 1     }
  169.    BiosCursor   : word absolute $40:$60 ; { BIOS end/start cursor lines  }
  170.    BiosCurPos   : word absolute $40:$50 ; { BIOS cursor position page 1  }
  171.  
  172.   Var
  173.                               { Int5 PrintScreen status byte }
  174.    PrintScreenStatus : byte absolute $50:0 ;
  175.  
  176.  
  177.    DosIdleSRB        : SRBptr   ;  { Ptr to INDOS ISR SRB        }
  178.    TimerSRB          : SRBptr   ;  { Ptr to Timer ISR SRB        }
  179.    DosStackPtr       : pointer  ;  { location of InDos stack     }
  180.    Int16stack        : pointer  ;  { forground int16 stack save  }
  181.  
  182.    InTimerStackptr   :pointer   ;  { temporary ptr to stack      }
  183.  
  184.    BIOS_INT8   : pointer ; { BIOS Timer Interrupt Vector       }
  185.    BIOS_INT16  : pointer ; { BIOS Keyboard Interrupt Vector    }
  186.    BIOS_INT13  : pointer ; { BIOS Disk Interrupt Vector        }
  187.    DOS_INT28   : pointer ; { DOS idle Service interrupt Vector }
  188.  
  189.    Exit_Vec    : pointer ; { pointer to previous Exit Procedure }
  190.  
  191.  
  192.     {─────────────────JumptoInterrupt ──────────────────────}
  193.  
  194.   Procedure JumpToInterrupt( oldvector : pointer );
  195.    inline( { Jump to old Intr from local ISR  }
  196.     $5B/                    { POP  BX IP part of vector     }
  197.     $58/                    { POP  AX CS part of vector     }
  198.     $87/$5E/$0E/            { XCHG BX,[BP+14] switch ofs/bx }
  199.     $87/$46/$10/            { XCHG AX,[BP+16] switch seg/ax }
  200.     $8B/$E5/                { MOV  SP,BP                    }
  201.     $5D/                    { POP  BP                       }
  202.     $07/                    { POP  ES                       }
  203.     $1F/                    { POP  DS                       }
  204.     $5F/                    { POP  DI                       }
  205.     $5E/                    { POP  SI                       }
  206.     $5A/                    { POP  DX                       }
  207.     $59/                    { POP  CX                       }
  208.     $CB                     { RETF      Jump [ToOldVector]  }
  209.         ) ;                 { to original timer vector      }
  210.   {end JumpToInterrupt}
  211.  
  212.     {─────────────────CallInterrupt─────────────────────}
  213.  
  214.  Procedure CallInterrupt( oldvector : pointer ) ;          { stack image     }
  215.   inline($55/               { PUSH    BP                 } {  ip   \ return  }
  216.          $89/$E5/           { MOV     BP,SP              } {  cs     to here }
  217.          $9C/               { PUSHF create an IRET return} {  flags/         }
  218.          $36/               { SS:                        } {  bp  <--sp      }
  219.          $FF/$5E/$02/       { CALLfar [BP+02]            } {  cs \           }
  220.          $5D/               { POP     BP                 } {  ip /old vector }
  221.          $83/$C4/$04 );     { ADD     SP,+04             } {                 }
  222.   {end CallInterrupt}
  223.  
  224.     {──────────────── Return to New SRB ─────────────────}
  225.   Procedure ReturnToNewTask     ; { restore a stack frame }
  226.     inline(
  227.     $C4/$1E/CurrentSRB/        { LES  BX,[CurrentSRB]    }
  228.     $26/$C4/$5F/$00/           { LES  BX,ES:[BX+stackptr]}
  229.     $8C/$C0/                   { MOV  AX,ES              }
  230.     $8E/$D0/                   { MOV  SS,AX              }
  231.     $89/$DC/                   { MOV  SP,BX              }
  232.     $89/$E5);                  { MOV  BP,SP              }
  233.                                { Turbo does: MOV SP,BP   }
  234.   {END ReturnToNewTask}        {             POP BP etc  }
  235.  
  236.   Procedure Switch_to_Timer_stack ;
  237.     inline(                    { switch to safe stack   }
  238.     $C4/$1E/TimerSRB/          { LES  BX,[TimerSRB]   }
  239.     $26/$C4/$5F/$00/           { LES  BX,ES:[BX+stackptr]}
  240.     $8C/$C0/                   { MOV  AX,ES              }
  241.     $8E/$D0/                   { MOV  SS,AX              }
  242.     $89/$DC/                   { MOV  SP,BX              }
  243.     $89/$E5 );                 { MOV  BP,SP              }
  244.   {END Switch_to_Timer_Stack}
  245.  
  246.            {─────────────── Exit _ Timer ──────────}
  247.  
  248.    Procedure Exit_Timer ;       { restore regs and exit this routine }
  249.     BEGIN
  250.     DisableInterrupts  ;
  251.     int8busy := false  ;        { reset code busy condition  }
  252.     inline(
  253.     $C4/$1E/InTimerStackptr/   { LES  BX,[InStackptr]    }
  254.     $8C/$C0/                   { MOV  AX,ES              }
  255.     $8E/$D0/                   { MOV  SS,AX              }
  256.     $89/$DC/                   { MOV  SP,BX              }
  257.     $89/$E5/                   { MOV  BP,SP              }
  258.     $5D/                       { POP  BP                 }
  259.     $07/                       { POP  ES                 }
  260.     $1F/                       { POP  DS                 }
  261.     $5F/                       { POP  DI                 }
  262.     $5E/                       { POP  SI                 }
  263.     $5A/                       { POP  DX                 }
  264.     $59/                       { POP  CX                 }
  265.     $5B/                       { POP  BX                 }
  266.     $58/                       { POP  AX                 }
  267.     $CF                        { IRET                    }
  268.                     ) ;
  269.    END {Exit_Timer} ;
  270.  
  271.   Procedure SaveStackFrame ;
  272.     inline(                    { save full stack frame   }
  273.     $5D/                       { pop   bp local bp       }
  274.     $58/                       { pop   ax fetch ip       }
  275.     $5B/                       { pop   bx fetch cs       }
  276.     $9C/                       { pushf                   }
  277.     $53/                       { push  bx set CS         }
  278.     $50/                       { push  ax set ip         }
  279.     $50/                       { push  ax                }
  280.     $53/                       { push  bx                }
  281.     $51/                       { push  cx                }
  282.     $52/                       { push  dx                }
  283.     $56/                       { push  si                }
  284.     $57/                       { push  di                }
  285.     $1E/                       { push  ds                }
  286.     $06/                       { push  es                }
  287.     $55/                       { push  bp                }
  288.     $89/$E5                    { mov   bp,sp             }
  289.       );
  290.   {END SaveStackFrame}
  291.  
  292.   Procedure RestoreStackFrame ;
  293.     inline(                    { restore full stackframe  }
  294.     $89/$EC/                   { mov   sp,bp              }
  295.     $5D/                       { pop   bp                 }
  296.     $07/                       { pop   es                 }
  297.     $1F/                       { pop   ds                 }
  298.     $5F/                       { pop   di                 }
  299.     $5E/                       { pop   si                 }
  300.     $5A/                       { pop   dx                 }
  301.     $59/                       { pop   cx                 }
  302.     $5B/                       { pop   bx                 }
  303.     $58/                       { pop   ax                 }
  304.     $CF                        { IRET                     }
  305.     ) ;
  306.   {END RestoreStackFrame}
  307.  
  308.   {────────────────────────────────────────────────────────────────────}
  309.   {                         Freeze/UnFreeze                            }
  310.   {────────────────────────────────────────────────────────────────────}
  311.   {          This procedure primarily used for debugging               }
  312.   {────────────────────────────────────────────────────────────────────}
  313.   Procedure Freeze ;
  314.    BEGIN
  315.      Status := status or frozen ;        { Freeze the INT8 dispatcher }
  316.    END {Freeze}                 ;
  317.  
  318.   Procedure UnFreeze ;
  319.    BEGIN
  320.      Status := status and (NOT frozen) ; { start the INT8 dispatcher }
  321.    END {UnFreeze}                 ;
  322.   {────────────────────────────────────────────────────────────────────}
  323.   {                      SingleTask/MultiTask                          }
  324.   {────────────────────────────────────────────────────────────────────}
  325.  
  326.   Procedure SingleTask ;
  327.    BEGIN
  328.      Status := status or inuse  ; { SingleTask the INT8 dispatcher }
  329.    END {SingleTask}                 ;
  330.  
  331.   Procedure MultiTask ;
  332.    BEGIN
  333.      Status := status and (NOT inuse) ; { start the INT8 dispatcher }
  334.    END {MultiTask}                 ;
  335.   {────────────────────────────────────────────────────────────────────}
  336.   {                            GetSRBaddr                              }
  337.   {────────────────────────────────────────────────────────────────────}
  338.   {          Return the address of the Current StayResidentBlock       }
  339.   {────────────────────────────────────────────────────────────────────}
  340.  
  341.   Function GetSRBaddr : pointer ;
  342.    BEGIN
  343.      GetSRBaddr := CurrentSRB   ; { give caller current SRB address}
  344.    END {GetSRB}                 ;
  345.   {────────────────────────────────────────────────────────────────────}
  346.   {                            GetSRBid                                }
  347.   {────────────────────────────────────────────────────────────────────}
  348.   {      Return the Procedure id of the current StayResidentblock      }
  349.   {────────────────────────────────────────────────────────────────────}
  350.   Function GetSRBid : word ;
  351.    BEGIN
  352.      GetSRBid := CurrentSRB^.procid ; { give caller current SRB id }
  353.    END {GetSRB}                     ;
  354.   {────────────────────────────────────────────────────────────────────}
  355.   {                         FindSRB                                    }
  356.   {────────────────────────────────────────────────────────────────────}
  357.   {            Find the SRB pointer matching the SRB id                }
  358.   {────────────────────────────────────────────────────────────────────}
  359.    Function FindSRB(ftSRBid : word ) : SRBptr ;
  360.     var
  361.      TestSRB : SRBptr  ;
  362.      i       : integer ;
  363.     begin
  364.      TestSRB := CurrentSRB                 ; { set first SRB ptr }
  365.      for i := 1 to numActiveSRBs do
  366.        if TestSRB^.procid = ftSRBid then     { search for SRB id }
  367.          begin
  368.          FindSRB := TestSRB ;                { return SRB addr ..}
  369.          exit               ;
  370.          end {if TestSRB..}
  371.        else
  372.          TestSRB := TestSRB^.SRBlink ;
  373.    end {FindSRB}        ;
  374.  {─────────────────────────────────────────────────────────────────────}
  375.  {                           Suspend                                   }
  376.  {─────────────────────────────────────────────────────────────────────}
  377.  {            Suspend a Procedure id with Suspend bits                 }
  378.  {─────────────────────────────────────────────────────────────────────}
  379.   Procedure Suspend(pSRBid : word ; pSuspendbits : word ) ;
  380.    var
  381.     sSRBaddr : SRBptr ;
  382.    Begin
  383.     sSRBaddr := FindSRB(pSRBid) ;
  384.     sSRBaddr^.SRBsuspended := sSRBaddr^.SRBsuspended
  385.                                        or pSuspendbits ;
  386.   End { Suspend } ;
  387.  {─────────────────────────────────────────────────────────────────────}
  388.  {                           Unsuspend                                 }
  389.  {─────────────────────────────────────────────────────────────────────}
  390.  {             Clear suspend bits in a StayResidentBlock               }
  391.  {─────────────────────────────────────────────────────────────────────}
  392.   Procedure Unsuspend(pSRBid : word ; psuspendbits : word ) ;
  393.    var
  394.      sSRBaddr : SRBptr ;
  395.    Begin
  396.     sSRBaddr := FindSRB(pSRBid) ;
  397.     sSRBaddr^.SRBsuspended := sSRBaddr^.SRBsuspended
  398.                                    and (NOT pSuspendbits) ;
  399.   End { Unsuspend } ;
  400.  {─────────────────────────────────────────────────────────────────────}
  401.  {                     DosCallsAllowed                                 }
  402.  {─────────────────────────────────────────────────────────────────────}
  403.  {     Return true if Dos is in a state to accept function calls       }
  404.  {─────────────────────────────────────────────────────────────────────}
  405.   Function DosCallsAllowed : boolean ; { See if Dos can be called  }
  406.    Begin {DosCallsAllowed}
  407.  
  408.      DosCallsAllowed := false ;          { assume Dos is busy }
  409.  
  410.             { -- CHECK TO SEE IF SOFT INTS BUSY -- }
  411.  
  412.      If INTS_Busy <> 0 then Exit ;         { Critcal interrupts busy }
  413.  
  414.       { --  CHECK TO SEE IF A PRINT SCREEN IS IN PROGRESS -- }
  415.       {     byte is at 50:00 1=active  ff=last attempt bad   }
  416.  
  417.     if PrintScreenStatus = 1 then Exit ;
  418.  
  419.                  { -- CHECK TO SEE IF DOS IS BUSY -- }
  420.  
  421.     If (byte(InDosStatus^)) or (byte(DosCriticalStatus^)) = 0 then {ok}
  422.         else  begin
  423.         If (byte(InDosStatus^))  > 1 then exit     ;
  424.         If byte(DosCriticalStatus^) <> 0 then exit ;
  425.         If NOT (DosIdle ) then  Exit               ;
  426.         end{else..}                                ;
  427.  
  428.     port[ $20] := $0B  ;           { CHECK THE 8259A PIC ISR REGISTER }
  429.     punt               ;           { FOR NON-EOI'd pending Intr's     }
  430.     if port[$20] <> 0              { tell 8259A we want the ISR       }
  431.       then exit        ;           { get the pending intr bits        }
  432.  
  433.     DosCallsAllowed := true ;      { -- ALL IS CLEAR, DO SOMETHING -- }
  434.    End {DosCallsAllowed}    ;
  435. {─────────────────────────────────────────────────────────────────────}
  436. {                      SAVE ENVIRONMENT                               }
  437. {─────────────────────────────────────────────────────────────────────}
  438. {      Save the Current procedure state in a StayResidentBlock        }
  439. {─────────────────────────────────────────────────────────────────────}
  440.  Procedure Save_Environment(var SRBlock: SRBptr) ;
  441.    VAR
  442.      regs        : registers    ;    { local set of registers        }
  443.  
  444.    BEGIN                             { Record the stack limits       }
  445.  
  446.    WITH SRBlock^,regs DO BEGIN
  447.  
  448.      GetIntVec(DOSI22, INT22ptr);       { save task terminate vector }
  449.      GetIntVec(DOSI23, INT23ptr);       { save ctrl break vector     }
  450.      GetIntVec(DOSI24, INT24ptr);       { save critical error vector }
  451.      GetIntVec(DOSI1B, INT1Bptr);       { save DOS ctrl break vector }
  452.  
  453.      GetDTA(DTA )  ;                    { save disk transfer addr  }
  454.      GetPSP(PSP )  ;                    { save Prefix storage addr }
  455.  
  456.      { Save extended error information }
  457.         Ax := $5900                            ;
  458.         Bx := 0                                ;
  459.         If DosVersion > 2 then
  460.            Intr($21,regs)                      ;
  461.         ExtErrInfo[1] := Ax                    ;
  462.         ExtErrInfo[2] := Bx                    ;
  463.         ExtErrInfo[3] := Cx                    ;
  464.         ExtErrInfo[4] := Dx                    ;
  465.         ExtErrInfo[5] := Si                    ;
  466.         ExtErrInfo[6] := Di                    ;
  467.         ExtErrInfo[7] := Ds                    ;
  468.         ExtErrInfo[8] := Es                    ;
  469.  
  470.      { Save Ctrl-C status }
  471.         Ax := $3300                            ;
  472.         Intr($21,regs)                         ;
  473.         CtrlCstatus := Dl                      ;
  474.      { Save Verify flag status }
  475.         Ax := $5400                            ;
  476.         Intr($21,regs)                         ;
  477.         VerifyStatus := Al                     ;
  478.  
  479.      if procid = resources[_kbd] then
  480.       if (resources[_crt] = 0)
  481.       or (resources[_crt] = procid) then
  482.       begin
  483.       SRBVideoPage := VideoPage       ;
  484.       cursorX      := whereX          ;
  485.       cursorY      := whereY          ;
  486.       cursortype   := BIOScursor      ;
  487.       end                             ;
  488.  
  489.      if resources[_kbd] = 1 then begin          { if foreground task..}
  490.       cursorx      := Videox         ;          { get DOS cursor posn }
  491.       cursory      := Videoy         ;          { since unknow to the }
  492.      end {if procid..}                          { Turbo RTL           }
  493.      END  { with SRBlock } ;
  494.  
  495.  
  496.    END {Save_Environment}      ;
  497.   {─────────────────────────────────────────────────────────────────────}
  498.   {                       RESTORE ENVIRONMENT                           }
  499.   {─────────────────────────────────────────────────────────────────────}
  500.   {        Restore a StayResidentBlock to the Current task              }
  501.   {─────────────────────────────────────────────────────────────────────}
  502.  Procedure Restore_Environment(var SRBlock: SRBptr) ;
  503.  
  504.    VAR
  505.      regs        : registers    ;    { local set of registers        }
  506.  
  507.    BEGIN
  508.    WITH SRBlock^,regs DO BEGIN
  509.  
  510.      SetIntVec(DOSI22, INT22ptr);    { replace task terminate vector }
  511.      SetIntVec(DOSI23, INT23ptr);    { replace ctrl break vector     }
  512.      SetIntVec(DOSI24, INT24ptr);    { replace critical error vector }
  513.      SetIntVec(DOSI1B, INT1Bptr);    { replace DOS ctrl break vector }
  514.  
  515.      SetDTA(DTA)  ;    { new disk transfer area  }
  516.      SetPSP(PSP)  ;    { new Prefix storage area }
  517.  
  518.      { Restore extended error information }
  519.         Ax := $5D0A                            ;
  520.         DS := Seg(ExtErrInfo)                  ;
  521.         Dx := ofs(ExtErrInfo)                  ;
  522.         If DosVersion > 2 then
  523.            Intr($21,regs)                      ;
  524.      { Restore Ctrl-C status }
  525.         Ax := $3301                            ;
  526.         Dl := CtrlCstatus                      ;
  527.         Intr($21,regs)                         ;
  528.      { Restore Verify flag status }
  529.         Ax := $5400                            ;
  530.         Al := VerifyStatus                     ;
  531.         Intr($21,regs)                         ;
  532.  
  533.        if procid = resources[_kbd] then       { if keyboard owned put     }
  534.           begin
  535.           gotoXY(cursorX,cursorY)   ;         { cursor in window          }
  536.           ah := 1                   ;         { Turn cursor back on       }
  537.           cx := Cursortype          ;
  538.           intr($10,regs)            ;
  539.           end
  540.          else begin
  541.           gotoxy(VideoCols+1,Videorows)     ; { hide the cursor           }
  542.           ah := 1                   ;         { turn cursor off           }
  543.           ch := $20                 ;
  544.           intr($10,regs)            ;
  545.          end {else}                 ;
  546.  
  547.        if resources[_kbd] = 1 then begin
  548.         Ah := 02           ;                  { Replace forgound cursor   }
  549.         Bh := SRBVideoPage ;
  550.         Dl := cursorX      ;
  551.         Dh := cursorY      ;
  552.         Intr($10,regs)     ;
  553.        end {if procid..}   ;
  554.      END  { with SRBlock }                  ;
  555.  
  556.  
  557.    END {Restore_Environment}       ;
  558.  
  559.   {─────────────────────────────────────────────────────────────────────}
  560.   {               SwitchEnvironment     (dispatcher)                    }
  561.   {─────────────────────────────────────────────────────────────────────}
  562.   {                switch the environment to a new task                 }
  563.   {─────────────────────────────────────────────────────────────────────}
  564.   Procedure SwitchEnvironment ;
  565.   var
  566.    i          : integer ;
  567.    found      : boolean ;
  568.    TestingSRB : SRBptr  ;
  569.  
  570.    BEGIN
  571.     If RUTidBlk.RUTtermbyte then         { when outside pgm has set  }
  572.       begin                              { the termination byte...   }
  573.        SingleTask;                       { SingleTask the system     }
  574.        SR50_xit  ;                       { Attempt to terminate      }
  575.        MultiTask ;                       { MultiTask and Try later ..}
  576.       end {if RUT..} ;
  577.  
  578.     If DosCallsAllowed then begin
  579.      Save_Environment(CurrentSRB)      ; { save current tasks environment }
  580.      Found      := false               ;
  581.      i          := 0                   ;
  582.      TestingSRB := CurrentSRB^.SRBlink ;
  583.  
  584.      repeat {until (i=NumactiveSRBs or found=true}
  585.  
  586.        { If a Timer task is within a resonable period of its tick  }
  587.        { request, make it eligible for dispatch, turn off wait bit }
  588.  
  589.       With TestingSRB^ do
  590.         if SRBtype = Timertype then
  591.           if (TimerTicks mod Keyvalue) < NumActiveSRBs then
  592.             SRBSuspended := SRBSuspended and (NOT TimerWait)
  593.             else SRBsuspended := SRBsuspended or TimerWait      ;
  594.  
  595.       if TestingSRB^.SRBSuspended = 0    { get next ready task          }
  596.          then begin
  597.          CurrentSRB := TestingSRB    ;   { Yield to the Next ready task }
  598.          Found      := true          ;
  599.          end {if TestingSRB..}
  600.       else begin                         { else look for a ready task   }
  601.       inc(i)                            ;
  602.       TestingSRB := TestingSRB^.SRBlink ;
  603.       end {else..}                      ;
  604.  
  605.      until (i=NumActiveSRBs) or (found=true) ;
  606.  
  607.      Restore_Environment(CurrentSRB) ;   { setup the new environment      }
  608.     end {if DosCallsAllowed}         ;
  609.  
  610.     if Found then begin
  611.       inc(RotrPosition)                     ; { show the dispatch }
  612.       byte(PutRotr^ ) :=                      { at upright corner }
  613.              Rotreller[RotrPosition mod 4]  ; { turn the rotor    }
  614.       end {if Found..}                      ;
  615.  
  616.    END {SwitchEnvironment}           ;
  617.  
  618.   {────────────────────────────────────────────────────────────────────}
  619.   {                              Yield                                 }
  620.   {────────────────────────────────────────────────────────────────────}
  621.   {             Yield the CPU to some other procedure                  }
  622.   {────────────────────────────────────────────────────────────────────}
  623.  
  624.   Procedure Yield ;
  625.    BEGIN
  626.      If bool(Status and frozen)  { if system is frozen then }
  627.                   then exit    ; { return to same task      }
  628.  
  629.      Status := status or inuse ; { stop other interference }
  630.  
  631.      SaveStackFrame          ; { Make like an interrupt         }
  632.      CurrentSRB^.SRBStackptr   { record current stackframe      }
  633.        :=  ptr(SSeg,getbp)   ;
  634.  
  635.      SwitchEnvironment       ; { switch to new task environment }
  636.  
  637.      DisableInterrupts       ; { stop other interference        }
  638.      Status := status and      { clear inuse status bit         }
  639.              (not inuse)     ;
  640.  
  641.      ReturntoNewTask         ; { switch to new stack frame      }
  642.      RestoreStackFrame       ; { Restore regs like an interrupt }
  643.                                { and IRET to next task          }
  644.    END {Yield}               ;
  645.   {────────────────────────────────────────────────────────────────────}
  646.   {                 Resource  Reserve/Rlse                             }
  647.   {────────────────────────────────────────────────────────────────────}
  648.   {        Reserve/Release a resource defined in Resource array        }
  649.   {────────────────────────────────────────────────────────────────────}
  650.     Procedure Resource(operation, resourceid : integer ) ;
  651.      BEGIN
  652.       case operation of
  653.        Reserve :
  654.           Repeat
  655.            while resources[resourceid] <>0 do yield    ;
  656.            resources[resourceid] := CurrentSRB^.procid ;
  657.            if resources[resourceid] = CurrentSRB^.procid
  658.              then exit ;
  659.           Until false                                 ;
  660.  
  661.        Rlse : if resources[resourceid] = CurrentSRB^.procid
  662.                   then resources[resourceid] := 0 ;
  663.       end {case operation}      ;
  664.     END {Resource}              ;
  665.      {──────────────────────────────────────────────────────────}
  666.      {                      CallInt16                           }
  667.      {──────────────────────────────────────────────────────────}
  668.      {         Call the original Interrupt 16 vector            }
  669.      {──────────────────────────────────────────────────────────}
  670.   const
  671.    ReadChar = $0000 ;
  672.    TestChar = $0100 ;
  673.  
  674.   Procedure CallInt16( func :word; var AX,flags :word ) ;
  675.    Begin
  676.  
  677.    inline(
  678.           $8B/$46/<func/        { MOV     AX,func read kbd func    }
  679.           $9C/                  { PUSHF   create an IRET return    }
  680.           $FF/$1E/>BIOS_INT16/  { CALL FAR [old_INT16]             }
  681.  
  682.       { Return the INT16 result registers, not the input regs }
  683.  
  684.           $9C/                  { PUSHF   Save INT16  conditions   }
  685.           $36/$c4/$7e/<flags/   { les di,ss:[^flags]  return flags }
  686.           $26/$8F/$05/          { pop es:[di]                      }
  687.           $36/$c4/$7e/<AX/      { les di,ss:[^AX]     return ax    }
  688.           $26/$89/$05 );        { mov ax,es:[di]                   }
  689.  
  690.    if func = testchar then        { if function is "test keyboard"   }
  691.      if boolean(flags and zflag)  { then return ..                   }
  692.        then AX := $0000  ;        { nul if no key, else return key   }
  693.  
  694.  
  695.    end {CallInt16}     ;
  696.      {──────────────────────────────────────────────────────────}
  697.      {                        KeyWaiting                        }
  698.      {──────────────────────────────────────────────────────────}
  699.      { Check if any keys waiting to be read in keyboard buffer  }
  700.      {──────────────────────────────────────────────────────────}
  701.   Function KeyWaiting :boolean ;
  702.    var
  703.     int16flags : word ;
  704.    begin
  705.     inline(
  706.       $B4/01/                 { MOV   AH,testfunc 01           }
  707.       $9C/                    { PUSHF create an IRET return    }
  708.       $FF/$1E/>BIOS_INT16/    { CALL  FAR [old_INT16]          }
  709.       $9C/                    { PUSHF Save INT16  conditions   }
  710.       $8F/$46/<int16flags     { pop   [BP+int16flags]          }
  711.           ) ;
  712.     keywaiting := NOT boolean(int16flags and zflag) ;
  713.    end {KeyWaiting}     ;
  714.   {────────────────────────────────────────────────────────────────────}
  715.   {                       Check for Hot Key                            }
  716.   {────────────────────────────────────────────────────────────────────}
  717.   { Scan all SRBs for a matching HotKey. If found, toggle the SRB      }
  718.   { suspended bit, and indicate last key was a hot one.                }
  719.   {────────────────────────────────────────────────────────────────────}
  720.   Procedure CheckforHotKey(LastKeyStroke : word ) ;
  721.   var
  722.    i           : integer ;
  723.    TestingSRB  : SRBptr  ;
  724.    OldKbdOwner : word    ;
  725.  
  726.    BEGIN
  727.      Hotkeyon    := false                 ;   { Turn off HotKey flag   }
  728.      If LastKeyStroke = 0 then exit       ;   { exit on null input     }
  729.      OldKbdOwner := Resources[_KBD]       ;
  730.      TestingSRB  := CurrentSRB            ;
  731.  
  732.      for i := 1 to NumactiveSRBs do
  733.       With TestingSRB^ do begin
  734.       if SRBType = Keytype then
  735.         if Keyvalue = LastKeyStroke then begin     { Check SRB Hotkey for match }
  736.          Ints_busy := Int16on                    ; { stop dispatching           }
  737.          Send('Popsched',TestingSRB)             ; { Schedule this popup        }
  738.          Hotkeyon := true                        ; { say last key was hotkey   }
  739.         Ints_busy := Ints_busy and (NOT Int16on) ; { start dispatching         }
  740.         EXIT                                     ; { we have a task            }
  741.         end {if keyvalue..}                      ;
  742.  
  743.       TestingSRB := TestingSRB^.SRBlink ;   { test next SRB }
  744.      end {for i..}                      ;
  745.  
  746.   end {Check for Hot Key } ;
  747.  
  748.   {──────────────────────────────────────────────────────────────────────}
  749.   {                     Interrupt 16 ISR (Keyboard)                      }
  750.   {──────────────────────────────────────────────────────────────────────}
  751.   {     A flag is set when a hotkey occurs. All other keys pass on       }
  752.   {──────────────────────────────────────────────────────────────────────}
  753.  
  754.  Procedure Kbd_INT16(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word);
  755.                      interrupt ;
  756.  
  757.   Label
  758.    INT16exit ;
  759.   const
  760.    varbytes = 4  ; { number of bytes on local stack }
  761.   var
  762.    keyfunc  :word ;
  763.    tempword :word ;
  764.  
  765.   Begin
  766.    if CurrentSRB^.Procid = 1 then begin { special stack for foreground }
  767.   Inline(
  768.   $C4/$3E/>Int16stack    {        les   di,[>INT16stack] ; address of current process block}
  769.                          {                              ;}
  770.   /$8C/$D2               {        mov   dx,ss           ; save previous stack seg}
  771.   /$8C/$C0               {        mov   ax,es           ; bp contains essential sp}
  772.   /$39/$D0               {        cmp   ax,dx           ; if segments are the same}
  773.   /$75/$02               {        jne   L1              ; define sp previous to}
  774.   /$89/$E7               {        mov   di,sp           ; current sp.}
  775.   /$06                   {L1:     push  es              ;}
  776.   /$17                   {        pop   ss              ; set local stack}
  777.   /$89/$FC               {        mov   sp,di           ;}
  778.                          {                              ; intr stack is 24 bytes}
  779.   /$B9/$18/$00           {        mov   cx,24           ; allow room for double stacking}
  780.   /$29/$CC               {        sub   sp,cx           ; eg, when this stack calls INT16}
  781.                          {                              ;}
  782.   /$52                   {        push  dx              ; save old sp}
  783.   /$55                   {        push  bp              ;}
  784.   /$29/$CC               {        sub   sp,cx           ; backup another 12 words}
  785.   /$8C/$DB               {        mov   bx,ds           ; save data segment address}
  786.   /$8E/$DA               {        mov   ds,dx           ; dseg gets old stack ss}
  787.   /$89/$EE               {        mov   si,bp           ; source ptr to old stack (ES contains old ss)}
  788.                          {                              ;}
  789.   /$16                   {        push  ss              ; dest pointer to new stack}
  790.   /$07                   {        pop   es              ;}
  791.   /$89/$E7               {        mov   di,sp           ;}
  792.                          {                              ;}
  793.   /$D1/$E9               {        shr   cx,1            ; words to save (24/2 words)}
  794.   /$FC                   {        cld                   ;}
  795.   /$F2/$A5               {        rep   movsw           ; move old stack to new}
  796.                          {                              ;}
  797.   /$89/$E5               {        mov   bp,sp           ; setup new bp}
  798.   /$81/$EC/>VARBYTES     {        sub   sp,>varbytes    ; room for local variables on stack}
  799.   /$8E/$DB               {        mov   ds,bx           ; recover dseg}
  800.                    );
  801.    end {if..}      ;
  802.    EnableInterrupts               ;
  803.  
  804.          {─────────────────────────────────────────────────────}
  805.          {            Read/Test a Key    (function 00 and 01)  }
  806.          {─────────────────────────────────────────────────────}
  807.  
  808.    Keyfunc := AX and $FF00         ;   { clear low byte          }
  809.    flags   := flags or zflag       ;   { assume no key available }
  810.  
  811.  
  812.    if keyfunc = ReadChar then begin
  813.  
  814.       while Resources[_KBD] <>         { suspend any task doing read..}
  815.         CurrentSRB^.Procid do          { but not owning keyboard      }
  816.         CurrentSRB^.SRBsuspended :=
  817.         CurrentSRB^.SRBsuspended or suspended ;
  818.  
  819.       repeat  {until KbdOwned and GoodKey}
  820.         while NOT keywaiting do {loop}      ; { wait for available key }
  821.         CallInt16(testchar,AX,flags)        ; { test the key value     }
  822.         CheckforHotKey(AX)                  ; { see if one of our keys }
  823.         if HotKeyon then
  824.            CallInt16(readchar,AX,flags)     ; { eat the hotkey         }
  825.       until
  826.       (Resources[_KBD] = CurrentSRB^.Procid)  { keys to kbd owner only }
  827.              and (NOT HotKeyon )            ;
  828.       CallInt16(readchar,AX,flags)          ; { finally, get the key   }
  829.       GOTO INT16exit               ;
  830.      end { if hi(.. }              ;
  831.  
  832.          {─────────────────────────────────────────────────────}
  833.          {             TEST for a Key        (function 01)     }
  834.          {─────────────────────────────────────────────────────}
  835.  
  836.    if keyfunc = TestChar then begin       { check for char (func01)   }
  837.  
  838.       if Resources[_KBD] <> CurrentSRB^.Procid
  839.                        then GOTO int16exit ;
  840.        if keywaiting then begin
  841.           CallInt16(testchar,AX,flags)     ; { Sneak look at next key    }
  842.           CheckforHotKey(AX)               ; { see if one of our hotkeys }
  843.           if  Hotkeyon then begin
  844.             CallInt16(readchar,AX,flags)   ; { eat the hotkey            }
  845.             AX       := 0                  ; { set up for empty return   }
  846.             flags := flags or zflag        ; { set zflag if hotkey       }
  847.             HotKeyon := false              ; { Turn off the hotkey status}
  848.             end {if hotkeyon..}            ;
  849.        end {if keywaiting}                 ;
  850.       GOTO int16exit                       ; { exit ISR                  }
  851.    end {if hi..}                           ;
  852.  
  853.  {───────────────────────────────────────────────────────────────────}
  854.  {                     Are You There                                 }
  855.  {───────────────────────────────────────────────────────────────────}
  856.  { Es:di contains a pointer to the asking user id blk. Compare the   }
  857.  { string to our id block. If same, switch ax:bx  and replace        }
  858.  { es:di with pointer to our id block. Else continue down the INT 16 }
  859.  { chain.                                                            }
  860.  {───────────────────────────────────────────────────────────────────}
  861.    if AX = $6c66 then begin          { someone asking if we're here }
  862.       if RUTidblk.RUTidstr = string(ptr(es,di)^) then begin
  863.          ax := ax xor bx ;           { swapping  ax and bx says yes }
  864.          bx := bx xor ax ;
  865.          ax := ax xor bx ;
  866.          es       := seg(RUTidblk) ; { show em our id block         }
  867.          di       := ofs(RUTidblk) ;
  868.       end {if RUTidblk} ;
  869.     GOTO int16exit      ;
  870.     end {if keyfunc};
  871.  
  872.  
  873.     { NOT one of our functions..pass to original INT 16 }
  874.  
  875.      CallInt16(AX,AX,flags)         ;  { get the key   }
  876.  
  877.  INT16EXIT: { GOTO here from above functions read/test character }
  878.  
  879.   if currentSRB^.procid = 1 then begin { special stack for foreground }
  880.   DisableInterrupts ;
  881.   Inline(                {        ; restore local to old stack}
  882.    $C4/$7E/$18           {        les   di,[bp+24]     ; dest = old stack ptr}
  883.   /$89/$F8               {        mov   ax,di          ; save old sp value}
  884.   /$89/$EE               {        mov   si,bp          ; point to local stack}
  885.   /$8C/$D2               {        mov   dx,ss          ;}
  886.   /$8E/$DA               {        mov   ds,dx          ; source = local stack}
  887.   /$B9/$0C/$00           {        mov   cx,12          ; words to move}
  888.   /$FC                   {        cld                  ;}
  889.   /$F2/$A5               {        rep   movsw          ; move the stack}
  890.   /$8C/$C2               {        mov   dx,es          ; switch to old stack}
  891.   /$8E/$D2               {        mov   ss,dx          ;}
  892.   /$89/$C4               {        mov   sp,ax          ; old sp ptr}
  893.   /$89/$E5               {        mov   bp,sp          ; reset bp for return}
  894.                    ) ;
  895.   end {if current..} ;
  896.  
  897. end; {SR50i16}
  898.  
  899. {────────────────────────────────────────────────────────────────────}
  900. {                      DISK I N T _ 1 3                              }
  901. {────────────────────────────────────────────────────────────────────}
  902. {         Set a status bit when I/O is outstanding to disk           }
  903. {────────────────────────────────────────────────────────────────────}
  904. {$S-}
  905. Procedure DISK_INT13(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word);
  906.                       interrupt ;
  907.  
  908.    BEGIN {Disk_Int13}
  909.    inline(
  910.    $80/$0E/>INTS_Busy/INT13on /  { OR   INTS_Busy,Int13flag        }
  911.    $8B/$86/AX/                   { MOV   AX,[BP+AX] retrieve parm  }
  912.    $9C/                          { PUSHF create an IRET return     }
  913.    $FF/$1E/>BIOS_INT13/          { CALL  FAR [oldDiskInt13]        }
  914.  
  915.    $9C/                          { PUSHF  Save INT13  condition    }
  916.    $FA/                          { disable interrupts              }
  917.    $8F/$86/flags/                { Pop [bp+flags] return flags also}
  918.    $80/$26/>INTS_Busy/255-INT13on      { AND INTS_Busy,Int13flag   }
  919.    );
  920.  
  921.       { Return the INT13 result registers, not the input regs }
  922.    inline(
  923.    $8E/$5E/<DS/                  { MOV   DS,[BP+DS]  }
  924.    $89/$86/AX/                   { MOV   [BP+AX],AX  }
  925.    $8B/$86/BP/                   { MOV   AX,[BP+BP]  }
  926.    $89/$86/BX/                   { MOV   [BP+BX],AX  }
  927.    $8D/$AE/BX/                   { LEA   BP,[BP+BX]  }
  928.    $89/$EC/                      { MOV   SP,BP       }
  929.    $5D/                          { POP   BP          }
  930.    $58/                          { POP   AX          }
  931.    $CF );                        { IRET              }
  932.  
  933.  END {DISK_INT13} ;
  934. {$S+}
  935. {────────────────────────────────────────────────────────────────────}
  936. {                     T I M E R        Interrupt 8 service routine   }
  937. {────────────────────────────────────────────────────────────────────}
  938. {   ─────────────────── T I M E R _ I S R ──────────────────────     }
  939. {────────────────────────────────────────────────────────────────────}
  940. {$S-}
  941. Procedure TIMER_ISR(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word) ;
  942.                 interrupt ;
  943.  
  944.   Begin {Timer_ISR}
  945. {$R-,S-}
  946.  
  947.   inc(TimerTicks,1)                  ;
  948.  
  949.   if int8busy then
  950.      JumpToInterrupt(BIOS_INT8)      ;
  951.  
  952.   inc(int8busy)                      ; { Tell 'em we're busy now     }
  953.  
  954.   InTimerStackptr                     { protect user stackframe    }
  955.            :=  ptr(SSeg,ofs(BP)) ;    { from further interrupts    }
  956.   Switch_to_Timer_Stack          ;    { switch to internal stack }
  957. {$R+,S+}
  958.  
  959.   Push(vec(InTimerStackptr).seg)     ; { Preserve Incoming stack ptr }
  960.   Push(vec(InTimerStackptr).ofs)     ; { in case of new interrupt    }
  961.  
  962.   CallInterrupt(BIOS_INT8)           ;
  963.  
  964.   EnableInterrupts                   ; { allow interrupts           }
  965.   if bool(Status and inuse)            { skip if TSR in use already }
  966.                 then Exit_Timer      ;
  967.  
  968.   if bool(Status and frozen)           { skip if TSR in halted      }
  969.                 then Exit_Timer      ;
  970.  
  971.   if DosCallsAllowed then {ok}         { See if dos is idle         }
  972.     Int8waiting := 0                   { say dispatch successful    }
  973.     else begin
  974.          inc(Int8waiting) ;            { say INT8 missed a dispatch }
  975.          Exit_Timer       ;            { skip if DOS too busy now   }
  976.          end              ;
  977.  
  978.   pop(vec(CurrentSRB^.SRBstackptr).ofs) ; { CurrentSRB^.SRBstackptr :=    }
  979.   pop(vec(CurrentSRB^.SRBstackptr).seg) ; {    InTimerStackptr        ;   }
  980.  
  981.   SwitchEnvironment                  ; { Yield to next task         }
  982.   DisableInterrupts                  ; { Protect stack change       }
  983.   int8busy := false                  ; { clear busy condition       }
  984.   ReturnToNewTask                    ; { Load new Stack Frame ..    }
  985.                                        { and return to another task }
  986. End;{SR50_Int8}
  987.  
  988.   {──────────────────────────────────────────────────────────────────────}
  989.   {                     Interrupt 28 ISR (Dos Idle)                      }
  990.   {──────────────────────────────────────────────────────────────────────}
  991.   {   Entry is made from the DOS interrupt 28 during a read idle loop    }
  992.   {──────────────────────────────────────────────────────────────────────}
  993. {$S-}
  994. Procedure DOS_IDLE(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word);
  995.                    interrupt ;
  996.   BEGIN {DOS_Idle }
  997.  
  998.   if INT8waiting = 0 then begin       { If INT8 not waiting then     }
  999.     CallInterrupt(Dos_Int28)    ;     { dont waste time here         }
  1000.     exit                        ;
  1001.     end {if INT8wait..}         ;
  1002.  
  1003.   if DosIdleCount > 0 then exit ;     { avoid double entries         }
  1004.   If  byte(InDosStatus^)  > 1         { Dont interrupt Dos internals }
  1005.                       then exit ;
  1006.   If byte(DosCriticalStatus^) <> 0
  1007.                       then exit ;
  1008.   If INTS_Busy <> 0   then exit ;     { Exit if interrupts busy      }
  1009.   If int8busy         then exit ;     { if timer active then  exit   }
  1010.  
  1011.   CallInterrupt(Dos_Int28)      ;     { call old interrupt 28        }
  1012.  
  1013. {*If byte(InDosStatus^) = 0           { skip int28 calls from user   }
  1014. {*                    then exit ;     { ..pgms issuing INT28         }
  1015.   inc( DosIdleCount)            ;     { show overhead count          }
  1016.  
  1017.   DisableInterrupts             ;     { stack is being manipulated  }
  1018.   inline(                             { switch to safe stack    }
  1019.     $16/                              { Push SS                 }
  1020.     $55/                              { Push BP                 }
  1021.     $C4/$1E/DosIdleSRB/               { LES  BX,[DosIdleSRB]    }
  1022.     $26/$C4/$5F/$00/                  { LES  BX,ES:[BX+stackptr]}
  1023.     $26/$8F/$47/$FC/                  { pop  ES:[bx-4] save Sp  }
  1024.     $26/$8F/$47/$FE/                  { pop  ES:[bx-2] save SS  }
  1025.     $83/$EB/$04/                      { Sub  bx,4 backup sp     }
  1026.     $8C/$C0/                          { MOV  AX,ES              }
  1027.     $8E/$D0/                          { MOV  SS,AX              }
  1028.     $89/$DC/                          { MOV  SP,BX              }
  1029.     $89/$E5 );                        { MOV  BP,SP              }
  1030. {$S+}
  1031.                                       { Make room on IdleStack  }
  1032.     SetSp(GetBP-64-2) ;               { back up the stack ptr   }
  1033.     DosStackptr := ptr(vec(InDosStackptr).seg,   { backup 32 words }
  1034.                    vec(InDosStackptr).ofs-64 ) ; { on indos stack  }
  1035.                                                  { save InDos Stackframe }
  1036.     Move(DosStackptr^,ptr(SSeg,GetBP-64)^,64) ;
  1037.     DosIdle := true  ;           { tell everybody DOS is idle   }
  1038.  
  1039.      { Timer may now preempt this task until DosIdle = false         }
  1040.  
  1041.     EnableInterrupts               ;
  1042.     Delay(DosIdledelay)            ;
  1043.  
  1044.     DosIdle := false ;                { say we are nolonger idle     }
  1045.                                       { restore the DOS stack frame  }
  1046.     DisableInterrupts ;
  1047.     Move(ptr(SSeg,GetBP-64)^,DosStackptr^,64) ;
  1048.     SetSp(GetBP)     ;            { restore the stackptr from BP     }
  1049.     inline(                       { switch back to dos stack         }
  1050.       $89/$E5/                    { MOV     BP,SP      point to SS:SP}
  1051.       $C4/$5E/$00/                { LES     BX,[BP+00] fetch SS:SP   }
  1052.       $8C/$C0/                    { MOV     AX,ES      temp move     }
  1053.       $8E/$D0/                    { MOV     SS,AX      set old stack }
  1054.       $89/$DC/                    { MOV     SP,BX      set old sptr  }
  1055.       $89/$E5 );                  { MOV     BP,SP      set  BP       }
  1056.  
  1057.     dec(DosIdlecount);
  1058.  
  1059. END {DOS IDLE } ;
  1060. {$S+}
  1061. {────────────────────────────────────────────────────────────────────}
  1062. {                         Setup ISRs                                 }
  1063. {────────────────────────────────────────────────────────────────────}
  1064.  
  1065.   Procedure Setup_ISRs ;         { Setup Interrupt Service Routines }
  1066.   begin
  1067.       DisableInterrupts              ;
  1068.       GetIntVec(BIOSI16, Bios_Int16) ;
  1069.       GetIntVec(BIOSI8 , BIOS_Int8 ) ;
  1070.       GetIntVec(BIOSI13, BIOS_Int13) ;
  1071.       GetIntVec(DOSI28 , DOS_Int28 ) ;
  1072.  
  1073.       SetIntVec(BIOSI16, @Kbd_INT16  ) ; { keyboard }
  1074.       SetIntVec(BIOSI8 , @Timer_ISR  ) ; { timer    }
  1075.       SetIntVec(BIOSI13, @Disk_INT13 ) ; { disk     }
  1076.       SetIntVec(DOSI28 , @DOS_Idle   ) ; { DOS idle }
  1077.       EnableInterrupts                 ;
  1078.  
  1079.   end {Setup_ISRs} ;
  1080. {────────────────────────────────────────────────────────────────────────────}
  1081. {                          S T A Y X I T                                     }
  1082. {────────────────────────────────────────────────────────────────────────────}
  1083. {  SR50_Xit Check Terminate Keys                                             }
  1084. {                                                                            }
  1085. {  Clean up the Program ,Free the Environment block, the program segment     }
  1086. {  memory and return to Dos. Programs using this routine ,must be the        }
  1087. {  last program in memory, else ,a hole will be left causing Dos             }
  1088. {  to take off for Peoria.                                                   }
  1089. {────────────────────────────────────────────────────────────────────────────}
  1090. { This procedure should be executed when user enters "SR50 /quit" ..         }
  1091. {────────────────────────────────────────────────────────────────────────────}
  1092.  
  1093. Procedure SR50_Xit;
  1094.  
  1095.   TYPE
  1096.    MCB = record
  1097.        mcbtype   : char      ;             {M or Z identifier }
  1098.        mcbseg    : integer   ;             {Segment of Program Prefix}
  1099.        mcblength : integer   ;             {Length in paragraphs }
  1100.        END                   ;
  1101.   const
  1102.    PSPvector22 = $0A   ; { PSP offset to terminate vector     }
  1103.    PSPvector23 = $0E   ; { PSP offset to ctrl break vector    }
  1104.    PSPvector24 = $12   ; { PSP offset to critical exit vector }
  1105.  
  1106.   VAR
  1107.    MemBlkPtr  :^MCB                     ;
  1108.  
  1109.    DOSvector22: vector absolute 0:$88   ;
  1110.    DOSvector23: vector absolute 0:$8C   ;
  1111.    DOSvector24: vector absolute 0:$90   ;
  1112.  
  1113.    Regs       : registers               ;
  1114.  
  1115.     Begin { Block }
  1116.  
  1117.        { See if next Memory block pointer is the last  MCB }
  1118.  
  1119.       MemBlkPtr := ptr(Prefixseg-1,0000 ) ;                   { our MCB  }
  1120.       MemBlkPtr := ptr(MemBlkptr^.MCBseg + MemBlkptr^.MCBlength,0) ;
  1121.                                                               { next MCB }
  1122.       If MemBlkPtr^.mcbtype  <> 'Z' then
  1123.          begin
  1124.             Writeln ( ' Not last program in memory.  Cannot uninstall.');
  1125.          EXIT ; {not last, cant end}
  1126.          end;
  1127.  
  1128.       ClrEol ; Writeln ( RUTidBlk.RUTidStr,' terminated on request') ;
  1129.  
  1130.       DisableInterrupts                   ;
  1131.  
  1132.  
  1133.       SetIntVec(BIOSI13, BIOS_Int13) ; { Restore Disk Interrupt Service Rtn  }
  1134.       SetIntVec(BIOSI16, Bios_Int16) ; { Restore Keyboard Interrupt Service  }
  1135.       SetIntVec(BIOSI8 , BIOS_Int8 ) ; { Restore Timer Interrupt Service     }
  1136.       SetIntVec(DOSI28 , DOS_Int28 ) ; { Restore DOS 28 Interrupt Service    }
  1137.  
  1138.      { Move Interrupt Vectors 22,23,24 to our PSP from where DOS will restore }
  1139.  
  1140.       meml[Prefixseg:PSPvector22] := longint(DOSvector22); { Terminate vector }
  1141.       meml[Prefixseg:PSPvector23] := longint(DOSvector23); { Cntrl-C vector   }
  1142.       meml[Prefixseg:PSPvector24] := longint(DOSvector24); { Critical vector  }
  1143.  
  1144.       EnableInterrupts  ;                   { Re-enable interrupts }
  1145.  
  1146.       Regs.Ax := $4900               ;  { Free Allocated Block function }
  1147.       Regs.Es := MemW[Prefixseg:$2C] ;  { Free environment block        }
  1148.       intr($21, Regs)      ;
  1149.  
  1150.       Regs.Ax := $4900     ;   { Free Allocated Block function }
  1151.       Regs.Es := Prefixseg ;   { Free Program                  }
  1152.       intr($21, Regs)      ;
  1153.  
  1154.       regs.Ax := $4C00     ;   { say bye bye, baby blue .. }
  1155.       intr($21, Regs)      ;
  1156.  
  1157.    End  { SR50Xit };
  1158.  
  1159.   {──────────────────────────────────────────────────────────────────────}
  1160.   {                       Dummy IRET                                     }
  1161.   {──────────────────────────────────────────────────────────────────────}
  1162.   Procedure DummyIret ;
  1163.    begin
  1164.    inline($5D/$C9)        ; { pop bp, iret }
  1165.    end {DummyIret}        ;
  1166.  
  1167.   {──────────────────────────────────────────────────────────────────────}
  1168.   {                         Start TSR                                    }
  1169.   {──────────────────────────────────────────────────────────────────────}
  1170.    Procedure StartTSR ;
  1171.    const
  1172.     esc = #27 ;
  1173.    var
  1174.     ch : char ;
  1175.    Begin {StartTSR}
  1176.  
  1177.      if debug then begin
  1178.        Writeln(' - Debugging Information -'                ) ;
  1179.        Writeln('CurrentSRB     : ',hexptr(@CurrentSRB     )) ;
  1180.        Writeln('InTimerStackptr: ',hexptr(@InTimerStackptr)) ;
  1181.        Writeln('Status         : ',hexptr(@Status         )) ;
  1182.        Writeln('Ints_Busy      : ',hexptr(@Ints_Busy      )) ;
  1183.        Writeln('Int8Busy       : ',hexptr(@Int8Busy       )) ;
  1184.        Writeln('DosIdle        : ',hexptr(@DosIdle        )) ;
  1185.        Writeln('DosIdleCount   : ',hexptr(@DosIdleCount   )) ;
  1186.        Writeln('InDosStatus    : ',hexptr(InDosStatus     )) ;
  1187.        Writeln('InDosStackptr  : ',hexptr(InDosStackptr   )) ;
  1188.        Writeln('@WindMax       : ',hexptr(@WindMax        )) ;
  1189.  
  1190.      end {if debug..}                  ;
  1191.  
  1192.      SwapVectors ;
  1193.      Status := status and
  1194.              ( NOT inuse )             ; { allow dispatching         }
  1195.  
  1196.      if debug then begin                 { debug loop to allow running }
  1197.           While ch <> esc do             { under a foreground debugger }
  1198.             ch := readkey ;              { drive int 16 like dos       }
  1199.           Exit            ;              { return to dos when debug on }
  1200.      end {if debug..}     ;
  1201.  
  1202.      Keep(0)                           ; { Go into TSR mode          }
  1203.  
  1204.    end {StartTSR} ;
  1205.   {──────────────────────────────────────────────────────────────────────}
  1206.   {                          Attach                                      }
  1207.   {──────────────────────────────────────────────────────────────────────}
  1208.   {     Attach is called form the initialization routine and must be     }
  1209.   {     forced as a far call procedure                                   }
  1210.   {──────────────────────────────────────────────────────────────────────}
  1211.  
  1212. {$F+}
  1213.    Procedure Attach( pUserPgmPtr:pointer; TsrType:word;
  1214.                      TsrValue:word  ; pPopproc:pointer ; pName:string8) ;
  1215.    VAR                                                        {$F-}
  1216.     tSRBptr  : SRBptr        ;
  1217.     StatusAreaSize : integer ;
  1218.     i              : integer ;
  1219.  
  1220.    Begin {Attach}
  1221.  
  1222.     StatusAreaSize := StackSize +          { size of SRBlock + pgm stack   }
  1223.                         StackOverhead    ;
  1224.     Getmem(tSRBptr,StatusAreaSize)       ; { fetch space for SRB and Stack }
  1225.     If CurrentSRB = nil then
  1226.         CurrentSRB := tSRBptr            ; { anchor the first SRB ptr      }
  1227.  
  1228.     inc(NumActiveSRBs)                   ; { add to active task count      }
  1229.  
  1230.     With tSRBptr^ do begin                { initialize the TaskStatusBlk  }
  1231.       Fillchar(tSRBptr^,
  1232.                      sizeof(SRBlock),0)  ; { Clear garbage                 }
  1233.       procptr  := pUserPgmPtr            ; { addr of task to execute       }
  1234.       SRBtype  := TsrType                ; { Timer or hotkey type          }
  1235.       Keyvalue := TsrValue               ; { ticks or Key code             }
  1236.       Popproc  := pPopproc               ; { Popup/dn maintenance routine  }
  1237.       SRBName  := pName                  ;
  1238.  
  1239.       SRBstackptr := ptr(seg(tSRBptr^),    { point to stackframe top       }
  1240.           ofs(tSRBptr^) + StatusAreaSize   { actually, bottom of the SRB   }
  1241.           - sizeof(stackframe)-1 )       ; { minus size of a stackframe    }
  1242.  
  1243.      SRBstackptr^.DS := dseg             ; { init Dseg for later restore   }
  1244.      SRBstackptr^.BP := getbp            ; { get reasonable value for bp   }
  1245.  
  1246.      procid          := NumActiveSRBs    ;
  1247.      SRBstackptr^.IP := ofs(procptr^)    ; { make an IRET frame on the new }
  1248.      SRBstackptr^.CS := seg(procptr^)    ; { ..stack to invoke user proc   }
  1249.      Pushflags                           ; { push ordinary flags on stack  }
  1250.      pop(SRBstackptr^.flags)             ; { stow 'em on stack frame       }
  1251.  
  1252.      Save_Environment(tSRBptr)           ; { init thread environment       }
  1253.  
  1254.      CursorX   := 1                      ;
  1255.      CursorY   := 1                      ;
  1256.      Cursortype := BIOScursor            ; { save cursor scan lines        }
  1257.  
  1258.      SRBSuspended := Suspended           ; { make SRB suspended            }
  1259.      If TsrType = TimerType then
  1260.        SRBSuspended := TimerWait         ;
  1261.      if TsrType = Systype then             { unsuspend sys tasks           }
  1262.        SRBSuspended := 0                 ;
  1263.  
  1264.      SRBlink := CurrentSRB^.SRBlink     ; { duplicate the link  SRB       }
  1265.      CurrentSRB^.SRBlink := tSRBptr     ; { current SRB gets ptr to new   }
  1266.  
  1267.      END {with tSRBptr}
  1268.    end {Attach} ;
  1269.   {──────────────────────────────────────────────────────────────────}
  1270.   {                     Critical Error EXIT                          }
  1271.   {──────────────────────────────────────────────────────────────────}
  1272.   {     Restore system vectors, tattle on whomever and exit          }
  1273.   {──────────────────────────────────────────────────────────────────}
  1274. {$F+}{$S-}  PROCEDURE Critical_Exit; {$F-}
  1275.   BEGIN
  1276.  
  1277.     ExitProc := Exit_Vec ;           {restore previous ExitProc}
  1278.  
  1279.     DisableInterrupts              ;
  1280.  
  1281.     SetIntVec(BIOSI13, BIOS_Int13) ; { Restore Disk Interrupt Service Rtn  }
  1282.     SetIntVec(BIOSI16, Bios_Int16) ; { Restore Keyboard Interrupt Service  }
  1283.     SetIntVec(BIOSI8 , BIOS_Int8 ) ; { Restore Timer Interrupt Service     }
  1284.     SetIntVec(DOSI28 , DOS_Int28 ) ; { Restore DOS 28 Interrupt Service    }
  1285.  
  1286.     EnableInterrupts               ;
  1287.  
  1288.   writeln('CurrentTask: ',CurrentSRB^.SRBname,' #',CurrentSRB^.procid) ;
  1289.  
  1290.   END {Critical_Exit}     ;
  1291.  
  1292. {$S+}
  1293.   {──────────────────────────────────────────────────────────────────────}
  1294.   {                             POPSCHED                                 }
  1295.   {──────────────────────────────────────────────────────────────────────}
  1296.   {      Schedules POPup POPdn routines and enables the popup tasks      }
  1297.   {──────────────────────────────────────────────────────────────────────}
  1298. {$F+} Procedure POPsched ; {$F-}
  1299.     var
  1300.      OldSRBptr : SRBptr ;
  1301.      NewSRBptr : SRBptr ;
  1302.      PopParm   : boolean ;
  1303.  
  1304.     Begin  REPEAT {forever}
  1305.  
  1306.      Receive('popsched',                   { receive srbptr to schedule }
  1307.                pointer(NewSRBptr)) ;       { and wait when none ready   }
  1308.  
  1309.      OldSRBptr := FindSRB(Resources[_KBD]) ; { Suspend current popup routine }
  1310.      if OldSRBptr^.keyvalue <> 0 then        { only if its a Keytype task    }
  1311.         Suspend(OldSRBptr^.procid,
  1312.                               Suspended ) ;
  1313.      PopParm := false ;                      { say this is a popdown }
  1314.      if OldSRBptr^.PopProc <> nil then begin
  1315.         push(word(PopParm))         ;
  1316.         Callfar(OldSRBptr^.POPproc) ;        { call its PopUp/Dn routine }
  1317.         end                         ;
  1318.  
  1319.  
  1320.      if OldSRBptr^.procid =                   { Dont re-popup a task using  }
  1321.         NewSRBptr^.procid then                { a toggle up/dn hotkey       }
  1322.         begin
  1323.         Resources[_KBD] := 1   ;              { Dos gets the keyboard       }
  1324.         UnSuspend(1,suspended) ;              { Activate the forground task }
  1325.         end
  1326.      else
  1327.        With NewSRBptr^ do begin               { but call new task popup proc }
  1328.        PopParm :=
  1329.            boolean(SRBsuspended AND $0001 ) ; { if suspended then popup time}
  1330.        if PopProc <> nil then begin           { if false, then popdown time }
  1331.           push(word(PopParm)) ;
  1332.           Callfar(POPproc)    ;
  1333.           end                 ;
  1334.        if PopParm then begin
  1335.          Resources[_KBD] := procid   ;        { if popup assign keyboard }
  1336.          Unsuspend(procid,suspended) ;        { and set SRB unsuspended  }
  1337.          end {if PopParm}
  1338.        else {popdn} begin                     { if popdouwn..         }
  1339.          Resources[_KBD] := 1 ;               { Dos gets the keyboard }
  1340.          Suspend(procid,suspended) ;          { and task is suspended }
  1341.        end {else..}           ;
  1342.      end {else with PopSRBptr..} ;
  1343.  
  1344.    UNTIL false ; End {Popsched} ;
  1345.   {──────────────────────────────────────────────────────────────────────}
  1346.   {                        initialization                                }
  1347.   {──────────────────────────────────────────────────────────────────────}
  1348.    var
  1349.     regs : registers ;
  1350.  
  1351.    begin  {initialization}
  1352.  
  1353.    Status := status or inuse     ; { disallow dispatching  }
  1354.    PutRotr  := ptr($B800,0)      ; { Show a Rotor in       }
  1355.    If lo(lastmode) = mono then     { upper right of screen }
  1356.       PutRotr  := ptr($B000,0)   ; { for each dispatch of  }
  1357.    Videoseg := vec(PutRotr).seg  ; { yield request         }
  1358.    incptr(PutRotr, 80*2-2)       ;
  1359.  
  1360.     { issure int 16  "are you there" request to a (possibly)      }
  1361.     { previously loaded SR50. BX will be loaded wih AX if already }
  1362.     { resident. If Paramstr is "quit", zap the previously loaded  }
  1363.     { SR50 termination byte.                                      }
  1364.  
  1365.    Getmem(Int16stack,stacksize) ;{ Forground INT16 functions stack }
  1366.    incptr(Int16stack,stacksize) ;
  1367.    inline($CC);
  1368.    With Regs DO BEGIN            { See if already resident           }
  1369.     ax := $6C66         ;        { our "see quit" keyboard function  }
  1370.     bx := $0000         ;        { ax and bx will switch if TSR      }
  1371.     es := dseg          ;        { point ES:DI to our RUT id block   }
  1372.     di := ofs(RUTidblk) ;        { Are You There id block            }
  1373.     intr($16,regs)      ;        { issue keyboard read               }
  1374.  
  1375.     If bx = $6c66 then begin    {  resident if bx ax switch}
  1376.      if paramstr(1) = 'quit' then
  1377.        with RUTidblktype(ptr(es,di)^) do
  1378.          RUTtermbyte := true        { set terminate byte if resident }
  1379.       else                          { Already resident.. exit        }
  1380.         writeln(^G,'SR 5.0 is already resident.') ;
  1381.       HALT(0)                                            ;
  1382.     end {if bx}                                          ;
  1383.    END {with regs}                                       ;
  1384.  
  1385.  
  1386.    NumActiveSRBs := 0                         ; { assume no active tasks   }
  1387.    CurrentSRB    := nil                       ; { show no SRB chain yet    }
  1388.  
  1389.    GetMem( DosIdleSRB,
  1390.              sizeof(SRBlock)+stacksize )      ; { memory for SRB and stack }
  1391.    With DosIdleSRB^ do begin                    { used to hold InDos stack }
  1392.      SRBStackptr := stackptr(DosIdleSRB)      ; { initialize SRB stack ptr }
  1393.      incptr(SRBStackptr,
  1394.                  sizeof(SRBlock)+stacksize-2) ; { point stack @ SRB bottom }
  1395.      end {with..begin}                        ;
  1396.  
  1397.    GetMem( TimerSRB,
  1398.              sizeof(SRBlock)+stacksize )      ; { memory for SRB and stack }
  1399.    With TimerSRB^ do begin                      { used to hold InDos stack }
  1400.      SRBStackptr := stackptr(TimerSRB)        ; { initialize SRB stack ptr }
  1401.      incptr(SRBStackptr,
  1402.                  sizeof(SRBlock)+stacksize-2) ; { point stack @ SRB bottom }
  1403.      end {with..begin}                        ;
  1404.  
  1405.      DftWindow[3] := VideoCols         ; { attempt to assign the bios }
  1406.      DftWindow[4] := VideoRows         ; { screen coordinates. If nil }
  1407.      if VideoCols = 0 then               { assign the usual 80 by 25  }
  1408.         DftWindow[3] := 80             ;
  1409.      if videoRows = 0 then
  1410.         DftWindow[4] := 25             ;
  1411.  
  1412.      { create a Dwell task, one which is always dispatchable }
  1413.  
  1414.    Attach(@DummyIret,KeyType,         { Add Dos as a task          }
  1415.                  0000,NIL,'DOS')    ; { with an impossible keycode }
  1416.                                       { CurrentSRB now has ptr     }
  1417.    NumActiveSRBs := 1               ; { reset to one active task   }
  1418.  
  1419.    With CurrentSRB^ do BEGIN          { fix up the first SRB       }
  1420.      SRBlink      := CurrentSRB     ; { first SRB points to itself }
  1421.      SRBstackptr  := ptr(Sseg,Sptr) ; { New thread stack pointer   }
  1422.      procid       := 1              ; { Dos thread id              }
  1423.      popproc      := nil            ;
  1424.      SRBname      := 'FOREGRND'     ;
  1425.      SRBSuspended := 0              ; { Foreground never suspended }
  1426.    END {with currentSRB}            ;
  1427.  
  1428.    Attach(@POPSched,Systype,          { attach the pop up schedular }
  1429.               0000,nil,'SCHED')     ;
  1430.    MakeMailBox('POPSCHED')          ; { popupdn scheduler mail box  }
  1431.  
  1432.    Setup_ISRs                       ; { activate TSR vector traps   }
  1433.  
  1434.    Exit_Vec := ExitProc             ; { Chain into ExitProc     }
  1435.    ExitProc := @Critical_Exit       ; { install additional exit }
  1436.  
  1437.    end {initialization}   .
  1438.  
  1439. (**************************************************************************)
  1440.