ideal
jumps
p386

segment biosvar at 40h

  org 17h
flags_1 db ?
flags_2 db ?

  org 72h
resetflag dw ?

  org 96h
xflags_1 db ?
xflags_2 db ?

ends biosvar

segment bios at 0f000h
  org 0fff0h
reset:
ends bios


ifdef exact

segment tape_segment

tape_buffer: db 16384 dup (?)

ends tape_segment

endif

segment ports

group emulator ports

public output, input, int09handler, readjoystick
public ports@border, ports@js_present, ports$, ports@keymap
public ports@clickcycle, ports@clicktime, ports@exact
public ports@emu_tape, ports@sound

assume cs:emulator,ds:nothing,es:nothing,fs:nothing,gs:nothing,ss:nothing

ports@clickcycle dw 0
ports@clicktime dw 0

ifdef exact
dac:
  db 0,0,0
  db 0,0,45
  db 45,0,0
  db 45,0,45
  db 0,45,0
  db 0,45,45
  db 45,45,0
  db 45,45,45
endif

extrn need_int:byte,intctr:byte,cycles:word,cyc_2:byte
;
; output al to cx
; preserve ax,bx,cx,dx,si,bp
proc output near
  cmp cl,254
  je @@_sound
  ret
@@_sound:
ifdef exact
  test [ports@sound],2  ;sound on?
  jz @@_border          ;no, skip
  push ax               ;yes, sync with PC clock
  mov ax,[ports@clickcycle]
  test ax,ax            ;first click after interrupt?
  jz @@_cu2
  mov di,[cycles]       ;no, compute time since last click
  sub di,ax             ;convert from cycles to PC time units
  shr di,2
  mov ax,di
  shr ax,3
  add di,ax
  shr ax,1
  add ax,di
  mov di,[ports@clicktime] ;subtract delay from then-time
  sub di,ax             ;and put end of delay in di
  in al,40h             ;get current time
  mov ah,al
  in al,40h
  xchg al,ah
  sub ax,di             ;already here?
  jbe @@_cu3
  cmp ax,7500           ;no, too long to wait for?
  jae @@_cu2            ;yes -> skip it and start a new timer
@@_cu1:
  jmp short $+2
  jmp short $+2
  jmp short $+2
  jmp short $+2
  jmp short $+2
  jmp short $+2
  jmp short $+2
  jmp short $+2
  jmp short $+2
  jmp short $+2
  in al,40h             ;mark time until clocks are synchronised
  mov ah,al
  in al,40h
  xchg ah,al
  cmp ax,di
  ja @@_cu1
  jmp @@_cu3
@@_cu2:
  mov ax,[cycles]       ;(first click after interrupt)
  mov [ports@clickcycle],ax ;copy Spectrum cycles
  in al,40h             ;and PC clock
  mov ah,al
  in al,40h
  xchg ah,al
  mov [ports@clicktime],ax ;into variables for access by next clicks
@@_cu3:
  pop ax
endif
  push ax
  mov ah,al
  in al,61h
  shr ah,3
; and ax,2fdh          ;hand-assembled
  db 25h,0fdh
ports@sound db 02h
  or al,ah
  out 61h,al
  pop ax
@@_border:
;set MIC to D3

;set border to D0..2
ifdef exact
  push ax
  and al,7
  cmp al,[ports@border]
  je @@_bd_1
  mov [ports@border],al
  push dx
  mov dx,03c8h
  mov di,ax
  add di,ax
  add di,ax
  add di,offset dac
  mov al,8
  out dx,al
  inc dl
  mov al,[cs:di]
  inc di
  jmp short $+2
  out dx,al
  mov al,[cs:di]
  inc di
  jmp short $+2
  out dx,al
  mov al,[cs:di]
  jmp short $+2
  out dx,al
  pop dx
@@_bd_1:
  pop ax
else
  mov [ports@border],al
endif
  ret

endp output





;
; input from cx to al
; preserve bx,cx,dx,si,bp
proc input near
  cmp cl,254
  je @@_keyboard
  test cl,224
  jz @@_kempston
  cmp cl,255
  je @@_retrace
  mov al,255
  ret
