mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-06-01 06:41:37 +00:00
Merge branch 'master' of https://github.com/forth-ev/VolksForth into c64-390
This commit is contained in:
Philip Zembrod
commit
65208401c4
|
|
@ -5,8 +5,8 @@ Version 1.2
|
|||
|
||||
volksFORTH ist ein 16bit Forthsystem der Forth Gesellschaft e.V. Die
|
||||
Hauptentwicklung am volksFORTH fand von 1985 bis 1989 statt. Das
|
||||
volksFORTH Projekt wurde 2005 wiederbelebt, um ein ueberschaubares
|
||||
Forth-System fuer Systeme mit begrenzten Systemresourcen zur Verfuegung
|
||||
volksFORTH Projekt wurde 2005 wiederbelebt, um ein überschaubares
|
||||
Forth-System für Systeme mit begrenzten Systemresourcen zur Verfügung
|
||||
zu stellen.
|
||||
|
||||
Einige moderne Forth Systeme sind von volksFORTH beeinflusst worden oder
|
||||
|
|
@ -15,8 +15,8 @@ von volksFORTH abgeleitet worden (GNU-Forth, bigForth).
|
|||
Die aktuelle volksFORTH Version ist 3.81. Die Arbeit an der Version 3.90
|
||||
hat begonnen.
|
||||
|
||||
Derzeit stehen volksFORTH Versionen fuer folgende
|
||||
Rechner/Betriebssysteme zur Verfuegung:
|
||||
Derzeit stehen volksFORTH Versionen für folgende
|
||||
Rechner/Betriebssysteme zur Verfügung:
|
||||
|
||||
VolksForth MS-DOS (Intel x86
|
||||
Architecture
|
||||
|
|
@ -31,7 +31,7 @@ VolksForth Z80 (CP/M,
|
|||
|
||||
VolksForth 68000 (Atari ST)
|
||||
|
||||
VolksForth fuer folgende Rechner/Systeme ist in Arbeit:
|
||||
VolksForth für folgende Rechner/Systeme ist in Arbeit:
|
||||
|
||||
VolksForth MS-DOS (Atari Portfolio)
|
||||
VolksForth 6502 (Apple II, Commodore PET)
|
||||
|
|
@ -44,10 +44,10 @@ Die volksFORTH Quelldateien unterliegen der
|
|||
BSD Lizenz - http://www.opensource.org/licenses/bsd-license.php
|
||||
|
||||
Das Handbuch unterliegt dem Copyright (c) 1985 - 2006 Forth Gesellschaft
|
||||
e.V. ( Klaus Schleisiek, Ulrich Hoffmann, Bernd Pennemann, Georg Rehfeld
|
||||
e.V. (Klaus Schleisiek, Ulrich Hoffmann, Bernd Pennemann, Georg Rehfeld
|
||||
und Dietrich Weineck).
|
||||
|
||||
Autoren des volksForth/ultraForth sind
|
||||
Autoren des volksForth/ultraForth sind:
|
||||
|
||||
- Bernd Pennemann,
|
||||
- Claus Vogt,
|
||||
|
|
@ -58,7 +58,7 @@ Autoren des volksForth/ultraForth sind
|
|||
- Ewald Rieger,
|
||||
- Carsten Strotmann.
|
||||
|
||||
Handbuecher, Programmdateien und Quellcode zum volksFORTH sowie
|
||||
Handbücher, Programmdateien und Quellcode zum volksFORTH sowie
|
||||
Informationen zur Forth Gesellschaft finden Sie auf dem Webserver der
|
||||
Forth Gesellschaft
|
||||
|
||||
|
|
@ -78,9 +78,9 @@ Hinweise zum volksFORTH C=64/C16/Plus4 (ultraForth)
|
|||
C16 oder C116 mit 32kB oder 64kB mit Diskettenlaufwerk
|
||||
C16 oder C116 mit 64kB oder Plus4 mit Kassettenrekorder
|
||||
|
||||
Die Ursprungsversion des C16 mit 16kB ist nicht ultraFORTH-faehig,
|
||||
Die Ursprungsversion des C16 mit 16kB ist nicht ultraFORTH-fähig,
|
||||
da allein der FORTH-Kern den Speicher von $1000 bis $4b00 belegt.
|
||||
Der Umbau auf 64kB ist kostengünstig und lohnt sich eigentlich immer.
|
||||
Der Umbau auf 64kB ist kostengünstig und lohnt sich eigentlich immer.
|
||||
|
||||
Ein Diskettenlaufwerk ist sehr empfehlenswert.
|
||||
|
||||
|
|
@ -88,73 +88,73 @@ Ein Diskettenlaufwerk ist sehr empfehlenswert.
|
|||
|
||||
In der Distribution finden sich folgende Files:
|
||||
|
||||
vforth_1.d64 - Disketteimage Diskette 1 für Emulator
|
||||
vforth_1.d64 - Disketteimage Diskette 1 für Emulator
|
||||
C64 volksForth Binary
|
||||
C16 volksForth Binary
|
||||
Sourcecode
|
||||
vforth_2.d64 - Disketteimage Diskette 3 für Emulator
|
||||
Sourcecode
|
||||
vforth_2.d64 - Disketteimage Diskette 2 für Emulator
|
||||
Kompletter volksForth 6502 C64/C16 Quellcode
|
||||
vforth_3.d64 - Disketteimage Diskette 3 für Emulator
|
||||
vforth_3.d64 - Disketteimage Diskette 3 für Emulator
|
||||
Assembler, Disassembler, Editor
|
||||
vforth_4.d64 - Disketteimage Diskette 4 für Emulator
|
||||
vforth_4.d64 - Disketteimage Diskette 4 für Emulator
|
||||
Grafik, Demos, Tools, Decompiler
|
||||
tc38q.d64 - Quelltexte des Target Compilers
|
||||
|
||||
Diese Version des volksForth für den C=64 benutzt noch ein traditionelles
|
||||
Diese Version des volksForth für den C=64 benutzt noch ein traditionelles
|
||||
Forth-Block Dateisystem auf den Disketten. Ab der kommenden Version 3.90
|
||||
wird auch diese Version eine ANSI-Forth Dateischnittstelle bekommen. Die
|
||||
Forth-Block Routinen wird es weiterhin als optionales Quellcodepaket zum
|
||||
Forth-Block-Routinen wird es weiterhin als optionales Quellcodepaket zum
|
||||
Nachladen geben.
|
||||
|
||||
* über UltraForth/volksForth 6502/UltraForth83 ist das volksForth fuer die
|
||||
* über UltraForth/volksForth 6502/UltraForth83 ist das volksForth für die
|
||||
kleinen Commodore-Rechner C16, Plus4 und C64.
|
||||
|
||||
UltraForth83 besteht aus ca. 200 Seiten Handbuch in deutscher Sprache und
|
||||
vier Diskettenseiten. UltraForth83 ist sicher das beste Forth-System fuer
|
||||
den C64. Fuer den C16/Plus4 war es lange Zeit die einzige enstzunehmende
|
||||
Programmiersprache überhaupt.
|
||||
vier Diskettenseiten. UltraForth83 ist sicher das beste Forth-System für
|
||||
den C64. Für den C16/Plus4 war es lange Zeit die einzige enstzunehmende
|
||||
Programmiersprache überhaupt.
|
||||
|
||||
UltraForth83 ist eine komplette Programmierumgebung. Es enthaelt einen
|
||||
UltraForth83 ist eine komplette Programmierumgebung. Es enthält einen
|
||||
Full-Screen-Editor, einen quelltextnahe Debugger, den Compiler/Interpreter
|
||||
und einen Assembler.
|
||||
|
||||
UltraForth83 entspricht dem Forth83-Standard und existiert in aehnlichen
|
||||
UltraForth83 entspricht dem Forth83-Standard und existiert in ähnlichen
|
||||
Versionen auf Atari ST, C16/64/+4, Apple I, Apple II, Atari 8bit CP/M und
|
||||
MS-DOS PCs.
|
||||
|
||||
Der Name ultraForth wurde gewaehlt, da auf dem legendaeren C64 kein Programm
|
||||
Der Name ultraForth wurde gewählt, da auf dem legendären C64 kein Programm
|
||||
geklaut wurde, das nicht mindestens Super, Turbo oder eben Ultra hiess. Da
|
||||
diese seligen Zeiten schon lange vorbei sind, wird die kommende Version 3.90
|
||||
wieder volksForth 6502 C=64 heissen :)
|
||||
|
||||
* Zur Erlaeuterung der Bloecke/Screens
|
||||
* Zur Erläuterung der Blöcke/Screens
|
||||
|
||||
ultraForth/volksForth verwendete wie viele damalige Forth-Systeme statt 'normalen'
|
||||
Dateien Bloecke. Dabei handelt es sich um Disketten/Plattenbereiche fester Groesse,
|
||||
Dateien Blöcke. Dabei handelt es sich um Disketten/Plattenbereiche fester Größe,
|
||||
im Forth-83-Standard von jeweils 1024 bytes. Diese wurden ohne Betriebssystem-Unter-
|
||||
stuetzung auf die Platte geschrieben. Nebenbei werden Forth-Compiler auch heute noch
|
||||
oft als Forth-'Systeme' bezeichnet, da sie urspruenglich ohne Betriebssystem liefen
|
||||
stützung auf die Platte geschrieben. Nebenbei werden Forth-Compiler auch heute noch
|
||||
oft als Forth-'Systeme' bezeichnet, da sie ursprünglich ohne Betriebssystem liefen
|
||||
und daher leicht auf neue Hardware portiert werden konnten.
|
||||
|
||||
Die Forth-Quellen sind in solchen Bloecken gespeichert. Sie heissen auch Screens, da
|
||||
sie mit 16 Zeilen zu je 64 Zeichen einen Bildschirm (fast) ausfuellen.
|
||||
Die Forth-Quellen sind in solchen Blöcken gespeichert. Sie heissen auch Screens, da
|
||||
sie mit 16 Zeilen zu je 64 Zeichen einen Bildschirm (fast) ausfüllen.
|
||||
|
||||
Beim Commodore mit seinem 24x40-Bildschirm wurde ein anderes Format gewaehlt. Hier
|
||||
wurden 23 Zeilen zu 41 Zeichen und eine letzte Zeile zu 40 Zeichen benutzt. Das fuellte
|
||||
Beim Commodore mit seinem 24x40-Bildschirm wurde ein anderes Format gewählt. Hier
|
||||
wurden 23 Zeilen zu 41 Zeichen und eine letzte Zeile zu 40 Zeichen benutzt. Das füllte
|
||||
den Bildschirm genau aus und bot noch eine (unsichtbare) Spalte mit Leerzeichen.
|
||||
|
||||
Der Plattenzugriff in Bloecken ist leichter zu implementieren. Auf den Commodore Rechnern
|
||||
bot er zusaetzlich extreme Geschwindigkeitsvorteile.
|
||||
Der Plattenzugriff in Blöcken ist leichter zu implementieren. Auf den Commodore Rechnern
|
||||
bot er zusätzlich extreme Geschwindigkeitsvorteile.
|
||||
|
||||
Das Schreiben in Block-Manier fuehrt positiv zu kurzen Quelltext-Abschnitten und
|
||||
uebersichtlicher Organisation der Quellen. Zum Problem wurde es, wenn man doch noch
|
||||
ein paar Zeilen einfuegen will. Um einen Block einzuschieben, musste man alle anderen
|
||||
Bloecke um eins verschieben. Dies geschah z.B. mit '10 50 11 CONVEY'. Ein Tippfehler
|
||||
und die Quellen waren weg. Die Erinnerung an Convey duerfte alte Forthler immer noch
|
||||
Das Schreiben in Block-Manier führt positiv zu kurzen Quelltext-Abschnitten und
|
||||
übersichtlicher Organisation der Quellen. Zum Problem wurde es, wenn man doch noch
|
||||
ein paar Zeilen einfügen wollte. Um einen Block einzuschieben, musste man alle anderen
|
||||
Blöcke um eins verschieben. Dies geschah z.B. mit '10 50 11 CONVEY'. Ein Tippfehler
|
||||
und die Quellen waren weg. Die Erinnerung an Convey dürfte alte Forthler immer noch
|
||||
erbleichen lassen. Damit wurden wohl mehr Quellen vernichtet, als mit dem damaligen
|
||||
Dos-DISKCOPY. Letzteres erforderte ungefaehr 6 Diskettenwechsel. Jede Verwechslung
|
||||
der Disketten fuehrte zwangslaeufig zu Datenverlust. 'Legen Sie die Quelle ins Ziel'
|
||||
war eine gaengige Verballhornung der Diskcopy-Meldungen.
|
||||
Dos-DISKCOPY. Letzteres erforderte ungefähr 6 Diskettenwechsel. Jede Verwechslung
|
||||
der Disketten führte zwangsläufig zu Datenverlust. 'Legen Sie die Quelle ins Ziel'
|
||||
war eine gängige Verballhornung der Diskcopy-Meldungen.
|
||||
|
||||
* Erste Schritte
|
||||
|
||||
|
|
@ -178,46 +178,46 @@ Ein Diskettenlaufwerk ist sehr empfehlenswert.
|
|||
|
||||
Der C16 hat im Gegensatz zum C64 keine RESTORE-Taste.
|
||||
|
||||
Es gibt folgende Moeglichkeiten, ultraFORTH zu verlassen oder abzubrechen:
|
||||
Es gibt folgende Möglichkeiten, ultraFORTH zu verlassen oder abzubrechen:
|
||||
- Das Forth-Wort "BYE" schliesst die ultraFORTH-Bereiche und startet den Monitor.
|
||||
- Das Festhalten der "<Run/Stop>"-Taste mit gleichzeitigem Druecken der
|
||||
"<Reset>"-Taste fuehrt zu einem Reinitialisieren der I/O-Funktionen ohne
|
||||
- Das Festhalten der "<Run/Stop>"-Taste mit gleichzeitigem Drücken der
|
||||
"<Reset>"-Taste führt zu einem Reinitialisieren der I/O-Funktionen ohne
|
||||
Schliessen der ultraFORTH-Bereiche und startet den Monitor. Bei einem
|
||||
anschliessenden Restart von ultraFORTH ist alles so, wie vorher verlassen.
|
||||
- Die normale Benutzung des MONITORS schadet den von ultraFORTH benutzen
|
||||
Bereichen nicht.
|
||||
- Das Druecken der RESET-Taste ohne "<Run/Stop>"-Taste oder der
|
||||
Monitor-Befehl "1X" fuehren ins BASIC. Da ultraFORTH und BASIC
|
||||
die gleichen Speicher-Bereiche verschieden benutzen, folgt danach i.a.
|
||||
- Das Drücken der RESET-Taste ohne "<Run/Stop>"-Taste oder der
|
||||
Monitor-Befehl "1X" führen ins BASIC. Da ultraFORTH und BASIC
|
||||
die gleichen Speicher-Bereiche verschieden benutzen, folgt danach i.a.R.
|
||||
bald ein System-Absturz beider Sprachen oder unsinnige Reaktionen.
|
||||
|
||||
Die Benutzung des FORTH ist wie im Handbuch beschrieben. Selbst Woerter
|
||||
wie "C64init" heissen weiterhin genauso. Der verf<EFBFBD>gbare Speicher ist um
|
||||
fast 16kB groesser als der der C64-Version. Das Wort "C64fkeys" ist neu
|
||||
Die Benutzung des FORTH ist wie im Handbuch beschrieben. Selbst Wörter
|
||||
wie "C64init" heissen weiterhin genauso. Der verfügbare Speicher ist um
|
||||
fast 16kB größer als der der C64-Version. Das Wort "C64fkeys" ist neu
|
||||
hinzugekommen. Es installiert auf einem C16 die Funktionstastenbelegung des C64.
|
||||
|
||||
S.155 - Die Benutzung des EDITORS hat sich etwas geaendert, da Commodore die
|
||||
Ein/Ausgabe-Routinen geaendert hat. Die "<Fx>-Tasten sind etwas anders beschriftet.
|
||||
Die im Handbuch erwaehnte "<Ctrl>+@"-Funktion liegt beim C16 auf "<Ctrl>+&".
|
||||
S.155 - Die Benutzung des EDITORS hat sich etwas geändert, da Commodore die
|
||||
Ein/Ausgabe-Routinen geändert hat. Die "<Fx>-Tasten sind etwas anders beschriftet.
|
||||
Die im Handbuch erwähnte "<Ctrl>+@"-Funktion liegt beim C16 auf "<Ctrl>+&".
|
||||
|
||||
Im Gegensatz zu der Bemerkung des Handbuchs "S 149" koennen Zeilen nach
|
||||
unten aus dem Bildschirm geschoben werden. Dies geschieht unter folgenden Umstaenden:
|
||||
Im Gegensatz zu der Bemerkung des Handbuchs auf S. 149 können Zeilen nach
|
||||
unten aus dem Bildschirm geschoben werden. Dies geschieht unter folgenden Umständen:
|
||||
- Es wird in die 40. Bildschirmspalte einer beliebigen Spalte ein
|
||||
beliebiges Zeichen geschrieben. ( Wenn hier eine logische
|
||||
Bildschirmzeile aufhoert, schiebt die I/O-Routine eine neue Zeile ein)
|
||||
beliebiges Zeichen geschrieben. (Wenn hier eine logische
|
||||
Bildschirmzeile aufhört, schiebt die I/O-Routine eine neue Zeile ein)
|
||||
- Es wird "<ESC> I" eingegeben oder eine andere "<Esc>"-Kombination,
|
||||
die eine Zeile aus dem Bildschirm schiebt.
|
||||
|
||||
Die C16 ESCAPE-Tasten-Funktionen koennen benutzt werden, fuehren
|
||||
Die C16 ESCAPE-Tasten-Funktionen können benutzt werden, führen
|
||||
aber zusammen mit Editor-Funktionen zu sonderbaren Bildschirm-Reaktionen.
|
||||
|
||||
Benutzung der GRAFIK:
|
||||
Die Grafik ist bisher nicht angepasst und laeuft daher nicht.
|
||||
Die Grafik ist bisher nicht angepasst und läuft daher nicht.
|
||||
|
||||
Saemtliche TOOLS der System-Diskette sind angepasst, bzw. funktionieren ohne Aenderung.
|
||||
Sämtliche TOOLS der System-Diskette sind angepasst, bzw. funktionieren ohne Änderung.
|
||||
|
||||
Die Benutzung des Assemblers hat sich nicht geaendert. Es muss nur beachtet werden,
|
||||
dass ultraFORTH das ROM abschaltet. Daher muessen Lesezugriffe ins ROM etwas anders
|
||||
Die Benutzung des Assemblers hat sich nicht geändert. Es muss nur beachtet werden,
|
||||
dass ultraFORTH das ROM abschaltet. Daher müssen Lesezugriffe ins ROM etwas anders
|
||||
organisiert werden.
|
||||
|
||||
Beispiel:
|
||||
|
|
@ -229,16 +229,16 @@ Ein Diskettenlaufwerk ist sehr empfehlenswert.
|
|||
|
||||
S.48 Speichermodell:
|
||||
|
||||
Der ultraFORTH-Assembler-Scratchbereich von $029 aufwaerts sollte
|
||||
Der ultraFORTH-Assembler-Scratchbereich von $029 aufwärts sollte
|
||||
max. bis inclusive $76 genutzt werden, da sonst Monitor&Kernal-Bereiche
|
||||
ueberschrieben werden.
|
||||
überschrieben werden.
|
||||
|
||||
Zusaetzlich zu den im Handbuch beschriebenen Bereichen benutzt die
|
||||
C16-Version den Bereich von $0700 - $071E fuer eine Interrupt-Routine.
|
||||
Zusätzlich zu den im Handbuch beschriebenen Bereichen benutzt die
|
||||
C16-Version den Bereich von $0700 - $071E für eine Interrupt-Routine.
|
||||
|
||||
Statt "SYS(2064)" steht "SYS(4112)"
|
||||
|
||||
Der FORTH-Kern belegt nicht wie beim C64 den Bereich von $800 bis "limit",
|
||||
Der FORTH-Kern belegt nicht, wie beim C64, den Bereich von $800 bis "limit",
|
||||
sondern von $1000 bis "limit"
|
||||
|
||||
"limit" liegt nicht automatisch unterhalb von $E000 sondern bei $fd00 (64kb RAM)
|
||||
|
|
@ -249,15 +249,15 @@ Ein Diskettenlaufwerk ist sehr empfehlenswert.
|
|||
Bank-Switching:
|
||||
|
||||
Da beim C16 das Bank-Switching etwas anders funktioniert, mussten folgende
|
||||
Aenderungen vorgenommen werden:
|
||||
Änderungen vorgenommen werden:
|
||||
- ultraFORTH schaltet bei der Initialisierung das komplette ROM aus.
|
||||
- Daher muessen alle Lese-Zugriffe (auch JSR) ins ROM
|
||||
mittels Makro und/oder Umleitungsroutine implementiert werden.
|
||||
- Daher müssen alle Lese-Zugriffe (auch JSR) mittels Makro und/oder
|
||||
Umleitungsroutine ins ROM implementiert werden.
|
||||
- Daher musste die Interrupt-Behandlung umgeleitet werden.
|
||||
|
||||
Aus der veraenderten Interrupt-Behandlung ergibt sich eine geringe
|
||||
Verlangsamung des Systems. Ca. 1 Promille der CPU-Zeit verbringt das
|
||||
System zusaetzlich in der neuen Interrupt-Routine. Weiterhin fuehrt ein
|
||||
Aus der veränderten Interrupt-Behandlung ergibt sich eine geringe
|
||||
Verlangsamung des Systems. Ca. 1 Promille der CPU-Zeit verbringt das
|
||||
System zusätzlich in der neuen Interrupt-Routine. Weiterhin führt ein
|
||||
"BRK"-Befehl zwar wie gewohnt in den MONITOR, allerdings mit falschem Registerdump,
|
||||
da der Monitor jetzt die Daten der Interrupt-Routine auf dem Stack vorfindet.
|
||||
|
||||
|
|
@ -268,25 +268,24 @@ Ein Diskettenlaufwerk ist sehr empfehlenswert.
|
|||
Sie macht folgendes:
|
||||
- Installation der Interrupt-Umleitungs-Routine
|
||||
- Umschalten auf RAM.
|
||||
erst spaeter wird C64init aufgerufen, dass aehnliche Prozesse wie beim C64 ausloest.
|
||||
erst später wird C64init aufgerufen, dass ähnliche Prozesse wie beim C64 auslöst.
|
||||
|
||||
* Emulator
|
||||
* volksForth 3.81 6502 für C=64, C16 und Plus4 wurde in folgenden Emulatoren
|
||||
* volksForth 3.81 6502 für C=64, C16 und Plus4 wurde in folgenden Emulatoren
|
||||
getestet:
|
||||
* VICE - http://www.viceteam.org/
|
||||
* Frodo - http://frodo.cebix.net/
|
||||
* YAPE/SDL - https://github.com/calmopyrin/yapesdl
|
||||
|
||||
* Website:
|
||||
VolksForth ist erhältlich von der SourceForge Entwicklerwebseite
|
||||
VolksForth ist erhältlich von der SourceForge Entwicklerwebseite
|
||||
http://volksForth.sf.net
|
||||
und von der Webseite der Forth Gesellschaft
|
||||
http://www.forth-ev.de
|
||||
|
||||
Die Forth Live-Linux CD-ROM (erhaeltlich im Downloadbereich der Forth
|
||||
Gesellschaft Webseite) enthaelt die aktuellen Versionen des volksFORTH direkt
|
||||
ausfuerbar auf der Linux CD-ROM, inkl. der volksFORTH Handbuecher.
|
||||
Die Forth Live-Linux CD-ROM (erhältlich im Downloadbereich der Webseite der
|
||||
Forth Gesellschaft) enthält die aktuellen Versionen des volksFORTH, direkt
|
||||
ausfürbar auf der Linux CD-ROM, inkl. der volksFORTH Handbücher.
|
||||
|
||||
Viel Spass mit volksFORTH
|
||||
wuenscht das volksFORTH Team
|
||||
|
||||
|
||||
wünscht das volksFORTH Team
|
||||
|
|
|
|||
183
6502/C64/src/6502asm.fth
Normal file
183
6502/C64/src/6502asm.fth
Normal file
|
|
@ -0,0 +1,183 @@
|
|||
\ *** Block No. 5, Hexblock 5
|
||||
|
||||
\ Forth-6502 Assembler clv10oct87
|
||||
|
||||
\ Basis: Forth Dimensions VOL III No. 5)
|
||||
|
||||
Onlyforth Assembler also definitions
|
||||
|
||||
|
||||
\ *** Block No. 6, Hexblock 6
|
||||
|
||||
\ Forth-83 6502-Assembler 20oct87re
|
||||
|
||||
: end-code context 2- @ context ! ;
|
||||
|
||||
Create index
|
||||
$0909 , $1505 , $0115 , $8011 ,
|
||||
$8009 , $1D0D , $8019 , $8080 ,
|
||||
$0080 , $1404 , $8014 , $8080 ,
|
||||
$8080 , $1C0C , $801C , $2C80 ,
|
||||
|
||||
| Variable mode
|
||||
|
||||
: Mode: ( n -) Create c,
|
||||
Does> ( -) c@ mode ! ;
|
||||
|
||||
0 Mode: .A 1 Mode: #
|
||||
2 | Mode: mem 3 Mode: ,X
|
||||
4 Mode: ,Y 5 Mode: X)
|
||||
6 Mode: )Y $F Mode: )
|
||||
|
||||
|
||||
\ *** Block No. 7, Hexblock 7
|
||||
|
||||
\ upmode cpu 20oct87re
|
||||
|
||||
| : upmode ( addr0 f0 - addr1 f1)
|
||||
IF mode @ 8 or mode ! THEN
|
||||
1 mode @ $F and ?dup IF
|
||||
0 DO dup + LOOP THEN
|
||||
over 1+ @ and 0= ;
|
||||
|
||||
: cpu ( 8b -) Create c,
|
||||
Does> ( -) c@ c, mem ;
|
||||
|
||||
00 cpu brk $18 cpu clc $D8 cpu cld
|
||||
$58 cpu cli $B8 cpu clv $CA cpu dex
|
||||
$88 cpu dey $E8 cpu inx $C8 cpu iny
|
||||
$EA cpu nop $48 cpu pha $08 cpu php
|
||||
$68 cpu pla $28 cpu plp $40 cpu rti
|
||||
$60 cpu rts $38 cpu sec $F8 cpu sed
|
||||
$78 cpu sei $AA cpu tax $A8 cpu tay
|
||||
$BA cpu tsx $8A cpu txa $9A cpu txs
|
||||
$98 cpu tya
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 8, Hexblock 8
|
||||
|
||||
\ m/cpu 20oct87re
|
||||
|
||||
: m/cpu ( mode opcode -) Create c, ,
|
||||
Does>
|
||||
dup 1+ @ $80 and IF $10 mode +! THEN
|
||||
over $FF00 and upmode upmode
|
||||
IF mem true Abort" invalid" THEN
|
||||
c@ mode @ index + c@ + c, mode @ 7 and
|
||||
IF mode @ $F and 7 <
|
||||
IF c, ELSE , THEN THEN mem ;
|
||||
|
||||
$1C6E $60 m/cpu adc $1C6E $20 m/cpu and
|
||||
$1C6E $C0 m/cpu cmp $1C6E $40 m/cpu eor
|
||||
$1C6E $A0 m/cpu lda $1C6E $00 m/cpu ora
|
||||
$1C6E $E0 m/cpu sbc $1C6C $80 m/cpu sta
|
||||
$0D0D $01 m/cpu asl $0C0C $C1 m/cpu dec
|
||||
$0C0C $E1 m/cpu inc $0D0D $41 m/cpu lsr
|
||||
$0D0D $21 m/cpu rol $0D0D $61 m/cpu ror
|
||||
$0414 $81 m/cpu stx $0486 $E0 m/cpu cpx
|
||||
$0486 $C0 m/cpu cpy $1496 $A2 m/cpu ldx
|
||||
$0C8E $A0 m/cpu ldy $048C $80 m/cpu sty
|
||||
$0480 $14 m/cpu jsr $8480 $40 m/cpu jmp
|
||||
$0484 $20 m/cpu bit
|
||||
|
||||
|
||||
\ *** Block No. 9, Hexblock 9
|
||||
|
||||
\ Assembler conditionals 20oct87re
|
||||
|
||||
| : range? ( branch -- branch )
|
||||
dup abs $7F u> Abort" out of range " ;
|
||||
|
||||
: [[ ( BEGIN) here ;
|
||||
|
||||
: ?] ( UNTIL) c, here 1+ - range? c, ;
|
||||
|
||||
: ?[ ( IF) c, here 0 c, ;
|
||||
|
||||
: ?[[ ( WHILE) ?[ swap ;
|
||||
|
||||
: ]? ( THEN) here over c@ IF swap !
|
||||
ELSE over 1+ - range? swap c! THEN ;
|
||||
|
||||
: ][ ( ELSE) here 1+ 1 jmp
|
||||
swap here over 1+ - range? swap c! ;
|
||||
|
||||
: ]] ( AGAIN) jmp ;
|
||||
|
||||
: ]]? ( REPEAT) jmp ]? ;
|
||||
|
||||
|
||||
\ *** Block No. 10, Hexblock a
|
||||
|
||||
\ Assembler conditionals 20oct87re
|
||||
|
||||
$90 Constant CS $B0 Constant CC
|
||||
$D0 Constant 0= $F0 Constant 0<>
|
||||
$10 Constant 0< $30 Constant 0>=
|
||||
$50 Constant VS $70 Constant VC
|
||||
|
||||
: not $20 [ Forth ] xor ;
|
||||
|
||||
: beq 0<> ?] ; : bmi 0>= ?] ;
|
||||
: bne 0= ?] ; : bpl 0< ?] ;
|
||||
: bcc CS ?] ; : bvc VS ?] ;
|
||||
: bcs CC ?] ; : bvs VC ?] ;
|
||||
|
||||
|
||||
\ *** Block No. 11, Hexblock b
|
||||
|
||||
\ 2inc/2dec winc/wdec 20oct87re
|
||||
|
||||
: 2inc ( adr -- )
|
||||
dup lda clc 2 # adc
|
||||
dup sta CS ?[ swap 1+ inc ]? ;
|
||||
|
||||
: 2dec ( adr -- )
|
||||
dup lda sec 2 # sbc
|
||||
dup sta CC ?[ swap 1+ dec ]? ;
|
||||
|
||||
: winc ( adr -- )
|
||||
dup inc 0= ?[ swap 1+ inc ]? ;
|
||||
|
||||
: wdec ( adr -- )
|
||||
dup lda 0= ?[ over 1+ dec ]? dec ;
|
||||
|
||||
: ;c:
|
||||
recover jsr end-code ] 0 last ! 0 ;
|
||||
|
||||
|
||||
\ *** Block No. 12, Hexblock c
|
||||
|
||||
\ ;code Code code> bp/re03feb85
|
||||
|
||||
Onlyforth
|
||||
|
||||
: Assembler
|
||||
Assembler [ Assembler ] mem ;
|
||||
|
||||
: ;Code
|
||||
[compile] Does> -3 allot
|
||||
[compile] ; -2 allot Assembler ;
|
||||
immediate
|
||||
|
||||
: Code Create here dup 2- ! Assembler ;
|
||||
|
||||
: >label ( adr -)
|
||||
here | Create immediate swap ,
|
||||
4 hallot heap 1 and hallot ( 6502-alig)
|
||||
here 4 - heap 4 cmove
|
||||
heap last @ count $1F and + ! dp !
|
||||
Does> ( - adr) @
|
||||
state @ IF [compile] Literal THEN ;
|
||||
|
||||
: Label
|
||||
[ Assembler ] here >label Assembler ;
|
||||
|
||||
\ TODO(pzembrod): enable once rom-ram-sys.fth works with include
|
||||
\ include rom-ram-sys.fth \ Makros: rom ram sys
|
||||
|
||||
Onlyforth
|
||||
51
6502/C64/src/rom-ram-sys.fth
Normal file
51
6502/C64/src/rom-ram-sys.fth
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
\ *** Block No. 2, Hexblock 2
|
||||
|
||||
\ rom ram sys cas16aug06
|
||||
\ Shadow with Ctrl+W--->
|
||||
|
||||
\ needed for jumps
|
||||
\ in the ROM Area
|
||||
|
||||
Assembler also definitions
|
||||
(16 \ Switch Bank 8000-FFFF
|
||||
: rom here 9 + $8000 u> abort" not here"
|
||||
$ff3e sta ;
|
||||
: ram $ff3f sta ;
|
||||
: sys rom jsr ram ;
|
||||
\ if suffering from abort" not here"
|
||||
\ see next screen Screen --> C)
|
||||
|
||||
|
||||
(64 \ Switch Bank A000-BFFF
|
||||
: rom here 9 + $A000 u> abort" not here"
|
||||
$37 # lda 1 sta ;
|
||||
: ram $36 # lda 1 sta ;
|
||||
C)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 3, Hexblock 3
|
||||
|
||||
\ sysMacro Long cas16aug06
|
||||
|
||||
(64 .( not for C64 !) \\ C)
|
||||
|
||||
\ for advanced users, use macros
|
||||
|
||||
here $8000 $20 - u> ?exit \ not possible
|
||||
|
||||
|
||||
' 0 | Alias ???
|
||||
|
||||
Label long ROM
|
||||
Label long1 ??? jsr RAM rts end-code
|
||||
|
||||
| : sysMacro ( adr -- )
|
||||
$100 u/mod pha # lda long1 2+ sta
|
||||
# lda long1 1+ sta pla long jsr ;
|
||||
|
||||
: sys ( adr -- ) \ for Jsr to ROM
|
||||
here 9 + $8000 u>
|
||||
IF sysMacro ELSE sys THEN ;
|
||||
214
6502/C64/src/tracer.fth
Normal file
214
6502/C64/src/tracer.fth
Normal file
|
|
@ -0,0 +1,214 @@
|
|||
\ *** Block No. 47, Hexblock 2f
|
||||
|
||||
\ tracer: loadscreen cas16aug06
|
||||
|
||||
Onlyforth
|
||||
|
||||
\needs Code include trns6502asm.fth
|
||||
|
||||
\needs Tools Vocabulary Tools
|
||||
|
||||
Tools also definitions
|
||||
|
||||
\ This nice Forth Tracer has been
|
||||
\ developed by B. Pennemann and co
|
||||
\ for Atari ST. CL Vogt has ported it
|
||||
\ back to the volksForth 6502 C-16 and
|
||||
\ C-64
|
||||
|
||||
|
||||
\ *** Block No. 48, Hexblock 30
|
||||
|
||||
\ tracer: wcmp variables clv04aug87
|
||||
|
||||
Assembler also definitions
|
||||
|
||||
: wcmp ( adr1 adr2--) \ Assembler-Macro
|
||||
over lda dup cmp swap \ compares word
|
||||
1+ lda 1+ sbc ;
|
||||
|
||||
|
||||
Only Forth also Tools also definitions
|
||||
|
||||
| Variable (W
|
||||
| Variable <ip | Variable ip>
|
||||
| Variable nest? | Variable trap?
|
||||
| Variable last' | Variable #spaces
|
||||
|
||||
|
||||
\ *** Block No. 49, Hexblock 31
|
||||
|
||||
\ tracer:cpush oneline cas16aug06
|
||||
|
||||
| Create cpull 0 ]
|
||||
rp@ count 2dup + rp! r> swap cmove ;
|
||||
|
||||
: cpush ( addr len -)
|
||||
r> -rot over >r
|
||||
rp@ over 1+ - dup rp! place
|
||||
cpull >r >r ;
|
||||
|
||||
| : oneline &82 allot keyboard display
|
||||
.status space query interpret
|
||||
-&82 allot rdrop
|
||||
( delete quit from tnext ) ;
|
||||
|
||||
: range ( adr--) \ gets <ip ip>
|
||||
ip> off dup <ip !
|
||||
BEGIN 1+ dup @
|
||||
[ Forth ] ['] unnest = UNTIL
|
||||
3+ ip> ! ;
|
||||
|
||||
|
||||
\ *** Block No. 50, Hexblock 32
|
||||
|
||||
\ tracer:step tnext clv04aug87
|
||||
|
||||
| Code step
|
||||
$ff # lda trap? sta trap? 1+ sta
|
||||
RP X) lda IP sta
|
||||
RP )Y lda IP 1+ sta RP 2inc
|
||||
(W lda W sta (W 1+ lda W 1+ sta
|
||||
Label W1- W 1- jmp end-code
|
||||
|
||||
| Create: nextstep step ;
|
||||
|
||||
Label tnext IP 2inc
|
||||
trap? lda W1- beq
|
||||
nest? lda 0= \ low(!)Byte test
|
||||
?[ IP <ip wcmp W1- bcc
|
||||
IP ip> wcmp W1- bcs
|
||||
][ nest? stx \ low(!)Byte clear
|
||||
]?
|
||||
trap? dup stx 1+ stx \ disable tracer
|
||||
W lda (W sta W 1+ lda (W 1+ sta
|
||||
|
||||
|
||||
\ *** Block No. 51, Hexblock 33
|
||||
|
||||
\ tracer:..tnext clv12oct87
|
||||
|
||||
;c: nest? @
|
||||
IF nest? off r> ip> push <ip push
|
||||
dup 2- range
|
||||
#spaces push 1 #spaces +! >r THEN
|
||||
r@ nextstep >r
|
||||
input push output push
|
||||
2- dup last' !
|
||||
cr #spaces @ spaces
|
||||
dup 4 u.r @ dup 5 u.r space
|
||||
>name .name $10 col - 0 max spaces .s
|
||||
state push blk push >in push
|
||||
[ ' 'quit >body ] Literal push
|
||||
[ ' >interpret >body ] Literal push
|
||||
#tib push tib #tib @ cpush r0 push
|
||||
rp@ r0 !
|
||||
['] oneline Is 'quit quit ;
|
||||
|
||||
|
||||
\ *** Block No. 52, Hexblock 34
|
||||
|
||||
\ tracer:do-trace traceable cas16aug06
|
||||
|
||||
| Code do-trace \ installs TNEXT
|
||||
tnext 0 $100 m/mod
|
||||
# lda Next $c + sta
|
||||
# lda Next $b + sta
|
||||
$4C # lda Next $a + sta Next jmp
|
||||
end-code
|
||||
|
||||
| : traceable ( cfa--<IP ) recursive
|
||||
dup @
|
||||
['] : @ case? IF >body exit THEN
|
||||
['] key @ case? IF >body c@ Input @ +
|
||||
@ traceable exit THEN
|
||||
['] type @ case? IF >body c@ Output @ +
|
||||
@ traceable exit THEN
|
||||
['] r/w @ case? IF >body
|
||||
@ traceable exit THEN
|
||||
@ [ ' Forth @ @ ] Literal =
|
||||
IF @ 3 + exit THEN
|
||||
\ for defining words with DOES>
|
||||
>name .name ." can't be DEBUGged"
|
||||
quit ;
|
||||
|
||||
|
||||
\ *** Block No. 53, Hexblock 35
|
||||
|
||||
\ tracer:User-Words cas16aug06
|
||||
|
||||
: nest \ trace into current word
|
||||
last' @ @ traceable drop nest? on ;
|
||||
|
||||
: unnest \ proceeds at calling word
|
||||
<ip on ip> off ; \ clears trap range
|
||||
|
||||
: endloop last' @ 4 + <ip ! ;
|
||||
\ no trace of next word to skip LOOP..
|
||||
|
||||
' end-trace Alias unbug \ cont. execut.
|
||||
|
||||
: (debug ( cfa-- )
|
||||
traceable range
|
||||
nest? off trap? on #spaces off
|
||||
Tools do-trace ;
|
||||
|
||||
Forth definitions
|
||||
|
||||
: debug ' (debug ; \ word follows
|
||||
|
||||
: trace' \ word follows
|
||||
' dup (debug execute end-trace ;
|
||||
|
||||
|
||||
\ *** Block No. 54, Hexblock 36
|
||||
|
||||
\ tools for decompiling, clv12oct87
|
||||
|
||||
( interactive use )
|
||||
|
||||
Onlyforth Tools also definitions
|
||||
|
||||
| : ?: ?cr dup 4 u.r ." :" ;
|
||||
| : @? dup @ 6 u.r ;
|
||||
| : c? dup c@ 3 .r ;
|
||||
| : bl $24 col - 0 max spaces ;
|
||||
|
||||
: s ( adr - adr+)
|
||||
( print literal string)
|
||||
?: space c? 4 spaces dup count type
|
||||
dup c@ + 1+ bl ; ( count + re)
|
||||
|
||||
: n ( adr - adr+2)
|
||||
( print name of next word by its cfa)
|
||||
?: @? 2 spaces
|
||||
dup @ >name .name 2+ bl ;
|
||||
|
||||
: k ( adr - adr+2)
|
||||
( print literal value)
|
||||
?: @? 2+ bl ;
|
||||
|
||||
|
||||
\ *** Block No. 55, Hexblock 37
|
||||
|
||||
( tools for decompiling, interactive )
|
||||
|
||||
: d ( adr n - adr+n) ( dump n bytes)
|
||||
2dup swap ?: 3 spaces swap 0
|
||||
DO c? 1+ LOOP
|
||||
4 spaces -rot type bl ;
|
||||
|
||||
: c ( adr - adr+1)
|
||||
( print byte as unsigned value)
|
||||
1 d ;
|
||||
|
||||
: b ( adr - adr+2)
|
||||
( print branch target location )
|
||||
?: @? dup @ over + 6 u.r 2+ bl ;
|
||||
|
||||
( used for : )
|
||||
( Name String Literal Dump Clit Branch )
|
||||
( - - - - - - )
|
||||
|
||||
|
||||
Onlyforth
|
||||
15
6502/C64/src/trns6502asm.fth
Normal file
15
6502/C64/src/trns6502asm.fth
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
\ *** Block No. 4, Hexblock 4
|
||||
|
||||
\ transient Assembler clv10oct87
|
||||
|
||||
\ Basis: Forth Dimensions VOL III No. 5)
|
||||
|
||||
\ internal loading 04may85BP/re)
|
||||
|
||||
here $800 hallot heap dp !
|
||||
|
||||
include 6502asm.fth
|
||||
|
||||
dp !
|
||||
|
||||
Onlyforth
|
||||
|
|
@ -87,146 +87,107 @@
|
|||
* =blk/drv ( -- #blk )= "blocks-per-drive" - =#blk= gibt die
|
||||
Kapazität des aktuellen Laufwerks (bestimmt durch =OFFSET=) in
|
||||
Forth-Blöcken (1kB) an. Siehe =(BLK/DRV=.
|
||||
|
||||
con! ( 8b -- ) "con-store"
|
||||
Gibt 8b auf die CONsole (Bildschirm) aus. Ascii-Werte < $20 werden
|
||||
als Steuercodes interpretiert.
|
||||
|
||||
curleft ( -- ) "cur-left"
|
||||
Bewegt den Cursor ein Zeichen nach links. Eine der vordefinierten
|
||||
Terminalfunktionen.
|
||||
|
||||
curoff ( -- ) "cur-off"
|
||||
Schaltet den Cursor aus. Eine der vordefinierten Terminalfunktionen.
|
||||
|
||||
curon ( -- ) "cur-on"
|
||||
Schaltet den Cursor an. Eine der vordefinierten Terminalfunktionen.
|
||||
|
||||
currite ( -- ) "cur-right"
|
||||
Bewegt den Cursor ein Zeichen nach rechts. Eine der vordefinierten
|
||||
Terminalfunktionen.
|
||||
|
||||
dark ( -- ) "dark"
|
||||
Löscht den Bildschirm. Eine der vordefinierten Terminalfunktionen.
|
||||
|
||||
display ( -- ) "display"
|
||||
Ein mit OUTPUT: definiertes Wort, das den Bildschirm als Ausgabe
|
||||
gerät anwählt, wenn es ausgeführt wird. Die Worte EMIT, CR, TYPE,
|
||||
DEL, PAGE, AT, und AT? beziehen sich dann auf das aktuelle Terminal.
|
||||
Siehe TERMINAL:.
|
||||
|
||||
dma! ( addr -- ) "d-m-a-store"
|
||||
addr ist die Adresse des Diskettenpuffers, der beim nächsten Dis
|
||||
kettenzugriff verwendet werden soll.
|
||||
|
||||
drive ( n -- ) "drive"
|
||||
Wählt n als aktuelles Laufwerk an. [ndert OFFSET entsprechend.
|
||||
Siehe BLK/DRV.
|
||||
|
||||
drv! ( drv f -- dph ) "drive-store"
|
||||
drv ist die Nummer des Diskettenlaufwerks, das als nächstes ver
|
||||
wendet werden soll. f=0 gibt an, ob es sich um den erste Zugriff
|
||||
nach einem CP/M Warmstart handelt. dph ist die Adresse des CP/M
|
||||
Disk-Parameter-Headders. (Siehe CP/M Operating System Manual)
|
||||
Ist dph=0, so ist das angesprochene Laufwerk in diesem Kom puter
|
||||
system nicht unterstützt.
|
||||
|
||||
drv? ( blk -- drv ) "drive-question"
|
||||
blk gibt die absolute Nummer eines FORTH-Blocks an, DRV? berechnet
|
||||
daraus das Laufwerk (drv) auf dem er zu finden ist.
|
||||
Siehe /DRIVE, >DRIVE.
|
||||
|
||||
drv0 ( -- ) "drive-zero"
|
||||
Wählt Laufwerk 0 (A) als aktuelles Laufwerk für R/W an. Siehe DRIVE
|
||||
und >DRIVE.
|
||||
|
||||
drv1 ( -- ) "drive-one"
|
||||
Wählt Laufwerk 1 (B) als aktuelles Laufwerk für R/W an. Siehe DRIVE
|
||||
und >DRIVE.
|
||||
|
||||
drvinit ( -- ) "drive-init"
|
||||
Initialisiert das volksFORTH-Disk-System.
|
||||
Die im Komputer-System vorhandenen Laufwerke werden der Reihe nach
|
||||
selektiert und deren Kapazität berechnet. Dann wird das CP/M
|
||||
default-Laufwerk selektiert.
|
||||
dumb ( -- ) "dumb"
|
||||
Ein mit TERMINAL: definiertes Wort, das ein ignorantes Terminal
|
||||
anwählt, wenn es ausgeführt wird. CURON, CUROFF, CURLEFT, CURRITE,
|
||||
RVSON, RVSOFF, DARK und LOCATE haben dann keine Wirkung. Mit ihnen
|
||||
auch die sie benutzenden Worte (PAGE, (AT, (DEL. Wenn DISPLAY
|
||||
eingeschaltet ist, sind also auch PAGE, AT und DEL wirkungslos.
|
||||
DUMB ist als aktuelles Terminal angewählt, bis die Installierung
|
||||
eines leistungsfähigeren Terminals abgeschlossen ist.
|
||||
|
||||
getkey ( -- char ) "getkey"
|
||||
die unteren 7 Bit von char enthalten den Ascii-Code des letzten
|
||||
Tastendrucks. Ist noch keine Taste gedrückt, dann wartet getkey.
|
||||
Siehe auch KEY? und KEY.
|
||||
|
||||
home ( -- ) "home"
|
||||
Der Kopf des momentan selektierte Diskettenlaufwerks wird auf Spur
|
||||
null gefahren. Spur null wird als nächste Spur angewählt, die
|
||||
verwendet werden soll. Siehe TRK!, DRV!.
|
||||
|
||||
index ( from to -- ) "index"
|
||||
Liest die Blocks from bis to einschlie~lich und gibt deren erste
|
||||
Zeilen aus. Index kann mit einer beliebigen Taste angehalten werden
|
||||
und mit RETURN abgebrochen werden. (Siehe STOP?) Die ersten Zeilen
|
||||
von Screens enthalten typischer Weise Kommentare, die den Inhalt
|
||||
chararkterisieren.
|
||||
|
||||
keyboard ( -- ) "keyboard"
|
||||
Ein mit INPUT: definiertes Wort, das die Tastatur als Eingabegerät
|
||||
anwählt. Die Worte KEY, KEY?, DECODE und EXPECT beziehen sich nun
|
||||
auf die Tastatur. Siehe (KEY, (KEY? (DECODE, (EXPECT.
|
||||
|
||||
locate ( row col -- ) "locate"
|
||||
Bewegt den Cursor absolut auf Spalte col, Zeile row.
|
||||
Eine der vordefinierten Terminalfunktionen.
|
||||
|
||||
|
||||
out ( -- addr ) "out"
|
||||
Adresse einer Variablen, die die Anzahl der ausgegebenen Zeichen
|
||||
enthält.
|
||||
|
||||
read/write ( r/wf sponti -- f ) "read-write"
|
||||
Bewirkt das physikalische Lesen (r/wf = FALSE) und Schreiben
|
||||
(r/wf=TRUE) eines Sektors (=128 Bytes) von der/auf die Diskette. Das
|
||||
Laufwerk, die Spur , der Sektor sowie der Sektor-Puffer sind vorher
|
||||
mit DRV!, TRK!, SEC! und DMA! gewählt worden.
|
||||
sponti gibt an, ob beim Schreiben unmittelbar auf die Diskette
|
||||
geschrieben werden soll (sponti=TRUE) oder, ob der geschriebene
|
||||
Sektor im BIOS zwischengepuffert werden darf (sponti=FALSE).
|
||||
|
||||
rvsoff ( -- ) "reverse-off"
|
||||
Schaltet die Inversdarstellung aus. Eine der vordefinierten
|
||||
Terminalfunktionen.
|
||||
|
||||
rvson ( -- ) "reverse-on"
|
||||
Schaltet die Inversedarstellung ein. Eine der vordefinierten
|
||||
Terminalfunktionen.
|
||||
|
||||
sec! ( sec -- ) "sec-store"
|
||||
sec ist der beim nächsten Diskettenzugriff zu verwendende Sektor.
|
||||
.PA
|
||||
Term: ( offset -- offset' ) "term-colon"
|
||||
Ein definierendes Wort für Terminalfunktionen. Wird benutzt um die
|
||||
einzelnen Komponenten eines Terminal-Vektors zu definieren.
|
||||
Vordefinierte Terminalfunktionen sind CURON, CUROFF, CURLEFT,
|
||||
CURRITE, RVSON, RVSOFF, DARK und LOCATE. Siehe auch TERMINAL:
|
||||
|
||||
Terminal: ( -- ) "terminal-colon"
|
||||
Ein definierendes Wort für Terminals. Benutzt in der Form:
|
||||
* =con! ( 8b -- )= "con-store" - Gibt =8b= auf die CONsole
|
||||
(Bildschirm) aus. Ascii-Werte < $20 werden als Steuercodes
|
||||
interpretiert.
|
||||
* =curleft ( -- )= "cur-left" - Bewegt den Cursor ein Zeichen nach
|
||||
links. Eine der vordefinierten Terminalfunktionen.
|
||||
* =curoff ( -- )= "cur-off" - Schaltet den Cursor aus. Eine der
|
||||
vordefinierten Terminalfunktionen.
|
||||
* =curon ( -- )= "cur-on" - Schaltet den Cursor an. Eine der
|
||||
vordefinierten Terminalfunktionen.
|
||||
* =currite ( -- )= "cur-right" - Bewegt den Cursor ein Zeichen nach
|
||||
rechts. Eine der vordefinierten Terminalfunktionen.
|
||||
* =dark ( -- )= - "dark" - Löscht den Bildschirm. Eine der
|
||||
vordefinierten Terminalfunktionen.
|
||||
* =display ( -- )= "display" - Ein mit =OUTPUT:= definiertes Wort,
|
||||
das den Bildschirm als Ausgabegerät anwählt, wenn es ausgeführt
|
||||
wird. Die Worte =EMIT=, =CR=, =TYPE=, =DEL=, =PAGE=, =AT=, und
|
||||
=AT?= beziehen sich dann auf das aktuelle Terminal. Siehe
|
||||
TERMINAL:.
|
||||
* =dma! ( addr -- )= "d-m-a-store" - =addr= ist die Adresse des
|
||||
Diskettenpuffers, der beim nächsten Diskettenzugriff verwendet
|
||||
werden soll.
|
||||
* =drive ( n -- )= "drive" - Wählt =n= als aktuelles Laufwerk an.
|
||||
Ändert =OFFSET= entsprechend. Siehe =BLK/DRV=.
|
||||
* =drv! ( drv f -- dph )= "drive-store" - =drv= ist die Nummer des
|
||||
Diskettenlaufwerks, das als nächstes verwendet werden soll. f=0
|
||||
gibt an, ob es sich um den erste Zugriff nach einem CP/M Warmstart
|
||||
handelt. =dph= ist die Adresse des CP/M Disk-Parameter-Headders.
|
||||
(Siehe CP/M Operating System Manual) Ist =dph= = 0, so ist das
|
||||
angesprochene Laufwerk in diesem Computersystem nicht unterstützt.
|
||||
* =drv? ( blk -- drv )= "drive-question" - =blk= gibt die absolute
|
||||
Nummer eines FORTH-Blocks an, =DRV?= berechnet daraus das Laufwerk
|
||||
(=drv=) auf dem er zu finden ist. Siehe =/DRIVE=, =>DRIVE=.
|
||||
* =drv0 ( -- )= "drive-zero" - Wählt Laufwerk 0 (A) als aktuelles
|
||||
Laufwerk für =R/W= an. Siehe =DRIVE= und =>DRIVE=.
|
||||
* =drv1 ( -- )= "drive-one" - Wählt Laufwerk 1 (B) als aktuelles
|
||||
Laufwerk für =R/W= an. Siehe =DRIVE= und =>DRIVE=.
|
||||
* =drvinit ( -- )= "drive-init" - Initialisiert das
|
||||
volksFORTH-Disk-System. Die im Komputer-System vorhandenen
|
||||
Laufwerke werden der Reihe nach selektiert und deren Kapazität
|
||||
berechnet. Dann wird das CP/M Default-Laufwerk selektiert.
|
||||
* =dumb ( -- )= "dumb" - Ein mit =TERMINAL:= definiertes Wort, das
|
||||
ein ignorantes Terminal anwählt, wenn es ausgeführt wird. =CURON=,
|
||||
=CUROFF=, =CURLEFT=, =CURRITE=, =RVSON=, =RVSOFF=, =DARK= und
|
||||
=LOCATE= haben dann keine Wirkung. Mit ihnen auch die sie
|
||||
benutzenden Worte =(PAGE=, =(AT=, =(DEL=. Wenn =DISPLAY=
|
||||
eingeschaltet ist, sind also auch =PAGE=, =AT= und =DEL=
|
||||
wirkungslos. DUMB ist als aktuelles Terminal angewählt, bis die
|
||||
Installierung eines leistungsfähigeren Terminals abgeschlossen ist.
|
||||
* =getkey ( -- char )= "getkey" - die unteren 7 Bit von =char=
|
||||
enthalten den ASCII-Code des letzten Tastendrucks. Ist noch keine
|
||||
Taste gedrückt, dann wartet =getkey=. Siehe auch =KEY?= und =KEY=.
|
||||
* =home ( -- )= "home" - Der Kopf des momentan selektierte
|
||||
Diskettenlaufwerks wird auf Spur null gefahren. Spur null wird als
|
||||
nächste Spur angewählt, die verwendet werden soll. Siehe =TRK!=,
|
||||
=DRV!=.
|
||||
* =index ( from to -- )= "index" - Liest die Blocks from bis to
|
||||
einschlielich und gibt deren erste Zeilen aus. Index kann mit einer
|
||||
beliebigen Taste angehalten werden und mit =RETURN= abgebrochen
|
||||
werden. (Siehe =STOP?=) Die ersten Zeilen von Screens enthalten
|
||||
typischer Weise Kommentare, die den Inhalt chararkterisieren.
|
||||
* =keyboard ( -- )= "keyboard" - Ein mit INPUT: definiertes Wort, das
|
||||
die Tastatur als Eingabegerät anwählt. Die Worte =KEY=, =KEY?=, =DECODE=
|
||||
und =EXPECT= beziehen sich nun auf die Tastatur. Siehe =(KEY=, =(KEY?=
|
||||
=(DECODE=, =(EXPECT=.
|
||||
* =locate ( row col -- )= "locate" - Bewegt den Cursor absolut auf
|
||||
Spalte col, Zeile row. Eine der vordefinierten Terminalfunktionen.
|
||||
* =out ( -- addr )= "out" - Adresse einer Variablen, die die Anzahl
|
||||
der ausgegebenen Zeichen enthält.
|
||||
* =read/write ( r/wf sponti -- f )= "read-write" - Bewirkt das
|
||||
physikalische Lesen (r/wf = FALSE) und Schreiben (r/wf=TRUE) eines
|
||||
Sektors (=128 Bytes) von der/auf die Diskette. Das Laufwerk, die
|
||||
Spur, der Sektor sowie der Sektor-Puffer sind vorher mit =DRV!=,
|
||||
=TRK!=, =SEC!= und =DMA!= gewählt worden. =sponti= gibt an, ob beim
|
||||
Schreiben unmittelbar auf die Diskette geschrieben werden soll
|
||||
(sponti=TRUE) oder, ob der geschriebene Sektor im BIOS
|
||||
zwischengepuffert werden darf (sponti=FALSE).
|
||||
* =rvsoff ( -- )= "reverse-off" - Schaltet die Inversdarstellung aus.
|
||||
Eine der vordefinierten Terminalfunktionen.
|
||||
* =rvson ( -- )= "reverse-on" - Schaltet die Inversedarstellung ein.
|
||||
Eine der vordefinierten Terminalfunktionen.
|
||||
* =sec! ( sec -- )= "sec-store" - sec ist der beim nächsten
|
||||
Diskettenzugriff zu verwendende Sektor.
|
||||
* =Term: ( offset -- offset' )= "term-colon" - Ein definierendes Wort
|
||||
für Terminalfunktionen. Wird benutzt um die einzelnen Komponenten
|
||||
eines Terminal-Vektors zu definieren. Vordefinierte
|
||||
Terminalfunktionen sind =CURON=, =CUROFF=, =CURLEFT=, =CURRITE=, =RVSON=,
|
||||
=RVSOFF=, =DARK= und =LOCATE=. Siehe auch =TERMINAL:=
|
||||
* =Terminal: ( -- )= "terminal-colon" - Ein definierendes Wort für
|
||||
Terminals. Benutzt in der Form:
|
||||
#+begin_example
|
||||
Terminal: <name>
|
||||
newCURON newCUROFF newCURLEFT newCURRITE
|
||||
newRVSON newRVSOFF newDARK newLOACTE ;
|
||||
TERMINAL: erzeugt einen Kopf für <name> im Dictionary und kompiliert
|
||||
einen Vektor von Zeigern auf Worte die für die Ausführung von Ter
|
||||
minalfunktionen zuständig sind. Wird <name> ausgeführt, so werden
|
||||
die Terminalfunktionen von <name> zu den aktuellen Terminal
|
||||
funktionen gemacht, das Terminal <name> ist damit aktiv. Terminal
|
||||
funktionen werden von AT, PAGE, DEL ausgeführt, wenn die Ausgabe auf
|
||||
DISPLAY geschal tet ist. Siehe OUTPUT:, DISPLAY, DUMB.
|
||||
|
||||
trk! ( trk -- ) "track-store"
|
||||
trk ist die beim nächsten Diskettenzugriff zu verwendende Spur.
|
||||
#+end_example
|
||||
=TERMINAL:= erzeugt einen Kopf für <name> im Dictionary und
|
||||
kompiliert einen Vektor von Zeigern auf Worte die für die
|
||||
Ausführung von Terminalfunktionen zuständig sind. Wird <name>
|
||||
ausgeführt, so werden die Terminalfunktionen von <name> zu den
|
||||
aktuellen Terminal funktionen gemacht, das Terminal <name> ist
|
||||
damit aktiv. Terminal funktionen werden von =AT=, =PAGE=, =DEL=
|
||||
ausgeführt, wenn die Ausgabe auf =DISPLAY= geschaltet ist. Siehe
|
||||
=OUTPUT:=, =DISPLAY=, =DUMB=.
|
||||
* =trk! ( trk -- )= "track-store" - =trk= ist die beim nächsten
|
||||
Diskettenzugriff zu verwendende Spur.
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
README.TXT zu museum/ultra4th für Commodore C16, C64, Plus4 clv2000
|
||||
README.TXT zu museum/ultra4th für Commodore C16, C64, Plus4 clv2000
|
||||
|
||||
Claus.Vogt@Berlin.de --- http://www.home.pages.de/~clv
|
||||
|
||||
|
|
@ -149,7 +149,7 @@ UF_TO_PC\LIST-CBM.BAT 45 28.06.89 16:19 LIST-CBM.BAT
|
|||
ergibt etwa sieben Druckseiten, wenn alles funktioniert.
|
||||
|
||||
(Soeben gestet mit einem Pentium-III-500 mit HP Laserjet 5MP:
|
||||
Das Layout ist ziemlich murksig, aber man die Screens deutlich lesen.)
|
||||
Das Layout ist ziemlich murksig, aber man kann die Screens deutlich lesen.)
|
||||
|
||||
|
||||
UF_TO_PC\EPSONCBM.PRN 12.288 28.06.89 15:44 EPSONCBM.PRN
|
||||
|
|
@ -161,7 +161,7 @@ UF_TO_PC\CBM_ST.SCR
|
|||
|
||||
Benutzung von Commodore-Screens mit Atari clv05jan90
|
||||
Das Commodore-Screen-Format von 25 Zeilen a 41 Buchstaben
|
||||
kann so unter Atari ST, volksFORTH 3.80 verwendet werden.
|
||||
kann so unter Atari ST, volksFORTH 3.80 verwendet werden.
|
||||
|
||||
UF_TO_PC\FG0190.ART
|
||||
|
||||
|
|
@ -189,7 +189,7 @@ CLV\DSK-GRF.487 Image für C16/C64. Unvollendet, ca. 1987
|
|||
|
||||
Tests für die Basis eines Grafikpakets für ultraForth C16.
|
||||
Das Bankswitching, das etwas anders als auf dem C64
|
||||
organisiert war, machte da Žrger.
|
||||
organisiert war, machte da Ärger.
|
||||
|
||||
|
||||
CLV\EDIT. Image für C16/C64. Unvollendet, ca. 1987
|
||||
|
|
@ -199,7 +199,7 @@ CLV\EDIT. Image für C16/C64. Unvollendet, ca. 1987
|
|||
er auch, war aber unerträglich langsam und
|
||||
der Cursor war meistens weg ...
|
||||
|
||||
Dann begann auch bei mir zuhause die PC-Žra ...
|
||||
Dann begann auch bei mir zuhause die PC-Ära ...
|
||||
|
||||
|
||||
CLV\EH-TERM.387 Image für C16/C64
|
||||
|
|
@ -230,7 +230,7 @@ CLV\MENUE. Image. Test für ein Menüsystem ultraForth 3.8. Unvollendet
|
|||
|
||||
UltraForth83 war sicher das beste Forth-System für den C64.
|
||||
Für den C16/Plus4 war es die einzige enstzunehmende Programmiersprache
|
||||
überhaupt. Sonst existierten dort Basic und Assembler.
|
||||
Überhaupt. Sonst existierten dort Basic und Assembler.
|
||||
|
||||
UltraForth83 ist eine komplette Programmierumgebung
|
||||
Es enthält einen Full-Screen-Editor, einen quelltextnahe Debugger,
|
||||
|
|
@ -281,12 +281,12 @@ CLV\MENUE. Image. Test für ein Menüsystem ultraForth 3.8. Unvollendet
|
|||
Der Plattenzugriff in Blöcken ist leichter zu implementieren.
|
||||
Auf Commodore bot er zusätzlich extreme Geschwindigkeitsvorteile.
|
||||
|
||||
Das Schreiben in Block-Manier führte positiv zu kurzen Quelltext-Abschnitten und übersichtlicher Organisation der
|
||||
Das Schreiben in Block-Manier führte positiv zu kurzen Quelltext-Abschnitten und Übersichtlicher Organisation der
|
||||
Quellen. Zum Problem wurde es, wenn man doch noch ein paar Zeilen einfügen wollte.
|
||||
Um einen Block einzuschieben, mußte man alle anderen Blöcke um eins verschieben.
|
||||
Dies geschah z.B. mit '10 50 11 CONVEY'. Ein Tippfehler und die Quellen waren weg.
|
||||
Die Erinnerung an Convey dürfte alte Forthler immer noch erbleichen lassen.
|
||||
Damit wurden wohl mehr Quellen vernichtet, als mit dem damaligen Dos-DISKCOPY.
|
||||
Letzteres erforderte ungefähr 6 Diskettenwechsel. Jede Verwechslung
|
||||
der Disketten führte zwangsläufig zu Datenverlust.
|
||||
der Disketten führte zwangsläufig zu Datenverlust.
|
||||
'Legen Sie die Quelle ins Ziel' war eine gängige Verballhornung der Diskcopy-Meldungen.
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
* Prolog
|
||||
|
||||
volksFORTH ist eine Sprache, die in verschiedener Hinsicht
|
||||
ungewöhnlich ist. Denn FORTH selbst ist nicht nur eine Sprache,sondern
|
||||
ungewöhnlich ist. Denn FORTH selbst ist nicht nur eine Sprache, sondern
|
||||
ein im Prinzip grenzenloses Programmiersystem. Eines der Hauptmerkmale
|
||||
des Programmiersystems FORTH ist seine Modularität. Diese Modularität
|
||||
wird durch die kleinste Einheit eines FORTH-Systems, das WORT,
|
||||
|
|
@ -25,7 +25,7 @@ auf dem jeweiligen FORTH-System lauffähig sind. Ungewö̈hnlich ist, dass
|
|||
der Programmtext des Kerns selbst ein FORTH—Programm ist, im Gegensatz
|
||||
zu anderen Programmiersprachen, denen ein Maschinensprach-Programm
|
||||
zugrunde liegt. Aus diesem Kern wird durch ein besonderes
|
||||
FORTH-Programm, den MetaCompi1er, das lauffähige Forth-System (unter
|
||||
FORTH-Programm, dem MetaCompi1er, das lauffähige Forth-System (unter
|
||||
MS-DOS z.B. =KERNEL.COM=) erzeugt:
|
||||
|
||||
Wie fügt man nun diesem lauffähigen Kern eigene Worte hinzu? Das
|
||||
|
|
@ -52,7 +52,7 @@ FORTH-Prozeduren ist also das Leerzeichen, womit auch schon die Syntax
|
|||
der Sprache FORTH beschrieben wäre.
|
||||
|
||||
Der Compiler eines FORTH-Systems ist also Teil der
|
||||
Interpreteroberfläche. Es gibt daher keinen Compiler-Lauf zur
|
||||
Interpreteroberfläche. Es gibt daher keinen Compiler-Lauf zum
|
||||
Erstellen des Programmtextes wie in anderen Compiler-Sprachen,
|
||||
sondern der Interpreter wird mit allen zur Problemlösung notwendigen
|
||||
Worten als Anwenderprogramm abgespeichert.
|
||||
|
|
@ -81,7 +81,7 @@ Keine Nachrichten sind immer gute Nachrichten !
|
|||
|
||||
Und — ungewöhnlicherweise - benutzt FORTH die sogenannte
|
||||
Postfix-Notation (UPN) vergleichbar den HP-Taschenrechnern, die in
|
||||
machen Kreisen sehr beliebt sind. Das bedeutet, FORTH erwartet immer
|
||||
manchen Kreisen sehr beliebt sind. Das bedeutet, FORTH erwartet immer
|
||||
erst die Argumente, dann die Aktion. Statt
|
||||
|
||||
3 + 2 und (5 + 5) * 10
|
||||
|
|
@ -108,7 +108,7 @@ über den Stack übergeben.
|
|||
|
||||
** Assembler
|
||||
|
||||
Innerhalb einer PORTH-Umgebung kann man sofort in der Maschinensprache
|
||||
Innerhalb einer FORTH-Umgebung kann man sofort in der Maschinensprache
|
||||
des Prozessors programmieren, ohne den Interpreter verlassen zu
|
||||
müssen. Assembier-Definitionen sind den FORTH-Programmen gleichwertige
|
||||
FORTH-Worte.
|
||||
|
|
@ -141,7 +141,7 @@ in FORTH. Allerdings können mit dem VolksForth auch Dateien bearbeitet
|
|||
werden, die im Dateiformat des Systems vorliegen, sog. "Stream-Files".
|
||||
|
||||
Generell steht hinter jeder Sprache ein bestimmtes Konzept, und nur
|
||||
mit Kenntnis dieses Konzeptes ist möglich, eine Sprache effizient
|
||||
mit Kenntnis dieses Konzeptes ist es möglich, eine Sprache effizient
|
||||
einzusetzen. Das Sprachkonzept von FORTH wird beschrieben in dem Buch
|
||||
"In FORTH denken" von Leo Brodie (["Thinking
|
||||
Forth"][http://thinking-forth.sourceforge.net]). Einen ersten Eindruck
|
||||
|
|
@ -234,7 +234,7 @@ Damit Sie sofort beginnen können, wird in diesem Kapitel beschrieben,
|
|||
|
||||
| Datei | Beschreibung |
|
||||
|--------------+--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------|
|
||||
| volks4th.com | als Ihr komplettes Arbeitsssystem enthält resident das Fileinterface, den Editor, den Assembler und von Ihnen eingefügte Werkzeuge (tools). |
|
||||
| volks4th.com | als Ihr komplettes Arbeitssystem enthält resident das Fileinterface, den Editor, den Assembler und von Ihnen eingefügte Werkzeuge (tools). |
|
||||
| minimal.com | ist eine Grundversion, die oft benötigte Systemteile enthält. Diese ist notwendig, da FORTH—Systeme allgemein nicht über einen Linker verfügen, sondern ausgehend vom Systemkern die zur Problemlösung notwendigen Einzelprogramme schrittweise hinzukompiliert werden. |
|
||||
| kernel.com | ist eine Grundversion, die nur den Sprachkern enthält. Damit können Sie eigene FORTH-Versionen mit z.B. einem veränderten Editor zusammenstellen und dann mit =SAVESYSTEM <name>= als fertiges System abspeichern. In der gleichen Art können Sie auch fertige Anwendungen herstellen, denen man ihre FORTH-Abstammung nicht mehr ansieht. |
|
||||
| kernel.fb | enthält die Quelltexte des Sprachkerns. Eben dieser Quelltext ist mit einem Target-Compiler kompiliert worden und entspricht exakt dem =KERNEL.COM=. Sie können sich also den Compiler ansehen, wenn Sie wissen wollen, wie das volksFORTH funktioniert. |
|
||||
|
|
@ -256,7 +256,7 @@ FORTH-Systeme und damit auch volksFORTH sind fast immer interaktive
|
|||
Systeme, in denen Sie einen gerade entwickelten Gedankengang sofort
|
||||
überprüfen und verwirklichen können. Das Auffälligste an der
|
||||
volksFORTH-Oberfläche ist die inverse Statuszeile in der unteren
|
||||
Bildschirmzeile, die sich mit =status off= — und mit =status on= aus
|
||||
Bildschirmzeile, die sich mit =status off= aus— und mit =status on=
|
||||
wieder einschalten lässt.
|
||||
|
||||
Diese Statuszeile zeigt von links nach rechts folgende Informationen,
|
||||
|
|
@ -269,7 +269,7 @@ wobei =/= für "oder" steht
|
|||
| =Dic <xxxx>= | nennt den freien Hauptspeicher |
|
||||
| =Scr <xx>= | ist die Nummer des aktuellen Blocks (einer Block-Datei) |
|
||||
| =<name>.<ext>= | zeigt den Namen der Datei, die gerade bearbeitet wird. Dateien haben im MSDOS sowohl einen Namen <name> als auch eine dreibuchstabige Kennung, die Extension <ext>, wobei auch Dateien ohne Extension angelegt werden können. |
|
||||
| =FORTH FORTH FORTH= | zeigt die aktuelle Suchreihenfolge gemäß dem Vokabularkonzept. Ein Beispiel dafür sind die Assembler-Befehle: Diese befinden sich in ASSEMBLER und assembler words zeigtIhnen den Befehlsvorrat des Assemblers an. Achten Sie bitte auf die rechte Seite der Statuszeiie, wo jetzt =assembler forth forth= zu sehen ist. Da Sie aber jetzt - noch - keine Assembler-Befehle einsetzen wollen, schalten Sie bitte mit forth die Suchlaufpriorität wiederum.Die Statuszeile zeigt wieder das gewohnte =forth forth forth=. |
|
||||
| =FORTH FORTH FORTH= | zeigt die aktuelle Suchreihenfolge gemäß dem Vokabularkonzept. Ein Beispiel dafür sind die Assembler-Befehle: Diese befinden sich in ASSEMBLER und assembler words zeigt Ihnen den Befehlsvorrat des Assemblers an. Achten Sie bitte auf die rechte Seite der Statuszeiie, wo jetzt =assembler forth forth= zu sehen ist. Da Sie aber jetzt - noch - keine Assembler-Befehle einsetzen wollen, schalten Sie bitte mit forth die Suchlaufpriorität wieder um. Die Statuszeile zeigt wieder das gewohnte =forth forth forth=. |
|
||||
|
||||
Zur Orientierung im Arbeitssystem stellt das volksFORTH einige
|
||||
standardkonforme Wörter zur Verfügung:
|
||||
|
|
|
|||
68
sources/Apple1/2words.fth
Normal file
68
sources/Apple1/2words.fth
Normal file
|
|
@ -0,0 +1,68 @@
|
|||
\ *** Block No. 0 Hexblock 0
|
||||
\ Additional definitions for 32bit values cas 26jan06
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1 Hexblock 1
|
||||
\ 2Words Loadscreen cas 26jan06
|
||||
|
||||
hex
|
||||
&2 &3 thru
|
||||
decimal
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 2 Hexblock 2
|
||||
\ 2! 2@ 2VARIABLE 2CONSTANT 08JUL85RE)
|
||||
|
||||
CODE 2! ( D ADR --)
|
||||
TYA SETUP JSR 3 # LDY
|
||||
[[ SP )Y LDA N )Y STA DEY 0< ?]
|
||||
1 # LDY POPTWO JMP END-CODE
|
||||
|
||||
CODE 2@ ( ADR -- D)
|
||||
SP X) LDA N STA SP )Y LDA N 1+ STA
|
||||
SP 2DEC 3 # LDY
|
||||
[[ N )Y LDA SP )Y STA DEY 0< ?]
|
||||
XYNEXT JMP END-CODE
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 3 Hexblock 3
|
||||
\
|
||||
|
||||
: 2VARIABLE ( --) CREATE 4 ALLOT ;
|
||||
( -- ADR)
|
||||
|
||||
: 2CONSTANT ( D --) CREATE , , DOES> ( -- D) 2@ ;
|
||||
|
||||
\ 2DUP EXISTS
|
||||
\ 2SWAP EXISTS
|
||||
\ 2DROP EXISTS
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
2244
sources/Apple1/6502f83.fth
Normal file
2244
sources/Apple1/6502f83.fth
Normal file
File diff suppressed because it is too large
Load Diff
204
sources/Apple1/as65.fth
Normal file
204
sources/Apple1/as65.fth
Normal file
|
|
@ -0,0 +1,204 @@
|
|||
\ *** Block No. 0 Hexblock 0
|
||||
\ FORTH-6502 ASSEMBLER WFR ) cas 26jan06
|
||||
( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
|
||||
Load from Screen 1 for the transient assembler:
|
||||
This 6502 Forth Assembler can be loaded into the heap
|
||||
and then not be saved in the final binary to save memory.
|
||||
|
||||
Load from Screen 2 for the regular assembler:
|
||||
This 6502 Forth Assembler will be loaded into normal
|
||||
memory and will be saved into the final binary.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1 Hexblock 1
|
||||
\ TRANSIENT FORTH-6502 ASSEMBLER WFR ) er14dez88
|
||||
( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
|
||||
( INTERNAL LOADING 04MAY85BP/RE)
|
||||
hex
|
||||
\ HERE $200 HALLOT HEAP DP !
|
||||
&10 LOAD
|
||||
&11 LOAD
|
||||
3 &8 THRU
|
||||
&9 LOAD \ for System-Assembler
|
||||
|
||||
\ DP !
|
||||
|
||||
ONLYFORTH
|
||||
decimal
|
||||
|
||||
\ *** Block No. 2 Hexblock 2
|
||||
\ FORTH-65 ASSEMBLER WFR ) er14dez88
|
||||
( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
ONLYFORTH
|
||||
Vocabulary tassembler
|
||||
TASSEMBLER ALSO DEFINITIONS
|
||||
hex
|
||||
|
||||
8 +load \ relocate
|
||||
1 6 +THRU
|
||||
\ 7 +load \ System Assembler
|
||||
decimal
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 3 Hexblock 3
|
||||
\ FORTH-83 6502-ASSEMBLER ) er14dez88
|
||||
: END-CODE CONTEXT 2- @ CONTEXT ! ;
|
||||
CREATE INDEX
|
||||
09 c, 09 c, 05 c, 15 c, 15 c, 01 c, 11 c, 80 c,
|
||||
09 c, 80 c, 0D c, 1D c, 19 c, 80 c, 80 c, 80 c,
|
||||
80 c, 00 c, 04 c, 14 c, 14 c, 80 c, 80 c, 80 c,
|
||||
80 c, 80 c, 0C c, 1C c, 1C c, 80 c, 80 c, 2C c,
|
||||
|
||||
| VARIABLE MODE
|
||||
|
||||
: MODE: ( N -) CREATE C, DOES> ( -) C@ MODE ! ;
|
||||
|
||||
0 MODE: .A 1 MODE: # 2 | MODE: MEM 3 MODE: ,X
|
||||
4 MODE: ,Y 5 MODE: X) 6 MODE: )Y 0F MODE: )
|
||||
6 MODE: )Y 0F MODE: ) 6 MODE: )Y 0F MODE: )
|
||||
6 MODE: )Y 0F MODE: ) 6 MODE: )Y 0F MODE: )
|
||||
\ *** Block No. 4 Hexblock 4
|
||||
\ UPMODE CPU ) er14dez88
|
||||
| : UPMODE ( ADDR0 F0 - ADDR1 F1)
|
||||
IF MODE @ 8 OR MODE ! THEN 1 MODE @ 0F AND ?DUP IF
|
||||
0 DO DUP + LOOP THEN OVER 1+ @ AND 0= ;
|
||||
|
||||
: CPU ( 8B -) CREATE C, DOES> ( -) C@ >c, MEM ;
|
||||
|
||||
00 CPU BRK 18 CPU CLC D8 CPU CLD
|
||||
58 CPU CLI B8 CPU CLV CA CPU DEX
|
||||
88 CPU DEY E8 CPU INX C8 CPU INY
|
||||
EA CPU NOP 48 CPU PHA 08 CPU PHP
|
||||
68 CPU PLA 28 CPU PLP 40 CPU RTI
|
||||
60 CPU RTS 38 CPU SEC F8 CPU SED
|
||||
78 CPU SEI AA CPU TAX A8 CPU TAY
|
||||
BA CPU TSX 8A CPU TXA 9A CPU TXS
|
||||
98 CPU TYA
|
||||
\ *** Block No. 5 Hexblock 5
|
||||
\ M/CPU ) er14dez88
|
||||
|
||||
: M/CPU ( MODE OPCODE -) CREATE C, , DOES>
|
||||
DUP 1+ @ 80 AND IF 10 MODE +! THEN OVER FF00 AND UPMODE UPMODE
|
||||
IF MEM TRUE ABORT" INVALID" THEN
|
||||
C@ MODE @ INDEX + C@ + >c, MODE @ 7 AND
|
||||
IF MODE @ 0F AND 7 < IF >c, ELSE >, THEN THEN MEM ;
|
||||
|
||||
1C6E 60 M/CPU ADC 1C6E 20 M/CPU AND 1C6E C0 M/CPU CMP
|
||||
1C6E 40 M/CPU EOR 1C6E A0 M/CPU LDA 1C6E 00 M/CPU ORA
|
||||
1C6E E0 M/CPU SBC 1C6C 80 M/CPU STA 0D0D 01 M/CPU ASL
|
||||
0C0C C1 M/CPU DEC 0C0C E1 M/CPU INC 0D0D 41 M/CPU LSR
|
||||
0D0D 21 M/CPU ROL 0D0D 61 M/CPU ROR 0414 81 M/CPU STX
|
||||
0486 E0 M/CPU CPX 0486 C0 M/CPU CPY 1496 A2 M/CPU LDX
|
||||
0C8E A0 M/CPU LDY 048C 80 M/CPU STY 0480 14 M/CPU JSR
|
||||
8480 40 M/CPU JMP 0484 20 M/CPU BIT
|
||||
\ *** Block No. 6 Hexblock 6
|
||||
\ ASSEMBLER CONDITIONALS ) er14dez88
|
||||
|
||||
| : RANGE? ( BRANCH -- BRANCH )
|
||||
DUP ABS 07F U> ABORT" OUT OF RANGE " ;
|
||||
|
||||
: [[ ( BEGIN) >here ;
|
||||
: ?] ( UNTIL) >c, >here 1+ - RANGE? >c, ;
|
||||
: ?[ ( IF) >c, >here 0 >c, ;
|
||||
: ?[[ ( WHILE) ?[ SWAP ;
|
||||
: ]? ( THEN) >here OVER >c@ IF SWAP >!
|
||||
ELSE OVER 1+ - RANGE? SWAP >c! THEN ;
|
||||
: ][ ( ELSE) >here 1+ 1 JMP
|
||||
SWAP >here OVER 1+ - RANGE? SWAP >c! ;
|
||||
: ]] ( AGAIN) JMP ;
|
||||
: ]]? ( REPEAT) JMP ]? ;
|
||||
|
||||
\ *** Block No. 7 Hexblock 7
|
||||
\ ASSEMBLER CONDITIONALS ) er14dez88
|
||||
|
||||
90 CONSTANT CS B0 CONSTANT CC
|
||||
D0 CONSTANT 0= F0 CONSTANT 0<>
|
||||
10 CONSTANT 0< 30 CONSTANT 0>=
|
||||
50 CONSTANT VS 70 CONSTANT VC
|
||||
|
||||
: NOT 20 [ FORTH ] XOR ;
|
||||
|
||||
: BEQ 0<> ?] ; : BMI 0>= ?] ;
|
||||
: BNE 0= ?] ; : BPL 0< ?] ;
|
||||
: BCC CS ?] ; : BVC VS ?] ;
|
||||
: BCS CC ?] ; : BVS VC ?] ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 8 Hexblock 8
|
||||
\ 2INC/2DEC WINC/WDEC KS 19 MAY 84 ) er14dez88
|
||||
|
||||
: 2INC
|
||||
DUP LDA CLC 2 # ADC DUP STA CS ?[ SWAP 1+ INC ]? ;
|
||||
|
||||
: 2DEC
|
||||
DUP LDA SEC 2 # SBC DUP STA CC ?[ SWAP 1+ DEC ]? ;
|
||||
|
||||
: WINC DUP INC 0= ?[ SWAP 1+ INC ]? ;
|
||||
|
||||
: WDEC DUP LDA 0= ?[ OVER 1+ DEC ]? DEC ;
|
||||
|
||||
: ;C: RECOVER JSR END-CODE ] 0 LAST ! 0 ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 9 Hexblock 9
|
||||
\ ;CODE CODE CODE> BP 03 02 85) er14dez88
|
||||
ONLYFORTH
|
||||
|
||||
: ASSEMBLER ASSEMBLER [ ASSEMBLER ] MEM ;
|
||||
|
||||
: ;CODE [COMPILE] DOES> -3 >allot
|
||||
[COMPILE] ; -2 >allot ASSEMBLER ; IMMEDIATE
|
||||
|
||||
: CODE CREATE >here DUP 2- >! ASSEMBLER ;
|
||||
|
||||
: >LABEL ( ADR -)
|
||||
>here | CREATE SWAP , 4 HALLOT
|
||||
HEAP 1 AND HALLOT ( 6502-ALIGN) HERE 4 - HEAP 4 CMOVE
|
||||
HEAP LAST @ COUNT 01F AND + ! DP ! DOES> ( - ADR) @ ;
|
||||
|
||||
: LABEL [ ASSEMBLER ] >here >LABEL ASSEMBLER ;
|
||||
\ *** Block No. 10 Hexblock A
|
||||
\ Code generating primitives er14dez88
|
||||
|
||||
Variable >codes
|
||||
| Create nrc ] c, , c@ here allot ! c! [
|
||||
|
||||
: nonrelocate nrc >codes ! ; nonrelocate
|
||||
|
||||
| : >exec Create c,
|
||||
Does> c@ >codes @ + @ execute ;
|
||||
|
||||
| 0 >exec >c, | 2 >exec >, | 4 >exec >c@
|
||||
| 6 >exec >here | 8 >exec >allot | $0A >exec >!
|
||||
| $0C >exec >c!
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 11 Hexblock B
|
||||
\ FORTH-65 ASSEMBLER WFR ) er14dez88
|
||||
( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
ONLYFORTH
|
||||
|
||||
ASSEMBLER ALSO DEFINITIONS
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
323
sources/Apple1/assemble.fth
Normal file
323
sources/Apple1/assemble.fth
Normal file
|
|
@ -0,0 +1,323 @@
|
|||
\ *** Block No. 0 Hexblock 0
|
||||
\\ *** Assembler *** 25may86we
|
||||
|
||||
Dieses File enth„lt den 68000-Assembler f<EFBFBD>r volksFORTH-83.
|
||||
Der Assembler basiert auf dem von Michael Perry f<EFBFBD>r F83 entwik-
|
||||
kelten, enth„lt aber einige zus„tzliche Features.
|
||||
Wegen der Heap-Struktur im volksFORTH sind z.B. echte Labels
|
||||
verwendbar. Aus Geschwindigkeitsgr<EFBFBD>nden enth„lt der Assembler
|
||||
kaum Fehler<EFBFBD>berpr<EFBFBD>fung, es empfiehlt sich daher, nach getaner
|
||||
Tat die Code-Worte mit einem Disassembler zu <EFBFBD>berpr<EFBFBD>fen.
|
||||
|
||||
Screen $11 enth„lt einen Loadscreen, mit dem man der kompletten
|
||||
Assembler auf den Heap laden kann, damit er w„hrend der Kompila-
|
||||
tionszeit zur Verf<EFBFBD>gung steht, aber keinen Platz im Dictionary
|
||||
verbraucht. Mit CLEAR oder SAVE wird der Assembler entfernt,
|
||||
wenn er nicht mehr ben”tigt wird.
|
||||
|
||||
\ *** Block No. 1 Hexblock 1
|
||||
\ 68000 Assembler Load Screen 26oct86we
|
||||
|
||||
Onlyforth
|
||||
Vocabulary Assembler Assembler also definitions
|
||||
|
||||
: end-code context 2- @ context ! ;
|
||||
' swap | Alias *swap
|
||||
|
||||
base @ 4 $11 +thru base !
|
||||
|
||||
: reg) size push .l 0 *swap FP DI) ;
|
||||
: Next .w IP )+ D7 move D7 reg) D6 move D6 reg) jmp
|
||||
>here next-link @ , next-link ! ;
|
||||
|
||||
2 3 +thru Onlyforth
|
||||
|
||||
\ *** Block No. 2 Hexblock 2
|
||||
\ Internal Assembler 09sep86we
|
||||
|
||||
Onlyforth
|
||||
|
||||
here
|
||||
$1300 hallot heap dp ! -1 +load
|
||||
dp !
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 3 Hexblock 3
|
||||
\ Extended adressing modes 09sep86we
|
||||
|
||||
: R#) ( addr -- ) size push
|
||||
[ Forth ] dup 0< IF [ Assembler ] .w # D6 move D6 reg)
|
||||
[ Forth ] exit THEN .w FP D) ;
|
||||
|
||||
|
||||
| : inrange? ( addr -- offset f ) [ Forth ]
|
||||
>here 2+ - >here 0< IF dup $FFFE >here - < exit THEN
|
||||
dup >here negate > ;
|
||||
: pcrel) ( addr -- ) \ pc-relativ adressing mode
|
||||
inrange? [ Forth ] 0= abort" out of range" pcd) ;
|
||||
|
||||
: ;c: 0 recover R#) jsr end-code ] ;
|
||||
|
||||
|
||||
\ *** Block No. 4 Hexblock 4
|
||||
\ Assembler Forth words 09sep86we
|
||||
Forth definitions
|
||||
: Assembler Assembler [ Assembler ] .w ;
|
||||
: Code Create here dup 2- ! Assembler ;
|
||||
|
||||
| : (;code r> last @ name> ! ;
|
||||
: ;Code 0 ?pairs compile (;code [compile] [ reveal
|
||||
Assembler ; immediate restrict
|
||||
|
||||
: >label ( addr -- ) here | Create swap , immediate
|
||||
4 hallot >here 4- heap 4 cmove
|
||||
heap last @ count $1F and + even ! dp !
|
||||
Does> ( -- addr ) @
|
||||
state @ IF [compile] Literal THEN ;
|
||||
: Label [ Assembler ] >here [ Forth ] 1 and
|
||||
[ Assembler ] >allot >here >label Assembler ;
|
||||
\ *** Block No. 5 Hexblock 5
|
||||
\ Code generating primitives 26oct86we
|
||||
|
||||
Variable >codes
|
||||
| Create nrc ] c, , c@ here allot ! c! [
|
||||
|
||||
: nonrelocate nrc >codes ! ; nonrelocate
|
||||
|
||||
| : >exec Create c,
|
||||
Does> c@ >codes @ + @ execute ;
|
||||
|
||||
| 0 >exec >c, | 2 >exec >, | 4 >exec >c@
|
||||
| 6 >exec >here | 8 >exec >allot | $0A >exec >!
|
||||
| $0C >exec >c!
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 6 Hexblock 6
|
||||
\ 68000 Meta Assembler 04sep86we
|
||||
|
||||
| : ?, IF >, THEN >, ;
|
||||
| : 2, >, >, ;
|
||||
8 base !
|
||||
Variable size
|
||||
: .b 10000 size ! ;
|
||||
: .w 30100 size ! ; .w
|
||||
: .l 24600 size ! ;
|
||||
|
||||
| : Sz Constant Does> @ size @ and or ;
|
||||
00300 | Sz sz3 00400 | Sz sz4
|
||||
04000 | Sz sz40 30000 | Sz sz300
|
||||
|
||||
| : long? size @ 24600 = ;
|
||||
| : -sz1 long? IF 100 or THEN ;
|
||||
\ *** Block No. 7 Hexblock 7
|
||||
\ addressing modes 09sep86we
|
||||
|
||||
| : Regs 10 0 DO dup 1001 I * or Constant LOOP drop ;
|
||||
| : Mode Constant Does> @ *swap 7007 and or ;
|
||||
0000 Regs D0 D1 D2 D3 D4 D5 D6 D7
|
||||
0110 Regs A0 A1 A2 A3 A4 A5 A6 A7
|
||||
0220 Mode ) \ address register indirect
|
||||
0330 Mode )+ \ adr reg ind post-increment
|
||||
0440 Mode -) \ adr reg ind pre-decrement
|
||||
0550 Mode D) \ adr reg ind displaced
|
||||
0660 Mode (DI) \ adr reg ind displaced indexed s.u.
|
||||
0770 Constant #) \ immediate address
|
||||
1771 Constant L#) \ immediate long address
|
||||
2772 Constant pcD) \ pc relative displaced
|
||||
3773 Constant (pcDI) \ pc relative displaced indexed
|
||||
4774 Constant # \ immediate data
|
||||
\ *** Block No. 8 Hexblock 8
|
||||
\ fields and register assignments 08sep86we
|
||||
|
||||
| : Field Constant Does> @ and ;
|
||||
7000 | Field rd 0007 | Field rs
|
||||
0070 | Field ms 0077 | Field eas
|
||||
0377 | Field low
|
||||
| : dn? ( ea -- ea flag ) dup ms 0= ;
|
||||
| : src ( ea instr -- ea instr' ) over eas or ;
|
||||
| : dst ( ea instr -- ea instr' ) *swap rd or ;
|
||||
|
||||
| : ??dn ( mod -- mod ) dn? 0= abort" needs Data-Register" ;
|
||||
| : ??an ( mod -- mod ) dup ms 1 =
|
||||
abort" needs Adress-Register" ;
|
||||
|
||||
A6 Constant SP A5 Constant RP A4 Constant IP
|
||||
A3 Constant FP
|
||||
\ *** Block No. 9 Hexblock 9
|
||||
\ extended addressing 09sep86we
|
||||
: DI) (DI) size @ *swap ;
|
||||
: pcDI) (pcDI) size @ *swap ;
|
||||
|
||||
| : double? ( mode -- flag) dup L#) = *swap
|
||||
# = long? and or ;
|
||||
| : index? ( {n} mode -- {m} mode )
|
||||
dup >r dup 0770 and A0 (DI) = *swap (pcDI) = or
|
||||
IF size @ >r size !
|
||||
dup rd 10 * *swap ms IF 100000 or THEN
|
||||
sz40 *swap low or r> size !
|
||||
THEN r> ;
|
||||
|
||||
| : more? ( ea -- ea flag ) dup ms 0040 > ;
|
||||
| : ,more ( ea -- ) more?
|
||||
IF index? double? ?, ELSE drop THEN ;
|
||||
\ *** Block No. 10 Hexblock A
|
||||
\ extended addressing extras 09sep86we
|
||||
|
||||
| Create extra here 5 dup allot erase \ temporary storage area
|
||||
|
||||
| : extra? ( {n} mode -- mode ) more?
|
||||
IF >r r@ index? double? extra 1+ *swap
|
||||
IF under ! 2+ ! 2 ELSE ! 1 THEN extra c! r>
|
||||
ELSE 0 extra !
|
||||
THEN ;
|
||||
|
||||
| : ,extra ( -- ) extra c@ ?dup
|
||||
IF extra 1+ *swap 1 =
|
||||
IF @ >, ELSE dup 2+ @ *swap @ 2, THEN extra 5 erase
|
||||
THEN ;
|
||||
|
||||
|
||||
\ *** Block No. 11 Hexblock B
|
||||
\ immediates & address register specific 15jan86we
|
||||
| : Imm Constant Does> @ >r extra? eas r> or
|
||||
sz3 >, long? ?, ,extra ; ( n ea)
|
||||
0000 Imm ori 1000 Imm andi
|
||||
2000 Imm subi 3000 Imm addi
|
||||
5000 Imm eori 6000 Imm cmpi
|
||||
| : Immsr Constant Does> @ sz3 2, ; ( n )
|
||||
001074 Immsr andi>sr
|
||||
005074 Immsr eori>sr
|
||||
000074 Immsr ori>sr
|
||||
| : Iq Constant Does> @ >r extra? eas *swap rs 1000 * or
|
||||
r> or sz3 >, ,extra ; ( n ea )
|
||||
050000 Iq addq 050400 Iq subq
|
||||
| : Ieaa Constant Does> @ dst src sz4 >, ,more ; ( ea an )
|
||||
150300 Ieaa adda 130300 Ieaa cmpa
|
||||
040700 Ieaa lea 110300 Ieaa suba
|
||||
\ *** Block No. 12 Hexblock C
|
||||
\ shifts, rotates, and bit manipulation 15jan86we
|
||||
| : Isr Constant Does> @ >r dn?
|
||||
IF *swap dn? IF r> 40 or >r ELSE drop *swap 1000 * THEN
|
||||
rd *swap rs or r> or 160000 or sz3 >,
|
||||
ELSE dup eas 300 or r@ 400 and or r> 70 and 100 * or
|
||||
160000 or >, ,more
|
||||
THEN ; ( dm dn ) ( m # dn ) ( ea )
|
||||
400 Isr asl 000 Isr asr
|
||||
410 Isr lsl 010 Isr lsr
|
||||
420 Isr roxl 020 Isr roxr
|
||||
430 Isr rol 030 Isr ror
|
||||
| : Ibit Constant does> @ >r extra? dn?
|
||||
IF rd src 400 ELSE drop dup eas 4000 THEN
|
||||
or r> or >, ,extra ,more ; ( ea dn ) ( ea n # )
|
||||
000 Ibit btst 100 Ibit bchg
|
||||
200 Ibit bclr 300 Ibit bset
|
||||
\ *** Block No. 13 Hexblock D
|
||||
\ branch, loop, and set conditionals 15jan86we
|
||||
|
||||
| : Setclass ' *swap 0 DO I over execute LOOP drop ;
|
||||
| : Ibra 400 * 060000 or Constant ( label )
|
||||
Does> @ *swap >here 2+ - dup abs 200 <
|
||||
IF low or >, ELSE *swap 2, THEN ;
|
||||
20 Setclass Ibra bra bsr bhi bls bcc bcs bne beq
|
||||
bvc bvs bpl bmi bge blt bgt ble
|
||||
| : Idbr 400 * 050310 or Constant ( label \ dn - )
|
||||
Does> @ *swap rs or >, >here - >, ;
|
||||
20 Setclass Idbr dxit dbra dbhi dbls dbcc dbcs dbne dbeq
|
||||
dbvc dbvs dbpl dbmi dbge dblt dbgt dble
|
||||
| : Iset 400 * 050300 or Constant ( ea )
|
||||
Does> @ src >, ,more ;
|
||||
20 Setclass Iset set sno shi sls scc scs sne seq
|
||||
svc svs spl smi sge slt sgt sle
|
||||
\ *** Block No. 14 Hexblock E
|
||||
\ moves 15jan86we
|
||||
|
||||
: move extra? 7700 and src sz300 >,
|
||||
,more ,extra ; ( ea ea )
|
||||
: moveq ??dn rd *swap low or 070000 or >, ; ( n dn )
|
||||
: move>usp ??an rs 047140 or >, ; ( an )
|
||||
: move<usp ??an rs 047150 or >, ; ( an )
|
||||
: movem>
|
||||
extra? eas 044200 or -sz1 >, >, ,extra ; ( n ea )
|
||||
: movem<
|
||||
extra? eas 046200 or -sz1 >, >, ,extra ; ( n ea )
|
||||
: movep dn? IF rd *swap rs or 410 or
|
||||
ELSE rs rot rd or 610 or THEN -sz1 2, ;
|
||||
( dm d an ) ( d an dm )
|
||||
: lmove 7700 and *swap eas or 20000 or >, ;
|
||||
( long reg move )
|
||||
\ *** Block No. 15 Hexblock F
|
||||
\ odds and ends 15jan86we
|
||||
|
||||
: cmpm rd *swap rs or 130410 or sz3 >, ; ( an@+ am@+ )
|
||||
: exg dn? IF *swap dn? IF 140500 ELSE 140610 THEN >r
|
||||
ELSE *swap dn? IF 140610 ELSE 140510 THEN >r *swap
|
||||
THEN rs dst r> or >, ; ( rn rm )
|
||||
: ext ??dn rs 044200 or -sz1 >, ; ( dn )
|
||||
: swap ??dn rs 044100 or >, ; ( dn )
|
||||
: stop 47162 2, ; ( n )
|
||||
: trap 17 and 47100 or >, ; ( n )
|
||||
: link ??an rs 047120 or 2, ; ( n an )
|
||||
: unlk ??an rs 047130 or >, ; ( an )
|
||||
: eor extra? eas dst sz3 130400 or >, ,extra ; ( dn ea )
|
||||
: cmp ??dn 130000 dst src sz3 >, ,more ; ( ea dn )
|
||||
|
||||
|
||||
\ *** Block No. 16 Hexblock 10
|
||||
\ arithmetic and logic 15jan86we
|
||||
| : Ibcd Constant Does> @ dst over rs or *swap ms
|
||||
IF 10 or THEN >, ; ( dn dm ) ( an@- am@- )
|
||||
140400 Ibcd abcd 100400 Ibcd sbcd
|
||||
| : Idd Constant Does> @ dst over rs or *swap ms
|
||||
IF 10 or THEN sz3 >, ; ( dn dm ) ( an@- am@- )
|
||||
150400 Idd addx 110400 Idd subx
|
||||
| : Idea Constant Does> @ >r dn? ( ea dn ) ( dn ea )
|
||||
IF rd src r> or sz3 >, ,more
|
||||
ELSE extra? eas dst 400 or r> or sz3 >, ,extra THEN ;
|
||||
150000 Idea add 110000 Idea sub
|
||||
140000 Idea and 100000 Idea or
|
||||
| : Iead Constant Does> @ >r ??dn r> dst src
|
||||
>, ,more ; ( ea dn)
|
||||
040600 Iead chk 100300 Iead divu 100700 Iead divs
|
||||
140300 Iead mulu 140700 Iead muls
|
||||
\ *** Block No. 17 Hexblock 11
|
||||
\ arithmetic and control 15jan86we
|
||||
|
||||
| : Iea Constant Does> @ src >, ,more ; ( ea )
|
||||
047200 Iea jsr 047300 Iea jmp
|
||||
042300 Iea move>ccr
|
||||
040300 Iea move<sr 043300 Iea move>sr
|
||||
044000 Iea nbcd 044100 Iea pea
|
||||
045300 Iea tas
|
||||
| : Ieas Constant Does> @ src sz3 >, ,more ; ( ea )
|
||||
041000 Ieas clr 043000 Ieas not
|
||||
042000 Ieas neg 040000 Ieas negx
|
||||
045000 Ieas tst
|
||||
| : Icon Constant Does> @ >, ;
|
||||
47160 Icon reset 47161 Icon nop
|
||||
47163 Icon rte 47165 Icon rts
|
||||
47166 Icon trapv 47167 Icon rtr
|
||||
\ *** Block No. 18 Hexblock 12
|
||||
\ structured conditionals +/- 256 bytes 15jan86we
|
||||
: THEN >here over 2+ - *swap 1+ >c! ;
|
||||
: IF >, >here 2- ; hex
|
||||
: ELSE 6000 IF *swap THEN ;
|
||||
: BEGIN >here ;
|
||||
: UNTIL >, >here - >here 1- >c! ;
|
||||
: AGAIN 6000 UNTIL ;
|
||||
: WHILE IF *swap ;
|
||||
: REPEAT AGAIN THEN ;
|
||||
: DO >here *swap ;
|
||||
: LOOP dbra ;
|
||||
6600 Constant 0= 6700 Constant 0<>
|
||||
6A00 Constant 0< 6B00 Constant 0>=
|
||||
6C00 Constant < 6D00 Constant >=
|
||||
6E00 Constant <= 6F00 Constant >
|
||||
6500 Constant CC 6400 Constant CS
|
||||
34
sources/Apple1/ccompile.fth
Normal file
34
sources/Apple1/ccompile.fth
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
\ *** Block No. 0 Hexblock 0
|
||||
\ Crosscompile Script for 6502 Target cas 26jan06
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1 Hexblock 1
|
||||
\ loadscreen for cross-compiler cas 26jan06
|
||||
|
||||
include assemble.fb \ load 68000 assembler
|
||||
2 loadfrom as65.fb page \ load 6502 assembler
|
||||
include crostarg.fb page \ load target compiler
|
||||
include 6502f83.fb \ load Forth Kernel Source
|
||||
|
||||
save-target f6502.com \ save new forth as f6502.com
|
||||
key drop page .( Ready ) cr \ wait for keypress
|
||||
bye \ and exit forth
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
680
sources/Apple1/crostarg.fth
Normal file
680
sources/Apple1/crostarg.fth
Normal file
|
|
@ -0,0 +1,680 @@
|
|||
\ *** Block No. 0 Hexblock 0
|
||||
\\ *** volksFORTH-84 Target-Compiler *** cas 26jan06
|
||||
|
||||
This Target Compiler can be used to create a new Forth System
|
||||
using the Sourcecode 6502F82.FB.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1 Hexblock 1
|
||||
\ Target compiler loadscr 09sep86we
|
||||
\ Idea and first Implementation by ks/bp
|
||||
\ Implemented on 6502 by ks/bp
|
||||
\ ultraFORTH83-Version by bp/we
|
||||
\ Atari 520 ST - Version by we
|
||||
Onlyforth Assembler nonrelocate
|
||||
07 Constant imagepage \ Virtual memory bank
|
||||
Vocabulary Ttools
|
||||
Vocabulary Defining
|
||||
: .stat .blk .s ; ' .stat Is .status
|
||||
\ : 65( [compile] ( ; immediate
|
||||
: 65( ; immediate : ) ; immediate \ cpu-addressing|lbyte|hbyte|
|
||||
1 $14 +thru \ Target compiler
|
||||
$15 $17 +thru \ Target Tools
|
||||
$18 $1A +thru \ Redefinitions
|
||||
save $1B $24 +thru \ Predefinitions
|
||||
\ *** Block No. 2 Hexblock 2
|
||||
\ Target header pointers bp05mar86we
|
||||
|
||||
Variable tdp : there tdp @ ;
|
||||
Variable displace
|
||||
Variable ?thead 0 ?thead !
|
||||
Variable tlast 0 tlast !
|
||||
Variable glast' 0 glast' !
|
||||
Variable tdoes>
|
||||
Variable >in:
|
||||
Variable tvoc 0 tvoc !
|
||||
Variable tvoc-link 0 tvoc-link !
|
||||
Variable tnext-link 0 tnext-link !
|
||||
|
||||
: c+! ( 8b addr -- ) dup c@ rot + swap c! ;
|
||||
|
||||
|
||||
\ *** Block No. 3 Hexblock 3
|
||||
\ Image and byteorder 15sep86we
|
||||
|
||||
: >image ( addr1 - addr2 ) displace @ - ;
|
||||
|
||||
: >heap ( from quan - )
|
||||
heap over - 1 and + \ 68000-align
|
||||
dup hallot heap swap cmove ;
|
||||
\\
|
||||
: >ascii 2drop ; ' noop Alias C64>ascii
|
||||
|
||||
Code Lc@ ( laddr -- 8b )
|
||||
.l SP )+ A0 move .w D0 clr .b A0 ) D0 move
|
||||
.w D0 SP -) move Next end-code
|
||||
Code Lc! ( 8b addr -- )
|
||||
.l SP )+ A0 move .w SP )+ D0 move .b D0 A0 ) move
|
||||
Next end-code
|
||||
\ *** Block No. 4 Hexblock 4
|
||||
\ Ghost-creating 05mar86we
|
||||
|
||||
0 | Constant <forw> 0 | Constant <res>
|
||||
|
||||
| : Make.ghost ( - cfa.ghost )
|
||||
here dup 1 and allot here
|
||||
state @ IF context @ ELSE current THEN @
|
||||
dup @ , name
|
||||
dup c@ 1 $1F uwithin not abort" inval.Gname"
|
||||
dup c@ 1+ over c!
|
||||
c@ dup 1+ allot 1 and 0= IF bl c, THEN
|
||||
here 2 pick - -rot
|
||||
<forw> , 0 , 0 ,
|
||||
swap here over - >heap
|
||||
heap swap ! swap dp !
|
||||
heap + ;
|
||||
\ *** Block No. 5 Hexblock 5
|
||||
\ ghost words 05mar86we
|
||||
|
||||
: gfind ( string - cfa tf / string ff )
|
||||
dup count + 1+ bl swap c!
|
||||
dup >r 1 over c+! find -1 r> c+! ;
|
||||
|
||||
: ghost ( - cfa )
|
||||
>in @ name gfind IF nip exit THEN
|
||||
drop >in ! Make.ghost ;
|
||||
|
||||
: Word, ghost execute ;
|
||||
|
||||
: gdoes> ( cfa.ghost - cfa.does )
|
||||
4+ dup @ IF @ exit THEN
|
||||
here dup <forw> , 0 , 4 >heap
|
||||
dp ! heap dup rot ! ;
|
||||
\ *** Block No. 6 Hexblock 6
|
||||
\ ghost utilities 04dec85we
|
||||
|
||||
: g' name gfind 0= abort" ?" ;
|
||||
|
||||
: '.
|
||||
g' dup @ <forw> case?
|
||||
IF ." forw" ELSE <res> - abort" ??" ." res" THEN
|
||||
2+ dup @ 5 u.r
|
||||
2+ @ ?dup
|
||||
IF dup @ <forw> case?
|
||||
IF ." fdef" ELSE <res> - abort" ??" ." rdef" THEN
|
||||
2+ @ 5 u.r THEN ;
|
||||
|
||||
' ' Alias h'
|
||||
|
||||
|
||||
\ *** Block No. 7 Hexblock 7
|
||||
\ .unresolved 05mar86we
|
||||
|
||||
| : forward? ( cfa - cfa / exit&true )
|
||||
dup @ <forw> = over 2+ @ and IF drop true rdrop exit THEN ;
|
||||
|
||||
| : unresolved? ( addr - f )
|
||||
2+ dup c@ $1F and over + c@ BL =
|
||||
IF name> forward? 4+ @ dup IF forward? THEN
|
||||
THEN drop false ;
|
||||
|
||||
| : unresolved-words
|
||||
BEGIN @ ?dup WHILE dup unresolved?
|
||||
IF dup 2+ .name ?cr THEN REPEAT ;
|
||||
|
||||
: .unresolved voc-link @
|
||||
BEGIN dup 4- unresolved-words @ ?dup 0= UNTIL ;
|
||||
\ *** Block No. 8 Hexblock 8
|
||||
\ Extending Vocabularys for Target-Compilation 05mar86we
|
||||
|
||||
: Vocabulary Vocabulary 0 , here tvoc @ , tvoc ! ;
|
||||
|
||||
Vocabulary Transient 0 tvoc !
|
||||
|
||||
Only definitions Forth also
|
||||
|
||||
: T Transient ; immediate
|
||||
: H Forth ; immediate
|
||||
|
||||
definitions
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 9 Hexblock 9
|
||||
\ Transient primitives 05mar86we
|
||||
|
||||
Code byte> ( 8bh 8bl -- 16b )
|
||||
SP )+ D1 move SP ) D0 move 8 # D0 lsl .b D1 D0 move
|
||||
.w D0 SP ) move Next end-code
|
||||
Code >byte ( 16b -- 8bl 8bh )
|
||||
SP )+ D0 move D0 D1 move $FF D0 andi 8 # D1 lsr
|
||||
D0 SP -) move D1 SP -) move Next end-code
|
||||
|
||||
Transient definitions
|
||||
: c@ H >image imagepage lc@ ;
|
||||
: c! H >image imagepage lc! ;
|
||||
: @ dup T c@ swap 1+ T c@ 65( swap ) byte> ;
|
||||
: ! >r >byte 65( swap ) r@ T c! r> 1+ T c! ;
|
||||
: cmove ( from.mem to.target quan -)
|
||||
bounds ?DO dup H c@ I T c! H 1+ LOOP drop ;
|
||||
\ *** Block No. 10 Hexblock A
|
||||
\ Transient primitives bp05mar86we
|
||||
|
||||
: here there ;
|
||||
: allot Tdp +! ;
|
||||
: c, T here c! 1 allot H ;
|
||||
: , T here ! 2 allot H ;
|
||||
|
||||
: ," Ascii " parse dup T c,
|
||||
under there swap cmove
|
||||
.( dup 1 and 0= IF 1+ THEN ) allot H ;
|
||||
|
||||
: fill ( addr quan 8b -)
|
||||
-rot bounds ?DO dup I T c! H LOOP drop ;
|
||||
: erase 0 T fill ;
|
||||
: blank bl T fill ;
|
||||
: here! H Tdp ! ;
|
||||
\ *** Block No. 11 Hexblock B
|
||||
\ Resolving 08dec85we
|
||||
Forth definitions
|
||||
: resolve ( cfa.ghost cfa.target -)
|
||||
over dup @ <res> =
|
||||
IF space dup >name .name ." exists " ?cr 2+ ! drop exit THEN
|
||||
>r >r 2+ @ ?dup
|
||||
IF BEGIN dup T @ H 2dup = abort" resolve loop" r@ rot T !
|
||||
H ?dup 0= UNTIL
|
||||
THEN r> r> <res> over ! 2+ ! ;
|
||||
|
||||
: resdoes> ( cfa.ghost cfa.target -)
|
||||
swap gdoes> dup @ <res> = IF 2+ ! exit THEN swap resolve ;
|
||||
] Does> [ here 4- 0 ] dup @ there rot ! T , H ;
|
||||
' <forw> >body !
|
||||
] Does> [ here 4- 0 ] @ T , H ;
|
||||
' <res> >body !
|
||||
\ *** Block No. 12 Hexblock C
|
||||
\ move-threads 68000-align cas 26jan06
|
||||
|
||||
: move-threads Tvoc @ Tvoc-link @
|
||||
BEGIN over ?dup
|
||||
WHILE 2- @ over 2- T ! @ H swap @ swap REPEAT
|
||||
error" some undef. Target-Vocs left" drop ;
|
||||
|
||||
| : tlatest ( - addr) current @ 6 + ;
|
||||
|
||||
\\
|
||||
not used for the 6502 architecture
|
||||
|
||||
| : 68000-talign ( cfa -- ) 1 and IF 1 T allot H THEN ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 13 Hexblock D
|
||||
\ save-target 09sep86we
|
||||
|
||||
Dos definitions
|
||||
|
||||
Code (filewrite ( buff len handle -- n)
|
||||
SP )+ D0 move .l D2 clr .w SP )+ D2 move
|
||||
.l 0 imagepage # D1 move .w SP )+ D1 move
|
||||
.l D1 A7 -) move \ buffer adress
|
||||
.l D2 A7 -) move \ buffer length
|
||||
.w D0 A7 -) move \ handle
|
||||
$40 # A7 -) move \ call WRITE
|
||||
1 trap $0C # A7 adda
|
||||
.w D0 SP -) move Next end-code Forth definitions
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 14 Hexblock E
|
||||
\ save Target-System 09sep86we
|
||||
|
||||
: save-target [ Dos ]
|
||||
bl word count dup 0= abort" missing filename"
|
||||
over + off (createfile dup >r 0< abort" no device "
|
||||
T here $1C - 4 ! 0 , 0 , H [ Dos ] \ Programm header
|
||||
0 there r@ (filewrite there - abort" write error"
|
||||
r> (closefile 0< abort" close error" ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 15 Hexblock F
|
||||
\\ 6502-ALIGN ?HEAD \ 08SEP84BP)
|
||||
|
||||
| : 6502-align/1 ( adr -- adr' ) dup 0FF and 0FF = - ;
|
||||
|
||||
|
||||
| : 6502-align/2 ( lfa -- lfa )
|
||||
there 0FF and 0FF =
|
||||
IF dup dup 1+ there over - 1+ cmove> \ lfa now invalid
|
||||
1 tlast +! 1 tallot THEN ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 16 Hexblock 10
|
||||
\\ WARNING CREATE 30DEC84BP)
|
||||
|
||||
VARIABLE WARNING 0 WARNING !
|
||||
|
||||
| : EXISTS?
|
||||
WARNING @ ?EXIT
|
||||
LAST @ CURRENT @ (FIND NIP
|
||||
IF SPACE LAST @ .NAME ." EXISTS " ?CR THEN ;
|
||||
|
||||
: CREATE HERE BLK @ , CURRENT @ @ ,
|
||||
NAME C@ DUP 1 020 UWITHIN NOT ABORT" INVALID NAME"
|
||||
HERE LAST ! 1+ ALLOT EXISTS? ?HEAD @
|
||||
IF 1 ?HEAD +! DUP 6502-ALIGN/1 , \ POINTER TO CODE
|
||||
HEAPMOVE 020 FLAG! 6502-ALIGN/1 DP !
|
||||
ELSE 6502-ALIGN/2 DROP THEN REVEAL 0 ,
|
||||
;CODE DOCREATE JMP END-CODE
|
||||
\ *** Block No. 17 Hexblock 11
|
||||
\ compiling names into targ. 05mar86we
|
||||
|
||||
: (theader
|
||||
?thead @ IF 1 ?thead +!
|
||||
there $FF and $FF = IF 1 T allot H THEN exit THEN
|
||||
>in @ name swap >in !
|
||||
dup c@ 1 $20 uwithin not abort" inval. Tname"
|
||||
dup c@ 3 + there + $FF and $FF =
|
||||
there 2+ $FF and $FF = or IF 1 T allot H THEN
|
||||
blk @ T , H there tlatest dup @ T , H ! there dup tlast !
|
||||
over c@ 1+ .( even ) dup T allot cmove H ;
|
||||
|
||||
: Theader tlast off
|
||||
(theader Ghost dup glast' !
|
||||
there resolve ;
|
||||
|
||||
\ *** Block No. 18 Hexblock 12
|
||||
\ prebuild defining words bp27jun85we
|
||||
|
||||
| : executable? ( adr - adr f ) dup ;
|
||||
| : tpfa, there , ;
|
||||
| : (prebuild ( cfa.adr -- )
|
||||
>in @ Create >in ! here 2- ! ;
|
||||
|
||||
: prebuild ( adr 0.from.: - 0 )
|
||||
0 ?pairs executable? dup >r
|
||||
IF [compile] Literal compile (prebuild ELSE drop THEN
|
||||
compile Theader Ghost gdoes> ,
|
||||
r> IF compile tpfa, THEN 0 ; immediate restrict
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 19 Hexblock 13
|
||||
\ code portion of def.words bp11sep86we
|
||||
|
||||
: dummy 0 ;
|
||||
|
||||
: DO> ( - adr.of.jmp.dodoes> 0 )
|
||||
[compile] Does> here 4- compile @ 0 ] ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 20 Hexblock 14
|
||||
\ the 68000 Assembler 11sep86we
|
||||
|
||||
Forth definitions
|
||||
| Create relocate ] T c, , c@ here allot ! c! H [
|
||||
|
||||
Transient definitions
|
||||
|
||||
: Assembler H [ Tassembler ] relocate >codes ! Tassembler ;
|
||||
: >label ( 16b -) H >in @ name gfind rot >in !
|
||||
IF over resolve dup THEN drop Constant ;
|
||||
: Label T .( here 1 and allot ) here >label Assembler H ;
|
||||
: Code H Theader there 2+ T , Assembler H ;
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 21 Hexblock 15
|
||||
\ immed. restr. ' \ compile bp05mar86we
|
||||
|
||||
: ?pairs ( n1 n2 -- ) H - abort" unstructured" ;
|
||||
: >mark ( - addr ) H there T 0 , H ;
|
||||
: >resolve ( addr - ) H there over - swap T ! H ;
|
||||
: <mark ( - addr ) H there ;
|
||||
: <resolve ( addr - ) H there - T , H ;
|
||||
: immediate H Tlast @ ?dup
|
||||
IF dup T c@ $40 or swap c! H THEN ;
|
||||
: restrict H Tlast @ ?dup
|
||||
IF dup T c@ $80 or swap c! H THEN ;
|
||||
: ' ( <name> - cfa ) H g' dup @ <res> - abort" ?" 2+ @ ;
|
||||
: | H ?thead @ ?exit ?thead on ;
|
||||
: compile H Ghost , ; immediate restrict
|
||||
|
||||
|
||||
\ *** Block No. 22 Hexblock 16
|
||||
\ Target tools ks05mar86we
|
||||
|
||||
Onlyforth Ttools also definitions
|
||||
|
||||
| : ttype ( adr n -) bounds ?DO I T c@ H dup
|
||||
bl > IF emit ELSE drop Ascii . emit THEN LOOP ;
|
||||
: .name ( nfa -) ?dup IF dup 1+ swap T c@ H $1F and ttype
|
||||
ELSE ." ??? " THEN space ?cr ;
|
||||
| : nfa? ( cfa lfa - nfa / cfa ff)
|
||||
BEGIN dup WHILE 2dup 2+ dup T c@ H $1F and + 1+ .( even ) =
|
||||
IF 2+ nip exit THEN
|
||||
T @ H REPEAT ;
|
||||
: >name ( cfa - nfa / ff)
|
||||
Tvoc BEGIN @ dup WHILE under 2- @ nfa? ?dup
|
||||
IF nip exit THEN
|
||||
swap REPEAT nip ;
|
||||
\ *** Block No. 23 Hexblock 17
|
||||
\ Ttools for decompiling ks05mar86we
|
||||
|
||||
| : ?: dup 4 u.r ." :" ;
|
||||
| : @? dup T @ H 6 u.r ;
|
||||
| : c? dup T c@ H 3 .r ;
|
||||
|
||||
: s ( addr - addr+ ) ?: space c? 3 spaces
|
||||
dup 1+ over T c@ H ttype dup T c@ H + 1+ ;
|
||||
|
||||
: n ( addr - addr+2 ) ?: @? 2 spaces
|
||||
dup T @ H [ Ttools ] >name .name H 2+ ;
|
||||
|
||||
: d ( addr n - addr+n ) 2dup swap ?: swap 0 DO c? 1+ LOOP
|
||||
2 spaces -rot ttype ;
|
||||
|
||||
|
||||
\ *** Block No. 24 Hexblock 18
|
||||
\ Tools for decompiling bp05mar86we
|
||||
|
||||
: l ( addr -- addr+2 ) ?: 5 spaces @? 2+ ;
|
||||
|
||||
: c ( addr -- addr+1 ) 1 d ;
|
||||
|
||||
: b ( addr -- addr+1 ) ?: @? dup T @ H over + 5 u.r 2+ ;
|
||||
|
||||
: dump ( adr n -) bounds ?DO cr I $10 d drop
|
||||
stop? IF LEAVE THEN $10 +LOOP ;
|
||||
|
||||
: view T ' H [ Ttools ] >name ?dup
|
||||
IF 4- T @ H l THEN ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 25 Hexblock 19
|
||||
\ reinterpretation def.-words 05mar86we
|
||||
|
||||
Onlyforth
|
||||
|
||||
: redefinition
|
||||
tdoes> @ IF >in push [ ' >interpret >body ] Literal push
|
||||
state push context push >in: @ >in !
|
||||
name [ ' Transient 2+ ] Literal (find nip 0=
|
||||
IF cr ." Redefinition: " here .name
|
||||
>in: @ >in ! : Defining interpret THEN
|
||||
THEN 0 tdoes> ! ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 26 Hexblock 1A
|
||||
\ Create..does> structure bp05mar86we
|
||||
|
||||
| : (;tcode
|
||||
Tlast @ dup T c@ .( dup 1 and - ) 1+ + ! H rdrop ;
|
||||
| : changecfa compile lit tdoes> @ , compile (;tcode ;
|
||||
|
||||
Defining definitions
|
||||
|
||||
: ;code 0 ?pairs changecfa reveal rdrop ;
|
||||
immediate restrict
|
||||
|
||||
Defining ' ;code Alias does> immediate restrict
|
||||
|
||||
: ; [compile] ; rdrop ; immediate restrict
|
||||
|
||||
|
||||
\ *** Block No. 27 Hexblock 1B
|
||||
\ redefinition conditionals bp27jun85we
|
||||
|
||||
' DO Alias DO immediate restrict
|
||||
' ?DO Alias ?DO immediate restrict
|
||||
' LOOP Alias LOOP immediate restrict
|
||||
' IF Alias IF immediate restrict
|
||||
' THEN Alias THEN immediate restrict
|
||||
' ELSE Alias ELSE immediate restrict
|
||||
' BEGIN Alias BEGIN immediate restrict
|
||||
' UNTIL Alias UNTIL immediate restrict
|
||||
' WHILE Alias WHILE immediate restrict
|
||||
' REPEAT Alias REPEAT immediate restrict
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 28 Hexblock 1C
|
||||
\ clear Liter. Ascii ['] ." bp05mar86we
|
||||
|
||||
Onlyforth Transient definitions
|
||||
|
||||
: clear true abort" There are ghosts" ;
|
||||
: Literal ( n -) T compile lit , H ; immediate
|
||||
: Ascii H bl word 1+ c@ state @
|
||||
IF T [compile] Literal H THEN ; immediate
|
||||
: ['] T ' [compile] Literal H ; immediate restrict
|
||||
: " T compile (" ," H ; immediate restrict
|
||||
: ." T compile (." ," H ; immediate restrict
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 29 Hexblock 1D
|
||||
\ Target compilation ] [ bp05mar86we
|
||||
|
||||
Forth definitions
|
||||
|
||||
: tcompile
|
||||
?stack >in @ name find ?dup
|
||||
IF 0> IF nip execute >interpret THEN
|
||||
drop dup >in ! name
|
||||
THEN gfind IF nip execute >interpret THEN
|
||||
nullstring? IF drop exit THEN
|
||||
number? ?dup IF 0> IF swap T [compile] Literal THEN
|
||||
[compile] Literal H drop >interpret THEN
|
||||
drop >in ! Word, >interpret ;
|
||||
|
||||
Transient definitions
|
||||
: ] H state on ['] tcompile is >interpret ;
|
||||
\ *** Block No. 30 Hexblock 1E
|
||||
\ Target conditionals bp05mar86we
|
||||
|
||||
: IF T compile ?branch >mark H 1 ; immediate restrict
|
||||
: THEN abs 1 T ?pairs >resolve H ; immediate restrict
|
||||
: ELSE T 1 ?pairs compile branch >mark swap >resolve
|
||||
H -1 ; immediate restrict
|
||||
: BEGIN T <mark H 2 ; immediate restrict
|
||||
: WHILE T 2 ?pairs 2 compile ?branch >mark -2 H 2swap ;
|
||||
immediate restrict
|
||||
| : (repeat T 2 ?pairs <resolve H BEGIN dup -2 =
|
||||
WHILE drop T >resolve H REPEAT ;
|
||||
: UNTIL T compile ?branch (repeat H ; immediate restrict
|
||||
: REPEAT T compile branch (repeat H ; immediate restrict
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 31 Hexblock 1F
|
||||
\ Target conditionals bp27jun85we
|
||||
|
||||
: DO T compile (do >mark H 3 ; immediate restrict
|
||||
: ?DO T compile (?do >mark H 3 ; immediate restrict
|
||||
: LOOP T 3 ?pairs compile (loop compile endloop
|
||||
>resolve H ; immediate restrict
|
||||
: +LOOP T 3 ?pairs compile (+loop compile endloop
|
||||
>resolve H ; immediate restrict
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 32 Hexblock 20
|
||||
\ predefinitions bp05mar86we
|
||||
|
||||
: abort" T compile (abort" ," H ; immediate
|
||||
: error" T compile (err" ," H ; immediate
|
||||
|
||||
Forth definitions
|
||||
|
||||
Variable torigin
|
||||
Variable tudp 0 Tudp !
|
||||
|
||||
: >user T c@ H torigin @ + ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 33 Hexblock 21
|
||||
\ Datatypes bp05mar86we
|
||||
|
||||
Transient definitions
|
||||
: origin! H torigin ! ;
|
||||
: user' ( -- n ) T ' >body c@ H ;
|
||||
: uallot ( n -- ) H tudp @ swap tudp +! ;
|
||||
|
||||
DO> >user ;
|
||||
: User prebuild User 2 T uallot c, ;
|
||||
|
||||
DO> ;
|
||||
: Create prebuild Create ;
|
||||
|
||||
DO> T @ H ;
|
||||
: Constant prebuild Constant T , ;
|
||||
: Variable Create 2 T allot ;
|
||||
\ *** Block No. 34 Hexblock 22
|
||||
\ Datatypes bp05mar86we
|
||||
|
||||
dummy
|
||||
: Vocabulary
|
||||
H >in @ Vocabulary >in ! T prebuild Vocabulary 0 , 0 ,
|
||||
here H tvoc-link @ T , H tvoc-link ! ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 35 Hexblock 23
|
||||
\ target defining words bp08sep86we
|
||||
|
||||
Do> ;
|
||||
: Defer prebuild Defer 2 T allot ;
|
||||
: Is T ' H >body state @ IF T compile (is , H
|
||||
ELSE T ! H THEN ; immediate
|
||||
| : dodoes> T compile (;code H Glast' @
|
||||
there resdoes> there tdoes> ! ;
|
||||
|
||||
: ;code 0 T ?pairs dodoes> Assembler H [compile] [
|
||||
redefinition ; immediate restrict
|
||||
|
||||
: does> T dodoes> $04C C,
|
||||
compile (dodoes> H ; immediate restrict
|
||||
|
||||
|
||||
\ *** Block No. 36 Hexblock 24
|
||||
\ : Alias ; bp25mar86we
|
||||
|
||||
: Create: T Create H current @ context ! T ] H 0 ;
|
||||
|
||||
dummy
|
||||
: : H tdoes> off >in @ >in: ! T prebuild :
|
||||
H current @ context ! T ] H 0 ;
|
||||
|
||||
: Alias ( n -- ) H Tlast off (theader Ghost over resolve
|
||||
tlast @ T c@ H $20 or tlast @ T c! , H ;
|
||||
|
||||
: ; T 0 ?pairs compile exit .( unnest gegen exit getauscht)
|
||||
[compile] [ H redefinition ; immediate restrict
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 37 Hexblock 25
|
||||
\ predefinitions bp11sep86we
|
||||
|
||||
: compile T compile compile H ; immediate restrict
|
||||
: Host H Onlyforth Ttools also ;
|
||||
: Compiler T Host H Transient also definitions ;
|
||||
: [compile] H Word, ; immediate restrict
|
||||
: Onlypatch H there 3 - 0 tdoes> ! 0 ;
|
||||
|
||||
Onlyforth
|
||||
: Target Onlyforth Transient also definitions ;
|
||||
|
||||
Transient definitions
|
||||
Ghost c, drop
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 38 Hexblock 26
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 39 Hexblock 27
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
187
sources/Apple1/systemio.fth
Normal file
187
sources/Apple1/systemio.fth
Normal file
|
|
@ -0,0 +1,187 @@
|
|||
\ *** Block No. 0 Hexblock 0
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1 Hexblock 1
|
||||
\ loadscreen for system IO for Apple1 cas2013apr05
|
||||
|
||||
|
||||
1 9 +thru
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 2 Hexblock 2
|
||||
\ 65KEY? GETKEY cas2013apr05
|
||||
| $D010 Constant KBDDTA
|
||||
| $D011 Constant KBDCTL
|
||||
|
||||
| CODE 65KEY? ( -- FLAG) KBDCTL lda 0>= ?[ 0 # lda ][ 1 # lda ]?
|
||||
push0a jmp end-code
|
||||
|
||||
| CODE GETKEY ( -- 8B) KBDDTA lda $7F # AND
|
||||
push0a jmp end-code
|
||||
|
||||
| CODE CURON ( --) NEXT JMP END-CODE
|
||||
|
||||
| CODE CUROFF ( --) NEXT JMP END-CODE
|
||||
|
||||
: 65KEY ( -- 8B)
|
||||
CURON BEGIN PAUSE 65KEY? UNTIL CUROFF GETKEY ;
|
||||
\ *** Block No. 3 Hexblock 3
|
||||
\ DECODE EXPECT KEYBOARD BP28MAY85) cs08aug05
|
||||
08 CONSTANT #BS $0D CONSTANT #CR &27 CONSTANT #ESC
|
||||
|
||||
: 65DECODE ( ADDR CNT1 KEY -- ADDR CNT2)
|
||||
#BS CASE? IF DUP IF DEL 1- THEN EXIT THEN
|
||||
#CR CASE? IF DUP SPAN ! EXIT THEN
|
||||
>R 2DUP + R@ SWAP C! R> EMIT 1+ ;
|
||||
|
||||
: 65EXPECT ( ADDR LEN1 -- ) SPAN ! 0
|
||||
BEGIN DUP SPAN @ U<
|
||||
WHILE KEY DECODE
|
||||
REPEAT 2DROP SPACE ;
|
||||
|
||||
INPUT: KEYBOARD [ HERE INPUT ! ]
|
||||
65KEY 65KEY? 65DECODE 65EXPECT [
|
||||
|
||||
\ *** Block No. 4 Hexblock 4
|
||||
\ senden? (emit 65emit 25JAN85RE) cas2013apr05
|
||||
|
||||
| $D012 Constant DSP
|
||||
|
||||
| Code send? ( -- flg )
|
||||
DSP lda $80 # AND $80 # EOR push0a jmp end-code
|
||||
|
||||
Code (emit ( 8b -- )
|
||||
SP X) LDA DSP sta (drop jmp end-code
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 5 Hexblock 5
|
||||
\ EMIT CR DEL PAGE AT AT? 25JAN85RE) cas2013apr05
|
||||
|
||||
| Variable out 0 out ! | &40 Constant c/row
|
||||
|
||||
: 65emit ( 8b -- ) BEGIN pause send? UNTIL 1 out +! (emit ;
|
||||
|
||||
: 65CR #CR 65emit out @ c/row / 1+ c/row * out ! ;
|
||||
|
||||
: 65DEL ASCII _ 65emit -1 out +! ;
|
||||
|
||||
: 65PAGE &24 0 DO CR LOOP out off ;
|
||||
|
||||
: 65at ( row col -- ) .( at einf. ) swap c/row * + out ! ;
|
||||
|
||||
: 65AT? ( -- ROW COL ) out @ c/row /mod &24 min swap ;
|
||||
|
||||
\ *** Block No. 6 Hexblock 6
|
||||
\ er14dez88
|
||||
|
||||
: 65type ( adr len -- ) bounds ?DO I c@ emit LOOP ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 7 Hexblock 7
|
||||
\ TYPE DISPLAY (BYE BP 28MAY85RE) er14dez88
|
||||
|
||||
OUTPUT: DISPLAY [ HERE OUTPUT ! ]
|
||||
65EMIT 65CR 65TYPE 65DEL 65PAGE 65AT 65AT? [
|
||||
|
||||
|
||||
| : (bye ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 8 Hexblock 8
|
||||
\ B/BLK DRIVE >DRIVE DRVINIT 28MAY85RE) er14dez88
|
||||
|
||||
$400 CONSTANT B/BLK
|
||||
|
||||
$0AA CONSTANT BLK/DRV
|
||||
|
||||
| VARIABLE (DRV 0 (DRV !
|
||||
|
||||
| : DISK ( -- DEV.NO ) (DRV @ 8 + ;
|
||||
|
||||
: DRIVE ( DRV# -- ) BLK/DRV * OFFSET ! ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 9 Hexblock 9
|
||||
\ er14dez88
|
||||
: >DRIVE ( BLOCK DRV# -- BLOCK' )
|
||||
BLK/DRV * + OFFSET @ - ;
|
||||
: DRV? ( BLOCK -- DRV# )
|
||||
OFFSET @ + BLK/DRV / ;
|
||||
|
||||
: DRVINIT NOOP ;
|
||||
.( fuer reads. u. writes. ist errorhandler erforderlich )
|
||||
| : readserial ( adr blk -- )
|
||||
&27 emit .( rb ) space base push decimal . cr
|
||||
$400 bounds DO key I c! LOOP ;
|
||||
|
||||
| : writeserial ( adr blk -- )
|
||||
&27 emit .( wb ) space base push decimal . cr
|
||||
$400 bounds DO I c@ emit LOOP ;
|
||||
|
||||
\ *** Block No. 10 Hexblock A
|
||||
\ (r/w er14decas
|
||||
|
||||
: (R/W ( ADR BLK FILE R/WF -- FLAG)
|
||||
swap abort" no file"
|
||||
IF readserial ELSE writeserial THEN false ;
|
||||
|
||||
' (R/W IS R/W
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
170
sources/Apple1/tasker.fth
Normal file
170
sources/Apple1/tasker.fth
Normal file
|
|
@ -0,0 +1,170 @@
|
|||
\ *** Block No. 0 Hexblock 0
|
||||
\ Multitasking Extension to volksFORTH cas 26jan06
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1 Hexblock 1
|
||||
\ Tasker Loadscreen
|
||||
|
||||
\NEEDS CODE abort( Assembler needed )
|
||||
hex
|
||||
1 5 +thru \ load Tasker
|
||||
7 load \ Task-Demo
|
||||
decimal
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 2 Hexblock 2
|
||||
\ MULTITASKER BP 13.9.84 )
|
||||
|
||||
CODE STOP
|
||||
SP 2DEC IP LDA SP X) STA IP 1+ LDA SP )Y STA
|
||||
SP 2DEC RP LDA SP X) STA RP 1+ LDA SP )Y STA
|
||||
6 # LDY SP LDA UP )Y STA INY SP 1+ LDA UP )Y STA
|
||||
1 # LDY TYA CLC UP ADC W STA
|
||||
TXA UP 1+ ADC W 1+ STA W 1- JMP END-CODE
|
||||
|
||||
| CREATE TASKPAUSE ASSEMBLER
|
||||
2C # LDA UP X) STA ' STOP @ JMP END-CODE
|
||||
|
||||
: SINGLETASK [ ' PAUSE @ ] LITERAL ['] PAUSE ! ;
|
||||
|
||||
: MULTITASK TASKPAUSE ['] PAUSE ! ;
|
||||
|
||||
\ *** Block No. 3 Hexblock 3
|
||||
\ PASS ACTIVATE KS 8 MAY 84 )
|
||||
|
||||
: PASS ( N0 .. NR-1 TADR R -- )
|
||||
BEGIN [ ROT ( TRICK ! ) ]
|
||||
SWAP 02C OVER C! \ AWAKE TASK
|
||||
R> -ROT \ IP R ADDR
|
||||
8 + >R \ S0 OF TASK
|
||||
R@ 2+ @ SWAP \ IP R0 R
|
||||
2+ 2* \ BYTES ON TASKSTACK
|
||||
\ INCL. R0 & IP
|
||||
R@ @ OVER - \ NEW SP
|
||||
DUP R> 2- ! \ INTO SSAVE
|
||||
SWAP BOUNDS ?DO I ! 2 +LOOP ; RESTRICT
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 4 Hexblock 4
|
||||
\
|
||||
|
||||
: ACTIVATE ( TADR --)
|
||||
0 [ -ROT ( TRICK ! ) ] REPEAT ; -2 ALLOT RESTRICT
|
||||
|
||||
: SLEEP ( TADR --) 4C SWAP C! ; \ JMP-OPCODE
|
||||
|
||||
: WAKE ( TADR --) 2C SWAP C! ; \ BIT-OPCODE
|
||||
|
||||
| : TASKERROR ( STRING -)
|
||||
STANDARDI/O SINGLETASK ." TASK ERROR : " COUNT TYPE
|
||||
MULTITASK STOP ;
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 5 Hexblock 5
|
||||
\ BUILDING A TASK BP 13.9.84 )
|
||||
|
||||
: TASK ( RLEN SLEN -- )
|
||||
ALLOT \ STACK
|
||||
HERE 00FF AND 0FE =
|
||||
IF 1 ALLOT THEN \ 6502-ALIGN
|
||||
UP@ HERE 100 CMOVE \ INIT USER AREA
|
||||
HERE 04C C, \ JMP OPCODE TO SLEEP TASK
|
||||
UP@ 1+ @ ,
|
||||
DUP UP@ 1+ ! \ LINK TASK
|
||||
3 ALLOT \ ALLOT JSR WAKE
|
||||
DUP 6 - DUP , , \ SSAVE AND S0
|
||||
2DUP + , \ HERE + RLEN = R0
|
||||
UNDER + HERE - 2+ ALLOT ['] TASKERROR OVER
|
||||
[ ' ERRORHANDLER >BODY C@ ] LITERAL + ! CONSTANT ;
|
||||
|
||||
\ *** Block No. 6 Hexblock 6
|
||||
\ MORE TASKS KS/BP 26APR85RE)
|
||||
|
||||
: RENDEZVOUS ( SEMAPHORADR -) DUP UNLOCK PAUSE LOCK ;
|
||||
|
||||
| : STATESMART STATE @ IF [COMPILE] LITERAL THEN ;
|
||||
|
||||
: 'S ( TADR - ADR.OF.TASKUSERVAR)
|
||||
' >BODY C@ + STATESMART ; IMMEDIATE
|
||||
|
||||
\ SYNTAX: 2 DEMOTASK 'S BASE ! \ MAKES DEMOTASK WORKING BINARY
|
||||
|
||||
: TASKS ( -) ." MAIN " CR UP@ DUP 1+ @
|
||||
BEGIN 2DUP - WHILE
|
||||
DUP [ ' R0 >BODY C@ ] LITERAL + @ 6 + NAME> >NAME .NAME
|
||||
DUP C@ 04C = IF ." SLEEPING" THEN CR 1+ @ REPEAT 2DROP ;
|
||||
|
||||
\ *** Block No. 7 Hexblock 7
|
||||
\ TASKDEMO 27APR85RE)
|
||||
: TASKMARK ;
|
||||
|
||||
VARIABLE COUNTER COUNTER OFF
|
||||
|
||||
100 100 TASK BACKGROUND
|
||||
|
||||
: >COUNT ( N -) BACKGROUND 1 PASS COUNTER !
|
||||
BEGIN COUNTER @ DUP 1- COUNTER ! ?DUP
|
||||
WHILE PAUSE 0 <# #S #> type REPEAT stop ;
|
||||
|
||||
: WAIT BACKGROUND SLEEP ;
|
||||
|
||||
: GO BACKGROUND WAKE ;
|
||||
|
||||
|
||||
\ *** Block No. 8 Hexblock 8
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 9 Hexblock 9
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
255
sources/Apple1/tools.fth
Normal file
255
sources/Apple1/tools.fth
Normal file
|
|
@ -0,0 +1,255 @@
|
|||
\ *** Block No. 0 Hexblock 0
|
||||
\ Development Tools cas 26jan06
|
||||
|
||||
Interactive Tracer
|
||||
|
||||
One-Step Debugger
|
||||
|
||||
Traps
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1 Hexblock 1
|
||||
\ TOOLS LOADSCREEN 22MAR85RE)
|
||||
|
||||
ONLYFORTH
|
||||
|
||||
\NEEDS CODE abort( Assembler is needed )
|
||||
|
||||
VOCABULARY TOOLS
|
||||
|
||||
TOOLS ALSO DEFINITIONS
|
||||
hex
|
||||
1 &11 +THRU
|
||||
decimal
|
||||
ONLYFORTH
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 2 Hexblock 2
|
||||
\ HANDLE STEPS BP 10 02 85)
|
||||
|
||||
ASSEMBLER ALSO DEFINITIONS
|
||||
|
||||
ONLY FORTH ALSO TOOLS ALSO DEFINITIONS
|
||||
| VARIABLE (W | VARIABLE RPT
|
||||
|
||||
| CODE STEP
|
||||
RPT DEC RP X) LDA IP STA
|
||||
RP )Y LDA IP 1+ STA RP 2INC
|
||||
(W LDA W STA (W 1+ LDA W 1+ STA
|
||||
W 1- JMP END-CODE
|
||||
|
||||
| CREATE NEXTSTEP ] STEP [
|
||||
|
||||
|
||||
\ *** Block No. 3 Hexblock 3
|
||||
\ THROW STATUS ON R-STACK B 23JUL85RE)
|
||||
|
||||
| CREATE NPULL 0 ]
|
||||
RP@ COUNT 2DUP + RP! R> SWAP CMOVE ;
|
||||
|
||||
: NPUSH ( ADDR LEN -)
|
||||
R> -ROT OVER >R RP@ OVER 1+ - DUP RP! PLACE
|
||||
NPULL >R >R ;
|
||||
|
||||
| : ONELINE .STATUS SPACE QUERY INTERPRET
|
||||
-82 ALLOT RDROP ( DELETE QUIT FROM TNEXT ) ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 4 Hexblock 4
|
||||
\ TRAP AND DISPLAY KS 26MAR85RE)
|
||||
LABEL TNEXT
|
||||
IP 2INC RP LDA RPT CMP 0<> ?[
|
||||
[[ W 1- JMP SWAP ]?
|
||||
RP 1+ LDA RPT 1+ CMP 0= ?]
|
||||
LABEL DOTRACE
|
||||
RPT INC ( DISABLE TRACER )
|
||||
W LDA (W STA W 1+ LDA (W 1+ STA
|
||||
;C: R@ NEXTSTEP >R
|
||||
INPUT PUSH KEYBOARD
|
||||
OUTPUT PUSH DISPLAY
|
||||
CR 2- DUP 4 U.R @ DUP 5 U.R 2 SPACES
|
||||
>NAME .NAME 1C COL - 0 MAX SPACES .S
|
||||
STATE PUSH BLK PUSH >IN PUSH
|
||||
[ ' 'QUIT >BODY ] LITERAL PUSH
|
||||
[ ' >INTERPRET >BODY ] LITERAL PUSH
|
||||
\ *** Block No. 5 Hexblock 5
|
||||
\
|
||||
#TIB PUSH TIB #TIB @ NPUSH R0 PUSH
|
||||
RP@ R0 ! 082 ALLOT
|
||||
['] ONELINE IS 'QUIT QUIT ; -2 ALLOT
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 6 Hexblock 6
|
||||
\ TRACER COMMANDS BP 23JUL85RE)
|
||||
|
||||
| CODE (TRACE TNEXT 0 100 M/MOD
|
||||
# LDA NEXT 0C + STA
|
||||
# LDA NEXT 0B + STA
|
||||
04C # LDA NEXT 0A + STA NEXT JMP END-CODE
|
||||
|
||||
: TRACE' RP@ 2- RPT ! ' (TRACE EXECUTE END-TRACE ;
|
||||
|
||||
: BREAK RP@ 2+ RPT ! (TRACE ; RESTRICT
|
||||
|
||||
: TRACEL: CREATE , DOES> @ RPT +! ;
|
||||
|
||||
-6 TRACEL: +DO 6 TRACEL: -DO
|
||||
-2 TRACEL: +R 2 TRACEL: -R
|
||||
-6 TRACEL: +PUSH 6 TRACEL: -PUSH
|
||||
\ *** Block No. 7 Hexblock 7
|
||||
\ WATCH TRAP BP 10 02 85 )
|
||||
|
||||
| VARIABLE WATCHPT 2 ALLOT
|
||||
|
||||
LABEL WNEXT IP 2INC
|
||||
WATCHPT LDA N STA WATCHPT 1+ LDA N 1+ STA
|
||||
N X) LDA WATCHPT 2+ CMP 0<> ?[
|
||||
[[ RP LDA RPT STA RP 1+ LDA RPT 1+ STA
|
||||
( SET TO TNEXT) TNEXT 0 100 M/MOD
|
||||
# LDA NEXT 0C + STA # LDA NEXT 0B + STA
|
||||
DOTRACE JMP SWAP ]?
|
||||
N )Y LDA WATCHPT 3 + CMP 0= ?] W 1- JMP END-CODE
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 8 Hexblock 8
|
||||
\ WATCH COMMANDS BP 10 02 85 )
|
||||
|
||||
| CODE (WATCH WNEXT 0 100 M/MOD
|
||||
# LDA NEXT 0C + STA
|
||||
# LDA NEXT 0B + STA
|
||||
04C # LDA NEXT 0A + STA NEXT JMP END-CODE
|
||||
|
||||
: WATCH' ( ADR -- )
|
||||
DUP WATCHPT ! @ WATCHPT 2+ ! ' (WATCH EXECUTE END-TRACE ;
|
||||
|
||||
: CONT ( -) WATCHPT @ @ WATCHPT 2+ ! (WATCH ;
|
||||
|
||||
( SYNTAX : <VARNAME> WATCH' <PROCEDURE> )
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 9 Hexblock 9
|
||||
\ TOOLS FOR DECOMPILING, KS 4 APR 83 )
|
||||
( INTERACTIVE USE )
|
||||
| : ?: DUP 4 U.R ." :" ;
|
||||
| : @? DUP @ 6 U.R ;
|
||||
| : C? DUP C@ 3 .R ;
|
||||
| : BL 024 COL - 0 MAX SPACES ;
|
||||
|
||||
: S ( ADR - ADR+) ( PRINT LITERAL STRING)
|
||||
?: SPACE C? 4 SPACES DUP COUNT TYPE
|
||||
DUP C@ + 1+ BL ; ( COUNT + RE)
|
||||
|
||||
: N ( ADR - ADR+2) ( PRINT NAME OF NEXT WORD BY ITS CFA)
|
||||
?: @? 2 SPACES DUP @ >NAME .NAME 2+ BL ;
|
||||
|
||||
: L ( ADR - ADR+2) ( PRINT LITERAL VALUE) ?: @? 2+ BL ;
|
||||
|
||||
\ *** Block No. 10 Hexblock A
|
||||
\ TOOLS FOR DECOMPILING, INTERACTIVE )
|
||||
|
||||
: D ( ADR N - ADR+N) ( DUMP N BYTES)
|
||||
2DUP SWAP ?: 3 SPACES SWAP 0 DO C? 1+ LOOP
|
||||
4 SPACES -ROT TYPE BL ;
|
||||
|
||||
: C ( ADR - ADR+1) ( PRINT BYTE AS UNSIGNED VALUE) 1 D ;
|
||||
|
||||
: B ( ADR - ADR+2) ( PRINT BRANCH TARGET LOCATION )
|
||||
?: @? DUP @ OVER + 6 U.R 2+ BL ;
|
||||
|
||||
( USED FOR : )
|
||||
( NAME STRING LITERAL DUMP CLIT BRANCH )
|
||||
( - - - - - - )
|
||||
|
||||
|
||||
\ *** Block No. 11 Hexblock B
|
||||
\ DEBUGGING UTILITIES BP 19 02 85 )
|
||||
|
||||
: UNRAVEL \ UNRAVEL PERFORM (ABORT"
|
||||
RDROP RDROP RDROP CR ." TRACE DUMP IS " CR
|
||||
|
||||
BEGIN RP@ R0 @ -
|
||||
WHILE R> DUP 8 U.R SPACE 2- @ >NAME .NAME CR
|
||||
REPEAT (ERROR ;
|
||||
|
||||
' UNRAVEL ERRORHANDLER !
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 12 Hexblock C
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 13 Hexblock D
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 14 Hexblock E
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user