        Title   Turtle, computer slow-down by Konstantin Boyandin
        Ideal
        P386N
        Jumps
        Locals  @@

;
; Sample TSR
;

Struc   HotTableEntry
        flags           dw      ?
        scan            db      ?
        onrelease       db      ?
        cmdcode         dw      ?
Ends

HOT_TABLE_ENTRY_SIZE    = (size HotTableEntry)

;
; Constants and flags
;
PSP_ENVIRONMENT = 2ch

KEY_BREAK_PREFIX= 0f0h

BIOS_KBD_FLAGS  = 417h
BIOS_VIDEO_MODE = 449h
BIOS_DOS_TIMER  = 46ch

TEXTMODE_VALUE  = 3
TEXTMODE_SEGMENT= 0b800h

ARBITRARY_VALUE = 4567feedh

ID_MUX          = 0feedh

TSR_INSTALLED   = 8000h
TSR_BUSY        = 4000h
TSR_KEY_RELEASED= 2000h
TSR_CALCULATING = 1000h

EXIT_NORMAL     = 0
EXIT_INSTALLED  = 1
EXIT_RTC_FAIL   = 2

CMD_NONE        = 0
CMD_FASTER      = 1
CMD_SLOWER      = 2

RTC_INTR        = 01000000b

TSR_STACK_SIZE          = 64
TSR_STACK_BOTTOM        = (offset TsrStackEnd)
TSR_RESIDENT_SIZE       = ((offset TsrEnd - offset TsrStart) + 15 + 100h)
TSR_PROGRAM_SIZE        = ((offset ProgramEnd - offset TsrStart) + 15 + 100h)

;
; Macros
;
; Print: prints a message on stdout
;
Macro   Print   msg
        Mov     Dx, offset msg
        Call    PrintMsg
Endm
;
; Intercept: hooks an interrupt routine
;
Macro   Intercept       intno, oldhook, newroutine
        Mov     Ah, 35h
        Mov     Al, intno
        Int     21h
        Mov     [Word ptr oldhook], Bx
        Mov     [Word ptr oldhook + 2], Es
        Mov     Ah, 25h
        Mov     Al, intno
        Mov     Dx, offset newroutine
        Int     21h
Endm
;
; Release: releases previously intercepted hook
;
Macro   Release         intno, oldhook
        Mov     Ah, 25h
        Mov     Al, intno
        Push    Es
        Mov     Bx, [Word ptr oldhook]
        Mov     Es, [Word ptr oldhook + 2]
        Int     21h
        Pop     Es
Endm

Segment Tsr     Public  Use16   Byte

        Assume  Cs:Tsr, Ds:Tsr, Es:Tsr, Ss:Tsr

Label   TsrStart        Byte

        Org     TSR_STACK_SIZE

Label   TsrStackEnd     Byte

; ***********************************************************************
;                              TSR code
; ***********************************************************************

;**************************** TSR hooks *********************************

;
; TSR RTC
;
Proc    Tsr70   Far
        Cli
        Push    Eax
        Push    Edx
        Push    Ecx
        Push    Ds
        Push    Cs
        Pop     Ds
;
; Inform RTC controller
;
        Mov     Al, 0ch
        Out     70h, Al
        Mov     Ax, Ax
        In      Al, 71h
        Mov     Al, 20h
        Out     0a0h, Al
        Out     20h, Al
;
; IF we are installing, calculate tick counter
;
        Cmp     [MinQuant], 0
        Jne     @@RTC1
        Or      [TsrFlags], TSR_CALCULATING
        Jmp     @@Tsr70_Exit
  @@RTC1:
  ; If calculating, clear the bit
        Test    [TsrFlags], TSR_CALCULATING
        Je      @@RTC2
        And     [TsrFlags], Not TSR_CALCULATING
        Jmp     @@Tsr70_Exit
  @@RTC2:
  ; ... now eat up time
        Mov     Ecx, [CurQuant]
        Jecxz   @@Tsr70_Exit
  @@RTC_Loop:
        Mov     Eax, ARBITRARY_VALUE
        Mul     Eax
        Test    [TsrFlags], TSR_CALCULATING
        Sub     Ecx, 1
        Ja      @@RTC_Loop