;undocumented -
; in 255 is 255 during retrace,
; usually non-255 else
@@_retrace:
ifdef exact
  mov di,[cycles]
  cmp di,39000
  ja @@_retrace_1
else
  in al,40h
  in al,40h
  cmp al,2
  ja @@_retrace_1
endif
  inc [@@_retrace_2]
  mov al,[@@_retrace_2]
  ret
@@_retrace_1:
  mov al,255
  ret
@@_retrace_2 db 0
@@_kempston:
  test[ports@js_present],255
  jz @@_ke_2
  test [test_js],255
  jnz @@_ke_1
  mov [test_js],255
@@_ke_1:
  push dx
  mov dx,201h
  in al,dx
  not al
  mov ah,al
  shr ah,1
  or al,ah
  and al,16
  or al,[kempston]
  pop dx
  ret
@@_ke_2:
  xor al,al
  ret
@@_keyboard:
  mov di,offset keymap
  xor al,al
  mov ah,ch
  not ah
@@_k_1:
  test ah,128
  jz @@_k_2
  or al,[cs:di]
@@_k_2:
  inc di
  add ah,ah
  jnz @@_k_1
ifdef exact
  test [byte ptr ports@emu_tape],255
  jz @@_k_3
  call readbit
@@_k_3:
endif
  not al
  ret

ports@emu_tape db 0

ports@keymap:
keymap:
  db 0,0,0,0,0,0,0,0

kempston db 0

jtimer db 1

endp input



ifdef exact

;
; read one bit from the 'tape'
; return it in bit 6 of al
; preserve the rest of al and all other registers
proc readbit near
  push ds
  push es
  pushf
  pushad

  mov ax,[cycles]               ;inc long-timer if necessary
  cmp ax,[tape_cyc]
  mov [tape_cyc],ax
  ja @@_1
  add [tape_timer],35000
@@_1:
  xor eax,eax                   ;compute current instant
  mov ax,[cycles]
  add eax,[tape_timer]
  cmp eax,[tape_last]           ;after end of current tape block?
  jb @@_5
  mov ebx,[tape_last]           ;yes, go to next
  test ebx,ebx
  jnz @@_2
  mov ebx,eax                   ;kluge - start clock only when nec.
@@_2:
  mov [tape_first],ebx
  push eax                      ;store wanted instant
  mov eax,[tape_bl]             ;more left in this block?
  test eax,eax
  jnz @@_3
  mov ax,cs                     ;no, read 6-byte header
  mov ds,ax                     ; may be less, if so it's an error
  mov dx,offset tape_header     ; either end of file or some real error
  mov cx,6
  mov bx,[tape_handle]
  mov ah,3fh
  int 21h
  jc @@_error
  cmp ax,6
  jb @@_error
  cmp [byte ptr cs:offset tape_header],1 ;type byte is 1?
  jne @@_error
  cmp [byte ptr cs:offset tape_header+5],0 ;yes, compression type is 0?
  jne @@_error
  mov eax,[cs:offset tape_header+1] ;yes, set tape_bl to size of block
  and eax,0ffffffh
  mov [tape_bl],eax
  xor eax,eax                   ;compute division factor
  mov al,[byte ptr cs:offset tape_header+4] ;n
  mov ebx,256                   ;256-n
  sub bx,ax
  mov eax,1000000
  xor edx,edx
  div ebx                       ;1000000/(256-n) = frequency
  mov ebx,eax
  mov eax,3500000
  xor edx,edx
  div ebx                       ;Clock freq/sample rate
  mov [tape_div],eax
@@_3:
  mov ax,seg tape_buffer        ;read the block
  mov ds,ax
  xor dx,dx
  mov ecx,16384
  sub [tape_bl],ecx             ;at least 16384 bytes left?
  jae @@_4
  add ecx,[tape_bl]             ;no, read what's left
  mov [tape_bl],0
@@_4:
  mov bx,[tape_handle]
  mov ah,3fh
  push cx
  int 21h
  pop cx
  jc @@_error                   ;error -> error
  cmp ax,cx
  jb @@_error                   ;and too short -> error
  and eax,65535                 ;compute end of in-ram block
  mul [tape_div]                ; as clock ticks
  add eax,[tape_first]
  mov [tape_last],eax

  pop eax                       ;retrieve instant
  jmp @@_1

