diff options
Diffstat (limited to 'lang/basic')
| -rw-r--r-- | lang/basic/1.8.7/doc/basic handbuch.1 | 1075 | ||||
| -rw-r--r-- | lang/basic/1.8.7/doc/basic handbuch.2 | 2441 | ||||
| -rw-r--r-- | lang/basic/1.8.7/doc/basic handbuch.3 | 698 | ||||
| -rw-r--r-- | lang/basic/1.8.7/doc/basic handbuch.index | 232 | ||||
| -rw-r--r-- | lang/basic/1.8.7/source-disk | 1 | ||||
| -rw-r--r-- | lang/basic/1.8.7/src/BASIC.Administration | 1886 | ||||
| -rw-r--r-- | lang/basic/1.8.7/src/BASIC.Compiler | 2305 | ||||
| -rw-r--r-- | lang/basic/1.8.7/src/BASIC.Runtime | 1571 | ||||
| l--------- | lang/basic/1.8.7/src/eumel coder 1.8.1 | 1 | ||||
| -rw-r--r-- | lang/basic/1.8.7/src/eumel0 codes | bin | 0 -> 512 bytes | |||
| -rw-r--r-- | lang/basic/1.8.7/src/gen.BASIC | 80 |
11 files changed, 10290 insertions, 0 deletions
diff --git a/lang/basic/1.8.7/doc/basic handbuch.1 b/lang/basic/1.8.7/doc/basic handbuch.1 new file mode 100644 index 0000000..2e604cb --- /dev/null +++ b/lang/basic/1.8.7/doc/basic handbuch.1 @@ -0,0 +1,1075 @@ +____________________________________________________________________________ + + +#on("b")##on ("u")# +#center#Betriebssystem E U M E L +#off ("u")# + + +#center#Basic + + + + +#off("b")# +#center#Lizenzfreie Software der +#on ("b")# + +#center#Gesellschaft für Mathematik und Datenverarbeitung mbH, +#center#5205 Sankt Augustin + + +#off("b")# +#center#Die Nutzung der Software ist nur im Schul- und Hochschulbereich für +#center#nichtkommerzielle Zwecke gestattet. + +#center#Gewährleistung und Haftung werden ausgeschlossen + + +____________________________________________________________________________ +#page# +#page nr ("%", 1)# +#head# +EUMEL-BASIC-Compiler Inhalt % +#end# + +Inhalt + +1 Einleitung 3 + +2 Installation des BASIC-Compilers 4 + +3 Aufruf und Steuerung des BASIC-Compilers 5 + +4 Umgang mit dem BASIC-Compiler 7 +4.1 Erläuterungen zur Syntax 7 +4.2 Datentypen und Konstanten 10 +4.3 Variablen und Felder 12 +4.4 Operatoren 14 +4.5 Funktionen 19 +4.6 Typanpassung 22 +4.7 Aufruf von EUMEL-Prozeduren in BASIC-Programmen 23 + +5 Steuerung der Bildschirmausgaben 25 + +6 Grenzen des Compilers 26 + +7 Fehlerbehandlung 28 +7.1 Fehler zur Übersetzungszeit 28 +7.2 Fehler zur Laufzeit 30 + +8 Übersicht über die Anweisungen und Funktionen 31 + +9 Anpassung von Programmen an den EUMEL-BASIC-Compiler 96 +9.1 Unterschiede zwischen BASIC-Interpretern + und dem EUMEL-BASIC-Compiler 96 +9.2 Abweichungen von ISO 6373-1984 (Minimal-BASIC) 97 +9.3 Anpassung von Microsoft-BASIC Programmen + an den EUMEL-BASIC-Compiler 98 + +Anhang A: Reservierte Wörter 100 +Anhang B: Vom Scanner erkannte Symboltypen 103 +Anhang C: Übersicht über die Fehlermeldungen 106 +Anhang D: ELAN-Prozeduren des Compilers 113 +#page# + + +#page nr ("%", 3)# +#head# +EUMEL-BASIC-Compiler 1. Einleitung % + +#end# + +1. Einleitung + + +BASIC entspricht heute nicht mehr den Vorstellungen von einer modernen Program +miersprache. Dennoch wurde für das EUMEL-Betriebssystem ein Compiler für BASIC +entwickelt. Er soll vor allem dazu dienen, schon bestehende BASIC-Programme - +gegebenenfalls nach entsprechender Anpassung - auch unter EUMEL verfügbar zu +machen. +Der Compiler ist weitgehend an die ISO-Norm 6373 für Minimal-BASIC angelehnt. +Die Syntax und Bedeutung der Anweisungen orientiert sich in den meisten Fällen an +Microsoft-BASIC. Anweichungen treten insbesondere an den Stellen auf, an denen +Prinzipien des Betriebssystems EUMEL verletzt würden. +Verglichen mit dem ELAN-Compiler des EUMEL-Systems ist der BASIC-Compiler +beim Übersetzen recht langsam. Auch aus diesem Grund scheint es nicht sinnvoll, +den BASIC-Compiler zur Neuentwicklung größerer Programme einzusetzen. + +Sinn dieses Handbuchs ist es vor allem, Kenntnisse über den Umgang mit dem +EUMEL-BASIC-Compiler zu vermitteln. Das Handbuch ist auf keinen Fall als Ein +führung in die Programmiersprache BASIC gedacht, sondern es soll dem Benutzer mit +BASIC-Erfahrung die Arbeit mit dem EUMEL-BASIC-Compiler ermöglichen und +erleichtern. Neben Erfahrung in BASIC setzt dieses Buch an einigen Stellen auch +Grundkenntnisse über das EUMEL-System voraus. + + + +Zur #ib(4)#Notation#ie(4)# in dieser Beschreibung + +Bei der Beschreibung der Anweisungen und Funktionen und auch an anderen Stellen +werden in dieser Beschreibung Syntaxregeln für BASIC-Programme oder Teile davon +angegeben. Dabei werden folgende Zeichen mit besonderer Bedeutung verwendet: + +[ ] optionale Angabe +[...] beliebig häufige Wiederholung der letzten optionalen Angabe +| alternative Angabe, d.h. entweder die letzte links stehende Angabe oder + die nächste rechts stehende Angabe, aber nicht beide +< > in spitzen Klammern stehende Begriffe sind entweder definiert (z.B. <Va + riable>) oder werden hinter der Syntaxregel erläutert + +Die Notation der exportierten ELAN-Prozeduren des Compilers (besonders in An +hangD) entspricht der in den EUMEL-Handbüchern üblichen Prozedurkopf- +Schreibweise. +#page# +#head# +EUMEL-BASIC-Compiler 2. Installation des BASIC-Compilers % + +#end# + +2. #ib(3)#Installation des BASIC-Compilers#ie(3)# + + +Der EUMEL-BASIC-Compiler wird auf zwei Disketten mit jeweils 360 KByte +Speicherkapazität ausgeliefert. +Auf der Diskette "BASIC.1" befindet sich das #ib(3)#Generatorprogramm#ie(3)#("gen.BASIC") zur +Installation des EUMEL-BASIC-Systems. +Legen Sie diese Diskette in das Laufwerk ihres Rechners ein und geben Sie in der +Task, in der das BASIC-System installiert werden soll, folgende Zeile nach 'gib +kommando :' (oder 'maintenance :') ein: + +archive ("BASIC.1"); fetch ("gen.BASIC", archive); run + +Lassen Sie die Diskette 'BASIC.1' im Laufwerk und antworten Sie auf die Frage +"Archiv "BASIC.1" eingelegt(j/n)?" mit "j". Das Generatorprogramm holt nun einige +Dateien von der Diskette. Nach Zugriff auf das Archiv erscheint die Meldung "Archiv +abgemeldet!" und die Frage "Archiv 'BASIC.2' eingelegt(j/n)?". Legen Sie nun statt +des Archivs 'BASIC.1' das Archiv 'BASIC.2' in das Laufwerk ein und drücken Sie bitte +wiederum "j". Nach weiteren Archivoperationen erscheint dann wieder die Meldung +"Archiv abgemeldet". Sie können nun die Diskette "BASIC.2" aus dem Laufwerk +entnehmen. +Das Generatorprogramm insertiert nun alle Programme des BASIC-Systems in der +Task. Dieser Vorgang nimmt einige Zeit in Anspruch. Zum Abschluß erscheint die +Meldung "BASIC-System installiert". +Der EUMEL-BASIC-Compiler steht Ihnen nun in der Task (und in nachfolgend +eingerichteten Söhnen) zur Verfügung. +#page# +#head# +EUMEL-BASIC-Compiler 3. Aufruf und Steuerung des BASIC-Compilers % + +#end# + +3. #ib(4)#Aufruf und #ib(3)#Steuerung des BASIC-Compilers#ie(3)##ie(4)# + + + + +Übersetzen von BASIC-Programmen + +Ein BASIC-Programm, das vom Compiler übersetzt werden soll, muß sich dazu in +einer EUMEL-Textdatei befinden (Syntax vgl. Kap. 4.). Steht das BASIC-Programm +zum Beispiel in der Datei "Programm.17+4", so wird der Compiler mit + + #ib(3)#basic#ie(3)# ("Programm.17+4") + +zum Übersetzen dieses Programms aufgerufen. +In einem Vordurchlauf werden die Zeilennummern des Programms auf Richtigkeit +überprüft. Beim eigentlichen Compilerdurchlauf wird das BASIC-Programm dann mit +Hilfe des EUMEL-Coders in einen von der EUMEL-0-Maschine ausführbaren Code +übersetzt. + +Das Programm wird mit 'check on' (Zeilennummergenerierung) übersetzt. +Ein 'runagain' wie bei ELAN-Programmen ist bei BASIC-Programmen zur Zeit +leider nicht möglich. + + + +Insertieren von BASIC-Programmen + +Der BASIC-Compiler kann BASIC-Programme auch insertieren. Das ganze Pro +gramm bildet dabei eine Prozedur, die nach dem Insertieren wie eine 'normale' +ELAN-Prozedur aufgerufen werden kann. +Zum Insertieren wird der Compiler mit einem zusätzlichen Text-Parameter aufge +rufen: + + #ib(3)#basic#ie(3)# ("Programm.17+4", "blackjack") + +Das Programm wird übersetzt und, falls keine Fehler gefunden wurden, fest einge +tragen ('insertiert'). Gestartet wird das Programm aber nicht. +"blackjack" ist nun der Prozedurname, unter dem das BASIC-Programm nach erfolg +reichem Insertieren aufgerufen werden kann. +Bei 'packets' erscheint jetzt der Eintrag 'BASIC.blackjack' in der Liste der insertierten +Pakete, und ein 'help ("blackjack")' zeigt, daß eine Prozedur 'blackjack' nun tatsäch +lich in der Task bekannt ist. Die Prozedur 'bulletin' funktioniert für insertierte +BASIC-Programme nicht. Sie ist aber auch nicht nötig, da das 'Paket' mit dem +BASIC-Programm ohnehin nur eine Prozedur enthält und ihr Name ja schon aus +dem Namen des Paketes hervorgeht. + +#on ("b")# +Beachten Sie: + - Der Prozedurname muß der Syntax für ELAN-Prozedurnamen entsprechen, darf + aber #on ("b")#keine Leerzeichen enthalten. + - Die BASIC-Programme können über den Prozedurnamen nur aufgerufen wer + den; die Übergabe von Parametern ist ebenso wie Wertlieferung nicht möglich. + - Jedes Insertieren belegt Speicherplatz im Codebereich der Task. Weil der Coder + und der Compiler ebenfalls recht viel Code belegen, kann es (vor allem, wenn + die BASIC-Programme lang sind) schnell zu einem Code-Überlauf kommen + (Compiler Error 305). Es sollten daher nur die Programme insertiert werden, für + die dies wirklich nötig ist. + - Achten Sie bei der Wahl des Namens für die gelieferte Prozedur darauf, daß sie + nicht ungewollt Prozeduren des Betriebssystems überdecken. (Der Aufruf 'ba + sic("tadellos","help")' wäre z.B. gar nicht tadellos, denn 'help' wäre nach dem + Insertieren überdeckt). + - Auch beim Insertieren werden die BASIC-Programme mit 'check on' übersetzt. +#off ("b")# + + +Ausgabe der übersetzten Zeilen während des +Compilierens +Mit '#ib(3)#basic list#ie(3)# (TRUE)' wird der Compiler so eingestellt, daß beim Übersetzen die +aktuelle Programmzeile ausgegeben wird. Diese Ausgabe kann auch mit '#ib(3)#sysout#ie(3)#' +umgeleitet werden. Zum Beispiel: + + sysout ("Fehlerprotokoll"); basic ("Programm.17+4") + +Dies kann beim #ib(3)#Debugging#ie(3)# von BASIC-Programmen eine wertvolle Hilfe sein, da in +der Ausgabedatei die Fehler sofort hinter der betreffenden Programmzeile vermerkt +werden. Das 'sysout' muß in Monitortasks ('gib kommando:') direkt vor dem Aufruf +des Compilers gegeben werden, weil der Monitor 'sysout' sonst wieder zurücksetzt. + +Mit 'basic list (FALSE)' kann die Ausgabe der Programmzeilen beim Übersetzen +wieder ausgeschaltet werden. + +#page# +#head# +EUMEL-BASIC-Compiler 4. Umgang mit dem BASIC-Compiler % + +#end# + +4. Umgang mit dem BASIC-Compiler + + + +4.1. Erläuterungen zur #ib(3)#Syntax#ie(3)# + + +Ein zu übersetzendes Programm muß dem BASIC-Compiler in Form einer +#ib(3)#EUMEL-Textdatei#ie(3)# übergeben werden. (Es gelten somit auch die für EUMEL-Text +dateien üblichen Begrenzungen, z.B. höchstens 32000 Zeichen pro Zeile und höch +stens 4075 Dateizeilen pro Datei.) +BASIC-Programme setzen sich aus Programmzeilen zusammen; jede Dateizeile der +#ib(3)#Programmdatei#ie(3)# bildet eine BASIC-Programmzeile. Die Syntax für ein Programm sieht +damit so aus: + + +<Programmzeile>[<Programmzeile>][...]EOF + +Dabei bedeutet #ib(3)#EOF (end of file)#ie(3)# das Ende der Programmdatei. + +Eine #ib(3)#Programmzeile#ie(3)# hat folgende Syntax: + + +[<Zeilennummer>][<Anweisung>][:<Anweisung>][...][:]EOL + +Die #ib(3)#Zeilennummer#ie(3)# dient unter anderem als Sprungadresse an den Anfang der Pro +grammzeile während der Laufzeit des Programms (vgl. 'GOTO' und 'GOSUB'). Sie ist +fakultativ (d.h. sie muß nicht geschrieben werden). Durch sparsame Verwendung von +Zeilennummern (nämlich nur da, wo sie benötigt werden) kann eine gewisse Steige +rung der #ib(3)#Übersichtlichkeit von BASIC-Programmen#ie(3)# erreicht werden. Hat eine Pro +grammzeile keine Zeilennummer, so wird bei Fehlermeldungen (sowohl während der +Übersetzung als auch zur Laufzeit des Programms) die letzte Zeilennummer mit +angegeben, die davor auftrat. +Zeilennummern dürfen im Bereich von 1 bis 32767 liegen und müssen unbedingt in +aufsteigender Reihenfolge vergeben werden. Zeilennummern dürfen keine Leerzeichen +enthalten und müssen mit einem Leerzeichen abgeschlossen werden. Um spätere +Ergänzungen zu ermöglichen, ist eine Numerierung im Abstand zehn empfehlenswert. + +Hier ein Beispiel, wie ein BASIC-Programm in einer EUMEL-Datei aussehen +könnte: + + +...........................Einmaleins............................ +10 CLS: PRINT "Kleines Einmaleins" + FOR zahl% = 1 TO 10 + PRINT + 'Erzeugung einer Zeile + FOR faktor% = 1 TO 10 + PRINT TAB (faktor% * 5); + PRINT USING "\#\#\#"; faktor% * zahl%; + NEXT faktor% + NEXT zahl% + + + + +Die Syntax der Anweisungen, die vom EUMEL-BASIC-Compiler übersetzt werden +können, ist ausführlich im Kapitel 8 beschrieben. + +Der #ib(3)#Doppelpunkt#ie(3)# dient als Trennzeichen zwischen Anweisungen. Ihm muß nicht +unbedingt eine Anweisung folgen. Er kann somit als explizites "Ende der +Anweisung"-Symbol aufgefaßt werden (#ib(3)#EOS, "end of statement"#ie(3)#). + +#ib(3)#EOL (end of line)#ie(3)# ist das Ende einer Dateizeile. (Dieses "Zeichen" ist ebenso wie +EOF beim Editieren der Datei nicht sichtbar.) +Das #ib(3)#Hochkomma#ie(3)# ("'", Code 39) wird vom Compiler ebenfalls als EOL interpretiert. +Alle dem Hochkomma in der Dateizeile folgenden Zeichen werden überlesen. Dies +ermöglicht das Schreiben von Kommentaren ohne Verwendung der +'REM'-Anweisung. + +Es sei hier bereits bemerkt, daß sich durch die Realisierung des Übersetzers als +#on ("b")#Compiler gewisse Unterschiede gegenüber Interpretern #off ("b")#ergeben (siehe hierzu Kap. 9). +Der wesentliche Unterschied ist, daß der Interpreter dem Programmtext analog zum +Programmablauf folgt, der Compiler das Programm aber von vorne bis hinten Zeile für +Zeile übersetzt. Dies hat zur Folge, daß z.B. die Dimensionierungen von Feldvariablen +#on ("b")#textuell vor der Verwendung der Variablen stattfinden müssen#off ("b")# und nicht, wie bei +Interpretern, nur im Ablauf des Programms vorher ausgeführt werden müssen. + + + +Weitere Schreibregeln + +#on ("b")# +1. #ib(3)#Groß-/Kleinschreibung#ie(3)##off ("b")# +Für den BASIC-Compiler bestehen zwischen kleinen und großen Buchstaben keiner +lei Unterschiede, es sei denn es handelt sich um Textdenoter (Textkonstanten). +Daher können alle #ib(3)#Schlüsselwörter#ie(3)# und #ib(3)#Variablennamen#ie(3)# mit kleinen oder großen +Buchstaben geschrieben werden. Aus der Tatsache, daß zwischen großen und kleinen +Buchstaben nicht unterschieden wird, folgt aber bespielsweise auch, daß die Variab +lennamen (vgl. 4.3.) 'hallo' und 'HALLO' ein und dieselbe Variable bezeichnen. + +#on ("b")# +2. #ib(3)#Reservierte Wörter#ie(3)##off ("b")# +Der BASIC-Compiler erkennt eine ganze Reihe #on("i")#reservierter Wörter#off("i")#. Es handelt sich +hierbei im wesentlichen um die Namen der Anweisungen und Funktionen. Sie sollten +im eigenen Interesse darauf achten, daß sich sowohl vor als auch hinter reservier +ten Wörtern stets mindestens ein #on ("b")##ib(3)#Leerzeichen#ie(3)##off ("b")# (Blank) befindet. Der #ib(3)#Scanner#ie(3)# (ver +gleiche AnhangB) erkennt zwar manchmal die reservierten Wörter auch ohne Leer +zeichen, aber unter bestimmten Umständen kann es auch zu erkannten oder - noch +schlimmer - vom Compiler unerkannten Fehlern kommen. +Hierzu zwei Beispiele: +Die Anweisung 'IF a > b THENPRINT "größer"' führt beim Compilieren zur Fehler +meldung "Syntaxfehler: THEN oder GOTO erwartet". +Wesentlich gefährlicher ist da schon die Programmzeile + "LEThallo = 3 : PRINT hallo", +denn die unerwartete Wirkung ist die Ausgabe von "0" auf dem Bildschirm. Der Wert +"3" wurde nämlich nicht der Variablen mit dem Namen "hallo" zugewiesen, sondern +einer Variablen namens "LEThallo". + +#on ("b")# +3. Bedeutung der #ib(3)#Leerstelle#ie(3)# ("Blank") für den Compiler#off("b")# +Wie schon aus dem vorhergehenden Punkt ersichtlich kann das Fehlen von trennen +den Leerstellen unschöne Effekte haben, denn der #ib(3)#Scanner#ie(3)# (vgl. AnhangB) des +BASIC-Compilers erkennt anhand der Leerstelle (Code 32) beim Durchlauf durch das +Programm, daß ein #ib(3)#Symbol#ie(3)# zu Ende ist. +Es kommt somit immer dann zu Fehlern, wenn zwei Symbole (z.B. reservierte Wörter, +Konstanten, Variablen etc.) nicht durch Leerzeichen getrennt sind, und der Scanner +sie als ein Symbol "versteht". +Beispiel: + "a = 3 : b = 4 : PRINT a b" erzeugt die Ausgabe "34". + "a = 3 : b = 4 : PRINT ab" erzeugt hingegen die Ausgabe "0", denn der +Compiler sieht "ab" als #on ("b")#einen Variablennamen an. #off ("b")# + + + +4.2. #ib(3)#Datentypen#ie(3)# und #ib(3)#Konstanten#ie(3)# + + +Der EUMEL-BASIC-Compiler unterscheidet grundsätzlich zwischen zwei Daten +typen, nämlich zwischen #ib(3)#Texte#ie(3)#n und #ib(3)#Zahlen#ie(3)#. + +#on ("b")# +#ib(3)#Datentyp TEXT#ie(3)# #off ("b")# +Texte dürfen alle Zeichen enthalten (Codes 0 bis 255) und bis zu 32000 Zeichen lang +sein. +Die zugehörigen Konstanten werden von #ib(3)#Anführungszeichen#ie(3)# begrenzt, z.B.: + "Anzahl Einträge: " + "2.32 DM" + "General-Musik-Direktor" +Anführungszeichen (Code 34) dürfen #on("i")#innerhalb#off("i")# von Text-Konstanten nicht vor +kommen. + +Bei Zahlen unterscheidet der Compiler noch zwischen #ib(3)#INTs#ie(3)# (#ib(3)#Ganzzahlen#ie(3)#) und REALs +(#ib(3)#Gleitkommazahlen#ie(3)#). Diese entsprechen im Hinblick auf den Wertebereich genau den +in ELAN bekannten INTs und REALs. + +#on ("b")# +#ib(3)#Datentyp INT#ie(3)# #off ("b")# +INT-Werte dürfen zwischen -32768 und 32767 liegen. INT-Konstanten dürfen aber +#on("i")#nur#off("i")# aus Ziffern und einem optionalen '%'-Zeichen am Ende bestehen. Das bedeutet, +daß die INT-Konstanten im Bereich von 0 bis 32767 liegen können. +Ein nachgestelltes '%'-Zeichen kennzeichnet eine Konstante nochmals explizit als +INT. (Diese Option wurde aus Kompatibilitätsgründen implementiert.) + +#on ("b")# +#ib(3)#Datentyp REAL#ie(3)# #off ("b")# +REALs können Werte zwischen -9.999999999999*10#u#126#e# und +9.999999999999*10#u#126#e# annehmen. +Die kleinste positive von Null verschiedene Zahl ist 9.999999999999*10#u#-126#e#. +Der kleinste REAL-Wert mit x + 1.0 > 1.0 ist gleich 10#u#-12#e#. +REAL-Konstanten werden gebildet aus Vorkommastellen, Dezimalpunkt, Nachkom +mastellen, Zeichen "E" oder "D" (jeweils auch klein) für den #ib(3)#Exponent#ie(3)#en gefolgt vom +Vorzeichen und den Ziffern des Exponenten. +Dabei müssen nicht für jede REAL-Konstante alle diese Elemente benutzt werden. +Unverzichtbar sind #on("i")#entweder#off("i")# der Dezimalpunkt #on("i")#oder#off("i")# der Exponent. Ebenso müssen +zumindest entweder Vor- oder Nachkommastellen vorhanden sein. + +Beispiele für gültige REAL-Konstanten sind: + 0. + .01 + 1E-17 + 2.9979D8 + .3e-102 + 100.e+7 + +Nicht erlaubt sind dagegen folgende Schreibweisen für REAL-Konstanten: + e12 (#ib(3)#Mantisse#ie(3)# fehlt) + 100 (ist INT-Konstante) + . (weder Vor- noch Nachkommastellen) + .E-12 (dito) + 1exp-3 ('exp' nicht erlaubt) + -1.99e30 (Mantisse hat Vorzeichen) + +Das letzte Beispiel zeigt, daß auch vor REAL-Konstanten keine #ib(3)#Vorzeichen#ie(3)# erlaubt +sind. Da normalerweise keine REAL-Konstanten, sondern vielmehr numerische +Ausdrücke verlangt werden, können durch Voranstellen des Operators '-' (vgl. 4.4.) +auch #ib(3)#negative Zahlenwerte#ie(3)# leicht erzeugt werden. + +An REAL-Konstanten darf eines der Zeichen "!" und "\#" angehängt werden. Diese +Option wurde aus Kompatibilitätsgründen eingebaut. Wird ein "!" oder "\#" an eine +INT-Konstante angehängt, so verwandelt es diese in eine REAL-Konstante. +Beispiel: 10000! oder 10000\# entspricht 10000. oder 1E4 + + +#page# + +4.3. Variablen und Felder + + +Variablen + +Der BASIC-Compiler stellt für die in 4.2. vorgestellten Datentypen TEXT, INT und +REAL auch Variablen zur Verfügung. +Die #ib(3)#Variablennamen#ie(3)# müssen folgenden Bedingungen genügen: +- Ein Variablenname muß mit einem Buchstaben beginnen. +- Variablennamen dürfen ab der zweiten Stelle außer Buchstaben auch Ziffern, Dezi + malpunkte sowie die Zeichen "!", "\#", "$" und "%" enthalten. Leerzeichen dürfen + in Variablennamen dagegen nicht vorkommen. +- Variablennamen dürfen nicht mit FN beginnen (vgl. 4.5. benutzer-definierte Funk + tionen). +- #ib(3)#Reservierte Wörter#ie(3)# (siehe Anhang A) dürfen kein Variablenname sein. Als Teiltexte + dürfen reservierte Wörter aber in Variablennamen enthalten sein (auch am Anfang). + +Variablennamen dürfen beliebig lang sein, und alle Zeichen eines Variablennamens +sind signifikant. + +Welchen Typ eine Variable hat, entscheidet der Compiler nach folgenden #ib(3)#Kriterien#ie(3, " für den Typ einer Variablen")# (in +der Reihenfolge ihrer Beachtung): +- Ist das letzte Zeichen des Namens ein "!" oder "\#", so bezeichnet er eine + REAL-Variable. +- Ist das letzte Zeichen ein "%", so handelt es sich um eine INT-Variable. +- Ist das letzte Zeichen des Namens ein "$", so ist die Variable vom Typ TEXT. +- Liegt das erste Zeichen des Namens im Bereich der mit einer #ib(3)#DEFINT#ie(3)#-Anweisung + (vgl. Kap. 8) festgelegten Buchstaben, so ist die Variable eine INT-Variable. +- Liegt das erste Zeichen im Bereich der mit einer #ib(3)#DEFSTR#ie(3)#-Anweisung (vgl. Kap. 8) + festgelegten Buchstaben, so handelt es sich um eine TEXT-Variable. +- Wenn keine der obigen Bedingungen erfüllt ist, dann bezeichnet der Name eine + Variable des Datentyps REAL. + +Variablen, denen noch kein Wert zugewiesen wurde, haben den Inhalt null (bei INT +und REAL) beziehungsweise Leertext (bei TEXT). + + + +Felder (#ib(4)#Arrays#ie(4)#) + +Ein Feld (Array) ist eine Ansammlung von mehreren Variablen gleichen Typs. Jedes +Feld hat einen Namen. Für die #ib(3)#Feldnamen#ie(3)# gelten die gleichen Regeln wie für die +Namen von normalen Variablen. Auch die Datentypen werden nach den gleichen +Kriterien bestimmt wie bei einfachen Variablen. +In einem Feld können die Elemente in bis zu 100 #ib(3)#Dimensionen#ie(3)# abgelegt werden. Auf +ein Element eines Feldes wird über den Feldnamen und den Index / die #ib(3)#Indizes#ie(3)# des +Elements zugegriffen. Beim Zugriff auf das Element müssen so viele Indizes ange +geben werden, wie das Feld Dimensionen hat. +Beispiel: +Das Feld 'tabelle' habe zwei Dimensionen. Mit 'tabelle (3, 5)' wird auf das Element +mit dem Index 3 in der ersten Dimension und dem Index 5 in der zweiten Dimension +zugegriffen. + +Beim ersten Zugriff auf ein Element eines Feldes wird anhand der Zahl der Indizes +die Anzahl der Dimensionen festgestellt und das Feld so eingerichtet, daß in jeder +Dimension der größte Index zehn ist. +Soll ein Feld mit anderen größten Indizes eingerichtet werden, so muß hierzu die +#ib(3)#DIM#ie(3)#-Anweisung verwendet werden (siehe Kapitel 8). + +Der kleinste Index ist voreingestellt auf null, kann aber mit der #ib(3)#OPTION BASE#ie(3)#- +Anweisung (vgl. Kap. 8) auch auf eins eingestellt werden. + +Die Elemente eines Feldes sind, wie auch die einfachen Variablen, mit den Werten +null (INT und REAL) beziehungsweise Leertext (TEXT) vorbesetzt, sofern ihnen noch +nichts zugewiesen wurde. + +#page# + +4.4. Operatoren + +Nachfolgend sind alle Operatoren aufgelistet, die vom EUMEL-BASIC-Compiler +übersetzt werden. + + +Arithmetische #ib(4)#Operatoren#ie(4, ", arithmetische")# + +#ib(3)##ie(3, "+")##ib(3)##ie(3, "-")##ib(3)##ie(3, "*")##ib(3)##ie(3, "/")# +#ib(3)##ie(3, "\")##ib(3)##ie(3, "MOD")##ib(3)##ie(3, "^")# + + Operand(en) Zweck Ergebnistyp + + + INT positives Vorzeichen INT + REAL positives Vorzeichen REAL + + INT, INT INT-Addition INT + REAL, REAL REAL-Addition REAL + + - INT negatives Vorzeichen INT + REAL negatives Vorzeichen REAL + + INT, INT INT-Subtraktion INT + REAL, REAL REAL-Subtraktion REAL + + * INT, INT INT-Multiplikation INT + REAL, REAL REAL-Multiplikation REAL + + / (INT, INT) #linefeed (0.5)# + REAL-Division REAL + REAL, REAL #linefeed (1.0)# + + \ INT, INT #linefeed (0.5)# + INT-Division INT + (REAL, REAL) #linefeed (1.0)# + +MOD INT, INT INT-Divisionsrest INT + REAL, REAL Divisionsrest nach REAL + Runden auf Ganzzahl (nicht INT) + + ^ (INT, INT) #linefeed (0.5)# + Potenzierung REAL + REAL, REAL #linefeed (1.0)# + + +#on ("b")# +Hinweis: #off ("b")# +Wird ein Operator mit numerischen Operanden unterschiedlichen Typs (also INT und +REAL) aufgerufen, so wird der INT-Operand nach REAL konvertiert und der Operator +mit den beiden REAL-Operanden aufgerufen. +Sind die Operandtypen in Klammern angegeben, so werden vor Ausführung der Ope +ration die Operanden zu den nicht eingeklammerten Typen konvertiert. +Da jede #ib(3)#Konvertierung#ie(3)# Zeit benötigt, sollte der Benutzer darauf achten, daß möglichst +wenig konvertiert werden muß. +Hierzu ein (etwas extremes, aber nicht seltenes) Beispiel: +Der Aufruf a%\b bewirkt zunächst eine Konvertierung von a% nach REAL: +CDBL(a%)\b. Intern wird die Berechnung dann aber wieder mit INTs ausgeführt: +CINT(CDBL(a%))\CINT(b). Das Ergebnis wird also erst nach drei Konvertierungen +geliefert. Schreibt man dagegen sofort a%\CINT(b), dann reicht eine Konvertierung +aus. + +Es muß außerdem bei den Operatoren +, - und * für INTs darauf geachtet werden, +daß das Ergebnis innerhalb des INT-Wertebereichs liegen muß, da es sonst zu +einem #ib(3)#INT-Überlauf#ie(3)# kommt. + + + +Text-Operator #ib(4)#+#ie(4)# + +#ib(3)##ie(3, "Operatoren, Text-")# +Für Text-Manipulationen wird der Operator '+' mit zwei TEXT-Operanden zur +Verfügung gestellt. Mit '+' werden zwei Texte aneinandergehängt (konkateniert). + + + +Vergleichsoperatoren#ib(4)##ie(4, "Operatoren, Vergleichs-")# + +Im EUMEL-BASIC gibt es folgende Vergleichsoperatoren: + +#ib(3)#=#ie(3)# gleich +#ib(3)#<>#ie(3)# ungleich +#ib(3)#<#ie(3)# kleiner +#ib(3)#>#ie(3)# größer +#ib(3)#<=#ie(3)# kleiner oder gleich +#ib(3)#>=#ie(3)# größer oder gleich + +Bei den numerischen Datentypen werden mit den Vergleichsoperatoren die Zahlen +werte verglichen. +Sollen ein INT und ein REAL verglichen werden, dann wird der INT vorher nach +REAL konvertiert und ein REAL-Vergleich vorgenommen. + +Bei Texten dienen die Vergleichsoperatoren zum Vergleich der Zeichencodes. Dies +ermöglicht zum Beispiel ein alphabetisches Sortieren von Wörtern, mit der Einschrän +kung, daß Groß- und Kleinbuchstaben unterschiedliche Zeichencodes haben (ver +gleiche EUMEL-Zeichensatz-Tabelle im Benutzerhandbuch) und somit verschieden +eingeordnet werden. +Es gilt a$ < b$, wenn die Zeichenkette in a$ codemäßig vor der Zeichenkette in b$ + steht: "a" < "b" (TRUE) "aa"< "a" (FALSE) + + +Die Vergleichsoperatoren liefern, je nachdem ob die Aussage wahr oder falsch ist, die +INT-Werte 0 (falsch) oder -1 (wahr). +Anhand des Ergebnisses einer Vergleichsoperation kann zum Beispiel der Programm +ablauf gesteuert werden (siehe Kapitel 8, IF-Anweisung). + + + +Logische Operatoren + +#ib(3)##ie(3, "Operatoren, logische")# +Die logischen Operatoren haben zwei Aufgaben: +1. logische (Boolsche) Verknüpfung von #ib(3)#Wahrheitswerte#ie(3)#n, die zum Beispiel von + Vergleichsoperationen geliefert werden und +2. bitweise Ausführung von logischen Verknüpfungen auf den internen (Zweierkom + plement-) Darstellungen von INT-Werten. + +Da für beide Aufgaben die gleichen Operatoren benutzt werden, wurden für die Wahr +heitswerte die INT-Werte 0 für falsch (Bitmuster: 0000000000000000) und -1 für +wahr (Bitmuster: 1111111111111111) gewählt. + + Operand(en) Zweck insbesondere gilt + +#ib(3)#NOT#ie(3)# INT #linefeed (0.5)# NOT0->-1 + #ib(3)#Negation#ie(3)# + (REAL) #linefeed (1.0)# NOT-1->0 + +#ib(3)#AND#ie(3)# INT, INT #ib(3)#UND-Verknüpfung#ie(3)# 0AND0->0 + 0AND-1->0 + -1AND0->0 + -1AND-1->-1 + + #ib(3)#OR#ie(3)# INT, INT #ib(3)#ODER-Verknüpfung#ie(3)# 0OR0->0 + 0OR-1->-1 + -1OR0->-1 + -1OR-1->-1 + +#ib(3)#XOR#ie(3)# INT, INT #ib(3)#Exklusiv-ODER-Verknüpfung#ie(3)# 0XOR0->0 + 0XOR-1->-1 + -1XOR0->-1 + -1XOR-1->0 + +#ib(3)#EQV#ie(3)# INT, INT #ib(3)#Äquivalenz-Verknüpfung#ie(3)# 0EQV0->-1 + 0EQV-1->0 + -1EQV0->0 + -1EQV-1->-1 + +#ib(3)#IMP#ie(3)# INT, INT #ib(3)#Implikations-Verknüpfung#ie(3)# 0IMP0->-1 + 0IMP-1->-1 + -1IMP0->0 + -1IMP-1->-1 + + + +Prioritäten der Operanden + + +Hier die Übersicht über alle Operatoren in der Reihenfolge ihrer Ausführung + + + Operator Priorität + + ^ Potenzierung 13 + +, - positives/negatives Vorzeichen 12 + *, / Multiplikation, REAL-Division 11 + \ INT-Division 10 + MOD Divisionsrest- (MOD-) Operation 9 + +, - Addition, Subtraktion 8 + =, <>, <, >, <=, >= Vergleichsoperatoren 7 + NOT Negation 6 + AND UND-Verknüpfung 5 + OR ODER-Verknüpfung 4 + XOR Exklusiv-ODER-Verknüpfung 3 + EQV Äquivalenz-Verknüpfung 2 + IMP Implikations-Verknüpfung 1 + + +Die Reihenfolge der Auswertung von Ausdrücken kann durch Klammern geändert +werden. + +Beachten Sie, daß der Operator '=' in BASIC die Funktion eines Vergleichsoperators +und des #ib(3)#Zuweisungsoperators#ie(3)##ib(3)##ie(3, "Operator, Zuweisungs-")# (siehe Kapitel 8, LET-Anweisung) hat. + +#page# + +4.5. #ib(3)#Funktionen#ie(3)# + + + +Standard-Funktionen + +Der EUMEL-BASIC-Compiler unterstützt eine ganze Reihe von Funktionen. Diese +Funktionen liefern Werte und können in Ausdrücken zusammen mit Konstanten, +Variablen und Operatoren verwendet werden. +Viele der eingebauten Funktionen arbeiten mit Argumenten, das heißt es werden den +Funktionen Werte übergeben. +In Kapitel 8 dieses Handbuches sind alle Funktionen ausführlich beschrieben. +Beispiele für #ib(3)#Funktionsaufrufe#ie(3)#: + SQR (17) Dieser Ausdruck liefert die Wurzel von 17 als REAL. + RIGHT$ (text$, 5) Dieser Ausdruck liefert die letzten fünf Textzeichen +#right#aus 'text$' als TEXT. + + + +Benutzer-definierte Funktionen + +Neben der Verwendung der standardmäßig verfügbaren Funktionen besteht für den +Benutzer die Möglichkeit, selbst Funktionen innerhalb eines Programms zu definieren. + +#on ("b")# +#ib(3)#Definition benutzer-definierter Funktionen#ie(3)# #off ("b")# +Hierzu dient die #ib(3)#DEF FN#ie(3)#-Anweisung (vergleiche Kapitel 8). +Die Syntax der DEF FN-Anweisung lautet: + +DEFFN<Name>[(<Parameter>[,<Parameter>][...])]= +#right#<Funktionsdefinition> + +<Name>: Zeichenfolge, die der Syntax für Variablennamen ent + sprechen muß. + FN<Name> bilden zusammen den Namen der neuen + Funktion. +<#ib(3)#Parameter#ie(3)#>: Zeichenfolge, die der Syntax für Variablennamen ent + sprechen muß. +<Funktionsdefinition>: Ausdruck, der Konstanten, Variablen, die Parameter der + Funktion und Aufrufe anderer Funktionen enthalten + darf. + +- Die benutzer-definierten Funktionen ("user functions") liefern, genau wie die + Standard-Funktionen, Werte. +- Das letzte Zeichen des Funktionsnamens gibt den Typ des Wertes an, den die + Funktion liefert. Soll die Funktion einen TEXT liefern, so muß der Name mit "$" + enden. Soll ein INT geliefert werden, muß der Name mit "%" enden. Für alle + anderen Endungen wird eine REAL-liefernde Funktion eingetragen. +- Die Syntax der Parameternamen entspricht der Syntax für die Namen von einfachen + Variablen. +- Die Parameter haben nur bei der Definition Gültigkeit. Hierbei 'überdecken' sie (für + diese Zeile) eventuell im BASIC-Programm vorhandene gleichnamige Variablen. +- Jeder Parameter darf in der Parameterliste nur einmal vorkommen. +- Bezeichnet der Funktionsname eine TEXT-liefernde Funktion, so muß auch die + Funktionsdefinition ein Ergebnis vom Typ TEXT liefern. Zwischen INTs und REALs + findet eine Typanpassung statt. +- Eine Funktion darf nicht in ihrer eigenen Definition erscheinen. +- Eine Funktion ist allein durch ihren Namen gekennzeichnet. Generische Funktionen + (gleicher Name, aber unterschiedliche Parameter) können somit nicht definiert wer + den. + +Beispiele für gültige Funktionsdefinitionen: + DEF FNPI = 3.1415927 + DEF FNumfang (radius) = 2.0 * FNPI * radius (Enthält Aufruf von FNPI) + DEF FNhallo$ (dummy$) = "Hallo " + name$ (name$ kommt im + #right#BASIC-Programm vor) + DEF FNheavyside% (x) = ABS (SGN (x) = 1) + +Beispiele für ungültige Funktionsdefinitionen: + DEF FNfunct (a, b, a) = a ^ 2 + b (a kommt zweimal als Parameter vor) + DEF FNfr (x) = x * FNfr (x - 1) (rekursive Definition) + + +#on ("b")# +#ib(3)#Aufruf benutzer-definierter Funktionen#ie(3)# #off ("b")# + +FN<Name> [ ( <Argument> [, <Argument>] [...] ) ] + +<#ib(3)#Argument#ie(3)#> : Ausdruck, der für den entsprechenden Parameter bei der Evaluation + (Auswertung) der Funktion eingesetzt werden soll + +- Beim Funktionsaufruf werden die Argumente in der Reihenfolge ihres Auftretens für + die Parameter eingesetzt. Für TEXT-Parameter müssen die Argumente ebenfalls + TEXTe liefern. Zwischen INTs und REALs findet eine Typanpassung statt. +- Die Anzahl der Argumente muß genau mit der Anzahl der Parameter übereinstim + men. +- Für in der Funktionsdefinition vorkommende Variablen wird der zum Zeitpunkt des + Funktionsaufruf gültige Wert eingesetzt. +- Die Definition der Funktion muß dem ersten Aufruf der Funktion textuell voraus + gehen. +- Eine Definition gilt für alle textuell folgenden Aufrufe, bis die Funktion wieder neu + definiert wird. + +Beispiele für korrekte Funktionsaufrufe (bezogen auf obige Beispiel-Definitionen): + PRINT FNPI / 2.0 (Ausgabe: 1.570796) + PRINT FNumfang (20) (Ausgabe: 125.6637) + LET name$ = "Purzelbär":PRINT FNhallo$ ("") (Ausgabe: Hallo Purzelbär) + PRINT heavyside% (-17.3) (Ausgabe: 0) + +Beispiele für falsche Funktionsaufrufe (bezogen auf obige Beispiel-Definitionen): + PRINT FNPI (10) (kein Argument erwartet) + PRINT FNumfang (Argument erwartet) + PRINT FNhallo$ (zahl%) (Falscher Typ des Arguments) + PRINT FNheavyside (17.4, -12.3) (Zu viele Argumente) + + +#page# + +4.6. #ib(3)#Typanpassung#ie(3)# + + +In BASIC wird, im Gegensatz zu ELAN, nicht sehr streng zwischen den numerischen +Datentypen unterschieden, sondern es finden häufig automatische Typanpassungen +statt. Zu solchen Typanpassungen kommt es vor allem bei der Zuweisung, bei Opera +toren und bei Funktionen, aber auch bei einigen Anweisungen. +Die automatische Typanpassung hat zwei Nachteile: +1. Die Typkonvertierung von INT nach REAL und umgekehrt kostet Zeit während der + Programmausführung. +2. Es kann zu sehr unangenehmen Laufzeitfehlern kommen, wenn eine REAL- + INT-#ib(3)#Konvertierung#ie(3)# mit Fehler abbricht, weil der REAL-Wert außerhalb des + INT-Wertebereichs liegt. + +Allgemein gilt also, daß sich der Programmierer auch in BASIC über die Typen der +verwendeten Objekte im klaren sein sollte. Außerdem ist zu beachten, daß bei Konver +tierungen von REAL nach INT immer gerundet wird. + +Genaueres zur Typanpassung bei der Zuweisung finden Sie in Kapitel 8 bei der +LET-Anweisung. +Über Typkonvertierung bei Operatoren informiert Kapitel 4.4. +Informationen über die Funktionen betreffenden Typkonvertierungen befinden sich am +Anfang von Kapitel 8 und direkt bei der Beschreibung der jeweiligen Funktionen +(ebenfalls in Kapitel 8). + +#page# + +4.7. Aufruf von EUMEL-Prozeduren in + BASIC-Programmen + + + +Der EUMEL-BASIC-Compiler bietet die Möglichkeit, insertierte ELAN-Prozeduren +(und auch insertierte BASIC-Programme) in BASIC-Programmen aufzurufen. Hierzu +werden die beiden Anweisungen #ib(3)#CALL#ie(3)# und #ib(3)#CHAIN#ie(3)# (identisch) sowie die Funktion +#ib(3)#USR#ie(3)# zur Verfügung gestellt. +Mit der CALL-Anweisung (siehe auch Kapitel 8) können Prozeduren aufgerufen +werden, die keinen Wert liefern und nur die BASIC-Datentypen INT, REAL und/oder +TEXT als Parameter benötigen. +Beispiele: + CALL list + CALL taskstatus ("PUBLIC") + CALL cursor (10, 21) + CALL getcursor (x%, y%) + +Das letzte Beispiel zeigt, daß auch #ib(3)#VAR-Parameter#ie(3)# im ELAN-Sinne übergeben +werden können. + +Die Funktion USR dient im Gegensatz zu CALL zum Aufruf von #ib(3)#wertliefernden Pro +zeduren#ie(3)#. Die Prozeduren dürfen allerdings nur einen der BASIC-Datentypen INT, +REAL oder TEXT liefern. Es gilt auch bei USR, wie bei CALL, daß die aufgerufenen +Prozeduren nur Parameter der Typen INT, REAL oder TEXT haben dürfen. +Beispiele: + PRINT USR e (Ausgabe: 2.718282) + PRINT USR compress (" EUMEL ") (Ausgabe: EUMEL) + +#on ("b")# +Wichtige Hinweise zu CALL, CHAIN und USR: #off ("b")# +1. Bei den Parametern finden keinerlei Typkonvertierungen statt (ELAN- + Prozeduren werden ja gerade anhand der Typen ihrer Parameter eindeutig identifi + ziert). +2. Die Prozedurnamen nach CALL, CHAIN und USR dürfen keine Leerzeichen ent + halten, weil die Prozedur sonst nicht identifiziert werden kann. + Beispiel: CALLlernsequenzauftastelegen(...) statt + CALLlernsequenzauftastelegen(...) +3. Die Prozedurnamen können (nach BASIC-Konvention) auch Großbuchstaben + enthalten. + Beispiel: CALLcursor(17,4) ist äquivalent zu + CALLCURSOR(17,4) + + +Wie in Kapitel 3 erläutert kann ein BASIC-Programm auch insertiert werden. Somit +können mit der CALL-Anweisung auch andere (vorher insertierte) BASIC- +Programme aufgerufen werden. +Beispiel: +CALL blackjack ('blackjack' sei der Prozedurname, unter dem ein BASIC- + Programm zuvor insertiert wurde.) + +Die sonst in einigen BASIC-Dialekten vorhandene Möglichkeit, Programme oder +#ib(3)#Programmsegmente#ie(3)# nachzuladen, kann so durch Aufrufe von insertierten Programmen +nachgebildet werden. +#page# +#head# +EUMEL-BASIC-Compiler 5. Steuerung der Bildschirmausgaben % + +#end# + +5. #ib(4)#Steuerung der #ib(3)#Bildschirmausgaben#ie(3)##ie(4)# + + + +Die Ausgaben von BASIC-Programmen ('PRINT' und 'WRITE') werden im Paket +'basic output' behandelt. Dieses Paket ermöglicht unter anderem, daß die Ausgabe +auf das Terminal mit der Prozedur + + PROC #ib(3)#basic page#ie(3)# (BOOL CONST status) + +gesteuert werden können. Wird dabei 'TRUE' eingestellt, so wartet die Ausgabe bei +Erreichen der letzten Terminalzeile auf die Eingabe eines Zeichens, bevor sie fortfährt. +Das Eingabezeichen wird nach Ausgabe von ">>" in der rechten unteren Ecke des +Bildschirms erwartet und wie folgt interpretiert: + +#linefeed (1.5)# + Löschen des Bildschirms und Ausgabe der nächsten Bildschirmseite + Ausgabe der nächsten Zeile + Abbruch des Programms mit der Fehlermeldung "'halt' vom Terminal" + 'basic page' wird auf 'FALSE' gesetzt #linefeed (1.0)#und mit der normalen Ausgabe + weitergemacht + +Alle anderen Tasten bewirken eine Ausgabe der nächste Bildschirmseite (#ib(3)#Scrolling#ie(3)#). + +Ist 'basic page' auf 'FALSE' gesetzt, so kann durch Eingabe von vor einem Zei +lenwechsel 'basic page' auf 'TRUE' gesetzt werden. +#page# +#head# +EUMEL-BASIC-Compiler 6. Grenzen des Compilers % + +#end# + +6. #ib(3)#Grenzen des Compilers#ie(3)# + + +Es gibt verschiedene Grenzen, die bei der Benutzung des BASIC-Compilers erreicht +werden können. + +#on ("b")# +Grenzen des #ib(3)#EUMEL-Coder#ie(3)#s #off ("b")# +Da ein BASIC-Programm vom Compiler als eine Prozedur im Coder eingetragen +wird, darf der Code für ein BASIC-Programm die #ib(3)#Modulgrenze#ie(3)# von 7500 Byte Code +nicht überschreiten. +Sollte dies doch einmal der Fall sein (#ib(3)#Compiler Error 308#ie(3)#), so gibt es folgende +Abhilfe-Möglichkeiten: +- Zerlegen des BASIC-Programms in mehrere BASIC-Programme, wobei ein + Programm das andere während der Ausführung aufrufen kann (vgl.4.7.). + Bei dieser Methode können die Teilprogramme aber nicht mit gemeinsamen Variab + len arbeiten. +- Auslagerung von Programmteilen (z.B. Unterprogrammen) in ELAN-Prozeduren, + die insertiert und vom BASIC-Programm aufgerufen werden können (vgl.4.7.). + Dieses Verfahren bietet die Möglichkeit, Variablen zwischen BASIC-Programm und + ELAN-Prozedur über die Prozedurschnittstelle auszutauschen. + +Neben der Begrenzung des Codes ist auch die Größe des Datenspeicherbereichs pro +BASIC-Programm begrenzt. Insgesamt dürfen die Datenobjekte eines BASIC- +Programms nicht mehr als 32 KByte Speicherplatz belegen. Andernfalls kommt es +zum #ib(3)#Compiler Error 307#ie(3)#. + +Eine weitere Grenze des EUMEL-Coders stellt die maximal zulässige Anzahl der +#ib(3)#Labels#ie(3)# (interne Sprungadressen) dar. Es können nur höchstens 2000 Labels vom +Coder verwaltet werden. Der BASIC-Compiler vergibt für jede gefundene Zeile mit +Zeilennummer ein Label und benötigt auch bei Schleifen (FOR-NEXT, WHILE- +WEND), Fallunterscheidungen (IF-Anweisung), Unterprogramm-Aufrufen (GOSUB) +und bei der Definition von benutzer-definierten Funktionen (DEF) Labels. +Beim Auftreten des #ib(3)#Compiler Errors 304#ie(3)# (zu viele Label) ist Abhilfe relativ leicht +dadurch möglich, daß Zeilennummern nur den Zeilen vergeben werden, die tatsächlich +angesprungen werden (d.h. zu denen es GOTOs oder GOSUBs gibt). + +#on ("b")# +Grenzen des BASIC-Compilers #off ("b")# +Die interne #ib(3)#Namenstabelle#ie(3)# des BASIC-Compilers kann etwa 4240 Einträge aufneh +men. Ein Eintrag in dieser Tabelle wird für jede Variable, für jedes Feld, für jede +benutzer-definierte Funktion und für jeden Parameter einer benutzer-definierten +Funktion sowie für jede Konstante erzeugt. Numerische Konstanten erhalten, sofern +sie konvertiert werden müssen, sogar zwei Einträge in der Namenstabelle. +Bei Auftreten des seltenen Fehlers "volle Namenstabelle" kann durch eine Aufteilung +des BASIC-Programms in Teilprogramme oder eine Auslagerung von Unterprogram +men in ELAN-Prozeduren Abhilfe geschaffen werden. + +#on ("b")# +Sonstige EUMEL-Grenzen #off ("b")# +Außer den bisher genannten Begrenzungen sei nochmals auf die Begrenzung des +#ib(3)#Codebereichs pro Task#ie(3)# hingewiesen (maximal 256 KByte Code). +Da der EUMEL-Coder und der BASIC-Compiler recht viel Code belegen, sollte +"vorsichtig" insertiert werden, also nur das, was wirklich benötigt wird. +Auch die übrigen Grenzen des EUMEL-Systems sind zu beachten (vergleiche hierzu +die Aufstellung der möglichen Compiler Errors im EUMEL-Benutzerhandbuch)! + +#page# +#head# +EUMEL-BASIC-Compiler 7. Fehlerbehandlung % + +#end# + +7. #ib(3)#Fehlerbehandlung#ie(3)# + + +7.1. #ib(3)#Fehler zur Übersetzungszeit#ie(3)# + +Endeckt der BASIC-Compiler bei der Übersetzung eines BASIC-Programms Fehler, +so werden diese auf dem Bildschirm angezeigt und ins #ib(3)#Notebook#ie(3)# eingetragen. +Nur (syntaktisch) fehlerfreie Programme werden zur Ausführung gebracht beziehungs +weise insertiert. +Im #ib(3)#Vordurchlauf#ie(3)# werden die Zeilennummern auf Richtigkeit überprüft. Falls bereits +hiebei Fehler festgestellt werden, bricht der Compiler die Übersetzung nach dem +Vordurchlauf ab. +Im #ib(3)#Hauptdurchlauf#ie(3)# wird das Programm Zeile für Zeile auf syntaktische Richtigkeit +überprüft und gleichzeitig übersetzt. Wird dabei in einer Programmzeile ein Fehler +entdeckt, so wird er angezeigt und die Übersetzung des Programms #on("i")#in der nächsten +Programmzeile#off("i")# fortgesetzt. Eine Ausnahme von dieser Regel bildet nur die #ib(3)#DEF FN#ie(3)#- +Anweisung, bei der bei gewissen Fehlern die Übersetzung fortgesetzt wird. (Der +Grund hierfür liegt darin, daß die Folgefehlerzahl besonders bei der DEF FN- +Anweisung sehr groß wäre, wenn beim Auftreten eines Fehlers die Übersetzung der +Zeile sofort abgebrochen würde. Die Parameter würden dann nämlich nicht oder +falsch abgelegt, und bei jedem Aufruf der Funktion würde ein Fehler gemeldet.) + +Eine Übersicht über alle verwendeten Fehlermeldungen zur Übersetzungszeit befindet +sich im AnhangC. + + + +Interne Compilerfehler + +Neben den "normalen" Fehlern (siehe oben) kann es in seltenen Fällen möglicher +weise auch zu internen Fehlern kommen. +Es gibt zwei verschiedene Sorten von internen Fehlern: +1. interne Fehler, die das Compilerprogramm selbst feststellt. + Solche Fehler bewirken die Meldung "Interner Fehler !" (meist mit näherer Erläu + terung) und die Fortsetzung der Übersetzung in der nächsten Programmzeile. +2. Fehler, die in anderen Paketen des BASIC-Systems oder des EUMELs (z.B. im + EUMEL-Coder) während der Übersetzungszeit ausgelöst werden (siehe auch + Kapitel 6: "Grenzen des Compilers"). + Solche Fehler werden mit "#ib(3)#BASIC-Compiler ERROR#ie(3)#" und eventuell näheren + Angaben gemeldet. Beim Auftreten eines solchen Fehlers wird die Übersetzung + des gesamten Programms abgebrochen. + +Sollten bei Ihrer Arbeit mit dem EUMEL-BASIC-Compiler interne Fehler auftreten, +die nicht auf das Überschreiten von Compilergrenzen zurückzuführen sind, dann +wären wir Ihnen für eine Meldung der Fehler dankbar. Bitte senden Sie eine Fehler +beschreibung an: + + Gesellschaft für Mathematik und Datenverarbeitung + Schloß Birlinghoven + Postfach 1240 + 5205 Sankt Augustin 1 + +Die Fehlerbeschreibung sollte nach Möglichkeit folgende Informationen enthalten: +- verwendete Hardware +- Urlader-Version +- EUMEL-Version +- Programmtext des Programms, das den Fehler auftreten ließ +- genaue Angabe der ausgegebenen Fehlermeldung + + +#page# + +7.2. #ib(3)#Fehler zur Laufzeit#ie(3)# + +Treten während der Laufzeit eines BASIC-Programms Fehler auf, so wird die Ausfüh +rung des Programms mit einer entsprechenden Fehlermeldung abgebrochen. +Da die meisten Laufzeit-Fehlermeldungen durch Prozeduren des EUMEL-Systems +(und nicht des BASIC-Systems) erzeugt werden, entsprechen sie oft nicht der +BASIC-Terminologie. (Beispielsweise führt ein zu großer Feldindex zu der Fehlermel +dung "Ueberlauf bei Subskription".) + +Die bei Laufzeitfehlern gemeldete #ib(3)#Fehlerzeile#ie(3)# bezieht sich nicht (wie bei ELAN-Pro +grammen) auf die Nummer der Dateizeile, sondern auf die letzte der Programmzeile +vorangegangene BASIC-Zeilennummer. + +Fast alle ausgelösten Laufzeitfehler erzeugen auch #ib(3)#Fehlercodes#ie(3)#. Dabei liefern Fehler +aus EUMEL-Betriebssystem-Prozeduren die EUMEL-Standard-Fehlercodes (vgl. +Systemhandbuch), zum Beispiel wird beim Fehler "INT-Ueberlauf" der Fehlercode 4 +geliefert. +Laufzeitfehler, die in Prozeduren des BASIC-Systems ausgelöst werden, liefern dage +gen den in Microsoft-BASIC üblichen Fehlercode plus 1000. So liefert die Meldung +"Keine Daten mehr für READ" den Fehlercode 1004 (MS-BASIC: "Out of data", +Fehlercode 4). +Es läßt sich so anhand des gelieferten Fehlercodes ermitteln, ob der Fehler im +BASIC-System oder an einer anderen Stelle des EUMEL-Systems ausgelöst wurde. + +Eine Übersicht über die innerhalb des BASIC-Systems erzeugten Fehlermeldungen +enthält Anhang C. + diff --git a/lang/basic/1.8.7/doc/basic handbuch.2 b/lang/basic/1.8.7/doc/basic handbuch.2 new file mode 100644 index 0000000..1379e9e --- /dev/null +++ b/lang/basic/1.8.7/doc/basic handbuch.2 @@ -0,0 +1,2441 @@ +#page nr ("%", 31)# +#head# +EUMEL-BASIC-Compiler 8. Übersicht über die Befehle und Funktionen % + +#end# + +8. Übersicht über die Anweisungen und Funktionen + + + +In diesem Kapitel sind alle Anweisungen und Funktionen des vom Compiler übersetz +baren BASIC-Sprachumfangs in alphabetischer Reihenfolge aufgeführt. +Auch die Anweisungsbestandteile (z.B. ELSE und TO) sind mit einem Hinweis auf die +zugehörige Anweisung eingeordnet. +Sind bei Funktionen INT- oder REAL-Ausdrücke als Argumente angegeben, so ist +dies als Hinweis auf den Sinn der Funktion zu verstehen. Es können auch Ausdrücke +des jeweils anderen Datentyps eingesetzt werden. Wird statt eines INT-Ausdrucks +ein REAL-Ausdruck angegeben, so darf dessen Wert aber nur innerhalb des +Wertebereichs für INTs liegen, da der REAL-Wert bei der Ausführung der Funktion +in einen INT-Wert konvertiert wird. + + + +Funktion : ABS + +Zweck : Berechnung des Betrages (Absolutwertes) einer Zahl + +Syntax : ABS (<num. Ausdruck>) + +Erklärung : Liefert den Betrag des numerischen Ausdrucks. + Das Ergebnis ist vom gleichen Typ wie das Argument. + + +Beispiel : 10 a = -12.74 + 20 PRINT ABS (a) + Ausgabe: 12.74 + +Vergleiche : SGN-Funktion + + + +Operator : AND + +Siehe Kapitel 4.4. (Operatoren) + + + +Anweisungsbestandteil : AS + +Siehe NAME-Anweisung + + + +Funktion : ASC + +Zweck : Ermittlung des ASCII-Codes eines Textzeichens + +Syntax : ASC (<TEXT-Ausdruck>) + +Erklärung : Die Funktion liefert den ASCII-Code des ersten Zeichens des + TEXT-Ausdrucks. + Der Code wird als INT geliefert. + + +Beispiel : 10 a$ = "Guten Tag !" + 20 PRINT ASC (a$) + Ausgabe: 71 + +Vergleiche : CHR$-Funktion (Komplementärfunktion) + + + +Funktion : ATN + +Zweck : Berechnung des Arcustangens + +Syntax : ATN (<num. Ausdruck>) + +Erklärung : Die Funktion liefert den Arcustangens des + numerischen Ausdrucks in Radiant. + + +Beispiel : 10 LET x = 4 + 20 PRINT ATN (x) + Ausgabe: 1.325818 + +Vergleiche : TAN-Funktion (Komplementärfunktion), SIN, COS + + + +Anweisungsbestandteil : BASE + +Siehe OPTION BASE-Anweisung + + + +Anweisung : CALL + +Zweck : Aufruf einer insertierten Prozedur + +Syntax : CALL <Prozedurname> #right#[ (<Parameter> [, <Parameter>] [...] ) ] + +Erklärung : <Prozedurname>: Folge aus Zeichen, die für Prozeduren im + EUMEL-System zugelassen sind (also Buchstaben und - ab der + zweiten Stelle - Zahlen), aber keine Leerzeichen. + + <Parameter>: <CONST-Parameter> | <VAR-Parameter> + + <CONST-Parameter>: Ausdruck (genau des von der Prozedur + benötigten Typs) + <VAR-Parameter>: Variable (genau des von der Prozedur benö + tigten Typs) + + Die Prozedur mit dem angegebenen <Prozedurnamen> wird mit den + angegebenen Parametern aufgerufen. + Die aufgerufene Prozedur darf keinen Wert liefern (vgl. USR-Funk + tion). + + Mögliche Fehlerfälle: + - Eine Prozedur mit dem Namen <Prozedurnamen> und den an + gegebenen Parametern gibt es nicht. + - Die Prozedur liefert einen Wert. + - Die Prozedur benötigt Parametertypen, die in BASIC nicht bekannt + sind (z.B. BOOL, FILE, TASK, QUIET). + - Ein Parameter ist CONST, es wird aber ein VAR-Parameter ver + langt. + + Weitere Informationen finden Sie in Kapitel 4.7. + +Hinweis : 1. Bei den Parametern wird keine Typkonvertierung vorgenommen. + 2. Der Prozedurname muß (entgegen der ELAN-Gewohnheit) ohne + Leerzeichen angegeben werden. + 3. Statt des Anweisungswortes CALL kann auch CHAIN geschrieben + werden. CALL und CHAIN werden im EUMEL-BASIC nicht wie + in Microsoft-BASIC benutzt. + + +Beispiel : 10 CALL sysout ("Meine Datei") + 20 PRINT "Dieser Text geht nun in die Datei" + 30 CALL sysout ("") + 40 PRINT "Wieder auf den Bildschirm" + + +Vergleiche : USR-Funktion + + + +Funktion : CDBL + +Zweck : Konvertierung in den Datentyp REAL + +Syntax : CDBL (<num. Ausdruck>) + +Erklärung : Das Ergebnis des numerischen Ausdrucks wird als REAL geliefert. + + +Beispiel : 10 LET a! = 17 + 20 PRINT USR max (CDBL (a!), 152.3) + 30 REM max benötigt zwei REALs als Parameter + + +Vergleiche : CINT-Funktion + + + +Anweisung : CHAIN + +Vollkommen identisch mit der CALL-Anweisung (Erklärung siehe dort !) + + + +Funktion : CHR$ + +Zweck : Erzeugung eines Textzeichens mit einem bestimmten ASCII-Code + +Syntax : CHR$ (<INT-Ausdruck>) + +Erklärung : Die Funktion liefert das Zeichen mit dem ASCII-Code, den der + INT-Ausdruck angibt. + Das Zeichen wird als TEXT geliefert. + Die Leistung der Funktion ist nur für Werte im Bereich 0 bis 255 + definiert. + + +Beispiel : 10 PRINT CHR$ (61) + Ausgabe: = + +Vergleiche : ASC-Funktion (Komplementärfunktion) + + + +Funktion : CINT + +Zweck : Konvertierung in den Datentyp INT + +Syntax : CINT (<num. Ausdruck>) + +Erklärung : Das Ergebnis des numerischen Ausdrucks wird als INT geliefert. + REALs werden gerundet. Werte außerhalb des INT-Bereichs führen + zu einem INT-Überlauf. + + +Beispiel : 10 LET a = 17.625 + 20 PRINT CINT (a); CINT (-a) + Ausgabe: 18 -18 + +Vergleiche : CDBL-, FIX-, INT-Funktionen + + + +Anweisung : CLS + +Zweck : Löschen des Bildschirms + +Syntax : CLS + +Erklärung : Löscht den Bildschirm und positioniert den Cursor in die linke obere + Bildschirmecke (Position 1, 1). + + +Beispiel : 10 CLS + 20 PRINT "PROGRAMMBEGINN" + + + + +Funktion : COS + +Zweck : Berechnung des Cosinus eines Radiantwertes + +Syntax : COS (<Winkel>) + +Erklärung : <Winkel>: REAL-Ausdruck, der den Winkel in Radiant angibt. + Die Funktion liefert den Cosinus des Winkels als REAL. + + +Beispiel : 10 PI = 3.141593 + 20 PRINT COS (PI/4) + Ausgabe: .7071067 + +Vergleiche : SIN-, TAN-Funktionen + + + +Funktion : CSRLIN + +Zweck : Ermittlung der aktuellen Cursorzeile + +Syntax : CSRLIN + +Erklärung : Geliefert wird die Nummer der Zeile (als INT), in der sich der Cursor + auf dem Bildschirm befindet. Die oberste Zeile hat die Nummer 1. + + +Beispiel : 10 CLS + 20 PRINT + 30 PRINT CSRLIN + Ausgabe: 2 + +Vergleiche : POS-Funktion + + + +Funktion : CVD, CVI + +Zweck : Decodierung von in Texten verschlüsselten Zahlenwerten + +Syntax : CVD (<TEXT-Ausdruck>) + CVI (<TEXT-Ausdruck>) + +Erklärung : INTs und REALs können (mit MKI$ und MKD$) zu Texten codiert + werden. + CVD decodiert einen in 8 TEXT-Zeichen codierten REAL-Wert. + CVI decodiert einen in 2 TEXT-Zeichen codierten INT-Wert. + Es wird beim ersten Zeichen des TEXT-Ausdrucks mit der Dekodie + rung begonnen. + Ist der TEXT zu kurz, so wird mit der Meldung "Ueberlauf bei Subs + kription" abgebrochen. + + +Beispiel : 10 zahl$ = MKD$ (3.1415) + 20 PRINT CVD (zahl$) + Ausgabe: 3.1415 + +Vergleiche : MKD$-, MKI$- Funktionen (Komplementärfunktionen) + + + +Anweisung : DATA + +Zweck : Ablegen von Konstanten + +Syntax : DATA [<string>] [, [<string>]] [...] + +Erklärung : <string> : <quoted string> | <unquoted string> + <quoted string> : von Anführungszeichen umschlossene Zeichen + folge, die alle Zeichen außer Anführungs + zeichen enthalten darf + <unquoted string>: Zeichenfolge, die alle Zeichen außer Komma + und Doppelpunkt enthalten darf + + Eine DATA-Anweisung stellt einen Datenspeicher dar, der mit READ + (s.d.) ausgelesen werden kann. + In der DATA-Anweisung können "quoted strings" oder "unquo + ted strings" angegeben werden. "quoted strings" können später nur + noch als Texte ausgelesen werden. + Bei "unquoted strings" wird der Datentyp in der DATA-Anweisung + dagegen nicht festgelegt. Sie können also als INTs, REALs oder + TEXTe ausgelesen werden. Sollen "unquoted strings" Zahlenwerte + darstellen, so müssen sie den in BASIC üblichen Schreibregeln für + die numerischen Konstanten des jeweiligen Typs genügen. Es sind + allerdings zusätzlich noch Vorzeichen erlaubt. + Wenn die <strings> nicht angegeben sind, so wird ein "nil-Datum" + abgelegt. Dieses bewirkt bei einem READ mit numerischer Variable + die Lieferung des Wertes null und bei einem READ mit TEXT-Vari + able die Lieferung eines Leertextes. + + Die DATA-Anweisungen können an beliebiger Stelle im Programm + (vor oder hinter den zugehörigen READ-Anweisungen) stehen. + + Alle DATA-Anweisungen eines Programms bilden zusammen einen + großen sequentiellen Speicher, auf den mit READ der Reihe nach + zugegriffen wird. Intern wird ein sogenannter READ-DATA-Zeiger + geführt, der immer auf das nächste auszulesende Element zeigt. + Die RESTORE-Anweisung (s.d.) ermöglicht es, den READ- + DATA-Zeiger auf das erste Element einer bestimmten DATA-Zeile + zu setzen. + + +Beispiel : 2020 PRINT "Stadt", "Land", "Fluß" + 2030 READ stadt$, land$, fluß$ + 2040 PRINT stadt$, land$, fluß$ + . + 5000 DATA Paris, Frankreich, Seine + + +Vergleiche : READ-, RESTORE-Anweisungen + + + +Funktion : DATE$ + +Zweck : Abrufen des aktuellen Tagesdatums + +Syntax : DATE$ + +Erklärung : Das Tagesdatum wird als Text in der Form TT.MM.JJ geliefert. + + +Beispiel : 10 PRINT "Heute ist der " + DATE$ + Ausgabe (z.B.): Heute ist der 28.08.87 + +Vergleiche : TIME$-Funktion + + + +Anweisung : DEFDBL, DEFINT, DEFSNG, DEFSTR + +Zweck : Definition von Anfangsbuchstaben zur Kennzeichnung bestimmter + Variablentypen + +Syntax : DEFDBL <Buchstabe1> [ - <Buchstabe2>] + #right#[, <Buchstabe3> [ - <Buchstabe4>] ] [...] + DEFINT <Buchstabe1> [ - <Buchstabe2>] + #right#[, <Buchstabe3> [ - <Buchstabe4>] ] [...] + DEFSNG <Buchstabe1> [ - <Buchstabe2>] + #right#[, <Buchstabe3> [ - <Buchstabe4>] ] [...] + DEFSTR <Buchstabe1> [ - <Buchstabe2>] + #right#[, <Buchstabe3> [ - <Buchstabe4>] ] [...] + + +Erklärung : Mit den aufgeführten Anweisungen ist es möglich, bestimmte Buch + staben festzulegen, die, wenn sie als Anfangsbuchstaben eines + Variablennamens verwendet werden, der Variablen einen bestimmten + Typ zuordnen. + + Die Typfestlegung durch Kennzeichnung mit den Zeichen '!', '\#', '%' + oder '$' hat jedoch Vorrang vor den festgelegten Anfangsbuchstaben. + Eine genaue Erläuterung, nach welchen Kriterien der BASIC-Compi + ler den Typ einer Variablen feststellt, befindet sich in Kapitel 4.3. + + Die DEFINT-Anweisung legt Anfangsbuchstaben für INT-Variablen + fest. + Mit der DEFSTR-Anweisung werden Anfangsbuchstaben von + TEXT-Variablen festgelegt. + Die Anweisungen DEFDBL- und DEFSNG- wurden nur aus Kom + patibilitätsgründen implementiert. Sie werden zwar auf syntaktische + Richtigkeit überprüft, aber ansonsten vom Compiler nicht beachtet. + + Werden bei den Anweisungen ganze Buchstabenbereiche angegeben, + so muß der Buchstabe vor dem Bindestrich auch im Alphabet vor + dem Buchstaben hinter dem Bindestrich stehen. + +Hinweis : 1. Die oben beschriebenen Anweisungen gelten stets erst für die im + weiteren Text neu benutzten (also neu eingerichteten) Variablen. + 2. Die beschriebenen Anweisungen dürfen auch mehr als einmal in + einem Programm vorkommen. Die Buchstaben, die in der zweiten + und in den folgenden Anweisungen festgelegt werden, werden + #on("izusätzlich#off("i zu den in der ersten Anweisung festgelegten Buchsta + ben als Kennzeichen für den betreffenden Datentyp vom Compiler + vermerkt. + 3. Der Compiler überprüft nicht, ob gleiche Buchstaben als Kennzei + chen für mehr als einen Variablentyp angegeben werden (siehe + Kapitel 4.3.). Der Benutzer ist also selbst dafür verantwortlich, daß + solche Überschneidungen nicht vorkommen. + + +Beispiel : 10 DEFSTR s - z + 20 DEFINT a - h, n + 30 DIM tabelle (17) 'TEXT-Feld + 40 LET c = 4 'INT-Variable + 50 LET nummer = 17 'INT-Variable + 60 LET ueberschrift = "Willkommen" 'TEXT-Variable + 70 LET reellezahl = 19.563 'REAL-Variable + 80 LET aha\# = -1.36E17 'REAL-Variable + + + + +Anweisung : DEF FN + +Zweck : Definition einer benutzer-definierten Funktion + +Syntax : DEF FN<Name> [ ( <Parameter> [, <Parameter>] #right# [...] ) ] = <Funktionsdefinition> + +Erklärung : <Name> : Zeichenfolge, die der Syntax für Variablennamen + entsprechen muß + FN<Name> bilden zusammen den Namen der + neuen Funktion + <Parameter>: Zeichenfolge, die der Syntax für Variablennamen + entsprechen muß + <Funktionsdefinition>: Ausdruck, der Konstanten, Variablen, die + Parameter der Funktion und Aufrufe + anderer Funktionen enthalten darf + + Mit der DEF FN-Anweisung wird eine benutzer-definierte Funktion + ("user function") mit dem Funktionsnamen FN<Name> definiert + (vergleiche hierzu auch Kapitel 4.5.). + Die benutzer-definierte Funktion liefert, genau wie die standard + mäßig eingebauten Funktionen, einen Wert, der sich aus der Auswer + tung des unter <Funktionsdefinition> angegebenen Ausdrucks + ergibt. + Das letzte Zeichen des Funktionsnamens gibt den Typ des Wertes + an, den die Funktion liefert. Soll die Funktion einen TEXT liefern, so + muß der Name mit "$" enden. Soll ein INT geliefert werden, muß der + Name mit "%" enden. Für alle anderen Endungen wird eine REAL- + liefernde Funktion eingetragen. + Bezeichnet der Funktionsname eine TEXT-liefernde Funktion, so + muß auch die Funktionsdefinition ein Ergebnis vom Typ TEXT liefern. + Zwischen INTs und REALs findet eine Typanpassung statt. + + Die Parameter stehen für die beim Aufruf der Funktion übergebenen + Argumente. + Sie haben nur bei der Definition Gültigkeit. Hierbei 'überdecken' sie + (für diese Zeile) eventuell im BASIC-Programm vorhandene gleich + namige Variablen. + Die Syntax der Parameternamen entspricht der Syntax der Namen + von einfachen Variablen. + Jeder Parameter darf in der Parameterliste nur einmal vorkommen. + + In der Definition dürfen auch Aufrufe von zuvor definierten anderen + "user functions" erscheinen, nicht aber die zu definierende Funktion + selbst (rekursive Definition). + + Die Funktionen sind allein durch ihre Namen gekennzeichnet. Gene + rische Funktionen (gleicher Name, aber unterschiedliche Parameter) + können somit nicht definiert werden. + +Hinweis : 1. Die Definition einer "user function" muß ihrem ersten Aufruf + immer textuell vorausgehen. + 2. "user functions" können auch mehrfach definiert werden. Der + Compiler gibt in einem solchen Fall aber eine Warnung aus, da + die neue Definition nur für die textuell folgenden Aufrufe gültig ist. + + +Beispiel : 10 LET pi = 3.1415927 + 20 DEF FNkreisflaeche (radius) + #right#= 4.0 * pi * radius * radius + 1010 PRINT FNkreisflaeche (1.75) + Ausgabe: 38.48451 + + + +Anweisung : DIM + +Zweck : Dimensionierung eines Feldes + +Syntax : DIM <Felddeklaration> [, <Felddeklaration>] [...] + +Erklärung : <Felddeklaration>: <Feldvariable> (<INT-Konstante> + #right#[, <INT-Konstante>] [...] ) + <Feldvariable>: Name des Feldes (Syntax wie Name von einfachen + Variablen, vgl. 4.3.) + + Mit der DIM-Anweisung wird ein Feld dimensioniert, das heißt die + Anzahl seiner Dimensionen sowie der kleinste und größte Index in + jeder Dimension werden festgelegt und der Speicherplatz für seine + Elemente (siehe 4.3.) wird reserviert. + + Der kleinste Index in allen Dimensionen richtet sich nach der letzten + vorausgegangenen OPTION BASE-Anweisung. + Geht der Dimensionierung die Anweisung OPTION BASE 0 textuell + voraus oder ist keine OPTION BASE-Anweisung vor der Dimensio + nierung vorhanden, so ist der kleinste Index in allen Dimensionen + null. + Wenn der Dimensionierung aber eine OPTION BASE 1-Anweisung + vorausgeht, dann ist der kleinste Index in allen Dimensionen eins. + + Der größte Feldindex wird für jede Dimension durch die in Klammern + stehenden INT-Konstanten angegeben. Die Anzahl dieser INT-Kon + stanten bestimmt auch, wie viele Dimensionen das dimensionierte + Feld hat. + + Wird auf ein Element einer Feldvariablen zugegriffen, ohne daß die + Feldvariable vorher dimensioniert wurde, dann wird das Feld automa + tisch dimensioniert, wobei die Anzahl der Dimensionen anhand der + Anzahl der Indizes beim Aufruf ermittelt wird. Der größte Feldindex + wird bei dieser automatischen Dimensionierung in jeder Dimension + auf zehn gesetzt. Der kleinste Index richtet sich nach den vorausge + gangenen OPTION BASE-Anweisungen (siehe oben). + + Fehlerfälle bei der Dimensionierung: + - "Das Feld ist bereits dimensioniert": + Das Feld wurde bereits explizit, oder automatisch durch den Zugriff + auf ein Feldelement dimensioniert . + - "Die Obergrenze muß >= 1 sein": + Es wurde versucht, 0 als größten Index in einer Dimension festzu + legen, obwohl mit OPTION BASE der kleinste Index auf eins fest + gelegt wurde. + + Fehlerfälle beim Zugriff auf ein Feldelement: + - "Dimensioniert in ... Dimensionen, gefundene Anzahl Indizes ...": + Beim Zugriff wurde eine Anzahl von Indizes gefunden, die nicht mit + der Anzahl der Dimensionen übereinstimmt (Fehler zur Über + setzungszeit). + - "Ueberlauf bei Subskription" oder "Unterlauf bei Subskription": + Der Index ist zu groß beziehungsweise zu klein (Fehler zur Lauf + zeit). + + +Beispiel : 10 DIM a% (20, 10), text$ (30, 40) + 20 DIM tabelle (5, 7, 25) + 30 LET element = matrix (1, 7) + + Zeile 30 führt eine automatische Dimensionierung durch, die einem + DIM matrix (10, 10) entspricht. + + + +Anweisungsbestandteil : ELSE + +Siehe IF-Anweisung + + + +Anweisung : END + +Zweck : Beenden der Programmausführung eines BASIC-Programms + +Syntax : END + +Erklärung : END beendet die Programmausführung des BASIC-Programms ohne + eine Meldung (im Gegensatz zu STOP, s.d.). + END-Anweisungen dürfen im Programm an beliebiger Stelle stehen, + und es darf auch mehr als eine END-Anweisung in einem + Programm vorkommen. + Der Compiler übersetzt ein Programm auch nach Erreichen einer + END-Anweisung weiter. + Nach der letzten Anweisung eines Programms muß kein END stehen. + + +Beispiel : 2020 PRINT "Das war's !" + 2030 REM Hiernach hört's auf + 2040 END + + +Vergleiche : STOP-Anweisung + + + +Anweisungsbestandteil : EOF + +Siehe INPUT-Anweisung + + + + +Operator : EQV + +Siehe Kapitel 4.4. (Operatoren) + + + +Funktion : ERL + +Zweck : Ermittlung der letzten Fehlerzeile + +Syntax : ERL + +Erklärung : Die Nummer der Zeile, in der der letzte Fehler auftrat, wird als INT + geliefert. + +Hinweis : ERL ist realisiert durch Aufruf der Prozedur 'errorline' des Betriebs + systems. + Da die Fehlerbehandlungs-Anweisung ON ERROR nicht zur Verfü + gung steht, ist diese Funktion nicht im üblichen BASIC-Sinne + brauchbar. + +Vergleiche : ERM$, ERR-Funktionen, ERROR-Anweisung + + + +Funktion : ERM$ + +Zweck : Ermittlung der letzten Fehlermeldung + +Syntax : ERM$ + +Erklärung : Die letzte Fehlermeldung wird als TEXT geliefert. + +Hinweis : ERM$ ist realisiert durch Aufruf der Prozedur 'errormessage' des + Betriebssystems. + Da die Fehlerbehandlungs-Anweisung ON ERROR nicht zur Verfü + gung steht, ist diese Funktion nicht im üblichen BASIC-Sinne + brauchbar. + +Vergleiche : ERL-, ERR-Funktionen, ERROR-Anweisung + + + +Funktion : ERR + +Zweck : Ermittlung des letzten Fehlercodes + +Syntax : ERR + +Erklärung : Der Code des letzten aufgetretenen Fehlers wird als INT geliefert. + +Hinweis : ERR ist realisiert durch Aufruf der Prozedur 'errorcode' des Betriebs + systems. + Da die Fehlerbehandlungs-Anweisung ON ERROR nicht zur Verfü + gung steht, ist diese Funktion nicht im üblichen BASIC-Sinne + brauchbar. + +Vergleiche : ERL-, ERM$-Funktionen, ERROR-Anweisung + + + +Anweisung : ERROR + +Zweck : Auslösen eines Fehlers mit bestimmtem Fehlercode + +Syntax : ERROR <INT-Ausdruck> + +Erklärung : Es wird ein Fehler mit dem durch den INT-Ausdruck bestimmten + Fehlercode ausgelöst. + +Hinweis : ERROR ist realisiert durch Aufruf der Prozedur 'errorstop' des Be + triebssystems. + Da die Fehlerbehandlungs-Anweisung ON ERROR nicht zur Verfü + gung steht, ist diese Anweisung nicht im üblichen BASIC-Sinne + brauchbar. + +Vergleiche : ERL-, ERM$-, ERR-Funktionen + + + +Funktion : EXP + +Zweck : Berechnung einer Potenz der Eulerschen Zahl + +Syntax : EXP (<REAL-Ausdruck>) + +Erklärung : Die Funktion liefert e (die Basis des natürlichen Logarithmus) poten + ziert mit dem Wert des REAL-Ausdrucks. + Bei zu großen Werten kommt es zum Fehler 'REAL-Ueberlauf'. + Das Ergebnis der Funktion wird als REAL geliefert. + + +Beispiel : 10 PRINT EXP (10.0) + Ausgabe: 22026.47 + +Vergleiche : LOG-Funktion (Komplementärfunktion) + + + +Funktion : FIX + +Zweck : Ermittlung der Vorkommastellen einer REAL-Zahl + +Syntax : FIX (<REAL-Ausdruck>) + +Erklärung : Die Funktion schneidet die Nachkommastellen ab und liefert nur die + Vorkommastellen des REAL-Ausdrucks. + Die Vorkommastellen werden ebenfalls als REALs geliefert. + + +Beispiel : 10 zahl = 1.2345E2 + 20 PRINT FIX (zahl) + Ausgabe: 123 + +Vergleiche : CINT-, INT-Funktionen + + + +Anweisung : FOR + +Zweck : Beginn einer Zählschleife + +Syntax : FOR <num. Variable> = <Anfangswert> #ib(3)#TO#ie(3)# <Endwert> + #right#[ #ib(3)#STEP#ie(3)# <Schrittweite> ] + <Schleifenrumpf> + + +Erklärung : <num. Variable> : INT- oder REAL-Variable + <Anfangswert> : numerischer Ausdruck + <Endwert> : numerischer Ausdruck + <Schrittweite> : numerischer Ausdruck + <Schleifenrumpf>: Folge von Programmzeilen + + Die FOR-Anweisung erlaubt die komfortable Programmierung von + automatischen Zählschleifen (sogenannten FOR-NEXT-Schleifen). + Gelangt das Programm während der Ausführung an eine FOR-An + weisung, so werden zunächst die Ausdrücke <Anfangswert>, + <Endwert> sowie gegebenenfalls <Schrittweite> ausgewertet. Der + Anfangswert wird dann der Variablen zugewiesen. + Wenn der Wert der Variablen größer ist als der Endwert (bzw. kleiner + als der Endwert bei negativer Schrittweite), dann wird das Programm + mit der nach dem korrespondierenden NEXT (s.d.) folgenden + Anweisung fortgesetzt. + Ist dies jedoch nicht der Fall, werden die Anweisungen des <Schlei + fenrumpfs> ausgeführt. Erreicht das Programm nun die zum FOR + gehörige NEXT-Anweisung (gleiche Variable), so wird der Wert der + Variablen um die Schrittweite erhöht beziehungsweise erniedrigt (je + nach Vorzeichen), und wieder an den Anfang der Schleife verzweigt. + Hier findet dann wieder der Vergleich des Variableninhalts mit dem + Endwert statt (siehe oben). + + Die Laufvariable darf innerhalb der Schleife in Ausdrücken vorkom + men. Sie darf sogar verändert werden (, was aber zu unübersichtli + chen Effekten führen kann). Auch eine Schachtelung mehrerer + Schleifen mit der gleichen Laufvariable ist syntaktisch möglich, sollte + aber #on("iunter allen Umständen#off("i vermieden werden. + + FOR-NEXT-Schleifen dürfen (auch mit WHILE-WEND-Schleifen, + s.d.) geschachtelt werden. Überschneidungen von FOR-NEXT- + Schleifen und WHILE-WEND-Schleifen sind aber nicht zulässig. + + +Beispiel : 10 DIM name$ (5) + 20 FOR i = 1 TO 5 + 30 PRINT "Bitte geben Sie den " + STR$ (i) + #right#+ ". Namen ein:"; + 40 INPUT name$ (i) + 50 NEXT i + + + Es werden die fünf Elemente des Feldes 'name$' eingelesen. + +Vergleiche : NEXT-, WHILE-, IF-Anweisungen + + + +Funktion : FRE + +Zweck : Ermittlung des verfügbaren Speicherplatzes + +Syntax : FRE (<num. Ausdruck>) + FRE (<TEXT-Ausdruck>) + +Erklärung : Die Funktion liefert die Anzahl der freien Bytes. + FRE veranlaßt außerdem ein 'collect heap garbage' (EUMEL- + Systemprozedur). + + Das Ergebnis der Funktion wird als REAL geliefert. + Der Argument-Ausdruck ist ein Dummy-Argument (hat keinen + Einfluß auf den gelieferten Wert). + +Hinweis : Bei der EUMEL M+ Version wird ein korrektes Ergebnis geliefert + (vgl.'storage info'). + + +Beispiel : 10 PRINT FRE (0) + Ausgabe (z.B.): 5324800 + + + +Anweisungsbestandteil : GO + +Siehe GOSUB und GOTO + + + +Anweisung : GOSUB + +Zweck : Unterprogramm-Aufruf + +Syntax : GOSUB <Zeilennummer> + +Erklärung : <Zeilennummer>: INT-Konstante + Statt GOSUB darf auch GO #ib(3)#SUB#ie(3)# geschrieben werden. + + Die Programmausführung wird in der Zeile mit der angegebenen + Zeilennummer fortgesetzt. Die Zeile mit der Zeilennummer muß im + Programm existieren. + Wird im weiteren Programmablauf die Anweisung RETURN gefunden, + so wird hinter dem letzten abgearbeiteten GOSUB die Programm + ausführung fortgesetzt. + GOSUB dient zum Aufruf von #on("iUnterprogrammen#off("i, die von mehr als + einer Stelle im Programm (und auch in anderen Unterprogrammen) + aufgerufen werden können. + +Hinweis : Es wird empfohlen, Unterprogramme im Programm deutlich als solche + zu kennzeichnen und (durch END, STOP oder GOTO) sicherzustel + len, daß nur mit GOSUB zu ihnen verzweigt wird, da es sonst leicht + zu der (Laufzeit-) Fehlermeldung "RETURN ohne GOSUB" kommen + kann. + + +Beispiel : 140 GOSUB 10000 'Zeige Uhrzeit + . + . + 370 GOSUB 10000 'Zeige Uhrzeit + 9990 END + 10000 REM Unterprogramm Zeige Uhrzeit + 10010 PRINT "Es ist " + TIME$ + " Uhr" + 10020 RETURN + + +Vergleiche : RETURN-, ON-, GOTO- Anweisungen + + + +Anweisung : GOTO + +Zweck : Sprung zu einer angegebenen Zeile + +Syntax : GOTO <Zeilennummer> + +Erklärung : <Zeilennummer>: INT-Konstante + Statt GOTO darf auch GO #ib(3)#TO#ie(3)# geschrieben werden. + + Die Programmausführung wird in der Zeile mit der angegebenen + Zeilennummer fortgesetzt. Die Zeile mit der Zeilennummer muß im + Programm existieren. + + +Beispiel : 10 INPUT "Monat (1-12)", monat% + 20 IF monat% < 1 OR monat% > 12 THEN GOTO 10 + + +Vergleiche : ON-, IF-, GOSUB- Anweisungen + + + +Funktion : HEX$ + +Zweck : Erzeugung der hexadezimalen Darstellung einer Zahl als Text + +Syntax : HEX$ (<INT-Ausdruck>) + +Erklärung : Die Funktion liefert die hexadezimale (Zweierkomplement-) Darstel + lung der Zahl, die sich aus dem INT-Ausdruck ergibt. + + +Beispiel : 10 PRINT HEX$ (10000) + Ausgabe: 2710 + +Vergleiche : OCT$-Funktion + + + +Anweisung : IF + +Zweck : Sprung zu einer angegebenen Zeile + +Syntax : IF <Bedingung> + #right#[,] #ib(3)#THEN#ie(3)# <Anweisung(en)>|<Zeilennummer> + #right#[ [,] #ib(3)#ELSE#ie(3)# <Anweisung(en)>|<Zeilennummer>] + IF <Bedingung> [,] GOTO <Zeilennummer> + #right#[ [,] ELSE <Anweisung(en)>|<Zeilennummer>] + +Erklärung : <Bedingung> : numerischer Ausdruck + <Anweisung(en)>: Eine oder mehrere BASIC-Anweisungen, wobei + mehrere wie gewohnt durch ':' zu trennen sind + <Zeilennummer> : INT-Konstante + Statt GOTO darf auch GO TO geschrieben werden. + + Anhand der Bedingung wird entschieden, ob die Abarbeitung des + Programms mit dem THEN- oder ELSE-Zweig fortgesetzt werden + soll. Mit dem THEN-Zweig wird das Programm fortgesetzt, wenn die + Bedingung erfüllt ist (, d.h. der numerische Ausdruck ungleich null + ist). Im anderen Fall (Bedingung nicht erfüllt, numerischer Ausdruck + gleich null) wird das Programm mit dem ELSE-Teil fortgesetzt. Ist + kein ELSE-Teil angegeben, so wird die Abarbeitung des + Programmes in der folgenden #on("iZeile#off("i (nicht nach ':') fortgesetzt. + + Sind statt Anweisungen Zeilennummern nach THEN oder ELSE + angegeben, so entspricht dies einem GOTO (s.d.) zu diesen Zeilen + nummern. + + +Hinweis : Auch eine IF-Anweisung muß in #on("ieiner#off("i Programmzeile stehen. + + +Beispiel : 10 IF a >= b THEN IF a > b THEN + #right#PRINT "a größer b" ELSE PRINT "a gleich b" + #right#ELSE PRINT "a kleiner b" + + + Das Beispiel zeigt, daß bei geschachtelten IF-Anweisungen die + ELSE-Teile immer auf das letzte vorhergehende IF bezogen werden, + für das noch kein ELSE-Teil gefunden wurde. + + + +Vergleiche : GOTO-, GOSUB-, ON-Anweisungen + + + +Operator : IMP + +Siehe Kapitel 4.4. (Operatoren) + + + +Funktion : INKEY$ + +Zweck : Holen eines Zeichens von der Tastatur + +Syntax : INKEY$ + +Erklärung : Die Funktion liefert ein Textzeichen aus dem Tastaturzeichenpuffer. + Wurde kein Zeichen eingegeben, so wird ein Leertext (niltext) gelie + fert. + Die gelieferten Zeichen erscheinen nicht auf dem Bildschirm. + + +Beispiel : 10 REM Schreibmaschine + 20 LET a$ = INKEY$ + 30 IF ASC (a$) = 27 THEN STOP + 40 PRINT a$; + 50 GOTO 20 + + + Die eingegebenen Zeichen werden ausgegeben. Abbruch mit ESC. + +Vergleiche : INPUT$-Funktion, INPUT-Anweisung + + + +Anweisung : INPUT + +Zweck : Einlesen von Daten von der Tastatur + +Syntax : INPUT [;] [<Eingabeaufforderung> ,|; ][ #ib(3)#EOF#ie(3)# + <Zeilennummer>] + #right#<Variable> [, <Variable> ] [...] + +Erklärung : <Eingabeaufforderung>: TEXT-Konstante + <Zeilennummer>: INT-Konstante + <Variable>: Variable, der der eingelesene Werte + zugewiesen werden soll + + Mit der INPUT-Anweisung werden Daten zur Laufzeit des + Programms von der Tastatur in Variablen eingelesen. + + Folgt dem INPUT-Statement ein Semikolon, so wird nach + Beendigung der Eingabe kein Zeilenwechsel vorgenommen. + + Fehlt die <Eingabeaufforderung>, so wird "? " als Eingabe + aufforderung ausgegeben. + Folgt der ein Semikolon, so wird "? " noch zusätzlich ausge + geben. Bei einem Komma wird dieser Standard-Prompt unter + drückt. + + Folgt der <Eingabeaufforderung> die Zeichenfolge 'EOF', so wird + bei Eingabe eines Leertextes zu der nach 'EOF' angegebenen + Zeilennumer verzweigt. + + Sollen mehrere Variablen eingelesen werden, so muß der Benutzer + auch entsprechend viele Daten (durch Kommata getrennt) zur Verfü + gung stellen. + + Wird nichts eingegeben beziehungsweise nur die richtige Anzahl von + Kommata, so wird den entsprechenden Variablen 0, 0.0 bzw. 'niltext' + zugewiesen. + + Bei der Eingabe für eine Textvariable können alle Zeichen (außer + Steuerzeichen) eingegeben werden. Beginnt eine Eingabe mit dem + Anführungszeichen oder endet sie damit, dann muß sie auch damit + enden beziehungsweise beginnen. Diese beiden Anführungszeichen + werden nicht mit zugewiesen. Innerhalb dieser Texteingabe dürfen + Anführungszeichen stehen, aber keine Kommata. + + Eingaben für numerische Variablen müssen in der für Konstanten + üblichen Schreibweise erfolgen. Vorzeichen sind allerdings zusätzlich + erlaubt. + + Vor Zuweisung der eingegebenen Werte an die Variablen werden + Anzahl und Typ(en) und die Anzahl überprüft. + Dabei können folgende Fehlerfälle auftreten: + - "falscher Typ": + Es wurde ein Text statt einer Zahl eingegeben, es wurde ein REAL + statt eines INTs eingegeben oder eine Texteingabe ist fehlerhaft. + - "zu wenig Daten" + - "zu viele Daten" + - "Überlauf": + Es wurde eine zu große (oder zu kleine) Zahl eingegeben. + + Kommt es zu einem Fehler, dann wird nach der Meldung "?Eingabe + wiederholen ! (<Fehlerbeschreibung>)" die Eingabe zum Editieren + angeboten. + +Hinweis : Bei Eingabe von 'ESC k' kann die letzte Eingabezeile zum Editieren + zurückgeholt werden. + + Die Eingabe kann mit der Systemprozedur 'sysin' aus einer Datei + erfolgen. Aus der Eingabedatei wird für jedes INPUT-Statement eine + Zeile eingelesen. Die Ausgabe der Eingabeaufforderung und der + Zeilenwechsel nach der Eingabe werden unterdrückt. Sind die + Eingabedaten fehlerhaft, so wird das Programm mit 'errorstop' + abgebrochen. + + Wird die Ausgabe mit 'sysout' umgeleitet, so werden die Eingabe + aufforderung, die Eingabezeichenfolge und der Zeilenwechsel nach + der Eingabe auf den Bildschirm und in die Ausgabedatei ausgegeben, + auch dann, wenn der Text der Eingabe aus einer Datei eingelesen + wurde. + + +Beispiel : 1990 INPUT "Name, Vorname, Alter"; + #right#name$, vorname$, alter% + + +Vergleiche : INKEY$-, INPUT$-Funktionen + + + +Funktion : INPUT$ + +Zweck : Holen einer Zeichenfolge von der Tastatur + +Syntax : INPUT$ (<Anzahl Zeichen>) + +Erklärung : <Anzahl Zeichen>: INT-Ausdruck + + Die Funktion liefert eine Folge von <Anzahl Zeichen> Textzeichen + aus dem Tastaturzeichenpuffer. Enthält der Puffer nicht alle ge + wünschten Zeichen, so wird auf weitere Zeichen von der Tastatur + gewartet. + Die gelieferten Zeichen erscheinen nicht auf dem Bildschirm. + + +Beispiel : 10 PRINT "Bitte drei Zeichen eingeben !" + 20 LET a$ = INPUT$ (3) + 30 PRINT "Danke schön !" + + +Vergleiche : INKEY$-Funktion, INPUT-Anweisung + + + +Funktion : INSTR + +Zweck : Suchen einer Zeichenfolge in einer anderen + +Syntax : INSTR ( [<Startposition>,] <TEXT-Ausdruck1>, + #right#<TEXT-Ausdruck 2>) + +Erklärung : <Startposition>: INT-Ausdruck + + Die Funktion liefert die Position, ab der der TEXT-Ausdruck 2 das + erste Mal im TEXT-Ausdruck 1 vorkommt. + Die Position wird als INT geliefert. + + +Beispiel : 10 LET a$ = "hallihallo" + 20 LET b$ = "all" + 30 PRINT INSTR (a$, b$); INSTR (5, a$, b$) + Ausgabe: 2 7 + + + +Funktion : INT + +Zweck : Ermittlung der nächstkleineren ganzen Zahl + +Syntax : INT (<REAL-Ausdruck>) + +Erklärung : Die Funktion liefert die größte ganze Zahl, für die gilt: + n kleiner gleich <REAL-Ausdruck>. + Bei positiven Werten bedeutet das, daß die Nachkommastellen abge + schnitten werden. + Das Ergebnis wird als REAL geliefert. + + +Beispiel : 10 PRINT INT (11.74); INT (-11.74) + Ausgabe: 11 -12 + +Vergleiche : CINT-, FIX-Funktionen + + + +Anweisung : KILL + +Zweck : Löschen einer Datei in der Task + +Syntax : KILL <Dateiname> + +Erklärung : <Dateiname>: TEXT-Ausdruck + Die Datei <Dateiname> wird (ohne Nachfrage) gelöscht. + + +Beispiel : 2110 KILL "Scratchdatei" + + + + +Funktion : LEFT$ + +Zweck : Erzeugung eines Teiltextes aus einem anderen Text + +Syntax : LEFT$ (<TEXT-Ausdruck>, <Anzahl Zeichen>) + +Erklärung : <Anzahl Zeichen>: INT-Ausdruck + + Die Funktion liefert die ersten <Anzahl Zeichen> Textzeichen des + TEXT-Ausdrucks. + + +Beispiel : 10 LET a$ = "hallihallo" + 20 PRINT LEFT$ (a$, 4) + Ausgabe: hall + +Vergleiche : MID$-, RIGHT$-Funktionen, LSET-, MID$-, RSET- + Anweisungen + + + +Funktion : LEN + +Zweck : Ermittlung der Länge eines Textes + +Syntax : LEN (<TEXT-Ausdruck>) + +Erklärung : Die Funktion liefert die Anzahl der im TEXT-Ausdruck enthaltenen + Zeichen (also die Länge des Textes). Die Länge wird als INT + geliefert. + Ein Leertext (niltext, "") hat die Länge null. + + +Beispiel : 10 LET a$ = "hallihallo" + 20 PRINT LEN (a$) + Ausgabe: 10 + + + +Anweisung : LET + +Zweck : Zuweisung eines Wertes an eine Variable + +Syntax : [LET] <Variable> = <Ausdruck> + +Erklärung : Die LET-Anweisung ermöglicht das Zuweisen von Werten an Variab + len (dazu gehören auch die Elemente von Feldern). + + Das Schlüsselwort LET ist optional, d.h. eine Zuweisung wird auch + ohne dieses Schlüsselwort erkannt. + + #on("iZuweisung an TEXT-Variablen:#off("i + LET <TEXT-Variable> = <TEXT-Ausdruck> oder <num. + Konstante> + Die numerische Konstante wird automatisch in einen TEXT umge + wandelt (vgl. STR$-Funktion) + + #on("iZuweisung an INT-Variablen:#off("i + LET <INT-Variable> = <num. Ausdruck> + Ist der numerische Ausdruck ein REAL-Ausdruck, so wird automa + tisch nach INT konvertiert (vgl. CINT-Funktion). + + #on("iZuweisung an REAL-Variablen:#off("i + LET <REAL-Variable> = <num. Ausdruck> + Ist der numerische Ausdruck ein INT-Ausdruck, so wird automatisch + nach REAL konvertiert (vgl. CDBL-Funktion). + + +Beispiel : 10 LET t$ = "murmel marmel" + 20 LET t$ = 1245.3 'wie "1245.3" + 30 LET i% = 852 + 40 LET i% = 12.73 'aufgerundet: 13 + 50 LET r = 564 'wie 564. + 60 LET r = 157.36 + + + + +Anweisung : LINE INPUT + +Zweck : Einlesen einer Eingabe von der Tastatur in eine TEXT-Variable + +Syntax : LINE INPUT [;] [<Eingabeaufforderung>;] + #right#<TEXT-Variable> + +Erklärung : Die LINE INPUT-Anweisung ermöglicht das Einlesen von Eingaben + in TEXT-Variablen, aber im Gegensatz zu INPUT ohne Beachtung + von Trennzeichen (z.B. ","). + + Steht direkt nach LINE INPUT ein Semikolon, so wird nach Beendi + gung der Eingabe der Zeilenwechsel unterdrückt. + + Der eingegebene Text wird (bis auf das CR-Zeichen) der TEXT- + Variablen zugewiesen. + + +Beispiel : 2110 LINE INPUT "Name: ";name$ + + + Der Benutzer könnte nun auch folgendes eingeben: + Neumann, Alfred E. + +Vergleiche : INPUT-Anweisung + + + +Funktion : LOG + +Zweck : Berechnung des natürlichen Logarithmus einer Zahl + +Syntax : LOG (<REAL-Ausdruck>) + +Erklärung : Die Funktion liefert den natürlichen Logarithmus des Wertes des + REAL-Ausdrucks. + Bei nicht-positiven Werten kommt es zu einem Fehler in der + EUMEL-Prozedur 'log2'. + Das Ergebnis der Funktion wird als REAL geliefert. + + +Beispiel : 10 PRINT LOG (10.0) + Ausgabe: 2.302585 + +Vergleiche : EXP-Funktion (Komplementärfunktion) + + + +Funktion : LPOS + +Zweck : Ermittlung der aktuellen Druckspalte + +Syntax : LPOS (<num. Ausdruck>) + +Erklärung : Geliefert wird die Nummer der Spalte (als INT), in die das nächste + nächste Zeichen mit LPRINT ausgegeben wird. Die Spalte ganz links + hat die Nummer 1. + Der Argument-Ausdruck ist ein Dummy-Argument (hat keinen + Einfluß auf den gelieferten Wert). + + +Beispiel : 3010 IF LPOS (0) > 65 THEN LPRINT + 3020 LPRINT name$ + + + Falls die Druckposition hinter Spalte 65 liegt, wird eine neue Druck + zeile begonnen. + +Vergleiche : LPRINT-Anweisung, TAB-, POS-Funktion + + + +Anweisung : LPRINT + +Zweck : Ausgabe in eine Druckdatei + +Syntax : LPRINT [#ib(3)#USING#ie(3)# <Format> ;] + #right#[ #ib(3)#TAB#ie(3)# (<Spalte>) | , | ; | <Ausdruck> ] [...] + +Erklärung : <Format> : TEXT-Ausdruck für USING (vgl. PRINT) + <Spalte> : INT-Ausdruck (vgl. PRINT) + <Ausdruck>: TEXT-Ausdruck oder numerischer Ausdruck + + Die LPRINT-Anweisung arbeitet wie PRINT (siehe dort), mit dem + Unterschied, daß LPRINT die Zeichen nicht auf den Bildschirm, son + dern in eine Datei mit dem Namen "BASIC LPRINT OUTPUT" + ausgibt. Diese Datei wird automatisch eingerichtet, falls sie noch + nicht existiert. Ist sie schon vorhanden, so werden die auszugeben + den Zeichen am Ende der Datei angefügt. + Nach oder bei Ablauf des Programms kann die Datei (evtl. nach + vorheriger Aufbereitung durch Textverarbeitungsprogramme) mit + 'print', wie im EUMEL-System üblich, an den Drucker geschickt + werden. Der Benutzer ist selbst dafür verantwortlich, daß er die + Druckdatei, sofern die Daten nicht mehr benötigt werden, vor einem + neuen Programmlauf leert oder löscht. Versäumt er dies, so bleiben + die alten Daten in der Druckdatei, und die neuen Ausgaben werden + hinten angefügt. Das Löschen der Druckdatei kann zum Beispiel + durch das BASIC-Programm mit der KILL-Anweisung erreicht + werden. + + Die Art der Ausgabe und die Syntax ist sonst analog zur PRINT- + Anweisung (siehe Erläuterungen dort). + + +Beispiel : 2110 LPRINT "Dieser Text geht in die Druckdatei" + 2120 LPRINT TAB (12); "Datum: " DATE$ + 2130 LPRINT 1, 2, 3 + + +Vergleiche : PRINT-Anweisung, LPOS-Funktion + + + +Anweisung : LSET + +Zweck : Ersetzen von Zeichen eines Textes von links her + +Syntax : LSET <TEXT-Variable> = <TEXT-Ausdruck> + +Erklärung : Das Ergebnis des TEXT-Ausdrucks wird, links beginnend, in der + TEXT-Variablen eingesetzt. Es werden höchstens so viele Zeichen + ersetzt, wie bisher schon in der Variablen vorhanden waren, das heißt + die Länge des Textes in der Variablen ändert sich nicht. + + +Beispiel : 210 LET a$ = "12345" + 220 LSET a$ = "ABCDEFG" + 230 PRINT a$, + 240 LSET a$ = "abc" + 250 PRINT a$ + Ausgabe: ABCDE abcDE + +Vergleiche : MID$-, RSET-Anweisungen, LEFT$-, MID$-, RIGHT$-Funk + tionen + + + +Anweisung : MID$ + +Zweck : Ersetzen von Zeichen innnerhalb eines Textes + +Syntax : MID$ (<TEXT-Variable>, <Startposition> + #right#[, <Anzahl Zeichen>] ) = <TEXT-Ausdruck> + +Erklärung : <Startposition> : INT-Ausdruck + <Anzahl Zeichen>: INT-Ausdruck + + Das Ergebnis des TEXT-Ausdrucks wird, bei <Startposition> + beginnend, in der TEXT-Variablen eingesetzt. Es werden höch + stens LEN <TEXT-Variable> Textzeichen ersetzt. Ist keine + <Anzahl Zeichen> angegeben, so werden so viele Zeichen des + TEXT-Ausdrucks wie möglich in der TEXT-Variablen eingetragen. + Außerdem gilt: Es wird nicht über das bisherige Ende des Variablen + inhalts ersetzt, das heißt die Länge des Textes in der Variablen + ändert sich nicht. + + +Beispiel : 210 LET a$ = "12345" + 220 MID$ (a$, 3) = "ABCDEFG" + 230 PRINT a$, + 240 MID$ (a$, 2, 1) = "abc" + 250 PRINT a$ + Ausgabe: 12ABC 1aABC + +Vergleiche : LEFT$-, MID$-, RIGHT$-Funktionen, LSET-, RSET- + Anweisungen + + + +Funktion : MID$ + +Zweck : Erzeugung eines Teiltextes aus einem anderen Text + +Syntax : MID$ (<TEXT-Ausdruck>, + #right#<Startposition> [, <Anzahl Zeichen>]) + +Erklärung : <Startposition> : INT-Ausdruck + <Anzahl Zeichen>: INT-Ausdruck + + Die Funktion liefert höchstens <Anzahl Zeichen> Textzeichen des + TEXT-Ausdrucks von Position <Startposition> an. + Wird <Anzahl Zeichen> nicht angegeben, so werden alle Zeichen + ab Startposition geliefert. + Werden rechts von <Startposition> keine Zeichen mehr gefunden + oder ist <Anzahl Zeichen> gleich null, so wird ein Leertext geliefert. + + +Beispiel : 10 LET a$ = "hallihallo" + 20 PRINT MID$ (a$, 4, 4), + 30 PRINT MID$ (a$, 6) + Ausgabe: liha hallo + +Vergleiche : LEFT$-, RIGHT$-Funktionen, LSET-, MID$-, RSET- + Anweisungen + + + +Funktion : MKD$, MKI$ + +Zweck : Codierung von Zahlenwerten in Texte + +Syntax : MKD$ (<REAL-Ausdruck>) + MKI$ (<INT-Ausdruck>) + +Erklärung : Mit MKD$ und MKI$ können INTs und REALs zu Texten codiert + werden. + + Die Funktion MKD$ liefert einen 8 Zeichen langen TEXT, der den + Wert des REAL-Ausdrucks codiert enthält. + Vergleichbar arbeitet MKI$, das einen 2 Zeichen langen TEXT liefert, + der den Wert des INT-Ausdrucks darstellt. + + Mit MKD$ und MKI$ codierte Werte können mit CVD und CVI (s.d.) + wieder decodiert werden. + + +Beispiel : 10 zahl$ = MKD$ (3.1415) + 20 PRINT CVD (zahl$) + Ausgabe: 3.1415 + +Vergleiche : CVD-, CVI-Funktionen + + + +Operator : MOD + +Siehe Kapitel 4.4. (Operatoren) + + + +Anweisung : NAME + +Zweck : Umbenennen einer Datei + +Syntax : NAME <alter Name> AS <neuer Name> + +Erklärung : <alter Name>: TEXT-Ausdruck + <alter Name>: TEXT-Ausdruck + + NAME benennt die Datei <alter Name> in <neuer Name> um. + + +Beispiel : 10 NAME "Käufer" AS "Kunden" + + + + +Anweisung : NEXT + +Zweck : Markierung des Endes einer FOR-Schleife + +Syntax : NEXT [<num. Variable>] [, <num. Variable>] [...] + +Erklärung : NEXT markiert das Ende einer FOR-Schleife (vergleiche FOR- + Anweisung). + + Wird keine Variable angegeben, so bezieht sich das NEXT auf das + letzte textuell vorhergehende FOR. + Wird eine Laufvariable angegeben, so muß sie mit der im letzten + FOR verwendeten Laufvariable übereinstimmen. + Werden mehrere Variablen angegeben, so werden durch die + NEXT-Anweisung mehrere FOR-Schleifen abgeschlossen. + Beachten Sie, daß FOR-Schleifen sich nicht überschneiden dürfen, + sondern nur Schachtelungen zulässig sind. Es kommt daher auf die + Reihenfolge der Variablen bei den NEXT-Anweisungen an. Die + letzte (innerste) FOR-Schleife muß als erste wieder mit dem zuge + hörigen NEXT abgeschlossen werden. + +Vergleiche : FOR-, WHILE-Anweisungen + + + +Operator : NOT + +Siehe Kapitel 4.4. (Operatoren) + + + +Funktion : OCT$ + +Zweck : Erzeugung der oktalen Darstellung einer Zahl als Text + +Syntax : OCT$ (<INT-Ausdruck>) + +Erklärung : Die Funktion liefert die oktale (Zweierkomplement-) Darstellung der + Zahl, die sich aus dem INT-Ausdruck ergibt. + + +Beispiel : 10 PRINT OCT$ (10000) + Ausgabe: 23420 + +Vergleiche : OCT$-Funktion + + + +Anweisung : ON + +Zweck : Ausführung eines "berechneten" Sprungs oder Unterprogramm- + Aufrufs + +Syntax : ON <Sprungziel Nr.> GOTO | GOSUB + #right#<Zeilennummer> [, <Zeilennummer>] [...] + +Erklärung : <Sprungziel Nr.>: INT-Ausdruck + <Zeilennummer> : INT-Konstante + + ON ermöglicht die Verzweigung des Programms an eine von mehre + ren Stellen abhängig vom Ergebnis eines INT-Ausdrucks. + Gelangt das Programm an eine ON-Anweisung, dann wird zunächst + der Wert des INT-Ausdrucks berechnet. Dieses Ergebnis bildet dann + die Nummer n des Sprungziels. Danach wird zur n-ten Zeilen + nummer, die nach GOTO beziehungsweise GOSUB steht, verzweigt. + Die maximale Anzahl von Zeilennummern, die nach GOTO oder + GOSUB angegeben werden dürfen, ist 512. + Nimmt <Sprungziel Nr.> einen Wert an, zu dem keine Zeile in der + Liste gefunden wird (z.B. Werte kleiner gleich null oder Werte größer + als die Anzahl der angegebenen Zeilennummern), so wird das Pro + gramm mit der der ON-Anweisung folgenden Programmzeile fortge + setzt. + + Statt GOTO und GOSUB darf auch GO TO beziehungsweise + GO SUB geschrieben werden. + +Hinweis : Die ON-Anweisung muß in #on("ieiner#off("i Programmzeile stehen. + + +Beispiel : 260 INPUT "Menüpunkt 1, 2 oder 3", a + 270 ON VAL (a) GOTO 300, 400, 500 + 280 GOTO 260 + 300 PRINT "Menüpunkt 1" + . + . + 400 PRINT "Menüpunkt 2" + . + . + 500 PRINT "Menüpunkt 3" + + + Entsprechend der Eingabe wird nach 300, 400 oder 500 verzweigt. + Bei Fehleingaben wird Zeile 280 ausgeführt. + +Vergleiche : GOSUB-, GOTO-, IF-Anweisungen + + + +Anweisung : OPTION BASE + +Zweck : Festlegung des kleinsten Wertes für Feldindizes + +Syntax : OPTION BASE 0|1 + +Erklärung : OPTION BASE legt fest, ob die nachfolgend dimensionierten Felder + Elemente mit dem Index 0 erhalten, oder ob der niedrigste Index 1 + ist. Voreingestellt ist OPTION BASE 0. + +Hinweis : Der niedrigste Feldindex kann für jedes Feld individuell eingestellt + werden. Die OPTION BASE-Anweisung gilt für alle Felder, deren + Dimensionierung ihr textuell nachfolgen. Eine erneute OPTION + BASE-Anweisung kann dann die Untergrenze für die #on("iihr#off("i folgenden + Dimensionierungen festlegen. + + +Beispiel : 10 DIM a (100) 'Indizes 0-100 + 20 OPTION BASE 1 + 30 b$ (3) = "hallo" 'Indizes 1-10 + 40 DIM a% (5) 'Indizes 1-5 + 50 OPTION BASE 0 + 60 DIM c% (9) 'Indizes 0-9 + 70 LET d (4) = 12.3 'Indizes 0-10 + + +Vergleiche : DIM-Anweisung + + + +Operator : OR + +Siehe Kapitel 4.4. (Operatoren) + + + +Funktion : POS + +Zweck : Ermittlung der aktuellen Cursorspalte + +Syntax : POS (<num. Ausdruck>) + +Erklärung : Geliefert wird die Nummer der Spalte (als INT), in der sich der Cursor + auf dem Bildschirm befindet. Die Spalte ganz links hat die Num + mer 1. + Der Argument-Ausdruck ist ein Dummy-Argument (hat keinen + Einfluß auf den gelieferten Wert). + + +Beispiel : 10 CLS + 20 PRINT "testtext"; + 30 PRINT POS (0) + Ausgabe: testtext 9 + + +Vergleiche : CSRLIN-, LPOS-Funktionen + + + +Anweisung : PRINT + +Zweck : Ausgabe auf den Bildschirm + +Syntax : PRINT [#ib(3)#USING#ie(3)# <Format> ;] + #right#[ #ib(3)#TAB#ie(3)# (<Spalte>) | , | ; | <Ausdruck> ] [...] + +Erklärung : <Format> : TEXT-Ausdruck für USING (s. u.) + <Spalte> : INT-Ausdruck (s. u.) + <Ausdruck>: TEXT-Ausdruck oder numerischer Ausdruck, der + ausgegeben werden soll. + + PRINT dient der Ausgabe von Zeichen auf dem Bildschirm. + Numerische Werte werden mit sieben signifikanten Ziffer ausgege + ben. Bei Exponentendarstellung werden für den Exponent maximal 3 + Ziffern ausgegeben. Hinter allen numerischen Werten und vor posi + tiven numerischen Werten wird jeweils ein Leerzeichen ausgegeben. + + TAB bewirkt eine Positionierung des Cursors auf die angegebene + Spalte (die Spalte ganz links hat die Nummer 1). Ist die Spaltenzahl + größer als die mit WIDTH eingestellte Ausgabebreite, so wird auf die + Spalte mit der Nummer Spalte MODULO Ausgabebreite positioniert. + Eine Spaltennummer kleiner gleich null bewirkt eine entsprechende + Warnung. + Ist die Spalte mit der angegebenen Nummer in der aktuellen Zeile + bereits überschritten, dann wird auf die nächste Zeile positioniert. + + Ein Semikolon bewirkt, daß der Cursor an der gerade erreichten + Position bleibt. + + Ein Komma bewirkt die Positionierung auf die nächste gültige Spal + te, für deren Nummer gilt: Nummer MODULO 16 ist 1. + Das Komma dient also der Ausgabe in 16 Zeichen breiten Zonen. + + Endet die PRINT-Anweisung mit TAB (<Spalte>), einem Komma + oder einem Semikolon, dann wird kein Zeilenvorschub ausgelöst. + + #onbold#USING + Der EUMEL-BASIC-Compiler unterstützt auch die PRINT + USING-Anweisung für formatierte Ausgaben. + Der nach dem Wort USING angegebene TEXT-Ausdruck spezifi + ziert das Ausgabeformat für eine PRINT USING-Anweisung. + + Formatierung von Texten: + "!": Nur das erste Zeichen einer Zeichenfolge wird ausgegeben + "\n Leerzeichen\": Es werden die 2 + n ersten Zeichen einer + Zeichenfolge ausgegeben + "&": Alle Zeichen einer Zeichenfolge werden ausgegeben + + Formatierung von Zahlen: + "\#": bezeichnet eine Ziffernposition + ".": Position des Dezimalpunkts + "+": (vor oder nach Zahlen) Ausgabe des Vorzeichens + "-": (nach Zahlen) gegebenenfalls Ausgabe von "-" hinter der + Zahl + "**": Führende Leerstellen werden mit Sternchen aufgefüllt; wirkt + außerdem wie "\#\#". + "$$": Es wird ein Dollarzeichen links vor der formatierten Zahl ausgegeben; + wirkt außerdem wie "\#\#". + "**$": Führende Leerstellen werden mit Sternchen ausgefüllt und direkt vor + der formatierten Zahl wird ein Dollarzeichen ausgegeben; wirkt + außerdem wie "\#\#\#". + ",": (vor Dezimalpunkt) Unterteilung der Vorkommastellen in Dreier + gruppen mittels Komma + "^^^^": Position des Exponenten + "_": Ein Zeichen, das einem Unterstreichungsstrich folgt, wird unverändert + ausgegeben + + Ist der Format-Ausdruck fehlerhaft, so kommt es zum Fehler "USING- + Format fehlerhaft". + Überschreitet eine auszugebende Zahl in irgendeiner Hinsicht die im + Format-Ausdruck für sie vorgesehene Stellenzahl, so wird das Zeichen "%" + ausgegeben, um den Fehler anzuzeigen. + + +Hinweis : 1. PRINT (und PRINT USING) richtet sich bei allen Ausgaben nach + der mit WIDTH eingestellten Ausgabebreite. + 2. Alle Ausgaben von PRINT können mit der Systemprozedur + 'sysout' in eine Datei umgeleitet werden. Dann wird nichts auf + das Terminal ausgegeben. + 3. Das Verhalten beim Erreichen der letzten Bildschirmzeile kann + mit der Prozedur 'basic page' gesteuert werden. Vergleiche + hierzu Kapitel 5, "Steuerung der Bildschirmausgabe". + + +Beispiel : 10 PRINT "hallo", 2 ^ 32 TAB (33) "Ende"; + + Ausgabe: hallo 4.294967E+09 Ende + Position: 1234567890123456789012345678901234567890 + + +Vergleiche : WRITE-, LPRINT-Anweisungen, POS-, CSRLIN-, SPC- + Funktionen + + + +Anweisung : RANDOMIZE + +Zweck : Festlegung eines Anfangswertes für den Zufallszahlengenerator + +Syntax : RANDOMIZE [<num. Ausdruck>] + +Erklärung : Mit RANDOMIZE erhält der Zufallszahlengenerator einen bestimmten + Startwert. + Ist kein numerischer Ausdruck angegeben, so wird während des + Programmlaufs die Meldung "Startwert des Zufallszahlen + generators ?" ausgegeben und ein Startwert eingelesen. + + Wird der Zufallszahlengenerator immer mit dem gleichen Wert gestar + tet, so liefert er auch immer die gleichen Zufallszahlen. Soll er immer + verschiedene Werte liefern, so kann er zum Beispiel mit der System + uhr auf zufällige Startwerte gesetzt werden (RANDOMIZE TIMER). + + +Beispiel : 10 RANDOMIZE 4711 + 20 FOR i = 1 TO 5 + 30 PRINT INT (RND * 10); + 40 NEXT i + Ausgabe: 5 6 2 9 6 + +Vergleiche : RND-Funktion + + + +Anweisung : READ + +Zweck : Auslesen von Daten aus DATA-Anweisungen + +Syntax : READ <Variable> [, <Variable>] [...] + +Erklärung : <Variable>: numerische Variable oder TEXT-Variable + + Die READ-Anweisung liest die nächsten Elemente aus der aktuellen + DATA-Anweisung (s.d.) in die angegebenen Variablen ein. + + In TEXT-Variablen können sowohl "quoted strings" als auch "un + quoted strings" (vgl. DATA-Anweisung) eingelesen werden. + In numerische Variablen können dagegen nur "unquoted strings" + eingelesen werden. Außerdem müssen die Zeichen des "unquoted + string" eine gültige Darstellung einer numerischen Konstanten (even + tuell mit Vorzeichen) sein. Sind diese Bedingungen nicht erfüllt, so + kommt es bei der Ausführung des Programms zu entsprechenden + Fehlern. + + Eine READ-Anweisung kann Daten aus vorangehenden und nach + folgenden DATA-Anweisungen lesen. + Alle DATA-Anweisungen eines Programms bilden zusammen einen + großen sequentiellen Speicher, auf den mit READ der Reihe nach + zugegriffen wird. Intern wird ein sogenannter READ-DATA-Zeiger + geführt, der immer auf das nächste auszulesende Element zeigt. + + Die RESTORE-Anweisung (s.d.) ermöglicht es, den READ-DATA- + Zeiger auf das erste Element einer bestimmten DATA-Zeile zu + setzen. + + Sind keine Daten mehr für READ vorhanden, so wird die Ausführung + des Programms mit der Fehlermeldung "Keine Daten mehr für + READ" abgebrochen. + + +Beispiel : 2020 PRINT "Stadt", "Land", "Fluß" + 2030 READ stadt$, land$, fluß$ + 2040 PRINT stadt$, land$, fluß$ + . + 5000 DATA Köln, Bundesrepublik Deutschland, Rhein + + +Vergleiche : DATA-, RESTORE-Anweisungen + + + +Anweisung : REM + +Zweck : Ermöglicht das Einfügen von Kommentaren in ein Programm + +Syntax : REM <Zeichenfolge> + +Erklärung : <Zeichenfolge>: Beliebige Folge von Zeichen + + Wird eine REM-Anweisung gefunden, so wird der Rest der Pro + grammzeile nicht weiter beachtet. Die Compilierung wird in der fol + genden Zeile fortgesetzt. + Es empfielt sich, von Kommentarzeilen möglichst oft Gebrauch zu + machen, weil sie den Programmtext dokumentieren und strukturieren. + +Hinweis : Nach REM können keine weiteren Anweisungen mehr in einer Pro + grammzeile stehen, da sie nicht übersetzt werden. Auch der Doppel + punkt wird nach REM nicht beachtet. + + +Beispiel : 1000 REM Ausgabe des Feldes + 1010 FOR i = 1 TO feldgroesse% + 1020 PRINT "Eintrag"; i; feld (i) + 1030 NEXT i + + + +Anweisung : RESTORE + +Zweck : Setzen des READ-DATA-Zeigers auf den Anfang einer angegebe + nen Zeile + +Syntax : RESTORE [<Zeilennummer>] + +Erklärung : <Zeilennummer>: INT-Konstante + + Der READ-DATA-Zeiger (vgl. DATA-Anweisung) wird auf die Zeile + <Zeilennummer> gesetzt. + Wird keine Zeilennummer angegeben, so wird für <Zeilennummer> + 1 eingesetzt. + + Existiert die Programmzeile <Zeilennummer> nicht oder ist in ihr + keine DATA-Anweisung vorhanden, so wird der Zeiger auf die + nächste textuell folgende DATA-Anweisung gesetzt. + Folgt der angegebenen Zeilennummer im Programm keine DATA- + Anweisung mehr, kommt es zu der Fehlermeldung "RESTORE: Keine + DATA-Anweisung in oder nach Zeile <Zeilennummer> gefunden !" + + +Beispiel : 10 READ a, b, c + 20 RESTORE + 30 READ d, e, f + 40 DATA 2, 3, 5 + 50 PRINT a; b; c; d; e; f + Ausgabe: 2 3 5 2 3 5 + +Vergleiche : DATA-, READ-Anweisungen + + + +Anweisung : RETURN + +Zweck : Rücksprung aus einem Unterprogramm + +Syntax : RETURN + +Erklärung : RETURN bewirkt einen Rücksprung aus dem Unterprogramm hinter + die aufrufende GOSUB-Anweisung. + + Es dürfen auch mehrere RETURN-Anweisungen in einem Unterpro + gramm vorkommen, um es an verschiedenen Stellen zu verlassen. + + Wird ein RETURN gefunden, ohne daß ein GOSUB durchlaufen + wurde, so wird mit der Fehlermeldung "RETURN ohne GOSUB" + abgebrochen. + + +Beispiel : 140 GOSUB 10000 'Zeige Uhrzeit + . + . + 370 GOSUB 10000 'Zeige Uhrzeit + 9990 END + 10000 REM Unterprogramm Zeige Uhrzeit + 10010 PRINT "Es ist " + TIME$ + " Uhr" + 10020 RETURN + + +Vergleiche : GOSUB-, ON-Anweisungen + + + +Funktion : RIGHT$ + +Zweck : Erzeugung eines Teiltextes aus einem anderen Text + +Syntax : RIGHT$ (<TEXT-Ausdruck>, <Anzahl Zeichen>) +Erklärung : <Anzahl Zeichen>: INT-Ausdruck + + Die Funktion liefert die letzten <Anzahl Zeichen> Textzeichen des + TEXT-Ausdrucks. + Ist <Anzahl Zeichen> größer gleich der Länge des TEXT- + Ausdrucks, so wird der gesamte Ausdruck geliefert. + + +Beispiel : 10 LET a$ = "hallihallo" + 20 PRINT RIGHT$ (a$, 5) + Ausgabe: hallo + +Vergleiche : LEFT$-, MID$-Funktionen, LSET-, MID$-, RSET-Anweisungen + + + +Funktion : RND + +Zweck : Erzeugung von Zufallszahlen + +Syntax : RND [<num. Ausdruck>] + +Erklärung : Wird kein Argument angegeben, so wird ein Wert größer null für den + Ausdruck angenommen. + + RND (x) liefert + + für x > 0: + eine neue Zufallszahl. Es gilt immer: 0 <= RND < 1. Der Betrag + des Arguments hat keinen Einfluß auf das Ergebnis. + + für x = 0: + die letzte gelieferte Zufallszahl noch einmal. + + für x < 0: + eine neue Zufallszahl. Vorher wird aber RANDOMIZE x (s.d.) ausge + führt. + + Die Zufallszahlen werden als REALs geliefert. + Der Zufallszahlengenerator kann mit der RANDOMIZE-Anweisung + auf bestimmte Startwerte eingestellt werden. + + +Beispiel : 10 FOR i = 1 TO 5 + 20 PRINT INT (RND * 10) + 30 NEXT i + Ausgabe (z.B.): 7 9 9 5 0 + +Vergleiche : RANDOMIZE-Anweisung + + + +Anweisung : RSET + +Zweck : Ersetzen von Zeichen eines Textes von rechts her + +Syntax : RSET <TEXT-Variable> = <TEXT-Ausdruck> + +Erklärung : Das Ergebnis des TEXT-Ausdrucks wird, rechts beginnend, in der + TEXT-Variablen eingesetzt. Es werden höchstens so viele Zeichen + ersetzt, wie bisher schon in der Variablen vorhanden waren, das heißt + die Länge des Textes in der Variablen ändert sich nicht. + Soll ein Text eingesetzt werden, der länger ist als der Text in der + Variablen, so wird die Variable nicht verändert. + + +Beispiel : 210 LET a$ = "ABCDEFG" + 220 RSET a$ = "12345" + 230 PRINT a$, + 240 RSET a$ = "abc" + 250 PRINT a$ + Ausgabe: AB12345 AB12abc + +Vergleiche : LSET-, MID$-Anweisungen, LEFT$-, MID$-, RIGHT$-Funk + tionen + + + +Funktion : SGN + +Zweck : Ermittlung des Vorzeichens einer Zahl + +Syntax : SGN (<num. Ausdruck>) + +Erklärung : SGN (x) liefert + für x > 0: 1 + für x = 0: 0 + für x < 0: -1 . + + +Beispiel : 10 a = -12.74 + 20 PRINT SGN (a); SGN (-a); SGN (0 * a) + Ausgabe: -1 1 0 + +Vergleiche : ABS-Funktion + + + +Funktion : SIN + +Zweck : Berechnung des Sinus eines Radiantwertes + +Syntax : SIN (<Winkel>) + +Erklärung : <Winkel>: REAL-Ausdruck, der den Winkel in Radiant angibt. + Die Funktion liefert den Sinus des Winkels als REAL. + + +Beispiel : 10 PI = 3.141593 + 20 PRINT SIN (PI/4) + Ausgabe: .7071068 + +Vergleiche : COS-, TAN-Funktionen + + + +Funktion : SPACE$ + +Zweck : Erzeugung einer bestimmten Anzahl von Leerzeichen + +Syntax : SPACE$ (<INT-Ausdruck>) + +Erklärung : Die SPACE$-Funktion liefert einen TEXT, der aus so vielen Leerzei + chen (Code 32) besteht, wie der Wert des INT-Ausdrucks angibt. + + +Beispiel : 10 PRINT "123456789" + 20 PRINT "^" + SPACE$ (7) + "^" + + Ausgabe: 123456789 + ^ ^ + + +Vergleiche : STRING$-Funktion + + + +Funktion : SPC + +Diese Funktion entspricht exakt der SPACE$-Funktion und wurde nur aus Kompatibi +litätsgründen implementiert. + + + +Funktion : SQR + +Zweck : Berechnung der Quadratwurzel einer Zahl + +Syntax : SQR (<num. Ausdruck>) + +Erklärung : SQR (x) liefert die Quadratwurzel des durch den numerischen Aus + druck angegebenen Wertes. + Das Ergebnis wird als REAL geliefert. + + +Beispiel : 10 PRINT SQR (100); + 20 PRINT SQR (2); + 30 PRINT SQR (17.453) + Ausgabe: 10 1.414214 4.177679 + + + +Anweisungsbestandteil : STEP + +Siehe FOR-Anweisung + + + +Anweisung : STOP + +Zweck : Beenden der Programmausführung eines BASIC-Programms mit + Meldung + +Syntax : STOP + +Erklärung : STOP beendet die Programmausführung des BASIC-Programms. + Im Gegensatz zu END (s.d.) erzeugt STOP dabei die Meldung "STOP + beendet das Programm in Zeile ...". + + STOP-Anweisungen dürfen im Programm an beliebiger Stelle + stehen, und es darf auch mehr als eine STOP-Anweisung in einem + Programm vorkommen. + Der Compiler übersetzt ein Programm auch nach Erreichen einer + STOP-Anweisung weiter. + + +Beispiel : 3220 IF eingabe$ = "Ende" THEN STOP + + +Vergleiche : END-Anweisung + + + +Funktion : STR$ + +Zweck : Konvertierung einer Zahl in einen Text + +Syntax : STR$ (<num. Ausdruck>) + +Erklärung : Die Funktion liefert die Darstellung des Wertes des numerischen + Ausdrucks als TEXT. + Die Zahlen werden so als Text geliefert, wie sie bei einer PRINT- + Anweisung auf dem Bildschirm erscheinen würden. + + +Beispiel : 10 LET zahl$ = STR$ (1e6) + 20 PRINT zahl$; LEN (zahl$) + Ausgabe: 1000000 7 + +Vergleiche : VAL-Funktion (Komplementärfunktion) + + + +Funktion : STRING$ + +Zweck : Erzeugung eines Textes mit mehreren gleichen Zeichen + +Syntax : STRING$ (<Anzahl>, <Code>|<TEXT-Ausdruck>) + +Erklärung : <Anzahl>: INT-Ausdruck + <Code> : INT-Ausdruck (Wert im Bereich 0 bis 255) + + Die Funktion liefert <Anzahl> mal das Zeichen, + - das den ASCII-Code <Code> hat oder + - das am Anfang vom Ergebnis des TEXT-Ausdrucks steht. + + +Beispiel : 10 LET pfeil$ = STRING$ (10, "=") + ">" + 20 PRINT pfeil$;" ";STRING$ (5, 35) '35 entspr. \# + Ausgabe: ==========> \#\#\#\#\# + +Vergleiche : SPACE$-Funktion + + + +Anweisungsbestandteil : SUB + +Siehe GOSUB-Anweisung + + + +Anweisung : SWAP + +Zweck : Tauschen der Inhalte zweier Variablen + +Syntax : SWAP <Variable1>, <Variable2> + +Erklärung : SWAP tauscht die Inhalte der beiden Variablen. + + Die beiden Variablen müssen vom gleichen Typ sein. + + +Beispiel : 3220 LET a = 10 + 3230 LET b = 20 + 3240 SWAP a, b + 3250 PRINT a; b + Ausgabe: 20 10 + + + +Anweisungsbestandteil : TAB + +Siehe PRINT- und LPRINT-Anweisung + + + +Funktion : TAN + +Zweck : Berechnung des Tangens eines Radiantwertes + +Syntax : TAN (<Winkel>) + +Erklärung : <Winkel>: REAL-Ausdruck, der den Winkel in Radiant angibt. + Die Funktion liefert den Tangens des Winkels als REAL. + + +Beispiel : 10 PI = 3.141593 + 20 PRINT TAN (PI/4) + Ausgabe: 1 + +Vergleiche : COS-, SIN-Funktionen + + + +Anweisungsbestandteil : THEN + +Siehe IF-Anweisung + + + +Funktion : TIMER + +Zweck : Lesen der Systemuhr (CPU-Zeit der Task) + +Syntax : TIMER + +Erklärung : Die bisher von der Task verbrauchte CPU-Zeit (in Sekunden) wird + als REAL geliefert. + + TIMER eignet sich auch zum Starten des Zufallszahlengenerators + (vgl. RANDOMIZE-Anweisung). + + +Beispiel : 2010 LET starttime = TIMER + . + . + 2620 PRINT "Verbrauchte CPU-Zeit:"; + 2630 PRINT TIMER - starttime; "Sekunden" + + +Vergleiche : TIME$-Funktion + + + +Funktion : TIME$ + +Zweck : Abrufen der aktuellen Tageszeit + +Syntax : TIME$ + +Erklärung : Die Tageszeit wird als Text in der Form HH.MM.SS geliefert. + + +Beispiel : 10 PRINT "Es ist jetzt "; TIME$; " Uhr" + Ausgabe (z.B.): Es ist jetzt 10:51:17 Uhr + +Vergleiche : DATE$-, TIMER-Funktionen + + + +Anweisungsbestandteil : TO + +Siehe FOR- und GOTO-Anweisungen + + + +Anweisung : TRON / TROFF + +Zweck : Ein- und Ausschalten der TRACE-Funktion + +Syntax : TRON + TROFF + +Erklärung : Der TRACE-Modus dient der Suche nach logischen Fehlern bei der + Entwicklung von BASIC-Programmen. + + TRON schaltet den TRACE-Modus für die nachfolgend übersetzten + Programmzeilen ein. + + Ist der TRACE-Modus eingeschaltet, so wird für jede gefundene + Zeilennummer die Ausgabe dieser Zeilennummer in eckigen + Klammern mit in den erzeugten Code aufgenommen. Dies hat dann + während des Laufens den Effekt, daß immer bei Abarbeitung der im + TRACE-Modus übersetzten Zeilen die aktuelle Zeilennummer aus + gegeben wird. Es ist so leicht zu verfolgen, in welcher Reihenfolge + die Zeilen des Programms ausgeführt werden. + + TROFF schaltet den TRACE-Modus für die textuell folgenden Pro + grammzeilen wieder aus. + + +Beispiel : 5220 TRON + 5230 REM hier beginnt die kritische + 5240 REM Programmstelle + . + . + . + 5970 TROFF + + + Die Zeilen 5230 bis 5970 werden im TRACE-Modus übersetzt. + + + +Anweisungsbestandteil : USING + +Siehe PRINT-Anweisung + + + +Funktion : USR + +Zweck : Aufruf einer wertliefernden insertierten Prozedur + +Syntax : USR <Prozedurname> + #right#[ (<Parameter> [, <Parameter>] [...] ) ] + +Erklärung : <Prozedurname>: Folge aus Zeichen, die für Prozeduren im + EUMEL-System zugelassen sind (also Buchstaben und - ab der + zweiten Stelle - Zahlen), jedoch keine Leerzeichen. + + <Parameter>: <CONST-Parameter> | <VAR-Parameter> + + <CONST-Parameter>: Ausdruck (genau des von der Prozedur + benötigten Typs) + <VAR-Parameter>: Variable (genau des von der Prozedur benö + tigten Typs) + + Die Prozedur mit dem angegebenen <Prozedurnamen> und den + angegebenen Parametern wird aufgerufen. + Die USR-Funktion liefert nach Ausführung der Prozedur das von der + Prozedur übergebene Ergebnis (Typ INT, REAL oder TEXT). + + Mögliche Fehlerfälle: + - Eine Prozedur mit dem Namen <Prozedurnamen> und den ange + gebenen Parametern gibt es nicht. + - Die Prozedur liefert keinen Wert. + - Die Prozedur liefert einen Typ, der in BASIC unbekannt ist (zum + Beispiel BOOL). + - Die Prozedur benötigt Parametertypen, die in BASIC nicht bekannt + sind (z.B. BOOL, FILE, TASK, QUIET). + - Ein Parameter ist CONST, es wird aber ein VAR-Parameter ver + langt. + + Weitere Informationen finden Sie in Kapitel 4.7. + +Hinweis : 1. Bei den Parametern wird keine Typkonvertierung vorgenommen. + 2. Der Prozedurname muß (entgegen der ELAN-Gewohnheit) ohne + Leerzeichen angegeben werden. + 3. USR ist die einzige Funktion, bei der das Argument (nämlich der + Prozeduraufruf) nicht in Klammern stehen darf. + + +Beispiel : 10 LET euler = USR e + 20 PRINT euler + Ausgabe: 2.718282 + +Vergleiche : CALL-, CHAIN-Anweisungen + + + +Funktion : VAL + +Zweck : Konvertierung eines Texts in eine Zahl + +Syntax : VAL (<TEXT-Ausdruck>) + +Erklärung : Die Funktion liefert den Wert der Zahl, deren Darstellung in dem + übergebenen TEXT-Ausdruck enthalten ist. Führende Leerstellen + werden dabei überlesen. + Sobald ein nicht wandelbares Zeichen festgestellt wird, wird der bis + dahin ermittelte Wert (am Anfang null) geliefert. + + +Beispiel : 10 LET zahl$ = "-1.256E-63" + 20 PRINT VAL (zahl$) + Ausgabe: -1.256E-63 + +Vergleiche : STR$-Funktion (Komplementärfunktion) + + + +Anweisung : WEND + +Zweck : Markierung des Endes einer WHILE-Schleife + +Syntax : WEND + +Erklärung : WEND markiert das Ende einer WHILE-Schleife (vergleiche + WHILE-Anweisung). + +Vergleiche : WHILE-, FOR-Anweisungen + + + +Anweisung : WHILE + +Zweck : Beginn einer abweisenden Schleife + +Syntax : WHILE <Bedingung> + <Schleifenrumpf> + +Erklärung : <Bedingung> : numerischer Ausdruck + <Schleifenrumpf>: Folge von Programmzeilen + + Die WHILE-Anweisung erlaubt die komfortable Programmierung von + abweisenden Schleifen (sogenannten WHILE-WEND-Schleifen) in + BASIC. + Gelangt das Programm während der Ausführung an eine WHILE- + Anweisung, so wird zunächst der Bedingungs-Ausdruck ausge + wertet. Ist die Bedingung nicht erfüllt (falsch, Wert gleich null), so + wird das Programm mit der nächsten Anweisung hinter der korres + pondierenden WEND-Anweisung fortgesetzt. + Ist die Bedingung dagegen erfüllt (wahr, Wert ungleich null), so + werden die Anweisungen des Schleifenrumpfs abgearbeitet. Beim + Erreichen der WEND-Anweisung springt das Programm wieder zur + WHILE-Anweisung zurück, die Bedingung wird erneut überprüft und, + je nach Ergebnis, wird der Schleifenrumpf oder die Anweisung nach + WEND ausgeführt. + + WHILE-WEND-Schleifen dürfen (auch mit FOR-NEXT-Schleifen, + s.d.) geschachtelt werden. Überschneidungen von WHILE-WEND- + Schleifen und FOR-NEXT-Schleifen sind jedoch nicht zulässig. + + +Beispiel : 10 LET weiter$ = "j" + 20 WHILE LEFT$ (weiter$, 1) = "j" + 30 REM Hier beginnt das eigentliche Programm + . + . + 1650 INPUT "Weiter ? (j/n)", weiter$ + 1660 WEND + + + Das eigentliche Programm wird so lange ausgeführt, bis der Benutzer + etwas anderes als "j" an der ersten Stelle von 'weiter$' eingibt. + +Vergleiche : FOR-, IF-Anweisungen + + + +Anweisung : WIDTH + +Zweck : Einstellung der Bildschirmbreite + +Syntax : WIDTH <Zeichen pro Zeile> + +Erklärung : <Zeichen pro Zeile> : INT-Ausdruck + + Mit der WIDTH-Anweisung wird festgelegt, wie viele Zeichen pro + Zeile bei Ausgaben auf den Bildschirm oder in Dateien pro Zeile + ausgegeben werden sollen. + Soll für die Druckdatei eine andere Anzahl von Zeichen pro Zeile + gelten als für den Bildschirm, dann muß vor jeder Sequenz von + LPRINT-Anweisungen die gewünschte Anzahl mit WIDTH einge + stellt werden. + WIDTH gilt auch für Ausgaben in 'sysout'-Dateien. + Insbesondere bei der Ausgabe in Dateien kann ein Wert von mehr als + 80 Zeichen pro Zeile sinnvoll sein. + + +Beispiel : 10 REM es sollen nur 45 Zeichen pro Zeile + 20 REM ausgegeben werden + 30 WIDTH 45 + + +Vergleiche : PRINT-, LPRINT-, WRITE-Anweisungen + + + +Anweisung : WRITE + +Zweck : Ausgabe von Zahlen und Texten auf dem Bildschirm + +Syntax : WRITE [<Ausdruck>] [, <Ausdruck>] [...] + +Erklärung : <Ausdruck>: numerischer Ausdruck oder TEXT-Ausdruck + + Die WRITE-Anweisung erlaubt die Ausgabe von Daten auf dem + Bildschirm. Die angegebenen Ausdrücke werden ausgewertet und + ausgegeben. Dabei werden numerische Werte im gleichen Format + wie bei der PRINT-Anweisung (s.d.) ausgegeben, mit der Einschrän + kung, daß den Zahlen keine Leerstelle folgt. + Die Ergebnisse von Text-Ausdrücken werden von Anführungszei + chen umschlossen ausgegeben. + Alle Einzelausgaben werden durch Kommata voneinander getrennt. + + Nach Ausgabe aller angegebenen Ausdrücke wird der Cursor an den + Anfang der nächsten Zeile positioniert. + + +Beispiel : 10 LET a = 10.7: b = 20 + 20 LET c$ = "Testtext" + 30 WRITE a, b, c$ + Ausgabe: 10.7, 20,"Testtext" + +Vergleiche : PRINT-, LPRINT-, WIDTH-Anweisungen + + + +Operator : XOR + +Siehe Kapitel 4.4. (Operatoren) + diff --git a/lang/basic/1.8.7/doc/basic handbuch.3 b/lang/basic/1.8.7/doc/basic handbuch.3 new file mode 100644 index 0000000..14cb499 --- /dev/null +++ b/lang/basic/1.8.7/doc/basic handbuch.3 @@ -0,0 +1,698 @@ +#page nr ("%",97)# +#head# +EUMEL-BASIC-Compiler 9. Anpassung von Programmen an den EUMEL-BASIC-Compiler % + +#end# + +9. Anpassung von Programmen an den EUMEL-BASIC-Compiler + + +9.1. Unterschiede zwischen BASIC-Inter + pretern und dem EUMEL-BASIC- + Compiler + +Bei der Anpassung von Programmen für BASIC-Interpreter an den EUMEL- +BASIC-Compiler gibt es einige Besonderheiten zu beachten, die auf den unterschied +lichen Arbeitsweisen von Compilern gegenüber Interpretern beruhen. +Bei Interpretern fällt die Übersetzung und Ausführung des Quellprogramms zeitlich +zusammen (genau genommen gibt es ja gar keine Übersetzung, sondern das Quell +programm wird #on("i")#interpretiert#off("i")#). Dies hat zur Folge, daß auch nicht zur Ausführung +bestimmte Anweisungen (z.B. Dimensionierungen, Typfestlegungen etc.) erst während +der Ausführung des Programms erkannt und ausgewertet werden. +Bei Compilern hingegen muß deutlich zwischen der Übersetzungszeit (Compiletime) +und der Laufzeit (Runtime) eines Programms unterschieden werden. +Der wesentliche Unterschied zwischen Compilern und Interpretern liegt nun in der +Reihenfolge der Kenntnisnahme von den Anweisungen. Während der Interpreter von +den Anweisungen in der Reihenfolge ihres Auftretens entlang des Programmablaufs +Kenntnis nimmt, werden die Anweisungen vom Compiler in der Reihenfolge ihres +textuellen Auftretens zur Kenntnis genommen. +Da es sich bei dem EUMEL-BASIC-Compiler um einen One-Pass-Compiler +handelt, ist es zwingend notwendig, daß +- DIM-Anweisungen vor dem ersten Zugriff auf das zu dimensionierende Feld + stehen. +- OPTION BASE-Anweisungen vor den betreffenden Dimensionierungen stehen. +- DEF FN-Anweisungen vor dem ersten Aufruf der zu definierenden Funktion ste + hen. +- DEFINT- beziehungsweise DEFSTR-Anweisungen vor der ersten Verwendung der + betreffenden Variablen erscheinen. + +Einige Interpreter lassen sogar den Abschluß von FOR-NEXT- und WHILE- +WEND-Schleifen an mehreren Stellen im Programm zu (z.B. mehrere NEXT- +Anweisungen zu einer FOR-Anweisung). Auch solche "Kunstgriffe" gestattet der +EUMEL-BASIC-Compiler (aus den oben geschilderten Gründen) nicht. + + + + +9.2. Abweichungen von ISO 6373-1984 + (Minimal-BASIC) + + + +Der EUMEL-BASIC-Compiler weicht in folgenden Punkten von der ISO-Norm +6373-1984 für Minimal-BASIC ab: +- Treten bei der Auswertung von numerischen Ausdrücken Überläufe auf, so wird + nicht, wie im Standard vorgesehen, eine Warnung ausgegeben und mit bestimmten + Höchstwerten weitergerechnet, sondern die Ausführung des BASIC-Programms + wird mit einer entsprechenden Fehlermeldung abgebrochen. +- Nimmt die Sprungziel-Nummer bei der ON-Anweisung einen fehlerhaften Wert an + (Nummer < 1 oder Nummer > Anzahl Sprungziele), dann wird nicht, wie im + Standard empfohlen, mit einer Fehlermeldung abgebrochen, sondern es wird (wie + auch in Microsoft-BASIC üblich) das Programm mit der der ON-Anweisung fol + genden Anweisung fortgesetzt. +- Bei der DATA-Anweisung müssen nicht unbedingt Zeichenfolgen angegeben + werden. Werden sie weggelassen, dann wird bei Ausführung der READ- + Anweisung null beziehungsweise Leertext geliefert (vergleiche Kapitel 8, DATA- + Anweisung). +- Bei den Eingaben für eine INPUT-Anweisung können ebenfalls die Daten wegge + lassen werden. Auch hier wird null beziehungsweise Leertext geliefert (vergleiche + Kapitel 8, INPUT-Anweisung) + + +Die Erweiterungen gegenüber ISO 6373 sollen hier nicht im einzelnen aufgeführt +werden. Bitte vergleichen Sie in Zweifelsfällen die Normungsschrift mit dieser Doku +mentation! + + + + +9.3. Anpassung von Microsoft-BASIC Pro + grammen an den EUMEL-BASIC- + Compiler + + + +Bei der Entwicklung des EUMEL-BASIC-Compilers wurde zwar auf Übereinstim +mung mit Microsoft-BASIC Wert gelegt, von einer echten Kompatibilität kann aber +aufgrund einer ganzen Reihe fehlender Anweisungen und Funktionen nicht gespro +chen werden. +Gegenüber Microsoft-BASIC fehlen vor allem: +- alle "Direkt-Kommandos" (RUN, LIST, LOAD, SAVE, MERGE usw.). Die Aufgaben + dieser Anweisungen werden von den Prozeduren des EUMEL-Systems über + nommen. +- im weiteren Sinne "hardware-nahe" oder an Maschinensprache orientierte Anwei + sungen und Funktionen (CALL, PEEK, POKE, USR, WAIT usw.) +- die ERROR-Handling Anweisungen (ON ERROR, RESUME) +- die Dateiverarbeitungs-Anweisungen und -Funktion (INPUT\#, PRINT\# u.a.; die + INPUT- und PRINT-Anweisungen wurden aber auf Zusammenarbeit mit 'sysin' + und 'sysout' abgestimmt.) +- die Single-Precision-Variablen (Single- und Double-Precision-Variablen wer + den beide auf den Datentyp REAL abgebildet.) +- die hexadezimalen und oktalen Konstanten + +Anweisungen und Funktionen, die sich abweichend vom Microsoft-Standard verhal +ten, sind vor allem: +- CALL, CHAIN, USR +- ERROR, ERR, ERL +- LSET, RSET + +Wichtige Erweiterungen gegenüber Microsoft-BASIC sind: +- Möglichkeit des Aufrufs von ELAN-Prozeduren +- Maximale Anzahl von Zeichen pro Zeile: 32000 +- Maximale Anzahl von Zeichen pro TEXT-Objekt: 32000 +- OPTION BASE wirkt auf einzelne Felder (und nicht unbedingt auf ein ganzes + Programm) + +#on ("b")# +Hinweis zur Verwendung von MS-BASIC-Programmen im EUMEL-System#off ("b")# +Sollen Microsoft-BASIC-Programme in das EUMEL-Systemm übernommen wer +den, so ist dabei so vorzugehen: +1. Speichern Sie das Programm von MS-BASIC aus mit der ASCII-SAVE-Option + ab. + Beispiel: SAVE "PROGRAMM.BAS",A +2. Lesen Sie das Programm mittels "DOSDAT" (Programm zum Lesen von MS- + DOS-Dateien) im "file ascii"-Modus ein: + + reserve ("file ascii", /"DOS"); fetch ("PROGRAMM.BAS", /"DOS") + +Danach steht ihnen das BASIC-Program in der EUMEL-Textdatei +"PROGRAMM.BAS" zur Verfügung. + +#page# +#head# +EUMEL-BASIC-Compiler Anhang A: Reservierte Wörter % + +#end# + +Anhang A: #ib(4)#Reservierte Wörter#ie(4)# +Dieser Anhang enthält eine Übersicht über alle vom EUMEL-BASIC-Compiler +erkannten reservierten Wörter. + +ABS Funktion +AND Operator +AS Anweisungsbestandteil +ASC Funktion +ATN Funktion +BASE Anweisungsbestandteil +CALL Anweisung +CDBL Funktion +CHAIN Anweisung +CHR$ Funktion +CINT Funktion +CLEAR nicht implementiert +CLOSE nicht implementiert +CLS Anweisung +COMMON nicht implementiert +FIELD nicht implementiert +COS Funktion +CSRLIN Funktion +CVD Funktion +CVI Funktion +DATA Anweisung +DATE$ Funktion +DEF Anweisung +DEFDBL Anweisung +DEFINT Anweisung +DEFSNG Anweisung +DEFSTR Anweisung +DIM Anweisung +ELSE Anweisungsbestandteil +END Anweisung +EOF Anweisungsbestandteil +EQV Operator +ERL Funktion +ERM$ Funktion +ERR Funktion +ERROR Anweisung +EXP Funktion +FIX Funktion +FOR Anweisung +FRE Funktion +GET nicht implementiert +GO Anweisungsbestandteil +GOSUB Anweisung +GOTO Anweisung +HEX$ Funktion +IF Anweisung +IMP Operator +INKEY$ Funktion +INPUT Anweisung +INPUT$ Funktion +INSTR Funktion +INT Funktion +KILL Anweisung +LEFT$ Funktion +LEN Funktion +LET Anweisung +LINE Anweisungsbestandteil +LOC nicht implementiert +LOG Funktion +LPOS Funktion +LPRINT Anweisung +LSET Anweisung +MID$ Anweisung/Funktion +MKD$ Funktion +MKI$ Funktion +MOD Operator +NAME Anweisung +NEXT Anweisung +NOT Operator +OCT$ Funktion +ON Anweisung +OPEN nicht implementiert +OPTION Anweisung +OR Operator +OUT nicht implementiert +POS Funktion +PRINT Anweisung +PUT nicht implementiert +RANDOMIZE Anweisung +READ Anweisung +REM Anweisung +RESTORE Anweisung +RESUME nicht implementiert +RETURN Anweisung +RIGHT$ Funktion +RND Funktion +RSET Anweisung +SGN Funktion +SIN Funktion +SPACE$ Funktion +SPC Funktion +SQR Funktion +STEP Anweisungsbestandteil +STOP Anweisung +STR$ Funktion +STRING$ Funktion +SUB Anweisungsbestandteil +SWAP Anweisung +TAB Anweisungsbestandteil +TAN Funktion +THEN Anweisungsbestandteil +TIME$ Funktion +TIMER Funktion +TO Anweisungsbestandteil +TROFF Anweisung +TRON Anweisung +USING Anweisungsbestandteil +USR Funktion +VAL Funktion +WAIT nicht implementiert +WEND Anweisung +WHILE Anweisung +WIDTH Anweisung +WRITE Anweisung +XOR Operator +#page# +#head# +EUMEL-BASIC-Compiler Anhang B: Vom Scanner erkannte Symboltypen % + +#end# + +Anhang B: Vom #ib(3)#Scanner#ie(3)# erkannte #ib(3)#Symbol +typen#ie(3)# + + Der Scanner (ein Paket des EUMEL-BASIC-Systems) hat die Aufgabe, den Pro +grammtext Zeichen für Zeichen durchzugehen und auszulesen ('scannen'). Dabei +werden die Zeichen immer zu logischen Gruppen, sogenannten #on("i")#Symbolen#off("i")# zusammen +gefaßt. Diese Symbole werden dann dem eigentlichen Compilerprogramm geliefert. +Der Scanner entscheidet nach recht komplizierten Regeln, welche Zeichen aus der +Quelldatei zu einem Symbol zusammengefaßt werden. Dennoch soll in diesem An +hang der Begriff des Symbols etwas näher erklärt werden, da der Anwender (vor allem +bei den Fehlermeldungen) mit Symboltypen konfrontiert wird. + + + +Reservierte Wörter +#on ("b")# +Anfangszeichen:#off ("b")# Buchstaben +#on ("b")# +Folgezeichen:#off ("b")# Buchstaben +#on ("b")# +Beispiele:#off ("b")# PRINT, VAL, TAB, SUB, TO +#on ("b")# +Vergleiche:#off ("b")# Anhang A + + + +Operatoren ++ - * / \ ^ MOD +NOT AND OR XOR EQV IMP +< > = <= >= <> + +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.4. + + + +numerische Konstanten +#on ("b")# +Anfangszeichen:#off ("b")# Ziffern 0 bis 9, Dezimalpunkt '.' +#on ("b")# +Folgezeichen:#off ("b")# zusätzlich: 'd', 'D', 'e' oder 'E', am Schluß auch '%', '!' oder '\#' +#on ("b")# +Beispiele:#off ("b")# 1.0, 1.256d123, 12! +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.2. + + + +TEXT-Konstanten +#on ("b")# +Anfangszeichen:#off ("b")# Anführungszeichen +#on ("b")# +Folgezeichen:#off ("b")# Alle Zeichen, sogar Doppelpunkte, Apostrophe und Steuerzei + chen. Anführungszeichen dürfen #on("i")#innerhalb#off("i")# von + TEXT-Konstanten nicht vorkommen. Eine + TEXT-Konstante #on("i")#muß#off("i")# aber mit einem Anfüh + rungszeichen enden. +#on ("b")# +Beispiele:#off ("b")# "tadellos", "!?': alles mögliche" +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.2. + + + +Variablen +#on ("b")# +Anfangszeichen:#off ("b")# Buchstaben +#on ("b")# +Folgezeichen:#off ("b")# zusätzlich: Punkt '.', Ziffern 0 bis 9, Zeichen '$', '%', '!' und '\#' +#on ("b")# +Beispiele:#off ("b")# zeiger, A$, Zahl!, n%, var\#4.3% +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.3. + + + +Felder/Feldelemente +wie Variablen, jedoch gefolgt von '(', den Indexangaben und ')' +#on ("b")# +Beispiele:#off ("b")# zeiger (3), A$ (pointer), Zahl! (7), n% (a, b, c + d) +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.3. + + + +Benutzer-definierte Funktionen +#on ("b")# +Anfangszeichen:#off ("b")# FN +#on ("b")# +Folgezeichen:#off ("b")# Buchstaben, Punkt '.', Ziffern 0 bis 9, + Zeichen '$', '%', '!' und '\#' +#on ("b")# +Beispiele:#off ("b")# FNfunct, FNgauss%, FNf!4.5.6d\# +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.5. + + + +EOS (End of Statement, Anweisungsende) +Doppelpunkt ':' + +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.1. + + + +EOL (End of Line, Zeilenende) +Apostrophzeichen ' oder Ende der Dateizeile +EOL bedeutet gleichzeitig auch EOS + +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.1. + + + +EOF (End of File, Dateiende) +Ende der Quelldatei +EOF bedeutet gleichzeitig auch EOL (und somit auch EOS) + +#on ("b")# +Vergleiche:#off ("b")# Kapitel 4.1. + + + +Trennzeichen +Alle bisher nicht genannten Zeichen werden vom Scanner als Trennzeichen behan +delt. In BASIC benötigte Trennzeichen sind das Komma (','), das Semikolon (';') sowie +die beiden runden Klammern '(' und ')'. +Zeichen mit Codes kleiner als 32 (Steuerzeichen) werden vom Scanner überlesen. +#page# +#head# +EUMEL-BASIC-Compiler Anhang C: Übersicht über die Fehlermeldungen % + +#end# + +Anhang C: Übersicht über die Fehlermeldungen + + +Übersicht über die verwendeten Fehlermeldungen zur +Übersetzungszeit +Diese Übersicht enthält alle zur Übersetzungszeit möglichen Fehler, mit Ausnahme +der internen Fehler. +Die Erläuterungen geben die üblichen Ursachen für die Fehlermeldung an. Es wird +empfohlen, sich im Falle eines Fehlers außerdem in Kapitel 8 über die genaue Syntax +der betreffenden Anweisung beziehungsweise Funktion zu informieren. + + +#on ("b")#AS ohne NAME#off ("b")# +AS darf nur in NAME-Anweisungen vorkommen. + +#on ("b")#Accessrecht VAR erwartet, CONST gefunden#off ("b")# +Beim Aufruf einer ELAN-Prozedur (CALL, CHAIN oder USR) wurde ein VAR-Para +meter verlangt. Angegeben wurde aber ein CONST-Parameter (zum Beispiel ein +Ausdruck). + +#on ("b")#Ausdruck erwartet#off ("b")# +Es wurde ein numerischer oder TEXT-Ausdruck erwartet. Diese Fehlermeldung +erscheint zum Beispiel, wenn nach einem Operator kein Ausdruck mehr gefunden +wird. + +#on ("b")#BASE ohne OPTION#off ("b")# +BASE darf nur in OPTION BASE-Anweisungen vorkommen. + +#on ("b")#Bei SWAP nur gleiche Variablentypen erlaubt#off ("b")# +Mit SWAP können nur Variablen von genau dem gleichen Typ bearbeitet werden. + +#on ("b")#Das Feld ist bereits dimensioniert#off ("b")# +Diese Fehlermeldung erscheint bei DIM-Anweisungen, wenn das Feld vorher schon +explizit oder automatisch dimensioniert wurde. + +#on ("b")#ELSE ohne IF#off ("b")# +ELSE darf nur in IF-Anweisungen vorkommen. ELSE muß in der gleichen Zeile +stehen wie die zugehörige IF-Anweisung. + +#on ("b")#Falsche Felddimension: +Dimensioniert in ... Dimensionen, gefundene Anzahl Indizes: ...#off ("b")# +Beim Zugriff auf ein Feldelement wurden zu viele oder zu wenig Indizes angegeben. + +#on ("b")#FOR ohne NEXT#off ("b")# +Diese Fehlermeldung erscheint, wenn am Programmende für eine FOR-Anweisung +kein korrespondierendes NEXT gefunden wurde. + +#on ("b")#Falsche Reihenfolge der Zeilennummern#off ("b")# +Die Zeilennummern wurden nicht in aufsteigender Reihenfolge angegeben. + +#on ("b")#Falscher Typ#off ("b")# +Es wurde ein anderer Datentyp erwartet als angegeben, und es konnte keine automa +tische Konvertierung vorgenommen werden. + +#on ("b")#Falscher Typ der Operanden#off ("b")# +Bei einem dyadischen Operator wurden Operanden angegeben, für deren Typen +dieser Operator nicht definiert ist (vergleiche Kapitel 4.4.). + +#on ("b")#Falscher Typ des Operanden#off ("b")# +Bei einem monadischen Operator wurde ein Operand angegeben, für dessen Typ +dieser Operator nicht definiert ist (vergleiche Kapitel 4.4.). + +#on ("b")#Fehlerhafte Bereichsangabe#off ("b")# +Diese Fehlermeldung kann bei den Anweisungen DEFDBL, DEFINT, DEFSNG und +DEFSTR auftreten, wenn bei einer Bereichsangabe der Buchstabe vor dem Binde +strich im Alphabet nach dem Buchstaben hinter dem Bindestrich steht. + +#on ("b")#Fehlerhafte Dimensionierung: Die Obergrenze muß >= 1 sein#off ("b")# +Es wurde versucht, ein Feld mit dem größten Index null in einer Dimension zu +dimensionieren, obwohl die Index-Untergrenze mit OPTION BASE auf eins einge +stellt war. + +#on ("b")#Fehlerhafte Laufvariable#off ("b")# +Nach einer NEXT-Anweisung wurde eine Laufvariable gefunden, die nicht zur letzten +anhängigen FOR-Anweisung gehört. Der Fehler tritt auf, wenn Schleifen geschachtelt +wurden. + +#on ("b")#Fehlerhafte Zeilennummer#off ("b")# +Die Zeilennumer entspricht nicht der Syntax für Zeilennumern. + +#on ("b")#Fehlerhafter Funktionsaufruf#off ("b")# +- Die Prozedur liefert keinen Wert + Es wurde versucht, eine Prozedur mit USR aufzurufen, die keinen Wert liefert. +- Der Typ des Resultats ist nicht erlaubt, gefunden: ... + Es wurde versucht, eine Prozedur mit USR aufzurufen, die ein Objekt liefert, + dessen Datentyp in BASIC nicht bekannt ist. +- Kein Argument erwartet + Es wurde versucht, eine benutzer-definierte Funktion, die ohne Parameter definiert + wurde, mit Argument(en) aufzurufen. +- ... Argument(e) erwartet + Die Anzahl der angegebenen Argumente ist kleiner als die Anzahl der bei der + Funktionsdefinition angegebenen Parameter. +- Nur ... Argument(e) erwartet + Die Anzahl der angegebenen Argumente ist größer als die Anzahl der bei der Funk + tionsdefinition angegebenen Parameter. +- Kein Resultat erlaubt (gefunden: ...) + Bei CALL oder CHAIN wurde versucht, eine wertliefernde Prozedur aufzurufen. + +#on ("b")#Funktionsaufruf ohne Zusammenhang#off ("b")# +Es wurde ein Funktionsaufruf angegeben, wo eine Anweisung erwartet wurde. + +#on ("b")#GO ohne TO oder SUB#off ("b")# +Das reservierte Wort GO kann nur in GO SUB oder GO TO auftreten. + +#on ("b")#Interner Fehler#off ("b")# +Bei der Übersetzung wurde innerhalb des Compilerprogramms ein interner Fehler +ausgelöst. (vergleiche Kapitel 7.1.) + +#on ("b")#Nach OPTION BASE ist nur 0 oder 1 erlaubt#off ("b")# +Es wurde versucht, eine Zahl > 1 nach OPTION BASE anzugeben. + +#on ("b")#NEXT ohne FOR#off ("b")# +Es wurde eine NEXT-Anweisung gefunden, die keiner FOR-Anweisung zuzuordnen +ist, da keine "offenen" FOR-Schleifen mehr anhängig sind. + +#on ("b")#Nicht implementiert#off ("b")# +Einige reservierte Wörter werden vom BASIC-Compiler erkannt, obwohl die zugehö +rigen Anweisungen oder Funktionen nicht implementiert sind (vgl. Anhang A). + +#on ("b")#Parametervariable kommt mehrmals vor#off ("b")# +Bei der Definition einer "user function" kommt ein Parameter in der Parameterliste +mehr als einmal vor. + +#on ("b")#Rekursive Funktionsdefinition#off ("b")# +Es wurde versucht, in der Definition einer "user function" die zu definierende Funk +tion aufzurufen. + +#on ("b")#STEP ohne FOR#off ("b")# +STEP darf nur in FOR-Anweisungen vorkommen. + +#on ("b")#SUB ohne GO#off ("b")# +SUB darf nur in GOSUB vorkommen. + +#on ("b")#Syntaxfehler: <nähere Fehlerangabe>#off ("b")# +Wenn dieser Fehler erscheint, wurde vom Compiler eine Angabe gefunden, die nach +den Syntaxregeln dort nicht erwartet wurde oder fehlerhaft ist. + +#on ("b")#TAB ohne (L)PRINT#off ("b")# +TAB darf nur in PRINT- und LPRINT-Anweisungen vorkommen. + +#on ("b")#THEN ohne IF#off ("b")# +THEN darf nur in IF-Anweisungen vorkommen. THEN muß in der gleichen Zeile +stehen wie die zugehörige IF-Anweisung. + +#on ("b")#TO ohne Zusammenhang#off ("b")# +TO darf nur in FOR-Anweisungen oder in GO TO vorkommen. + +#on ("b")#Text zu lang#off ("b")# +Dieser Fehler erscheint, wenn ein Anführungszeichen fehlt beziehungsweise ein +Anführungszeichen zu viel gefunden wird. + +#on ("b")#Unbekannte Funktion, Argument(e) angegeben: ...#off ("b")# +Es wurde versucht, eine Funktion mit einem Argument aufzurufen, für dessen Typ die +Funktion nicht definiert ist. + +#on ("b")#Unbekannte Prozedur, Parameter angegeben: ...#off ("b")# +Die angegebene Prozedur konnte mit den angegebenen Parametertypen nicht gefun +den werden. + +#on ("b")#Undefinierte 'user function'#off ("b")# +Es wurde versucht, eine benutzer-definierte Funktion aufzurufen, die (noch) nicht +definiert wurde. + +#on ("b")#USING ohne (L)PRINT#off ("b")# +USING darf nur in PRINT- und LPRINT-Anweisungen vorkommen. + +#on ("b")#WEND ohne WHILE#off ("b")# +Es wurde eine WEND-Anweisung gefunden, die keiner WHILE-Anweisung zuzuord +nen ist, da keine "offenen" WHILE-Schleifen mehr anhängig sind. + +#on ("b")#WHILE ohne WEND#off ("b")# +Diese Fehlermeldung erscheint, wenn am Programmende für eine WHILE-Anweisung +kein korrespondierendes WEND gefunden wurde. + +#on ("b")#Zeile mit dieser Nummer existiert nicht#off ("b")# +Es wurde versucht, mit GOTO oder GOSUB zu einer Zeilennumer zu verzweigen, die +im Programm nicht angegeben wurde. + + + + +Übersicht über die innerhalb des BASIC-Systems +ausgelösten Laufzeitfehler +Die meisten Laufzeitfehler werden auch bei BASIC-Programmen im EUMEL-System +erzeugt (vergleiche Kapitel 7.2.). Einige werden aber innerhalb des BASIC-Systems +erzeugt. Die nachfolgende Übersicht enthält die innerhalb des BASIC-Systems aus +gelösten Fehler mit Angabe des gelieferten Fehlercodes und der Fehlermeldung. + +#on ("b")#Fehlercode:#off ("b")# 1003 +#on ("b")#Fehlermeldung:#off ("b")# RETURN ohne GOSUB +Eine RETURN-Anweisung wurde gefunden, obwohl keine GOSUB-Anweisung mehr +anhängig war. + + +#on ("b")#Fehlercode:#off ("b")# 1004 +#on ("b")#Fehlermeldung:#off ("b")# RESTORE: Keine DATA-Anweisung in oder nach +#right#Zeile ... gefunden +Eine RESTORE-Anweisung konnte nicht ausgeführt werden, weil in oder nach der in +der Anweisung angegebenen Zeilennummer keine DATA-Anweisung mehr steht. + + +#on ("b")#Fehlercode:#off ("b")# 1005 +#on ("b")#Fehlermeldung:#off ("b")# bei ^: negative Basis, gebrochener Exponent: ... +Es wurde versucht, eine negative Zahl mit einer gebrochenen Zahl zu potenzieren. + + +#on ("b")#Fehlercode:#off ("b")# 1005 +#on ("b")#Fehlermeldung:#off ("b")# USING: kein Format gefunden +Bei einer PRINT USING-Anweisung wurde kein Format für die Ausgabe angegeben +oder die Formatzeichenkette enthält keine Formatzeichen. + + +#on ("b")#Fehlercode:#off ("b")# 1005 +#on ("b")#Fehlermeldung:#off ("b")# USING-Format fehlerhaft: ... +Bei einer PRINT USING-Anweisung wurde ein fehlerhaftes Format angegeben. + + +#on ("b")#Fehlercode:#off ("b")# 1004 +#on ("b")#Fehlermeldung:#off ("b")# Keine Daten mehr für READ +Es stehen keine Daten mehr für die READ-Anweisung zur Verfügung; der READ- +DATA-Zeiger zeigt hinter das Ende der letzten DATA-Anweisung. + + +#on ("b")#Fehlercode:#off ("b")# 1005 +#on ("b")#Fehlermeldung:#off ("b")# WIDTH: negative Angabe: ... +Nach WIDTH wurde eine negative Zahl gefunden. + + +#on ("b")#Fehlercode:#off ("b")# 1013 +#on ("b")#Fehlermeldung:#off ("b")# READ: Falscher Datentyp, ... ist kein INT +Einer INT-Variablen konnte kein Wert zugewiesen werden, da das aktuelle Objekt +aus der DATA-Liste keine gültige Darstellung eines INT-Wertes war oder ein +"quoted string" gefunden wurde. + + +#on ("b")#Fehlercode:#off ("b")# 1013 +#on ("b")#Fehlermeldung:#off ("b")# READ: Falscher Datentyp, ... ist kein REAL +Einer REAL-Variablen konnte kein Wert zugewiesen werden, da das aktuelle Objekt +aus der DATA-Liste keine gültige Darstellung eines REAL-Wertes war oder ein +"quoted string" gefunden wurde. + + +#on ("b")#Fehlercode:#off ("b")# 1051 (interner Fehler) +#on ("b")#Fehlermeldung:#off ("b")# variierend +Bei der Ausführung des Programms trat in einer Prozedur des BASIC-Systems ein +interner Fehler auf. (Vergleiche Kapitel 7.) + + +#on ("b")#Fehlercode:#off ("b")# 1080 +#on ("b")#Fehlermeldung:#off ("b")# INPUT-Fehler ( Fehlerart ) : > Eingabezeile < +Bei einer INPUT-Anweisung, die auf eine mit 'sysin' eingestellte Datei wirken sollte, +kam es zu einem Fehler der angegebenen Fehlerart. Nach dem Doppelpunkt wird die +Eingabezeile aus der Eingabedatei ausgegeben. +#page# +#head# +EUMEL-BASIC-Compiler Anhang D: ELAN-Prozeduren des Compilers % + +#end# + +Anhang D: ELAN-Prozeduren des Compilers + + #on ("b")#PROC #ib(3)#basic#ie(3)# (TEXT CONST dateiname)#off ("b")# + Das in der Datei 'dateiname' enthaltene BASIC-Programm wird dem BASIC- + Compiler zur Übersetzung übergeben. Werden keine Fehler gefunden, so wird das + Programm direkt nach der Übersetzung ausgeführt. + Beispiel: + + basic ("Mein liebstes BASIC-Programm")#off ("b")# + + + #on ("b")#PROC basic (TEXT CONST dateiname, prozedurname)#off ("b")# + Das in der Datei 'dateiname' enthaltene BASIC-Programm wird dem BASIC- + Compiler zur Übersetzung übergeben. Werden keine Fehler gefunden, dann wird + das Programm unter dem Namen 'prozedurname' dauerhaft eingetragen (inser + tiert). + Das Programm wird nicht ausgeführt. Beachten Sie, daß der Prozedurname den + Vorschriften für ELAN-Prozedurnamen entsprechen muß und außerdem #on ("b")#keine + Leerzeichen#off ("b")# enthalten darf. (Zur Namenswahl siehe auch Kapitel 3.) + Beispiel: + + basic ("Mein liebstes BASIC-Programm", "liebstesprogramm")#off ("b")# + + + + #on ("b")#PROC #ib(3)#basic list#ie(3)# (BOOL CONST status)#off ("b")# + Mit der Prozedur 'basic list' kann eingestellt werden, ob die gerade vom Compiler + übersetzten Programmzeilen angezeigt werden sollen oder nicht (vergleiche Kapitel + 3.). + + basic list (TRUE)#off ("b")#: Die übersetzten Zeile werden angezeigt + basic list (FALSE)#off ("b")#: Die übersetzten Zeile werden nicht angezeigt + + + #on ("b")#PROC #ib(3)#basic page#ie(3)# (BOOL CONST status)#off ("b")# + Mit der Prozedur 'basic page' kann eingestellt werden, wie die Ausgaben von + BASIC-Programmen behandelt werden, wenn der Bildschirm voll ist (vergleiche + Kapitel 5, Steuerung der Bildschirmausgaben). + + basic page (TRUE): Beim Erreichen des Bildschirmendes wird auf einen + Tastendruck gewartet (vgl. Kap. 5.) + basic page (FALSE): Beim Erreichen des Bildschirmendes wird 'gescrollt'. + diff --git a/lang/basic/1.8.7/doc/basic handbuch.index b/lang/basic/1.8.7/doc/basic handbuch.index new file mode 100644 index 0000000..4ac7e16 --- /dev/null +++ b/lang/basic/1.8.7/doc/basic handbuch.index @@ -0,0 +1,232 @@ +#page nr ("%",115)# +#head# +EUMEL-BASIC-Compiler Stichwortverzeichnis % + +#end# + +Stichwortverzeichnis + +>= 15 +\ 14 +- 14 ++ 14 ++ 15 +<= 15 +* 14 +/ 14 += 15 +> 15 +< 15 +<> 15 +^ 14 +ABS 31 +AND 16 +Anführungszeichen 10 +Argument 21 +Arithmetische Operatoren 14 +Arrays 13 +ASC 32 +ATN 32 +Äquivalenz-Verknüpfung 17 +Aufruf benutzer-definierter Funktionen 21 +Aufruf und Steuerung des BASIC-Compilers 5 +basic 5, 113 +BASIC-Compiler ERROR 28 +basic list 6, 113 +basic page 25, 114 +benutzer-definierte Funktionen 19, 104 +Bildschirmausgaben 25 +CALL 23, 33 +CDBL 35 +CHAIN 23, 35 +CHR$ 35 +CINT 36 +CLS 36 +Codebereichs pro Task 27 +Compiler Error 304 26 +Compiler Error 307 26 +Compiler Error 308 26 +COS 37 +CSRLIN 37 +CVD, CVI 38 +DATA 38 +DATE$ 40 +Datentypen 10 +Datentyp INT 10 +Datentyp REAL 10 +Datentyp TEXT 10 +Debugging 6 +DEFDBL, DEFINT, DEFSNG, DEFSTR 40 +DEF FN 19, 28, 42 +Definition benutzer-definierter Funktionen 19 +DEFINT 12 +DEFSTR 12 +DIM 13, 43 +Dimensionen 13 +Doppelpunkt 8 +ELSE 54 +END 45 +EOF 56 +EOF (End of File, Dateiende) 7, 105 +EOL (End of Line, Zeilenende) 8, 105 +EOS (End of Statement, Anweisungsende) 8, 105 +EQV 17 +ERL 46 +ERM$ 47 +ERR 47 +ERROR 48 +EUMEL-Coder 26 +EUMEL-Textdatei 7 +Exklusiv-ODER-Verknüpfung 17 +EXP 49 +Exponent 10 +Fehlerbehandlung 28 +Fehlercodes 30 +Fehlerzeile 30 +Fehler zur Laufzeit 30, 111 +Fehler zur Übersetzungszeit 28, 106 +Felder (Arrays) 13 +Felder/Feldelemente 104 +Feldnamen 13 +FIX 49 +FOR 50 +FRE 51 +Funktionen 19 +Funktionsaufrufe 19 +Ganzzahlen 10 +Generatorprogramm 4 +Gleitkommazahlen 10 +GOSUB 52 +GOTO 53 +Grenzen des Compilers 26 +Groß-/Kleinschreibung 9 +Hauptdurchlauf 28 +HEX$ 54 +Hochkomma 8 +IF 54 +IMP 17 +Implikations-Verknüpfung 17 +Indizes 13 +INKEY$ 56 +INPUT$ 58 +INPUT 56 +Insertieren von BASIC-Programmen 5 +Installation des BASIC-Compilers 4 +INSTR 59 +INT 59 +Interne Compilerfehler 28 +INTs 10 +INT-Überlauf 15 +KILL 60 +Konstanten 10 +Konvertierung 15, 22 +Kriterien für den Typ einer Variablen 12 +Labels 26 +Leerzeichen 9 +LEFT$ 60 +LEN 61 +LET 61 +LINE INPUT 62 +LOG 63 +Logische Operatoren 16 +LPOS 63 +LPRINT 64 +LSET 65 +Mantisse 11 +MID$ 65, 66 +MKD$, MKI$ 67 +MOD 14 +Modulgrenze 26 +NAME 68 +Namenstabelle 27 +Negation 16 +negative Zahlenwerte 11 +NEXT 50, 68 +NOT 16 +Notation 3 +Notebook 28 +numerische Konstanten 103 +OCT$ 69 +ODER-Verknüpfung 17 +ON 69 +Operatoren 103 +Operatoren, arithmetische 14 +Operatoren, logische 16 +Operatoren, Text- 15 +Operatoren, Vergleichs- 15 +Operator, Zuweisungs- 18 +OPTION BASE 13, 71 +OR 17 +Parameter 19 +POS 72 +PRINT 72 +Prioritäten der Operanden 18 +Programmdatei 7 +Programmsegmente 24 +Programmzeile 7 +RANDOMIZE 75 +READ 75 +REM 77 +Reservierte Wörter 9, 12, 100, 103 +RESTORE 77 +RETURN 78 +RIGHT$ 79 +RND 80 +RSET 81 +Scanner 9, 103 +Schlüsselwörter 9 +Scrolling 25 +SGN 81 +SIN 82 +SPACE$ 82 +SPC 83 +SQR 83 +Standard-Funktionen 19 +STEP 50 +Steuerung der Bildschirmausgaben 25 +Steuerung des BASIC-Compilers 5 +STOP 84 +STR$ 84 +STRING$ 85 +SUB 52 +SWAP 86 +Symbol 9 +Symboltypen 103 +Syntax 7 +sysout 6 +TAB 64, 72 +TAN 86 +Texte 10 +TEXT-Konstanten 104 +Text-Operator + 15 +THEN 54 +TIME$ 88 +TIMER 87 +TO 50, 53 +Trennzeichen 105 +TRON / TROFF 88 +Typanpassung 22 +UND-Verknüpfung 16 +USING 64, 72 +USR 23, 90 +Übersetzen von BASIC-Programmen 5 +Übersichtlichkeit von BASIC-Programmen 7 +VAL 91 +Variablen 12, 104 +Variablennamen 9, 12 +VAR-Parameter 23 +Vergleichsoperatoren 15 +Vordurchlauf 28 +Vorzeichen 11 +Wahrheitswerte 16 +Weitere Schreibregeln 9 +WEND 92 +wertliefernden Prozeduren 23 +WHILE 92 +WIDTH 93 +WRITE 94 +XOR 17 +Zahlen 10 +Zeilennummer 7 +Zuweisungsoperator 18 + diff --git a/lang/basic/1.8.7/source-disk b/lang/basic/1.8.7/source-disk new file mode 100644 index 0000000..c87f56d --- /dev/null +++ b/lang/basic/1.8.7/source-disk @@ -0,0 +1 @@ +informatikpaket/02_basic.img diff --git a/lang/basic/1.8.7/src/BASIC.Administration b/lang/basic/1.8.7/src/BASIC.Administration new file mode 100644 index 0000000..6df6854 --- /dev/null +++ b/lang/basic/1.8.7/src/BASIC.Administration @@ -0,0 +1,1886 @@ +(***************************************************************************) +(* *) +(* Zweite von drei Dateien des EUMEL-BASIC-Systems *) +(* *) +(* Autor: Heiko Indenbirken *) +(* Überarbeitet von: Rudolf Ruland und Michael Overdick *) +(* *) +(* Stand: 27.10.1987 *) +(* *) +(***************************************************************************) + +PACKET basic errors DEFINES basic error, (* Autor: Heiko Indenbirken *) + return error, (* Stand: 26.08.1987/rr/mo *) + basic warning: + +TEXT VAR erste zeile, + message; +LET errorsize = 40; +LET ERROR = STRUCT (INT no, TEXT msg); + +ROW errorsize ERROR CONST error msg :: ROW errorsize ERROR : +(ERROR:( 1, "NEXT ohne FOR"), + ERROR:( 2, "Syntaxfehler:"), + ERROR:( 5, "Fehlerhafter Funktionsaufruf"), + ERROR:( 8, "Zeile mit dieser Nummer existiert nicht"), + ERROR:(10, "Das Feld ist bereits dimensioniert"), + ERROR:(13, "Falscher Typ:"), + ERROR:(15, "Text zu lang"), + ERROR:(18, "Undefinierte 'user function'"), + ERROR:(22, "Ausdruck erwartet"), + ERROR:(26, "FOR ohne NEXT"), + ERROR:(29, "WHILE ohne WEND"), + ERROR:(30, "WEND ohne WHILE"), + ERROR:(51, "Interner Fehler"), + ERROR:(80, "Fehlerhafte Zeilennummer"), + ERROR:(81, "Falsche Reihenfolge der Zeilennummern"), + ERROR:(82, "Falscher Typ des Operanden:"), + ERROR:(83, "Falscher Typ der Operanden:"), + ERROR:(84, "Falsche Felddimension:"), + ERROR:(85, "Rekursive Funktionsdefinition"), + ERROR:(86, "Fehlerhafte Laufvariable:"), + ERROR:(87, "Fehlerhafte Bereichsangabe:"), + ERROR:(88, "Fehlerhafte Dimensionierung:"), + ERROR:(89, "Parametervariable kommt mehrmals vor"), + ERROR:(90, "AS ohne NAME"), + ERROR:(91, "BASE ohne OPTION"), + ERROR:(92, "ELSE ohne IF"), + ERROR:(93, "STEP ohne FOR"), + ERROR:(94, "TAB ohne (L)PRINT"), + ERROR:(95, "THEN ohne IF"), + ERROR:(96, "TO ohne Zusammenhang"), + ERROR:(97, "USING ohne (L)PRINT"), + ERROR:(98, "Unbekannte Funktion,"), + ERROR:(99, "Unbekannte Prozedur,"), + ERROR:(100,"Nicht implementiert"), + ERROR:(101,"SUB ohne GO"), + ERROR:(102,"GO ohne TO oder SUB"), + ERROR:(103,"Accessrecht VAR erwartet, CONST gefunden"), + ERROR:(104,"Funktionsaufruf ohne Zusammenhang"), + ERROR:(105,"Nach OPTION BASE ist nur 0 oder 1 erlaubt"), + ERROR:(106,"Bei SWAP nur gleiche Variablentypen erlaubt")); + +TEXT PROC errortext (INT CONST no): + INT VAR i; + FOR i FROM 1 UPTO errorsize + REP IF errormsg [i].no = no + THEN LEAVE errortext WITH errormsg [i].msg FI + PER; + "Unbekannter BASIC-Fehler #" + text (no) . +END PROC errortext; + +PROC basic error (TEXT CONST packet, + INT CONST error nr, + INT CONST line nr, + INT CONST statement nr, + TEXT CONST position, addition, + BOOL CONST leave statement): + erste zeile aufbauen; + einfache fehlermeldung aufbauen; + diese auf terminal ausgeben; + diese in sysout datei ausgeben wenn noetig; (* F20/rr *) + fehlermeldung in fehlerdatei ausgeben; + IF leave statement (* DEF/mo *) + THEN errorstop (101, packet + "-Fehler") + FI. + +erste zeile aufbauen: + IF line nr = 0 AND statement nr = 0 + THEN erste zeile := "FEHLER" + ELSE erste zeile := "FEHLER (Dateizeile "; + erste zeile CAT text (line nr); + erste zeile CAT ") in Zeile "; + erste zeile CAT text (statement nr); + FI; + + erste zeile CAT " bei >> "; + erste zeile CAT position; + erste zeile CAT " << : " . + +einfache fehlermeldung aufbauen: + message := " "; + message CAT error text (error nr); + message CAT " " . + +diese auf terminal ausgeben: (* F20/rr *) + display (""13""10""); + display (erste zeile); + display (""13""10""); + display (message + addition); + display (""13""10"") . + +diese in sysout datei ausgeben wenn noetig : (* F20/rr *) + IF sysout <> "" + THEN putline (erste zeile); + putline (message + addition); + line; + FI . + +fehlermeldung in fehlerdatei ausgeben: + note (erste zeile); + note line; + note (message); + note (addition); + note line . + +END PROC basic error; + +PROC basic warning (INT CONST line nr, (* mo *) + statement nr, + TEXT CONST warning text): +generate warning; +on screen; +in sysout file; +into the notebook. + +generate warning: + IF line nr = 0 AND statement nr = 0 + THEN erste zeile := "WARNUNG" + ELSE erste zeile := "WARNUNG (Dateizeile "; + erste zeile CAT text (line nr); + erste zeile CAT ") in Zeile "; + erste zeile CAT text (statement nr); + FI; + erste zeile CAT ": "; + erste zeile CAT warning text. + +on screen: + display (""13""10""); + display (erste zeile); + display (""13""10""). + +in sysout file: + IF sysout <> "" + THEN putline (erste zeile); + line; + FI. + +into the notebook: + IF warnings + THEN note (erste zeile); + note line + FI. + +END PROC basic warning; + +PROC return error: + errorstop (1003, "RETURN ohne GOSUB") +END PROC return error; + +END PACKET basic errors; + +PACKET basic types DEFINES symbol of, (* Autor: Heiko Indenbirken *) + type of, (* Stand: 07.09.1987/rr/mo *) + dim of, + shift, deshift, + reserved, + param list, + is bool op: + +LET (* S y m b o l T y p e n *) + any = 0, const = 1, var = 2, array = 3, + expr = 4, unused = 5, letter = 6, param = 7, + res word = 8, operator = 9, eos = 10, del = 11, + stat no = 12, eol = 13, eop = 14, + user fn = 20; (* DEF/mo *) +(* Operatoren *) +LET less equal = 28, unequal = 29, greater equal = 30; + +TEXT VAR dummy; + +TEXT PROC symbol of (INT CONST n) : + IF n < 0 + THEN ""19"" + symbol of (-n) + ELSE SELECT n OF + CASE less equal : "<=" + CASE unequal : "<>" + CASE greater equal : ">=" + + CASE eos : "EOS" + CASE eol : "EOL" + CASE eop : "EOF" + OTHERWISE : character END SELECT + FI . + +character : + IF n > 32 AND n < 128 + THEN code (n) + ELIF n >= 128 AND n <= 255 + THEN res word of (n) + ELSE "%" + subtext (text (n+1000), 2) + " " FI . + +END PROC symbol of; + +TEXT PROC type of (INT CONST n) : + SELECT n OF + CASE any : "ANY" + CASE const : "Konstante" + CASE var : "Variable" + CASE array : "Feld" + CASE expr : "Ausdruck" + CASE unused : " -?- " + CASE letter : "Buchstabe" + CASE param : "Parameter" + CASE res word : "reserviertes Wort" + CASE operator : "Operator" + CASE eos : "EOS" + CASE del : "Trennzeichen" + CASE stat no : "Zeilennumer" + CASE eol : "EOL" + CASE eop : "EOF" + CASE user fn : "'user function'" (* DEF/mo *) + OTHERWISE "?TYPE #" + text (n) ENDSELECT. +END PROC type of; + +TEXT PROC dim of (TEXT CONST parameter): + IF parameter = "" + THEN "" + ELSE base limits and size FI . + +base limits and size: + INT CONST dimension :: (LENGTH parameter DIV 2) - 2; + TEXT VAR result :: text (parameter ISUB dimension+1); + INT VAR i; + result CAT ": ["; + FOR i FROM 1 UPTO dimension-1 + REP result CAT text (parameter ISUB i); + result CAT ", " + PER; + result CAT text (parameter ISUB dimension); + result CAT "] "; + result CAT text (parameter ISUB dimension+2); + result . + +END PROC dim of; + +TEXT PROC param list (INT CONST first, no): + IF no < first + THEN "keine" + ELSE parameter list FI . + +parameter list: + INT VAR i; + TEXT VAR result :: "("; + FOR i FROM first UPTO no + REP result CAT dump (dtype (i)); + IF i = no + THEN result CAT ")" + ELSE result CAT ", " FI + PER; + result . + +END PROC param list; + +TEXT PROC shift (TEXT CONST word) : + INT VAR i; + dummy := word; + FOR i FROM 1 UPTO length (word) + REP shift char PER; + dummy . + +shift char: + INT VAR local letter :: code (dummy SUB i); + IF 97 <= local letter AND local letter <= 122 + THEN replace (dummy, i, code (local letter - 32)) FI . + +END PROC shift; + +TEXT PROC deshift (TEXT CONST word) : + INT VAR i; + dummy := word; + FOR i FROM 1 UPTO length (word) + REP deshift char PER; + dummy . + +deshift char: + INT VAR local letter :: code (dummy SUB i); + IF 65 <= local letter AND local letter <= 90 + THEN replace (dummy, i, code (local letter + 32)) FI; + +END PROC deshift; + +(* Verwaltung der Reservierten BASIC-Wörter *) +LET first operator = 249, (* MOD NOT AND OR XOR EQV IMP *) + first bool op = 250; (* 249 250 251 252 253 254 255 *) + +INT VAR index; +ROW 9 TEXT VAR res words :: ROW 9 TEXT : +("", + ""129"as"163"go"167"if"188"on"217"to"252"or", + ""128"abs"130"asc"131"atn"141"cos"142"cvd"143"cvi"145"def"150"dim"152"end"153"eof"154"erl"155"err"157"exp"159"fix"160"for"161"fre"162"get"172"int"175"len"176"let"178"loc"179"log"191"out"192"pos"194"put"202"rnd"197"rem"204"sgn"205"sin"207"spc"208"sqr"214"tab"215"tan"221"val"227"cls"234"usr"235"sub"249"mod"250"not"251"and"253"xor"254"eqv"255"imp", + ""132"base"133"call"134"cdbl"136"chr$"137"cint"144"data"151"else"165"goto"166"hex$"173"kill"177"line"181"lset"182"mid$"183"mkd$"184"mki$"185"name"186"next"187"oct$"189"open"196"read"203"rset"209"step"210"stop"211"str$"213"swap"216"then"219"tron"222"wait"223"wend"228"erm$"230"lpos", + ""135"chain"138"clear"139"close"156"error"158"field"164"gosub"169"input"171"instr"174"left$"193"print"218"troff"220"using"224"while"225"width"226"write"231"time$"232"date$"233"timer", + ""140"common"146"defdbl"147"defint"148"defsng"149"defstr"168"inkey$"170"input$"180"lprint"190"option"199"resume"200"return"201"right$"206"space$"229"csrlin", + ""198"restore"212"string$", + "", + ""195"randomize"); + +BOOL PROC reserved (TEXT CONST name, INT VAR no, type): + IF reserve is not possible COR not found within res words + THEN FALSE + ELSE no := code (this words SUB (index-1)); + type := res word or op; + TRUE + FI . + +reserve is not possible: + INT CONST len :: length (name); + len < 2 OR len > 9 . + +not found within res words: + index := pos (this words, name); + index = 0 . + +this words: + res words [len] . + +res word or op: + IF no >= first operator + THEN operator + ELSE res word FI . + +END PROC reserved; + +INT PROC reserved (TEXT CONST name): + IF reserve is not possible COR not found within res words + THEN 0 + ELSE code (this words SUB (index-1)) FI . + +reserve is not possible: + INT CONST len :: length (name); + len < 2 OR len > 9 . + +not found within res words: + index := pos (this words, name); + index = 0 . + +this words: + res words [len] . + +END PROC reserved; + +TEXT PROC res word of (INT CONST no): + INT VAR i; + FOR i FROM 2 UPTO 9 + REP index := pos (res words [i], code (no)); + IF index > 0 + THEN LEAVE res word of WITH shift (this name) FI + PER; + "" . + +this name: + subtext (res words [i], index+1, next code) . + +next code: + INT VAR c := pos (res words [i], ""127"", ""255"", index+1); + IF c = 0 + THEN length (res words [i]) + ELSE c-1 FI . + +END PROC res word of; + +BOOL PROC is bool op (INT CONST no): (* mo *) + no >= first bool op +END PROC is bool op; + +END PACKET basic types; + +PACKET basic table handling DEFINES init table, (* Autor: Heiko Indenbirken *) + put name, (* Stand: 13.08.1987/rr/mo *) + known, name of, + remember, + recognize, + table entries, + hash table, next table, + scope compulsory: (* DEF/mo *) + +LET hash length = 1024, + hash length minus one = 1023, + start of name table = 256, + table length = 4500; + +LET SYMBOL = STRUCT (INT type, ADDRESS adr, DTYPE data, TEXT dim); +LET TABLE = STRUCT (INT entries, + ROW hash length INT hash table, + ROW table length INT next, + ROW table length TEXT name table, + ROW table length SYMBOL symbol table); + +DATASPACE VAR table space; +BOUND TABLE VAR table; +INITFLAG VAR tab := FALSE; +SYMBOL CONST nilsymbol :: SYMBOL:(0, LOC 0, void type, ""); +INT VAR i; +BOOL VAR compulsory with scope :: TRUE; (* DEF/mo *) + +PROC init table: + IF NOT initialized (tab) + THEN table space := nilspace; + table := table space; + FI; + table.entries := start of name table; + FOR i FROM 1 UPTO hash length + REP table.hash table [i] := 0 PER; + compulsory with scope := TRUE; (* DEF/mo *) + +END PROC init table; + +PROC put name (TEXT CONST scope, name, INT VAR pointer): (* DEF/mo *) + IF compulsory with scope + THEN put name (scope + name, pointer) + ELIF NOT in table + THEN put name (name, pointer) + FI. + +in table: + hash (scope + name, pointer); + pointer := hash table (pointer); + WHILE not end of chain + REP IF name is found THEN LEAVE in table WITH TRUE FI; + pointer := table. next (pointer); + PER; + FALSE . + +name is found: + table.name table [pointer] = scope + name. + +not end of chain: + pointer > 0 . + +END PROC put name; + +PROC put name (TEXT CONST name, INT VAR pointer): + IF no entry in hash table + THEN create a new chain + ELSE create a new entry in chain FI; + insert name in name table . + +no entry in hash table: + INT VAR hash index; + hash (name, hash index); + table.hash table [hash index] = 0 . + +create a new chain: + table.hash table [hash index] := table.entries . + +create a new entry in chain: + pointer := table.hash table [hash index]; + REP IF name is found + THEN LEAVE put name + ELIF end of chain + THEN table.next [pointer] := table.entries; + LEAVE create a new entry in chain + ELSE pointer := next pointer FI + PER . + +name is found: + table.name table [pointer] = name. + +end of chain: + INT CONST next pointer := table.next [pointer]; + next pointer = 0 . + +insert name in name table: + IF table.entries >= table length + THEN errorstop ("volle Namenstabelle") FI; + + pointer := table.entries; + table.symbol table [pointer] := nilsymbol; + table.name table [pointer] := name; + table.next [pointer] := 0; + table.entries INCR 1 . + +END PROC put name; + +PROC hash (TEXT CONST name, INT VAR index) : + INT VAR j; + index := 0; + FOR j FROM 1 UPTO length (name) + REP addmult cyclic PER; + index INCR 1 . + +addmult cyclic : + index INCR index ; + IF index > hash length minus one + THEN wrap around FI; + index := (index + code (name SUB j)) MOD hash length minus one . + +wrap around: + index DECR hash length minus one . + +ENDPROC hash ; + +INT PROC table entries: + table.entries +END PROC table entries; + +INT PROC hash table (INT CONST n): + table.hash table [n] +END PROC hash table; + +INT PROC next table (INT CONST n): + table.next [n] +END PROC next table; + +TEXT PROC name of (INT CONST index): + IF index < 0 + THEN errorstop ("PROC name of: negativer Index"); "" + ELIF index < start of name table + THEN symbol of (index) + ELIF index <= table.entries + THEN table.name table (index) + ELSE errorstop ("PROC name of: Index größer als nametable"); + "" + FI + +END PROC name of; + +PROC recognize (INT CONST symb, type, ADDRESS CONST adr, DTYPE CONST data, TEXT CONST dim): + symbol.type := type; + symbol.adr := adr; + symbol.data := data; + symbol.dim := dim . + +symbol: table.symboltable [symb] . +END PROC recognize; + +PROC remember (INT CONST symb, INT VAR type, ADDRESS VAR adr, DTYPE VAR data, TEXT VAR dim): + SYMBOL CONST symbol := table.symboltable [symb]; + type := symbol.type; + adr := symbol.adr; + data := symbol.data; + dim := symbol.dim +END PROC remember; + +BOOL PROC known (INT CONST symb) : + table.symboltable [symb].type > 0 +END PROC known; + +PROC scope compulsory (BOOL CONST new state): (* DEF/mo *) + compulsory with scope := new state +END PROC scope compulsory; + +END PACKET basic table handling; + +PACKET basic scanner DEFINES begin scanning, (* Autor: Heiko Indenbirken *) + next symbol, (* Stand: 27.10.1987/rr/mo *) + next data, + next statement, + define chars, + scan line, + scan line no, (* F29/rr *) + get data types of input vars, (* F25/rr *) + basic error, + basic warning, + basic list, + set scope, + scanner scope: + + +LET (* S y m b o l T y p e n *) + any = 0, const = 1, var = 2, array = 3, + res word= 8, operator= 9, eos = 10, del =11, + stat no = 12, user fn = 20; (* DEF/mo *) + +LET (* S y m b o l z e i c h e n *) + less = 60, greater = 62, + less equal = 28, unequal = 29, greater equal = 30, + point = 46, eol = 13, eop = 14, + go = 163, gosub = 164, goto = 165, + sub = 235, to = 217; + +LET name chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz.0123456789!#$%", + quote = """", open bracket = "(", + comma = ",", close bracket = ")", + colon = ":", + exponent chars= "dDeE"; + +FILE VAR source file; +TEXT VAR defint chars, defstr chars, record, letter, + scope, new name; (* DEF/mo *) +REAL VAR r dummy; +INT VAR act stat no, record no, rec len, scan pos, i dummy; +BOOL VAR eol generated, at line begin, listing := FALSE; + +PROC define chars (TEXT CONST begin, end, DTYPE CONST data): + INT VAR i; + FOR i FROM code (begin) UPTO code (end) + REP IF data = int type + THEN defint chars CAT code (i) + ELIF data = text type + THEN defstr chars CAT code (i) + FI + PER . + +END PROC define chars; + + +PROC scanline (TEXT VAR line, INT VAR col): + line := record; + col := scan pos +END PROC scanline; + +INT PROC scan line no : record no END PROC scan line no; + + +PROC get data types of input vars (ROW 100 DTYPE VAR input var data, (* F25/rr *) + INT VAR number input vars) : + + TEXT VAR first var char; + INT VAR var pos := scan pos; + to begin of actual var; + REP get next input var; + skip brackets if necessary; + IF var char <> comma THEN LEAVE get data types of input vars FI; + skip comma; + PER; + + . var char : record SUB var pos + + . to begin of actual var : + WHILE pos (name chars, var char) <> 0 REP var pos DECR 1 PER; + var pos INCR 1; + number input vars := 0; + + . get next input var : + first var char := deshift (var char); + WHILE pos (name chars, var char) <> 0 REP var pos INCR 1 PER; + var pos DECR 1; + number input vars INCR 1; + input var data (number input vars) := var datatype (first var char, var char); + var pos := pos (record, ""33"", ""255"", var pos + 1); + + . skip brackets if necessary : + IF var char = open bracket + THEN INT VAR bracket counter := 1; + REP count bracket UNTIL bracket counter = 0 PER; + var pos := pos (record, ""33"", ""255"", var pos + 1); + FI; + + . count bracket : + INT CONST open := pos (record, open bracket, var pos + 1), + close := pos (record, close bracket, var pos + 1); + IF open > 0 + THEN IF close > 0 + THEN IF open > close + THEN close bracket found + ELSE open bracket found + FI; + ELSE open bracket found + FI; + ELSE IF close > 0 + THEN close bracket found + ELSE LEAVE get data types of input vars + FI; + FI; + + . open bracket found : + bracket counter INCR 1; + var pos := open; + + . close bracket found : + bracket counter DECR 1; + var pos := close; + + . skip comma : + var pos := pos (record, ""33"", ""255"", var pos + 1); + +END PROC get data types of input vars; + + +PROC begin scanning (FILE VAR basic file): + enable stop; + source file := basic file; + to first record (source file); + col (source file, 1); + IF eof (source file) + THEN errorstop ("Datei ist leer") FI; + + defint chars := ""; + defstr chars := ""; + scope := ""; (* DEF/mo *) + act stat no := 0; + read record (source file, record); + rec len := length (record); + scan pos := 0; + record no := 1; + eol generated := FALSE; + at line begin := TRUE; + IF listing + THEN line; + putline (record); + IF sysout <> "" + THEN cout (record no) + FI + ELSE cout (record no) + FI. + +END PROC begin scanning; + +PROC next statement: + IF eof (source file) + THEN errorstop (99, "") + ELSE eol generated := FALSE; + at line begin := TRUE; + down (source file); + read record (source file, record); + rec len := length (record); + scan pos := 0; + record no INCR 1; + FI; + IF listing + THEN putline (record); + IF sysout <> "" + THEN cout (record no) + FI + ELSE cout (record no) + FI. + +END PROC next statement; + +PROC next symbol (TEXT VAR name, INT VAR no, type, DTYPE VAR data): + enable stop; + clear symbol; + IF eol generated + THEN next statement FI; + + IF eol reached + THEN generate eol + ELIF at line begin CAND stat no found (* F15/rr *) + THEN generate stat no + ELSE generate chars FI . + +clear symbol: + name := ""; + no := 0; + type := any; + data := void type . + +eol reached: + scan pos := pos (record, ""33"", ""255"", scan pos+1); + scan pos = 0 . + +generate eol : + IF eof (source file) + THEN name := "EOF"; no := eop; type := eos + ELSE name := "EOL"; no := eol; type := eos FI; + eol generated := TRUE . + +stat no found: (* F15/rr *) + at line begin := FALSE; + pos ("0123456789", act char) <> 0 . + +generate stat no: (* F15/rr *) + INT CONST next scan pos := last number pos; + name := subtext (record, scan pos, next scan pos); + act stat no := int (name); + scan pos := next scan pos; + no := act stat no; type := stat no . + +last number pos : (* F15/rr *) + INT CONST high := pos (record, ""058"", ""255"", scan pos), + low := pos (record, ""032"", ""047"", scan pos); + IF high > 0 + THEN IF low > 0 + THEN min (high, low) - 1 + ELSE high - 1 + FI + ELIF low > 0 + THEN low - 1 + ELSE LENGTH record + FI . + +generate chars: + SELECT code (act char) OF + CASE 32: next symbol (name, no, type, data) (* Space *) + CASE 34: generate text denoter (* " *) + CASE 39: generate eol (* ' *) + CASE 42, 43, 45, 47, 92, 94, 61: generate operator (* *,+,-,/,\,^,=*) + CASE 60: generate less op (*<, <=, <> *) + CASE 62: generate greater op (*>, >= *) + CASE 46: treat point (* . *) + CASE 48, 49, 50, 51, 52, 53, 54, 55, 56, 57: + generate numeric const (* 0 - 9 *) + CASE 58: generate eos (* : *) + CASE 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, + 82, 83, 84, 85, 86, 87, 88, 89, 90, 97, 98, 99, 100, 101, 102, 103, + 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, + 118, 119, 120, 121, 122, (* small and large letters *) + generate res word or id + OTHERWISE generate delimiter END SELECT . + +generate text denoter: + get text const (name, data); + type := const . + +generate operator: + name := act char; no := code (name); type := operator . + +generate less op: + IF next char = "=" + THEN name := "<="; no := less equal; skip char + ELIF next char = ">" + THEN name := "<>"; no := unequal; skip char + ELSE name := "<"; no := less FI; + type := operator . + +generate greater op: + IF next char = "=" + THEN name := ">="; no := greater equal; skip char + ELSE name := ">"; no := greater; FI; + type := operator . + +treat point: + IF pos ("0123456789", next char) <> 0 + THEN generate numeric const + ELSE name := "."; + no := point; + type := del + FI. + +generate numeric const: + get numeric const (name, data); + type := const . + +last name char: + name SUB LENGTH name . + +generate eos: + name := ":"; no := eos; type := eos . + +generate res word or id: + get name chars; + IF reserved (deshift name, no, type) + THEN IF type = res word AND no = go + THEN treat go + FI + ELSE IF function name + THEN data := ftn datatype; + type := user fn + ELSE data := var datatype (deshift (name) SUB 1, last name char); + type := var or array + FI; + put name (scope, deshift name, no) + FI. + +treat go: + next symbol (new name, no, type, data); + IF no = to AND type = res word + THEN name CAT new name; + no := goto + ELIF no = sub AND type = res word + THEN name CAT new name; + no := gosub + ELSE scan error (102, name, "") + FI. + +get name chars: + TEXT VAR deshift name :: ""; + INT VAR begin of name :: scan pos; + FOR scan pos FROM scan pos UPTO rec len + WHILE name chars found + REP deshift name CAT deshifted char PER; + scan pos DECR 1; + name := subtext (record, begin of name, scan pos). + +name chars found: + pos (name chars, act char) > 0 . + +function name: + subtext (deshift name, 1, 2) = "fn" . + +ftn datatype: + IF last name char = "$" + THEN text type + ELIF last name char = "%" + THEN int type + ELSE real type FI . + +var or array: + IF array name + THEN name CAT "()"; + deshift name CAT "()"; (* F30/rr *) + array + ELSE var FI . + +array name: + next scan char = "(" . + +deshifted char: + letter := act char; + IF letter >= "A" AND letter <= "Z" + THEN code (code (letter) + 32) + ELSE letter FI . + +generate delimiter: + name := act char; no := code (name); type := del . + +next scan char: record SUB pos (record, ""33"", ""255"", scan pos+1). +next char: (record SUB scan pos + 1) . +act char: record SUB scan pos . +skip char: scan pos INCR 1 . +END PROC next symbol; + +DTYPE PROC var datatype (TEXT CONST first name char, last name char) : + + IF last name char = "!" OR last name char = "#" + THEN real type + ELIF last name char = "$" + THEN text type + ELIF last name char = "%" + THEN int type + ELIF pos (defint chars, first name char) > 0 + THEN int type + ELIF pos (defstr chars, first name char) > 0 + THEN text type + ELSE real type FI . + +END PROC var datatype; + +BOOL PROC next data (TEXT VAR data text, DTYPE VAR data type) : (* F17/rr *) + + data type := void type; + IF no more data + THEN scan pos := rec len; + data text := ""; + FALSE + ELIF quoted string + THEN get quoted string; + TRUE + ELSE get unquoted string; + TRUE + FI + + . no more data : + scan pos := pos (record, ""33"", ""255"", scan pos+1); + scan pos = 0 + + . quoted string : + (record SUB scan pos) = quote + + . get quoted string : + get text const (data text, data type); + + . get unquoted string : + INT CONST comma or colon pos 1 := position of comma or colon minus one; + data text := compress (subtext (record, scan pos, comma or colon pos 1)); + scan pos := comma or colon pos 1; + + . position of comma or colon minus one : + INT CONST colon pos := pos (record, colon, scan pos), + comma pos := pos (record, comma, scan pos); + IF colon pos > 0 + THEN IF comma pos > 0 + THEN min (colon pos, comma pos) - 1 + ELSE colon pos - 1 + FI + ELSE IF comma pos > 0 + THEN comma pos - 1 + ELSE LENGTH record + FI + FI + +END PROC next data; + +PROC get numeric const (TEXT VAR value, DTYPE VAR data): + get sign; + get const; + check datatype . + +get sign: + IF act char = "-" + THEN value := "-"; + scan pos INCR 1 + ELIF act char = "+" + THEN value := "+"; + scan pos INCR 1 + ELSE value := "" FI . + +get const: + get digits; + get point; + get digits; + get exponent . + +get digits: + FOR scan pos FROM scan pos UPTO rec len + WHILE digit found + REP value CAT act char PER . + +get point: + IF act char = "." + THEN value CAT "."; + scan pos INCR 1 + ELIF pos (exponent chars, act char) > 0 + THEN value CAT ".0" + ELSE LEAVE get const FI . + +get exponent: + IF pos (exponent chars, act char) > 0 (* F1/rr *) + THEN value CAT "e"; + scan pos INCR 1; + evtl get sign; + get digits + FI . + +evtl get sign: + IF act char = "+" OR act char = "-" + THEN value CAT act char; + scan pos INCR 1 + FI . + +digit found: + "0" <= act char AND act char <= "9" . + +check datatype: + IF act char = "%" + THEN IF integer ok (value) + THEN data := int type + ELSE scan error (2, value, "INT-Konstante nicht korrekt") FI + ELIF act char = "!" OR act char = "#" + THEN IF real ok (value) + THEN data := real type + ELSE scan error (2, value, "REAL-Konstante nicht korrekt") FI + ELIF integer ok (value) + THEN scan pos DECR 1; data := int type + ELIF real ok (value) + THEN scan pos DECR 1; + data := real type + ELSE scan error (2, value, "Numerische Konstante nicht korrekt") FI . + +act char: record SUB scan pos . +END PROC get numeric const; + +PROC get text const (TEXT VAR value, DTYPE VAR data): + INT CONST quote 1 := scan pos; + scan pos := pos (record, """", scan pos+1); + IF quote 1 < scan pos + THEN value := subtext (record, quote 1+1, scan pos-1); + data := text type + ELSE scan error (15, subtext (record, quote 1), "("" fehlt)") FI . + +END PROC get text const; + +BOOL PROC integer ok (TEXT VAR zahl): + disable stop; + i dummy := int (zahl); + IF is error + THEN clear error; + FALSE + ELIF last conversion ok + THEN zahl := ""0""0""; + replace (zahl, 1, i dummy); + TRUE + ELSE FALSE FI . + +END PROC integer ok; + +BOOL PROC real ok (TEXT VAR zahl): + disable stop; + r dummy := real (zahl); + IF is error + THEN clear error; + FALSE + ELIF last conversion ok + THEN zahl := ""0""0""0""0""0""0""0""0""; + replace (zahl, 1, r dummy); + TRUE + ELSE FALSE FI . + +END PROC real ok; + +PROC basic error (INT CONST no, TEXT CONST name, addition): + basic error ("Compiler", no, record no, act stat no, name, addition, TRUE) +END PROC basic error; + +PROC basic error (INT CONST no, TEXT CONST name, addition, BOOL CONST leave statement): + basic error ("Compiler", no, record no, act stat no, name, addition, leave statement) +END PROC basic error; + +PROC scan error (INT CONST no, TEXT CONST name, addition): + basic error ("Scanner", no, record no, act stat no, name, addition, TRUE) +END PROC scan error; + +PROC basic warning (TEXT CONST warning text): (* mo *) + basic warning (record no, act stat no, warning text) +END PROC basic warning; + +PROC basic list (BOOL CONST t): + listing := t +END PROC basic list; + +BOOL PROC basic list: + listing +END PROC basic list; + +PROC set scope (TEXT CONST new scope): (* DEF/mo *) + scope := new scope +END PROC set scope; + +TEXT PROC scanner scope: (* DEF/mo *) + scope +END PROC scanner scope; + +END PACKET basic scanner; + + +PACKET basic stat no DEFINES init stat no, (* Autor: Heiko Indenbirken *) + stat no pos, (* Stand: 27.10.1987/rr/mo *) + label pos, + all stat no: + +LET nil = ""; + +TEXT VAR found stat no :: nil; +INT VAR i, akt stat no :: 0, found no :: 0; + +PROC init stat no (FILE VAR f, INT VAR error no): (* F21/rr *) +(*Die Datei 'f' muß im 'modify-Mode' sein. *) + INT VAR line no; + akt stat no := -1; (* F28/rr *) + found no := 0; + found stat no := nil; + error no := 0; (* F21/rr *) + to first record (f); + col (f, 1); + disable stop; + FOR line no FROM 1 UPTO 4000 + REP exec (PROC (TEXT CONST, INT CONST) check, f, line no); + IF is error THEN check error FI; + IF eof (f) + THEN LEAVE init stat no + ELSE down (f) FI + PER; + +. check error : (* F21/rr *) + IF error code = 100 + THEN clear error; + error no INCR 1; + ELSE LEAVE init stat no; + FI; + +END PROC init stat no; + +PROC check (TEXT CONST record, INT CONST line no): + IF statement no vorhanden + THEN remember statement no FI . + +statement no vorhanden: (* F15/rr *) + INT CONST first number pos := pos (record, ""048"", ""057"", 1); + first number pos > 0 CAND first number pos = first non blank pos . + +first non blank pos : (* F15/rr *) + pos (record, ""033"", ""255"", 1) . + +remember statement no: + get statement no; + IF neue nummer ist groesser als vorherige + THEN akt stat no := neue nummer; + cout (neue nummer); + found no INCR 1; + found stat no CAT mki (neue nummer) + ELSE basic error ("Stat no", 81, line no, neue nummer, number, + "Letzte Zeilennummer davor: " + text (akt stat no), TRUE) + FI . + +get statement no : (* F15/rr *) + disable stop; + TEXT CONST number := subtext (record, first number pos, last number pos); + INT VAR neue nummer := int (number); + IF NOT last conversion ok OR is error + THEN clear error; + basic error ("Stat no", 80, line no, akt stat no, number, + "Die Zeilennummer muß im Bereich 0-32767 liegen", TRUE) + FI; + enable stop . + +last number pos : (* F15/rr *) + INT CONST high := pos (record, ""058"", ""255"", first number pos), + low := pos (record, ""032"", ""047"", first number pos); + IF high > 0 + THEN IF low > 0 + THEN min (high, low) - 1 + ELSE high - 1 + FI + ELIF low > 0 + THEN low - 1 + ELSE LENGTH record + FI . + +neue nummer ist groesser als vorherige: + neue nummer > akt stat no . + +END PROC check; + +INT PROC stat no pos (INT CONST stat no): + FOR i FROM found no DOWNTO 1 + REP IF (found stat no ISUB i) = stat no + THEN LEAVE stat no pos WITH i FI + PER; + 0 +END PROC stat no pos; + +INT PROC label pos (INT CONST stat no): + FOR i FROM found no DOWNTO 1 + REP IF (found stat no ISUB i) = stat no + THEN LEAVE label pos WITH i FI + PER; + basic error (8, text (stat no), nil); (* F16/rr *) + 0 +END PROC label pos; + +PROC all stat no (TEXT VAR stat no, INT VAR no): + stat no := found stat no; + no := found no +END PROC all stat no; + +END PACKET basic stat no; + +PACKET basic storage DEFINES init storage, (* Autor: Heiko Indenbirken *) + next local adr, (* Stand: 12.06.86 *) + next ref, + local adr, + local storage, + type size, + quiet type: + + + +LET ref length = 2; + +INT VAR quiet size, quiet align; +ADDRESS VAR loc adr, free loc adr; +DTYPE VAR quiet value; +identify ("QUIET", quiet size, quiet align, quiet value); + +PROC init storage: + free loc adr := LOC 0; + loc adr := LOC 0; + +END PROC init storage; + +(* Verwaltung der lokalen Addressen für Zwischenergebnisse *) +ADDRESS PROC next local adr (DTYPE CONST type): + INT VAR type len :: type size (type); + loc adr := free loc adr; + adjust (loc adr, type len); + free loc adr := loc adr + type len; + loc adr . + +END PROC next local adr; + +ADDRESS PROC next ref: + loc adr := free loc adr; + adjust (loc adr, ref length); + free loc adr := loc adr + ref length; + loc adr . + +END PROC next ref; + +ADDRESS PROC local adr: + loc adr +END PROC local adr; + +INT PROC local storage: + int (subtext (dump (free loc adr), 6)) +END PROC local storage; + +INT PROC type size (DTYPE CONST type): + IF type = int type OR type = bool type + THEN 1 + ELIF type = row type + THEN 2 + ELIF type = real type + THEN 4 + ELIF type = text type + THEN 8 + ELIF type = quiet value + THEN quiet size + ELSE errorstop ("Unbekannter DTYPE: " + dump (type)); 0 FI . + +END PROC type size; + +DTYPE PROC quiet type: + quiet value +END PROC quiet type; + +END PACKET basic storage; + +PACKET basic identify DEFINES (* Autor: Heiko Indenbirken *) + (* Stand: 20.08.1987/rr/mo *) + identify, + convert paramfield, + dump ftn, + is basic function: (* mo *) + +LET nil = ""; + +LET ENTRY = STRUCT (TEXT param, INT no, next, OPN opn, DTYPE result); + +ROW 256 ENTRY VAR ftn table; + +clear ftn table; +init ftn names; +init int operator; +init real operator; +init text operator; +init predefined funktions; + +PROC dump ftn (INT CONST n, TEXT VAR param, INT VAR no, next, + OPN VAR opn, DTYPE VAR result): + param := ftn table [n].param; + no := ftn table [n].no; + next := ftn table [n].next; + opn := ftn table [n].opn; + result := ftn table [n].result + +END PROC dump ftn; + +PROC identify (INT CONST ftn no, first, params, OPN VAR operation, BOOL VAR found): + TEXT VAR param; + INT VAR pos :: min (ftn no, 256); + convert paramfield (first, params, param); + REP IF param = ftn table [pos].param AND ftn no = ftn table [pos].no + THEN declare (params+1, ftn table [pos].result); + declare (params+1, 1); + operation := ftn table [pos].opn; + found := TRUE; + LEAVE identify + ELSE pos := ftn table [pos].next FI + UNTIL pos <= 0 PER; (* F14/rr *) + operation := nop; + found := FALSE . + +END PROC identify; + +PROC next free entry (INT VAR free pos): + FOR free pos FROM 1 UPTO 256 + REP IF ftn table [free pos].next < 0 AND ftn table [free pos].no = 0 (* mo *) + THEN LEAVE next free entry FI + PER; + errorstop ("Überlauf der Funktionstabelle") . + +END PROC next free entry; + +PROC convert paramfield (INT CONST first, params, TEXT VAR param): + INT VAR i; + param := nil; + FOR i FROM first UPTO params + REP param CAT datatype PER . + +datatype: + DTYPE CONST data :: dtype (i); + IF data = int type + THEN "I" + ELIF data = real type + THEN "R" + ELIF data = text type + THEN "T" + ELIF data = bool type + THEN "b" + ELSE errorstop ("Falscher DTYPE: " + dump (data)); + nil + FI . + +END PROC convert paramfield; + +PROC convert paramfield (TEXT CONST params, INT CONST first): + INT VAR i; + FOR i FROM first UPTO first+length (params)-1 + REP parameter (i, this type, 1, GLOB 0) PER . + +this type: + IF (params SUB i) = "I" + THEN int type + ELIF (params SUB i) = "R" + THEN real type + ELIF (params SUB i) = "T" + THEN text type + ELSE errorstop ("Unbekannter Typ: " + params); + undefined type + FI . + +END PROC convert paramfield; + +PROC init op (INT CONST ftn no, TEXT CONST param, ftn name): + IF elan opn found + THEN insert new opn in chain + ELSE errorstop ("PROC " + ftn name + " (" + param + ") nicht gefunden") FI . + +elan opn found: + OPN VAR opn; + BOOL VAR found; + convert paramfield (param, 1); + identify (ftn name, 1, length (param), opn, found); + found . + +insert new opn in chain: + INT VAR ftn pos :: ftn no; + REP IF end of chain found + THEN cat new entry in chain + ELIF free entry in chain found + THEN cover this entry + ELSE next entry FI + UNTIL ftn pos <= 0 PER . + +end of chain found: + act entry.next = 0 . + +cat new entry in chain: + INT VAR free pos; + next free entry (free pos); + act entry.next := free pos; + free entry := ENTRY:(param, ftn no, 0, opn, dtype (LENGTH param+1)); + LEAVE insert new opn in chain . + +free entry in chain found: + act entry.next = -1 . + +cover this entry: + act entry := ENTRY:(param, ftn no, 0, opn, dtype (LENGTH param+1)); + LEAVE insert new opn in chain . + +next entry: + ftn pos := act entry.next . + +act entry: ftn table [ftn pos] . +free entry: ftn table [free pos] . + +END PROC init op; + +BOOL PROC is basic function (INT CONST ftn no): (* mo *) + + pos (ftn names, code (ftn no)) <> 0 + +END PROC is basic function; + +. +clear ftn table: + INT VAR k; + FOR k FROM 1 UPTO 256 + REP ftn table [k] := ENTRY:(nil, 0,-1, nop, undefined type) PER . + +init ftn names: + TEXT CONST ftn names :: "+-*/\^<=>"28""29""30""249""251""252""253""254"" + + ""128""130""131""134""136""137""141""143""142"" + + ""153""154""155""157""159""161""166""168""170""171""172"" + + ""174""175""178""179""182""184""183""187""192"" + + ""201""202""204""205""206""207""208""211""212"" + + ""215""221""228""229""230""231""232""233""; + FOR k FROM 1 UPTO length (ftn names) + REP ftn table [ftn pos] := ENTRY:(nil, ftn pos,-1, nop, void type) PER . + +ftn pos: + code (ftn names SUB k) . + +init int operator: + init op ( 43, "II", "+"); + init op ( 45, "II", "-"); + init op ( 42, "II", "*"); + init op ( 47, "II", "/"); (* mo *) + init op ( 92, "II", "DIV"); (* mo *) + init op ( 94, "II", "^"); + init op ( 61, "II", "EQU"); + init op ( 29, "II", "UEQ"); + init op ( 60, "II", "LES"); + init op ( 28, "II", "LEQ"); + init op ( 62, "II", "GRE"); + init op ( 30, "II", "GEQ"); + init op (249, "II", "MOD"); (* mo *) + init op (251, "II", "AND"); + init op (252, "II", "OR"); + init op (253, "II", "XOR"); + init op (254, "II", "EQV"); + init op (255, "II", "IMP"). + +init real operator: + init op ( 43, "RR", "+"); + init op ( 45, "RR", "-"); + init op ( 42, "RR", "*"); + init op ( 47, "RR", "/"); + init op ( 92, "RR", "DIV"); (* mo *) + init op ( 94, "RR", "^"); + init op ( 61, "RR", "EQU"); + init op ( 29, "RR", "UEQ"); + init op ( 60, "RR", "LES"); + init op ( 28, "RR", "LEQ"); + init op ( 62, "RR", "GRE"); + init op ( 30, "RR", "GEQ"); + init op (249, "RR", "realmod"). (* mo *) + +init text operator: + init op ( 43, "TT", "+"); + init op ( 61, "TT", "EQU"); + init op ( 29, "TT", "UEQ"); + init op ( 60, "TT", "LES"); + init op ( 28, "TT", "LEQ"); + init op ( 62, "TT", "GRE"); + init op ( 30, "TT", "GEQ") . + +init predefined funktions: + init op (128, "I", "abs"); + init op (128, "R", "abs"); + init op (130, "T", "asc"); + init op (131, "R", "arctan"); + init op (131, "I", "arctan"); + init op (134, "I", "cdbl"); + init op (134, "R", "cdbl"); + init op (136, "I", "chr"); + init op (136, "R", "chr"); + init op (137, "R", "cint"); + init op (137, "I", "cint"); + init op (141, "R", "cos"); + init op (141, "I", "cos"); + init op (143, "T", "cvi"); + init op (142, "T", "cvd"); +# init op (153, "", "eof");# (* File *) + init op (154, "", "errorline"); + init op (155, "", "errorcode"); + init op (157, "R", "exp"); + init op (157, "I", "exp"); + init op (159, "R", "floor"); + init op (159, "I", "floor"); + init op (161, "I", "fre"); + init op (161, "R", "fre"); + init op (161, "T", "fre"); + init op (166, "I", "hex"); + init op (166, "R", "hex"); + init op (168, "", "incharety"); + init op (170, "I", "inchars"); + init op (170, "R", "inchars"); + init op (171, "TT", "instr"); + init op (171, "ITT", "instr"); + init op (171, "RTT", "instr"); + init op (172, "I", "ent"); + init op (172, "R", "ent"); + init op (174, "TI", "left"); + init op (174, "TR", "left"); + init op (175, "T", "length"); +# init op (178, "I", "line no");# (* File *) + init op (179, "R", "ln"); + init op (179, "I", "ln"); + init op (182, "TII", "mid"); + init op (182, "TI", "mid"); + init op (182, "TRR", "mid"); + init op (182, "TR", "mid"); + init op (183, "I", "mkd"); + init op (183, "R", "mkd"); + init op (187, "I", "oct"); + init op (187, "R", "oct"); + init op (192, "I", "pos"); + init op (192, "R", "pos"); + init op (201, "TI", "right"); + init op (201, "TR", "right"); + init op (202, "", "rnd"); (* F12/rr *) + init op (202, "I", "rnd"); + init op (202, "R", "rnd"); + init op (204, "I", "sign"); + init op (204, "R", "sign"); + init op (205, "R", "sin"); + init op (205, "I", "sin"); + init op (206, "I", "space"); + init op (206, "R", "space"); + init op (207, "I", "space"); + init op (207, "R", "space"); + init op (208, "R", "sqrt"); + init op (208, "I", "sqrt"); + init op (211, "I", "basictext"); + init op (211, "R", "basictext"); + init op (212, "IT", "string"); + init op (212, "RT", "string"); + init op (212, "II", "string"); + init op (212, "RR", "string"); + init op (212, "RI", "string"); + init op (212, "IR", "string"); + init op (215, "R", "tan"); + init op (215, "I", "tan"); + init op (221, "T", "val"); (* F18/rr *) + init op (228, "", "errormessage"); + init op (229, "", "csrlin"); + init op (230, "I", "lpos"); + init op (230, "R", "lpos"); + init op (231, "", "time"); + init op (232, "", "date"); + init op (233, "", "timer"). + +END PACKET basic identify; + +PACKET basic data handling (* Autor: R. Ruland *) + (* Stand: 23.10.87/mo *) + DEFINES init data, + data line, + data, read, + restore, + next int, + next real, + next text: + +LET (* R e s u l t T y p e n *) + stat code = 0, stat char = ""0"", + data code = 1, data char = ""1"", + text code = 2, text char = ""2"", + + int overflow = 4, + real overflow = 6; + +INT VAR type; +TEXT VAR data text :: "", number text; + +PROC init data: + + data text := "" + +END PROC init data; + + +PROC init data (TEXT VAR data, INT VAR data pos): + + data := data text; + data pos := 1 + +END PROC init data; + + +PROC restore (TEXT CONST data, INT VAR data pos, INT CONST line no): + + INT CONST data length :: LENGTH data; + data pos := 1; + WHILE data pos < data length + REP type := code (data SUB data pos); + data pos INCR 1; + SELECT type OF + CASE stat code : IF int value (data, data pos) >= line no + THEN LEAVE restore FI + CASE data code, text code : data pos INCR int value (data, data pos) + OTHERWISE : errorstop (1051, "Fehlerhaften Dateneintrag gefunden: " + text (type)) + ENDSELECT; + PER; + errorstop (1004, "RESTORE: Keine DATA-Anweisung in oder nach Zeile " + text (line no) + + " gefunden"); + +END PROC restore; + + +INT PROC next int (TEXT CONST data, INT VAR data pos): + + number text := next text (data, data pos); + disable stop; + INT VAR result := int (number text); + IF is error + THEN IF error code = int overflow THEN handle overflow FI; + ELIF NOT last conversion ok CAND number text <> "" + THEN errorstop (1013, "READ: Falscher Datentyp, " + number text + " ist kein INT") + FI; + result + + . handle overflow : + clear error; + result := result value; + IF cursor x pos <> 1 THEN next line FI; + basic out ("WARNUNG : INT-Überlauf bei READ, gefunden: " + number text); + next line; + + . result value : + IF (number text SUB 1) = "-" THEN minint ELSE maxint FI + +END PROC next int; + + +REAL PROC next real (TEXT CONST data, INT VAR data pos): + + number text := next text (data, data pos); + disable stop; + REAL VAR result := val (number text); + IF is error + THEN IF error code = real overflow OR error code = int overflow (* <- wegen Fehler in REAL PROC real (T C) *) + THEN handle overflow or underflow + FI; + ELIF NOT last conversion ok CAND number text <> "" + THEN errorstop (1013, "READ: Falscher Datentyp, " + number text + " ist kein REAL") + FI; + result + + . handle overflow or underflow : (* F23/rr *) + clear error; + IF cursor x pos <> 1 THEN next line FI; + basic out ("WARNUNG : " + overflow or underflow + " bei READ, gefunden: " + number text); + next line; + + . overflow or underflow : + IF is overflow + THEN result := sign * (max real - 0.99999999999994e120); (* <- wegen Fehler in TEXT PROC text (R C) *) + "REAL-Überlauf" + ELSE result := 0.0; + "REAL-Unterlauf" + FI + + . sign : + IF (number text SUB 1) = "-" THEN -1.0 ELSE 1.0 FI + + . is overflow : + INT VAR exponent pos := pos (number text, "E"); + IF exponent pos = 0 THEN exponent pos := pos (number text, "e") FI; + IF exponent pos = 0 + THEN TRUE + ELSE (number text SUB (exponent pos + 1)) <> "-" + FI + +END PROC next real; + + +TEXT PROC next text (TEXT CONST data, INT VAR data pos): + + INT CONST len :: int value (data, data pos); + data pos INCR len; + subtext (data, data pos-len, data pos-1) + +END PROC next text; + + +INT PROC int value (TEXT CONST data, INT VAR data pos): + + data pos INCR 2; + subtext (data, data pos-2, data pos-1) ISUB 1 + +END PROC int value; + + +PROC data line (INT CONST line no): + + data text CAT stat char; + data text CAT mki (line no) + +END PROC data line; + + +PROC data (TEXT CONST string, DTYPE VAR data type) : + + data text CAT data + mki (length (string)); + data text CAT string; + + . data : + IF data type = void type + THEN data char + ELIF data type = text type + THEN text char + ELSE errorstop (1051, "Unbekannter DTYPE: " + dump (data type)); "" + FI + +END PROC data; + + +PROC read (TEXT CONST data, INT VAR data pos, INT VAR i): + + type := code (data SUB data pos); + data pos INCR 1; + IF data pos >= LENGTH data + THEN errorstop (1004, "Keine Daten mehr für READ") + ELIF type = data code + THEN i := next int (data, data pos) + ELIF type = stat code + THEN data pos INCR 2; + read (data, data pos, i) + ELSE errorstop (1013, "READ: Falscher Datentyp, " + data string (data,data pos) + " ist kein INT") + FI; + +END PROC read; + + +PROC read (TEXT CONST data, INT VAR data pos, REAL VAR r): + + type := code (data SUB data pos); + data pos INCR 1; + IF data pos >= LENGTH data + THEN errorstop (1004, "Keine Daten mehr für READ") + ELIF type = data code + THEN r := next real (data, data pos) + ELIF type = stat code + THEN data pos INCR 2; + read (data, data pos, r) + ELSE errorstop (1013, "READ: Falscher Datentyp, " + data string (data,data pos) + " ist kein REAL") + FI; + +END PROC read; + + +PROC read (TEXT CONST data, INT VAR data pos, TEXT VAR t): + + type := code (data SUB data pos); + data pos INCR 1; + IF data pos >= LENGTH data + THEN errorstop (1004, "Keine Daten mehr für READ") + ELIF type = data code OR type = text code + THEN t := next text (data, data pos) + ELIF type = stat code + THEN data pos INCR 2; + read (data, data pos, t) + ELSE errorstop (1013, "READ: Falscher Datentyp, " + data string (data,data pos) + " ist kein TEXT") + FI; + +END PROC read; + + +TEXT PROC data string (TEXT CONST data, INT VAR data pos): + + IF type = text code + THEN """" + next text (data, data pos) + """" + ELSE "unbekannter DTYPE: " + text (type) + FI + +END PROC data string; + +END PACKET basic data handling; + + +PACKET basic odds and ends DEFINES trace, (* Autor: Heiko Indenbirken *) + start basic, (* Stand: 26.10.1987/rr/mo *) + end basic, + loop end, + basic stop: + +(* Fehlerbehandlung *) + +PROC trace (INT CONST stat no): + basic out ("[" + text (stat no) + "]") + +END PROC trace; + +(*Laufzeitprozeduren *) +PROC start basic: + set line nr (0); + initialize random (0.1); (* F26/rr *) + init output; + init input + +END PROC start basic; + +PROC end basic: + IF is error + THEN switch back to old sysout state + FI . + +END PROC end basic; + +(* Schleifenüberprüfung *) +BOOL PROC loop end (REAL CONST x, max, step) : + IF step > 0.0 + THEN x > max + ELSE x < max FI + +END PROC loop end; + +BOOL PROC loop end (INT CONST x, max, step) : + IF step > 0 + THEN x > max + ELSE x < max FI + +END PROC loop end; + +PROC basic stop (INT CONST stat no): + basic out ("STOP beendet das Programm in Zeile " + text (stat no)); + next line + +END PROC basic stop; + +END PACKET basic odds and ends + diff --git a/lang/basic/1.8.7/src/BASIC.Compiler b/lang/basic/1.8.7/src/BASIC.Compiler new file mode 100644 index 0000000..d4e4c21 --- /dev/null +++ b/lang/basic/1.8.7/src/BASIC.Compiler @@ -0,0 +1,2305 @@ +(***************************************************************************) +(* *) +(* Dritte von drei Dateien des EUMEL-BASIC-Systems *) +(* *) +(* Autor: Heiko Indenbirken *) +(* Überarbeitet von: Rudolf Ruland und Michael Overdick *) +(* *) +(* Stand: 27.10.1987 *) +(* *) +(***************************************************************************) + +PACKET basic compiler DEFINES basic, (* Autor: Heiko Indenbirken *) + basic version: (* Stand: 27.10.1987/rr/mo *) + +PROC basic version : + +putline (""13" "15" BASIC - Compiler Version 1.1 (27.10.1987) "14""); + +END PROC basic version; + +LET compiler msg = " ******* ENDE DER UEBERSETZUNG *******", + compiler err msg = " Fehler entdeckt"; + +LET (* S y m b o l T y p e n *) + any = 0, const = 1, var = 2, array = 3, denoter = 5, + res word= 8, operator= 9, eos = 10, del =11, stat no = 12, + result const = 13, (* F3/rr *) + user fn = 20; (* DEF/mo *) + +LET (* S y m b o l z e i c h e n *) + plus = 43, minus = 45, mult = 42, + div = 47, backslash = 92, exponent = 94, + equal = 61, semicolon = 59, comma = 44, + numbersign = 35, open bracket = 40, close bracket = 41, + eol = 13, eop = 14, mod op = 249; + +LET (* Reservierte Worte *) + as s = 129, base s = 132, call s = 133, chain s = 135, + clear s = 138, close s = 139, common s = 140, data s = 144, + def s = 145, defdbl s = 146, defint s = 147, defsng s = 148, + defstr s = 149, dim s = 150, else s = 151, end s = 152, + eof s = 153, error s = 156, field s = 158, for s = 160, + get s = 162, gosub s = 164, goto s = 165, if s = 167, (* F2/rr *) + input s = 169, kill s = 173, let s = 176, line in s = 177, + lprint s = 180, lset s = 181, mid s = 182, name s = 185, + next s = 186, on s = 188, open s = 189, option s = 190, + print s = 193, put s = 194, rand s = 195, read s = 196, + rem s = 197, restore s = 198, resume s = 199, return s = 200, + rset s = 203, step s = 209, stop s = 210, swap s = 213, + tab s = 214, then s = 216, to s = 217, troff s = 218, + tron s = 219, using s = 220, wait s = 222, wend s = 223, + while s = 224, width s = 225, write s = 226, not = 250, + cls s = 227, usr = 234, sub = 235; (* mo *) + +LET nil = "", + intern error = 51; + +LET SYMBOL = STRUCT (TEXT name, INT no, type, ADDRESS adr, DTYPE data); +ADDRESS CONST niladr :: LOC -4; +SYMBOL CONST nilsymbol :: SYMBOL : (nil, any, any, nil adr, void type); +SYMBOL VAR symb; +BOOL VAR found; +OPN VAR opn; + +TEXT OP NAME (SYMBOL CONST val): + IF val.type = const + THEN constant value + ELIF val.type = stat no + THEN text (val.no) + ELSE val.name FI . + +constant value: + IF val.data = int type AND length (val.name) = 2 + THEN text (val.name ISUB 1) + ELIF val.data = real type AND length (val.name) = 8 + THEN text (val.name RSUB 1) + ELSE val.name FI . + +END OP NAME; + +PROC careful error (INT CONST no, TEXT CONST name, addition): (* DEF/mo *) + IF at end of statement + THEN basic error (no, name, addition) + ELSE basic error without leaving statement + FI. + +at end of statement: + symb.type = eos. + +basic error without leaving statement: + basic error (no, name, addition, FALSE); + error no INCR 1. + +END PROC careful error; + +(* P r e c o m p i l e r *) +PROC next symbol: + symb.adr := niladr; + next symbol (symb.name, symb.no, symb.type, symb.data); + + IF symb.no = end symbol AND symb.type = res word + THEN symb.no := -symb.no; + symb.type := eos; + FI +END PROC next symbol; + +PROC skip (INT CONST symbol, type): + IF symb.type = type AND symb.no = symbol + THEN next symbol + ELSE basic error (2, NAME symb, name of (symbol) + " erwartet") FI . +END PROC skip; + +PROC get letter (SYMBOL VAR symbol): + IF symb.type = var AND (LENGTH symb.name) = 1 + THEN symbol := symb; + next symbol + ELSE basic error (2, NAME symb, "Buchstabe erwartet, " + type of (symb.type) + " gefunden") FI . + +END PROC get letter; + +PROC get var (SYMBOL VAR symbol): + IF symb.type = var + THEN variable (symbol) + ELIF symb.type = array + THEN array var (symbol) + ELSE basic error (2, NAME symb, "Variable erwartet, " + type of (symb.type) + " gefunden") FI . + +END PROC get var; + +PROC get expr (SYMBOL VAR symbol): + get expression (symbol, 0) +END PROC get expr; + +PROC get const (SYMBOL VAR symbol, DTYPE CONST data): + IF symb.type = const + THEN symbol := symb; + declare const (symbol, data); (* F3/rr *) + next symbol + ELSE basic error (2, NAME symb, "Konstante erwartet, " + type of (symb.type) + " gefunden") FI . + +END PROC get const; + +PROC get var (SYMBOL VAR symbol, DTYPE CONST data): + get var (symbol); + convert (symbol, data) +END PROC get var; + +PROC get expr (SYMBOL VAR symbol, DTYPE CONST data): + get expression (symbol, 0); + convert (symbol, data) +END PROC get expr; + +PROC get expression (SYMBOL VAR result, INT CONST last prio): + get single result; + WHILE symb.type = operator AND higher priority + REP get dyadic operand; + gen dyadic operation + PER . + +get single result: + INT VAR prio; + SELECT symb.type OF + CASE var: variable (result) + CASE array: array var (result) + CASE const: get const + CASE operator: get monadic operator + CASE res word: basic function (result) + CASE user fn: user function (result) (* DEF/mo *) + OTHERWISE get bracket END SELECT . + +get const: + result := symb; + declare const (result, result. data); (* F3/rr *) + next symbol . + +get monadic operator: + get operator; + prio := monadic op prio; (* mo *) + get monadic operand; + generate monadic operator . + +monadic op prio: (* mo *) + IF op no = not + THEN 6 + ELSE 12 + FI. + +get monadic operand: + SYMBOL VAR operand; + next symbol; + get expression (operand, prio). + +generate monadic operator: +(* Mögliche Ops: +, - und NOT *) + parameter (1, operand.data, const, operand.adr); + parameter (2, operand.data, var, next local adr (operand.data)); + parameter (3, void type, const, nil adr); + + IF op no = plus + THEN result := operand + ELIF op no = minus + THEN generate minus op + ELIF op no = not + THEN generate not op + ELSE basic error (2, op name, "Kein monadischer Operator") FI . + +generate minus op: + IF operand.data = int type + THEN apply (1, 2, int minus) + ELIF operand.data = real type + THEN apply (1, 2, real minus) + ELSE basic error (82, op name, NAME operand + " : " + dump (operand.data)) FI; + result := SYMBOL:(op name, 0, result const, local adr, operand.data) . + +generate not op: + IF operand.data = int type + THEN apply (1, 1, int not opn) + ELIF operand.data = real type + THEN apply (1, 1, real not opn) + ELSE basic error (82, op name, NAME operand + " : " + dump (operand.data)) FI; + result := SYMBOL:(op name, 0, result const, local adr, operand.data) . + +get operator: + INT CONST op no :: symb.no; + TEXT CONST op name :: symb.name . + +higher priority: + get operator; + prio := dyadic op prio; + prio > last prio . + +dyadic op prio: + IF is bool op (op no) THEN bool op prio + ELIF op no = plus OR op no = minus THEN 8 + ELIF op no = mod op THEN 9 + ELIF op no = backslash THEN 10 + ELIF op no = mult OR op no = div THEN 11 + ELIF op no = exponent THEN 13 + ELSE (* relational operator *) 7 + FI. + +bool op prio: + 256 - op no. + +get bracket: + IF symb.type = del AND symb.no = open bracket + THEN next symbol + ELSE basic error (22, NAME symb, "") FI; + get expression (result, 0); + skip (close bracket, del) . + +get dyadic operand: + next symbol; + get expression (operand, prio) . + +gen dyadic operation: + convert operands; + identify dyadic operator; + generate dyadic operator . + +convert operands: + DTYPE CONST op type :: type of operation; + convert (result, op type); + convert (operand, op type) . + +type of operation: + IF is bool op (op no) + THEN int type + ELIF result.data = operand.data + THEN result.data + ELSE real type FI . + +identify dyadic operator: + BOOL VAR local found; + OPN VAR local opn; + DTYPE VAR data; + parameter (1, result.data, const, result.adr); + parameter (2, operand.data, const, operand.adr); + identify (op no, 1, 2, local opn, local found); + IF NOT local found + THEN basic error (83, symbol of (op no), + NAME result + " : " + dump (result.data) + " und " + + NAME operand + " : " + dump (operand.data)) + ELSE data := dtype (3) FI . + +generate dyadic operator: + declare (3, var); + define (3, next local adr (data)); + apply (3, push); + apply (1, 2, local opn); + result := SYMBOL:(op name, 0, result const, local adr, data) . + +END PROC get expression; + +PROC variable (SYMBOL VAR symbol): + symbol := symb; + next symbol; + IF known (symbol.no) + THEN get adr from table + ELSE declare var (symbol, nil) FI . + +get adr from table: + TEXT VAR defined dim; + remember (symbol.no, symbol.type, symbol.adr, symbol.data, defined dim) . + +END PROC variable; + +PROC array var (SYMBOL VAR symbol field): +(* Aufbau der Dimensionsangaben in der Symboltabelle *) +(* limit 1 [limit 2]... Basis Elemente *) +(* jeweils als 2 Byte Integer/Text *) +(* Die Dimension ist dann DIM/2-2 *) + ROW 100 SYMBOL VAR indizes; + TEXT VAR limits; + INT VAR dim; + + symbol field := symb; next symbol; + get paramfield (indizes, dim, int type); + + IF known (symbol field.no) + THEN check field dim and data + ELSE declare new field FI; + generate field index . + +check field dim and data: + INT VAR type; + DTYPE VAR data; + remember (symbol field.no, type, symbol field.adr, data, limits); + + IF old dim <> dim + THEN basic error (84, symbol field.name, "Dimensioniert in " + text (old dim) + " Dimensionen, gefundene Anzahl Indizes: " + text (dim)) + ELIF NOT (symbol field.data = data) + THEN basic error (intern error, symbol field.name, dump (data) + " <=> " + dump (symbol field.data)) + ELIF NOT (symbol field.type = type) + THEN basic error (intern error, symbol field.name, "Feld erwartet, " + type of (type) + " gefunden") FI . + +old dim: (length (limits) DIV 2) - 2 . + +declare new field: + limits := dim * ""10""0"" + mki (array base) + + mki ((10 - array base + 1)**dim); + declare var (symbol field, limits) . + +generate field index: + init field subscription; + FOR j FROM 1 UPTO dim + REP increase field index; + calc index length and limit; + calculate field pointer; + symbol field.adr := REF pointer + PER . + +init field subscription: + ADDRESS VAR pointer :: next local adr (row type), + index adr :: next local adr (int type); + INT VAR j, elem length :: (limits ISUB (dim+2)) * typesize (symbol field.data), + elem limit, + elem offset :: 1 - (limits ISUB (dim+1)); + BOOL CONST base zero := elem offset = 1 . + +increase field index: + IF base zero + THEN parameter (1, int type, const, index.adr); + parameter (2, int type, const, one value); + parameter (3, int type, var, index adr); + parameter (4, void type, const, nil adr); + apply (1, 3, int add); + ELSE index adr := index.adr FI . + +index: indizes [j] . + +calc index length and limit: + elem limit := (limits ISUB j) + elem offset; + elem length := elem length DIV elem limit . + +calculate field pointer: + parameter (1, int type, const, symbol field.adr); + parameter (2, int type, const, index adr); + parameter (3, int type, elem length); + parameter (4, int type, elem limit); + parameter (5, int type, const, pointer); + parameter (6, void type, const, nil adr); + apply (1, 5, subscript); + +END PROC array var; + +PROC get paramfield (ROW 100 SYMBOL VAR params list, INT VAR no): + skip (open bracket, del); + FOR no FROM 1 UPTO 100 + REP get expression (params list [no], 0); + IF symb.type = del AND symb.no = close bracket + THEN next symbol; + LEAVE get paramfield + ELSE skip (comma, del) FI + PER . + +END PROC get paramfield; + +PROC get paramfield (ROW 100 SYMBOL VAR params list, INT VAR no, DTYPE CONST data): + skip (open bracket, del); + FOR no FROM 1 UPTO 100 + REP get expression (params list [no], 0); + convert (params list [no], data); + IF symb.type = del AND symb.no = close bracket + THEN next symbol; + LEAVE get paramfield + ELSE skip (comma, del) FI + PER . + +END PROC get paramfield; + +PROC examine access rights (ROW 100 SYMBOL VAR params list, INT CONST no): + + INT VAR j; + FOR j FROM 1 UPTO no REP + IF params list [j].type = const OR params list [j].type = result const + THEN IF access (j) = 2 + THEN basic error (103, NAME params list [j], "im " + text (j) + + ". Eintrag der Parameterliste") + FI + FI + PER + +END PROC examine access rights; + +PROC basic function (SYMBOL VAR ftn): (* Änd. 11.08.87, mo *) + init and check function; + IF symb.type = del AND symb.no = open bracket + THEN get paramfield (params list, number params); + FI; + apply function . + +init and check function: + ROW 100 SYMBOL VAR params list; + INT VAR number params :: 0; + BOOL CONST is usr :: symb.no = usr; + IF is usr + THEN check proc name + FI; + ftn := symb; + next symbol . + +check proc name: + next symbol; + IF symb.type = array + THEN symb.name := subtext (symb.name, 1, LENGTH symb.name-2) + ELIF symb.type <> var + THEN basic error (2, NAME symb, "Prozedurname erwartet") + FI. + +apply function: + OPN VAR ftn local opn; + BOOL VAR ftn found; + INT CONST result :: number params+1; + + INT VAR j; + FOR j FROM 1 UPTO number params + REP parameter (j, params list [j].data, const, params list [j].adr) PER; + IF is usr + THEN identify proc; + examine access rights (params list, number params); + ELSE identify function + FI; + + ftn.adr := next local adr (ftn.data); + + declare (result, var); + define (result, ftn.adr); + apply (result, push); + apply (1, number params, ftn local opn). + +identify proc: + identify (deshift (ftn.name), 1, number params, ftn local opn, ftn found); + ftn.data := dtype (result); + IF NOT ftn found + THEN basic error (99, ftn.name, "Parameter angegeben: " + param list (1, number params)) + ELIF ftn.data = void type + THEN basic error (5, ftn.name, "Die Prozedur liefert keinen Wert") + ELIF NOT (ftn.data = int type) AND NOT (ftn.data = real type) AND NOT (ftn.data = text type) + THEN basic error (5, ftn.name, "Der Typ des Resultats ist nicht erlaubt, gefunden: " + + dump (dtype (result))) + FI. + +identify function: + identify (ftn.no, 1, number params, ftn local opn, ftn found); + IF ftn found + THEN ftn.data := dtype (result) + ELIF is basic function (ftn.no) + THEN basic error (98, ftn.name, "Argument(e) angegeben: " + param list (1, number params)) + ELSE basic error (22, ftn.name, "Anweisung(sbestandteil) gefunden") + FI. + +END PROC basic function; + +PROC user function (SYMBOL VAR result): (* DEF/mo *) + check if function defined; + get arguments if expected; + gosub (user function label); + copy result. + +check if function defined: + TEXT CONST scope :: name of (symb.no) + "?"; + IF NOT known (symb.no) + THEN basic error (18, symb.name, "") + ELIF scanner scope = scope + THEN basic error (85, symb.name, "") + FI. + +get arguments if expected: + INT VAR param counter; + TEXT VAR dim text; + result := symb; + remember (symb.no, symb.type, result.adr, result.data, dim text); + INT VAR number of params :: LENGTH dim text DIV 2 - 1; + next symbol; + IF number of params > 0 + THEN get all arguments + ELIF symb.no = open bracket AND symb.type = del + THEN basic error (5, symb.name, "Kein Argument erwartet") + FI. + +get all arguments: + IF symb.no <> open bracket OR symb.type <> del + THEN basic error (5, NAME symb, text (number of params) + " Argument(e) erwartet") + FI; + next symbol; + FOR param counter FROM 2 UPTO number of params REP + get one argument; + skip comma; + PER; + get one argument; + skip close bracket. + +get one argument: + SYMBOL VAR ftn param; + ftn param.no := dim text ISUB param counter; + remember (ftn param.no, ftn param.type, ftn param.adr, ftn param.data, ftn param.name); + IF ftn param.type <> var + THEN basic error (intern error, name of (ftn param.no), "Parametereintrag fehlerhaft") + FI; + SYMBOL VAR expr res; + get expr (expr res, ftn param.data); + apply move (ftn param.adr, expr res.adr, ftn param.data). + +skip comma: + IF symb.no = close bracket AND symb.type = del + THEN basic error (5, symb.name, text (number of params) + " Argumente erwartet") + ELIF symb.no <> comma OR symb.type <> del + THEN basic error (2, NAME symb, " , in Argumentenliste erwartet") + FI; + next symbol. + +skip close bracket: + IF symb.no = comma AND symb.type = del + THEN basic error (5, symb.name, "Nur " + text (number of params) + " Argument(e) erwartet") + ELIF symb.no <> close bracket OR symb.type <> del + THEN basic error (2, NAME symb, " ) nach Argumentenliste erwartet") + FI; + next symbol. + +user function label: + label list [dim text ISUB 1]. + +copy result : + apply move (next local adr (result.data), result.adr, result.data); + result.adr := local adr. + +END PROC user function; + +PROC apply move (ADDRESS CONST dest adr, source adr, DTYPE CONST datype): + parameter (1, datype, var, dest adr); + parameter (2, datype, const, source adr); + parameter (3, void type, const, nil adr); + + IF datype = int type + THEN apply (1, 2, int move) + ELIF datype = real type + THEN apply (1, 2, real move) + ELIF datype = text type + THEN apply (1, 2, text move) + ELSE basic error (2, "=", "Unbekannter Datentyp: " + dump (datype)) FI . + +END PROC apply move; + +PROC convert (SYMBOL VAR symbol, DTYPE CONST to data): (* F3/rr *) + IF to data = from data + THEN + ELIF symbol.type = const + THEN declare const (symbol, to data) + ELIF to data = int type + THEN make int + ELIF to data = real type + THEN make real + ELSE basic error (13, NAME symbol, dump (to data) + " erwartet, " + dump (from data) + " gefunden") FI . + +from data : symbol.data . + +make real : + IF symbol.data = int type + THEN parameter (1, symbol.data, const, symbol.adr); + parameter (2, real type, var, next local adr (real type)); + parameter (3, void type, const, nil adr); + apply (1, 1, int to real); + symbol.adr := local adr; + symbol.data := real type + ELSE basic error (13, NAME symbol, dump (to data) + " erwartet, " + dump (from data) + " gefunden") FI . + +make int : + IF symbol.data = real type + THEN parameter (1, symbol.data, const, symbol.adr); + parameter (2, int type, var, next local adr (int type)); + parameter (3, void type, const, nil adr); + apply (1, 1, real to int); + symbol.adr := local adr; + symbol.data := int type + ELSE basic error (13, NAME symbol, dump (to data) + " erwartet, " + dump (from data) + " gefunden") FI . + +END PROC convert; + +PROC declare const (SYMBOL VAR symbol constant, DTYPE CONST data): + convert symb value; + IF new constant + THEN declare this constant + ELSE get table entry FI . + +convert symb value: + IF data = symbol constant.data + THEN LEAVE convert symb value + ELIF data = int type AND symbol constant.data = real type + THEN symbol constant.name := mki (symbol constant.name RSUB 1); + ELIF data = real type AND symbol constant.data = int type + THEN symbol constant.name := mkd (symbol constant.name ISUB 1); + ELIF data = text type AND symbol constant.data = int type + THEN symbol constant.name := text (symbol constant.name ISUB 1) + ELIF data = text type AND symbol constant.data = real type + THEN symbol constant.name := text (symbol constant.name RSUB 1) + ELSE basic error (13, NAME symbol constant, dump (data) + " erwartet, " + + dump (symbol constant.data) + " gefunden") FI; + symbol constant.data := data . + +new constant: +(* Konstanten werden wie folgt abgelegt: *) +(* INT: § HL *) +(* REAL: § MMMMMMME *) +(* TEXT: § Text *) + put name ("§ " + symbol constant.name, symbol constant.no); + NOT known (symbol constant.no) . + +declare this constant: + IF data = int type + THEN allocate denoter (symbol constant.adr, symbol constant.name ISUB 1) + ELIF data = real type + THEN allocate denoter (symbol constant.adr, symbol constant.name RSUB 1) + ELIF data = text type + THEN allocate denoter (symbol constant.adr, symbol constant.name) FI; + recognize (symbol constant.no, const, symbol constant.adr, data, nil) . + +get table entry: + INT VAR table type; + TEXT VAR table dim; + remember (symbol constant.no, table type, symbol constant.adr, symbol constant.data, table dim); + IF table dim <> nil + THEN basic error (intern error, NAME symbol constant, "Dimension in Tabelle ungleich niltext") + ELIF NOT (symbol constant.data = data) + THEN basic error (intern error, NAME symbol constant, "Falscher DTYPE in Tabelle, erw: " + dump (data) + + ", gef: " + dump (symbol constant.data)) FI . + +END PROC declare const; + +PROC declare var (SYMBOL VAR symbol var, TEXT CONST dim): (* F4/rr *) + allocate variable; + recognize (symbol var.no, symbol var.type, symbol var.adr, symbol var.data, dim) . + +allocate variable : + symbol var.adr := next local adr (symbol var.data); + IF dim <> nil + THEN INT VAR index; + ADDRESS VAR dummy; + FOR index FROM 2 UPTO no of elements + REP dummy := next local adr (symbol var.data) PER; + FI . + +no of elements: + (dim ISUB (LENGTH dim DIV 2)) . +END PROC declare var; + +PROC parameter (INT CONST p, DTYPE CONST d type, INT CONST value): + declare (p, d type); + declare (p, denoter); + define (p, value); +END PROC parameter; + +PROC apply (INT CONST first, number params, TEXT CONST name): + identify (name, first, number params, opn, found); + IF NOT found + THEN errorstop (1051, "PROC " + name + ", Parameter: " + param list (first, number params) + ", nicht gefunden!") FI; + apply (first, number params, opn) + +END PROC apply; + +PROC clear local stack : (* F4/rr *) + + define local variables; + clear index; + define (rep); index incr one; + if local storage less or equal index then goto end; + get cell address; + clear cell; + apply (rep); + define (end); + clear cell address; + + . define local variables : + LABEL VAR rep, end; + ADDRESS VAR index; + declare (rep); declare (end); + allocate variable (index, type size (int type)); + + . clear index : + parameter (1, int type, var, index); + apply (1, 1, clear); + + . index incr one : + parameter (1, int type, var, index); + apply (1, 1, incone); + + . if local storage less or equal index then goto end : + parameter (1, int type, const, loc storage); + parameter (2, int type, const, index); + apply (1, 2, lsequ); + apply (end, TRUE); + + . get cell address : + parameter (1, int type, const, LOC 2); + parameter (2, int type, const, index); + parameter (3, int type, 1); + parameter (4, int type, 16000); + parameter (5, int type, const, LOC 0); + apply (1, 5, subscript); + + . clear cell : + parameter (1, int type, var, REF LOC 0); + apply (1, 1, clear); + + . clear cell address : + parameter (1, int type, var, LOC 0); + apply (1, 1, clear); + parameter (1, int type, var, LOC 1); + apply (1, 1, clear); + +END PROC clear local stack; + +(* M a i n *) +(* ̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃̃ *) +(* C o m p i l e r *) +(* ***** G l o b a l e V a r i a b l en ***** *) +INT VAR end symbol :: 0, error no :: 0, act stat no :: 0, array base :: 0; +BOOL VAR basic trace, was warning; +ADDRESS VAR data pos, data text; + + +(* Globale Operationen *) +OPN VAR basic init, basic frame, basic module, ret, equal op, + int minus, real minus, int not opn, real not opn, + trace op, ln op, push, + int incr, real incr, int add, + int move, real move, text move, test, + real to int, int to real, subscript, + clear, incone, lsequ, (* F4/rr *) + basic out text; + +(* Parameter VOID *) + init ("RTN", 1, 0, ret); + +(* Parameter INT *) + declare (1, int type); + init ("intnot", 1, 1, int not opn); (* mo *) + init ("PP", 1, 1, push); + init ("LN", 1, 1, ln op); + init ("real", 1, 1, int to real); + init ("TEST", 1, 1, test); + init ("CLEAR", 1, 1, clear); + init ("INCONE", 1, 1, incone); + init ("trace", 1, 1, trace op); + +(* Parameter INT INT *) + declare (2, int type); + init ("COMPLINT", 1, 2, int minus); + init ("MOVE", 1, 2, int move); + init ("INC", 1, 2, int incr); + init ("EQU", 1, 2, equal op); + init ("LSEQU", 1, 2, lsequ); + +(* Parameter INT INT INT *) + declare (3, int type); + init ("ADD", 1, 3, int add); + +(* Paramter REAL *) + declare (1, real type); + init ("realnot", 1, 1, real not opn); (* mo *) + init ("cint", 1, 1, real to int); + +(* Parameter REAL REAL *) + declare (2, real type); + init ("COMPLREAL", 1, 2, real minus); + init ("FMOVE", 1, 2, real move); + init ("INCR", 1, 2, real incr); + +(* Parameter TEXT *) + declare (1, text type); + init ("basicout", 1, 1, basic out text); + +(* Paramter TEXT TEXT *) + declare (2, text type); + init ("TMOVE", 1, 2, text move); + +(* Parameter ADDRESS INT DENOTER DENOTER ADDRESS *) + declare (3, denoter); + declare (4, denoter); + init ("SUBSCRIPT", 1, 5, subscript); + +PROC init (TEXT CONST name, INT CONST local from, number params, OPN VAR local opn): + identify (name, local from, number params, local opn, found); + IF NOT found + THEN errorstop (1051, "PROC init (TC, IC, IC, OPN VAR): OPN für """ + name + """ nicht gefunden") FI +END PROC init; + +(* Runtime Konstanten *) + ADDRESS VAR true value, false value, niltext value, + zero value, one value, two value, three value, + comma value, int one value, real one value, + loc storage; (* F4/rr *) + +(* +++++ Globale Variablen +++++ *) + BOOL VAR proc found; + INT VAR deftype, field elems, i, params; + ROW 100 SYMBOL VAR param; + SYMBOL VAR base size, begin range, end range, expr result, field, filename, + from, len, image, label, old name, new name, + question, size, tab pos, var result; + TEXT VAR constant, field size, proc name; + +(* Label-Verwaltung *) +LET label list size = 4100; +BOUND ROW label list size LABEL VAR label list; +DATASPACE VAR label ds; +INITFLAG VAR label init :: FALSE; +INT VAR last label no; + +(* ***** I n t e r f a c e P r o z d u r e n ***** *) +PROC basic: + basic (last param) +END PROC basic; + +PROC basic (TEXT CONST basic file name): + basic (basic file name, nil) +END PROC basic; + +PROC basic (TEXT CONST basic file name, prog name): + IF NOT exists (basic file name) + THEN errorstop ("""" + basic file name + """ gibt es nicht") + ELSE FILE VAR basic file :: sequential file (modify, basic file name); (* F5/rr *) + headline (basic file, basic file name); + last param (basic file name); + basic (basic file, prog name) + FI; + +END PROC basic; + +PROC basic (FILE VAR source file, TEXT CONST prog name): + IF prog name <> nil CAND prog name is not a tag (* F5/rr *) + THEN errorstop ("unzulässiger Programmname : """ + prog name + """"); + FI; + modify (source file); (* F5/rr *) + disable stop; + init label table; + store status; + coder on (data allocation by coder); + compile (source file, progname); + restore status; + start basic prog . + +prog name is not a tag : (* F5/rr *) + LET tag = 1; + INT VAR symbol type; + TEXT VAR symbol name; + scan (prog name); + next symbol (symbol name, symbol type); + symbol name <> prog name OR symbol type <> tag . + +init label table: + IF NOT initialized (label init) + THEN label ds := nilspace; + label list := label ds; + FI . + +store status: + INT CONST source line :: line no (source file), + source col :: col (source file); + BOOL CONST check status :: check; + check on . + +restore status: + to line (source file, source line); + col (source file, source col); + IF NOT check status + THEN check off FI . + +start basic prog: + IF error no > 0 OR is error + THEN basic error end + ELSE normal end + FI; + close (source file) . + +basic error end: + coder off (FALSE, FALSE, nop); + IF is error + THEN put error; + clear error + ELSE display (""13""10""10""); (* F20/rr *) + display (text (error no) + compiler err msg); + display (""13""10""10""); + display (compiler msg); + display (""13""10""); + IF sysout <> "" + THEN line (2); + put (text (error no) + compiler err msg); + line (2); + put (compiler msg); + line + FI + FI; + show file and error . + +show file and error: (* F20/rr *) + IF anything noted CAND command dialogue + THEN noteedit (source file); + FI; + errorstop (nil) . + +normal end: + IF prog name = nil + THEN run basic proc + ELSE insert basic proc FI; + IF warnings AND was warning + THEN show file and error + FI. + +run basic proc: + coder off (FALSE, TRUE, basic frame); + display (""13""10"") . + +insert basic proc: + coder off (TRUE, TRUE, basic frame); + coder on (data allocation by coder); + coder off (FALSE, FALSE, basic init); + display (""13""10"") . + +END PROC basic; + +PROC compile (FILE VAR source file, TEXT CONST progname): + enable stop; + init compiler; + init basic prog; + + begin scanning (source file); + next symbol; + get statement group (eop); + end compiling . + +init compiler: + end symbol := 0; + error no := 0; + act stat no := 0; + array base := 0; + basic trace := FALSE; + was warning := FALSE; + + init storage; + init label; + init data; + init table . + +init label: + TEXT VAR local stat no; + INT VAR stat nos; + init stat no (source file, error no); (* F21/rr *) + IF error no > 0 THEN LEAVE compile FI; + all stat no (local stat no, stat nos); + FOR i FROM 1 UPTO stat nos + REP declare (label list [i]) PER; + last label no := stat nos. (* DEF/mo *) + +init basic prog: + LIB VAR packet; + declare (basic packet name, packet); + define (packet); + parameter (1, void type, const, nil adr); + declare (basic init); + IF progname = nil + THEN declare (basic frame) + ELSE declare (progname, 1, 0, basic frame) FI; + declare (basic module); + declare runtime const; + declare basic init; + declare basic frame; + declare basic module . + +basic packet name: + IF progname <> "" + THEN "BASIC." + progname + ELSE "BASIC" + FI. + +declare runtime const: + allocate variable (data text, type size (text type)); + allocate variable (data pos, type size (int type)); + allocate variable (loc storage, type size (int type)); (* F4/rr *) + + allocate denoter (true value, 0); + allocate denoter (false value, -1); + allocate denoter (niltext value, nil); + allocate denoter (one value, 1); + allocate denoter (two value, 2); + allocate denoter (three value, 3); + allocate denoter (real one value, 1.0); + allocate denoter (comma value, ","); + + zero value := true value; + int one value := one value . + +declare basic init: + begin module; + define (basic init, 4); + parameter (1, text type, var, data text); + parameter (2, int type, var, data pos); + apply (1, 2, "initdata"); + parameter (1, void type, const, nil adr); + apply (1, 0, ret); + end module . + +declare basic frame: + begin module; + define (basic frame, 4); + + IF prog name = nil + THEN parameter (1, void type, const, nil adr); + apply (1, 0, basic init); + FI; + + declare (1, int type); + declare (1, const); + define (1, 0); + parameter (2, void type, const, nil adr); + apply (1, 1, ln op); + + apply (1, 0, "disablestop"); + apply (1, 0, "startbasic"); + + parameter (1, int type, var, data pos); + parameter (2, int type, const, one value); + parameter (3, void type, const, nil adr); + apply (1, 2, int move); + + parameter (1, void type, const, nil adr); + apply (1, 0, basic module); + apply (1, 0, "endbasic"); + parameter (1, void type, const, nil adr); + apply (1, 0, ret); + end module . + +declare basic module: + LABEL VAR start lab; + begin module; + define (basic module); + declare (start lab); + apply (1, 0, "enablestop"); + gosub (start lab); + parameter (1, void type, const, nil adr); + apply (1, 0, "returnerror"); (* mo *) + define (start lab); + clear local stack . (* F4/rr *) + +end compiling: + parameter (1, void type, const, nil adr); + apply (1, 0, ret); + define (loc storage, local storage - 1); (* F4/rr *) + set length of local storage (basic module, max (2, local storage)); (* F4/rr *) + IF error no = 0 + THEN end module FI . + +END PROC compile; + +PROC get statement group (INT CONST new symbol): +(* 'get statement group' compiliert das ganze Programm bis zum Auftreten *) +(* von 'end symbol' *) + disable stop; + new end symbol; + get all basic lines; + old end symbol . + +new end symbol: + INT CONST old symbol :: end symbol; + end symbol := new symbol . + +old end symbol: + end symbol := old symbol . + +get all basic lines: + REP get basic line; + + IF is error + THEN error handling + ELIF symb.type = eos + THEN check this eos FI + PER . + +error handling: (* F20/rr *) + IF error in basic program + THEN error no INCR 1 + ELIF end of source file + THEN clear error; + LEAVE get all basic lines + ELIF halt from terminal + THEN LEAVE get statement group + ELSE error no INCR 1; + handle internal error; + LEAVE get statement group + FI; + clear error; + scope compulsory (TRUE); (* DEF/mo *) + set scope (""); (* DEF/mo *) + next statement; + next symbol . + +error in basic program: + errorcode = 101. + +end of source file: + errorcode = 99. + +halt from terminal: + errorcode = 1. + +handle internal error : (* F20/rr *) + TEXT VAR error :: "BASIC-Compiler ERROR"; + IF errorcode <> 0 + THEN error CAT " #" + text (errorcode) FI; + IF errorline > 0 + THEN error CAT " at " + text (errorline) FI; + error CAT " : "; + error CAT errormessage; + IF sysout <> "" THEN putline (error) FI; + note (error); + noteline; + clear error; + errorstop (error). + +check this eos: + IF symb.no = eol + THEN next symbol + ELIF symb.no = -new symbol OR symb.no = eop + THEN LEAVE get all basic lines (* mo *) + ELSE basic error (intern error, NAME symb, "EOL erwartet, " + + type of (symb.type) + " gefunden") + FI . + +END PROC get statement group; + +PROC get basic line (INT CONST new symbol): +(*Die Abbruchbedingungen werden neu gesetzt und bei Verlassen der *) +(*Prozedur zurückgesetzt. *) + disable stop; + INT CONST old symbol :: end symbol; + end symbol := new symbol; + get basic line; + end symbol := old symbol . + +END PROC get basic line; + +PROC get basic line: +(* 'get basic line' behandelt genau eine Zeile mit Zeilennummer. *) + enable stop; + IF symb.type = stat no + THEN gen stat no (symb.no) FI; + + REP get one basic statement PER . + +get one basic statement: +(* 'get one basic statement' behandelt genau ein Statement. *) + IF symb.type = eos + THEN get end of statement + ELIF symb.type = res word OR symb.type = var OR symb.type = array + THEN get one statement + ELSE basic error (2, NAME symb, type of (symb.type) + " ohne Zusammenhang") FI . + +get end of statement: + IF symb.no = eos + THEN next symbol + ELSE LEAVE get basic line FI . + +get one statement: + IF symb.type = res word + THEN get res word statement + ELIF symb.type = var OR symb.type = array + THEN let statement + FI; + skip comma if else expected; + IF symb.type <> eos + THEN basic error (2, NAME symb, "EOS erwartet, " + type of (symb.type) + " gefunden") + FI. + +skip comma if else expected: + IF end symbol = else s AND symb.type = del AND symb.no = comma + THEN next symbol; + IF symb.type <> eos OR symb.no <> -else s + THEN basic error (2, NAME symb, "ELSE erwartet") + FI + FI. + +get res word statement: + SELECT symb.no OF + CASE as s : basic error (90, symb.name, "") + CASE base s : basic error (91, symb.name, "") + CASE call s, + chain s : call statement + CASE clear s : not implemented + CASE close s : not implemented + CASE cls s : cls statement (* mo *) + CASE common s : not implemented + CASE data s : data statement + CASE def s : def statement (* mo *) + CASE defint s, + defdbl s, + defsng s, + defstr s : def type statement + CASE dim s : dim statement + CASE else s : basic error (92, symb.name, "") + CASE end s : end statement + CASE error s : error statement + CASE field s : not implemented + CASE for s : for statement + CASE get s : not implemented + CASE gosub s : gosub statement + CASE goto s : goto statement + CASE if s : if statement + CASE input s : input statement + CASE kill s : kill statement + CASE let s : let statement + CASE line in s: line statement + CASE lprint s : lprint statement (* mo *) + CASE l set s : l set statement + CASE mid s : mid statement + CASE name s : name statement + CASE next s : basic error (1, symb.name, "") + CASE on s : on statement + CASE open s : not implemented + CASE option s : option statement + CASE print s : print statement + CASE put s : not implemented + CASE rand s : randomize statement + CASE read s : read statement + CASE rem s : rem statement + CASE restore s: restore statement + CASE resume s : not implemented + CASE return s : return statement + CASE r set s : r set statement + CASE step s : basic error (93, symb.name, "") + CASE stop s : stop statement + CASE sub : basic error (101, symb.name, "") + CASE swap s : swap statement + CASE tab s : basic error (94, symb.name, "") + CASE then s : basic error (95, symb.name, "") + CASE to s : basic error (96, symb.name, "") + CASE troff s : troff statement + CASE tron s : tron statement + CASE using s : basic error (97, symb.name, "") + CASE wait s : not implemented + CASE wend s : basic error (30, symb.name, "") + CASE while s : while statement + CASE width s : width statement + CASE write s : write statement + OTHERWISE basic error (104, symb.name, "") END SELECT. + +not implemented: + basic error (100, symb.name, ""). + +call statement: +(*CALL <proc name> [(<argument list>)] *) + next symbol; + get proc name; + get proc parameter; + apply proc . + +get proc name: + proc name := symb.name; + IF symb.type = array + THEN proc name := subtext (proc name, 1, LENGTH proc name-2) FI; + next symbol . + +get proc parameter: + params := 0; + IF symb.type = del AND symb.no = open bracket + THEN get paramfield (param, params) FI . + +apply proc: + OPN VAR proc opn; + FOR i FROM 1 UPTO params + REP parameter (i, param [i].data, const, param [i].adr) PER; + identify (deshift (proc name), 1, params, proc opn, proc found); + + IF NOT proc found + THEN basic error (99, proc name, "Parameter angegeben: " + param list (1, params)) + ELIF result found + THEN basic error (5, proc name, "Kein Resultat erlaubt (gefunden: " + dump (result data) + ")") + FI; + + examine access rights (param, params); + + parameter (params+1, void type, const, nil adr); + apply (1, params, proc opn) . + +result found: + NOT (result data = void type) . + +result data: + dtype (params+1) . + +cls statement: +(*CLS *) + next symbol; + apply (1, 0, "nextpage"). + +data statement: +(*DATA <list of constants> *) + DTYPE VAR const data; + data line (act stat no); + REP IF next data (constant, const data) + THEN data (constant, const data) + ELSE basic error (2, "EOL", "Daten fehlen !") FI; + + next symbol; + IF symb.type = eos + THEN LEAVE data statement + ELIF symb.type <> del OR symb.no <> comma + THEN basic error (2, NAME symb, " , erwartet") FI + PER . + +def statement: (* DEF/mo *) +(*DEF FN<name> [(parameter list)] = <function definition> *) + get function name; + store label of function; + get all params; + get function definition. + +get function name: + next symbol; + IF symb.type <> user fn + THEN treat wrong function name + ELIF LENGTH symb.name <= 2 + THEN basic error (2, symb.name, "Unerlaubter Funktionsname") + ELIF known (symb.no) + THEN basic warning ("Die Funktion """ + symb.name + """ wurde bereits definiert"); + was warning := TRUE + FI; + SYMBOL VAR function :: symb; + function.name := name of (function.no). + +treat wrong function name: + IF symb.type = var OR symb.type = array + THEN basic error (2, symb.name, "Funktionsname muß mit FN beginnen") + ELSE basic error (2, NAME symb, "Funktionsname erwartet") + FI. + +store label of function: + IF last label no < label list size + THEN last label no INCR 1 + ELSE errorstop ("Zu viele Label") + FI; + declare (label list [last label no]); + TEXT VAR dim text :: ""; + dim text CAT last label no; + recognize (function.no, user fn, niladr, function.data, dim text). + +get all params: + set scope (function.name + "?"); + next symbol; + IF symb.type = del AND symb.no = open bracket + THEN REP + try to get a param; + try to get del + UNTIL symb.no = close bracket OR + (symb.type <> del AND symb.type <> var) PER; + skip close bracket + FI. + +try to get a param: + REP + IF symb.type <> var + THEN next symbol + FI; + IF symb.type <> var + THEN careful error (2, NAME symb, "Parametervariable erwartet"); + IF symb.type <> del + THEN next symbol + FI + ELSE treat param + FI + UNTIL symb.type <> del OR symb.no = close bracket PER. + +treat param: + IF NOT known (symb.no) + THEN declare var (symb, nil); + ELIF already appeared in param list + THEN careful error (89, symb.name, ""); + FI; + dim text CAT symb.no. + +already appeared in param list: + INT VAR param counter; + FOR param counter FROM 2 UPTO LENGTH dim text DIV 2 REP + IF (dim text ISUB param counter) = symb.no + THEN LEAVE already appeared in param list WITH TRUE + FI + PER; + FALSE. + +try to get del: + IF symb.type = var + THEN next symbol + FI; + IF symb.type = var OR (symb.type = del CAND (symb.no <> comma AND symb.no <> close bracket)) + THEN careful error (2, symb.name, " , in Parameterliste erwartet") + FI. + +skip close bracket: + IF symb.type = del AND symb.no = close bracket + THEN next symbol + ELSE careful error (2, NAME symb, " ) nach Parameterliste erwartet") + FI. + +get function definition: + scope compulsory (FALSE); + skip (equal, operator); + generate forward jump; + define this label; + get expr (expr result, function.data); + recognize (function.no, user fn, expr result.adr, function.data, dim text); + goret; + define (behind); + scope compulsory (TRUE); + set scope (""). + +generate forward jump: + LABEL VAR behind; + declare (behind); + apply (behind). + +define this label: + define (label list [last label no]). + + +def type statement: +(*DEFINT/DBL/SNG/STR <range(s) of letters> *) + deftype := symb.no; + next symbol; + REP get letter (begin range); + IF symb.type = operator AND symb.no = minus + THEN next symbol; + get letter (end range) + ELSE end range := begin range FI; + + IF name of (begin range.no) > name of (end range.no) + THEN basic error (87, begin range.name + "-" + end range.name, "") + ELSE define chars (name of (begin range.no), name of (end range.no), data type) FI; + + IF symb.type = eos + THEN LEAVE def type statement + ELSE skip (comma, del) FI + PER . + +data type: + SELECT deftype OF + CASE defint s: int type + CASE defstr s: text type + OTHERWISE real type ENDSELECT . + + dim statement: +(*DIM <list of subscripted var results> *) + next symbol; + REP get field var; + get field size; + declare field; + + IF symb.type = eos + THEN LEAVE dim statement + ELSE skip (comma, del) FI + PER . + +get field var: + IF symb.type = array + THEN IF known (symb.no) + THEN basic error (10, symb.name, "") + ELSE field := symb; + next symbol + FI + ELIF symb.type = var + THEN basic error (2, symb.name, "Dimensionsangabe fehlt") + ELSE basic error (2, NAME symb, "Feldname erwartet") + FI. + +get field size: + field size := ""; + field elems := 1; + skip (open bracket, del); + + REP get const (size, int type); + INT CONST field limit :: size.name ISUB 1; + IF field limit < array base + THEN basic error (88, NAME size, "Die Obergrenze muß >= " + + text (array base) + " sein") + ELSE field size CAT (mki (field limit)); + field elems := field elems * (field limit + 1 - array base) + FI; + + IF symb.type = del AND symb.no = close bracket + THEN next symbol; + LEAVE get field size + ELSE skip (comma, del) FI + PER . + +declare field: + field size CAT mki (array base); + field size CAT mki (field elems); + declare var (field, field size) . + +end statement: +(*END *) + next symbol; + parameter (1, void type, const, nil adr); + apply (1, 0, ret) . + +error statement: +(*ERROR <integer expr result> *) + next symbol; + get expr (expr result, int type); + parameter (1, int type, const, expr result.adr); + parameter (2, text type, const, niltext value); + apply (1, 2, "errorstop") . + +gosub statement: +(*GOSUB <line number> *) + next symbol; + get const (label, int type); + gosub (this label) . + +goto statement : +(*GOTO <line number> *) + next symbol; + get const (label, int type); + apply (this label) . + +this label: label list [label pos (label no)] . +label no: label.name ISUB 1 . + +input statement: +(*INPUT [;]["Anfrage" ;/,] Variable [, Variable] *) + ROW 100 DTYPE VAR input var data; + INT VAR number input vars; + LABEL VAR input lab; + next symbol; + declare (input lab); + define (input lab); + get semicolon for cr lf; + get question and question mark; + apply (1, 3, "readinput"); + get input eof; + get data types of input vars (input var data, number input vars); (* F25/rr *) + check data types of input vars; (* F8/F25/rr *) + apply (1, 0, "inputok"); + apply (input lab, FALSE); + assign list of input var . (* F8/F25/rr *) + +get semicolon for cr lf: + IF symb.type = del AND symb.no = semicolon + THEN next symbol; + parameter (1, bool type, const, false value) + ELSE parameter (1, bool type, const, true value) FI . + +get question and question mark: + IF symb.type = const AND symb.data = text type + THEN get const (question, text type); + parameter (2, text type, const, question.adr); + parameter (3, bool type, const, question mark value); + next symbol + ELSE parameter (2, text type, const, niltext value); + parameter (3, bool type, const, true value); (* F7/rr *) + FI . + +question mark value: + IF symb.type = del AND symb.no = semicolon + THEN true value + ELIF symb.type = del AND symb.no = comma + THEN false value + ELSE basic error (2, NAME symb, " ; oder , erwartet"); nil adr FI . + +get input eof: + IF symb.type = res word AND symb.no = eof s + THEN next symbol; + get const (label, int type); + apply (1, 0, "inputeof"); + apply (this label, TRUE) + FI . + +check data types of input vars : (* F8/F25/rr *) + FOR i FROM 1 UPTO number input vars + REP parameter (1, int type, const, input data type); + apply (1, 1, "checkinput"); + apply (input lab, FALSE); + PER . + +input data type : (* F8/F25/rr *) + IF input var data (i) = int type THEN one value + ELIF input var data (i) = real type THEN two value + ELIF input var data (i) = text type THEN three value + ELSE zero value + FI . + +assign list of input var : (* F8/F25/rr *) + REP get var (var result); + parameter (1, var result. data, var, var result. adr); + apply (1, 1, "assigninput"); + + IF symb.type = del AND symb.no = comma + THEN next symbol + ELSE LEAVE assign list of input var FI + PER . + +kill statement: +(*KILL <filename> *) + next symbol; + get expr (filename, text type); + + parameter (1, text type, const, filename.adr); + parameter (2, quiet type, const, next local adr (int type)); + apply (2, 0, "quiet"); + apply (1, 2, "forget") . + +let statement: +(*[LET] <var> = <expression> *) + IF symb.type = res word AND symb.no = let s + THEN next symbol FI; + get var (var result); + skip (equal, operator); + get expr (expr result, var result.data); + apply move (var result.adr, expr result.adr, var result.data). + +line statement: (* F9/rr *) +(*1. LINE INPUT [;][<"prompt string">;]<string var result> *) + next symbol; + skip (input s, res word); + get semicolon; + get prompt string; + apply (1, 3, "readinput"); + assign string var result . + +get semicolon: + IF symb.type = del AND symb.no = semicolon + THEN next symbol; + parameter (1, bool type, const, false value) + ELSE parameter (1, bool type, const, true value) FI . + +get prompt string: + IF symb.type = const AND symb.data = text type + THEN get const (question, text type); + parameter (2, text type, const, question.adr); + skip (semicolon, del); + ELSE parameter (2, text type, const, niltext value); + FI; + parameter (3, bool type, const, false value) . + +assign string var result : + get var (var result, text type); + parameter (1, text type, var, var result.adr); + apply (1, 1, "assigninputline") . + +lprint statement: +(*LPRINT (cf. PRINT) *) + apply (1, 0, "switchtoprintoutfile"); + print statement; + apply (1, 0, "switchbacktooldsysoutstate"). + +l set statement: +(*LSET <string var> = <string expression> *) + next symbol; + get var (var result, text type); + skip (equal, operator); + get expr (expr result, text type); + parameter (1, text type, var, var result.adr); + parameter (2, text type, const, expr result.adr); + apply (1, 2, "lset") . + +mid statement: +(*MID$ (<string var>, from [,len]) = <string expression> *) + next symbol; + skip (open bracket, del); + get var (var result, text type); + skip (comma, del); + get expr (from, int type); + IF symb.type = del AND symb.no = comma + THEN next symbol; + get expr (len, int type) + ELSE len := nilsymbol FI; + skip (close bracket, del); + skip (equal, operator); + get expr (expr result, text type); + + parameter (1, text type, var, var result.adr); + parameter (2, int type, const, from.adr); + parameter (3, text type, const, expr result.adr); + IF len.data = int type + THEN parameter (4, int type, const, one value); + parameter (5, int type, const, len.adr); + parameter (6, text type, var, next local adr (text type)); + apply (3, 3, "subtext"); + parameter (3, text type, const, local adr); + FI; + apply (1, 3, "replace") . + +name statement: +(*NAME <old filename> AS <new filename> *) + next symbol; + get expr (old name, text type); + skip (as s, res word); + get expr (new name, text type); + parameter (1, text type, const, old name.adr); + parameter (2, text type, const, new name.adr); + apply (1, 2, "rename") . + +option statement: +(*OPTION BASE 0|1 *) + next symbol; + skip (base s, res word); + get const (base size, int type); + IF new array base > 1 + THEN basic error (105, NAME base size, "") + ELSE array base := new array base + FI. + +new array base: + base size.name ISUB 1. + +randomize statement: +(*RANDOMIZE [<expression>] *) + next symbol; + IF symb.type = eos + THEN apply (1, 0, "initrnd") + ELSE get expr (expr result, real type); + parameter (1, real type, const, expr result.adr); + apply (1, 1, "initrnd") + FI . + +read statement: +(*READ <list of var> *) + next symbol; + REP get var (var result); + parameter (1, text type, const, data text); + parameter (2, int type, var, data pos); + parameter (3, var result.data, var, var result.adr); + apply (1, 3, "read"); + + IF symb.type = eos + THEN LEAVE read statement + ELSE skip (comma, del) FI + PER . + +rem statement: +(*REM <remark> *) + next statement; + symb := SYMBOL : ("", eol, eos, LOC 0, void type); + LEAVE get basic line . + +restore statement: +(*RESTORE [<line number>] *) + next symbol; + IF symb.type = eos + THEN parameter (1, int type, var, data pos); + parameter (2, int type, const, one value); + parameter (3, void type, const, nil adr); + apply (1, 2, int move); + ELSE get const (label, int type); + parameter (1, text type, const, data text); + parameter (2, int type, var, data pos); + parameter (3, int type, const, label.adr); + apply (1, 3, "restore") + FI . + +return statement : +(*RETURN *) + next symbol; + goret . + +r set statement: +(*RSET <string var> = <string expression> *) + next symbol; + get var (var result, text type); + skip (equal, operator); + get expr (expr result, text type); + parameter (1, text type, var, var result.adr); + parameter (2, text type, const, expr result.adr); + apply (1, 2, "rset") . + +stop statement: +(*STOP *) + next symbol; + expr result := SYMBOL: (nil, any, const, nil adr, int type); + expr result.name CAT act stat no; + declare const (expr result, int type); + parameter (1, int type, const, expr result.adr); + apply (1, 1, "basicstop"); + parameter (1, void type, const, nil adr); + apply (1, 0, ret) . + +swap statement: +(*SWAP <var>,<var> *) + next symbol; + get var (var result); + parameter (1, var result.data, var, var result.adr); + DTYPE CONST first var result data :: var result.data; + skip (comma, del); + get var (var result); + IF first var result data = var result.data + THEN parameter (2, var result.data, var, var result.adr); + apply (1, 2, "swap") + ELSE basic error (106, var result.name, "gefunden: " + + dump (first var result data) + ", " + dump (var result.data)) + FI. + +troff statement: +(*TROFF *) + next symbol; + basic trace := FALSE . + +tron statement: +(*TRON *) + next symbol; + basic trace := TRUE . + +width statement: +(*WIDTH Größe *) + next symbol; + get expr (expr result, int type); + parameter (1, int type, const, expr result.adr); + apply (1, 1, "width") . + +write statement: +(*WRITE [<list of expr results>] *) + next symbol; + + IF symb.type = eos + THEN apply (1, 0, "nextline") + ELSE write list of expr results FI . + +write list of expr results: + REP get expr (expr result); + parameter (1, expr result.data, const, expr result.adr); + apply (1, 1, "basicwrite"); + + IF symb.type = eos + THEN apply (1, 0, "nextline"); + LEAVE write list of expr results + ELSE skip (comma, del); + parameter (1, text type, const, comma value); + apply (1, 1, "basicout") + FI + PER . + +END PROC get basic line; + +PROC gen stat no (INT CONST local stat no): +(* Die Zeilennummer wird als Label definiert *) +(* Die Prozedur 'stat no' wird mit der Statementnummer aufgerufen *) + act stat no := local stat no; + define (label list [label pos (act stat no)]); + + declare (1, int type); + declare (1, const); + define (1, act stat no); + parameter (2, void type, const, nil adr); + apply (1, 1, ln op); + + IF basic trace + THEN expr result := SYMBOL: (nil, any, const, nil adr, int type); + expr result.name CAT act stat no; + declare const (expr result, int type); + parameter (1, int type, const, expr result.adr); + apply (1, 1, trace op) + FI; + next symbol . + +END PROC gen stat no; + +PROC for statement: +(*FOR <var> = x TO y [STEP z] *) + SYMBOL VAR local var result, init val, limit val, step val; + LABEL VAR start loop, end loop; + INT CONST for stat no := act stat no, (* F29/rr *) + for scan line no := scan line no; + TEXT CONST for symb name := symb.name; + declare (start loop); + declare (end loop); + + next symbol; + get loop var; + skip (equal, operator); + get expr (init val, local var result.data); + skip (to s, res word); + get expr (limit val, local var result.data); + get step val; + + init loop var; + define (start loop); + gen check of variable; + get statement group (next s); + + IF symb.type = eos AND symb.no = -next s + THEN next var statement + ELSE define (end loop); + basic error ("Compiler", 26, for scan line no, for stat no, for symb name, "", TRUE); (* F29/rr *) + FI . + +get loop var: + get var (local var result); + IF NOT (local var result.data = int type OR local var result.data = real type) + THEN basic error (2, NAME local var result, "INT oder REAL erwartet, " + + dump (local var result.data) + " gefunden") + FI . + +get step val: + IF symb.type = res word AND symb.no = step s + THEN next symbol; + get expr (step val, local var result.data) + ELIF local var result.data = int type + THEN step val.data := int type; + step val.adr := int one value + ELSE step val.data := real type; + step val.adr := real one value + FI . + +init loop var: + IF local var result.data = int type + THEN init int loop + ELSE init real loop FI . + +init int loop: + IF limit val.type = var + THEN parameter (1, int type, var, next local adr (int type)); + parameter (2, int type, const, limit val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, int move); + limit val.adr := local adr; + FI; + IF step val.type = var + THEN parameter (1, int type, var, next local adr (int type)); + parameter (2, int type, const, step val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, int move); + step val.adr := local adr; + FI; + IF NOT (init val.no = local var result.no) + THEN parameter (1, int type, var, local var result.adr); + parameter (2, int type, const, init val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, int move) + FI . + +init real loop: + IF limit val.type = var + THEN parameter (1, real type, var, next local adr (real type)); + parameter (2, real type, const, limit val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, real move); + limit val.adr := local adr; + FI; + IF step val.type = var + THEN parameter (1, real type, var, next local adr (real type)); + parameter (2, real type, const, step val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, real move); + step val.adr := local adr; + FI; + IF NOT (init val.no = local var result.no) + THEN parameter (1, real type, var, local var result.adr); + parameter (2, real type, const, init val.adr); + parameter (3, void type, const, nil adr); + apply (1, 2, real move) + FI . + +gen check of variable: + parameter (1, local var result.data, const, local var result.adr); + parameter (2, limit val.data, const, limit val.adr); + parameter (3, step val.data, const, step val.adr); + parameter (4, bool type, const, nil adr); apply (4, nop); +(* In der nächsten Coder-Version ist eine PUSH-Angabe nop nicht nötig *) + apply (1, 3, "loopend"); + apply (end loop, TRUE) . + +next var statement: +(*NEXT [<var>][,<var>...] *) + next symbol; + generate loop end; + IF symb.type <> eos + THEN check next var result FI . + +check next var result: + IF symb.no = local var result.no + THEN next symbol; + IF symb.type = del AND symb.no = comma + THEN next for loop FI + ELSE basic error (86, NAME symb, local var result.name + " erwartet") FI . + +next for loop: + IF end symbol = next s + THEN symb := SYMBOL:("", -next s, eos, nil adr, void type) + ELSE basic error (1, symb.name, "") (* mo *) + FI. + +generate loop end: + parameter (1, local var result.data, var, local var result.adr); + parameter (2, step val.data, const, step val.adr); + parameter (3, void type, const, nil adr); + IF local var result.data = int type + THEN apply (1, 2, int incr) + ELSE apply (1, 2, real incr) FI; + + apply (start loop); + define (end loop) . + +END PROC for statement; + +PROC if statement : (* Änd. 11.08.87, mo *) +(* IF <expression> THEN <statement(s)>|<line number> *) +(* [ELSE <statement(s)>|<line number>] *) +(* IF <expression> GOTO <line number> *) +(* [ELSE <statement(s)>|<line number>] *) + SYMBOL VAR local expr result; + next symbol; + get expr (local expr result, int type); + skip comma if there; + IF symb.type = res word AND (symb.no = then s OR symb.no = goto s) + THEN test expr result; + IF symb.no = goto s + THEN next symbol; + if goto statement + ELIF next symbol is stat no + THEN if goto statement + ELSE if then statement + FI + ELSE basic error (2, NAME symb, "THEN oder GOTO erwartet") FI . + +skip comma if there: + IF symb.no = comma AND symb.type = del + THEN next symbol + FI. + +test expr result: + parameter (1, int type, const, local expr result.adr); + parameter (2, bool type, var, nil adr); apply (2, nop); + apply (1, 1, test) . + +next symbol is stat no: + next symbol; + symb.type = const AND symb.data = int type. + +if goto statement: + SYMBOL VAR stat label; + get const (stat label, int type); + expect else if comma found; + IF symb.type = res word AND symb.no = else s + THEN apply (this label, FALSE); + treat else case + ELIF symb.type <> eos OR symb.no <> eol + THEN declare (else label); + apply (this label, FALSE); + apply (else label); + get basic line (else s); + IF symb.type = eos AND symb.no = -else s + THEN else statement + ELSE define (else label) + FI + ELSE apply (this label, FALSE) + FI. + +this label: label list [label pos (label no)] . +label no: stat label.name ISUB 1 . + +expect else if comma found: + IF symb.type = del AND symb.no = comma + THEN next symbol; + IF symb.no <> else s OR symb.type <> res word + THEN basic error (2, NAME symb, "ELSE erwartet") + FI + FI. + +treat else case: + IF next symbol is stat no + THEN get const (stat label, int type); + apply (this label) + ELSE get basic line + FI. + +if then statement: + LABEL VAR fi label; + declare (else label); + apply (else label, TRUE); + get basic line (else s); + + IF symb.type = eos AND symb.no = -else s + THEN declare (fi label); + apply (fi label); + else statement; + define (fi label) + ELSE define (else label) FI . + + +else statement: + LABEL VAR else label; + define (else label); + treat else case. + + +END PROC if statement; + +PROC on statement: +(*2. ON <expression> GOSUB <list of line numbers> *) +(*3. ON <expression> GOTO <list of line numbers> *) + LABEL VAR before case, after case, return case; + declare (before case); + declare (after case); + declare (return case); + + next symbol; + IF symb.type = res word AND symb.no = error s + THEN basic error (100, symb.name, "") + FI; + get expr (expr result, int type); + IF on gosub statement + THEN gosub (before case); + apply (after case) + ELIF NOT on goto statement + THEN basic error (2, symb.name, "GOTO oder GOSUB erwartet") FI; + + get case stat no; + define (before case); + gen case branches; + gen return case; + define (after case) . + +on gosub statement: + BOOL CONST gosub found := symb.type = res word AND symb.no = gosub s; + gosub found . + +on goto statement: + symb.type = res word AND symb.no = goto s. + +get case stat no: + TEXT VAR case stat no :: nil; + INT VAR case no :: 0; + next symbol; + REP get const (label, int type); + case no INCR 1; + case stat no CAT label.name; + + IF symb.type = eos + THEN LEAVE get case stat no + ELSE skip (comma, del) FI + PER . + +gen case branches: + computedbranch (expr result.adr, case no + 1, otherwise lab); (* F6/rr *) + apply (otherwise lab); + FOR i FROM 1 UPTO case no + REP apply (label i) PER . + +gen return case: + IF gosub found + THEN define (return case); + goret + FI . + +otherwise lab: + IF gosub found + THEN return case + ELSE after case FI . + +label i: + label list [label pos (case stat no ISUB i)] . + +END PROC on statement; + +PROC print statement: +(*PRINT [<list of expr results>] *) +(*PRINT USING <string exp>;<list of expression> *) +(*PRINT #<file number>,<list of expr results> *) +(*PRINT #<file number>, USING <string exp>;<list of expression> *) + next symbol; + IF symb.type = del AND symb.no = numbersign + THEN print file statement + ELSE print display statement FI . + +print file statement: + basic error (100, symb.name, "") . + +print display statement: + get format string; + print list of expr results; + reset format string . + +get format string: + IF symb.type = res word AND symb.no = using s + THEN next symbol; + get expr (image, text type); + skip (semicolon, del); + parameter (1, text type, const, image.adr); + apply (1, 1, "using"); + ELSE image := nilsymbol FI . + +reset format string: + IF image.type <> any + THEN apply (1, 0, "clearusing") FI . + +print list of expr results: + REP IF symb.type = res word AND symb.no = tab s + THEN get tabulation + ELIF symb.type = del AND symb.no = comma + THEN get next zone + ELIF symb.type = del AND symb.no = semicolon + THEN get next pos + ELIF symb.type = eos + THEN apply (1, 0, "nextline"); + LEAVE print list of expr results + ELSE get print expr result FI; + PER . + +get tabulation: + next symbol; + skip (open bracket, del); + get expr (tab pos, int type); + skip (close bracket, del); + parameter (1, int type, const, tab pos.adr); + apply (1, 1, "tab") . + +get next zone: + next symbol; + IF image.type = any + THEN apply (1, 0, "nextzone") FI; + IF symb.type = eos + THEN LEAVE print list of expr results FI . + +get next pos: + next symbol; + IF symb.type = eos + THEN LEAVE print list of expr results FI . + +get print expr result: + get expr (expr result); + parameter (1, expr result.data, const, expr result.adr); + apply (1, 1, "basicout") . + +END PROC print statement; + +PROC while statement: +(*WHILE <expression> *) + LABEL VAR while lab, wend lab; + SYMBOL VAR while expr result; + INT CONST while stat no := act stat no, (* F29/rr *) + while scan line no := scan line no; + TEXT CONST while symb name := symb.name; + next symbol; + declare (while lab); + declare (wend lab); + + define (while lab); + get expr (while expr result, int type); + parameter (1, int type, const, while expr result.adr); + parameter (2, bool type, const, nil adr); apply (2, nop); + apply (1, 1, test); + apply (wend lab, TRUE); (* 'test' vergleicht mit 0 *) + + get statement group (wend s); + IF symb.type = eos AND symb.no = -wend s + THEN wend statement + ELSE basic error ("Compiler", 29, while scan line no, while stat no, while symb name, "", TRUE) FI. (* F29/rr *) + +wend statement: +(*WEND *) + apply (while lab); + define (wend lab); + next symbol . + +END PROC while statement; + +END PACKET basic compiler + diff --git a/lang/basic/1.8.7/src/BASIC.Runtime b/lang/basic/1.8.7/src/BASIC.Runtime new file mode 100644 index 0000000..854002a --- /dev/null +++ b/lang/basic/1.8.7/src/BASIC.Runtime @@ -0,0 +1,1571 @@ +(***************************************************************************) +(* *) +(* Erste von drei Dateien des EUMEL-BASIC-Systems *) +(* *) +(* Autor: Heiko Indenbirken *) +(* Überarbeitet von: Rudolf Ruland und Michael Overdick *) +(* *) +(* Stand: 27.10.1987 *) +(* *) +(***************************************************************************) + +PACKET basic std DEFINES EQU, UEQ, (* Autor: Heiko Indenbirken *) + LES, LEQ, (* Stand: 23.10.1987/rr/mo *) + GRE, GEQ, + EQV, IMP, + ^, swap, + val, asc, cdbl, chr, + cint, cvi, cvd, fre, + hex, inchars, + instr, ent, left, + mid, mki, mkd, + oct, right, + rnd, init rnd, + space, string, + l set, r set, + int not, real not, + /, DIV, real mod, + time, timer, + arctan, cos, sin, tan, + exp, ln, floor, + sqrt: + + +INT CONST true := -1, + false := 0; + +LET real overflow = 6; + + +(*BASIC-Integervergleiche *) +INT OP EQU (INT CONST a, b): + IF a=b + THEN true + ELSE false FI +END OP EQU; + +INT OP UEQ (INT CONST a, b): + IF a=b + THEN false + ELSE true FI +END OP UEQ; + +INT OP LES (INT CONST a, b): + IF a<b + THEN true + ELSE false FI +END OP LES; + +INT OP LEQ (INT CONST a, b): + IF a<=b + THEN true + ELSE false FI +END OP LEQ; + +INT OP GRE (INT CONST a, b): + IF a>b + THEN true + ELSE false FI +END OP GRE; + +INT OP GEQ (INT CONST a, b): + IF a>=b + THEN true + ELSE false FI +END OP GEQ; + +(*BASIC-Realvergleiche *) +INT OP EQU (REAL CONST a, b): + IF a=b + THEN true + ELSE false FI +END OP EQU; + +INT OP UEQ (REAL CONST a, b): + IF a=b + THEN false + ELSE true FI +END OP UEQ; + +INT OP LES (REAL CONST a, b): + IF a<b + THEN true + ELSE false FI +END OP LES; + +INT OP LEQ (REAL CONST a, b): + IF a<=b + THEN true + ELSE false FI +END OP LEQ; + +INT OP GRE (REAL CONST a, b): + IF a>b + THEN true + ELSE false FI +END OP GRE; + +INT OP GEQ (REAL CONST a, b): + IF a>=b + THEN true + ELSE false FI +END OP GEQ; + +(*BASIC-Tesxtvergleiche *) +INT OP EQU (TEXT CONST a, b): + IF a=b + THEN true + ELSE false FI +END OP EQU; + +INT OP UEQ (TEXT CONST a, b): + IF a=b + THEN false + ELSE true FI +END OP UEQ; + +INT OP LES (TEXT CONST a, b): + IF a<b + THEN true + ELSE false FI +END OP LES; + +INT OP LEQ (TEXT CONST a, b): + IF a<=b + THEN true + ELSE false FI +END OP LEQ; + +INT OP GRE (TEXT CONST a, b): + IF a>b + THEN true + ELSE false FI +END OP GRE; + +INT OP GEQ (TEXT CONST a, b): + IF a>=b + THEN true + ELSE false FI +END OP GEQ; + + +(*BASIC INTEGER / BOOL Operatoren *) +REAL PROC real not (REAL CONST a): (* mo *) + real (int (a) XOR -1) +END PROC real not; + +INT PROC int not (INT CONST a): (* mo *) + a XOR -1 +END PROC int not; + +INT OP EQV (INT CONST l, r): + int not (l XOR r) +END OP EQV; + +INT OP IMP (INT CONST l, r): + (l EQV r) OR r +END OP IMP; + +LET smallest significant = 5.0e-12; +REAL OP ^ (REAL CONST x, y): (* F22/rr *) + IF x > 0.0 + THEN x ** y + ELIF x = 0.0 + THEN IF y > 0.0 + THEN 0.0 + ELIF y = 0.0 + THEN 1.0 + ELSE errorstop (real overflow, ""); + max real + FI + ELSE REAL VAR floor y := floor (y + round value); + IF (abs (y - floor y) > smallest significant) + COR (floor y = 0.0 AND y <> 0.0) + THEN errorstop (1005, "bei " + text (x) + + " ^ " + text (y, 19) + + " : neg. Basis, gebr. Exponent"); + 0.0 + ELIF (floor y MOD 2.0) = 0.0 + THEN (-x) ** floor y + ELSE - ( (-x) ** floor y ) + FI + FI . + + round value : IF y >= 0.0 THEN 0.5 ELSE -0.5 FI . + +END OP ^; + +REAL OP ^ (INT CONST x, y): + real (x) ** y +END OP ^; + +REAL OP / (INT CONST l, r): (* mo *) + real (l) / real (r) +END OP /; + +INT OP DIV (REAL CONST l, r): (* mo *) + cint (l) DIV cint (r) +END OP DIV; + +REAL PROC real mod (REAL CONST l, r): (* mo *) + round (l, 0) MOD round (r, 0) +END PROC real mod; + +(* Basic Arithmetik *) +REAL VAR r swap; +PROC swap (REAL VAR left, right): + r swap := left; + left := right; + right := r swap +END PROC swap; + +INT VAR i swap; +PROC swap (INT VAR left, right): + i swap := left; + left := right; + right := i swap +END PROC swap; + +TEXT VAR t swap; +PROC swap (TEXT VAR left, right): + t swap := left; + left := right; + right := t swap +END PROC swap; + +(*Internkonvertierungen *) +INT PROC cvi (TEXT CONST v): + v ISUB 1 +END PROC cvi; + +REAL PROC cvd (TEXT CONST v): + v RSUB 1 +END PROC cvd; + +TEXT VAR i text :: 2*""0"", r text :: 8*""0""; +TEXT PROC mki (REAL CONST x): + mki (cint (x)) +END PROC mki; + +TEXT PROC mki (INT CONST i): + replace (i text, 1, i); + i text +END PROC mki; + +TEXT PROC mkd (INT CONST i): + mkd (real (i)) +END PROC mkd; + +TEXT PROC mkd (REAL CONST r): + replace (r text, 1, r); + r text +END PROC mkd; + +(*Textoperationen *) +PROC l set (TEXT VAR left, TEXT CONST right): + replace (left, 1, right) +END PROC l set; + +PROC r set (TEXT VAR left, TEXT CONST right): + replace (left, length (left)-length (right)+1, right) +END PROC r set; + +TEXT PROC left (TEXT CONST string, REAL CONST no): + left (string, cint (no)) +END PROC left; + +TEXT PROC left (TEXT CONST string, INT CONST no): + subtext (string, 1, no) +END PROC left; + +TEXT PROC right (TEXT CONST string, REAL CONST no): + right (string, cint (no)) +END PROC right; + +TEXT PROC right (TEXT CONST string, INT CONST no): + subtext (string, length (string)-no+1) +END PROC right; + +TEXT PROC mid (TEXT CONST source, REAL CONST from): + mid (source, cint (from)) +END PROC mid; + +TEXT PROC mid (TEXT CONST source, INT CONST from): + subtext (source, from) +END PROC mid; + +TEXT PROC mid (TEXT CONST source, REAL CONST from, length): + mid (source, cint (from), cint (length)) +END PROC mid; + +TEXT PROC mid (TEXT CONST source, INT CONST from, length): + subtext (source, from, from+length-1) +END PROC mid; + +TEXT PROC string (REAL CONST x, y): + string (cint (x), cint (y)) +END PROC string; + +TEXT PROC string (INT CONST x, REAL CONST y): + string (x, cint (y)) +END PROC string; + +TEXT PROC string (REAL CONST x, INT CONST y): + string (cint (x), y) +END PROC string; + +TEXT PROC string (INT CONST i, j): + i * code (j) +END PROC string; + +TEXT PROC string (REAL CONST i, TEXT CONST x): + string (cint (i), x) +END PROC string; + +TEXT PROC string (INT CONST i, TEXT CONST x): + i * (x SUB 1) +END PROC string; + +(*Konvertierungen *) + +REAL PROC val (TEXT CONST text) : (* F18/rr *) + + TEXT VAR buffer := text; + change (buffer, "d", "e"); + change (buffer, "D", "e"); + change (buffer, "E", "e"); + real (buffer) + +END PROC val; + +REAL PROC asc (TEXT CONST text): + real (code (text SUB 1)) +END PROC asc; + +TEXT PROC chr (INT CONST n): + code (n) +END PROC chr; + +TEXT PROC chr (REAL CONST n): + code (cint (n)) +END PROC chr; + +TEXT PROC hex (REAL CONST x): + hex (cint (x)) +END PROC hex; + +TEXT PROC hex (INT CONST x): + TEXT VAR value :: "12"; + replace (value, 1, x); + high byte + low byte . + +low byte: + hexdigit (code (value SUB 1) DIV 16) + hexdigit (code (value SUB 1) MOD 16) . + +high byte: + IF (value SUB 2) = ""0"" + THEN "" + ELSE hexdigit (code (value SUB 2) DIV 16) + + hexdigit (code (value SUB 2) MOD 16) + FI . + +END PROC hex; + +TEXT PROC oct (REAL CONST x): + oct (cint (x)) +END PROC oct; + +TEXT PROC oct (INT CONST x): + INT VAR number :: x AND maxint; + generate oct number; + IF x < 0 + THEN "1" + oct number + ELSE subtext (oct number, pos (oct number, "1", "7", 1)) + FI. + +generate oct number: + TEXT VAR oct number :: ""; + INT VAR digit; + FOR digit FROM 1 UPTO 5 REP + oct number := hexdigit (number MOD 8) + oct number; + number := number DIV 8 + PER. + +END PROC oct; + +TEXT PROC hexdigit (INT CONST digit): + IF 0 <= digit AND digit <= 9 + THEN code (digit + 48) + ELIF 10 <= digit AND digit <= 15 + THEN code (digit + 55) + ELSE errorstop (1051, "Hexziffer außerhalb des gültigen Bereichs"); "" FI +END PROC hexdigit; + +TEXT PROC inchars (REAL CONST n): + inchars (cint (n)) +END PROC inchars; + +TEXT PROC inchars (INT CONST n): + TEXT VAR buffer :: "", char; + INT VAR i; + FOR i FROM 1 UPTO n + REP inchar (char); + buffer CAT char + PER; + buffer + +END PROC inchars; + +(*Mathematische Prozeduren *) +REAL PROC ent (INT CONST r): + real (r) +END PROC ent; + +REAL PROC ent (REAL CONST r): + IF r >= 0.0 OR frac (r) = 0.0 + THEN floor (r) + ELSE floor (r-1.0) FI +END PROC ent; + +REAL PROC cdbl (INT CONST r): + real (r) +END PROC cdbl; + +REAL PROC cdbl (REAL CONST r): + r +END PROC cdbl; + +INT PROC cint (INT CONST r): + r +END PROC cint; + +INT PROC cint (REAL CONST r): + IF r >= 0.0 + THEN int (r+0.5) + ELSE int (r-0.5) FI +END PROC cint; + +REAL VAR last rnd :: rnd (1.0); +REAL PROC rnd (INT CONST x): + rnd (real (x)) +END PROC rnd; + +REAL PROC rnd (REAL CONST x): + IF x > 0.0 + THEN last rnd := random; + last rnd + ELIF x = 0.0 + THEN last rnd + ELSE init rnd (x); + last rnd := random; + last rnd + FI + +END PROC rnd; + +REAL PROC rnd: + rnd (1.0) +END PROC rnd; + +PROC init rnd (REAL CONST init value) : + + REAL VAR init := init value; + IF init <= -1.0 OR 1.0 <= init + THEN set exp (- decimal exponent (init) - 1, init) FI; + initialize random (init) + +END PROC init rnd; + + +REAL PROC fre (TEXT CONST dummy): + INT VAR f, u; + collect heap garbage; + storage (f, u); + + real (f - u) * 1024.0 +END PROC fre; + +REAL PROC fre (REAL CONST dummy): + fre ("") +END PROC fre; + +REAL PROC fre (INT CONST dummy): + fre ("") +END PROC fre; + +(*Inputroutinenen *) +INT PROC instr (TEXT CONST source, pattern): + pos (source, pattern) +END PROC instr; + +INT PROC instr (REAL CONST from, TEXT CONST source, pattern): + instr (cint (from), source, pattern) +END PROC instr; + +INT PROC instr (INT CONST from, TEXT CONST source, pattern): + pos (source, pattern, from) +END PROC instr; + +TEXT PROC space (REAL CONST len): + space (cint (len)) +END PROC space; + +TEXT PROC space (INT CONST len): + len * " " +END PROC space; + +TEXT PROC time: (* mo *) + subtext (time (clock (1) MOD day), 1, 8) (* hh:mm:ss *) +END PROC time; + +REAL PROC timer: + clock (0) +END PROC timer; + +REAL PROC arctan (INT CONST x): + arctan (real (x)) +END PROC arctan; + +REAL PROC cos (INT CONST x): + cos (real (x)) +END PROC cos; + +REAL PROC sin (INT CONST x): + sin (real (x)) +END PROC sin; + +REAL PROC tan (INT CONST x): + tan (real (x)) +END PROC tan; + +REAL PROC exp (INT CONST x): + exp (real (x)) +END PROC exp; + +REAL PROC ln (INT CONST x): + ln (real (x)) +END PROC ln; + +REAL PROC floor (INT CONST x): + real (x) +END PROC floor; + +REAL PROC sqrt (INT CONST x): + sqrt (real (x)) +END PROC sqrt; + +END PACKET basic std; + +PACKET basic using DEFINES using, (* Autor: Heiko Indenbirken *) + clear using, (* Stand: 05.08.1987/rr/mo *) + basic text: + + +LET exclamation point = "!", + backslash = "\", + comercial and = "&", + numbersign = "#", + plus = "+", + minus = "-", + asterisk dollar = "**$", + asterisk = "**", + dollarsign = "$$", + comma = ",", + point = ".", + caret = "^^^^", + underscore = "_", + blank = " ", + nil = "", + + number format chars = "#+-*$.^", + format chars = "!\&#+-$*."; + +TEXT VAR result, using format :: "", pre format :: ""; +INT VAR using pos :: 0; +BOOL VAR image used :: FALSE; + +PROC using (TEXT CONST format): + using format := format; + using pos := 0; + result := ""; + image used := TRUE + +END PROC using; + +PROC clear using: + using format := ""; + image used := FALSE +END PROC clear using; + +TEXT PROC next format: + pre format := ""; + IF using pos = 0 + THEN "" + ELSE search rest of format FI . + +search rest of format: + WHILE using pos <= length (using format) + REP IF at underscore + THEN using pos INCR 1; + pre format CAT akt char + ELIF at format char + THEN LEAVE next format WITH pre format + ELSE pre format CAT akt char FI; + using pos INCR 1 + PER; + using pos := 0; + pre format . + +at underscore: + akt char = underscore . + +at format char: + pos (format chars, akt char) > 0 CAND + evtl double asterisk CAND + evtl point with numbersign . + +evtl double asterisk: + akt char <> asterisk COR next char = asterisk . + +evtl point with numbersign: + akt char <> point COR next char = numbersign . + +akt char: using format SUB using pos . +next char: using format SUB using pos+1 . +END PROC next format; + +PROC init (TEXT VAR l result): + IF using pos = 0 + THEN using pos := 1; + l result := next format; + IF using pos = 0 + THEN errorstop (1005, "USING: kein Format gefunden") FI + ELSE l result := "" FI + +END PROC init; + +TEXT PROC basic text (TEXT CONST string): + IF image used + THEN using text + ELSE string FI . + +using text: + init (result); + result CAT format string; + using pos INCR 1; + result CAT next format; + result . + +format string: + IF akt char = exclamation point + THEN string SUB 1 + ELIF akt char = backslash + THEN given length string + ELIF akt char = comercial and + THEN string + ELSE errorstop (1005, "USING-Format fehlerhaft: " + using format); "" FI . + +given length string: + INT VAR len :: 2; + FOR using pos FROM using pos+1 UPTO length (using format) + REP IF akt char = "\" + THEN LEAVE given length string WITH text (string, len) FI; + len INCR 1 + UNTIL akt char <> " "PER; + errorstop (1005, "USING-Format fehlerhaft: " + using format); + "" . + +akt char: using format SUB using pos +END PROC basic text; + +TEXT PROC basic text (INT CONST number): + IF image used + THEN basic text (real (number)) + ELSE sign + text (number) FI . + +sign: + IF number >= 0 + THEN " " + ELSE "" FI . + +END PROC basic text; + +TEXT PROC basic text (REAL CONST number): + IF image used + THEN using text + ELSE normal text FI . + +normal text: +(* Bei Real Zahlen werden maximal 7 signifikante Stellen ausgegeben, *) +(* führende und nachfolgende Nullen werden unterdrückt, *) +(* der Dezimalpunkt wird im Normalformat unterdrückt *) + calculate sign; + REAL VAR mantissa := round (abs (number), 6-decimal exponent (number)); + INT CONST exp :: decimal exponent (mantissa); + + IF mantissa = 0.0 + THEN result := " 0" + ELIF exp > 6 OR exp < -7 OR (exp < 0 AND more than 7 signifikant digits) + THEN scientific notation + ELIF exp < 0 + THEN short negative notation + ELSE short positive notation FI; + result . + +more than 7 signifikant digits: + REAL VAR signifikant := mantissa; + set exp (7+exp, signifikant); + frac (signifikant) <> 0.0 . + +calculate sign: + IF number >= 0.0 + THEN result := " " + ELSE result := "-" FI . + +scientific notation: + set exp (0, mantissa); + result CAT non zero (text (mantissa, 8, 6)); + + IF exp < 0 + THEN result CAT "E-" + ELSE result CAT "E+" FI; + + IF abs (exp) > 9 + THEN result CAT text (abs (exp)) + ELSE result CAT "0"; + result CAT text (abs (exp)) + FI . + +short positive notation: + result CAT non zero (text (mantissa, 8, 6-exp)); + IF (result SUB LENGTH result) = "." + THEN delete char (result, LENGTH result) FI . + +short negative notation: + result CAT non zero (subtext (text (abs (mantissa), 9, 7), 2)).(* F13/rr *) + +using text: + init (result); + result CAT format number (subformat, number); + result CAT next format; + result . + +subformat: + INT VAR from :: using pos, to :: last format char; + subtext (using format, from, to) . + +last format char: + FOR using pos FROM using pos+1 UPTO length (using format) + REP IF non format char + THEN LEAVE last format char WITH using pos-1 FI + PER; + using pos := 0; + length (using format) . + +non format char: + IF (using format SUB using pos) = comma + THEN (using format SUB (using pos+1)) <> point + ELSE pos (numberformat chars, using format SUB using pos) = 0 FI . + +END PROC basic text; + +TEXT PROC non zero (TEXT CONST text): + INT VAR i; + FOR i FROM length (text) DOWNTO 2 + REP UNTIL (text SUB i) <> "0" PER; + subtext (text, 1, i) +END PROC non zero; + +TEXT PROC format number (TEXT CONST format, REAL CONST number): + IF no digit char + THEN errorstop (1005, "USING-Format fehlerhaft: " + using format); "" + ELIF exponent found + THEN exponent format + ELSE normal format FI . + +no digit char: + pos (format, numbersign) = 0 AND + pos (format, asterisk) = 0 AND + pos (format, dollarsign) = 0 . + +exponent found: + INT CONST exponent pos := pos (format, caret); + exponent pos > 0 . + +exponent format: + IF leading plus + THEN plus or minus + exponent field (subtext (format, 2), number, exponent pos-1) + ELIF trailing plus + THEN exponent field (format, number, exponent pos) + plus or minus + ELIF trailing minus + THEN exponent field (format, number, exponent pos) + nil or minus + ELSE blank or minus + exponent field (subtext (format, 2), number, exponent pos-1) FI . + +normal format: + IF leading numbersign + THEN number field (format, number, "", " ") + ELIF leading point + THEN number field (format, number, "", " ") + ELIF leading plus + THEN number field (format, abs (number), plus or minus, " ") + ELIF leading asterisk dollar + THEN number field (format, number, "$", "*") + ELIF leading asterisk + THEN number field (format, number, "", "*") + ELIF leading dollarsign + THEN number field (format, number, "$", " ") + ELSE errorstop (1005, "USING-Format fehlerhaft: " + using format); "" FI . + +leading numbersign: (format SUB 1) = numbersign . +leading point: (format SUB 1) = point . +leading plus: (format SUB 1) = plus . +leading asterisk dollar: subtext (format, 1, 3) = asterisk dollar . +leading asterisk: subtext (format, 1, 2) = asterisk . +leading dollarsign: subtext (format, 1, 2) = dollarsign . + +trailing minus: (format SUB LENGTH format) = minus . +trailing plus: (format SUB LENGTH format) = plus . + +plus or minus: IF number < 0.0 THEN minus ELSE plus FI . +nil or minus: IF number < 0.0 THEN minus ELSE nil FI . +blank or minus: IF number < 0.0 THEN minus ELSE blank FI . + +END PROC format number; + +TEXT PROC exponent field (TEXT CONST format, REAL CONST value, INT CONST exponent pos): + REAL VAR number := abs (value); + INT CONST point pos := pos (format, point); + calc leading and trailing; + INT CONST new exponent :: decimal exponent (value) - leading + 1; + IF abs (new exponent) >= 100 + THEN "%" + mantissa + "E" + null text (new exponent, 4) + ELSE mantissa + exponent + FI. + +calc leading and trailing: + INT VAR leading, trailing; + IF point pos = 0 + THEN leading := exponent pos-1; + trailing := 0 + ELSE leading := point pos-1; + trailing := exponent pos-point pos-1 + FI . + +mantissa: + set exp (leading - 1, number); + IF point pos = 0 + THEN subtext (text (number, leading+1, 0), 1, leading) + ELSE subtext (text (number, leading+trailing+2, trailing), 2) FI . + +exponent: + "E" + null text (new exponent, 3) . + +END PROC exponent field; + +TEXT PROC number field (TEXT CONST format, REAL CONST value, + TEXT CONST pretext, lead char): + INT CONST point pos :: pos (format, point); + calc fraction; + calc digits; + calc commata if necessary; + fill with lead chars and sign . + +calc fraction: + INT VAR fraction :: 0, i; + FOR i FROM point pos+1 UPTO length (format) + WHILE (format SUB i) = numbersign + REP fraction INCR 1 PER . + +calc digits: + TEXT VAR valuetext; + IF point pos = 0 + THEN valuetext := digits (abs (value), 0, TRUE); + delete char (valuetext, length (valuetext)) + ELSE valuetext := digits (abs (value), fraction, point pos <> 1) FI . + +calc commata if necessary: + IF comma before point + THEN insert commata FI . + +comma before point: + point pos > 0 CAND (format SUB point pos-1) = comma . + +insert commata: + i := pos (valuetext, point)-3; + WHILE i > 1 CAND (valuetext SUB i) <> " " + REP insert char (valuetext, ",", i); + i DECR 3 + PER . + +fill with lead chars and sign: + IF trailing minus + THEN fillby (pretext + valuetext, length (format)-1, lead char) + nil or minus + ELIF trailing plus + THEN fillby (pretext + valuetext, length (format)-1, lead char) + plus or minus + ELIF value < 0.0 + THEN fillby (pretext + minus + valuetext, length (format), lead char) + ELSE fillby (pretext + valuetext, length (format), lead char) FI . + + +plus or minus: IF value < 0.0 THEN minus ELSE plus FI . +nil or minus: IF value < 0.0 THEN minus ELSE nil FI . +trailing minus: (format SUB LENGTH format) = minus . +trailing plus: (format SUB LENGTH format) = plus . +END PROC numberfield; + +TEXT PROC null text (INT CONST n, digits): + TEXT VAR l result := text (abs (n), digits); + IF n < 0 + THEN replace (l result, 1, "-") + ELSE replace (l result, 1, "+") FI; + change all (l result, " ", "0"); + l result . +END PROC null text; + +TEXT PROC fillby (TEXT CONST source, INT CONST format, TEXT CONST with): + IF differenz >= 0 + THEN differenz * with + source + ELSE "%" + source FI . + +differenz: format - length (source) . +END PROC fillby; + +TEXT PROC digits (REAL CONST value, INT CONST frac, BOOL CONST null): + IF decimal exponent (value) < 0 + THEN TEXT VAR l result := text (value, frac+2, frac); + + IF null AND first char <> "0" + THEN replace (l result, 1, "0"); + l result + ELIF (NOT null AND first char = "0") OR first char = " " + THEN subtext (l result, 2) + ELSE l result FI + ELSE text (value, decimal exponent (value)+frac+2, frac) FI . + +first char: + (l result SUB 1) . + +END PROC digits; + +TEXT PROC right (TEXT CONST msg, INT CONST len): + IF length (msg) >= len + THEN subtext (msg, 1, len) + ELSE (len - length (msg)) * " " + msg FI + +END PROC right; + +END PACKET basic using; + +PACKET basic output (* Autor: R. Ruland *) + (* Stand: 28.08.1987/rr/mo *) + DEFINES basic page, + width, + init output, + basic out, + basic write, + tab, + next zone, + next line, + next page, + cursor x pos, + pos, + csrlin, + l pos, + switch to printout file, + switch back to old sysout state: + +LET zone width = 16; (* sd.ddddddEsdddb (s = sign, d = digit, b = blank) *) +LET printfile name = "BASIC LPRINT OUTPUT"; + +INT VAR screen width, x cursor, y cursor, line no; +BOOL VAR paging := FALSE, first time, + in lprint; (* mo *) +TEXT VAR buffer, output line, last sysout file, old sysout, char; + +PROC basic page (BOOL CONST status): + + paging := status + +END PROC basic page; + +BOOL PROC basic page: paging END PROC basic page; + + +PROC width (INT CONST max): + + IF max < 0 + THEN errorstop (1005, "WIDTH: negatives Angabe: " + text (max)) + ELIF max = 0 + THEN screen width := 1 + ELSE screen width := max + FI; + last sysout file := ""; + +END PROC width; + +INT PROC width : screen width END PROC width; + + +PROC init output: + + clear using; + width (max (1, x size)); + line no := 1; + output line := ""; + first time := TRUE; + in lprint := FALSE + +END PROC init output; + + +PROC basic out (INT CONST i): bas out (basic text (i) + " ") END PROC basic out; + +PROC basic out (REAL CONST r): bas out (basic text (r) + " ") END PROC basic out; + +PROC basic out (TEXT CONST t): bas out (basic text (t)) END PROC basic out; + +PROC basic write (INT CONST i): bas out (basic text (i)) END PROC basic write; + +PROC basic write (REAL CONST r): bas out (basic text (r)) END PROC basic write; + +PROC basic write (TEXT CONST t): bas out (basic text ("""" + t + """")) END PROC basic write; + + +PROC bas out (TEXT CONST msg): + + get cursor; + IF length (msg) > free + THEN IF first time + THEN first time := FALSE; + next line; + bas out (msg); + ELSE buffer := subtext (msg, 1, free); + IF sysout = "" + THEN out (buffer) + ELSE sysout write (buffer) + FI; + next line; + buffer := subtext (msg, free + 1); + bas out (buffer); + FI; + ELSE first time := TRUE; + IF sysout = "" + THEN out (msg) + ELSE sysout write (msg) + FI; + FI; + + . free : screen width - x cursor + 1 + +END PROC bas out; + + +PROC tab (INT CONST n): + + get cursor; + IF n <= 0 + THEN tab position out of range + ELIF n > screen width + THEN tab (n MOD screen width); + ELIF x cursor > n + THEN next line; + tab (n); + ELIF sysout = "" + THEN cursor (n, y cursor); + ELSE buffer := (n - x cursor) * " "; + sysout write (buffer) + FI; + + . tab position out of range : + IF x cursor <> 1 THEN next line FI; + write ("WARNUNG : TAB-Position <= 0"); + next line; + +END PROC tab; + + +PROC next zone: + + get cursor; + IF x cursor > screen width - zone width + THEN next line; + ELIF sysout = "" + THEN free TIMESOUT " "; + ELSE buffer := free * " "; + sysout write (buffer) + FI; + + . free : ((x cursor - 1) DIV zone width + 1) * zone width - x cursor + 1 + +END PROC next zone; + + +PROC next line : + + IF sysout = "" + THEN next line on screen + ELSE line; + write (""); (* generates new record *) + output line := ""; + FI; + + . next line on screen: + line no INCR 1; + IF paging CAND line no > y size + THEN IF in last line + THEN warte; + ELSE out (""13""10""); + line no := y cursor + 1; + FI; + ELIF NOT paging + THEN char := incharety; + IF char <> "" + THEN IF char = "+" + THEN paging := TRUE + ELSE type (char) + FI + FI; + out (""13""10"") + ELSE out (""13""10"") + FI + + . in last line : + get cursor; + y cursor = y size + + . warte : + cursor (x size - 2, y size); + out (">>"); + inchar (char); + IF char = ""13"" + THEN next page + ELIF char = ""10"" + THEN out (""8""8" "13""10"") + ELIF char = ""27"" + THEN clear editor buffer; + errorstop (1, "") + ELIF char = "-" + THEN out (""8""8" "13""10""); + line no := 1; + paging := FALSE; + ELSE out (""8""8" "13""10""); + line no := 1; + FI; + + . clear editor buffer: + REP UNTIL get charety = "" PER; + +END PROC next line; + + +PROC next page: + + IF sysout = "" + THEN out (""1""4"") + ELSE line + FI; + clear using; + line no := 1; + output line := ""; + +END PROC next page; + + +INT PROC pos (REAL CONST dummy): (* mo *) + + cursor x pos + +END PROC pos; + + +INT PROC pos (INT CONST dummy): (* mo *) + + cursor x pos + +END PROC pos; + + +INT PROC cursor x pos : + + get cursor; + x cursor + +END PROC cursor x pos; + + +INT PROC csrlin: (* mo *) + + get cursor; + y cursor + +END PROC csrlin; + + +PROC get cursor : + + IF sysout = "" + THEN get cursor (x cursor, y cursor); + ELSE x cursor := LENGTH output line + 1; + FI; + +END PROC get cursor; + + +INT PROC l pos (REAL CONST dummy): (* mo *) + + l pos (0) + +END PROC l pos; + + +INT PROC l pos (INT CONST dummy): (* mo *) + + INT VAR lprint position :: 1; + IF exists (printfile name) + THEN disable stop; + FILE VAR printfile :: sequential file (modify, printfile name); + IF lines (printfile) > 0 + THEN to line (printfile, lines (printfile)); + lprint position := len (printfile) + 1 + FI; + output (printfile) + FI; + lprint position + +END PROC l pos; + + +PROC switch to printout file: (* mo *) + + in lprint := TRUE; + old sysout := sysout; + careful sysout (printfile name); + +END PROC switch to printout file; + + +PROC switch back to old sysout state: (* mo *) + + IF in lprint + THEN careful sysout (old sysout); + in lprint := FALSE + FI + +END PROC switch back to old sysout state; + + +PROC sysout write (TEXT CONST string): + check sysout; + write (string); + output line CAT string. + +check sysout: + IF sysout <> last sysout file + THEN careful sysout (sysout) + FI. + +END PROC sysout write; + + +PROC careful sysout (TEXT CONST new sysout): (* mo *) + +IF new sysout <> "" + THEN disable stop; + FILE VAR outfile :: sequential file (modify, new sysout); + max line length (outfile, screen width); + last sysout file := sysout; + IF lines (outfile) > 0 + THEN to line (outfile, lines (outfile)); + read record (outfile, output line); + delete record (outfile) + ELSE output line := "" + FI; + sysout (new sysout); + write (output line); + ELSE sysout ("") +FI + +END PROC careful sysout; + +END PACKET basic output; + + +PACKET basic input (* Autor: R. Ruland *) + (* Stand: 27.10.1987/rr/mo *) + + DEFINES init input, + read input, + check input, + assign input, + assign input line, + input ok, + input eof: + + +LET comma = ",", + quote = """", + + wrong type = 1, + insufficient data = 2, + too much data = 3, + overflow = 4, + + int overflow = 4, + real overflow = 6; + +INT VAR input line pos, input error no; +BOOL VAR on terminal; +TEXT VAR input line :: "", previous input line := "", input value; + +. first quote found : (input value SUB 1) = quote +.; + +PROC init input : + + input error no := 0; + input line pos := 0; + input line := ""; + previous input line := ""; + +END PROC init input; + + +PROC read input (BOOL CONST cr lf, TEXT CONST msg, BOOL CONST question mark): + + on terminal := sysout <> "" AND sysin = ""; + check input error; + out string (msg); + IF question mark THEN out string ("? ") FI; + IF sysin <> "" + THEN getline (input line); + ELSE editget input line; + FI; + out string (input line); + IF crlf THEN out line FI; + input line pos := 0; + input error no := 0; + + . check input error : + IF input error no = 0 + THEN input line := ""; + ELSE IF sysin = "" + THEN BOOL CONST old basic page := basic page; + basic page (FALSE); + IF cursor x pos <> 1 THEN next line FI; + basic out ("?Eingabe wiederholen ! (" + error text + ")"); + next line; + basic page (old basic page); + ELSE errorstop (1080,"INPUT-Fehler (" + error text + + ") : >" + input line + "<"); + FI; + FI; + + . error text : + SELECT input error no OF + CASE wrong type : "falscher Typ" + CASE insufficient data : "zu wenig Daten" + CASE too much data : "zu viele Daten" + CASE overflow : "Überlauf" + OTHERWISE : "" + END SELECT + + . editget input line : + TEXT VAR exit char; + INT VAR x, y; + get cursor (x, y); + REP IF width - x < 1 + THEN out (""13""10""); + get cursor (x, y) + FI; + editget (input line, max text length, width - x, "", "k", exit char); + cursor (x, y); + IF exit char = ""27"k" + THEN input line := previous input line; + ELSE previous input line := input line; + LEAVE editget input line; + FI; + PER; + +END PROC read input; + + +PROC out string (TEXT CONST string) : + + basic out (string); + IF on terminal THEN out (string) FI; + +END PROC out string; + + +PROC out line : + + next line; + IF on terminal THEN out (""13""10"") FI; + +END PROC out line; + + +BOOL PROC check input (INT CONST type) : + + get next input value; + input value := compress (input value); + set conversion (TRUE); + SELECT type OF + CASE 1 : check int input + CASE 2 : check real input + CASE 3 : check text input + END SELECT; + IF NOT last conversion ok THEN input error no := wrong type FI; + input error no = 0 + + . check int input : + IF input value <> "" + THEN disable stop; + INT VAR help int value; + help int value := int (input value); + IF is error CAND error code = int overflow + THEN clear error; + input error no := overflow; + FI; + enable stop; + FI; + + . check real input : + IF input value <> "" + THEN disable stop; + REAL VAR help real value; + help real value := val (input value); + IF is error CAND (error code = real overflow + OR error code = int overflow) (* <-- Aufgrund eines Fehlers in 'real' *) + THEN clear error; + input error no := overflow; + FI; + enable stop; + FI; + + . check text input : + (* IF input value = "" THEN input error no := wrong type FI; *) + IF NOT is quoted string CAND quote found + THEN input error no := wrong type + FI; + + . is quoted string : + first quote found CAND last quote found + + . last quote found : + (input value SUB LENGTH input value) = quote + + . quote found : + pos (input value, quote) > 0 + +END PROC check input; + + +PROC assign input (INT VAR int value) : + + get next input value; + int value := int (input value); + +END PROC assign input; + +PROC assign input (REAL VAR real value) : + + get next input value; + real value := val (input value); + +END PROC assign input; + +PROC assign input (TEXT VAR string value) : + + get next input value; + input value := compress (input value); + IF first quote found + THEN string value := subtext (input value, 2, LENGTH input value -1) + ELSE string value := input value + FI; + +END PROC assign input; + +PROC assign input line (TEXT VAR string line) : + + string line := input line; + +END PROC assign input line; + + +PROC get next input value : (* F27/rr *) + + IF input line pos > LENGTH input line + THEN input value := ""; + input error no := insufficient data; + ELSE IF next non blank char = quote + THEN get quoted string + ELSE get unquoted string + FI; + FI; + + . next non blank char : + INT CONST next non blank char pos := pos (input line, ""33"", ""255"", input line pos + 1); + input line SUB next non blank char pos + + . get quoted string : + INT CONST quote pos := pos (input line, quote, next non blank char pos + 1); + IF quote pos = 0 + THEN input value := subtext (input line, next non blank char pos); + input line pos := LENGTH input line + 1; + input error no := wrong type; + ELSE input value := subtext (input line, next non blank char pos, quote pos); + input line pos := pos (input line, ""33"", ""255"", quote pos + 1); + IF input line pos = 0 + THEN input line pos := LENGTH input line + 1; + ELIF (input line SUB input line pos) <> comma + THEN input error no := wrong type; + input line pos DECR 1; + FI; + FI; + + . get unquoted string : + INT VAR comma pos := pos (input line, comma, input line pos + 1); + IF comma pos = 0 + THEN input value := subtext (input line, input line pos + 1); + input line pos := LENGTH input line + 1; + ELSE input value := subtext (input line, input line pos + 1, comma pos - 1); + input line pos := comma pos; + FI; + +END PROC get next input value; + + +BOOL PROC input ok: + + IF input line pos <= LENGTH input line + THEN input error no := too much data FI; + input line pos := 0; + input error no = 0 + +END PROC input ok; + +BOOL PROC input eof: input line = "" END PROC input eof; + + +END PACKET basic input; + +PACKET basic std using io (* Autor: R. Ruland *) + (* Stand: 26.10.87/rr/mo *) + + DEFINES init rnd: + + +PROC init rnd: + + REAL VAR init; + REP read input (TRUE, "Startwert des Zufallszahlengenerators ? ", FALSE); + UNTIL check input (2) CAND input ok PER; (* F24/rr *) + assign input (init); + init rnd (init); + +END PROC init rnd; + + +END PACKET basic std using io; + diff --git a/lang/basic/1.8.7/src/eumel coder 1.8.1 b/lang/basic/1.8.7/src/eumel coder 1.8.1 new file mode 120000 index 0000000..5fead18 --- /dev/null +++ b/lang/basic/1.8.7/src/eumel coder 1.8.1 @@ -0,0 +1 @@ +../../../../system/eumel-coder/1.8.1/src/eumel coder 1.8.1
\ No newline at end of file diff --git a/lang/basic/1.8.7/src/eumel0 codes b/lang/basic/1.8.7/src/eumel0 codes Binary files differnew file mode 100644 index 0000000..226014c --- /dev/null +++ b/lang/basic/1.8.7/src/eumel0 codes diff --git a/lang/basic/1.8.7/src/gen.BASIC b/lang/basic/1.8.7/src/gen.BASIC new file mode 100644 index 0000000..9690ae6 --- /dev/null +++ b/lang/basic/1.8.7/src/gen.BASIC @@ -0,0 +1,80 @@ +(**************************************************************************) +(* *) +(* Generatorprogramm zur Installation des EUMEL-BASIC-Systems *) +(* *) +(* Autor: Heiko Indenbirken *) +(* Überarbeitet von: Michael Overdick *) +(* *) +(* Stand: 27.08.1987 *) +(* *) +(**************************************************************************) + +LET coder name = "eumel coder 1.8.1"; + +show headline; +from archive ("BASIC.1", (coder name & "eumel0 codes") - all); +from archive ("BASIC.2", + ("BASIC.Runtime" & "BASIC.Administration" & "BASIC.Compiler") - all); +set status; +insert ("eumel coder 1.8.1"); +insert ("BASIC.Runtime"); +insert ("BASIC.Administration"); +insert ("BASIC.Compiler"); +forget (coder name & "BASIC.Runtime" + & "BASIC.Administration" & "BASIC.Compiler" & "gen.BASIC"); +restore status; +show end . + +show headline: + page; + putline (" "15"Einrichten des EUMEL-BASIC-Systems "14""); + line . + +set status: + BOOL VAR old check := check, + old warnings := warnings, + old command dialogue := command dialogue; + check off; + warnings off; + command dialogue (FALSE). + +restore status: + IF old check THEN do ("check on") ELSE do ("check off") FI; + IF old warnings THEN warnings on FI; + command dialogue (old command dialogue). + +show end: + line (2); + putline (" "15"BASIC-System installiert "14""); + line . + +PROC from archive (TEXT CONST name, THESAURUS CONST files): + IF highest entry (files) > 0 + THEN ask for archive; + archive (name); + fetch (files, archive); + release (archive); + putline ("Archiv abgemeldet !") + FI . + +ask for archive: + line; + IF no ("Archiv """ + name + """ eingelegt") + THEN errorstop ("Archive nicht bereit") FI . + +END PROC from archive; + +THESAURUS OP & (TEXT CONST left, right): + THESAURUS VAR result := empty thesaurus; + insert (result, left); + insert (result, right); + result +END OP &; + +THESAURUS OP & (THESAURUS CONST left, TEXT CONST right): + THESAURUS VAR result := left; + insert (result, right); + result +END OP &; + + |