@@Tsr70_Exit:
        Pop     Ds
        Pop     Ecx
        Pop     Edx
        Pop     Eax
        Sti
        Iret
Endp

;
; Tsr Multiplexor
;
Proc    Tsr2f   Far
        Pushf
        Cli
        Push    Ds
        Push    Cs
        Pop     Ds
  ;
  ; Our ID?
  ;
        Cmp     Ax, ID_MUX
        Je      @@S2f
  ;
  ; Not our call: chain back
  ;
        Pushf
        Call    [Tsr2fHook]
        Jmp     @@SExit
@@S2f:
  ;
  ; As basic type of Mux hook, we'll just report we are here
  ;
        Xor     Ax, Ax
        Mov     Bx, Cs
@@SExit:
        Pop     Ds
        Popf
        Iret
Endp

;
; Tsr Keyboard hook
;
Proc    Tsr09   Far
        Cli
  ; Precaution: if already active, leave
        Test    [Word ptr Cs:TsrFlags], TSR_BUSY
        Jne     @@TSRIsBusy
  ; Save current context ...
        Pusha
        Push    Ds
        Push    Es
  ; ... set up data segment ...
        Push    Cs
        Pop     Ds
  ; ... read scan code
        In      Al, 60h
        Mov     [KeyScan], Al
  ; ... set or reset 'key released' flag
        And     [TsrFlags], Not TSR_KEY_RELEASED
        Cmp     Al, KEY_BREAK_PREFIX
        Jne     @@H09_1
        Or      [TsrFlags], TSR_KEY_RELEASED
  ; ... scan hot table and place command code
  @@H09_1:
        Cld
        Mov     [Command], CMD_NONE
        Xor     Bx, Bx
        Mov     Es, Bx
        Mov     Bx, [Es:BIOS_KBD_FLAGS]
        Mov     Cx, HOT_TABLE_SIZE
        Mov     Si, offset HotTable
  @@H09_L:
    ; check flags...
        Mov     Dx, [(HotTableEntry ptr Si).flags]
        Mov     Ax, Dx
        And     Dx, Bx
        Cmp     Dx, Ax
        Jne     @@H09_L_loop
    ; check scan code
        Mov     Al, [KeyScan]
        Cmp     [(HotTableEntry ptr Si).scan], Al
        Jne     @@H09_L_loop
    ; check 'on release' code
        Mov     Ah, [(HotTableEntry ptr Si).onrelease]
        Xor     Al, Al
        Test    [TsrFlags], TSR_KEY_RELEASED
        Je      @@H09_oncheck
        Inc     Al
  @@H09_oncheck:
        Xor     Ah, Al
        Jne     @@H09_L_loop
        Mov     Ax, [(HotTableEntry ptr Si).cmdcode]
        Mov     [Command], Ax
        Jmp     @@Hook09_Exit
    ; tests passed, set command code
  @@H09_L_loop:
        Add     Si, HOT_TABLE_ENTRY_SIZE
        Loop    @@H09_L
  @@Hook09_Exit:
  ; If command non-zero,.. (cautios!)
        Cmp     [Command], CMD_NONE
  ; ... restore changed context ...
        Pop     Es
        Pop     Ds
        Popa
  ; ... if no command, chain back
        Jne     @@CommandValid
  @@TSRIsBusy:
        Jmp     [Dword ptr Cs:Tsr09Hook]
  @@CommandValid:
  ; Release interrupt controller
        Push    Ax
        In      Al, 61h
        Mov     Ah, Al
        Or      Al, 80h
        Out     61h, Al
        Xchg    Ah, Al
        Out     61h, Al
        Mov     Al, 20h
        Out     20h, Al
        Pop     Ax
  ;   Note: if TSR should perform file management, it should check
  ; it's safe *before calling this routine*
        Call    PerformCommand
  ; ... leaving at last
        Sti
        Iret
Endp

;********************** TSR command processing **************************