@@_5:                           ;the tape info is now in ram
  xor edx,edx
  sub eax,[tape_first]
  div [tape_div]                ;at address ax
  mov bx,ax                     ;so read it!
  mov ax,seg tape_buffer
  mov ds,ax
  mov al,[ds:bx]
  cmp al,128                    ;simple 1-bit reading
  jb @@_exit_1
  jmp @@_exit_0

@@_error:
  pop eax
  mov bx,[tape_handle]
  mov ah,3eh
  int 21h
  mov [ports@emu_tape],0

@@_exit_0:
  popad
  and al,191
  jmp @@_exit
@@_exit_1:
  popad
  or al,64
@@_exit:
  popf
  pop es
  pop ds
  ret
endp readbit

align 4
tape_bl dd 0
tape_first dd 0
tape_last dd 0
tape_div dd 1
tape_timer dd 0
tape_cyc dw 0
tape_handle dw 0
tape_seg dw seg tape_buffer
tape_header: db 6 dup (0)
tape_name: db 'tape-in.voc',0

proc opentape near
  mov ax,cs
  mov ds,ax
  mov dx,offset tape_name
  mov ax,3d00h
  int 21h
  jc @@_notape
  mov [tape_handle],ax
  mov bx,ax
  mov ax,4200h
  xor cx,cx
  mov dx,1ah
  int 21h
  jc @@_notape
  mov [ports@emu_tape],1
  ret
@@_notape:
  mov [ports@emu_tape],0
  ret
endp opentape



endif



proc int09handler near
  push ds
  push es
  pusha
  pushf

  mov ax,cs
  mov ds,ax
  mov ax,40h
  mov es,ax
  assume ds:emulator,es:biosvar

  in al,60h
  stc
  mov ah,4fh
  int 15h
  jnc @@_exit
  test [extended],255
  jnz @@_extended
  cmp al,0fah
  je @@_ack
  cmp al,0eeh
  je @@_exit
  cmp al,0f0h
  je @@_i_1
  cmp al,0e0h
  jne @@_i_2
  mov [extended],1
  jmp @@_exit
@@_i_1:
  mov [break],128
  jmp @@_exit
@@_i_2:
  or al,[break]
  mov [break],0
  mov ah,al
  and ax,807fh
  cmp al,88
  ja @@_exit
  mov bx,ax
  add bx,bx
  add bx,bx
  mov cx,[ds:bx+offset keytrans]
  mov dx,[ds:bx+2+offset keytrans]

@@_i_3:
  test cx,cx
  jz @@_i_7
  movzx bx,cl
  test ah,128
  jnz @@_i_4
  or [byte ptr ds:bx+offset keymap-1],ch
  jmp @@_i_5
@@_i_4:
  not ch
  and [byte ptr ds:bx+offset keymap-1],ch
@@_i_5:
  test dx,dx
  jz @@_i_7
  movzx bx,dl
  test ah,128
  jnz @@_i_6
  or [byte ptr ds:bx+offset keymap-1],dh
  jmp @@_exit
@@_i_6:
  not dh
  and [byte ptr ds:bx+offset keymap-1],dh
  jmp @@_exit

@@_i_7:
  test dl,dl
  jz @@_exit
  dec dl
  je @@_numlock
  dec dl
  je @@_keypad
  dec dl
  jz @@_fkeys
  dec dl
  jz @@_shifts
  dec dl
  jz @@_del
  dec dl
  jz @@_soundoff
  dec dl
  jz @@_soundon

  jmp @@_exit

@@_soundoff:
  test ah,ah
  jnz @@_exit
  mov [ports@sound],0
  jmp @@_exit

@@_soundon:
  test ah,ah
  jnz @@_exit
  mov [ports@sound],2
  jmp @@_exit

@@_fullstop:
  mov cx,0401h
  mov dx,0201h
  jmp @@_i_3

@@_numlock:
  test ah,ah
  jnz @@_nl_1
  test [flags_1],4
  jnz @@_pause
  test [flags_2],32
  jnz @@_exit
  xor [flags_1],32
  or [flags_2],32
@@_nl_1:
  and [flags_2],255-32
  jmp @@_exit

