- Integration von PropForth in TriOS

- Systemstart: Code für alle drei Chips kommen jetzt aus den EEPROMS
- Bellatrix: PASM-Loader
- Bellatrix: Multiscreen-Version (3 unabhängige Screens)
- Bellatrix: Egalisierte Steuerzeichen für bessere Nebenläufigkeit
This commit is contained in:
drohne235@googlemail.com 2011-04-23 21:02:22 +00:00
parent ea7adb9397
commit a385171c9f
85 changed files with 5830 additions and 60 deletions

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,90 @@
hex
ifnot: lib:adm
: lib:adm ;
\ kommandoformen
ifnot: adm:fkt! \ ( fkt -- )
: adm:fkt! b[ [a!] ]b ;
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b@ \ ( fkt -- b )
: adm:fkt!b@ b[ 0 [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!b!b@ \ ( b fkt -- b )
: adm:fkt!b!b@ b[ [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!l@ \ ( fkt -- l )
: adm:fkt!l@ b[ [a!] [a.l@] ]b ;
ifnot: adm:fkt!s! \ ( s fkt -- )
: adm:fkt!s! b[ [a!] [a.s!] ]b ;
\ administra-chipmanagment-funktionen
\ 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@ ;
\ adm:getspec ( -- spec ) - chipspezifikation abfragen
\
\ +---------- com
\ | +-------- i2c
\ | |+------- rtc
\ | ||+------ lan
\ | |||+----- sid
\ | ||||+---- wav
\ | |||||+--- hss
\ | ||||||+-- bootfähig
\ | |||||||+- dateisystem
\ %00000000_00000000_00000000_01001111
ifnot: adm:getspec
: adm:getspec
5D adm:fkt!l@ ;
\ adm:setsyssound ( syssnd -- ) - systemklänge
\ syssnd = 0 - systemklänge aus
\ syssnd = 1 - systemklänge an
ifnot: adm:setsyssound
: adm:setsyssound
5E adm:fkt!b! ;
\ adm:getsoundsys ( -- sndsys ) - abfrage aktives soundsystem
\ 0 - sound aus
\ 1 - hss
\ 2 - wav
ifnot: adm:getsoundsys
: adm:getsoundsys
5F adm:fkt!b@ ;
\ adm:load ( cstr -- ) - neuen administra-code laden
ifnot: adm:aload
: adm:aload
60 adm:fkt!s! ;
\ adm:getcogs ( -- cogs ) - anzahl der belegten cogs
ifnot: adm:getcogs
: adm:getcogs
61 adm:fkt!b@ ;
\ adm:getver ( -- ver ) - abfrage der codeversion
ifnot: adm:getver
: adm:getver
62 adm:fkt!l@ ;
\ adm:reset ( -- ) - reset administra
ifnot: adm:reset
: adm:reset
63 adm:fkt! ;

Binary file not shown.

View File

@ -0,0 +1,55 @@
hex
ifnot: lib:ari
: lib:ari ;
\ abs ( n1 -- abs_n1 ) absolute value of n1
ifnot: abs
: abs _execasm1>1 151 _cnip ;
\ u*/mod ( u1 u2 u3 -- u4 u5 ) u5 = (u1*u2)/u3, u4 is the
\ remainder. Uses a 64bit intermediate result.
ifnot: u*/mod
: u*/mod rot2 um* rot um/mod ;
\ u*/ ( u1 u2 u3 -- u4 ) u4 = (u1*u2)/u3 Uses a 64bit
\ intermediate result.
ifnot: u*/
: u*/ rot2 um* rot um/mod nip ;
\ sign ( n1 n2 -- n3 ) n3 is the xor of the sign bits of
\ n1 and n2
ifnot: sign
: sign xor 80000000 and ;
\ */mod ( n1 n2 n3 -- n4 n5 ) n5 = (n1*n2)/n3, n4 is the
\ remainder. Uses a 64bit intermediate result.
ifnot: */mod
: */mod 2dup sign >r abs rot dup r> sign >r abs rot abs
um* rot um/mod r> if negate swap negate swap then ;
\ */ ( n1 n2 n3 -- n4 ) n4 = (n1*n2)/n3. Uses a 64bit
\ intermediate result.
ifnot: */
: */ */mod nip ;
\ /mod ( n1 n2 -- n3 n4 ) \ signed divide & mod n4 = n1/n2,
\ n3 is the remainder
ifnot: /mod
: /mod 2dup sign >r abs swap abs swap u/mod r> if negate swap
negate swap then ;
\ * ( n1 n2 -- n1*n2) n1 multiplied by n2
ifnot: *
: * um* drop ;
\ / ( n1 n2 -- n1/n2) n1 divided by n2
ifnot: /
: / /mod nip ;
\ rnd ( -- n1 ) n1 is a random number from 00 - FF
ifnot: rnd
: rnd cnt COG@ 8 rshift cnt COG@ xor FF and ;

Binary file not shown.

View File

@ -0,0 +1,485 @@
fl
hex
: mod:basics ;
\ Copyright (c) 2010 Sal Sanci
\ Anpassung für Hive-System 2011 dr235
\ ------------------------------------------------------ BASICS
\ this words needs to align with the assembler code
: _stptr 5 _cv ;
: _sttop 2e _cv ;
\ _words ( cstr -- )
: _words lastnfa
begin
2dup swap dup if npfx else 2drop -1 then
if dup .strname space then
nfa>next dup 0=
until 2drop cr ;
\ words name ( -- ) prints the words in the forth dictionary
: words parsenw _words ;
\ .long ( n -- ) emit 8 hex digits
: .long dup 10 rshift .word .word ;
\ st? ( -- ) prints out the stack
: st? ." ST: " _stptr COG@ 2+ dup _sttop <
if _sttop swap - 0
do _sttop 2- i - COG@ .long space loop
else drop
then cr ;
\ variable ( -- ) skip blanks parse the next word and create
\ a variable, allocate a long, 4 bytes
: variable
lockdict create $C_a_dovarl w, 0 l, forthentry freedict ;
\ constant ( x -- ) skip blanks parse the next word and create
\ a constant, allocate a long, 4 bytes
: constant
lockdict create $C_a_doconl w, l, forthentry freedict ;
\ waitpeq ( n1 n2 -- ) \ wait until state n1 is equal to
\ ina anded with n2
: waitpeq _execasm2>0 1E0 _cnip ;
\ locknew ( -- n2 ) allocate a lock, result is in n2, -1
\ if unsuccessful
: locknew -1 4 hubop -1 = if drop -1 then ;
\ (forget) ( cstr -- ) wind the dictionary back to the word
\ which follows - caution
: (forget) dup
if
find if
pfa>nfa nfa>lfa dup here W! W@ wlastnfa W!
else .cstr 3f emit cr then
else drop then ;
\ forget ( -- ) wind the dictionary back to the word which
\ follows - caution
: forget parsenw (forget) ;
\ free ( -- ) display free main bytes and current cog longs
: free dictend W@ here W@ - . ." bytes free - " par
coghere W@ - . ." cog longs free" cr ;
\ ifnot: name ( -- ) - bedingte compilierung; wenn name schon
\ im wörterbuch vorhanden, wird bis zum nächsten semikolon
\ der eingabestrom ignoriert
: ifnot: parsenw nip find if begin key 3B = until
key drop then ;
\ bei konstrukte, die keine doppelpunkdefinition sind, muss der
\ block mit diesem Wort abgeschlossen werden
: :; ;
\ --------------------------------------------------------- BUS
\ bin ( -- ) - umschaltung auf duales zahlensystem
\ : bin 2 base W! ;
\ +---------------------------- /hs
\ |+--------------------------- /wr
\ ||+-------------------------- busclk
\ |||+------------------------- hbeat
\ ||||+------------------------ al
\ |||||+----------------------- /bel
\ ||||||+---------------------- /adm
\ |||||||+--------------------- /ram2
\ ||||||||+-------------------- /ram1
\ ||||||||| +--------- a0..10
\ ||||||||| |
\ ||||||||| | +- d0..7
\ |||||||||+---------++------+
\ 00000000000000000000000000000000
\ bin 00000111111111111111111100000000 constant dinp hex
\ bin 00000111111111111111111111111111 constant dout hex
\ bin 00000010000000000000000000000000 constant boff hex
\ bin 00000100011110000000000000000000 constant _s1 hex
\ bin 00000000001110000000000000000000 constant _b1 hex
\ bin 00000010001110000000000000000000 constant _b2 hex
\ bin 00000110001110000000000000000000 constant _b3 hex
\ bin 00000000010110000000000000000000 constant _a1 hex
\ bin 00000010010110000000000000000000 constant _a2 hex
\ bin 00000110010110000000000000000000 constant _a3 hex
\ bin 00001000000000000000000000000000 constant ?hs hex
8000000 constant ?hs
: [inp] \ ( -- ) bus eingabe
7FFFF00 dira COG! ; \ dinp
: [out] \ ( -- ) bus ausgabe
7FFFFFF dira COG! ; \ dout
: [off] \ ( -- ) bus aus
2000000 dira COG! 0 outa COG! ; \ boff
: [end] \ ( -- ) buskommunikation beendet
4780000 outa COG! [inp] ; \ _s1
: [hs=1] \ ( -- ) wartet auf hs = 1
?hs dup waitpeq ;
: [hs=0] \ ( -- ) warten auf hs = 0
0 ?hs waitpeq ;
: [s!] \ ( c ctrl -- ) sende 8 bit an einen slave
[out] [hs=1] swap ff and or outa COG! [hs=0] [end] ;
: [s@] \ ( ctrl -- c ) empfängt 8 bit von einem slave
[inp] [hs=1] outa COG! [hs=0] ina COG@ ff and [end] ;
: [b!] \ ( c -- ) sende 8 bit an bellatrix
2380000 [s!] ; \ _b2
: [a!] \ ( c -- ) sende 8 bit an administra
2580000 [s!] ; \ _a2
: [b@] \ ( -- c ) empfängt 8 bit von bellatrix
6380000 [s@] ; \ _b3
: [a@] \ ( -- c ) empfängt 8 bit von administra
6580000 [s@] ; \ _a3
: <8 \ ( -- )
8 lshift ;
\ [b.l!] ( 32b -- ) - long an bellatrix senden
: [b.l!]
dup 18 rshift [b!]
dup 10 rshift [b!]
dup 8 rshift [b!]
[b!] ;
\ [b.l@] ( -- 32b ) - long von bellatrix einlesen
: [b.l@]
[b@] <8
[b@] or <8
[b@] or <8
[b@] or ;
\ [a.s@] ( -- ) - einen cstring von administra empfangen
\ und im pad speichern
: [a.s@]
[a@] pad 2dup C! 1+ swap
0 do dup [a@] swap C! 1+ loop drop ;
\ [a.s!] ( cstr -- ) - einen cstring an administra senden
: [a.s!]
dup C@ dup [a!] \ ( -- cstr len ) len senden
0 do \ ( cstr len -- cstr )
1+ dup C@ [a!] \ ( cstr -- cstr+1 ) zeichen senden
loop drop ; \ ( cstr -- )
\ [a.w@] ( -- 16b ) - 16bit-wert von administra einlesen
: [a.w@]
[a@] <8 [a@] or ;
\ [a.l!] ( 32b -- ) - long an administra senden
: [a.l!]
dup 18 rshift [a!]
dup 10 rshift [a!]
dup 8 rshift [a!]
[a!] ;
\ [a.l@] ( -- 32b ) - long von administra einlesen
: [a.l@]
[a@] <8
[a@] or <8
[a@] or <8
[a@] or ;
wvariable b[lock] \ nummer der semaphore für den
\ zugriff auf die bus-hardware
\ b[ ( -- ) bus belegen; wartet bis semaphore freigegeben ist
: b[ begin b[lock] W@ lockset -1 <> until [inp] ;
\ ]b ( -- ) bus freigeben
\ ! busclk bleibt auf ausgabe, da dieses signal sonst
\ kein definierten pegel besitzt !
: ]b [off] b[lock] W@ lockclr drop ;
\ administra-kommandoformate
: b[a! b[ [a!] ;
: b[a!a! b[ [a!] [a!] ;
: adm:fkt! b[a! ]b ; \ ( fkt -- )
: adm:fkt!b@ b[a! [a@] ]b ; \ ( fkt -- b )
: adm:fkt!b! b[a!a! ]b ; \ ( b fkt -- )
: adm:fkt!b!b@ b[a!a! [a@] ]b ; \ ( b fkt -- b )
: adm:fkt!s@ b[a! [a.s@] ]b ; \ ( fkt -- )
: adm:fkt!s!b@ b[a! [a.s!] [a@] ]b ; \ ( s fkt -- b )
: adm:fkt!b!l@ b[a!a! [a.l@] ]b ; \ ( b fkt -- l )
\ ----------------------------------------------------- SD0.LIB
\ marker-funktionen
\ adm:dmact ( dmnr -- ) - marker aktivieren
: adm:dmact 19 adm:fkt!b!b@ drop ;
\ adm:dmset ( dmnr -- ) - marker setzen
: adm:dmset 1A adm:fkt!b! ;
\ dateisystem-funktionen
\ adm:volname ( -- ) - name des volumes im pad ablegen
: adm:volname 0C adm:fkt!s@ ;
\ adm:mount ( -- err ) - medium mounten
: adm:mount 01 adm:fkt!b@ ;
\ adm:unmount ( -- err ) - medium unmounten
: adm:unmount 18 adm:fkt!b@ ;
\ adm:checkmounted ( -- t/f )
: adm:checkmounted 0D adm:fkt!b@ ;
\ adm:diropen ( -- ) - verzeichnisabfrage initialisieren
: adm:diropen 02 adm:fkt! ;
\ adm:nextfile ( -- st )
\ st = 0 - keine gültige datei
\ st = 1 - dateiname im pad gültig
\ bei gültigem eintrag befindet sich der dateiname im pad
: adm:nextfile b[ 3 [a!] [a@] dup if [a.s@] then ]b ;
\ adm:fattrib ( nr -- attrib ) - dateiattribut abfragen
: adm:fattrib 0B adm:fkt!b!l@ ;
\ adm:chdir ( cstr -- err ) - verzeichnis öffnen
: adm:chdir 16 adm:fkt!s!b@ ;
\ adm:getc ( -- c ) - ein zeichen aus der geöffneten datei lesen
: adm:getc 06 adm:fkt!b@ ;
\ adm:eof ( -- eof ) - abfrage ob end of file erreicht ist
: adm:eof 1E adm:fkt!b@ ;
\ adm:open ( cstr modus -- err ) - datei öffnen
\ modus "R" $52 - Read
\ modus "W" $57 - Write
\ modus "A" $41 - Append
: adm:open b[ 4 [a!] [a!] [a.s!] [a@] ]b ;
\ adm:close ( -- ) - datei schließen
: adm:close 05 adm:fkt!b@ ;
\ ----------------------------------------------------- SCR.LIB
\ [dscr] ( scrnr -- ) display-screen setzen
: [dscr] 0 [b!] 59 [b!] [b!] ;
\ [wscr] ( scrnr -- ) schreib-screen setzen
: [wscr] 0 [b!] 58 [b!] [b!] ;
\ [key?] ( -- c ) - ungekapselte tastaturstatusabfrage
: [key?] 0 [b!] 1 [b!] [b@] ;
\ [key] ( -- c ) - ungekapselte tastaturabfrage
: [key] 0 [b!] 2 [b!] [b@] ;
\ [emit] ( c -- ) - ungekapselte zeichenausgabe
: [emit] emit? if emit then ;
\ ----------------------------------------------------- TOOLS
\ cls ( -- ) - screen löschen
: cls 01 emit ;
\ .tab ( -- ) - tabulator
: .tab 09 emit ;
\ .err ( err -- ) - fehlermeldung ausgeben
\ 0 no error
\ 1 fsys unmounted
\ 2 fsys corrupted
\ 3 fsys unsupported
\ 4 not found
\ 5 file not found
\ 6 dir not found
\ 7 file read only
\ 8 end of file
\ 9 end of directory
\ 10 end of root
\ 11 dir is full
\ 12 dir is not empty
\ 13 checksum error
\ 14 reboot error
\ 15 bpb corrupt
\ 16 fsi corrupt
\ 17 dir already exist
\ 18 file already exist
\ 19 out of disk free space
\ 20 disk io error
\ 21 command not found
\ 22 timeout
\ 23 parameter error
: .err dup if ERR then drop ;
\ .pad ( -- ) - ausgabe eines strings im pad
: .pad pad .cstr ;
\ .vname ( -- ) - ausgabe des namens der eingelegten sd-card
: .vname adm:volname .pad ;
\ mount ( -- ) - sd-card mounten
: mount adm:mount .err ." Medium : " .vname cr ;
\ unmount ( -- ) - sd-card unmounten
: unmount adm:unmount .err ;
\ mount? ( -- ) - test ob medium mounted ist
\ wird als exception gewertet
: mount? adm:checkmounted 0= if 1 .err then ;
\ padbl ( -- ) fills this cogs pad with blanks
: padbl pad padsize bl fill ;
\ .entry ( -- st ) - einen verzeichniseintrag ausgeben
: .entry
adm:nextfile 13 adm:fattrib if 0F emit else space then
dup if .pad .tab then ;
\ .len ( st -- st ) - dateilänge ausgeben
: .len dup if 0 adm:fattrib . then ;
\ lscnt ( cnt1 st -- cnt2 st ) - spaltenformatierung für ls
\ cnt - spaltenzähler, st - flag verzeichnisende
: lscnt
swap 1+ dup 4 = if cr drop 0 else .tab then swap ;
\ lsl ( -- ) - verzeichnis anzeigen, long-format
: lsl mount?
adm:diropen begin .entry .len cr 0= until padbl ;
\ ls ( -- ) - verzeichnis in spalten anzeigen
: ls mount?
adm:diropen 0 begin .entry lscnt 0= until drop padbl cr ;
\ cd name ( -- ) - verzeichnis wechseln
: cd mount? parsenw adm:chdir .err ;
\ open name ( -- ) - datei lesend öffnen und auf fehler prüfen
: open
mount? parsenw dup
if 52 adm:open else drop 23 then .err ;
\ close ( -- ) - geöffnete datei schließen
: close adm:close .err ;
\ dload name - datei compilieren; log im gleichen screen
\ load name - datei compilieren; log screen 3
\ sys name - datei aus sys compilieren; log screen 3
\ die datei wird in der nächsten freien cog compiliert
\ fl ist für load nicht nötig und bringt in dem kontext
\ die cog-zuordnung durcheinander
: (load)
begin adm:getc emit adm:eof until ;
: (dload)
open cogid nfcog iolink
(load)
cogid iounlink close ;
: (sload)
open cogid 3 dup b[ [wscr] ]b iolink
(load)
cogid dup b[ [wscr] ]b iounlink close ;
: load
." Loading... " (sload) ;
: dload
(dload) ;
: sys
2 adm:dmset 1 adm:dmact ." Loading... " (sload) 2 adm:dmact ;
\ ------------------------------------------------- SPIN-LOADER
\ (spin) ( cstr -- ) - c" reg.sys" (spin)
: (spin)
dup C@ 1+
0 do
dup i + C@
ldvar 1+ i + C!
loop drop
1 ldvar C!
;
\ spin name ( -- ) - spinobjekt "name" starten
: spin
parsenw (spin) ;
\ regime ( -- ) - startet dir trios-cli "regime"
: regime
0 adm:dmact
c" reg.sys" (spin) ;
\ ----------------------------------------------------- DRV:INT
wvariable icog \ nummer der drv:int-cog
wvariable lcog \ nummer interaktiven cog
\ xint ( n -- ) io von cog n auf drv:int umschalten
: xint icog W@ ioconn ;
\ [cogscr] ( nr -- ) - umschaltung screen + cog
: [cogscr]
dup 2dup lcog W! xint [dscr] [wscr] ;
\ =n ( n1 n2 -- n1 n1=n2 )
: =n 2dup = swap drop ;
\ [esc] ( -- ) - manager für esc-funktionen im drv:int
: [esc]
begin [key?] until [key]
71 =n if 1b [emit] then \ esc - q : esc-char/quit
31 =n if 1 [cogscr] then \ esc - 1 : cog-screen 0
32 =n if 2 [cogscr] then \ esc - 2 : cog-screen 1
33 =n if 3 [cogscr] then \ esc - 3 : cog-screen 2
62 =n if lcog W@ cogreset then \ esc - b : break (cog)
72 =n if reboot then \ esc - r : reset (chip)
drop ; \ esc - esc : pause
\ drv:int ( -- ) treiber für bellatrix-terminal
\ diese cog fragt in einer endlosschleife ab, ob zeichen
\ versendet oder empfangen werden sollen. um die zeichenausgabe
\ zu beschleunigen, findet ausgabe und eingabe in einem
\ verhältnis von 512:1 statt. per esc-code können spezielle
\ funktionen im driver ausgelöst werden.
: drv:int
\ name und typ der cog einstellen
cogid dup cogstate 10 swap C! c" drv:int" over
cognumpad ccopy
20 delms 0D emit \ verzögertes cr für prompt
begin
\ input --> vga/video
200 0 do key? \ eingabezeichen vorhanden?
if key b[ [b!] ]b then loop \ cog ---> bel.vga
\ output <-- keyboard
b[ [key?] \ tastenstatus bellatrix?
if [key] dup 1b = if drop [esc] else [emit] thens ]b
0 until ;
\ ----------------------------------------------------- SYSINIT
: start \ ( -- ) initialisierung hive
locknew b[lock] W! \ b-semaphore
0 dup cogstate 10 swap C! c" drv:ldr" over
cognumpad ccopy
5 dup icog W! c" drv:int" swap cogx 1 b[ [cogscr] ]b ;
: _ob onboot ;
: onboot _ob start ;

View File

@ -0,0 +1,77 @@
hex
ifnot: lib:bel
: lib:bel ;
\ kommandoformate
ifnot: bel:fkt! \ ( fkt -- )
: bel:fkt! b[ 0 [b!] [b!] ]b ;
ifnot: bel:fkt!b! \ ( b fkt -- )
: bel:fkt!b! b[ 0 [b!] [b!] [b!] ]b ;
ifnot: bel:fkt!b!l@ \ ( b fkt -- l )
: bel:fkt!b!l@ b[ 0 [b!] [b!] [b!] [b.l@] ]b ;
ifnot: bel:fkt!b!l! \ ( l b fkt -- )
: bel:fkt!b!l! b[ 0 [b!] [b!] [b!] [b.l!] ]b ;
ifnot: bel:fkt!l@ \ ( fkt -- l )
: bel:fkt!l@ b[ 0 [b!] [b!] [b.l@] ]b ;
ifnot: bel:fkt!b@ \ ( fkt -- b )
: bel:fkt!b@ b[ 0 [b!] [b!] [b@] ]b ;
\ chipmanagment-funktionen
ifnot: bel:wscr \ ( scrnr -- ) - schreibscreen setzen
: bel:wscr 58 bel:fkt!b! ;
ifnot: bel:dscr \ ( scrnr -- ) - displayscreen setzen
: bel:dscr 59 bel:fkt!b! ;
ifnot: bel:getcol \ ( colnr -- col ) - farbe abfragen
: bel:getcol 5A bel:fkt!b!l@ ;
ifnot: bel:setcol \ ( col colnr -- ) - farbe setzen
: bel:setcol 5B bel:fkt!b!l! ;
ifnot: bel:getresx \ ( -- resx ) - abfrage x-auflösung
: bel:getresx 5C bel:fkt!l@ ;
ifnot: bel:getresy \ ( -- resy ) - abfrage y-auflösung
: bel:getresy 5D bel:fkt!l@ ;
ifnot: bel:getcols \ ( -- cols ) - abfrage textspalten
: bel:getcols 5E bel:fkt!b@ ;
ifnot: bel:getrows \ ( -- rows ) - abfrage textzeilen
: bel:getrows 5F bel:fkt!b@ ;
ifnot: bel:getcogs \ ( -- cogs ) - abfrage belegte cogs
: bel:getcogs 60 bel:fkt!b@ ;
ifnot: bel:getspec \ ( -- spec ) - abfrage codespezifikation
: bel:getspec 61 bel:fkt!l@ ;
ifnot: bel:getver \ ( -- ver ) - abfrage codeversion
: bel:getver 62 bel:fkt!l@ ;
ifnot: bel:load \ ( cstr -- ) - bellatrix-code laden
: bel:load
52 adm:open .err \ datei öffnen
b[
0 [b!] 63 [b!] \ bella-loader starten
10 0 do 06 [a!] [a@] [b!] loop \ header einlesen
0A [a!] 0 [a.l!] \ 0 adm:seek
[b@] <8 [b@] or \ dateilänge empfangen
0 do 06 [a!] [a@] [b!] loop \ datei senden
]b
adm:close .err \ datei schließen
;

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,74 @@
hex
ifnot: lib:cog
: lib:cog ;
\ cog special register
ifnot: ctra 1F8 wconstant ctra :;
ifnot: ctrb 1F9 wconstant ctrb :;
ifnot: frqa 1FA wconstant frqa :;
ifnot: frqb 1FB wconstant frqb :;
ifnot: phsa 1FC wconstant phsa :;
ifnot: phsb 1FD wconstant phsb :;
ifnot: vcfg 1FE wconstant vcfg :;
ifnot: vscl 1FF wconstant vscl :;
\ this words needs to align with the assembler code
ifnot: _faddrmask : _faddrmask 1 _cv ;
ifnot: _flongmask : _flongmask 2 _cv ;
ifnot: _stptr : _stptr 5 _cv ;
ifnot: _sttos : _sttos 7 _cv ;
ifnot: _treg1 : _treg1 8 _cv ;
ifnot: _treg2 : _treg2 9 _cv ;
ifnot: _treg3 : _treg3 a _cv ;
ifnot: _treg4 : _treg4 b _cv ;
ifnot: _treg5 : _treg5 c _cv ;
ifnot: _treg6 : _treg6 d _cv ;
ifnot: _stbot : _stbot e _cv ;
ifnot: _sttop : _sttop 2e _cv ;
ifnot: _rsbot : _rsbot _sttop ;
\ waitcnt ( n1 n2 -- n1 ) \ wait until n1, add n2 to n1
ifnot: waitcnt
: waitcnt _execasm2>1 1F1 _cnip ;
\ waitpeq ( n1 n2 -- ) \ wait until state n1 is equal to
\ ina anded with n2
ifnot: waitpeq
: waitpeq _execasm2>0 1E0 _cnip ;
\ waitpne ( n1 n2 -- ) \ wait until state n1 is not equal
\ to ina anded with n2
ifnot: waitpne
: waitpne _execasm2>0 1E8 _cnip ;
\ lockret ( n1 -- ) deallocate a lock, previously allocated
\ via locknew
ifnot: lockret
: lockret 5 hubop 2drop ;
\ locknew ( -- n2 ) allocate a lock, result is in n2, -1
\ if unsuccessful
ifnot: locknew
: locknew -1 4 hubop -1 = if drop -1 then ;
\ cog+ ( -- ) add a forth cog
ifnot: cog+
: cog+ (cog+) ;
\ (cog-) ( -- ) stop first forth cog, cannot be executed form
\ the first forth cog
ifnot: (cog-)
: (cog-) nfcog cogstop ;
\ cog- ( -- ) stop first forth cog, cannot be executed form
\ the first forth cog
ifnot: cog-
: cog- (cog-) ;

View File

@ -0,0 +1,65 @@
hex
ifnot: mod:debug
: mod:debug ;
\ keycode ( -- ) - anzeige der tastaturcodes
ifnot: keycode
: keycode
begin
0 key? if
drop key dup dup ." code : " emit ." : " . cr 1B =
then until ;
\
\ Noisy reset messages
\
\ print out a reset message to the console
\ (rsm) ( n -- ) n is the last status
\ 0011FFFF - stack overflow
\ 0012FFFF - return stack overflow
\ 0021FFFF - stack underflow
\ 0022FFFF - return stack underflow
\ 8100FFFF - no free cogs
\ 8200FFFF - no free main memory
\ 8400FFFF - fl no free main memory
\ 8500FFFF - no free cog memory
\ 8800FFFF - eeprom write error
\ 9000FFFF - eeprom read error
: (rsm) state W@ 2 and 0= swap
\ process the last status
dup 0= if c" ok" else
dup FF11 = if c" DST OVER" else
dup FF12 = if c" RST OVER" else
dup FF21 = if c" DST LOW" else
dup FF22 = if c" RST LOW" else
dup 8001 = if c" COGs OUT" else
dup 8002 = if c" hMEM OUT" else
dup 8003 = if c" ROM WR" else
dup 8004 = if c" FL" else
dup 8005 = if c" cMEM OUT" else
dup 8006 = if c" ROM RD" else
c" ?"
thens
rot if
lockdict cr c" ERR : " .cstr swap . .cstr cr freedict
else 2drop then ;
: onreset (rsm) 4 state orC! ;
\ .byte ( n1 -- )
: .byte <# # # #> .cstr ;
\ [if (dumpb)
: (dumpb) cr over .addr space dup .addr _ecs bounds ; ]
\ [if (dumpm)
: (dumpm) cr .word _ecs ; ]
\ [if (dumpe)
: (dumpe) tbuf 8 bounds do i C@ .byte space loop 2 spaces tbuf 8 bounds do i C@ dup bl < if drop 2e then emit loop ; ]
\ dump ( adr cnt -- ) uses tbuf
[if dump
: dump (dumpb) do i (dumpm) i tbuf 8 cmove (dumpe) 8 +loop cr ; ]

Binary file not shown.

View File

@ -0,0 +1,40 @@
Reset-Fehlercodes:
0011FFFF - stack overflow
0012FFFF - return stack overflow
0021FFFF - stack underflow
0022FFFF - return stack underflow
8100FFFF - no free cogs
8200FFFF - no free main memory
8400FFFF - fl no free main memory
8500FFFF - no free cog memory
8800FFFF - eeprom write error
9000FFFF - eeprom read error
.err-Fehlercodes:
0 no error
1 fsys unmounted
2 fsys corrupted
3 fsys unsupported
4 not found
5 file not found
6 dir not found
7 file read only
8 end of file
9 end of directory
10 end of root
11 dir is full
12 dir is not empty
13 checksum error
14 reboot error
15 bpb corrupt
16 fsi corrupt
17 dir already exist
18 file already exist
19 out of disk free space
20 disk io error
21 command not found
22 timeout
23 parameter error

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,155 @@
hex
ifnot: mod:hplay
: mod:hplay ;
\ kommandoformate
ifnot: adm:fkt! \ ( fkt -- )
: adm:fkt! b[ [a!] ]b ;
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b!w@ \ ( b fkt -- w )
: adm:fkt!b!w@ b[ [a!] [a!] [a.w@] ]b ;
ifnot: adm:fkt!s!b@ \ ( cstr fkt -- b )
: adm:fkt!s!b@ b[ [a!] [a.s!] [a@] ]b ;
ifnot: bel:fkt!b@ \ ( fkt -- b )
: bel:fkt!b@ b[ 0 [b!] [b!] [b@] ]b ;
ifnot: bel:char \ ( b -- )
: bel:char b[ [b!] ]b ;
\ hss-funktionen
ifnot: hss:load \ ( cstr -- err ) - hss-datei laden
: hss:load dup if 64 adm:fkt!s!b@ then ;
ifnot: hss:play \ ( -- ) - datei im puffer abspielen
: hss:play 65 adm:fkt! ;
ifnot: hss:stop \ ( -- ) - player stop
: hss:stop 66 adm:fkt! ;
ifnot: hss:reg \ hreg ( regnr -- 16b )
: hss:reg 69 b[ [a!] [a!] [a.w@] ]b ;
ifnot: hss:vol \ hvol ( vol -- ) - lautstärke 0..15
: hss:vol 6A adm:fkt!b! ;
\ keyboard-funktionen
ifnot: key:stat \ ( -- stat ) - tastenstatus abfragen
: key:stat 1 bel:fkt!b@ ;
\ steuerzeichen
ifnot: scr:cls \ ( -- ) - screen löschen
: scr:cls 01 bel:char ;
ifnot: scr:home \ ( -- ) - cursor oben links
: scr:home 02 bel:char ;
ifnot: scr:curon \ ( -- ) - cursor anschalten
: scr:curon 04 bel:char ;
ifnot: scr:curoff \ ( -- ) - cursor abschalten
: scr:curoff 05 bel:char ;
\ sd0-funktionen
\ adm:diropen ( -- ) - verzeichnisabfrage initialisieren
ifnot: adm:diropen
: adm:diropen
02 adm:fkt! ;
\ adm:nextfile ( -- st )
\ st = 0 - keine gültige datei
\ st = 1 - dateiname im pad gültig
\ bei gültigem eintrag befindet sich der dateiname im pad
ifnot: adm:nextfile
: adm:nextfile
b[ 03 [a!] [a@] dup if [a.s@] then ]b ;
\ metafunktionen
\ hload name ( -- ) - hss-datei in player laden
ifnot: hload
: hload mount? parsenw hss:load .err ;
ifnot: .hset
: .hset \ ( shift -- ) - eine registersatz ausgeben
5 0 do dup i + hss:reg .word space loop drop ;
ifnot: .hreg
: .hreg \ ( -- ) - register ausgeben
14 0 do i .hset cr 5 +loop ;
ifnot: fadeout
: fadeout \ ( -- ) - sound langsam ausblenden
f 0 do e i - hss:vol 50 delms loop ;
ifnot: end?
: end? \ ( cnt -- flag ) - abfrage nach cnt wiederholungen
4 hss:reg = ;
ifnot: hwait
: hwait \ ( -- flag ) - wartet auf songende oder taste
begin 50 delms key? 2 end? or until key drop ;
ifnot: hreg..
: hreg.. \ ( -- ) - fortlaufende anzeige register
scr:curoff scr:cls begin scr:home .hreg 2 end? until
scr:curon fadeout hss:stop ;
ifnot: (hplay)
: (hplay) \ ( cstr -- )
." Datei : " dup .cstr hss:load .err f hss:vol hss:play
hwait fadeout hss:stop 100 delms cr ;
\ hplay name ( -- ) - datei abspielen
ifnot: hplay
: hplay
hload hss:play ;
\ files? ( -- cnt ) - anzahl dateien im dir
ifnot: files?
: files?
adm:diropen
0 begin adm:nextfile swap 1+ swap 0= until 3 - padbl ;
\ filenr? ( nr -- )
ifnot: filenr?
: filenr?
adm:diropen
0 do adm:nextfile drop loop ;
\ hdirplay ( -- ) - gesamtes verzeichnis abspielen
\ im verzeichnis dürfen nur hss-dateien sein!
ifnot: hdirplay
: hdirplay
decimal files? dup ." Dateien : " . cr
0 do i dup 1 + . 3 + filenr? pad (hplay) loop padbl hex ;
: (hp) ." play : " dup .cstr hss:load .err ;
ifnot: playliste
: playliste
c" kw.hss" (hplay)
c" genes.hss" (hplay)
c" greenpuz.hss" (hplay)
c" hssintro.hss" (hplay)
c" kali766.hss" (hplay)
c" machine.hss" (hplay)
c" metroid.hss" (hplay)
c" mrboss.hss" (hplay)
c" mrevil.hss" (hplay)
c" raind.hss" (hplay)
c" sytrus.hss" (hplay)
c" tbellsp1.hss" (hplay) ;

View File

@ -0,0 +1,60 @@
hex
ifnot: lib:hss
: lib:hss ;
\ kommandoformate
ifnot: adm:fkt! \ ( fkt -- )
: adm:fkt! b[ [a!] ]b ;
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b!b! \ ( b b fkt -- )
: adm:fkt!b!b! b[ [a!] [a!] [a!] ]b ;
ifnot: adm:fkt!b!w@ \ ( b fkt -- w )
: adm:fkt!b!w@ b[ [a!] [a!] [a.w@] ]b ;
ifnot: adm:fkt!s!b@ \ ( cstr fkt -- b )
: adm:fkt!s!b@ b[ [a!] [a.s!] [a@] ]b ;
\ hss-funktionen
\ ( cstr -- err ) - hss-datei laden
ifnot: hss:load
: hss:load dup if 64 adm:fkt!s!b@ then ;
\ ( -- ) - datei im puffer abspielen
ifnot: hss:play
: hss:play 65 adm:fkt! ;
\ ( -- ) - player stop
ifnot: hss:stop
: hss:stop 66 adm:fkt! ;
\ ( -- ) - player pause
ifnot: hss:pause
: hss:pause 67 adm:fkt! ;
\ hreg ( regnr -- 16b )
\ 0 iEndFlag iRowFlag iEngineC iBeatC iRepeat Player
\ 5 iNote iOktave iVolume iEffekt iInstrument Kanal 1
\ 10 iNote iOktave iVolume iEffekt iInstrument Kanal 2
\ 15 iNote iOktave iVolume iEffekt iInstrument Kanal 3
\ 20 iNote iOktave iVolume iEffekt iInstrument Kanal 4
\
\ iEndFlag Repeat oder Ende wurde erreicht
\ iRowFlag Trackerzeile (Row) ist fertig
\ iEngineC Patternzähler
\ iBeatC Beatzähler (Anzahl der Rows)
\ iRepeat Zähler für Loops
ifnot: hss:reg
: hss:reg 69 b[ [a!] [a!] [a.w@] ]b ;
\ hvol ( vol -- ) - lautstärke 0..15
ifnot: hss:vol
: hss:vol 6A adm:fkt!b! ;

View File

@ -0,0 +1,17 @@
hex
ifnot: lib:key
: lib:key ;
\ kommandoformate
ifnot: bel:fkt!b@ \ ( fkt -- b )
: bel:fkt!b@ b[ 0 [b!] [b!] [b@] ]b ;
\ keyboard-funktionen
ifnot: key:stat \ ( -- stat ) - tastenstatus abfragen
: key:stat 1 bel:fkt!b@ ;
ifnot: key:code \ ( -- code ) - tastencode abfragen
: key:code 2 bel:fkt!b@ ;
ifnot: key:spec \ ( -- spec ) - spezialtasten abfragen
: key:spec 4 bel:fkt!b@ ;

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,206 @@
\ ACHTUNG: Diese Modifikation nicht bei einer Installation im
\ HI-EEPROM verwenden!
hex
[if mod:rom
: mod:rom ; ]
\ constant ( x -- ) skip blanks parse the next word and create a constant, allocate a long, 4 bytes
[if constant
: constant lockdict create $C_a_doconl w, l, forthentry freedict ; ]
\
\ CONFIG PARAMETERS BEGIN
\
40 wconstant fsps \ a page size which works with 32kx8 & 64kx8 eeproms
\ and should work with larger as well.
8000 constant fsbot \ file-system bottom: the start adress in eeprom for the file system
\ file system top: the end address of the file system
\ uncomment the line for your comfiguration
\ 8000 constant fstop \ the end address for the file system with one 24LC256 32k eeprom
10000 constant fstop \ the end address for the file system with one 24LC512 64k eeprom
\ 20000 constant fstop \ the end address for the file system with two 24LC512 64k eeprom
\ 30000 constant fstop \ the end address for the file system with 3 24LC512 64k eeprom
\ 40000 constant fstop \ the end address for the file system with 4 24LC512 64k eeprom
\ 50000 constant fstop \ the end address for the file system with 5 24LC512 64k eeprom
\ 60000 constant fstop \ the end address for the file system with 6 24LC512 64k eeprom
\ 70000 constant fstop \ the end address for the file system with 7 24LC512 64k eeprom
\ NOTE IF you have DEMOBOARD or any system with 32K EEPROM, you will step on your spin image
\ when you write to the EEPROM. You can still use it (if you are tricky), but KNOW WHAT YOUR DOING!!!
\
\ CONFIG PARAMETERS END
\
\ lasti? ( -- t/f ) true if this is the last value of i in this loop
[if lasti?
: lasti? _rsptr COG@ 2+ COG@ 1- _rsptr COG@ 3 + COG@ = ; ]
\ padbl ( -- ) fills this cogs pad with blanks
[if padbl
: padbl pad padsize bl fill ; ]
\ _eeread ( t/f -- c1 ) read a byte from the eeprom, ackbit in, byte out
[if _eeread : _eeread _sdai 0 8 0 do 1 lshift _sclh _sda? _scll if 1 or then loop
swap if _sdah else _sdal then _sdao _sclh _scll _sdal ; ]
\ the eereadpage and eewritePage words assume the eeprom are 64kx8 and will address up to
\ 8 sequential eeproms
\ eereadpage ( eeAddr addr u -- t/f ) return true if there was an error, use lock 1
[if eereadpage : eereadpage begin 1 lockset 0= until
1 max rot dup ff and swap dup 8 rshift ff and swap 10 rshift 7 and 1 lshift dup >r
_eestart A0 or _eewrite swap _eewrite or swap _eewrite or
_eestart r> A1 or _eewrite or
rot2 bounds
do lasti? _eeread i C! loop _eestop 1 lockclr drop ; ]
\ _eeread ( t/f -- c1 ) read a byte from the eeprom, ackbit in, byte out
[if _eeread : _eeread _sdai 0 8 0 do 1 lshift _sclh _sda? _scll if 1 or then loop
swap if _sdah else _sdal then _sdao _sclh _scll _sdal ; ]
\ the eereadpage and eewritePage words assume the eeprom are 64kx8 and will address up to
\ 8 sequential eeproms
\ eereadpage ( eeAddr addr u -- t/f ) return true if there was an error, use lock 1
[if eereadpage : eereadpage begin 1 lockset 0= until
1 max rot dup ff and swap dup 8 rshift ff and swap 10 rshift 7 and 1 lshift dup >r
_eestart A0 or _eewrite swap _eewrite or swap _eewrite or
_eestart r> A1 or _eewrite or
rot2 bounds
do lasti? _eeread i C! loop _eestop 1 lockclr drop ; ]
\ EW@ ( eeAddr -- n1 )
[if EW@
: EW@ t0 2 eereadpage if 8006 ERR then t0 W@ ; ]
\ EC@ ( eeAddr -- c1 )
[if EC@
: EC@ EW@ FF and ; ]
\ (fspa) ( addr1 -- addr2) addr2 is the next page aligned address after addr1
: (fspa) fsps 1- + fsps 1- andn ;
\ (fsnext) ( addr1 -- addr2 t/f) addr - the current file address, addr2 - the next addr, t/f - true if we have
\ gone past the end of the eeprom. t0 -length of the current file
\ t1 - length of the file name (char)
: (fsnext) t0 W@ t1 C@ + 2+ 1+ + (fspa) dup fstop >= ;
\ (fswr) ( addr1 addr2 n1 -- ) addr1 - the eepropm address to write, addr2 - the address to write from
\ n1 - the number of bytes to write
: (fswr) dup >r rot dup r> + fstop 1- > if A0 ERR then rot2 eewritepage if 88 ERR then ;
\ (fsrd) ( addr1 addr2 n1 -- ) addr1 - the eepropm address to read, addr2 - the address of the read buffer
\ n1 - the number of bytes to read
: (fsrd) dup >r rot dup r> + fstop 1- > if C0 ERR then rot2 eereadpage if 90 ERR then ;
\ (fsfree) ( -- n1 ) n1 is the first location in the file system, -1 if there are none
: (fsfree) -1 fsbot begin
\ read 3 bytes into t0, t1 and process
dup t0 3 (fsrd) t0 W@ FFFF = if nip dup -1 else (fsnext) then
until drop ;
\ (fsfind) ( cstr -- addr ) find the last file named cstr, addr is the eeprom address, 0 if not found
: (fsfind) fsbot 0 >r begin
\ read namesizemax 1F + 3 bytes into t0, t1, and tbuf
dup t0 22 (fsrd) t0 W@ FFFF = if -1 else
over t1 cstr= if r> drop dup >r then
(fsnext)
then
until 2drop r> ;
\ (fslast) ( -- addr ) find the last file, 0 if not found
: (fslast) 0 fsbot begin
\ read namesizemax 1F + 3 bytes into t0, t1, and tbuf
dup t0 22 (fsrd) t0 W@ FFFF = if -1 else
nip dup
(fsnext)
then
until drop ;
\ fsclear ( -- )
: fsclr padbl fsbot 400 + fsbot do i pad fsps (fswr) 2e emit fsps +loop -1 fsbot EW! ;
: fsclear -1 fsbot EW! ;
\ fsfree ( -- )
: fsfree (fsfree) dup -1 = if 0 else fstop swap - then . ." bytes free in fs" cr ;
\ fsls ( -- ) list the files
: fsls cr fsbot begin
\ read namesizemax 1F + 3 bytes into t0, t1, and tbuf
dup t0 22 (fsrd) t0 W@ FFFF = if -1 else
dup .addr space t0 W@ .addr space t1 .cstr cr
(fsnext)
then
until fstop swap - cr . ." bytes free in files system" cr cr ;
\ (fsread) ( cstr -- )
: (fsread) (fsfind) dup if
\ read 3 bytes into t0, t1 and process
dup t0 3 (fsrd)
t1 C@ + 2+ 1+ t0 W@ bounds do
ibound i - fsps >= if
i pad fsps (fsrd) pad fsps bounds
do i C@ emit loop i fsps 1- + seti
else
i EC@ emit
then
loop
else drop then padbl ;
\ fsread ( -- ) filename
: fsread parsenw dup if (fsread) else drop then ;
\ (fsload) ( ctsr -- )
: (fsload) cogid nfcog iolink (fsread) d emit d emit cogid iounlink ;
\ fsload filename ( -- ) send the file to the next free forth cog
: fsload parsenw dup if (fsload) else drop then ;
\ (fsk) ( n1 -- n2)
: (fsk) 8 lshift key or ;
\ fswrite filename ( -- ) writes a file until ... followed immediately by a cr is encountered
: fswrite (fsfree) dup -1 <> parsenw dup rot and if
\ set the file length to 0, copy in the file name
0 pad W! dup C@ 2+ 1+ pad + swap pad 2+ ccopy
\ find the first free page
0 swap key (fsk) (fsk) (fsk)
\ ( eaddr1 n1 addr2 n2 ) eaddr - start of file in the eeprom, n1 - bytes written so far, addr2 - next addr in the pad,
\ n2 - a 4 byte key buffer
begin
\ check to see if we have a ... at the end of a line
2E2E2E0D over = if
-1
else
\ get a key from the key buffer, write it the the pad
swap over 18 rshift dup dup d = if drop cr else emit then over C! 1+ tuck pad - fsps = if
\ we have a page worth of data, write it out
nip rot2 2dup + pad fsps (fswr) fsps + rot pad swap
then
\ get another key
(fsk) 0
then
until
\ any keys left?
drop pad - dup 0> if
\ write the leftover, not a full page
>r 2dup + pad r> dup >r (fswr) r> +
else
drop
then
\ write the length of FFFF for the next file
2dup + FFFF swap (fspa) dup fstop 1- < if EW! else 2drop then
\ subtract the length of the filename +1, and the 2 bytes which are the length of the file, and update the length of the file
over 2+ EC@ 2+ 1+ - swap EW!
else 2drop clearkeys then padbl
;
\ fsdrop ( -- ) deletes last file
: fsdrop (fslast) dup -1 = if drop else FFFF swap EW! then ;

View File

@ -0,0 +1,69 @@
hex
ifnot: lib:scr
: lib:scr ;
\ kommandoformate
ifnot: bel:char \ ( b -- )
: bel:char b[ [b!] ]b ;
ifnot: bel:fkt!b! \ ( b fkt -- )
: bel:fkt!b! b[ 0 [b!] [b!] [b!] ]b ;
ifnot: bel:fkt!b!b! \ ( b b fkt -- )
: bel:fkt!b!b! b[ 0 [b!] [b!] [b!] [b!] ]b ;
ifnot: bel:ctrl! \ ( ctrl -- )
: bel:ctrl! b[ 0 [b!] 3 [b!] [b!] ]b ;
ifnot: bel:ctrl!b! \ ( b ctrl -- )
: bel:ctrl!b! b[ 0 [b!] 3 [b!] [b!] [b!] ]b ;
ifnot: bel:ctrl!b@ \ ( ctrl -- b@ )
: bel:ctrl!b@ b[ 0 [b!] 3 [b!] [b!] [b@] ]b ;
ifnot: bel:ctrl!b!b! \ ( b b ctrl -- )
: bel:ctrl!b!b! b[ 0 [b!] 3 [b!] [b!] [b!] [b!] [b!] ]b ;
\ einfache steuerzeichen
ifnot: scr:cls \ ( -- ) - screen löschen
: scr:cls 01 bel:char ;
ifnot: scr:home \ ( -- ) - cursor oben links
: scr:home 02 bel:char ;
ifnot: scr:pos1 \ ( -- ) - cursor an zeilenanfang
: scr:pos1 03 bel:char ;
ifnot: scr:curon \ ( -- ) - cursor anschalten
: scr:curon 04 bel:char ;
ifnot: scr:curoff \ ( -- ) - cursor abschalten
: scr:curoff 05 bel:char ;
ifnot: scr:scrlu \ ( -- ) - screen nach oben scrollen
: scr:scrlu 06 bel:char ;
ifnot: scr:scrld \ ( -- ) - screen nach unten scrollen
: scr:scrld 07 bel:char ;
ifnot: scr:bs \ ( -- ) - backspace
: scr:bs 08 bel:char ;
ifnot: scr:tab \ ( -- ) - tabulator
: scr:tab 09 bel:char ;
\ screen-funktionen
ifnot: scr:logo \ ( y x -- ) - hive logo
: scr:logo 5 bel:fkt!b!b! ;
ifnot: scr:char \ ( char -- ) - zeichensatz direkt ausgeben
: scr:char 6 bel:fkt!b! ;
\ parametrisierte steuerzeichen
ifnot: scr:setcur \ ( cur -- ) - cursorzeichen setzen
: scr:setcur 01 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:getx \ ( -- x ) - cursor position x abfragen
: scr:getx 04 bel:ctrl!b@ ;
ifnot: scr:gety \ ( -- y ) - cursor position y abfragen
: scr:gety 05 bel:ctrl!b@ ;
ifnot: scr:setcol \ ( colnr -- ) - farbe wählen 0..15
: scr:setcol 06 bel:ctrl!b! ;
ifnot: scr:sline \ ( row -- ) - anfangszeile scrollbereich
: scr:sline 07 bel:ctrl!b! ;
ifnot: scr:eline \ ( row -- ) - endzeile scrollbereich
: scr:eline 08 bel:ctrl!b! ;
ifnot: scr:sinit \ ( -- ) -
: scr:sinit 09 bel:ctrl! ;
ifnot: scr:tabset \ ( pos nr -- ) - tabulatorposition setzen 0..7
: scr:tabset 0A bel:ctrl!b!b! ;

View File

@ -0,0 +1,176 @@
hex
ifnot: lib:sd0
: lib:sd0 ;
\ ------------------------------------ lib:sd0
\ kommandoformate
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b!b@ \ ( b fkt -- b )
: adm:fkt!b!b@ b[ [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!b!l@ \ ( b fkt -- l )
: adm:fkt!b!l@ b[ [a!] [a!] [a.l@] ]b ;
ifnot: adm:fkt!l! \ ( l fkt -- )
: adm:fkt!l! b[ [a!] [a.l!] ]b ;
ifnot: adm:fkt!l@ \ ( fkt -- l )
: adm:fkt!l@ b[ [a!] [a.l@] ]b ;
ifnot: adm:fkt!b!l! \ ( l b fkt -- )
: adm:fkt!b!l! b[ [a!] [a!] [a.l!] ]b ;
ifnot: adm:fkt!s!b@ \ ( s fkt -- b )
: adm:fkt!s!b@ b[ [a!] [a.s!] [a@] ]b ;
ifnot: adm:fkt!b!s!b@ \ ( s b fkt -- b )
: adm:fkt!b!s!b@ b[ [a!] [a!] [a.s!] [a@] ]b ;
ifnot: adm:fkt!s!s!b@ \ ( s s fkt -- b )
: adm:fkt!s!s!b@ b[ [a!] [a.s!] [a.s!] [a@] ]b ;
\ dateisystem-funktionen
\ adm:mount ( -- err ) - medium mounten
ifnot: adm:mount
: adm:mount
01 adm:fkt!b@ ;
\ adm:diropen ( -- ) - verzeichnisabfrage initialisieren
ifnot: adm:diropen
: adm:diropen
02 adm:fkt! ;
\ adm:nextfile ( -- st )
\ st = 0 - keine gültige datei
\ st = 1 - dateiname im pad gültig
\ bei gültigem eintrag befindet sich der dateiname im pad
ifnot: adm:nextfile
: adm:nextfile
b[ 03 [a!] [a@] dup if [a.s@] then ]b ;
\ adm:open ( cstr modus -- err ) - datei öffnen
\ modus "R" $52 - Read
\ modus "W" $57 - Write
\ modus "A" $41 - Append
ifnot: adm:open
: adm:open
04 adm:fkt!b!s!b@ ;
\ adm:close ( -- ) - datei schließen
ifnot: adm:close
: adm:close
05 adm:fkt!b@ ;
\ adm:getc ( -- c ) - ein zeichen aus datei lesen
ifnot: adm:getc
: adm:getc
06 adm:fkt!b@ ;
\ adm:putc ( c -- ) - ein zeichen in datei schreiben
ifnot: adm:putc
: adm:putc
07 adm:fkt!b! ;
\ adm:eof ( -- eof ) - abfrage ob end of file erreicht ist
ifnot: adm:eof
: adm:eof
1E adm:fkt!b@ ;
\ adm:getblk ( adr cnt -- ) - datenblock aus datei lesen
\ adm:putblk ( adr cnt -- ) - datenblock in datei schreiben
\ adm:seek ( pos -- ) - position in datei setzen
: adm:seek
0A adm:fkt!l! ;
\ adm:fattrib ( nr -- attrib ) - dateiattribut abfragen
ifnot: adm:fattrib
: adm:fattrib
0B adm:fkt!b!l@ ;
\ adm:volname ( -- ) - name des volumes im pad ablegen
ifnot: adm:volname
: adm:volname
0C adm:fkt!s@ ;
\ adm:checkmounted ( -- t/f )
ifnot: adm:checkmounted
: adm:checkmounted
0D adm:fkt!b@ ;
\ adm:checkopen ( -- t/f )
ifnot: adm:checkopen
: adm:checkopen
0E adm:fkt!b@ ;
\ adm:checkused ( -- used ) - anzahl benutzte sektoren
ifnot: adm:checkused
: adm:checkused
0F adm:fkt!l@ ;
\ adm:checkfree ( -- free ) - anzahl freie sektoren
ifnot: adm:checkfree
: adm:checkfree
10 adm:fkt!l@ ;
\ adm:newfile ( cstr -- ) - neue datei erstellen
ifnot: adm:newfile
: adm:newfile
11 adm:fkt!s!b@ ;
\ adm:newdir ( cstr -- ) - neues verzeichnis erstellen
ifnot: adm:newdir
: adm:newdir
12 adm:fkt!s!b@ ;
\ adm:del ( cstr -- ) - datei/verzeichnis löschen
ifnot: adm:del
: adm:del
13 adm:fkt!s!b@ ;
\ adm:rename ( cstr1.fn1 cstr2.fn2 -- )
ifnot: adm:rename
: adm:rename
14 adm:fkt!s!s!b@ ;
\ adm:chattrib ( cstr1.fn cstr2.attrib -- )
ifnot: adm:chattrib
: adm:chattrib
15 adm:fkt!s!s!b@ ;
\ adm:chdir ( cstr -- err ) - verzeichnis öffnen
ifnot: adm:chdir
: adm:chdir
16 adm:fkt!s!b@ ;
\ adm:format ( cstr.label -- ) - medium formatieren
ifnot: adm:format
: adm:format
17 adm:fkt!s!b@ ;
\ adm:unmount ( -- err ) - medium unmounten
ifnot: adm:unmount
: adm:unmount
18 adm:fkt!b@ ;
\ marker-funktionen
ifnot: adm:dmact \ ( dmnr -- ) - marker aktivieren
: adm:dmact 19 adm:fkt!b!b@ .err ;
ifnot: adm:dmset \ ( dmnr -- ) - marker setzen
: adm:dmset 1A adm:fkt!b! ;
ifnot: adm:dmget \ ( dmnr -- dm ) - marker lesen
: adm:dmget 1B adm:fkt!b!l@ ;
ifnot: adm:dmclr \ ( dmnr -- ) - marker löschen
: adm:dmclr 1C adm:fkt!b! ;
ifnot: adm:dmput \ ( dm dmnr -- ) - marker schreiben
: adm:dmput 1D adm:fkt!b!l! ;

View File

@ -0,0 +1,93 @@
hex
ifnot: lib:sfx
: lib:sfx ;
\ kommandoformen
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b!b! \ ( b b fkt -- )
: adm:fkt!b!b! b[ [a!] [a!] [a!] ]b ;
ifnot: adm:fkt!b!64b! \ ( ptr b fkt -- )
: adm:fkt!b!64b! b[ [a!] [a!]
31 0 do dup i + C@ [a!] loop drop ]b ;
\ sfx-funktionen
\ sfx:fire( chan slot -- ) - sfx abspielen
\ slot - $00..$0f nummer der freien effektpuffer
\ slot - $f0..f5 vordefinierte effektslots
\ chan - 0/1 stereokanal
\ vordefinierte effekte
\ &f0 - warnton
\ $f1 - signalton
\ $f2 - herzschlag schnell
\ $f3 - herzschlag langsam
\ $f4 - telefon
\ $f5 - phaser :)
\ $f6 - pling
\ $f7 - on
\ $f8 - off
ifnot: sfx:fire
: sfx:fire 6B adm:fkt!b!b! ;
\ ( ptr slot -- ) - sfx setzen
\ slot - $00..$0f nummer der freien effektpuffer
\ ptr - zeiger auf 32 byte effektdaten
\
\ struktur der effektdaten:
\
\ [wav ][len ][freq][vol ] grundschwingung
\ [lfo ][lfw ][fma ][ama ] modulation
\ [att ][dec ][sus ][rel ] hüllkurve
\ [seq ] (optional)
\
\ [wav] wellenform
\ 0 sinus (0..500hz)
\ 1 schneller sinus (0..1khz)
\ 2 dreieck (0..500hz)
\ 3 rechteck (0..1khz)
\ 4 schnelles rechteck (0..4khz)
\ 5 impulse (0..1,333hz)
\ 6 rauschen
\ [len] tonlänge $0..$fe, $ff endlos
\ [freq] frequenz $00..$ff
\ [vol] lautstärke $00..$0f
\
\ [lfo] low frequency oscillator $ff..$01
\ [lfw] low frequency waveform
\ $00 sinus (0..8hz)
\ $01 fast sine (0..16hz)
\ $02 ramp up (0..8hz)
\ $03 ramp down (0..8hz)
\ $04 square (0..32hz)
\ $05 random
\ $ff sequencer data (es folgt eine sequenzfolge [seq])
\ [fma] frequency modulation amount
\ $00 no modulation
\ $01..$ff
\ [ama] amplitude modulation amount
\ $00 no modulation
\ $01..$ff
\ [att] attack $00..$ff
\ [dec] decay $00..$ff
\ [sus] sustain $00..$ff
\ [rel] release $00..$ff
ifnot: sfx:setslot
: sfx:setslot
6C adm:fkt!b!64b! ;
\ sfx:keyoff ( chan -- ) - release-phase einleiten
ifnot: sfx:keyoff
: sfx:keyoff
6D adm:fkt!b! ;
\ sfx:stop ( chan -- )
ifnot: sfx:stop
: sfx:stop
6E adm:fkt!b! ;

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,116 @@
\ achtung: vor verwendung muss der administra-code mit sidcog
\ geladen werden:
\ sys tools.f
\ sys splay.f <--- sid-player laden
\ aload admsid.adm <--- administra-code mit sidcog laden
\ splay xyz.dmp <--- sid-datei abspielen
hex
ifnot: mod:splay
: mod:splay ;
\ kommandoformen
ifnot: adm:fkt! \ ( fkt -- )
: adm:fkt! b[ [a!] ]b ;
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b@ \ ( fkt -- b )
: adm:fkt!b@ b[ 0 [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!s! \ ( s fkt -- )
: adm:fkt!s! b[ [a!] [a.s!] ]b ;
ifnot: adm:fkt!s!b@ \ ( s fkt -- err )
: adm:fkt!s! b[ [a!] [a.s!] [b@] ]b ;
ifnot: adm:fkt!b!l@ \ ( b fkt -- l )
: adm:fkt!b!l@ b[ [a!] [a!] [a.l@] ]b ;
\ dm-funktionen
ifnot: adm:dmget \ ( dmnr -- dm ) - marker lesen
: adm:dmget 1B adm:fkt!b!l@ ;
\ adm:dmact ( dmnr -- ) - marker aktivieren
: adm:dmact 19 adm:fkt!b!b@ drop ;
\ adm-funktionen
\ adm:aload ( cstr -- ) - neuen administra-code laden
ifnot: adm:aload
: adm:aload
60 adm:fkt!s! ;
\ tools
ifnot: aload
: aload
mount? parsenw dup
if 1 adm:dmact adm:aload 0 else drop 23 then .err ;
\ sid-funktionen
ifnot: sid:play
: sid:play \ ( cstr -- err )
9E adm:fkt!s!b@ ;
ifnot: sid:stop
: sid:stop \ ( -- )
9F adm:fkt! ;
ifnot: sid:status
: sid:status \ ( -- status )
A1 adm:fkt!b@ ;
ifnot: sid:mute
\ 1 - sid1
\ 2 - sid2
\ 3 - sid1 & sid2
: sid:mute \ ( sidnr -- )
A3 adm:fkt!b! ;
\ send? ( -- t/f )
ifnot: send?
: send?
begin 50 delms key? dup if key drop then sid:status 0= or
until ;
\ (splay) ( cstr -- )
ifnot: (splay)
: (splay) \ ( cstr -- )
." Datei : " dup .cstr cr sid:play .err
send? sid:stop 3 sid:mute adm:close drop ;
\ files? ( -- cnt ) - anzahl dateien im dir
ifnot: files?
: files?
adm:diropen
0 begin adm:nextfile swap 1+ swap 0= until 3 - padbl ;
\ filenr? ( nr -- )
ifnot: filenr?
: filenr?
adm:diropen
0 do adm:nextfile drop loop ;
\ splay name.dmp ( -- ) - sid-datei abspielen
ifnot: splay
: splay
parsenw (splay) ;
\ sdirplay ( -- ) - gesamtes verzeichnis abspielen
\ im verzeichnis dürfen nur sid-dateien sein!
ifnot: sdirplay
: sdirplay
files? dup ." Dateien : " . cr
0 do i dup 1 + . 3 + filenr? pad (splay) loop padbl ;
ifnot: smute
: smute
sid:stop 3 sid:mute ;

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,152 @@
hex
ifnot: mod:tools
: mod:tools ;
\ kommandoformen
ifnot: adm:fkt!b!l@ \ ( b fkt -- l )
: adm:fkt!b!l@ b[ [a!] [a!] [a.l@] ]b ;
ifnot: adm:fkt!b!b@ \ ( b fkt -- b )
: adm:fkt!b!b@ b[ [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!s! \ ( s fkt -- )
: adm:fkt!s! b[ [a!] [a.s!] ]b ;
\ dm-funktionen
ifnot: adm:dmget \ ( dmnr -- dm ) - marker lesen
: adm:dmget 1B adm:fkt!b!l@ ;
ifnot: adm:dmact \ adm:dmact ( dmnr -- ) - marker aktivieren
: adm:dmact 19 adm:fkt!b!b@ drop ;
\ adm-funktionen
\ adm:aload ( cstr -- ) - neuen administra-code laden
ifnot: adm:load
: adm:load
60 adm:fkt!s! ;
\ bel-funktionen
\ bel:load ( cstr -- ) - bellatrix-code laden
\ achtung: die gesamte loader-operation ist eine atomare
\ operation über alle drei propellerchips, kann also auch
\ nicht aufgetrennt werden!
ifnot: bel:load
: bel:load
52 adm:open .err \ datei öffnen
b[
0 [b!] 63 [b!] \ bella-loader starten
10 0 do 06 [a!] [a@] [b!] loop \ header einlesen
0A [a!] 0 [a.l!] \ 0 adm:seek
[b@] <8 [b@] or \ dateilänge empfangen
0 do 06 [a!] [a@] [b!] loop \ datei senden
]b
adm:close .err \ datei schließen
;
\ ------------------------------------ mod:tools
ifnot: aload
: aload \ name ( -- ) - administra-code laden
mount? parsenw dup
if adm:load 0 else drop 23 then .err ;
ifnot: bload
: bload \ name ( -- ) - bellatrix-code laden
mount? parsenw dup
if bel:load 0 else drop 23 then .err ;
ifnot: .dmstatus \ ( dm -- ) - ausgabe marker-status
: .dmstatus -1 = if ." frei" else ." gesetzt" then cr ;
ifnot: dm?
: dm?
." [root] : " 0 adm:dmget .dmstatus
." [sys ] : " 1 adm:dmget .dmstatus
." [usr ] : " 2 adm:dmget .dmstatus
." [ A ] : " 3 adm:dmget .dmstatus
." [ B ] : " 4 adm:dmget .dmstatus
." [ C ] : " 5 adm:dmget .dmstatus ;
\ open name ( -- ) - datei lesend öffnen und auf fehler prüfen
ifnot: open
: open
mount? parsenw dup
if 52 adm:open else drop 23 then .err ;
\ close ( -- ) - geöffnete datei schließen
ifnot: close
: close
adm:close .err ;
\ (cat) ( -- ) - alle zeichen der geöffneten datei ab
\ lesemarke auf ausgabekanal bis zum eof ausgeben
ifnot: (cat)
: (cat) begin adm:getc emit adm:eof until ;
\ cat name ( -- ) - datei "name" komplett ausgeben
ifnot: cat
: cat open (cat) close ;
\ nextline ( -- ) - ausgabe der nächsten textzeile aus der
\ geöffneten datei
ifnot: nextline
: nextline
begin adm:getc dup emit 0d = adm:eof or until ;
\ nextlines ( n -- ) - ausgabe von n zeilen
ifnot: nextlines
: nextlines
0 do adm:eof 0= if nextline then loop ;
\ less name ( -- ) - zeilenweise ausgabe der datei
ifnot: less
: less
open begin 10 nextlines key 71 = adm:eof or until close ;
\ #C ( c1 -- ) prepend the character c1 to the number
\ currently being formatted
ifnot: #C
: #C -1 >out W+! pad>out C! ;
\ .cogch ( n1 n2 -- ) print as x(y)
ifnot: .cogch
: .cogch <# 29 #C # 28 #C drop # #> .cstr ;
\ j ( -- n1 ) the second most current loop counter
ifnot: j
: j _rsptr COG@ 5 + COG@ ;
\ cog? ( -- )
ifnot: cog?
: cog?
8 0 do ." Cog:" i dup . ." #io chan:"
dup cognchan . cogstate C@
dup 4 and if version W@ .cstr then
dup 10 and if i cognumpad version W@ C@ over C@ -
spaces .cstr then
14 and if i cogio i cognchan 0 do
i 4* over + 2+ W@ dup 0= if drop else
space space j i .cogch ." ->" io>cogchan .cogch
then
loop
drop then cr loop ;
\ jede erweiterung legt ein wort als startmarke
\ nmit folgendem namen an:
\ mod:xxx - softwaremodule
\ drv:xxx - treiber
\ lib:xxx - bibliotheken
\ so kann mit den folgenden kommandos eine schnelle liste der
\ vorhandenen erweiterungen abgerufen und mit forget
\ aus dem system entfernt werden
\ mod? ( -- ) - anzeige der module
ifnot: mod?
: mod? c" mod:" _words ;
\ lib? ( -- ) - anzeige der bibliotheken
ifnot: lib?
: lib? c" lib:" _words ;

View File

@ -0,0 +1,325 @@
: 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ä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ä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ä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 ;

Binary file not shown.

View File

@ -0,0 +1,54 @@
hex
ifnot: lib:wav
: lib:wav ;
\ kommandoformen
ifnot: adm:fkt!b@ \ ( fkt -- b )
: adm:fkt!b@ b[ [a!] [a@] ]b ;
ifnot: adm:fkt!s!b@ \ ( s fkt -- b )
: adm:fkt!s!b@ b[ [a!] [a.s!] [a@] ]b ;
ifnot: adm:fkt!l@l@ \ ( fkt -- l l )
: adm:fkt!l@l@ b[ [a!] [a.l@] [a.l@] ]b ;
\ wave-funktionen
\ 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 ;
\ wav:status ( -- status )
ifnot: wav:status
: wav:status
98 adm:fkt!b@ ;
\ wav:leftvol ( vol -- )
ifnot: wav:leftvol
: wav:leftvol
99 adm:fkt!b! ;
\ wav:rightvol ( vol -- )
ifnot: wav:rightvol
: wav:rightvol
9A adm:fkt!b! ;
\ wav:pause ( -- )
ifnot: wav:pause
: wav:pause
9B adm:fkt!b@ drop ;
\ wav:position ( -- len pos )
ifnot: wav:position
: wav:position
9C adm:fkt!l@l@ ;

View File

@ -0,0 +1,16 @@
fl
\ _words ( cstr -- ) prints the words in the forth dictionary starting with cstr, 0 prints all
: _words lastnfa
begin
2dup swap dup if npfx else 2drop -1 then
if dup .strname space then
nfa>next dup 0=
until 2drop cr ;
\ words ( -- ) prints the words in the forth dictionary, if the pad has another string following, with that prefix
: words parsenw _xwords ;
: t1 1000 0 do i . loop ;
: t2 1000 0 do ." test " loop ;

Binary file not shown.

View File

@ -0,0 +1,93 @@
hex
ifnot: mod:wplay
: mod:wplay ;
\ kommandoformate
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 ;
\ wave-funktionen
\ 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 ;
\ wav:status ( -- status )
ifnot: wav:status
: wav:status
98 adm:fkt!b@ ;
\ adm-funktionen
\ 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@ ;
\ metafunktionen
\ won
ifnot: won
: won
0 adm:setsound 3 adm:setsound 2drop ;
\ woff
ifnot: woff
: woff
2 adm:setsound 1 adm:setsound 2drop ;
\ wend? ( -- t/f )
ifnot: wend?
: wend?
begin 50 delms key? dup if key drop then wav:status 0= or until ;
\ (wplay) ( cstr -- )
ifnot: (wplay)
: (wplay) \ ( cstr -- )
." Datei : " dup .cstr cr wav:start .err wend? wav:stop ;
\ wplay name ( -- )
ifnot: wplay
: wplay
won parsenw (wplay) woff ;
\ files? ( -- cnt ) - anzahl dateien im dir
ifnot: files?
: files?
adm:diropen
0 begin adm:nextfile swap 1+ swap 0= until 3 - padbl ;
\ filenr? ( nr -- )
ifnot: filenr?
: filenr?
adm:diropen
0 do adm:nextfile drop loop ;
\ wdirplay ( -- ) - gesamtes verzeichnis abspielen
\ im verzeichnis dürfen nur wav-dateien sein!
ifnot: wdirplay
: wdirplay
won files? dup ." Dateien : " . cr
0 do i dup 1 + . 3 + filenr? pad (wplay) loop padbl woff ;

Binary file not shown.

Binary file not shown.

Binary file not shown.

BIN
bstl.exe

Binary file not shown.

Binary file not shown.

View File

@ -1,51 +0,0 @@
{\rtf1\ansi\deff1\adeflang1025
{\fonttbl{\f0\froman\fprq2\fcharset128 Liberation Serif{\*\falt Times New Roman};}{\f1\fswiss\fprq0\fcharset0 Arial;}{\f2\fswiss\fprq2\fcharset128 Liberation Sans{\*\falt Arial};}{\f3\fswiss\fprq0\fcharset0 Arial;}{\f4\fnil\fprq2\fcharset128 DejaVu Sans;}}
{\colortbl;\red0\green0\blue0;\red128\green128\blue128;}
{\stylesheet{\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\rtlch\af1\afs24\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs24\lang1031\loch\f1\fs24\lang1031\snext1 Normal;}
{\s2\sb240\sa120\keepn\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\rtlch\af4\afs28\lang1081\ltrch\dbch\af4\langfe2052\hich\f2\fs28\lang1031\loch\f2\fs28\lang1031\sbasedon1\snext3 Heading;}
{\s3\sa120\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\rtlch\af1\afs24\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs24\lang1031\loch\f1\fs24\lang1031\sbasedon1\snext3 Body Text;}
{\s4\sa120\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\rtlch\af1\afs24\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs24\lang1031\loch\f1\fs24\lang1031\sbasedon3\snext4 List;}
{\s5\sb120\sa120\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\rtlch\af1\afs24\lang1081\ai\ltrch\dbch\af1\langfe2052\hich\f1\fs24\lang1031\i\loch\f1\fs24\lang1031\i\sbasedon1\snext5 caption;}
{\s6\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\rtlch\af1\afs24\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs24\lang1031\loch\f1\fs24\lang1031\sbasedon1\snext6 Index;}
{\*\cs8\cf0\rtlch\af1\afs24\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs24\lang1031\loch\f1\fs24\lang1031 Numbering Symbols;}
}{\*\listtable{\list\listtemplateid1
{\listlevel\levelnfc0\leveljc0\levelstartat6\levelfollow0{\leveltext \'02\'00.;}{\levelnumbers\'01;}\fi-360\li360}
{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'03\'00.\'01;}{\levelnumbers\'01\'03;}\fi-360\li720}
{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'06\'00.\'01.\'02.;}{\levelnumbers\'01\'03\'05;}\fi-360\li1080}
{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'08\'00.\'01.\'02.\'03.;}{\levelnumbers\'01\'03\'05\'07;}\fi-360\li1440}
{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'0a\'00.\'01.\'02.\'03.\'04.;}{\levelnumbers\'01\'03\'05\'07\'09;}\fi-360\li1800}
{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'0c\'00.\'01.\'02.\'03.\'04.\'05.;}{\levelnumbers\'01\'03\'05\'07\'09\'0b;}\fi-360\li2160}
{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'0e\'00.\'01.\'02.\'03.\'04.\'05.\'06.;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d;}\fi-360\li2520}
{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'10\'00.\'01.\'02.\'03.\'04.\'05.\'06.\'07.;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d\'0f;}\fi-360\li2880}
{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'12\'00.\'01.\'02.\'03.\'04.\'05.\'06.\'07.\'08.;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d\'0f\'11;}\fi-360\li3240}
{\*\soutlvl{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'14\'00.\'01.\'02.\'03.\'04.\'05.\'06.\'07.\'08.\'09.;}{\levelnumbers\'01\'03\'05\'07\'09\'0b\'0d\'0f\'11\'13;}\fi-360\li3600}}\listid1}
{\list\listtemplateid2
{\listlevel\levelnfc0\leveljc0\levelstartat1\levelfollow0{\leveltext \'02\'00.;}{\levelnumbers\'01;}\fi-360\li360}\listid2}
}{\listoverridetable{\listoverride\listid1\listoverridecount0\ls0}{\listoverride\listid2\listoverridecount0\ls1}}
{\info{\creatim\yr0\mo0\dy0\hr0\min0}{\revtim\yr0\mo0\dy0\hr0\min0}{\printim\yr0\mo0\dy0\hr0\min0}{\comment StarWriter}{\vern3200}}\deftab720
{\*\pgdsctbl
{\pgdsc0\pgdscuse195\pgwsxn12240\pghsxn15840\marglsxn1800\margrsxn1800\margtsxn1440\margbsxn1440\pgdscnxt0 Standard;}}
{\*\pgdscno0}\paperh15840\paperw12240\margl1800\margr1800\margt1440\margb1440\sectd\sbknone\pgwsxn12240\pghsxn15840\marglsxn1800\margrsxn1800\margtsxn1440\margbsxn1440\ftnbj\ftnstart1\ftnrstcont\ftnnar\aenddoc\aftnrstcont\aftnstart1\aftnnrlc
\pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031
\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031
\par \pard\plain \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031
\par \pard\plain {\listtext\pard\plain \li360\ri0\lin360\rin0\fi-360\fs20\fs20\fs20 1.\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\li720\ri0\lin720\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 \'dcbersicht}
\par \pard\plain {\listtext\pard\plain \li360\ri0\lin360\rin0\fi-360\fs20\fs20\fs20 2.\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\li720\ri0\lin720\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 Installation}
\par \pard\plain {\listtext\pard\plain \li360\ri0\lin360\rin0\fi-360\fs20\fs20\fs20 3.\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\li720\ri0\lin720\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 Regime CLI}
\par \pard\plain {\listtext\pard\plain \li360\ri0\lin360\rin0\fi-360\fs20\fs20\fs20 4.\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\li720\ri0\lin720\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 Ordnerstruktur und Tools}
\par \pard\plain {\listtext\pard\plain \li360\ri0\lin360\rin0\fi-360\fs20\fs20\fs20 5.\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\li720\ri0\lin720\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 Systemstart}
\par \pard\plain {\listtext\pard\plain \li360\ri0\lin360\rin0\fi-360\fs20\fs20\fs20 6.\tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\ls1\li720\ri0\lin720\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 Programmieren}
\par \pard\plain {\listtext\pard\plain \li360\ri0\lin360\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li720\ri0\lin720\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.1 IOS}
\par \pard\plain {\listtext\pard\plain \li360\ri0\lin360\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li720\ri0\lin720\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.2 Regnatix-Loader}
\par \pard\plain {\listtext\pard\plain \li360\ri0\lin360\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li720\ri0\lin720\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.3 Administra-Code}
\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl1 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li1080\ri0\lin1080\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.3.1 SD-Card}
\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl1 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li1080\ri0\lin1080\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.3.2 Sound (HSS, Wav, SIDCog)}
\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl1 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li1080\ri0\lin1080\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.3.3 LAN}
\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl1 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li1080\ri0\lin1080\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.3.4 COM}
\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl1 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li1080\ri0\lin1080\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.3.5 I2C}
\par \pard\plain {\listtext\pard\plain \li360\ri0\lin360\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl0 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li720\ri0\lin720\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.4 Bellatrix-Code}
\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl1 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li1080\ri0\lin1080\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.4.1 Textmodus}
\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl1 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li1080\ri0\lin1080\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.4.2 Grafikmodus}
\par \pard\plain {\listtext\pard\plain \li720\ri0\lin720\rin0\fi-360\fs20\fs20\fs20 \tab}\ilvl1 \ltrpar\s1\cf0{\*\hyphen2\hyphlead2\hyphtrail2\hyphmax0}\li1080\ri0\lin1080\rin0\fi-360\rtlch\af1\afs20\lang1081\ltrch\dbch\af1\langfe2052\hich\f1\fs20\lang1031\loch\f1\fs20\lang1031 {\rtlch \ltrch\loch\f1\fs20\lang1031\i0\b0 5.4.3 Keyboard und Maus}
\par }

Binary file not shown.

View File

@ -0,0 +1,89 @@
''***************
''* PASD Test *
''***************
''
CON
'Use the following 2 lines if running on a Parallax PropDemo board
_clkmode = xtal1 + pll16x
_xinfreq = 5_000_000
'Use the following 2 lines if running on a Hydra board
'_clkmode = xtal1 + pll8x
'_xinfreq = 10_000_000
VAR
long Cog, TestVar
OBJ
dbg : "PASDebug" '<---- Add for Debugger
PUB main
Cog := cognew(@entry, @TestVar) + 1
dbg.start(31,30,@entry) '<---- Add for Debugger
PUB stop
if Cog
cogstop(Cog~ - 1)
DAT
org 0
entry
' --------- Debugger Kernel add this at Entry (Addr 0) ---------
long $34FC1202,$6CE81201,$83C120B,$8BC0E0A,$E87C0E03,$8BC0E0A
long $EC7C0E05,$A0BC1207,$5C7C0003,$5C7C0003,$7FFC,$7FF8
' --------------------------------------------------------------
'
' Test code with modify, MainRAM access, jumps, subroutine and waitcnt.
'
:init mov dira,LEDS ' Configure LEDs as outputs (1)
andn outa,LEDS ' Set LEDs to the 'Off' state (0)
mov BlinkCounter,#0 ' Clear blink counter
:led_state_1 or outa,LED_0 ' Turn on LED 0 (Hydra)
or outa,LED_16 ' Turn on LED 16 (PropDemo)
andn outa,LED_17 ' Turn off LED 17 (PropDemo)
call #wait ' Delay
:led_state_2 andn outa,LED_0 ' Turn off LED 0 (Hydra)
andn outa,LED_16 ' Turn off LED 16 (PropDemo)
or outa,LED_17 ' Turn on LED 17 (PropDemo)
call #wait
add BlinkCounter,#1
cmp BlinkCounter,#5 wz
if_z jmp #:init
jmp #:led_state_1
wait mov WaitCounter,cnt
add WaitCounter,BlinkFreq
waitcnt WaitCounter,BlinkFreq
wait_ret ret
'
' VARIABLES
'
BlinkCounter long 0
LEDS long $00FF_0001 ' Bits 16-23 are PropDemo board leds. Bit 0 is Hydra LED.
LED_0 long $0000_0001 ' Hydra LED.
LED_16 long $0001_0000 ' PropDemo board LED.
LED_17 long $0002_0000 ' PropDemo board LED.
BlinkFreq long 40_000_000
WaitCounter res 1
fit

View File

@ -0,0 +1,355 @@
''****************************************
''* Propeller Assembly Source Debugger *
''* (PASD) needs PASD.exe on PC *
''****************************************
'' version 0.2 , August 2007
''
'' (c)2007 Andy Schenk, Insonix GmbH
'' www.insonix.ch/propeller
'' It's allowed to use this only for non commercial projects.
CON
BAUDRATE = 115200
VAR
long cog 'cog flag/id
long serpins '11 contiguous longs
long bitticks
long cpntr 'pointer to code in main ram
PUB start(rxpin, txpin, codeptr) : okay
'' Start PASD driver - starts a cog
'' returns false if no cog available
''
longfill(@serpins, 0, 3)
serpins := txpin<<16 + rxpin
bitticks := clkfreq / BAUDRATE
cpntr := codeptr
okay := cog := cognew(@entry, @serpins) + 1
repeat until bitticks == 0 'wait until PC ready
PUB stop
'' Stop the driver - frees a cog
if cog
cogstop(cog~ - 1)
DAT
'*********************************
'* Assembly language PASD driver *
'*********************************
org
entry
mov t1,par 'get parameter address
rdword t2,t1 'get rx_pin
mov rxmask,#1
shl rxmask,t2
add t1,#2 'get tx_pin
rdword t2,t1
mov txmask,#1
pasdi shl txmask,t2
add t1,#2 'get bit ticks
pasdd rdlong bittime,t1
pasdp add t1,#4 'get codepointer
pasdr rdlong cogadr,t1
sub t1,#4
or outa,txmask 'tx_pin = output/idle
or dira,txmask
call #charin 'wait until PC sends start
wrlong K0,t1 'report ready to spin
wrlong K0,sharep 'prepare execute
cmdloop call #charin 'wait for cmd from PC
cmp rxd,#5 wz 'mouse/debugger command?
if_nz jmp #cmdloop
call #charin 'Command
mov t1,rxd
and t1,#$7F
call #charin 'Val L
mov t2,rxd
call #charin 'Val H
shl rxd,#8
or t2,rxd
cmp t1,#"d" wz 'dump cog ram?
if_z jmp #dumpcog
cmp t1,#"m" wz 'dump hub-ram?
if_z jmp #dumphub
cmp t1,#"i" wz 'Init?
if_z jmp #initpar
cmp t1,#"r" wz 'Run/Cont?
if_z jmp #runcont
cmp t1,#"p" wz 'Stop? = Restart
if_z jmp #resetcog
cmp t1,#"s" wz 'Step?
if_z jmp #single
cmp t1,#"b" wz 'Set Break?
if_z jmp #setbrk
cmp t1,#"w" wz 'Write clong?
if_z jmp #wrcode
cmp t1,#"l" wz 'Low word clong
if_z jmp #lowword
cmp t1,#"h" wz 'High word clong
if_z jmp #highword
cmp t1,#"e" wz 'Execute clong
if_z jmp #execlong
jmp #cmdloop
'-------------
dumpcog mov t3,#511
movs i_getind,#0
dcloop mov op,i_getind
call #execute
mov op,i_write
call #execute
add i_getind,#1
rdlong t1,shareg
call #sendlong
djnz t3,#dcloop
mov op,i_nop
call #execute
jmp #cmdloop
'-------------
dumphub mov t3,#128
dhloop rdlong t1,t2
call #sendlong
add t2,#4
djnz t3,#dhloop
mov op,i_nop
call #execute
jmp #cmdloop
'-------------
resetcog cogstop cognr
mov t1,cogpar 'restart cog
shl t1,#14
or t1,cogadr
shl t1,#2
or t1,cognr
coginit t1
jmp #cmdloop
'-------------
initpar mov op,i_cogid 'get cogid
call #execute
mov op,i_write
call #execute
rdlong cognr,shareg
movs i_getind,#$1F0 'get cogpar-reg
mov op,i_getind
call #execute
mov op,i_write
call #execute
rdlong cogpar,shareg
mov t1,cogadr
call #sendlong
jmp #cmdloop
'-------------
runcont movs i_jump,t2 'start addr
wrlong K0,shareg 'clr brk addr
mov op,i_jump
call #execute 'jump
'-------------
waitbrk mov dtime,rate
waitlp test rxmask,ina wz 'if not rx start
if_z jmp #cmdloop
djnz dtime,#waitlp 'wait rate
mov t1,watchId
call #sendlong 'send ina repeatly
mov t1,ina
call #sendlong
rdlong t1,shareg
tjz t1,#waitbrk 'wait for break
shl t1,#16
or t1,brkId 'add Break ID
call #sendlong
jmp #cmdloop
'-------------
single movs i_getind,t2 'get Instr from addr
getsngl mov op,i_getind
call #execute
mov op,i_write
'dosngle call #execute
call #execute
rdlong op,shareg 'and execute
dosngle wrlong K0,shareg 'clr brk addr
call #execute
rdlong t1,shareg wz 'get addr+c/z
if_nz jmp #waitbrk 'if no break
mov op,i_break
call #execute 'force break ??
jmp #waitbrk
'-------------
execlong mov op,clong 'Exec 1 op in clong
jmp #dosngle
'-------------
lowword mov clong,t2
jmp #cmdloop
'-------------
highword shl t2,#16
or clong,t2
jmp #cmdloop
'-------------
setbrk wrlong i_break,shareg 'break instr
jmp #wrtoadr
'-------------
wrcode wrlong clong,shareg 'write code
wrtoadr movd i_setind,t2 'to addr
mov op,i_setind
call #execute
jmp #cmdloop
'-------------
i_getind mov pasdd,0-0 'opcodes for asm cog
i_write wrlong pasdd,pasdr
i_nop nop
i_cogid cogid pasdd
i_jump jmp #0-0
i_setind rdlong 0-0,pasdr
i_break jmpret pasdd,#0
i_clrd mov pasdd,#0
'-------------
execute wrlong op,sharep 'set instruction
mov dtime,#72
add dtime,cnt 'wait for execution
waitcnt dtime,#48
wrlong K0,sharep 'sync
waitcnt dtime,#32
execute_ret ret
'-------------
sendlong mov txd,t1 'send long t1 as 4 bytes
call #charout
mov txd,t1
shr txd,#8
call #charout
mov txd,t1
shr txd,#16
call #charout
mov txd,t1
shr txd,#24
call #charout
sendlong_ret ret
'-------------
charout and txd,#$FF 'send 1 character
mov txcnt,#10
or txd,#$100 'add stoppbit
shl txd,#1 'add startbit
mov dtime,cnt
add dtime,bittime
sendbit shr txd,#1 wc 'test LSB
mov ti,outa
if_nc andn ti,txmask 'bit=0 or
if_c or ti,txmask 'bit=1
mov outa,ti
waitcnt dtime,bittime 'wait 1 bit
djnz txcnt,#sendbit '10 times
waitcnt dtime,bittime '2 stopbits
charout_ret ret
'------------
charin test rxmask,ina wz 'wait until stop
if_z jmp #charin
charstart test rxmask,ina wz 'wait until startbit
if_nz jmp #charstart
mov dtime,bittime
shr dtime,#1
add dtime,bittime '1.5 bittime
add dtime,cnt
mov rxcnt,#8
mov rxd,#0
charbits waitcnt dtime,bittime
shr rxd,#1
test rxmask,ina wz 'shift in bits
if_nz or rxd,#$80
djnz rxcnt,#charbits
waitcnt dtime,bittime 'wait until stopbit
charin_ret ret
'------------
'
' Initialized data
'
sharep long $7FFC
shareg long $7FF8
K512 long 512
K0 long 0
d_inc long $200
brkId long $7F06
rate long 400_000
watchId long $0006
'
' Uninitialized data
'
t1 res 1
t2 res 1
t3 res 1
bittime res 1
dtime res 1
rxmask res 1
rxd res 1
rxbits res 1
rxcnt res 1
txmask res 1
txd res 1
txcnt res 1
ti res 1
clong res 1
op res 1
cognr res 1
cogadr res 1
cogpar res 1
vp res 1
vparr res 1
' Add this little debugger kernel at the begin of your Assembly code:
{
' --------- Debugger Kernel add this at Entry (Addr 0) ---------
long $34FC1202,$6CE81201,$83C120B,$8BC0E0A,$E87C0E03,$8BC0E0A
long $EC7C0E05,$A0BC1207,$5C7C0003,$5C7C0003,$7FFC,$7FF8
' --------------------------------------------------------------
}

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,275 @@
{\rtf1\ansi\deff0{\fonttbl{\f0\fswiss\fcharset0 Arial;}}
{\*\generator Msftedit 5.41.15.1515;}\viewkind4\uc1\pard\lang1031\f0\fs20 char y=0, x=0 \par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
char y=0, x=1 \par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0003_3333_3300_0000\par
LONG %%0033_3000_3330_0000\par
LONG %%0330_0000_0033_0000\par
LONG %%3300_0000_0003_3000\par
LONG %%3300_0000_0000_3000\par
LONG %%3000_0000_0000_3300\par
LONG %%3000_0000_0000_3300\par
LONG %%3300_0000_0000_3000\par
LONG %%3300_0000_0003_3000\par
LONG %%0330_0000_0033_0000\par
LONG %%0033_3000_0333_0000\par
LONG %%0033_3333_3330_0000\par
LONG %%0333_0000_0333_0000\par
char y=0, x=2 \par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
char y=0, x=3 \par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3003_3330_0333_3300\par
LONG %%3033_3333_0333_3300\par
LONG %%3033_3333_0333_3300\par
char y=0, x=4 \par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%3000_3333_0000_3333\par
LONG %%3003_3333_3000_3333\par
LONG %%3003_3333_3000_3333\par
LONG %%3003_3333_3000_3333\par
LONG %%3003_3333_3000_3333\par
LONG %%3000_3333_0000_3333\par
LONG %%3000_0000_0000_3333\par
LONG %%3000_0000_0000_3333\par
char y=0, x=5 \par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%3330_0000_0000_3333\par
LONG %%3330_0000_0000_3333\par
LONG %%3330_0000_0000_3333\par
LONG %%3330_0000_0000_3333\par
LONG %%3330_0000_0000_3333\par
LONG %%3330_0000_0000_3333\par
LONG %%3330_0000_0000_3333\par
LONG %%3330_0000_0000_3333\par
char y=0, x=6 \par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%3333_3000_0000_0033\par
LONG %%3333_3333_0000_0033\par
LONG %%3333_3333_3000_0033\par
LONG %%3333_3333_3300_0033\par
LONG %%3333_3333_3330_0033\par
LONG %%0000_3333_3330_0033\par
LONG %%0000_0033_3333_0033\par
LONG %%3333_0003_3333_0033\par
char y=0, x=7 \par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
char y=1, x=0 \par
LONG %%0000_0000_0000_0000\par
LONG %%3330_0000_0000_0000\par
LONG %%0033_3000_0000_0000\par
LONG %%0000_3300_0000_0000\par
LONG %%0000_3300_0000_0000\par
LONG %%0000_0330_0000_0000\par
LONG %%0000_0330_0000_0000\par
LONG %%0000_0330_0000_0000\par
LONG %%0000_0330_0000_0000\par
LONG %%0000_3300_0000_0000\par
LONG %%0003_3000_0000_0000\par
LONG %%0333_0000_0000_0000\par
LONG %%3330_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
char y=1, x=1 \par
LONG %%3330_0000_0033_3000\par
LONG %%3300_0000_0003_3333\par
LONG %%3300_0000_0003_3300\par
LONG %%0330_0000_0033_0000\par
LONG %%0033_0000_0030_0000\par
LONG %%0033_0000_0330_0000\par
LONG %%0003_3333_3330_0000\par
LONG %%0003_3333_3330_0000\par
LONG %%0033_0000_0330_0000\par
LONG %%0033_0000_0030_0000\par
LONG %%0330_0000_0033_0000\par
LONG %%3300_0000_0003_3330\par
LONG %%0000_0000_0000_0333\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
char y=1, x=2 \par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0033_3333\par
LONG %%0000_0000_3330_0000\par
LONG %%0000_0000_3300_0000\par
LONG %%0000_0003_3000_0000\par
LONG %%0000_0003_0000_0000\par
LONG %%0000_0033_0000_0000\par
LONG %%0000_0003_0000_0000\par
LONG %%0000_0003_0000_0000\par
LONG %%0000_0003_3000_0000\par
LONG %%0000_0000_3300_0000\par
LONG %%0000_0000_0333_3033\par
LONG %%0000_0000_0003_3333\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
char y=1, x=3 \par
LONG %%3033_3333_0333_3300\par
LONG %%3033_3333_0333_3300\par
LONG %%3003_3330_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%3000_0000_0333_3300\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
char y=1, x=4 \par
LONG %%3003_3333_3000_3333\par
LONG %%3003_3333_3000_3333\par
LONG %%3003_3333_3000_3333\par
LONG %%3003_3333_3000_3333\par
LONG %%3003_3333_3000_3333\par
LONG %%0003_3333_3000_3333\par
LONG %%0003_3333_3000_3333\par
LONG %%0003_3333_3000_3333\par
LONG %%0003_3333_3000_3333\par
LONG %%0003_3333_3000_3333\par
LONG %%0003_3333_3000_3333\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
char y=1, x=5 \par
LONG %%3330_0000_0000_3333\par
LONG %%3330_0000_0000_3333\par
LONG %%3330_0000_0000_3333\par
LONG %%3330_0000_0003_3333\par
LONG %%3330_0000_0003_3333\par
LONG %%3330_0000_0033_3333\par
LONG %%3333_3333_3333_3333\par
LONG %%3333_3333_3333_3330\par
LONG %%3333_3333_3333_3300\par
LONG %%3333_3333_3333_3000\par
LONG %%3333_3333_3330_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
char y=1, x=6 \par
LONG %%3333_3003_3333_0033\par
LONG %%3333_3003_3333_0033\par
LONG %%3333_3003_3333_0033\par
LONG %%3333_3003_3333_0033\par
LONG %%3333_0033_3333_0033\par
LONG %%0000_3333_3330_0033\par
LONG %%3333_3333_3330_0033\par
LONG %%3333_3333_3300_0033\par
LONG %%3333_3333_3000_0033\par
LONG %%3333_3333_0000_0033\par
LONG %%3333_3000_0000_0033\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
char y=1, x=7 \par
LONG %%0000_0000_0000_0003\par
LONG %%0000_0000_0000_0003\par
LONG %%0000_0000_0000_0003\par
LONG %%0000_0000_0000_0003\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_3333\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
LONG %%0000_0000_0000_0000\par
}

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

90
forth/adm.lib Normal file
View File

@ -0,0 +1,90 @@
hex
ifnot: lib:adm
: lib:adm ;
\ kommandoformen
ifnot: adm:fkt! \ ( fkt -- )
: adm:fkt! b[ [a!] ]b ;
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b@ \ ( fkt -- b )
: adm:fkt!b@ b[ 0 [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!b!b@ \ ( b fkt -- b )
: adm:fkt!b!b@ b[ [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!l@ \ ( fkt -- l )
: adm:fkt!l@ b[ [a!] [a.l@] ]b ;
ifnot: adm:fkt!s! \ ( s fkt -- )
: adm:fkt!s! b[ [a!] [a.s!] ]b ;
\ administra-chipmanagment-funktionen
\ 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@ ;
\ adm:getspec ( -- spec ) - chipspezifikation abfragen
\
\ +---------- com
\ | +-------- i2c
\ | |+------- rtc
\ | ||+------ lan
\ | |||+----- sid
\ | ||||+---- wav
\ | |||||+--- hss
\ | ||||||+-- bootfähig
\ | |||||||+- dateisystem
\ %00000000_00000000_00000000_01001111
ifnot: adm:getspec
: adm:getspec
5D adm:fkt!l@ ;
\ adm:setsyssound ( syssnd -- ) - systemklänge
\ syssnd = 0 - systemklänge aus
\ syssnd = 1 - systemklänge an
ifnot: adm:setsyssound
: adm:setsyssound
5E adm:fkt!b! ;
\ adm:getsoundsys ( -- sndsys ) - abfrage aktives soundsystem
\ 0 - sound aus
\ 1 - hss
\ 2 - wav
ifnot: adm:getsoundsys
: adm:getsoundsys
5F adm:fkt!b@ ;
\ adm:load ( cstr -- ) - neuen administra-code laden
ifnot: adm:aload
: adm:aload
60 adm:fkt!s! ;
\ adm:getcogs ( -- cogs ) - anzahl der belegten cogs
ifnot: adm:getcogs
: adm:getcogs
61 adm:fkt!b@ ;
\ adm:getver ( -- ver ) - abfrage der codeversion
ifnot: adm:getver
: adm:getver
62 adm:fkt!l@ ;
\ adm:reset ( -- ) - reset administra
ifnot: adm:reset
: adm:reset
63 adm:fkt! ;

55
forth/ari.lib Normal file
View File

@ -0,0 +1,55 @@
hex
ifnot: lib:ari
: lib:ari ;
\ abs ( n1 -- abs_n1 ) absolute value of n1
ifnot: abs
: abs _execasm1>1 151 _cnip ;
\ u*/mod ( u1 u2 u3 -- u4 u5 ) u5 = (u1*u2)/u3, u4 is the
\ remainder. Uses a 64bit intermediate result.
ifnot: u*/mod
: u*/mod rot2 um* rot um/mod ;
\ u*/ ( u1 u2 u3 -- u4 ) u4 = (u1*u2)/u3 Uses a 64bit
\ intermediate result.
ifnot: u*/
: u*/ rot2 um* rot um/mod nip ;
\ sign ( n1 n2 -- n3 ) n3 is the xor of the sign bits of
\ n1 and n2
ifnot: sign
: sign xor 80000000 and ;
\ */mod ( n1 n2 n3 -- n4 n5 ) n5 = (n1*n2)/n3, n4 is the
\ remainder. Uses a 64bit intermediate result.
ifnot: */mod
: */mod 2dup sign >r abs rot dup r> sign >r abs rot abs
um* rot um/mod r> if negate swap negate swap then ;
\ */ ( n1 n2 n3 -- n4 ) n4 = (n1*n2)/n3. Uses a 64bit
\ intermediate result.
ifnot: */
: */ */mod nip ;
\ /mod ( n1 n2 -- n3 n4 ) \ signed divide & mod n4 = n1/n2,
\ n3 is the remainder
ifnot: /mod
: /mod 2dup sign >r abs swap abs swap u/mod r> if negate swap
negate swap then ;
\ * ( n1 n2 -- n1*n2) n1 multiplied by n2
ifnot: *
: * um* drop ;
\ / ( n1 n2 -- n1/n2) n1 divided by n2
ifnot: /
: / /mod nip ;
\ rnd ( -- n1 ) n1 is a random number from 00 - FF
ifnot: rnd
: rnd cnt COG@ 8 rshift cnt COG@ xor FF and ;

485
forth/basics.mod Normal file
View File

@ -0,0 +1,485 @@
fl
hex
: mod:basics ;
\ Copyright (c) 2010 Sal Sanci
\ Anpassung für Hive-System 2011 dr235
\ ------------------------------------------------------ BASICS
\ this words needs to align with the assembler code
: _stptr 5 _cv ;
: _sttop 2e _cv ;
\ _words ( cstr -- )
: _words lastnfa
begin
2dup swap dup if npfx else 2drop -1 then
if dup .strname space then
nfa>next dup 0=
until 2drop cr ;
\ words name ( -- ) prints the words in the forth dictionary
: words parsenw _words ;
\ .long ( n -- ) emit 8 hex digits
: .long dup 10 rshift .word .word ;
\ st? ( -- ) prints out the stack
: st? ." ST: " _stptr COG@ 2+ dup _sttop <
if _sttop swap - 0
do _sttop 2- i - COG@ .long space loop
else drop
then cr ;
\ variable ( -- ) skip blanks parse the next word and create
\ a variable, allocate a long, 4 bytes
: variable
lockdict create $C_a_dovarl w, 0 l, forthentry freedict ;
\ constant ( x -- ) skip blanks parse the next word and create
\ a constant, allocate a long, 4 bytes
: constant
lockdict create $C_a_doconl w, l, forthentry freedict ;
\ waitpeq ( n1 n2 -- ) \ wait until state n1 is equal to
\ ina anded with n2
: waitpeq _execasm2>0 1E0 _cnip ;
\ locknew ( -- n2 ) allocate a lock, result is in n2, -1
\ if unsuccessful
: locknew -1 4 hubop -1 = if drop -1 then ;
\ (forget) ( cstr -- ) wind the dictionary back to the word
\ which follows - caution
: (forget) dup
if
find if
pfa>nfa nfa>lfa dup here W! W@ wlastnfa W!
else .cstr 3f emit cr then
else drop then ;
\ forget ( -- ) wind the dictionary back to the word which
\ follows - caution
: forget parsenw (forget) ;
\ free ( -- ) display free main bytes and current cog longs
: free dictend W@ here W@ - . ." bytes free - " par
coghere W@ - . ." cog longs free" cr ;
\ ifnot: name ( -- ) - bedingte compilierung; wenn name schon
\ im wörterbuch vorhanden, wird bis zum nächsten semikolon
\ der eingabestrom ignoriert
: ifnot: parsenw nip find if begin key 3B = until
key drop then ;
\ bei konstrukte, die keine doppelpunkdefinition sind, muss der
\ block mit diesem Wort abgeschlossen werden
: :; ;
\ --------------------------------------------------------- BUS
\ bin ( -- ) - umschaltung auf duales zahlensystem
\ : bin 2 base W! ;
\ +---------------------------- /hs
\ |+--------------------------- /wr
\ ||+-------------------------- busclk
\ |||+------------------------- hbeat
\ ||||+------------------------ al
\ |||||+----------------------- /bel
\ ||||||+---------------------- /adm
\ |||||||+--------------------- /ram2
\ ||||||||+-------------------- /ram1
\ ||||||||| +--------- a0..10
\ ||||||||| |
\ ||||||||| | +- d0..7
\ |||||||||+---------++------+
\ 00000000000000000000000000000000
\ bin 00000111111111111111111100000000 constant dinp hex
\ bin 00000111111111111111111111111111 constant dout hex
\ bin 00000010000000000000000000000000 constant boff hex
\ bin 00000100011110000000000000000000 constant _s1 hex
\ bin 00000000001110000000000000000000 constant _b1 hex
\ bin 00000010001110000000000000000000 constant _b2 hex
\ bin 00000110001110000000000000000000 constant _b3 hex
\ bin 00000000010110000000000000000000 constant _a1 hex
\ bin 00000010010110000000000000000000 constant _a2 hex
\ bin 00000110010110000000000000000000 constant _a3 hex
\ bin 00001000000000000000000000000000 constant ?hs hex
8000000 constant ?hs
: [inp] \ ( -- ) bus eingabe
7FFFF00 dira COG! ; \ dinp
: [out] \ ( -- ) bus ausgabe
7FFFFFF dira COG! ; \ dout
: [off] \ ( -- ) bus aus
2000000 dira COG! 0 outa COG! ; \ boff
: [end] \ ( -- ) buskommunikation beendet
4780000 outa COG! [inp] ; \ _s1
: [hs=1] \ ( -- ) wartet auf hs = 1
?hs dup waitpeq ;
: [hs=0] \ ( -- ) warten auf hs = 0
0 ?hs waitpeq ;
: [s!] \ ( c ctrl -- ) sende 8 bit an einen slave
[out] [hs=1] swap ff and or outa COG! [hs=0] [end] ;
: [s@] \ ( ctrl -- c ) empfängt 8 bit von einem slave
[inp] [hs=1] outa COG! [hs=0] ina COG@ ff and [end] ;
: [b!] \ ( c -- ) sende 8 bit an bellatrix
2380000 [s!] ; \ _b2
: [a!] \ ( c -- ) sende 8 bit an administra
2580000 [s!] ; \ _a2
: [b@] \ ( -- c ) empfängt 8 bit von bellatrix
6380000 [s@] ; \ _b3
: [a@] \ ( -- c ) empfängt 8 bit von administra
6580000 [s@] ; \ _a3
: <8 \ ( -- )
8 lshift ;
\ [b.l!] ( 32b -- ) - long an bellatrix senden
: [b.l!]
dup 18 rshift [b!]
dup 10 rshift [b!]
dup 8 rshift [b!]
[b!] ;
\ [b.l@] ( -- 32b ) - long von bellatrix einlesen
: [b.l@]
[b@] <8
[b@] or <8
[b@] or <8
[b@] or ;
\ [a.s@] ( -- ) - einen cstring von administra empfangen
\ und im pad speichern
: [a.s@]
[a@] pad 2dup C! 1+ swap
0 do dup [a@] swap C! 1+ loop drop ;
\ [a.s!] ( cstr -- ) - einen cstring an administra senden
: [a.s!]
dup C@ dup [a!] \ ( -- cstr len ) len senden
0 do \ ( cstr len -- cstr )
1+ dup C@ [a!] \ ( cstr -- cstr+1 ) zeichen senden
loop drop ; \ ( cstr -- )
\ [a.w@] ( -- 16b ) - 16bit-wert von administra einlesen
: [a.w@]
[a@] <8 [a@] or ;
\ [a.l!] ( 32b -- ) - long an administra senden
: [a.l!]
dup 18 rshift [a!]
dup 10 rshift [a!]
dup 8 rshift [a!]
[a!] ;
\ [a.l@] ( -- 32b ) - long von administra einlesen
: [a.l@]
[a@] <8
[a@] or <8
[a@] or <8
[a@] or ;
wvariable b[lock] \ nummer der semaphore für den
\ zugriff auf die bus-hardware
\ b[ ( -- ) bus belegen; wartet bis semaphore freigegeben ist
: b[ begin b[lock] W@ lockset -1 <> until [inp] ;
\ ]b ( -- ) bus freigeben
\ ! busclk bleibt auf ausgabe, da dieses signal sonst
\ kein definierten pegel besitzt !
: ]b [off] b[lock] W@ lockclr drop ;
\ administra-kommandoformate
: b[a! b[ [a!] ;
: b[a!a! b[ [a!] [a!] ;
: adm:fkt! b[a! ]b ; \ ( fkt -- )
: adm:fkt!b@ b[a! [a@] ]b ; \ ( fkt -- b )
: adm:fkt!b! b[a!a! ]b ; \ ( b fkt -- )
: adm:fkt!b!b@ b[a!a! [a@] ]b ; \ ( b fkt -- b )
: adm:fkt!s@ b[a! [a.s@] ]b ; \ ( fkt -- )
: adm:fkt!s!b@ b[a! [a.s!] [a@] ]b ; \ ( s fkt -- b )
: adm:fkt!b!l@ b[a!a! [a.l@] ]b ; \ ( b fkt -- l )
\ ----------------------------------------------------- SD0.LIB
\ marker-funktionen
\ adm:dmact ( dmnr -- ) - marker aktivieren
: adm:dmact 19 adm:fkt!b!b@ drop ;
\ adm:dmset ( dmnr -- ) - marker setzen
: adm:dmset 1A adm:fkt!b! ;
\ dateisystem-funktionen
\ adm:volname ( -- ) - name des volumes im pad ablegen
: adm:volname 0C adm:fkt!s@ ;
\ adm:mount ( -- err ) - medium mounten
: adm:mount 01 adm:fkt!b@ ;
\ adm:unmount ( -- err ) - medium unmounten
: adm:unmount 18 adm:fkt!b@ ;
\ adm:checkmounted ( -- t/f )
: adm:checkmounted 0D adm:fkt!b@ ;
\ adm:diropen ( -- ) - verzeichnisabfrage initialisieren
: adm:diropen 02 adm:fkt! ;
\ adm:nextfile ( -- st )
\ st = 0 - keine gültige datei
\ st = 1 - dateiname im pad gültig
\ bei gültigem eintrag befindet sich der dateiname im pad
: adm:nextfile b[ 3 [a!] [a@] dup if [a.s@] then ]b ;
\ adm:fattrib ( nr -- attrib ) - dateiattribut abfragen
: adm:fattrib 0B adm:fkt!b!l@ ;
\ adm:chdir ( cstr -- err ) - verzeichnis öffnen
: adm:chdir 16 adm:fkt!s!b@ ;
\ adm:getc ( -- c ) - ein zeichen aus der geöffneten datei lesen
: adm:getc 06 adm:fkt!b@ ;
\ adm:eof ( -- eof ) - abfrage ob end of file erreicht ist
: adm:eof 1E adm:fkt!b@ ;
\ adm:open ( cstr modus -- err ) - datei öffnen
\ modus "R" $52 - Read
\ modus "W" $57 - Write
\ modus "A" $41 - Append
: adm:open b[ 4 [a!] [a!] [a.s!] [a@] ]b ;
\ adm:close ( -- ) - datei schließen
: adm:close 05 adm:fkt!b@ ;
\ ----------------------------------------------------- SCR.LIB
\ [dscr] ( scrnr -- ) display-screen setzen
: [dscr] 0 [b!] 59 [b!] [b!] ;
\ [wscr] ( scrnr -- ) schreib-screen setzen
: [wscr] 0 [b!] 58 [b!] [b!] ;
\ [key?] ( -- c ) - ungekapselte tastaturstatusabfrage
: [key?] 0 [b!] 1 [b!] [b@] ;
\ [key] ( -- c ) - ungekapselte tastaturabfrage
: [key] 0 [b!] 2 [b!] [b@] ;
\ [emit] ( c -- ) - ungekapselte zeichenausgabe
: [emit] emit? if emit then ;
\ ----------------------------------------------------- TOOLS
\ cls ( -- ) - screen löschen
: cls 01 emit ;
\ .tab ( -- ) - tabulator
: .tab 09 emit ;
\ .err ( err -- ) - fehlermeldung ausgeben
\ 0 no error
\ 1 fsys unmounted
\ 2 fsys corrupted
\ 3 fsys unsupported
\ 4 not found
\ 5 file not found
\ 6 dir not found
\ 7 file read only
\ 8 end of file
\ 9 end of directory
\ 10 end of root
\ 11 dir is full
\ 12 dir is not empty
\ 13 checksum error
\ 14 reboot error
\ 15 bpb corrupt
\ 16 fsi corrupt
\ 17 dir already exist
\ 18 file already exist
\ 19 out of disk free space
\ 20 disk io error
\ 21 command not found
\ 22 timeout
\ 23 parameter error
: .err dup if ERR then drop ;
\ .pad ( -- ) - ausgabe eines strings im pad
: .pad pad .cstr ;
\ .vname ( -- ) - ausgabe des namens der eingelegten sd-card
: .vname adm:volname .pad ;
\ mount ( -- ) - sd-card mounten
: mount adm:mount .err ." Medium : " .vname cr ;
\ unmount ( -- ) - sd-card unmounten
: unmount adm:unmount .err ;
\ mount? ( -- ) - test ob medium mounted ist
\ wird als exception gewertet
: mount? adm:checkmounted 0= if 1 .err then ;
\ padbl ( -- ) fills this cogs pad with blanks
: padbl pad padsize bl fill ;
\ .entry ( -- st ) - einen verzeichniseintrag ausgeben
: .entry
adm:nextfile 13 adm:fattrib if 0F emit else space then
dup if .pad .tab then ;
\ .len ( st -- st ) - dateilänge ausgeben
: .len dup if 0 adm:fattrib . then ;
\ lscnt ( cnt1 st -- cnt2 st ) - spaltenformatierung für ls
\ cnt - spaltenzähler, st - flag verzeichnisende
: lscnt
swap 1+ dup 4 = if cr drop 0 else .tab then swap ;
\ lsl ( -- ) - verzeichnis anzeigen, long-format
: lsl mount?
adm:diropen begin .entry .len cr 0= until padbl ;
\ ls ( -- ) - verzeichnis in spalten anzeigen
: ls mount?
adm:diropen 0 begin .entry lscnt 0= until drop padbl cr ;
\ cd name ( -- ) - verzeichnis wechseln
: cd mount? parsenw adm:chdir .err ;
\ open name ( -- ) - datei lesend öffnen und auf fehler prüfen
: open
mount? parsenw dup
if 52 adm:open else drop 23 then .err ;
\ close ( -- ) - geöffnete datei schließen
: close adm:close .err ;
\ dload name - datei compilieren; log im gleichen screen
\ load name - datei compilieren; log screen 3
\ sys name - datei aus sys compilieren; log screen 3
\ die datei wird in der nächsten freien cog compiliert
\ fl ist für load nicht nötig und bringt in dem kontext
\ die cog-zuordnung durcheinander
: (load)
begin adm:getc emit adm:eof until ;
: (dload)
open cogid nfcog iolink
(load)
cogid iounlink close ;
: (sload)
open cogid 3 dup b[ [wscr] ]b iolink
(load)
cogid dup b[ [wscr] ]b iounlink close ;
: load
." Loading... " (sload) ;
: dload
(dload) ;
: sys
2 adm:dmset 1 adm:dmact ." Loading... " (sload) 2 adm:dmact ;
\ ------------------------------------------------- SPIN-LOADER
\ (spin) ( cstr -- ) - c" reg.sys" (spin)
: (spin)
dup C@ 1+
0 do
dup i + C@
ldvar 1+ i + C!
loop drop
1 ldvar C!
;
\ spin name ( -- ) - spinobjekt "name" starten
: spin
parsenw (spin) ;
\ regime ( -- ) - startet dir trios-cli "regime"
: regime
0 adm:dmact
c" reg.sys" (spin) ;
\ ----------------------------------------------------- DRV:INT
wvariable icog \ nummer der drv:int-cog
wvariable lcog \ nummer interaktiven cog
\ xint ( n -- ) io von cog n auf drv:int umschalten
: xint icog W@ ioconn ;
\ [cogscr] ( nr -- ) - umschaltung screen + cog
: [cogscr]
dup 2dup lcog W! xint [dscr] [wscr] ;
\ =n ( n1 n2 -- n1 n1=n2 )
: =n 2dup = swap drop ;
\ [esc] ( -- ) - manager für esc-funktionen im drv:int
: [esc]
begin [key?] until [key]
71 =n if 1b [emit] then \ esc - q : esc-char/quit
31 =n if 1 [cogscr] then \ esc - 1 : cog-screen 0
32 =n if 2 [cogscr] then \ esc - 2 : cog-screen 1
33 =n if 3 [cogscr] then \ esc - 3 : cog-screen 2
62 =n if lcog W@ cogreset then \ esc - b : break (cog)
72 =n if reboot then \ esc - r : reset (chip)
drop ; \ esc - esc : pause
\ drv:int ( -- ) treiber für bellatrix-terminal
\ diese cog fragt in einer endlosschleife ab, ob zeichen
\ versendet oder empfangen werden sollen. um die zeichenausgabe
\ zu beschleunigen, findet ausgabe und eingabe in einem
\ verhältnis von 512:1 statt. per esc-code können spezielle
\ funktionen im driver ausgelöst werden.
: drv:int
\ name und typ der cog einstellen
cogid dup cogstate 10 swap C! c" drv:int" over
cognumpad ccopy
20 delms 0D emit \ verzögertes cr für prompt
begin
\ input --> vga/video
200 0 do key? \ eingabezeichen vorhanden?
if key b[ [b!] ]b then loop \ cog ---> bel.vga
\ output <-- keyboard
b[ [key?] \ tastenstatus bellatrix?
if [key] dup 1b = if drop [esc] else [emit] thens ]b
0 until ;
\ ----------------------------------------------------- SYSINIT
: start \ ( -- ) initialisierung hive
locknew b[lock] W! \ b-semaphore
0 dup cogstate 10 swap C! c" drv:ldr" over
cognumpad ccopy
5 dup icog W! c" drv:int" swap cogx 1 b[ [cogscr] ]b ;
: _ob onboot ;
: onboot _ob start ;

77
forth/bel.lib Normal file
View File

@ -0,0 +1,77 @@
hex
ifnot: lib:bel
: lib:bel ;
\ kommandoformate
ifnot: bel:fkt! \ ( fkt -- )
: bel:fkt! b[ 0 [b!] [b!] ]b ;
ifnot: bel:fkt!b! \ ( b fkt -- )
: bel:fkt!b! b[ 0 [b!] [b!] [b!] ]b ;
ifnot: bel:fkt!b!l@ \ ( b fkt -- l )
: bel:fkt!b!l@ b[ 0 [b!] [b!] [b!] [b.l@] ]b ;
ifnot: bel:fkt!b!l! \ ( l b fkt -- )
: bel:fkt!b!l! b[ 0 [b!] [b!] [b!] [b.l!] ]b ;
ifnot: bel:fkt!l@ \ ( fkt -- l )
: bel:fkt!l@ b[ 0 [b!] [b!] [b.l@] ]b ;
ifnot: bel:fkt!b@ \ ( fkt -- b )
: bel:fkt!b@ b[ 0 [b!] [b!] [b@] ]b ;
\ chipmanagment-funktionen
ifnot: bel:wscr \ ( scrnr -- ) - schreibscreen setzen
: bel:wscr 58 bel:fkt!b! ;
ifnot: bel:dscr \ ( scrnr -- ) - displayscreen setzen
: bel:dscr 59 bel:fkt!b! ;
ifnot: bel:getcol \ ( colnr -- col ) - farbe abfragen
: bel:getcol 5A bel:fkt!b!l@ ;
ifnot: bel:setcol \ ( col colnr -- ) - farbe setzen
: bel:setcol 5B bel:fkt!b!l! ;
ifnot: bel:getresx \ ( -- resx ) - abfrage x-auflösung
: bel:getresx 5C bel:fkt!l@ ;
ifnot: bel:getresy \ ( -- resy ) - abfrage y-auflösung
: bel:getresy 5D bel:fkt!l@ ;
ifnot: bel:getcols \ ( -- cols ) - abfrage textspalten
: bel:getcols 5E bel:fkt!b@ ;
ifnot: bel:getrows \ ( -- rows ) - abfrage textzeilen
: bel:getrows 5F bel:fkt!b@ ;
ifnot: bel:getcogs \ ( -- cogs ) - abfrage belegte cogs
: bel:getcogs 60 bel:fkt!b@ ;
ifnot: bel:getspec \ ( -- spec ) - abfrage codespezifikation
: bel:getspec 61 bel:fkt!l@ ;
ifnot: bel:getver \ ( -- ver ) - abfrage codeversion
: bel:getver 62 bel:fkt!l@ ;
ifnot: bel:load \ ( cstr -- ) - bellatrix-code laden
: bel:load
52 adm:open .err \ datei öffnen
b[
0 [b!] 63 [b!] \ bella-loader starten
10 0 do 06 [a!] [a@] [b!] loop \ header einlesen
0A [a!] 0 [a.l!] \ 0 adm:seek
[b@] <8 [b@] or \ dateilänge empfangen
0 do 06 [a!] [a@] [b!] loop \ datei senden
]b
adm:close .err \ datei schließen
;

74
forth/cog.lib Normal file
View File

@ -0,0 +1,74 @@
hex
ifnot: lib:cog
: lib:cog ;
\ cog special register
ifnot: ctra 1F8 wconstant ctra :;
ifnot: ctrb 1F9 wconstant ctrb :;
ifnot: frqa 1FA wconstant frqa :;
ifnot: frqb 1FB wconstant frqb :;
ifnot: phsa 1FC wconstant phsa :;
ifnot: phsb 1FD wconstant phsb :;
ifnot: vcfg 1FE wconstant vcfg :;
ifnot: vscl 1FF wconstant vscl :;
\ this words needs to align with the assembler code
ifnot: _faddrmask : _faddrmask 1 _cv ;
ifnot: _flongmask : _flongmask 2 _cv ;
ifnot: _stptr : _stptr 5 _cv ;
ifnot: _sttos : _sttos 7 _cv ;
ifnot: _treg1 : _treg1 8 _cv ;
ifnot: _treg2 : _treg2 9 _cv ;
ifnot: _treg3 : _treg3 a _cv ;
ifnot: _treg4 : _treg4 b _cv ;
ifnot: _treg5 : _treg5 c _cv ;
ifnot: _treg6 : _treg6 d _cv ;
ifnot: _stbot : _stbot e _cv ;
ifnot: _sttop : _sttop 2e _cv ;
ifnot: _rsbot : _rsbot _sttop ;
\ waitcnt ( n1 n2 -- n1 ) \ wait until n1, add n2 to n1
ifnot: waitcnt
: waitcnt _execasm2>1 1F1 _cnip ;
\ waitpeq ( n1 n2 -- ) \ wait until state n1 is equal to
\ ina anded with n2
ifnot: waitpeq
: waitpeq _execasm2>0 1E0 _cnip ;
\ waitpne ( n1 n2 -- ) \ wait until state n1 is not equal
\ to ina anded with n2
ifnot: waitpne
: waitpne _execasm2>0 1E8 _cnip ;
\ lockret ( n1 -- ) deallocate a lock, previously allocated
\ via locknew
ifnot: lockret
: lockret 5 hubop 2drop ;
\ locknew ( -- n2 ) allocate a lock, result is in n2, -1
\ if unsuccessful
ifnot: locknew
: locknew -1 4 hubop -1 = if drop -1 then ;
\ cog+ ( -- ) add a forth cog
ifnot: cog+
: cog+ (cog+) ;
\ (cog-) ( -- ) stop first forth cog, cannot be executed form
\ the first forth cog
ifnot: (cog-)
: (cog-) nfcog cogstop ;
\ cog- ( -- ) stop first forth cog, cannot be executed form
\ the first forth cog
ifnot: cog-
: cog- (cog-) ;

65
forth/debug.mod Normal file
View File

@ -0,0 +1,65 @@
hex
ifnot: mod:debug
: mod:debug ;
\ keycode ( -- ) - anzeige der tastaturcodes
ifnot: keycode
: keycode
begin
0 key? if
drop key dup dup ." code : " emit ." : " . cr 1B =
then until ;
\
\ Noisy reset messages
\
\ print out a reset message to the console
\ (rsm) ( n -- ) n is the last status
\ 0011FFFF - stack overflow
\ 0012FFFF - return stack overflow
\ 0021FFFF - stack underflow
\ 0022FFFF - return stack underflow
\ 8100FFFF - no free cogs
\ 8200FFFF - no free main memory
\ 8400FFFF - fl no free main memory
\ 8500FFFF - no free cog memory
\ 8800FFFF - eeprom write error
\ 9000FFFF - eeprom read error
: (rsm) state W@ 2 and 0= swap
\ process the last status
dup 0= if c" ok" else
dup FF11 = if c" DST OVER" else
dup FF12 = if c" RST OVER" else
dup FF21 = if c" DST LOW" else
dup FF22 = if c" RST LOW" else
dup 8001 = if c" COGs OUT" else
dup 8002 = if c" hMEM OUT" else
dup 8003 = if c" ROM WR" else
dup 8004 = if c" FL" else
dup 8005 = if c" cMEM OUT" else
dup 8006 = if c" ROM RD" else
c" ?"
thens
rot if
lockdict cr c" ERR : " .cstr swap . .cstr cr freedict
else 2drop then ;
: onreset (rsm) 4 state orC! ;
\ .byte ( n1 -- )
: .byte <# # # #> .cstr ;
\ [if (dumpb)
: (dumpb) cr over .addr space dup .addr _ecs bounds ; ]
\ [if (dumpm)
: (dumpm) cr .word _ecs ; ]
\ [if (dumpe)
: (dumpe) tbuf 8 bounds do i C@ .byte space loop 2 spaces tbuf 8 bounds do i C@ dup bl < if drop 2e then emit loop ; ]
\ dump ( adr cnt -- ) uses tbuf
[if dump
: dump (dumpb) do i (dumpm) i tbuf 8 cmove (dumpe) 8 +loop cr ; ]

40
forth/error.txt Normal file
View File

@ -0,0 +1,40 @@
Reset-Fehlercodes:
0011FFFF - stack overflow
0012FFFF - return stack overflow
0021FFFF - stack underflow
0022FFFF - return stack underflow
8100FFFF - no free cogs
8200FFFF - no free main memory
8400FFFF - fl no free main memory
8500FFFF - no free cog memory
8800FFFF - eeprom write error
9000FFFF - eeprom read error
.err-Fehlercodes:
0 no error
1 fsys unmounted
2 fsys corrupted
3 fsys unsupported
4 not found
5 file not found
6 dir not found
7 file read only
8 end of file
9 end of directory
10 end of root
11 dir is full
12 dir is not empty
13 checksum error
14 reboot error
15 bpb corrupt
16 fsi corrupt
17 dir already exist
18 file already exist
19 out of disk free space
20 disk io error
21 command not found
22 timeout
23 parameter error

155
forth/hplay.mod Normal file
View File

@ -0,0 +1,155 @@
hex
ifnot: mod:hplay
: mod:hplay ;
\ kommandoformate
ifnot: adm:fkt! \ ( fkt -- )
: adm:fkt! b[ [a!] ]b ;
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b!w@ \ ( b fkt -- w )
: adm:fkt!b!w@ b[ [a!] [a!] [a.w@] ]b ;
ifnot: adm:fkt!s!b@ \ ( cstr fkt -- b )
: adm:fkt!s!b@ b[ [a!] [a.s!] [a@] ]b ;
ifnot: bel:fkt!b@ \ ( fkt -- b )
: bel:fkt!b@ b[ 0 [b!] [b!] [b@] ]b ;
ifnot: bel:char \ ( b -- )
: bel:char b[ [b!] ]b ;
\ hss-funktionen
ifnot: hss:load \ ( cstr -- err ) - hss-datei laden
: hss:load dup if 64 adm:fkt!s!b@ then ;
ifnot: hss:play \ ( -- ) - datei im puffer abspielen
: hss:play 65 adm:fkt! ;
ifnot: hss:stop \ ( -- ) - player stop
: hss:stop 66 adm:fkt! ;
ifnot: hss:reg \ hreg ( regnr -- 16b )
: hss:reg 69 b[ [a!] [a!] [a.w@] ]b ;
ifnot: hss:vol \ hvol ( vol -- ) - lautstärke 0..15
: hss:vol 6A adm:fkt!b! ;
\ keyboard-funktionen
ifnot: key:stat \ ( -- stat ) - tastenstatus abfragen
: key:stat 1 bel:fkt!b@ ;
\ steuerzeichen
ifnot: scr:cls \ ( -- ) - screen löschen
: scr:cls 01 bel:char ;
ifnot: scr:home \ ( -- ) - cursor oben links
: scr:home 02 bel:char ;
ifnot: scr:curon \ ( -- ) - cursor anschalten
: scr:curon 04 bel:char ;
ifnot: scr:curoff \ ( -- ) - cursor abschalten
: scr:curoff 05 bel:char ;
\ sd0-funktionen
\ adm:diropen ( -- ) - verzeichnisabfrage initialisieren
ifnot: adm:diropen
: adm:diropen
02 adm:fkt! ;
\ adm:nextfile ( -- st )
\ st = 0 - keine gültige datei
\ st = 1 - dateiname im pad gültig
\ bei gültigem eintrag befindet sich der dateiname im pad
ifnot: adm:nextfile
: adm:nextfile
b[ 03 [a!] [a@] dup if [a.s@] then ]b ;
\ metafunktionen
\ hload name ( -- ) - hss-datei in player laden
ifnot: hload
: hload mount? parsenw hss:load .err ;
ifnot: .hset
: .hset \ ( shift -- ) - eine registersatz ausgeben
5 0 do dup i + hss:reg .word space loop drop ;
ifnot: .hreg
: .hreg \ ( -- ) - register ausgeben
14 0 do i .hset cr 5 +loop ;
ifnot: fadeout
: fadeout \ ( -- ) - sound langsam ausblenden
f 0 do e i - hss:vol 50 delms loop ;
ifnot: end?
: end? \ ( cnt -- flag ) - abfrage nach cnt wiederholungen
4 hss:reg = ;
ifnot: hwait
: hwait \ ( -- flag ) - wartet auf songende oder taste
begin 50 delms key? 2 end? or until key drop ;
ifnot: hreg..
: hreg.. \ ( -- ) - fortlaufende anzeige register
scr:curoff scr:cls begin scr:home .hreg 2 end? until
scr:curon fadeout hss:stop ;
ifnot: (hplay)
: (hplay) \ ( cstr -- )
." Datei : " dup .cstr hss:load .err f hss:vol hss:play
hwait fadeout hss:stop 100 delms cr ;
\ hplay name ( -- ) - datei abspielen
ifnot: hplay
: hplay
hload hss:play ;
\ files? ( -- cnt ) - anzahl dateien im dir
ifnot: files?
: files?
adm:diropen
0 begin adm:nextfile swap 1+ swap 0= until 3 - padbl ;
\ filenr? ( nr -- )
ifnot: filenr?
: filenr?
adm:diropen
0 do adm:nextfile drop loop ;
\ hdirplay ( -- ) - gesamtes verzeichnis abspielen
\ im verzeichnis dürfen nur hss-dateien sein!
ifnot: hdirplay
: hdirplay
decimal files? dup ." Dateien : " . cr
0 do i dup 1 + . 3 + filenr? pad (hplay) loop padbl hex ;
: (hp) ." play : " dup .cstr hss:load .err ;
ifnot: playliste
: playliste
c" kw.hss" (hplay)
c" genes.hss" (hplay)
c" greenpuz.hss" (hplay)
c" hssintro.hss" (hplay)
c" kali766.hss" (hplay)
c" machine.hss" (hplay)
c" metroid.hss" (hplay)
c" mrboss.hss" (hplay)
c" mrevil.hss" (hplay)
c" raind.hss" (hplay)
c" sytrus.hss" (hplay)
c" tbellsp1.hss" (hplay) ;

60
forth/hss.lib Normal file
View File

@ -0,0 +1,60 @@
hex
ifnot: lib:hss
: lib:hss ;
\ kommandoformate
ifnot: adm:fkt! \ ( fkt -- )
: adm:fkt! b[ [a!] ]b ;
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b!b! \ ( b b fkt -- )
: adm:fkt!b!b! b[ [a!] [a!] [a!] ]b ;
ifnot: adm:fkt!b!w@ \ ( b fkt -- w )
: adm:fkt!b!w@ b[ [a!] [a!] [a.w@] ]b ;
ifnot: adm:fkt!s!b@ \ ( cstr fkt -- b )
: adm:fkt!s!b@ b[ [a!] [a.s!] [a@] ]b ;
\ hss-funktionen
\ ( cstr -- err ) - hss-datei laden
ifnot: hss:load
: hss:load dup if 64 adm:fkt!s!b@ then ;
\ ( -- ) - datei im puffer abspielen
ifnot: hss:play
: hss:play 65 adm:fkt! ;
\ ( -- ) - player stop
ifnot: hss:stop
: hss:stop 66 adm:fkt! ;
\ ( -- ) - player pause
ifnot: hss:pause
: hss:pause 67 adm:fkt! ;
\ hreg ( regnr -- 16b )
\ 0 iEndFlag iRowFlag iEngineC iBeatC iRepeat Player
\ 5 iNote iOktave iVolume iEffekt iInstrument Kanal 1
\ 10 iNote iOktave iVolume iEffekt iInstrument Kanal 2
\ 15 iNote iOktave iVolume iEffekt iInstrument Kanal 3
\ 20 iNote iOktave iVolume iEffekt iInstrument Kanal 4
\
\ iEndFlag Repeat oder Ende wurde erreicht
\ iRowFlag Trackerzeile (Row) ist fertig
\ iEngineC Patternzähler
\ iBeatC Beatzähler (Anzahl der Rows)
\ iRepeat Zähler für Loops
ifnot: hss:reg
: hss:reg 69 b[ [a!] [a!] [a.w@] ]b ;
\ hvol ( vol -- ) - lautstärke 0..15
ifnot: hss:vol
: hss:vol 6A adm:fkt!b! ;

17
forth/key.lib Normal file
View File

@ -0,0 +1,17 @@
hex
ifnot: lib:key
: lib:key ;
\ kommandoformate
ifnot: bel:fkt!b@ \ ( fkt -- b )
: bel:fkt!b@ b[ 0 [b!] [b!] [b@] ]b ;
\ keyboard-funktionen
ifnot: key:stat \ ( -- stat ) - tastenstatus abfragen
: key:stat 1 bel:fkt!b@ ;
ifnot: key:code \ ( -- code ) - tastencode abfragen
: key:code 2 bel:fkt!b@ ;
ifnot: key:spec \ ( -- spec ) - spezialtasten abfragen
: key:spec 4 bel:fkt!b@ ;

206
forth/rom.mod Normal file
View File

@ -0,0 +1,206 @@
\ ACHTUNG: Diese Modifikation nicht bei einer Installation im
\ HI-EEPROM verwenden!
hex
[if mod:rom
: mod:rom ; ]
\ constant ( x -- ) skip blanks parse the next word and create a constant, allocate a long, 4 bytes
[if constant
: constant lockdict create $C_a_doconl w, l, forthentry freedict ; ]
\
\ CONFIG PARAMETERS BEGIN
\
40 wconstant fsps \ a page size which works with 32kx8 & 64kx8 eeproms
\ and should work with larger as well.
8000 constant fsbot \ file-system bottom: the start adress in eeprom for the file system
\ file system top: the end address of the file system
\ uncomment the line for your comfiguration
\ 8000 constant fstop \ the end address for the file system with one 24LC256 32k eeprom
10000 constant fstop \ the end address for the file system with one 24LC512 64k eeprom
\ 20000 constant fstop \ the end address for the file system with two 24LC512 64k eeprom
\ 30000 constant fstop \ the end address for the file system with 3 24LC512 64k eeprom
\ 40000 constant fstop \ the end address for the file system with 4 24LC512 64k eeprom
\ 50000 constant fstop \ the end address for the file system with 5 24LC512 64k eeprom
\ 60000 constant fstop \ the end address for the file system with 6 24LC512 64k eeprom
\ 70000 constant fstop \ the end address for the file system with 7 24LC512 64k eeprom
\ NOTE IF you have DEMOBOARD or any system with 32K EEPROM, you will step on your spin image
\ when you write to the EEPROM. You can still use it (if you are tricky), but KNOW WHAT YOUR DOING!!!
\
\ CONFIG PARAMETERS END
\
\ lasti? ( -- t/f ) true if this is the last value of i in this loop
[if lasti?
: lasti? _rsptr COG@ 2+ COG@ 1- _rsptr COG@ 3 + COG@ = ; ]
\ padbl ( -- ) fills this cogs pad with blanks
[if padbl
: padbl pad padsize bl fill ; ]
\ _eeread ( t/f -- c1 ) read a byte from the eeprom, ackbit in, byte out
[if _eeread : _eeread _sdai 0 8 0 do 1 lshift _sclh _sda? _scll if 1 or then loop
swap if _sdah else _sdal then _sdao _sclh _scll _sdal ; ]
\ the eereadpage and eewritePage words assume the eeprom are 64kx8 and will address up to
\ 8 sequential eeproms
\ eereadpage ( eeAddr addr u -- t/f ) return true if there was an error, use lock 1
[if eereadpage : eereadpage begin 1 lockset 0= until
1 max rot dup ff and swap dup 8 rshift ff and swap 10 rshift 7 and 1 lshift dup >r
_eestart A0 or _eewrite swap _eewrite or swap _eewrite or
_eestart r> A1 or _eewrite or
rot2 bounds
do lasti? _eeread i C! loop _eestop 1 lockclr drop ; ]
\ _eeread ( t/f -- c1 ) read a byte from the eeprom, ackbit in, byte out
[if _eeread : _eeread _sdai 0 8 0 do 1 lshift _sclh _sda? _scll if 1 or then loop
swap if _sdah else _sdal then _sdao _sclh _scll _sdal ; ]
\ the eereadpage and eewritePage words assume the eeprom are 64kx8 and will address up to
\ 8 sequential eeproms
\ eereadpage ( eeAddr addr u -- t/f ) return true if there was an error, use lock 1
[if eereadpage : eereadpage begin 1 lockset 0= until
1 max rot dup ff and swap dup 8 rshift ff and swap 10 rshift 7 and 1 lshift dup >r
_eestart A0 or _eewrite swap _eewrite or swap _eewrite or
_eestart r> A1 or _eewrite or
rot2 bounds
do lasti? _eeread i C! loop _eestop 1 lockclr drop ; ]
\ EW@ ( eeAddr -- n1 )
[if EW@
: EW@ t0 2 eereadpage if 8006 ERR then t0 W@ ; ]
\ EC@ ( eeAddr -- c1 )
[if EC@
: EC@ EW@ FF and ; ]
\ (fspa) ( addr1 -- addr2) addr2 is the next page aligned address after addr1
: (fspa) fsps 1- + fsps 1- andn ;
\ (fsnext) ( addr1 -- addr2 t/f) addr - the current file address, addr2 - the next addr, t/f - true if we have
\ gone past the end of the eeprom. t0 -length of the current file
\ t1 - length of the file name (char)
: (fsnext) t0 W@ t1 C@ + 2+ 1+ + (fspa) dup fstop >= ;
\ (fswr) ( addr1 addr2 n1 -- ) addr1 - the eepropm address to write, addr2 - the address to write from
\ n1 - the number of bytes to write
: (fswr) dup >r rot dup r> + fstop 1- > if A0 ERR then rot2 eewritepage if 88 ERR then ;
\ (fsrd) ( addr1 addr2 n1 -- ) addr1 - the eepropm address to read, addr2 - the address of the read buffer
\ n1 - the number of bytes to read
: (fsrd) dup >r rot dup r> + fstop 1- > if C0 ERR then rot2 eereadpage if 90 ERR then ;
\ (fsfree) ( -- n1 ) n1 is the first location in the file system, -1 if there are none
: (fsfree) -1 fsbot begin
\ read 3 bytes into t0, t1 and process
dup t0 3 (fsrd) t0 W@ FFFF = if nip dup -1 else (fsnext) then
until drop ;
\ (fsfind) ( cstr -- addr ) find the last file named cstr, addr is the eeprom address, 0 if not found
: (fsfind) fsbot 0 >r begin
\ read namesizemax 1F + 3 bytes into t0, t1, and tbuf
dup t0 22 (fsrd) t0 W@ FFFF = if -1 else
over t1 cstr= if r> drop dup >r then
(fsnext)
then
until 2drop r> ;
\ (fslast) ( -- addr ) find the last file, 0 if not found
: (fslast) 0 fsbot begin
\ read namesizemax 1F + 3 bytes into t0, t1, and tbuf
dup t0 22 (fsrd) t0 W@ FFFF = if -1 else
nip dup
(fsnext)
then
until drop ;
\ fsclear ( -- )
: fsclr padbl fsbot 400 + fsbot do i pad fsps (fswr) 2e emit fsps +loop -1 fsbot EW! ;
: fsclear -1 fsbot EW! ;
\ fsfree ( -- )
: fsfree (fsfree) dup -1 = if 0 else fstop swap - then . ." bytes free in fs" cr ;
\ fsls ( -- ) list the files
: fsls cr fsbot begin
\ read namesizemax 1F + 3 bytes into t0, t1, and tbuf
dup t0 22 (fsrd) t0 W@ FFFF = if -1 else
dup .addr space t0 W@ .addr space t1 .cstr cr
(fsnext)
then
until fstop swap - cr . ." bytes free in files system" cr cr ;
\ (fsread) ( cstr -- )
: (fsread) (fsfind) dup if
\ read 3 bytes into t0, t1 and process
dup t0 3 (fsrd)
t1 C@ + 2+ 1+ t0 W@ bounds do
ibound i - fsps >= if
i pad fsps (fsrd) pad fsps bounds
do i C@ emit loop i fsps 1- + seti
else
i EC@ emit
then
loop
else drop then padbl ;
\ fsread ( -- ) filename
: fsread parsenw dup if (fsread) else drop then ;
\ (fsload) ( ctsr -- )
: (fsload) cogid nfcog iolink (fsread) d emit d emit cogid iounlink ;
\ fsload filename ( -- ) send the file to the next free forth cog
: fsload parsenw dup if (fsload) else drop then ;
\ (fsk) ( n1 -- n2)
: (fsk) 8 lshift key or ;
\ fswrite filename ( -- ) writes a file until ... followed immediately by a cr is encountered
: fswrite (fsfree) dup -1 <> parsenw dup rot and if
\ set the file length to 0, copy in the file name
0 pad W! dup C@ 2+ 1+ pad + swap pad 2+ ccopy
\ find the first free page
0 swap key (fsk) (fsk) (fsk)
\ ( eaddr1 n1 addr2 n2 ) eaddr - start of file in the eeprom, n1 - bytes written so far, addr2 - next addr in the pad,
\ n2 - a 4 byte key buffer
begin
\ check to see if we have a ... at the end of a line
2E2E2E0D over = if
-1
else
\ get a key from the key buffer, write it the the pad
swap over 18 rshift dup dup d = if drop cr else emit then over C! 1+ tuck pad - fsps = if
\ we have a page worth of data, write it out
nip rot2 2dup + pad fsps (fswr) fsps + rot pad swap
then
\ get another key
(fsk) 0
then
until
\ any keys left?
drop pad - dup 0> if
\ write the leftover, not a full page
>r 2dup + pad r> dup >r (fswr) r> +
else
drop
then
\ write the length of FFFF for the next file
2dup + FFFF swap (fspa) dup fstop 1- < if EW! else 2drop then
\ subtract the length of the filename +1, and the 2 bytes which are the length of the file, and update the length of the file
over 2+ EC@ 2+ 1+ - swap EW!
else 2drop clearkeys then padbl
;
\ fsdrop ( -- ) deletes last file
: fsdrop (fslast) dup -1 = if drop else FFFF swap EW! then ;

69
forth/scr.lib Normal file
View File

@ -0,0 +1,69 @@
hex
ifnot: lib:scr
: lib:scr ;
\ kommandoformate
ifnot: bel:char \ ( b -- )
: bel:char b[ [b!] ]b ;
ifnot: bel:fkt!b! \ ( b fkt -- )
: bel:fkt!b! b[ 0 [b!] [b!] [b!] ]b ;
ifnot: bel:fkt!b!b! \ ( b b fkt -- )
: bel:fkt!b!b! b[ 0 [b!] [b!] [b!] [b!] ]b ;
ifnot: bel:ctrl! \ ( ctrl -- )
: bel:ctrl! b[ 0 [b!] 3 [b!] [b!] ]b ;
ifnot: bel:ctrl!b! \ ( b ctrl -- )
: bel:ctrl!b! b[ 0 [b!] 3 [b!] [b!] [b!] ]b ;
ifnot: bel:ctrl!b@ \ ( ctrl -- b@ )
: bel:ctrl!b@ b[ 0 [b!] 3 [b!] [b!] [b@] ]b ;
ifnot: bel:ctrl!b!b! \ ( b b ctrl -- )
: bel:ctrl!b!b! b[ 0 [b!] 3 [b!] [b!] [b!] [b!] [b!] ]b ;
\ einfache steuerzeichen
ifnot: scr:cls \ ( -- ) - screen löschen
: scr:cls 01 bel:char ;
ifnot: scr:home \ ( -- ) - cursor oben links
: scr:home 02 bel:char ;
ifnot: scr:pos1 \ ( -- ) - cursor an zeilenanfang
: scr:pos1 03 bel:char ;
ifnot: scr:curon \ ( -- ) - cursor anschalten
: scr:curon 04 bel:char ;
ifnot: scr:curoff \ ( -- ) - cursor abschalten
: scr:curoff 05 bel:char ;
ifnot: scr:scrlu \ ( -- ) - screen nach oben scrollen
: scr:scrlu 06 bel:char ;
ifnot: scr:scrld \ ( -- ) - screen nach unten scrollen
: scr:scrld 07 bel:char ;
ifnot: scr:bs \ ( -- ) - backspace
: scr:bs 08 bel:char ;
ifnot: scr:tab \ ( -- ) - tabulator
: scr:tab 09 bel:char ;
\ screen-funktionen
ifnot: scr:logo \ ( y x -- ) - hive logo
: scr:logo 5 bel:fkt!b!b! ;
ifnot: scr:char \ ( char -- ) - zeichensatz direkt ausgeben
: scr:char 6 bel:fkt!b! ;
\ parametrisierte steuerzeichen
ifnot: scr:setcur \ ( cur -- ) - cursorzeichen setzen
: scr:setcur 01 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:getx \ ( -- x ) - cursor position x abfragen
: scr:getx 04 bel:ctrl!b@ ;
ifnot: scr:gety \ ( -- y ) - cursor position y abfragen
: scr:gety 05 bel:ctrl!b@ ;
ifnot: scr:setcol \ ( colnr -- ) - farbe wählen 0..15
: scr:setcol 06 bel:ctrl!b! ;
ifnot: scr:sline \ ( row -- ) - anfangszeile scrollbereich
: scr:sline 07 bel:ctrl!b! ;
ifnot: scr:eline \ ( row -- ) - endzeile scrollbereich
: scr:eline 08 bel:ctrl!b! ;
ifnot: scr:sinit \ ( -- ) -
: scr:sinit 09 bel:ctrl! ;
ifnot: scr:tabset \ ( pos nr -- ) - tabulatorposition setzen 0..7
: scr:tabset 0A bel:ctrl!b!b! ;

176
forth/sd0.lib Normal file
View File

@ -0,0 +1,176 @@
hex
ifnot: lib:sd0
: lib:sd0 ;
\ ------------------------------------ lib:sd0
\ kommandoformate
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b!b@ \ ( b fkt -- b )
: adm:fkt!b!b@ b[ [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!b!l@ \ ( b fkt -- l )
: adm:fkt!b!l@ b[ [a!] [a!] [a.l@] ]b ;
ifnot: adm:fkt!l! \ ( l fkt -- )
: adm:fkt!l! b[ [a!] [a.l!] ]b ;
ifnot: adm:fkt!l@ \ ( fkt -- l )
: adm:fkt!l@ b[ [a!] [a.l@] ]b ;
ifnot: adm:fkt!b!l! \ ( l b fkt -- )
: adm:fkt!b!l! b[ [a!] [a!] [a.l!] ]b ;
ifnot: adm:fkt!s!b@ \ ( s fkt -- b )
: adm:fkt!s!b@ b[ [a!] [a.s!] [a@] ]b ;
ifnot: adm:fkt!b!s!b@ \ ( s b fkt -- b )
: adm:fkt!b!s!b@ b[ [a!] [a!] [a.s!] [a@] ]b ;
ifnot: adm:fkt!s!s!b@ \ ( s s fkt -- b )
: adm:fkt!s!s!b@ b[ [a!] [a.s!] [a.s!] [a@] ]b ;
\ dateisystem-funktionen
\ adm:mount ( -- err ) - medium mounten
ifnot: adm:mount
: adm:mount
01 adm:fkt!b@ ;
\ adm:diropen ( -- ) - verzeichnisabfrage initialisieren
ifnot: adm:diropen
: adm:diropen
02 adm:fkt! ;
\ adm:nextfile ( -- st )
\ st = 0 - keine gültige datei
\ st = 1 - dateiname im pad gültig
\ bei gültigem eintrag befindet sich der dateiname im pad
ifnot: adm:nextfile
: adm:nextfile
b[ 03 [a!] [a@] dup if [a.s@] then ]b ;
\ adm:open ( cstr modus -- err ) - datei öffnen
\ modus "R" $52 - Read
\ modus "W" $57 - Write
\ modus "A" $41 - Append
ifnot: adm:open
: adm:open
04 adm:fkt!b!s!b@ ;
\ adm:close ( -- ) - datei schließen
ifnot: adm:close
: adm:close
05 adm:fkt!b@ ;
\ adm:getc ( -- c ) - ein zeichen aus datei lesen
ifnot: adm:getc
: adm:getc
06 adm:fkt!b@ ;
\ adm:putc ( c -- ) - ein zeichen in datei schreiben
ifnot: adm:putc
: adm:putc
07 adm:fkt!b! ;
\ adm:eof ( -- eof ) - abfrage ob end of file erreicht ist
ifnot: adm:eof
: adm:eof
1E adm:fkt!b@ ;
\ adm:getblk ( adr cnt -- ) - datenblock aus datei lesen
\ adm:putblk ( adr cnt -- ) - datenblock in datei schreiben
\ adm:seek ( pos -- ) - position in datei setzen
: adm:seek
0A adm:fkt!l! ;
\ adm:fattrib ( nr -- attrib ) - dateiattribut abfragen
ifnot: adm:fattrib
: adm:fattrib
0B adm:fkt!b!l@ ;
\ adm:volname ( -- ) - name des volumes im pad ablegen
ifnot: adm:volname
: adm:volname
0C adm:fkt!s@ ;
\ adm:checkmounted ( -- t/f )
ifnot: adm:checkmounted
: adm:checkmounted
0D adm:fkt!b@ ;
\ adm:checkopen ( -- t/f )
ifnot: adm:checkopen
: adm:checkopen
0E adm:fkt!b@ ;
\ adm:checkused ( -- used ) - anzahl benutzte sektoren
ifnot: adm:checkused
: adm:checkused
0F adm:fkt!l@ ;
\ adm:checkfree ( -- free ) - anzahl freie sektoren
ifnot: adm:checkfree
: adm:checkfree
10 adm:fkt!l@ ;
\ adm:newfile ( cstr -- ) - neue datei erstellen
ifnot: adm:newfile
: adm:newfile
11 adm:fkt!s!b@ ;
\ adm:newdir ( cstr -- ) - neues verzeichnis erstellen
ifnot: adm:newdir
: adm:newdir
12 adm:fkt!s!b@ ;
\ adm:del ( cstr -- ) - datei/verzeichnis löschen
ifnot: adm:del
: adm:del
13 adm:fkt!s!b@ ;
\ adm:rename ( cstr1.fn1 cstr2.fn2 -- )
ifnot: adm:rename
: adm:rename
14 adm:fkt!s!s!b@ ;
\ adm:chattrib ( cstr1.fn cstr2.attrib -- )
ifnot: adm:chattrib
: adm:chattrib
15 adm:fkt!s!s!b@ ;
\ adm:chdir ( cstr -- err ) - verzeichnis öffnen
ifnot: adm:chdir
: adm:chdir
16 adm:fkt!s!b@ ;
\ adm:format ( cstr.label -- ) - medium formatieren
ifnot: adm:format
: adm:format
17 adm:fkt!s!b@ ;
\ adm:unmount ( -- err ) - medium unmounten
ifnot: adm:unmount
: adm:unmount
18 adm:fkt!b@ ;
\ marker-funktionen
ifnot: adm:dmact \ ( dmnr -- ) - marker aktivieren
: adm:dmact 19 adm:fkt!b!b@ .err ;
ifnot: adm:dmset \ ( dmnr -- ) - marker setzen
: adm:dmset 1A adm:fkt!b! ;
ifnot: adm:dmget \ ( dmnr -- dm ) - marker lesen
: adm:dmget 1B adm:fkt!b!l@ ;
ifnot: adm:dmclr \ ( dmnr -- ) - marker löschen
: adm:dmclr 1C adm:fkt!b! ;
ifnot: adm:dmput \ ( dm dmnr -- ) - marker schreiben
: adm:dmput 1D adm:fkt!b!l! ;

93
forth/sfx.lib Normal file
View File

@ -0,0 +1,93 @@
hex
ifnot: lib:sfx
: lib:sfx ;
\ kommandoformen
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b!b! \ ( b b fkt -- )
: adm:fkt!b!b! b[ [a!] [a!] [a!] ]b ;
ifnot: adm:fkt!b!64b! \ ( ptr b fkt -- )
: adm:fkt!b!64b! b[ [a!] [a!]
31 0 do dup i + C@ [a!] loop drop ]b ;
\ sfx-funktionen
\ sfx:fire( chan slot -- ) - sfx abspielen
\ slot - $00..$0f nummer der freien effektpuffer
\ slot - $f0..f5 vordefinierte effektslots
\ chan - 0/1 stereokanal
\ vordefinierte effekte
\ &f0 - warnton
\ $f1 - signalton
\ $f2 - herzschlag schnell
\ $f3 - herzschlag langsam
\ $f4 - telefon
\ $f5 - phaser :)
\ $f6 - pling
\ $f7 - on
\ $f8 - off
ifnot: sfx:fire
: sfx:fire 6B adm:fkt!b!b! ;
\ ( ptr slot -- ) - sfx setzen
\ slot - $00..$0f nummer der freien effektpuffer
\ ptr - zeiger auf 32 byte effektdaten
\
\ struktur der effektdaten:
\
\ [wav ][len ][freq][vol ] grundschwingung
\ [lfo ][lfw ][fma ][ama ] modulation
\ [att ][dec ][sus ][rel ] hüllkurve
\ [seq ] (optional)
\
\ [wav] wellenform
\ 0 sinus (0..500hz)
\ 1 schneller sinus (0..1khz)
\ 2 dreieck (0..500hz)
\ 3 rechteck (0..1khz)
\ 4 schnelles rechteck (0..4khz)
\ 5 impulse (0..1,333hz)
\ 6 rauschen
\ [len] tonlänge $0..$fe, $ff endlos
\ [freq] frequenz $00..$ff
\ [vol] lautstärke $00..$0f
\
\ [lfo] low frequency oscillator $ff..$01
\ [lfw] low frequency waveform
\ $00 sinus (0..8hz)
\ $01 fast sine (0..16hz)
\ $02 ramp up (0..8hz)
\ $03 ramp down (0..8hz)
\ $04 square (0..32hz)
\ $05 random
\ $ff sequencer data (es folgt eine sequenzfolge [seq])
\ [fma] frequency modulation amount
\ $00 no modulation
\ $01..$ff
\ [ama] amplitude modulation amount
\ $00 no modulation
\ $01..$ff
\ [att] attack $00..$ff
\ [dec] decay $00..$ff
\ [sus] sustain $00..$ff
\ [rel] release $00..$ff
ifnot: sfx:setslot
: sfx:setslot
6C adm:fkt!b!64b! ;
\ sfx:keyoff ( chan -- ) - release-phase einleiten
ifnot: sfx:keyoff
: sfx:keyoff
6D adm:fkt!b! ;
\ sfx:stop ( chan -- )
ifnot: sfx:stop
: sfx:stop
6E adm:fkt!b! ;

116
forth/splay.mod Normal file
View File

@ -0,0 +1,116 @@
\ achtung: vor verwendung muss der administra-code mit sidcog
\ geladen werden:
\ sys tools.f
\ sys splay.f <--- sid-player laden
\ aload admsid.adm <--- administra-code mit sidcog laden
\ splay xyz.dmp <--- sid-datei abspielen
hex
ifnot: mod:splay
: mod:splay ;
\ kommandoformen
ifnot: adm:fkt! \ ( fkt -- )
: adm:fkt! b[ [a!] ]b ;
ifnot: adm:fkt!b! \ ( b fkt -- )
: adm:fkt!b! b[ [a!] [a!] ]b ;
ifnot: adm:fkt!b@ \ ( fkt -- b )
: adm:fkt!b@ b[ 0 [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!s! \ ( s fkt -- )
: adm:fkt!s! b[ [a!] [a.s!] ]b ;
ifnot: adm:fkt!s!b@ \ ( s fkt -- err )
: adm:fkt!s! b[ [a!] [a.s!] [b@] ]b ;
ifnot: adm:fkt!b!l@ \ ( b fkt -- l )
: adm:fkt!b!l@ b[ [a!] [a!] [a.l@] ]b ;
\ dm-funktionen
ifnot: adm:dmget \ ( dmnr -- dm ) - marker lesen
: adm:dmget 1B adm:fkt!b!l@ ;
\ adm:dmact ( dmnr -- ) - marker aktivieren
: adm:dmact 19 adm:fkt!b!b@ drop ;
\ adm-funktionen
\ adm:aload ( cstr -- ) - neuen administra-code laden
ifnot: adm:aload
: adm:aload
60 adm:fkt!s! ;
\ tools
ifnot: aload
: aload
mount? parsenw dup
if 1 adm:dmact adm:aload 0 else drop 23 then .err ;
\ sid-funktionen
ifnot: sid:play
: sid:play \ ( cstr -- err )
9E adm:fkt!s!b@ ;
ifnot: sid:stop
: sid:stop \ ( -- )
9F adm:fkt! ;
ifnot: sid:status
: sid:status \ ( -- status )
A1 adm:fkt!b@ ;
ifnot: sid:mute
\ 1 - sid1
\ 2 - sid2
\ 3 - sid1 & sid2
: sid:mute \ ( sidnr -- )
A3 adm:fkt!b! ;
\ send? ( -- t/f )
ifnot: send?
: send?
begin 50 delms key? dup if key drop then sid:status 0= or
until ;
\ (splay) ( cstr -- )
ifnot: (splay)
: (splay) \ ( cstr -- )
." Datei : " dup .cstr cr sid:play .err
send? sid:stop 3 sid:mute adm:close drop ;
\ files? ( -- cnt ) - anzahl dateien im dir
ifnot: files?
: files?
adm:diropen
0 begin adm:nextfile swap 1+ swap 0= until 3 - padbl ;
\ filenr? ( nr -- )
ifnot: filenr?
: filenr?
adm:diropen
0 do adm:nextfile drop loop ;
\ splay name.dmp ( -- ) - sid-datei abspielen
ifnot: splay
: splay
parsenw (splay) ;
\ sdirplay ( -- ) - gesamtes verzeichnis abspielen
\ im verzeichnis dürfen nur sid-dateien sein!
ifnot: sdirplay
: sdirplay
files? dup ." Dateien : " . cr
0 do i dup 1 + . 3 + filenr? pad (splay) loop padbl ;
ifnot: smute
: smute
sid:stop 3 sid:mute ;

152
forth/tools.mod Normal file
View File

@ -0,0 +1,152 @@
hex
ifnot: mod:tools
: mod:tools ;
\ kommandoformen
ifnot: adm:fkt!b!l@ \ ( b fkt -- l )
: adm:fkt!b!l@ b[ [a!] [a!] [a.l@] ]b ;
ifnot: adm:fkt!b!b@ \ ( b fkt -- b )
: adm:fkt!b!b@ b[ [a!] [a!] [a@] ]b ;
ifnot: adm:fkt!s! \ ( s fkt -- )
: adm:fkt!s! b[ [a!] [a.s!] ]b ;
\ dm-funktionen
ifnot: adm:dmget \ ( dmnr -- dm ) - marker lesen
: adm:dmget 1B adm:fkt!b!l@ ;
ifnot: adm:dmact \ adm:dmact ( dmnr -- ) - marker aktivieren
: adm:dmact 19 adm:fkt!b!b@ drop ;
\ adm-funktionen
\ adm:aload ( cstr -- ) - neuen administra-code laden
ifnot: adm:load
: adm:load
60 adm:fkt!s! ;
\ bel-funktionen
\ bel:load ( cstr -- ) - bellatrix-code laden
\ achtung: die gesamte loader-operation ist eine atomare
\ operation über alle drei propellerchips, kann also auch
\ nicht aufgetrennt werden!
ifnot: bel:load
: bel:load
52 adm:open .err \ datei öffnen
b[
0 [b!] 63 [b!] \ bella-loader starten
10 0 do 06 [a!] [a@] [b!] loop \ header einlesen
0A [a!] 0 [a.l!] \ 0 adm:seek
[b@] <8 [b@] or \ dateilänge empfangen
0 do 06 [a!] [a@] [b!] loop \ datei senden
]b
adm:close .err \ datei schließen
;
\ ------------------------------------ mod:tools
ifnot: aload
: aload \ name ( -- ) - administra-code laden
mount? parsenw dup
if adm:load 0 else drop 23 then .err ;
ifnot: bload
: bload \ name ( -- ) - bellatrix-code laden
mount? parsenw dup
if bel:load 0 else drop 23 then .err ;
ifnot: .dmstatus \ ( dm -- ) - ausgabe marker-status
: .dmstatus -1 = if ." frei" else ." gesetzt" then cr ;
ifnot: dm?
: dm?
." [root] : " 0 adm:dmget .dmstatus
." [sys ] : " 1 adm:dmget .dmstatus
." [usr ] : " 2 adm:dmget .dmstatus
." [ A ] : " 3 adm:dmget .dmstatus
." [ B ] : " 4 adm:dmget .dmstatus
." [ C ] : " 5 adm:dmget .dmstatus ;
\ open name ( -- ) - datei lesend öffnen und auf fehler prüfen
ifnot: open
: open
mount? parsenw dup
if 52 adm:open else drop 23 then .err ;
\ close ( -- ) - geöffnete datei schließen
ifnot: close
: close
adm:close .err ;
\ (cat) ( -- ) - alle zeichen der geöffneten datei ab
\ lesemarke auf ausgabekanal bis zum eof ausgeben
ifnot: (cat)
: (cat) begin adm:getc emit adm:eof until ;
\ cat name ( -- ) - datei "name" komplett ausgeben
ifnot: cat
: cat open (cat) close ;
\ nextline ( -- ) - ausgabe der nächsten textzeile aus der
\ geöffneten datei
ifnot: nextline
: nextline
begin adm:getc dup emit 0d = adm:eof or until ;
\ nextlines ( n -- ) - ausgabe von n zeilen
ifnot: nextlines
: nextlines
0 do adm:eof 0= if nextline then loop ;
\ less name ( -- ) - zeilenweise ausgabe der datei
ifnot: less
: less
open begin 10 nextlines key 71 = adm:eof or until close ;
\ #C ( c1 -- ) prepend the character c1 to the number
\ currently being formatted
ifnot: #C
: #C -1 >out W+! pad>out C! ;
\ .cogch ( n1 n2 -- ) print as x(y)
ifnot: .cogch
: .cogch <# 29 #C # 28 #C drop # #> .cstr ;
\ j ( -- n1 ) the second most current loop counter
ifnot: j
: j _rsptr COG@ 5 + COG@ ;
\ cog? ( -- )
ifnot: cog?
: cog?
8 0 do ." Cog:" i dup . ." #io chan:"
dup cognchan . cogstate C@
dup 4 and if version W@ .cstr then
dup 10 and if i cognumpad version W@ C@ over C@ -
spaces .cstr then
14 and if i cogio i cognchan 0 do
i 4* over + 2+ W@ dup 0= if drop else
space space j i .cogch ." ->" io>cogchan .cogch
then
loop
drop then cr loop ;
\ jede erweiterung legt ein wort als startmarke
\ nmit folgendem namen an:
\ mod:xxx - softwaremodule
\ drv:xxx - treiber
\ lib:xxx - bibliotheken
\ so kann mit den folgenden kommandos eine schnelle liste der
\ vorhandenen erweiterungen abgerufen und mit forget
\ aus dem system entfernt werden
\ mod? ( -- ) - anzeige der module
ifnot: mod?
: mod? c" mod:" _words ;
\ lib? ( -- ) - anzeige der bibliotheken
ifnot: lib?
: lib? c" lib:" _words ;

325
forth/v1.mod Normal file
View File

@ -0,0 +1,325 @@
: 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ä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ä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ä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 ;

54
forth/wav.lib Normal file
View File

@ -0,0 +1,54 @@
hex
ifnot: lib:wav
: lib:wav ;
\ kommandoformen
ifnot: adm:fkt!b@ \ ( fkt -- b )
: adm:fkt!b@ b[ [a!] [a@] ]b ;
ifnot: adm:fkt!s!b@ \ ( s fkt -- b )
: adm:fkt!s!b@ b[ [a!] [a.s!] [a@] ]b ;
ifnot: adm:fkt!l@l@ \ ( fkt -- l l )
: adm:fkt!l@l@ b[ [a!] [a.l@] [a.l@] ]b ;
\ wave-funktionen
\ 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 ;
\ wav:status ( -- status )
ifnot: wav:status
: wav:status
98 adm:fkt!b@ ;
\ wav:leftvol ( vol -- )
ifnot: wav:leftvol
: wav:leftvol
99 adm:fkt!b! ;
\ wav:rightvol ( vol -- )
ifnot: wav:rightvol
: wav:rightvol
9A adm:fkt!b! ;
\ wav:pause ( -- )
ifnot: wav:pause
: wav:pause
9B adm:fkt!b@ drop ;
\ wav:position ( -- len pos )
ifnot: wav:position
: wav:position
9C adm:fkt!l@l@ ;

16
forth/words.mod Normal file
View File

@ -0,0 +1,16 @@
fl
\ _words ( cstr -- ) prints the words in the forth dictionary starting with cstr, 0 prints all
: _words lastnfa
begin
2dup swap dup if npfx else 2drop -1 then
if dup .strname space then
nfa>next dup 0=
until 2drop cr ;
\ words ( -- ) prints the words in the forth dictionary, if the pad has another string following, with that prefix
: words parsenw _xwords ;
: t1 1000 0 do i . loop ;
: t2 1000 0 do ." test " loop ;

23
forth/work/bload.f Normal file
View File

@ -0,0 +1,23 @@
fl
hex
\ metafunktionen
: (bload) \ ( cstr -- ) - belatrix-code laden
52 adm:open .err \ datei öffnen
b[
0 [b!] 63 [b!] \ bella-loader starten
10 0 do 06 [a!] [a@] [b!] loop \ header einlesen
0A [a!] 0 [a.l!] \ 0 adm:seek
[b@] <8 [b@] or \ dateilänge empfangen
0 do 06 [a!] [a@] [b!] loop \ datei senden
]b
adm:close .err \ datei schließen
;
: bload \ name ( -- ) - bellatrix-code laden
parsenw (bload) ;

93
forth/wplay.mod Normal file
View File

@ -0,0 +1,93 @@
hex
ifnot: mod:wplay
: mod:wplay ;
\ kommandoformate
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 ;
\ wave-funktionen
\ 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 ;
\ wav:status ( -- status )
ifnot: wav:status
: wav:status
98 adm:fkt!b@ ;
\ adm-funktionen
\ 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@ ;
\ metafunktionen
\ won
ifnot: won
: won
0 adm:setsound 3 adm:setsound 2drop ;
\ woff
ifnot: woff
: woff
2 adm:setsound 1 adm:setsound 2drop ;
\ wend? ( -- t/f )
ifnot: wend?
: wend?
begin 50 delms key? dup if key drop then wav:status 0= or until ;
\ (wplay) ( cstr -- )
ifnot: (wplay)
: (wplay) \ ( cstr -- )
." Datei : " dup .cstr cr wav:start .err wend? wav:stop ;
\ wplay name ( -- )
ifnot: wplay
: wplay
won parsenw (wplay) woff ;
\ files? ( -- cnt ) - anzahl dateien im dir
ifnot: files?
: files?
adm:diropen
0 begin adm:nextfile swap 1+ swap 0= until 3 - padbl ;
\ filenr? ( nr -- )
ifnot: filenr?
: filenr?
adm:diropen
0 do adm:nextfile drop loop ;
\ wdirplay ( -- ) - gesamtes verzeichnis abspielen
\ im verzeichnis dürfen nur wav-dateien sein!
ifnot: wdirplay
: wdirplay
won files? dup ." Dateien : " . cr
0 do i dup 1 + . 3 + filenr? pad (wplay) loop padbl woff ;

223
installation.rtf Normal file
View File

@ -0,0 +1,223 @@
{\rtf1\ansi\deff0{\fonttbl{\f0\fswiss\fcharset0 Arial;}}
{\*\generator Msftedit 5.41.15.1515;}\viewkind4\uc1\pard\lang1031\f0\fs20\par
1. Installation des Grundsystems\par
2. Forth im \'dcberblick\par
3. Regime im \'dcberblick\par
\par
\par
\par
\par
\ul\b 1. Installation des Grundsystems:\par
\ulnone\b0\par
1. Flashen der drei EEPROMS:\par
\par
\\flash\\administra\\admflash.spin\tab --> Administra\par
\\flash\\bellatrix\\belflash.spin\tab --> Bellatrix\par
\\flash\\regnatix\\regflash.spin\tab --> Regnatix\par
\par
2. Der Schalter bleibt ab jetzt auf Regnatix stehen. Ein Terminalprogramm (ich verwende Tera Term) starten und 57600 Baud auf die Schnittstelle vom Hive einstellen. Nach einem Reset meldet sich das Propforth im Terminal. Datei "system\\basics.f" in einem Editor \'f6ffnen, alles markieren, kopieren und im Terminal einf\'fcgen. Der Quelltext wird jetzt im Forth compiliert. \par
\par
3. Im Terminalfenster, aso im Forth, dass Kommendo "saveforth" eingeben. Damit wird das gesamte Forthsystem mit der gerade neu compilierten Erweiterungen wieder im EEPROM als Image gespeichert. \par
\par
Nach einem Reset sollte sich das Forth jetzt komplett mit seinem Prompt sowohl auf dem angeschlossenen VGA-Monitor, als auch im Terminal melden. Im Prinzip ben\'f6tigen wir nun das Terminalprogramm nicht mehr und k\'f6nnen direkt am Hive arbeiten. Sp\'e4ter, wenn man in Forth programmiert, ist die vorhandene Terminalschnittstelle aber manchmal sehr n\'fctzlich.\par
\par
\ul\b Erstellung einer Forth-SDCard:\par
\ulnone\b0\par
Im Prinzip kann jede normale FAT16/32 Karte verwendet werden. Lange Dateinamen werden nicht verwendet, Unterverzeichnisse sind kein Problem. Es ist sinnvoll, alle Dateien aus dem Verzeichnis "bin\\sd-card-basic\\" auf die SD-Karte zu kopieren.\par
\par
Das Verzeichnis "system" hat eine besondere Bedeutung: Hier sollten sich die Tools, Erweiterungen und Bibliotheken befinden. Mit dem Kommando "sys name.f" kann aus jedem anderen Verzeichnis ohne Wechsel die Datei name.f geladen und compiliert werden.\par
\par
\ul\b Systemstart:\par
\ulnone\b0\par
Beim Systemstart wird immer das Forth aus dem EEPROM gestartet. So kann, wie mit den klassischen Homecomputern, sofort unkompliziert programmiert werden. Neben dem Forth gibt es im TriOS noch ein in Spin programmiertes Betriebssystem, welches sich dem Benutzer durch den Kommandointerpreter Regime pr\'e4sentiert. Aus dem Forth kann diese mit dem Kommando "regime" gestartet werden. Im Gegenzug kann im laufenden Regime mit dem Kommando "forth" wieder zur integrierten Programmiersprache gewechselt werden.\par
\par
\ul\b 2. Forth im \'dcberblick:\ulnone\b0\par
\par
Einige n\'fctzliche Kommandos befinden sich in dem Modul tools.mod. In den meisten F\'e4llen ist es sinnvoll dieses Modul mit der Befehlssequenz "sys tools.mod saveforth" fest im Forth einzubinden.\par
\par
\b Wichtige Tastencodes:\par
\b0\par
[ESC]-1\tab\tab Screen 1, COG 1\par
[ESC]-2 \tab Screen 2, COG 2\par
[ESC]-3 \tab Screen 3, COG 3\par
[ESC]-b \tab Break, Reset der aktuellen COG\par
[ESC]-r \tab\tab Reset, Neustart Regnatix\par
\par
\b Wichtige Kommandos:\par
\b0\par
load <name>\tab - Datei laden und comilieren, Ausgabe Screen 3\par
dload <name>\tab - wie load, aber Ausgabe aktueller Screen\par
sys <name>\tab - Datei aus sys-Verzeichnis laden und compilieren\par
ls \tab - Dateiliste\par
lsl \tab - Dateiliste- Long-Format\par
cd <name> \tab - in Verzeichniss wechseln\par
mount \tab - SD-Card einbinden\par
unmount \tab - SD-Card freigeben\par
words \tab - Anzeige W\'f6terbuch\par
mod? \tab - (tools.mod) Anzeige compilierter Erweiterungen\par
lib? \tab - (tools.mod) Anzeige compilierter Bibliotheken\par
cog? \tab - (tools.mod) Anzeige COG-Liste\par
cat <name> \tab - (tools.mod) Ausgabe einer Textdatei\par
less <name> \tab - (tools.mod) Zeilenweise Textausgabe\par
dm? \tab - (tools.mod) Anzeige der Systemverzeichnisse\par
regime\tab\tab - CLI starten\par
aload <name>\tab - Adminsitra-Code laden\par
bload <name>\tab - Bellatrix-Code laden\par
spin <name>\tab - Spin-Programm starten\par
\par
\b Wichtige Dateien:\par
\b0\par
Die Dateien *.mod und *.lib enthalten ganz normale Forth-Quelltexte. Damit hat man schnell eine \'dcbersicht \'fcber die grobe Funktion dieser Quellen: Lib's sind halt reine Sammlungen von Worten zu einer bestimmten Funktionsgruppe und MOD's sind mehr oder weniger fertige und abgeschlossene Programme. Ein Beispiel:\par
\par
Die Datei hss.lib enth\'e4lt Worte um die HSS-Funktionen von Administra anzusprechen. Mit diesen Funktionen kann man nun ein Modul (Programm) wie einen HSS-Soundplayer schreiben.\par
\par
Im Gegensatz dazu die Datei splay.mod: Mit diesem Modul wird ein HSS-Soundplayer ins System eingef\'fcgt, welcher Funktionen aus der hss.lib verwendet. \par
\par
Die Datei ben\'f6tigt man aber mehr oder weniger nur zur Entwicklung, ein fertiges Modul wie splay.mod enth\'e4lt dann schon die die entsprechenden HSS-Worte die ben\'f6tigt werden. \par
\par
Die ifnot: ... Anweisung sorgt dabei daf\'fcr, dass keine Funktionen doppelt in das W\'f6rterbuch compiliert werden. Das ist quasi ein verteiltes und fein granuliertes Konzept analog zu einer DLL. Die Forth-Version funktioniert dabei aber im Gegensatz zu DLL's nicht auf Bibliotheks-, sondern auf Funktionsebene. \par
\par
*.mod \tab Module, Forth-Erweiterungen f\'fcr das System\par
*.lib \tab Bibliotheken, grundlegende Wortsammlungen\par
*.adm \tab Administra-Code (z.Bsp. admsid.adm f\'fcr SIDCog-Code)\par
*.bel \tab Bellatrix-Code\par
*.bin\tab Spin-Code, im Normalfall zur Ausf\'fchrung in Regnatix\par
\par
basics.f \tab - (mod:basics) Hive-Core f\'fcr PropForth\par
ari.lib \tab\tab - (lib:ari) Zus\'e4tzliche arithmetische Funktionen\par
cog.lib \tab - (lib:cog) Zus\'e4tzliche COG-Funktionen\par
adm.lib \tab - (lib:adm) Administra-Chipmanagment-Funktionen\par
hss.lib \tab - (lib:hss) Bibliothek f\'fcr Hydra-Sound-System\par
sfx.lib \tab\tab - (lib:sfx) Soundeffekt-Bibliothek\par
wav.lib \tab - (lib:wav) Wave-Soundbibliothek\par
\par
bel.lib \tab\tab - (lib:bel) Bellatrix-Chipmanagment-Funktionen\par
key.lib \tab - (lib:key) Tastatur-Bibliothek\par
scr.lib \tab\tab - (lib:scr) Screen-Bibliothek\par
sd0.lib \tab - (lib:sd0) SD-Card-Bibliothek\par
\par
debug.f \tab - N\'fctzliche Worte zur Fehlersuche und Entwicklung\par
rom.f \tab - EEPROM-Dateisystem\par
tools.f \tab\tab - N\'fctzliche Tools (cat, less, dm?...)\par
hplay.f \tab - HSS-Player\par
wplay.f \tab - WAV-Player\par
splay.f \tab - SID-Player\par
\par
Administra-Codedateien im SYS-Verzeichnis:\par
\par
admled.adm \tab Testprogramm - HBeat-LED blinken lassen\par
admsid.adm \tab SidCog-Version (wird von splay ben\'f6tigt)\par
admsys.adm \tab Standardcode f\'fcr ADM mit SD/HSS/WAV\par
admym.adm \tab Yamaha-Soundchip-Version\par
aterm96.adm \tab Mini-OS f\'fcr Administra (Testzwecke)\par
\par
\b Reset-Fehlercodes:\par
\b0\par
0011FFFF - stack overflow\par
0012FFFF - return stack overflow\par
0021FFFF - stack underflow\par
0022FFFF - return stack underflow\par
8100FFFF - no free cogs\par
8200FFFF - no free main memory\par
8400FFFF - fl no free main memory\par
8500FFFF - no free cog memory\par
8800FFFF - eeprom write error\par
9000FFFF - eeprom read error\par
\par
\b .err-Fehlercodes:\par
\b0\par
0 no error\par
1 fsys unmounted\par
2 fsys corrupted\par
3 fsys unsupported\par
4 not found\par
5 file not found\par
6 dir not found\par
7 file read only\par
8 end of file\par
9 end of directory\par
10 end of root\par
11 dir is full\par
12 dir is not empty\par
13 checksum error\par
14 reboot error\par
15 bpb corrupt\par
16 fsi corrupt\par
17 dir already exist\par
18 file already exist\par
19 out of disk free space\par
20 disk io error\par
21 command not found\par
22 timeout\par
23 parameter error\par
\par
\ul\b 3. Regime im \'dcberblick\par
\par
\ulnone\b0 Da wir ja drei verschiedene Teilsystem in unserem Computer haben, muss Regime wissen, f\'fcr welchen Chip eine ausf\'fchrbare Datei bestimmt ist. Den Typ ausf\'fchrbarer Dateien kann Regime automatisch anhand der Dateinamenserweiterung unterscheiden:\par
\par
*.bin\tab Regnatix-Code\par
*.bel\tab Bellatrix-Code\par
*.adm\tab Administra-Code\par
\par
Dabei gen\'fcgt es, den Namen ohne Erweiterung einzugeben. Dennoch kann es vorkommen, das man eine normale Spin-Datei mit einer beliebigen Erweiterung gespeichert hat. Diese Datei kann man dann mit den Kommandos rload, aload oder bload ganz gezielt in einen Chip laden.\par
\par
<dateiname> \tab\tab - bin/adm/bel-datei wird gestartet\par
mount\tab\tab\tab\tab - SD-aufwerk mounten\par
unmount\tab\tab\tab - SD-Laufwerk freigeben\par
dir wh\tab\tab\tab\tab - Verzeichnis anzeigen\par
type <sd:fn>\tab\tab\tab - Anzeige einer Textdatei\par
aload <sd:fn>\tab\tab\tab - Administra-Code laden\par
bload <sd:fn>\tab\tab\tab - Bellatrix-Code laden\par
rload <sd:fn>\tab\tab\tab - Regnatix-Code laden\par
del <sd:fn>\tab\tab\tab - Datei l\'f6schen\par
cls\tab\tab\tab\tab - Bildschirm l\'f6schen\par
free\tab\tab\tab\tab - Anzeige des freien Speichers auf SD-Card\par
attrib <sd:fn> ashr\tab\tab - Dateiattribute \'e4ndern\par
cd <sd:dir>\tab\tab\tab - Verzeichnis wechseln\par
mkdir <sd:dir>\tab\tab\tab - Verzeichnis erstellen\par
rename <sd:fn1> <sd:fn2>\tab - datei/verzeichnis umbenennen\par
format <volname>\tab\tab - SD-Laufwerk formatieren\par
reboot\tab\tab\tab\tab - Hive neu starten\par
sysinfo\tab\tab\tab\tab - Systeminformationen\par
color <0..7>\tab\tab\tab - Farbe w\'e4hlen\par
cogs\tab\tab\tab\tab - Belegung der COG's anzeigen\par
dmlist\tab\tab\tab\tab - Anzeige der Verzeichnis-Marker\par
dm <r/s/u/a/b/c>\tab\tab - Marker-Verzeichnis wechseln\par
dmset <r/s/u/a/b/c>\tab\tab - Marker setzen\par
dmclr <r/s/u/a/b/c>\tab\tab - Marker l\'f6schen\par
forth\tab\tab\tab\tab - Forth starten\par
\par
Marker:\par
r\tab - Marker f\'fcr Root-Verzeichnis\par
s\tab - Marker f\'fcr System-Verzeichnis\par
u\tab - Marker f\'fcr User-Verzeichnis\par
a/b/c\tab - Benutzerdefinierte Verzeichnismarker\par
\par
Die r, s, u-Marker werden vom System automatisch gesetzt und intern verwendet.\par
\par
RAMDISK:\par
\par
xload <sd:fn>\tab\tab\tab - Datei von SD-Laufwerk in RAM laden\par
xsave <x:fn>\tab\tab\tab - Datei aus RAM auf SD-Laufwerk speichern\par
xdir\tab\tab\tab\tab - Verzeichnis im RAM anzeigen\par
xrename <x:fn1> <x:fn2> \tab - Datei im RAM umbenennen\par
xdel <x:fn>\tab\tab\tab - Datei im RAM l\'f6schen\par
xtype <x:fn>\tab\tab\tab - Textdatei im RAM anzeigen\par
\par
EXTERNE KOMMANDOS:\par
\par
Die meisten Kommandozeilentools zeigen mit dem Parameter /? eine Liste der Optionen an.\par
\par
sysconf \tab - Systemeinstellungen\par
hplay\tab\tab - HSS-Player\par
wplay\tab\tab - WAV-Player\par
splay\tab\tab - SID-Player\par
yplay\tab\tab - Yamaha-Soundchip-Player\par
sfxtool\tab\tab - HSS-Soundeffekte erstellen\par
\par
vga.bin\tab\tab - VGA 1024 x 768 Pixel, 64 x 24 Zeichen\par
htext.bin\tab - VGA 1024 x 768 Pixel, 128 x 48 Zeichen\par
tv.bin\tab\tab - TV-Textmodus 40 x 13 Zeichen\par
\par
}

Binary file not shown.

View File

@ -1,5 +1,6 @@
{\rtf1\ansi\ansicpg1252\deff0\deftab709{\fonttbl{\f0\fnil\fcharset0 Times New Roman;}{\f1\fnil\fcharset128 Times New Roman;}{\f2\fnil\fcharset0 Courier New;}{\f3\fnil\fcharset2 Symbol;}} {\rtf1\ansi\ansicpg1252\deff0\deftab709{\fonttbl{\f0\fnil\fcharset0 Times New Roman;}{\f1\fnil\fcharset128 Times New Roman;}{\f2\fnil\fcharset0 Courier New;}{\f3\fnil\fcharset2 Symbol;}}
{\*\generator Msftedit 5.41.15.1515;}\viewkind4\uc1\pard\lang1031\f0\fs20 15-04-2011-dr235\tab\tab - flash-tool/rom: damit kann unter anderem eine bin-datei (z. bsp. basic) in den hi-rom \par {\*\generator Msftedit 5.41.15.1515;}\viewkind4\uc1\pard\lang1031\f0\fs20 23.04.2011-dr235\tab\tab - integration von propforth in trios\par
15-04-2011-dr235\tab\tab - flash-tool/rom: damit kann unter anderem eine bin-datei (z. bsp. \tab\tab\tab basic) in den hi-rom \par
\tab\tab\tab (64k eeprom erforderlich!) gespeichert und mit rom gestartet werden\par \tab\tab\tab (64k eeprom erforderlich!) gespeichert und mit rom gestartet werden\par
\tab\tab\tab - \'fcbernahme der rtc-routinen von stephan\par \tab\tab\tab - \'fcbernahme der rtc-routinen von stephan\par
\tab\tab\tab - time-kommando: anzeige/\'e4nderung datum/zeit\par \tab\tab\tab - time-kommando: anzeige/\'e4nderung datum/zeit\par
@ -19,7 +20,15 @@
19-07-2010-dr235 \f0\tab\f1 - booten eines alternativen administra-codes: befindet sich auf der karte\par 19-07-2010-dr235 \f0\tab\f1 - booten eines alternativen administra-codes: befindet sich auf der karte\par
\f0\tab\tab \f1 in der root eine datei "adm.sys", so wird diese datei automatisch in\par \f0\tab\tab \f1 in der root eine datei "adm.sys", so wird diese datei automatisch in\par
\f0\tab\tab \f1 administra geladen\par \f0\tab\tab \f1 administra geladen\par
11-07-2010-dr235\tab\f0\tab\f1 - integration sid1/2-funktionen in admsid/ios\line\tab\tab\tab - anpassung sid-demo von ahle2 als regnatix-code (verzeichnis demo)\line\tab\tab\tab - diverse graphics-spielereien (verzeichnis demo)\line\tab\tab\tab - sysconf /af - administra neu booten (admflash.adm\line\tab\tab\tab wird dadurch \u252?berfl\u252?ssig)\line 27-06-2010-dr085/235\tab - admin mountet nun automatisch nach einem boot\tab\tab\line 26-06-2010-dr235\tab\f0\tab\f1 - div. demos zugef\u252?gt\line\tab\tab\tab - shooter angepasst und eingef\u252?gt\line 20-06-2010-dr235\tab\f0\tab\f1 - erste lauff\u228?hige SID-Player-Version\line\tab\tab\tab f\u252?r die Kommandozeile (splay)\line 14-06-2010-dr085/235\tab - Semaphoren in FATEngine korrekt eingesetzt\line\tab\tab\tab - Abfrage des Volume-Labels korrigiert\line 10-06-2010-dr235\tab\f0\tab\f1 - Kommando "ramtest" zugef\u252?gt\line 09-06-2010-dr085\tab\f0\tab\f1 - Fehler in Administra-Bootfunktion behoben\line\line -----------------------------------------------------------------------------------------------\line\line\f0 02-10-2010-dr235\par 11-07-2010-dr235\tab\f0\tab\f1 - integration sid1/2-funktionen in admsid/ios\line\tab\tab\tab - anpassung sid-demo von ahle2 als regnatix-code (verzeichnis demo)\line\tab\tab\tab - diverse graphics-spielereien (verzeichnis demo)\line\tab\tab\tab - sysconf /af - administra neu booten (admflash.adm\line\tab\tab\tab wird dadurch \u252?berfl\u252?ssig)\line 27-06-2010-dr085/235\tab - admin mountet nun automatisch nach einem boot\tab\tab\line 26-06-2010-dr235\tab\f0\tab\f1 - div. demos zugef\u252?gt\line\tab\tab\tab - shooter angepasst und eingef\u252?gt\line 20-06-2010-dr235\tab\f0\tab\f1 - erste lauff\u228?hige SID-Player-Version\line\tab\tab\tab f\u252?r die Kommandozeile (splay)\line 14-06-2010-dr085/235\tab - Semaphoren in FATEngine korrekt eingesetzt\line\tab\tab\tab - Abfrage des Volume-Labels korrigiert\line 10-06-2010-dr235\tab\f0\tab\f1 - Kommando "ramtest" zugef\u252?gt\line 09-06-2010-dr085\tab\f0\tab\f1 - Fehler in Administra-Bootfunktion behoben\line\line -----------------------------------------------------------------------------------------------\line\par
\f0 23-04-2011-dr235\par
\par
Ein neuer Meilenstein: PropForth ist jetzt in TriOS integriert. Als Nebeneffekt starten nun wieder, wie bei meiner ersten SpinOS-Version, alle drei Chips ihren initialen Code aus ihrem EEPROM und nicht mehr vom SD-Laufwerk. Damit gibt es vom Einschalten bis zum Forth-Prompt quasi keine f\'fchlbare Bootzeit mehr. So geh\'f6rt es sich f\'fcr einen richtigen Homecomputer. Es ist nun m\'f6glich, unmittelbar nach dem Einschalten sofort zu programmieren. Erst wenn man zu Regime wechselt wird kurz reg.sys nachgeladen. Aber selbst die Ladezeiten sind nun durch Verwendung des SD-Blocktransfer erfreulich kurz. \par
\par
Obwohl das Grundsystem vom Forth den halben hRAM belegt, ist es als genormte Sprache doch eine wunderbare Geschichte im Hive. Viele der Ressourcen sind jetzt schon problemlos in Forth nutzbar und man kann sehr unkompliziert experimentieren.\par
\par
\f1\par
\f0 02-10-2010-dr235\par
\par \par
\ul\b Speicherverwaltung:\par \ul\b Speicherverwaltung:\par
\ulnone\b0\par \ulnone\b0\par

View File

@ -10,8 +10,12 @@ REM --> \bin\flash
bstc -L %libpath% -b -O a .\flash\administra\admflash.spin bstc -L %libpath% -b -O a .\flash\administra\admflash.spin
move admflash.binary %flash% move admflash.binary %flash%
bstc -L %libpath% -b -O a .\flash\bellatrix\belflash.spin bstc -L %libpath% -b -O a .\flash\bellatrix\belflash.spin
move belflash.binary %flash% copy belflash.binary %flash%
rename belflash.binary vga.bel
move vga.bel %sd-sys%
bstc -L %libpath% -b -O a .\flash\regnatix\regflash.spin bstc -L %libpath% -b -O a .\flash\regnatix\regflash.spin
move regflash.binary %flash% move regflash.binary %flash%
@ -27,8 +31,8 @@ bstc -L %libpath% -b -O a .\system\regnatix\regime.spin
rename regime.binary reg.sys rename regime.binary reg.sys
move reg.sys %sd% move reg.sys %sd%
bstc -L %libpath% -b -O a .\system\bellatrix\vga-text-1024x768-pix-64x24-zeichen\vga.spin bstc -L %libpath% -b -O a .\flash\bellatrix\belflash.spin
rename vga.binary bel.sys rename belflash.binary bel.sys
move bel.sys %sd% move bel.sys %sd%
REM ---------------------------------------------------------------- REM ----------------------------------------------------------------
@ -109,6 +113,12 @@ bstc -L %libpath% -b -O a .\system\regnatix\yplay.spin
rename yplay.binary yplay.bin rename yplay.binary yplay.bin
move yplay.bin %sd-sys% move yplay.bin %sd-sys%
REM ----------------------------------------------------------------
REM Forthdateien kopieren
copy .\forth\*.* %sd-sys%
REM ---------------------------------------------------------------- REM ----------------------------------------------------------------
REM Zusatzdateien kopieren REM Zusatzdateien kopieren

Binary file not shown.

Binary file not shown.

View File

@ -25,12 +25,13 @@ dm <r/s/u/a/b/c> - in das entsprechende marker-
dmset <r/s/u/a/b/c> - setzt den entsprechenden marker dmset <r/s/u/a/b/c> - setzt den entsprechenden marker
auf das aktuelle verzeichnis auf das aktuelle verzeichnis
dmclr <r/s/u/a/b/c> - marker löschen dmclr <r/s/u/a/b/c> - marker löschen
forth - forth starten
marker: marker:
r - root-verzeichnis r - root-verzeichnis
s - system-verzeichnis s - system-verzeichnis
u - user-verzeichnis u - user-verzeichnis
a/b/c - benutzerdefinierte verzeichnismarker a/b/c - benutzerdefinierte verzeichnismarker
r, s, u-marker werden vom system automatisch gesetzt und r, s, u-marker werden vom system automatisch gesetzt und
intern verwendet. intern verwendet.