Proc    PerformCommand  Near
; Switch to TSR stack and save context
        Mov     [Word ptr Cs:OldStack], Sp
        Mov     [Word ptr Cs:OldStack + 2], Ss
        Lss     Sp, [Dword ptr Cs:TsrStack]
        Pusha
        Push    Ds
        Push    Es
        Push    Cs
        Pop     Ds
        Xor     Ax, Ax
        Mov     Es, Ax
; Perform necessary commands...
  @@Cmd1:
        Cmp     [Command], CMD_FASTER
        Jne     @@Cmd2
  ; **************************************************
  ;    Command 1: Faster
  ; **************************************************
        Cmp     [Percent], QUANT_MAX_VALUE
        Jae     @@PerformCommand_Exit
        Add     [Percent], QUANT_VALUE
        Jmp     @@PerformCommand_Exit
  @@Cmd2:
        Cmp     [Command], CMD_SLOWER
        Jne     @@PerformCommand_Exit
  ; **************************************************
  ;    Command 2: Slower
  ; **************************************************
        Cmp     [Percent], QUANT_VALUE
        Jle     @@PerformCommand_Exit
        Sub     [Percent], QUANT_VALUE
@@PerformCommand_Exit:
        Call    FillBanner
        Call    ShowBanner
; Retrieve context
        Pop     Es
        Pop     Ds
        Popa
        Lss     Sp, [Dword ptr Cs:OldStack]
        Retn
Endp

;************************** TSR routines ********************************

Proc    UnhookMux       Near
        Mov     Ax, [Word ptr Tsr2fHook]
        Or      Ax, [Word ptr Tsr2fHook + 2]
        Je      @@Unhook2f_Exit
        Release 2fh, Tsr2fHook
@@Unhook2f_Exit:
        Retn
Endp

Proc    DisableRTC      Near
        Mov     Ax, [Word ptr Tsr70Hook]
        Or      Ax, [Word ptr Tsr70Hook + 2]
        Je      @@DRTC_Exit
;
; Disable RTC now...
;
        In      Al, 0a1h
        Or      Al, 01h
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        Out     0a1h, Al
        Mov     Al, 0bh
        Out     70h, Al
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        In      Al, 71h
        Mov     Ah, Al
        And     Ah, Not RTC_INTR        ; RTC periodic interrupts disable
        Mov     Al, 0bh
        Out     70h, Al
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Al, Ah
        Out     71h, Al
;
; ... and unhook it
;
        Release 70h, Tsr70Hook
@@DRTC_Exit:
        Retn
Endp

Proc    UnhookKeyboard  Near
        Mov     Ax, [Word ptr Tsr09Hook]
        Or      Ax, [Word ptr Tsr09Hook + 2]
        Je      @@Unhook09_Exit
        Release 09h, Tsr09Hook
@@Unhook09_Exit:
        Retn
Endp

;
; FillBanner: calculate delay count value and fill banner
;
Proc    FillBanner      Near
; Calculate values
        Push    Eax
        Push    Ebx
        Push    Edx
        Xor     Ebx, Ebx
        Mov     Ebx, QUANT_MAX_VALUE
        Sub     Bx, [Percent]
        Mov     Eax, [MinQuant]
        Mul     Ebx
        Mov     [CurQuant], Eax
        Pop     Edx
        Pop     Ebx
        Pop     Eax
; Fill banner with spaces
        Mov     Di, offset Banner
        Push    Es
        Push    Ds
        Pop     Es
        Mov     Cx, BANNER_SIZE
        Mov     Al, ' '
  @@FB_spaces:
        Stosb
        Inc     Di
        Loop    @@FB_spaces
        Pop     Es
; Convert percentage into number
        Lea     Di, [Banner + 6]
        Mov     Bx, 10
        Mov     Ax, [Percent]
  @@FB_number:
        Xor     Dx, Dx
        Div     Bx
        Add     Dl, '0'
        Mov     [Di], Dl
        Dec     Di
        Dec     Di
        Or      Ax, Ax
        Ja      @@FB_number
@@FillBanner_Exit:
        Retn
