PC speaker, timer reprogramming / ISR, fix IN and OUT instructions

This commit is contained in:
Jeremy Penner 2023-09-28 22:07:10 -04:00
parent dd6cfe85cd
commit 47d14694c7
11 changed files with 134 additions and 24 deletions

10
asm.jrt
View file

@ -334,14 +334,14 @@ var ignoreimm
: AX? oparg-reg? oparg-val @ 0x00 = and ; : AX? oparg-reg? oparg-val @ 0x00 = and ;
: >inout* ( base ) : >inout* ( base )
arg2 oparg-reg? oparg-val @ 0x03 ( DX ) = and arg1 if oparg-reg? oparg-val @ 0x03 ( DX ) = and swap-args if
AL? if 8 + >t 2ret then AL? if 8 + >t 2ret then
AX? if 9 + >t 2ret then AX? if 9 + >t 2ret then
then then
arg2 oparg-imm? arg1 if swap-args oparg-imm? swap-args if
AL? if >t oparg-val @ >t 2ret then AL? if swap-args >t oparg-val @ >t 2ret then
AX? if 1+ >t oparg-val @ >t 2ret then AX? if swap-args 1+ >t oparg-val @ >t 2ret then
then ; then ;
2 :op IN 0xe4 >inout* ; 2 :op IN arg2 0xe4 >inout* ;
2 :op OUT 0xe6 >inout* ; 2 :op OUT 0xe6 >inout* ;

Binary file not shown.

27
beep.jrt Executable file
View file

@ -0,0 +1,27 @@
import timer.jrt
:asm >spk ( div -- )
MOV AL 0xb6 #
OUT 0x43 # AL
POP AX
OUT 0x42 # AL
MOV AL AH
OUT 0x42 # AL
IN AL 0x61 #
OR AL 0x03 #
OUT 0x61 # AL
NEXT
:asm silence ( -- )
IN AL 0x61 #
AND AL 0xfc #
OUT 0x61 # AL
NEXT
: slide ( div count + -- )
>r begin over >spk 1 sleep-csec swap r@ + swap 1- dup not until
rdrop drop drop silence ;
: boop ( div count -- ) swap >spk sleep-csec silence ;
: noise ( count -- )
begin rand >spk 1 sleep-csec 1- dup not until drop silence ;

9
common.jrt Executable file
View file

@ -0,0 +1,9 @@
import text.jrt
import keys.jrt
import random.jrt
: !+ ( v p -- ) dup @ <rot + swap ! ;
: b!+ ( v p -- ) dup b@ <rot + swap b! ;
: b!| ( f p -- ) dup b@ <rot | swap b! ;
: b!^ ( f p -- ) dup b@ <rot ^ swap b! ;
: ~ 0xffff ^ ;

View file

@ -16,8 +16,8 @@ We start with MINIJORT.EXE, compiled with Borland Turbo C++ from MINIJORT.C
and MAIN.C. This is a stripped-down version of the Jorth engine that Neut and MAIN.C. This is a stripped-down version of the Jorth engine that Neut
Tower[1] was built with, and the only part of this project that existed in Tower[1] was built with, and the only part of this project that existed in
any form before August 14, 2023. (I started early on the jam because I any form before August 14, 2023. (I started early on the jam because I
basically knew what I wanted to implement, and I knew that getting _anything_ basically knew what I wanted to implement, and with the absurd plan I had in
playable by the end of September with the absurd plan I had in mind was mind, I knew that getting _anything_ playable by the end of September was
going to be a long shot.) MINIJORT.EXE is a simple Forth interpreter that going to be a long shot.) MINIJORT.EXE is a simple Forth interpreter that
loads BOOT.JOR and then reads the rest of its input from stdin. loads BOOT.JOR and then reads the rest of its input from stdin.

BIN
swine.com

Binary file not shown.

View file

