:asm intvect@ ( int -- seg off )
  XOR BX BX
  MOV ES BX
  POP BX
  SHL BX 1 #
  SHL BX 1 #
  PUSH @[ 2 @+ ES: BX]
  PUSH @[ ES: BX]
  NEXT

:asm intvect! ( seg off int -- )
  XOR BX BX
  MOV ES BX
  POP BX
  SHL BX 1 #
  SHL BX 1 #
  CLI
  POP @[ ES: BX]
  POP @[ 2 @+ ES: BX]
  STI
  NEXT

: irq 8 + ;

{ :timm :asmisr ( int -- ) ARRAY 4 ALLOT w>t CLI PUSH AX ;
  :timm ISR-DONE MOV AL 0x20 # OUT 0x20 # AL POP AX STI IRET ;
  :timm CHAIN-ISR ( isr -- )
    POP AX
    STI
    JMP FAR CS: @+ ; }

: isr>int ( isr -- int ) 2 cells + @ ;
: isr>code ( isr -- p ) 3 cells + ;
: uninstall-isr ( isr -- )
  >r r@ cell + @ r@ @ <r isr>int intvect! ;
: install-isr ( isr -- ) 
  >r r@ isr>int intvect@ r@ ! r@ cell + ! 
  get-cseg r@ isr>code <r isr>int intvect! ;

var timer
0 irq :asmisr timer-isr
  MOV AX CS: timer @+
  INC AX
  MOV CS: timer @+ AX
  AND AX 0x07 #
  JZ 0 @>
  ISR-DONE
0 <:
  timer-isr CHAIN-ISR

:asm set-timer-div ( div -- )
  MOV AL 0x36 #
  OUT 0x43 # AL
  POP AX
  OUT 0x40 # AL
  MOV AL AH
  OUT 0x40 # AL
  NEXT

( the timer is set to run at just under 150hz, so a "csec" is closer to 7.5ms
  than 10ms. )
: over-csec ( csec -- ) 
  timer @ + >arg (( begin dup timer @ > while yield0 repeat drop )) ;
: sleep-csec ( cs -- ) over-csec each suspend next ;

' init :chain [ 0xffff 3 >> lit ] set-timer-div timer-isr install-isr ;
' cleanup :chain 0xffff set-timer-div timer-isr uninstall-isr ;