Endp

;
; ShowBanner: displays banner, if in text mode
;
Proc    ShowBanner      Near
        Cmp     [Byte ptr Es:BIOS_VIDEO_MODE], TEXTMODE_VALUE
        Ja      @@ShowBannerExit
        Push    Es
        Cld
        Mov     Cx, BANNER_SIZE
        Les     Di, [Dword ptr BannerStartPtr]
        Mov     Si, offset Banner
        Rep     Movsw
        Pop     Es
@@ShowBannerExit:
        Retn
Endp

; ***********************************************************************
;                              TSR data
; ***********************************************************************

OldStack        dw      0, 0
TsrStack        dw      TSR_STACK_BOTTOM, Tsr
Tsr70Hook       dd      0
Tsr2fHook       dd      0
Tsr09Hook       dd      0
TsrFlags        dw      0
TsrPSPSeg       dw      0
Command         dw      CMD_NONE
; Turtle-related data
QUANT_VALUE     =       5
QUANT_MAX_VALUE =       100
CurQuant        dd      0
MinQuant        dd      0
Percent         dw      100
; Keyboard control combinations: flags, scan, <unused>, function no.
HOT_TABLE_SIZE  =       2
HotTable        dw      000ch, 004eh, CMD_FASTER
                dw      000ch, 004ah, CMD_SLOWER
BANNER_SIZE     =       5
BannerStartPtr  dw      0000h, 0b800h
Banner          db      ' ', 02h, ' ', 02h, ' ', 02h, ' ', 02h, ' ', 02h
KeyScan         db      0
Signature       db      'MBS Turtle', 0

Label   TsrEnd          Byte

; ***********************************************************************
;                             Init code
; ***********************************************************************
Start:
;
; Miscellaneous init:
;
  ; Segments & stack
        Mov     Ax, Tsr
        Mov     Ds, Ax
        Mov     Es, Ax
        Cli
        Mov     Ss, Ax
        Mov     Sp, TSR_STACK_BOTTOM
        Sti
  ; PSP value
        Mov     Ah, 62h
        Int     21h
        Mov     [TsrPSPSeg], Bx
  ; Environment segment
        Push    Es
        Mov     Es, Bx
        Mov     Bx, [Es:PSP_ENVIRONMENT]
        Mov     [TsrEnvSeg], Bx
        Pop     Es
;
; Say hello
;
        Print   ITsrCopyright
;
; Call Mux to see whether it's already installed
;
        Mov     Ax, ID_MUX      ; arbitrary value, be cautious
        Int     2fh
        Or      Ax, Ax          ; zero if installed
        Jne     Install
        Mov     [TsrCS], Bx     ; save TSR Cs value for later use
;
; Already installed, type that and leave
;
        Print   ITsrName
        Print   ITsrMsg1
        Print   ITsrMsg2
        Mov     Al, EXIT_INSTALLED
        Jmp     Exit
;
; OK to install
;
Install:
;
; RTC enable: enable RTC (if possible)
;
        Call    EnableRTC
        Jnc     @@Install1
        Mov     Al, EXIT_RTC_FAIL
        Jmp     Exit
;
; Hook keyboard
;
  @@Install1:
        Call    HookKeyboard
;
; Hook Mux
;
        Call    HookMux
;
; TSR now...
;
        Call    MakeTSR
;
; Leave to DOS...
;
Exit:
        Mov     Ah, 4ch
        Int     21h

;
; MakeTSR: leaves resident portion
;
Proc    MakeTSR Near
;
; Print relevant messages
;
        Print   ITsrMsg3
        Print   ITsrMsg2
;
; Free environment
;
        Push    Es
        Mov     Es, [TsrEnvSeg]
        Mov     Ah, 49h
        Int     21h
        Pop     Es
;
; TSR now...
;
        Mov     Dx, TSR_RESIDENT_SIZE
        Shr     Dx, 4
        Mov     Ax, 3100h
        Int     21h
Endp

;
; Print: prints messages via DosFn 09h
;
; DX: message offset
Proc            PrintMsg        Near
        Push    Ax
        Mov     Ah, 09h
        Int     21h
        Pop     Ax
        Retn