@@_pause:
  xor [flags_2],8
  in al,61h
  mov ah,al
  or al,80h
  jmp $+2
  jmp $+2
  jmp $+2
  out 61h,al
  mov al,ah
  and al,7fh
  jmp $+2
  jmp $+2
  jmp $+2
  out 61h,al
  mov al,20h
  out 20h,al
  sti
@@_pause_1:
  test [flags_2],8
  jnz @@_pause_1
  jmp @@_return

@@_keypad:
  test [flags_1],32
  jz @@_k_1
  movzx bx,dh
  add bx,bx
  add bx,bx
  mov cx,[cs:bx+offset keytrans]
  mov dx,[cs:bx+2+offset keytrans]
  jmp @@_i_3
@@_k_1:
  cmp dl,3
  je @@_down
  cmp dl,5
  je @@_left
  cmp dl,7
  je @@_right
  cmp dl,9
  je @@_up
  jmp @@_exit

@@_extended:
  mov [extended],0
  mov ah,al
  and ax,807fh
  cmp al,1ch
  je @@_enter
  cmp al,1dh
  je @@_rctrl
  cmp al,35h
  je @@_slash
  cmp al,38h
  je @@_altgr
  mov cx,0108h
  cmp al,48h
  je @@_up
  cmp al,4bh
  je @@_left
  cmp al,4dh
  je @@_right
  cmp al,50h
  je @@_down
  cmp al,53h
  je @@_del
  jmp @@_exit

@@_enter:
  mov cx,0102h
  xor dx,dx
  jmp @@_i_3
@@_slash:
  mov cx,1008h
  mov dx,0201h
  jmp @@_i_3
@@_left:
  mov dx,1005h
  jmp @@_i_3
@@_down:
  mov dx,1004h
  jmp @@_i_3
@@_up:
  mov dx,0804h
  jmp @@_i_3
@@_right:
  mov dx,0404h
  jmp @@_i_3

@@_ack:
  or [byte ptr xflags_2],16
  jmp @@_exit

@@_fkeys:
  test ah,ah
  jnz @@_exit
  mov [cs:need_int],dh
  mov [dword ptr ds:4+offset keymap],0 ;release all keys
  mov [dword ptr ds:offset keymap],0
  jmp @@_exit

@@_shifts:
  dec dh
  jz @@_lshift
  dec dh
  jz @@_rshift
  dec dh
  jz @@_lctrl
  dec dh
  jz @@_rctrl
  dec dh
  jz @@_alt
  dec dh
  jz @@_altgr
  jmp @@_exit
@@_lshift:
  mov al,ah
  shr al,6
  xor al,2
  mov bl,[flags_1]
  and bl,0fdh
  or al,bl
  mov [flags_1],al
  mov cx,0108h
  xor dx,dx
  jmp @@_i_3
@@_rshift:
  mov al,ah
  shr al,7
  xor al,1
  mov bl,[flags_1]
  and bl,0feh
  or al,bl
  mov [flags_1],al
  mov cx,0108h
  xor dx,dx
  jmp @@_i_3
@@_lctrl:
  mov al,ah
  shr al,5
  xor al,4
  mov bl,[flags_1]
  and bl,0fbh
  or bl,al
  mov [flags_1],bl
  shr al,2
  mov bl,[flags_2]
  and bl,0feh
  or bl,al
  mov [flags_2],bl
  and [xflags_1],0fbh
  jmp @@_exit
@@_rctrl:
  mov al,ah
  shr al,5
  xor al,4
  mov bl,[flags_1]
  and bl,0fbh
  or bl,al
  mov [flags_1],bl
  and [flags_2],0feh
  mov bl,[xflags_1]
  and bl,0fbh
  or bl,al
  mov [xflags_1],bl
  jmp @@_exit
@@_alt:
  mov al,ah
  shr al,4
  xor al,8
  mov bl,[flags_1]
  and bl,0f7h
  or al,bl
  mov [flags_1],al
  shr al,2
  mov bl,[flags_2]
  and bl,0fdh
  or bl,al
  mov [flags_2],bl
  and [xflags_1],0f7h
  mov cx,0201h
  xor dx,dx
  jmp @@_i_3