@ -1,12 +1,10 @@
import text.jrt import timer.jrt
import keys.jrt import beep.jrt
import random.jrt
: !+ ( v p -- ) dup @ <rot + swap ! ; : meep 2000 5 -80 slide ;
: b!+ ( v p -- ) dup b@ <rot + swap b! ; : moop 1600 5 80 slide ;
: b!| ( f p -- ) dup b@ <rot | swap b! ; : boom 40 noise ;
: b!^ ( f p -- ) dup b@ <rot ^ swap b! ; : click 2000 3 boop 4000 3 boop ;
: ~ 0xffff ^ ;
0 const IN-PROGRESS 0 const IN-PROGRESS
1 const CANCEL 1 const CANCEL
@ -114,10 +112,13 @@ var neighbour-check
: reveal-unflagged-neighbours? ( p -- ) : reveal-unflagged-neighbours? ( p -- )
dup square-pos count-surrounding-flags over squarecount = dup square-pos count-surrounding-flags over squarecount =
if square-pos ' reveal do-neighbour-squares else drop then ; if click square-pos ' reveal do-neighbour-squares else drop then ;
: reveal-at square-at dup revealed? : reveal-at square-at dup revealed?
if reveal-unflagged-neighbours? else reveal then autoreveal check-win ; if reveal-unflagged-neighbours? else reveal click then
: flag-at square-at dup revealed? not if FFLAG swap b!^ else drop then ; autoreveal check-win ;
: flag-noise ( p -- ) b@ FFLAG & if moop else meep then ;
: flag-at square-at dup revealed? not
if FFLAG swap dup flag-noise b!^ else drop then ;
( theming ) ( theming )
array countcolors white b, lblue b, lgreen b, red b, blue b, array countcolors white b, lblue b, lgreen b, red b, blue b,
@ -269,10 +270,11 @@ var current-menu
5 popupbox ( x ) 10 textxy! draw-spaced-text 5 popupbox ( x ) 10 textxy! draw-spaced-text
wait-key drop ; wait-key drop ;
: fanfare meep moop meep moop meep moop meep ;
: display-result : display-result
game-state b@ game-state b@
dup WON = if green bg! lcyan fg! s" YOU WON" 26 result-message then dup WON = if fanfare green bg! lcyan fg! s" YOU WON" 26 result-message then
LOST = if red bg! yellow fg! s" YOU LOST" 25 result-message then ; LOST = if boom red bg! yellow fg! s" YOU LOST" 25 result-message then ;
2 :noname blue bg! lgray fg! 4 popupbox ; defmenu quitmenu 2 :noname blue bg! lgray fg! 4 popupbox ; defmenu quitmenu
' leave s" Return to game" 0 defitem ' leave s" Return to game" 0 defitem
@ -285,7 +287,7 @@ var current-menu
begin draw-game await-command confirm-quit in-progress? not until begin draw-game await-command confirm-quit in-progress? not until
draw-board display-result enter ; draw-board display-result enter ;
: start init-board play ; : start init-board boardw @ 2/ cursx b! boardh @ 2/ cursy b! play ;
( title menu ) ( title menu )
array title-text t", SWINE MEEPER" array title-text t", SWINE MEEPER"
@ -316,7 +318,9 @@ array title-text t", SWINE MEEPER"
' theme-menu s" Themes" 2 defitem ' theme-menu s" Themes" 2 defitem
' leave s" Quit" 3 defitem ' leave s" Quit" 3 defitem
: title textmode reseed! hidecursor title-menu textmode ; : title install-timer textmode reseed! hidecursor
title-menu
textmode uninstall-timer ;
' title ' main redefine ' title ' main redefine

68
timer.jrt Executable file
View file

@ -0,0 +1,68 @@
: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: @+ ; }
:asm get-cseg
PUSH CS
NEXT
: 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 0x03 #
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
: sleep-csec ( cs -- )
timer @ + begin dup timer @ <= until drop ;
: install-timer 0xffff 2 >> set-timer-div timer-isr install-isr ;
: uninstall-timer 0xffff set-timer-div timer-isr uninstall-isr ;

Binary file not shown.

View file

@ -162,5 +162,7 @@ dbg" boot"
MOV BP 0x00 # MOV BP 0x00 #
NEXT NEXT
} import common.jrt {
here s", zipstub.seg" s" zipoff.com" writeenv here s", zipstub.seg" s" zipoff.com" writeenv

Binary file not shown.