Endp

;
; Hook2f: intercepts Mux
;
Proc    HookMux         Near
        Mov     Ax, [Word ptr Tsr2fHook]
        Or      Ax, [Word ptr Tsr2fHook + 2]
        Jne     @@Hook2f_Exit
        Intercept       2fh, Tsr2fHook, Tsr2f
@@Hook2f_Exit:
        Retn
Endp

Proc    HookKeyboard    Near
        Mov     Ax, [Word ptr Tsr09Hook]
        Or      Ax, [Word ptr Tsr09Hook + 2]
        Jne     @@Hook09_Exit
        Intercept       09h, Tsr09Hook, Tsr09
@@Hook09_Exit:
        Retn
Endp

;
; EnableRTC: tries to switch RTC on
; Returns:
;       Carry set, if failure
;       Carry clear, if OK
;
Proc    EnableRTC       Near
;
; If it were installed...
;
        Mov     Ax, [Word ptr Tsr09Hook]
        Or      Ax, [Word ptr Tsr09Hook + 2]
        Jne     @@ERTC_Success
        Intercept       70h, Tsr70Hook, Tsr70
;
; Enable RTC registers
;
        Mov     Al, 0bh
        Out     70h, Al
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        In      Al, 71h
        Mov     Ah, Al
        Or      Ah, RTC_INTR    ; RTC periodic interrupts enable
        Mov     Al, 0bh
        Out     70h, Al
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Al, Ah
        Out     71h, Al
        In      Al, 0a1h
        And     Al, 0feh
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        Mov     Ax, Ax
        Out     0a1h, Al
;
; Now precalculate delay amount...
;
        Push    Es
        Push    Eax
        Push    Edx
        Push    Ebx
        Xor     Cx, Cx
        Mov     Es, Cx
        Mov     Cx, [Es:BIOS_DOS_TIMER]
        Add     Cx, 2
  @@ERTC_Wait_Flag:
        Test    [TsrFlags], TSR_CALCULATING
        Je      @@ERTC_Wait_Flag
  ; ... if RTC fails to start, go out
        Cmp     Cx, [Es:BIOS_DOS_TIMER]
        Je      @@ERTC_Fail
  ; ... 70h handler set flag, now calculate amount
  @@ERTC_Inc_Loop:
        Inc     [MinQuant]
        Mov     Eax, ARBITRARY_VALUE
        Mul     Eax
        Test    [TsrFlags], TSR_CALCULATING
        Jne     @@ERTC_Inc_Loop
  ; ... calculated, now divide it by 20
        Xor     Edx, Edx
        Mov     Eax, [MinQuant]
        Mov     Ebx, QUANT_MAX_VALUE
        Div     Ebx
        Mov     [MinQuant], Eax
        Pop     Ebx
        Pop     Edx
        Pop     Eax
        Pop     Es
;
; Success, clear carry
;
@@ERTC_Success:
        Clc
        Retn
;
; Failure, tell that and exit
;
@@ERTC_Fail:
        Pop     Ebx
        Pop     Edx
        Pop     Eax
        Pop     Es
        Print   ITsrName
        Print   ITsrMsg4
        Call    DisableRTC
        Stc
        Retn
Endp

; ***********************************************************************
;                             Init data
; ***********************************************************************

ITsrCopyright   db      'Turtle, (c) 1995 MBS, to make your PC crawl.',13,10,'$'
ITsrName        db      'Turtle: $'
ITsrMsg1        db      'already installed.',13,10,'$'
ITsrMsg2        db      'Control key combinations:',13,10
                db      '  [Ctrl-Alt-GrayPlus]   faster',13,10
                db      '  [Ctrl-Alt-GrayMinus]  slower',13,10,'$'
ITsrMsg3        db      'Turtle installed. $'
ITsrMsg4        db      'failed to enable real-time clock',13,10,'$'
TsrCS           dw      0
TsrEnvSeg       dw      0

Label   ProgramEnd      Byte

Ends

End     Start