@@_altgr:
  mov al,ah
  shr al,4
  xor al,8
  mov bl,[flags_1]
  and bl,0f7h
  or al,bl
  mov [flags_1],al
  and [flags_2],0fdh
  mov bl,[xflags_1]
  and bl,0f7h
  or bl,al
  mov [xflags_1],bl
  mov cx,0201h
  xor dx,dx
  jmp @@_i_3

@@_del:
  mov al,[flags_1]
  not al
  and al,0ch
  jnz @@_exit
  mov [resetflag],1234h
  jmp far reset

@@_exit:
  in al,61h
  mov ah,al
  or al,80h
  jmp $+2
  jmp $+2
  jmp $+2
  out 61h,al
  mov al,ah
  and al,7fh
  jmp $+2
  jmp $+2
  jmp $+2
  out 61h,al
  mov al,20h
  out 20h,al

  mov al,[flags_1]
  shr al,4
  xor al,[xflags_2]
  and al,7
  jz @@_return
  xor [xflags_2],al              ;change LEDs

  test [xflags_2],64
  jnz @@_return
  and [xflags_2],04fh            ;reset resend, ack, error
  or [xflags_2],64
  xor cx,cx                      ;wait until keyb listens
  cli
@@_s_1:
  in al,64h
  test al,2
  loopnz @@_s_1
  mov al,0edh                    ;send command
  out 60h,al
  sti
  xor cx,cx                      ;wait for ack
@@_s_2:
  test [xflags_2],16
  loopz @@_s_2
  jz @@_s_4                      ;ack arrived?
  xor cx,cx                      ;yes, send param as well
  cli                            ;wait until keyb listens
@@_s_3:
  in al,64h
  test al,2
  loopnz @@_s_3
  mov al,[xflags_2]              ;get the LED state and
  and al,7
  out 60h,al                     ;send it
  sti
@@_s_4:
  and [xflags_2],0fh             ;turn off led update bit

@@_return:
  popf
  popa
  pop es
  pop ds
  iret
  assume ds:nothing,es:nothing

skip db 1
extended db 0
break db 0

keytrans:
  db 0,0,0,0, 0,0,0,0                                   ;nop,esc
  db 5,1,0,0, 5,2,0,0, 5,4,0,0, 5,8,0,0, 5,16,0,0       ;1..5
  db 4,16,0,0, 4,8,0,0, 4,4,0,0, 4,2,0,0, 4,1,0,0       ;6..0
  db 0,0,0,0, 0,0,0,0
  db 4,1,8,1                                            ;del
  db 0,0,0,0
  db 6,1,0,0, 6,2,0,0, 6,4,0,0, 6,8,0,0, 6,16,0,0       ;q..t
  db 3,16,0,0, 3,8,0,0, 3,4,0,0, 3,2,0,0, 3,1,0,0       ;y..p
  db 0,0,0,0, 0,0,0,0
  db 2,1,0,0                                            ;enter
  db 0,0,4,3                                            ;ctrl
  db 7,1,0,0, 7,2,0,0, 7,4,0,0, 7,8,0,0, 7,16,0,0       ;a..g
  db 2,16,0,0, 2,8,0,0, 2,4,0,0, 2,2,0,0, 2,1,0,0       ;h..›/enter
  db 0,0,0,0, 0,0,0,0
  db 0,0,4,1                                            ;left shift
  db 8,1,0,0, 8,2,0,0, 8,4,0,0, 8,8,0,0, 8,16,0,0       ;<>..v
  db 1,16,0,0, 1,8,0,0, 1,4,0,0, 1,2,0,0, 1,1,0,0       ;b.."."
  db 0,0,0,0
  db 0,0,4,2                                            ;right shift
  db 1,16,1,2                                           ;*
  db 0,0,4,5                                            ;alt
  db 1,1,0,0
  db 0,0,0,0                                            ;caps
  db 0,0,0,0, 0,0,3,2, 0,0,3,3, 0,0,3,4, 0,0,6,0        ;F1..F5
  db 0,0,7,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,3,12       ;F6..F10
  db 0,0,1,0, 0,0,0,0                                   ;num, scroll
  db 0,0,2,8, 0,0,2,9, 0,0,2,10                         ;k 7,8,9
  db 2,8,1,2                                            ;k -
  db 0,0,2,5, 0,0,2,6, 0,0,2,7                          ;k 4,5,6
  db 2,4,1,2                                            ;k +
  db 0,0,2,2, 0,0,2,3, 0,0,2,4                          ;k 1,2,3
  db 0,0,2,11, 0,0,5,0                                  ;k 0, .
  db 0,0,0,0, 0,0,0,0                                   ;???
  db 8,1,0,0                                            ;<>
  db 0,0,0,0, 0,0,3,12                                  ;F11..F12

