TriOS-alt/forth/v1.mod

326 lines
8.9 KiB
Modula-2
Raw Normal View History

2011-11-11 17:41:02 +01:00
: mod:vortrag ;
24 constant rows
64 constant cols
wvariable lcol 7 lcol W!
ifnot: adm:fkt!s!b@ \ ( s fkt -- b )
: adm:fkt!s!b@ b[ [a!] [a.s!] [a@] ]b ;
ifnot: adm:fkt!b!b@ \ ( b fkt -- b )
: adm:fkt!b!b@ b[ [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!b@ \ ( fkt -- b )
: adm:fkt!b@ b[ [a!] [a@] ]b ;
ifnot: bel:char \ ( b -- )
: bel:char b[ [b!] ]b ;
ifnot: bel:ctrl!b! \ ( b ctrl -- )
: bel:ctrl!b! b[ 0 [b!] 3 [b!] [b!] [b!] ]b ;
ifnot: bel:fkt!b!b! \ ( b b fkt -- )
: bel:fkt!b!b! b[ 0 [b!] [b!] [b!] [b!] ]b ;
ifnot: scr:bs \ ( -- ) - backspace
: scr:bs 08 bel:char ;
ifnot: scr:tab \ ( -- ) - tabulator
: scr:tab 09 bel:char ;
ifnot: scr:pos1 \ ( -- ) - cursor an zeilenanfang
: scr:pos1 03 bel:char ;
ifnot: scr:setcol \ ( colnr -- ) - farbe w<EFBFBD>hlen 0..15
: scr:setcol 06 bel:ctrl!b! ;
ifnot: scr:sline \ ( row -- ) - anfangszeile scrollbereich
: scr:sline 07 bel:ctrl!b! ;
ifnot: scr:setx \ ( x -- ) - cursor position x setzen
: scr:setx 02 bel:ctrl!b! ;
ifnot: scr:sety \ ( y -- ) - cursor position y setzen
: scr:sety 03 bel:ctrl!b! ;
ifnot: scr:curon \ ( -- ) - cursor anschalten
: scr:curon 04 bel:char ;
ifnot: scr:curoff \ ( -- ) - cursor abschalten
: scr:curoff 05 bel:char ;
ifnot: scr:logo \ ( y x -- ) - hive logo
: scr:logo 5 bel:fkt!b!b! ;
\ adm:setsound ( sfkt -- sstat ) - soundsystem verwalten
\ sfkt:
\ 0: hss-engine abschalten
\ 1: hss-engine anschalten
\ 2: dac-engine abschalten
\ 3: dac-engine anschalten
\ sstat - status/cognr startvorgang
ifnot: adm:setsound
: adm:setsound
5C adm:fkt!b!b@ ;
\ wav:start ( cstr -- err )
ifnot: wav:start
: wav:start
96 adm:fkt!s!b@ ;
\ wav:stop ( -- )
ifnot: wav:stop
: wav:stop
97 adm:fkt!b@ drop ;
\ won
ifnot: won
: won
0 adm:setsound 3 adm:setsound 2drop ;
\ woff
ifnot: woff
: woff
2 adm:setsound 1 adm:setsound 2drop ;
: lcol@ lcol W@ ; \ ( -- col )
: lines \ ( n -- )
0 do cr loop ;
: waitkey
scr:curoff cr key drop scr:bs scr:bs scr:bs scr:curon ;
: nextpage
scr:curoff scr:pos1 lcol@ spaces ." -->" key drop scr:bs scr:bs scr:bs scr:curon ;
: .head \ ( -- )
4 scr:setcol scr:pos1 lcol@ spaces ;
: .bullet \ ( -- )
0 scr:setcol scr:pos1 lcol@ spaces 0f emit space ;
: .number \ ( n -- n )
0 scr:setcol scr:pos1 lcol@ spaces dup . 1+
2e emit space ;
: .line \ ( -- )
cr 0 scr:setcol scr:pos1 lcol@ 2+ spaces ;
: .sub \ ( -- )
0 scr:setcol scr:pos1 lcol@ 2+ spaces ;
wvariable xpos 1 xpos W!
wvariable ypos 1 ypos W!
: pos! \ ( x y -- )
ypos W! xpos W! ;
: pos@ \ ( -- x y )
xpos W@ ypos W@ ;
: nextline
ypos W@ 1+ ypos W! ;
: move \ ( x y -- )
1 delms pos@ scr:sety scr:setx ;
: btop0 \ ( -- )
move 9f emit 6 0 do 90 emit loop 9e emit nextline ;
: bbot0 \ ( -- )
move 9d emit 6 0 do 90 emit loop 9c emit nextline ;
: btop1 \ ( -- )
move 2 spaces 9f emit 6 0 do 90 emit loop 9e emit nextline ;
: bbot1 \ ( -- )
move 2 spaces 9d emit 6 0 do 90 emit loop 9c emit nextline ;
: bmid0 \ ( -- )
move 91 emit ." COG " 95 emit 90 emit bb emit nextline
move 91 emit ." " 95 emit 90 emit aa emit nextline ;
: bmid1 \ ( -- )
move a9 emit 90 emit 94 emit ." COG " 91 emit nextline
move ba emit 90 emit 94 emit ." " 91 emit nextline ;
: bmid2 \ ( -- )
move a9 emit 90 emit 94 emit ." SER "
95 emit 90 emit bb emit ." [TERMINAL]" nextline
move ba emit 90 emit 94 emit ." " 91 emit nextline ;
: bmid3 \ ( -- )
move a9 emit 90 emit 94 emit ." VGA "
95 emit 90 emit bb emit ." [BELLATRIX]" nextline
move ba emit 90 emit 94 emit ." KBD " 91 emit nextline ;
: bmid4 \ ( -- )
move 91 emit ." COG " 95 emit 90 emit bb emit
." Zeichenausgabekanal (emit)" nextline
move 91 emit ." " 95 emit 90 emit aa emit
." Zeicheneingabekanal (key)" nextline ;
: cog0 \ ( x y -- )
0 scr:setcol pos! btop0 bmid0 bbot0 ;
: cog1 \ ( x y -- )
0 scr:setcol pos! btop1 bmid1 bbot1 ;
: cog3 \ ( x y -- )
0 scr:setcol pos! btop0 bmid4 bbot0 ;
: cogext \ ( x y -- )
0 scr:setcol pos! btop1 bmid2 bbot1 ;
: cogint \ ( x y -- )
0 scr:setcol pos! btop1 bmid3 bbot1 ;
: drvser
0 scr:setcol 2dup cog0 swap a + swap cogext ;
: drvint
0 scr:setcol 2dup cog0 swap a + swap cogint ;
: p0
0 scr:sline cls 5 lines
14 1c scr:curoff scr:logo won c" woodz.wav" wav:start drop
key drop scr:curon wav:stop woff ;
: i1
0 scr:sline cls 3 lines
.head ." Implementierungsvarianten" cr waitkey
.bullet ." Forth-Diamond: Master & Slaves = PropForth" waitkey cr
.sub ." Nachteil: Programmierung aller Treiber in Forth" waitkey cr
.bullet ." Forth-Spin: Forth mit SPIN-Interface" waitkey cr
.sub ." Vorteil: Nutzung fertiger Treiber" waitkey
.sub ." Nachteil: hoher Ressourcenverbrauch" waitkey cr
.bullet ." Forth-Funktionskomplexe: " cr cr
.sub ." Master = Forth" cr
.sub ." Slaves = Spin-Funktionsbibliotheken" cr
.sub ." Interface Forth <--> Spin = 8Bit-Bus" cr cr
nextpage ;
: i2
0 scr:sline cls 3 lines
.head ." Implementierungsvarianten" cr cr
.bullet ." Forth-Funktionskomplexe: " cr cr
.sub ." Master = Forth" cr
.sub ." Slaves = Spin-Funktionsbibliotheken" cr
.sub ." Interface Forth <--> Spin = 8Bit-Bus" cr waitkey
.bullet ." Nachteile:" cr cr
.sub ." Spin --> Compiler noch auf Host" cr waitkey
.bullet ." Vorteile:" cr cr
.sub ." Code ist schon vorhanden (TriOS)" waitkey
.sub ." Gegenseitige Befruchtung von Forth & TriOS" waitkey
.sub ." Maximale Ressourcen f<>r Forth im Master" waitkey
.sub ." Spin-Code kann sp<73>ter auch durch Forth ersetzt werden" cr
nextpage ;
: i3
0 scr:sline cls 3 lines
.head ." Ablauf der Implementierung" cr waitkey
.bullet ." Ausgangslage: " cr cr
.sub ." Forth mit Terminalzugriff" cr waitkey
.bullet ." Plan:" cr cr
.sub ." 1. Busroutine um auf Slaves zuzugreifen" waitkey
.sub ." 2. Integration VGA/Keyboard/SD-Card" waitkey
.sub ." 3. Autostart" cr cr
nextpage ;
: p1
0 scr:sline cls 1 lines
.head ." Buszugriff" cr cr
.bullet ." ! ( n adr -- ) store - Wert im RAM speichern" cr
.bullet ." @ ( adr -- n ) fetch - Wert aus RAM lesen" cr waitkey
.bullet ." c! c@ p! p@ - Abwandlungen der Grundform" cr waitkey
.bullet ." s! ( c adr -- ) - Byte an Slave senden" cr
.bullet ." s@ ( adr -- c ) - Byte von Slave empfangen" cr waitkey
.bullet ." b! ( c -- ) - Byte an Bellatrix senden" cr
.bullet ." b@ ( -- c ) - Byte von Bellatrix empfangen" cr
.bullet ." a! ( c -- ) - Byte an Administra senden" cr
.bullet ." a@ ( -- c ) - Byte von Administra empfangen" cr cr
.head ." Beispiele :" cr cr
.bullet ." 01 b! - Bildschirm l<>schen" waitkey
.bullet ." : cls 01 b! ; " waitkey
.bullet ." : bel:key 0 b! 2 b! b@ ; \ ( -- key )" cr
nextpage ;
: p2
0 scr:sline cls 5 lines
.head ." IO-Kan<61>le/Pipes" cr waitkey
9 8 cog3 key drop
9 c cog3
.line ." ..."
9 11 cog3
cr cr
nextpage ;
: p3
0 scr:sline cls 5 lines
.head ." Serieller Treiber" cr cr
9 8 drvser
9 c cog3
.line ." ..."
9 11 cog3
cr cr
nextpage ;
: p4
0 scr:sline cls 5 lines
.head ." VGA/Keyboard-Treiber" cr cr
9 8 drvser
9 c drvint
.line ." ..."
9 11 cog3
cr cr
nextpage ;
: p5
0 scr:sline cls 5 lines
.head ." Treiber: VGA" cr cr
9 8 drvint cr
.line ." : drv-vga "
.line ." begin"
.line ." key?"
.line ." if key b! then"
.line ." 0 until ;"
cr cr
nextpage ;
: p6
0 scr:sline cls 5 lines
.head ." Treiber: Keyboard" cr cr
9 8 drvint cr
.line ." : drv-key"
.line ." begin"
.line ." bel:keystat"
.line ." if bel:key emit then"
.line ." 0 until ;"
cr cr
nextpage ;
: p7
0 scr:sline cls 5 lines
.head ." Treiber: Gesamt" cr cr
9 8 drvint cr
.line ." : drv:int"
.line ." begin"
.line ." \ input --> vga/video"
.line ." 200 0 do key?"
.line ." if key b[ [b!] ]b then loop"
.line ." \ output <-- keyboard"
.line ." b[ [key?]"
.line ." if [key] [emit] then ]b"
.line ." 0 until ;"
cr cr
nextpage ;
: p8
0 scr:sline cls 5 lines
.head ." Semaphoren" cr waitkey
.bullet ." : bel:key 0 b! 2 b! b@ ; \ ( -- key )" cr waitkey
.bullet ." : bel:key bon 0 b! 2 b! b@ boff ;" cr waitkey
.bullet ." [ ... ]" cr waitkey
.bullet ." b[ ... ]b" cr waitkey
.bullet ." : bel:key b[ 0 b! 2 b! b@ ]b ;" cr waitkey
.bullet ." : bel:key b[ 0 [b!] 2 [b!] [b@] ]b ;" cr waitkey
.bullet ." : bel:key 2 0 b[ [b!] [b!] [b@] ]b ;" cr cr
cr cr
nextpage ;
: run
begin p0 i1 i2 i3 p1 p2 p3 p4 p5 p6 p7 p8 0 until ;