endp int09handler


proc readjoystick near
  test [test_js],255
  jnz @@_0
  ret
@@_0:
  push ds
  pusha
  pushf
  cli
  mov ax,cs
  mov ds,ax
  assume ds:emulator
@@_1:
  in al,40h
  mov cl,al
  in al,40h
  mov ch,al
  mov si,cx
  mov dx,0201h
  out dx,al             ;trigger joystick
  mov ah,3              ;mask for both directions
@@_2:
  in al,dx              ;wait until one direction clicks
  and al,ah
  cmp al,ah
  je @@_2
  mov ah,al             ;now just look for the other bit
  in al,40h             ;store time in cx
  mov cl,al
  in al,40h
  mov ch,al
  test ah,ah            ;both clicked?
  jnz @@_3
  mov bx,cx             ;yes, say same time
  jmp @@_4
@@_3:
  in al,dx              ;wait until other direction clicks
  test al,ah
  jnz @@_3
  in al,40h             ;store time in bx
  mov bl,al
  in al,40h
  mov bh,al
  test ah,1             ;put x in bx, y in cx
  jnz @@_4
  xchg bx,cx
@@_4:
  mov ax,si             ;compute proper delays
  sub ax,bx
  mov bx,ax
  sub si,cx
  mov cx,si
  cmp bx,2000           ;don't use data if int occured
  ja @@_9
  cmp bx,30
  jb @@_9
  cmp cx,2000
  ja @@_9
  cmp cx,30
  jb @@_9
  xor al,al             ;convert to kempston data
  cmp cx,600            ;y ctr below up trigger?
  jae @@_5
  or al,8               ;yes, set bit 0
@@_5:
  cmp cx,1300           ;y ctr above down trigger?
  jbe @@_6
  or al,4               ;yes, set bit 1
@@_6:
  cmp bx,600            ;x ctr low below up trigger?
  jae @@_7
  or al,2               ;yes, set bit 2
@@_7:
  cmp bx,1300           ;x ctr above right trigger?
  jbe @@_8
  or al,1               ;yes, set bit 3
@@_8:
  mov [kempston],al
@@_9:
  popf
  popa
  pop ds
  assume ds:nothing
  ret

endp readjoystick

assume ds:nothing


proc ports$init far
  push ds
  pusha
  pushf

ifdef exact
  call opentape
endif

  mov dx,0201h
  out dx,al             ;trigger joystick
  mov ah,3              ;mask for both directions
  xor cx,cx
@@_1:
  in al,dx              ;wait until one direction clicks
  and al,ah
  cmp al,ah
  loope @@_1            ;loop if neither bit 0 & cx>0
  jcxz @@_4             ;time-out -> no joystick
@@_2:
  in al,dx              ;wait for the other direction
  and al,ah
  loopne @@_2
  jcxz @@_4             ;never clicked -> no joystick

  cmp cx,65500          ;loop counter still unreasonably high?
  ja @@_4               ;yes -> no joystick

  xor ah,ah
@@_3:
  in al,dx              ;wait for cx to time out
  or ah,al
  loop @@_3
  test ah,3
  jnz @@_4              ;non-zero -> no joystick

  mov [ports@js_present],255 ;AOK -> say we have a joystick
  jmp @@_5

@@_4:
  mov [ports@js_present],0

@@_5:
  popf
  popa
  pop ds
  ret
endp ports$init

ifdef exact
ports@exact db 1
else
ports@exact db 0
endif

ports@js_present db 0

test_js db 0

ports@border db 0

ports$:
  dd ports$init
  dd -1

ends ports

end