diff options
| author | Lars-Dominik Braun <lars@6xq.net> | 2019-03-02 14:17:13 +0100 |
|---|---|---|
| committer | Lars-Dominik Braun <lars@6xq.net> | 2019-03-02 14:17:13 +0100 |
| commit | 50acf53648b6562853cb26aa4e7062a5ced66908 (patch) | |
| tree | 570243dba5597bdbe8d08ff931d53f006dfd62a3 /devel/debugger/1.8.2 | |
| parent | 98cab31fc3659e33aef260efca55bf9f1753164c (diff) | |
| download | eumel-src-50acf53648b6562853cb26aa4e7062a5ced66908.tar.gz eumel-src-50acf53648b6562853cb26aa4e7062a5ced66908.tar.bz2 eumel-src-50acf53648b6562853cb26aa4e7062a5ced66908.zip | |
Move debugger sources to version subdirectory
Diffstat (limited to 'devel/debugger/1.8.2')
| -rw-r--r-- | devel/debugger/1.8.2/doc/DEBUGGER.PRT | 2021 | ||||
| -rw-r--r-- | devel/debugger/1.8.2/src/DEBUGGER.ELA | 3151 |
2 files changed, 5172 insertions, 0 deletions
diff --git a/devel/debugger/1.8.2/doc/DEBUGGER.PRT b/devel/debugger/1.8.2/doc/DEBUGGER.PRT new file mode 100644 index 0000000..4379f4a --- /dev/null +++ b/devel/debugger/1.8.2/doc/DEBUGGER.PRT @@ -0,0 +1,2021 @@ +***************************************************************************
+*** ***
+*** D o k u m e n t a t i o n ***
+*** zum EUMEL-Debugger ***
+*** ***
+*** Autor: Michael Staubermann ***
+*** Stand der Dokumentation: 03.12.86 ***
+*** Stand des Debuggers: 01.12.86 ***
+*** ***
+***************************************************************************
+
+1. Anwendung des Debuggers
+1.1 Code Disassembler (Decoder)
+1.1.1 Datenrepr„sentation
+1.1.2 Datenadressen
+1.1.3 Codeadressen
+
+1.2 Ablaufverfolgung (Tracer)
+
+2. Die EUMEL0-Instruktionen
+2.1 Erl„uterung der Instruktionen (Thematisch sortiert)
+2.2 Alphabetische Liste der Instruktionen
+
+3. Beschreibung der Pakete
+3.1 PACKET address
+3.2 PACKET table routines
+3.3 PACKET eumel decoder
+3.4 PACKET tracer
+
+#page#
+#ub#1. Anwendung des Debuggers#ue#
+
+Der EUMEL-Debugger ist fr die Software-Entwickler und nicht fr die
+Anwender dieser Software gedacht. Insbesondere bei der Entwicklung
+systemnaher Software, wie z.B. Compiler, ist der Debugger hilfreich.
+
+(ELAN-)Programme werden wie bisher compiliert (z.B. insertiert), ohne daá
+der Quelltext des Programmes vorher modifiziert werden máte. Um den
+Sourcetext w„hrend der Ablaufverfolgung (Trace) beobachten zu k”nnen,
+máen die Programme mit 'check on' bersetzt werden.
+
+Die sinnvolle Anwendung des Debuggers setzt allerdings Kenntnis der
+EUMEL0-Instruktionen voraus, die im Kapitel 2 erl„utert werden (Der Debugger
+setzt die Codierung BIT-A fr diese Instruktionen voraus, d.h. er l„uft
+zumindest in der interpretativen EUMEL0-Version.).
+
+
+#ub#1.1 Code Disassembler (Decoder)#ue#
+
+Der Decoder konvertiert die vom Compiler erzeugte Bitcodierung (16 Bit) in
+Mnemonics (Textdarstellung der Instruktionen), die in eine FILE geschrieben,
+bzw. optional auf dem Bildschirm ausgegeben werden k”nnen. Die Bitcodierung
+kann zus„tzlich ausgegeben werden.
+Der Decoder wird mit 'decode' aufgerufen. W„hrend der Dekodierung stehen
+folgende Tastenfunktionen zur Verfgung:
+
+Taste Funktion
+-----------------------------------------------------------------------
+ ESC Abbruch der Dekodierung.
+ e Echo. Schaltet die parallel Bildschirmausgabe ein/aus.
+ l Zeilennummern statt Hexadezimaladressen mitprotokollieren.
+ a Hexadezimaladressen statt Zeilennummern mitprotokollieren.
+ f Zeigt den Namen und die aktuelle Zeilennummer der Protokollfile.
+ d getcommand ; docommand
+ s storage info
+ m Zeigt die aktuelle Modulnummer an (sinnvoll falls kein Echo)
+ Q,W Zeilennummern/Hexadressen mitprotokollieren (falls kein Echo)
+ S Keine Zeilennummern/Hexadressen ausgeben (l„uft auch im Hintergrund)
+
+
+#ub#1.1.1 Datenrepr„sentation#ue#
+
+INT-Zahlen werden hexadezimal (xxxxH, xxH) oder dezimal dargestellt,
+TEXTe in Anfhrungszeichen ("..."),
+REALs im 20-Stellen scientific-Format,
+TASK-Objekte durch XX-YYYY/"name" mit XX als Taskindex und YYYY als Version,
+ wenn die Stationsnummer nicht 0 ist, wird sie vor XX als SS- dargestellt.
+DATASPACE-Objekte werden durch XX-YY repr„sentiert (XX ist der eigene
+ Taskindex, YY ist die Datenraumnummer),
+BOOL-Objekte durch TRUE oder FALSE.
+Module werden durch ihre Modulnummer, optional auch durch ihre
+ Startadresse, und falls m”glich durch ihren Namen repr„sentiert. Die
+ Parameterliste wird in den F„llen, wo das Modul in der Permanenttabelle
+ vermerkt ist auch angegeben.
+Nicht weiter dereferenzierbare Adressen werden durch ein vorgestelltes '@'
+gekennzeichnet (z.B. BOUND-Objekte).
+In den F„llen, wo es mehrere sinnvolle Darstellungen gibt, werden diese
+durch ein '|' getrennt.
+
+
+#ub#1.1.2 Datenadressen#ue#
+
+Zus„tzlich zu den globalen Daten (statische Variablen und Denoter) kann auch
+deren Adresse ausgegeben werden. Die Daten werden in einer, ihrem Typ
+entsprechenden, Darstellung ausgegeben. Komplexe oder zusammengesetzte
+Datentypen werden auf Repr„sentationen elementarer Datentypen (INT, REAL,
+BOOL, TEXT, DATASPACE, TASK) abgebildet.
+
+Prozeduren, Operatoren und Paketinitialisierungen von Main-Packets werden
+zusammenfassend als Module bezeichnet. Einem Modul geh”rt ein eigener
+Stackbereich fr lokale Daten, Parameter und Rcksprungadresse etc. In
+diesem Bereich stehen entweder die Datenobjekte selbst (z.B. lokale
+Variablen) oder lokale Referenzadressen auf beliebige Objekte (lokale,
+globale Daten, Fremddatenr„ume und sogar Module).
+Da die effektiven lokalen Adressen erst w„hrend der Runtime bekannt sind,
+findet man im Decoder-Output nur die Adressoffsets relativ zum Stackanfang
+des Moduls.
+
+Datenadressen werden in spitzen Klammern angegeben, Branch-Codeaddressen ohne
+Klammern. Alle Adressen sind Wortaddressen. Der Adresstyp wird durch einen
+Buchstaben nach '<' angezeigt:
+'G' kennzeichnet eine globale Adresse (Denoter oder statische Variable). Die
+Representation der Daten kann immer angegeben werden (also nicht nur zur
+Runtime).
+'L' kennzeichnet einen Adressoffset fr ein lokales Datenobjekt auf dem
+Stack. Da die lokale Basis, d.h. die Anfangsadresse der Daten des aktuellen
+Moduls, erst bei Runtime feststehen, kann hier weder die effektive
+Datenadresse, noch der Inhalt des Datenobjekts angegeben werden.
+'LR' kennzeichnet eine lokale Referenzadresse, d.h. auf dem Stack steht
+eine Adresse (32 Bit), die ein Datenobjekt adressiert. Žhnlich wie bei 'L'
+kann auch bei 'LR' erst zur Runtime eine Representation des adressierten
+Datenobjekts angegeben werden. Der Wert nach 'LR' bezeichnet den Offset, der
+zur lokalen Basis addiert werden muá, um die Adresse der Referenzadresse zu
+erhalten. Die niederwertigsten 16 Bit (das erste der beiden W”rter) k”nnen
+128KB adressieren. Im h”herwertigsten Byte des zweiten Wortes steht die
+Nummer des Datenraumes der eigenen Task, der das adressierte Datenobjekt
+enth„lt (0 entspricht dem Standarddatenraum). Das niederwertigste Byte des
+zweiten Wortes enth„lt die Segmentnummer (128KB-Segmente) mit dem
+Wertebereich 0 bis 7 (maximal also 1MB/Datenraum). Im Standarddatenraum
+(Datenraumnummer 4) enthalten die Segmente folgene Tabellen:
+
+Segment Tabelle
+-------------------------------------------------
+ 0 Paketdaten (high 120KB) und Moduladresstabelle
+ 1 Stack (low 64K), Heap (high 64K)
+ 2 Codesegment
+ 3 Codesegment (120KB) u.a. fr eigene Module
+ 4 Compilertabellen tempor„r
+ 5 Compilertabellen permanent
+ 6 nilsegment fr Compiler (FF's)
+ 7 Compiler: Intermediate String
+
+Repr„sentationen von Datenobjekten, die in Fremddatenr„umen residieren
+(BOUND-Objekte) k”nnen zur Zeit noch nicht ausgegeben werden, statt dessen
+wird die Datenraumnummer und die Wortadresse innerhalb dieses Datenraums
+ausgegeben.
+
+
+#ub#1.1.3 Codeadressen#ue#
+
+Module werden in der Regel (Ausnahme: Parameterprozeduren) ber ihre
+Modulnummer angesprochen, aus der dann die Adresse des Moduls berechnet
+werden kann (mithilfe der Moduladresstabelle). Die Adressen der
+Parameterprozeduren sind vom Typ 'LR' (Local-Reference), kommen nur als
+Parameter auf dem Stack vor und beeinhalten Codesegment und Codeadresse.
+
+Sprungadressen (von Branch-Befehlen) adressieren immer nur das eigene
+Segment und davon auch nur eine Adresse innerhalb eines 8 KB groáen
+Bereichs.
+
+
+#ub#1.2 Ablaufverfolgung (Tracer)#ue#
+
+Um den eigenen (!) Code im Einzelschrittbetrieb abzuarbeiten, wird der
+Tracer benutzt. Auáer den Inhalten der globalen Daten kann man sich die
+Inhalte der Stackobjekte (lokale Variablen) und der aktuellen Parameter
+eines Prozeduraufrufs (auch von Parameterprozeduren) ansehen. Es k”nnen
+keine Daten ver„ndert werden!
+Man hat die M”glichkeit
+- die Resultate der letzten ausgefhrten Instruktion oder
+- die aktuellen Parameter fr den n„chsten Instruktionsaufruf
+zu beobachten.
+Der Inhalt des Stacks kann sequentiell durchgesehen werden, Error- und
+Disablestop-Zustand k”nnen gel”scht werden.
+Der Einzelschrittablauf kann protokolliert und die entsprechende
+Sourceline parallel zum ausgefhrten Code beobachtet werden.
+Der Einzelschrittbetrieb kann, ber Teile des Codes hinweg, ausgeschaltet
+werden, z.B. fr h„ufig durchlaufene Schleifen.
+Fr die Repr„sentation der Daten und deren Adressen gilt das unter 1.1
+gesagte.
+Der Tracer wird mit 'trace' aufgerufen. W„hrend der Aktivit„t des Tracers
+stehen folgende Funktionen zur Verfgung (Nur der erste Buchstabe wird
+getippt):
+
+Abkrzung Funktion
+--------------------------------------------------------------------------
+ Auto Die Befehle werden im Einzelschrittbetrieb ausgefhrt, ohne daá
+ eine Taste gedrckt werden muá.
+ Bpnt Der n„chste Breakpoint wird an eine vom Benutzer festgelegte
+ Codeadrese gesetzt. Damit k”nnen Teile des Codes abgearbeitet
+ werden, ohne daá der Einzelschrittmodus aktiv ist. Nach der
+ Eingabe der Adresse wird der Befehl an dieser Adresse angezeigt.
+ Best„tigt wird die Richtigkeit mit <RETURN> oder 's'.
+ Clrr Ein eventuell vorliegender Fehlerzustand wird gel”scht.
+ Dstp 'disable stop' wird fr das untersuchte Modul gesetzt.
+ Estp 'enable stop' wird fr das untersuchte Modul gesetzt.
+ File Der Name der kompilierten Quelldatei wird eingestellt.
+ Go Der Code wird bis zum Ende abgearbeitet, ohne daá der Tracer
+ aktiviert wird.
+ Prot Der Name der Protokollfile wird eingestellt. Die abgearbeiteten
+ Instruktionen werden in dieser File protokolliert.
+ Rslt Es wird umgeschaltet, ob die angezeigte Instruktion nach <RETURN>
+ oder 's' abgearbeitet werden soll (Forward-Trace, 'F') oder ob das
+ Ergebnis der letzten ausgefhrten Instruktion angezeigt werden soll
+ (Result-Trace, 'R'). Der aktuelle Zustand dieses Switches wird in
+ der ersten Bildschirmzeile durch 'R' oder 'F' gekennzeichnet.
+ Kurzzeitige Umschaltung, um das Ergebnis der letzten Operation
+ anzusehen, ist auch m”glich (zweimal 'r' tippen).
+ Step/CR Mit <RETURN> oder 's' wird die n„chste Instruktion ausgefhrt.
+ Dies ist bei Forward-Trace die angezeigte Instruktion.
+ Term Bis zur n„chst 'h”heren' Prozedur der CALL-Sequence, die im
+ 'disable stop'-Zustand arbeitet, werden die Module verlassen. In
+ der Regel bedeutet dies ein Programmabbruch. Alle Breakpoints sind
+ anschlieáend zurckgesetzt.
+ - Der Stackpointer auf den sichtbaren Stack (in der ersten
+ Bildschirmzeile) wird um zwei verringert. Er zeigt auf die n„chst
+ tiefere Referenzadresse. Der EUMEL-0-Stackpointer wird nicht
+ ver„ndert.
+ + Der Stackpointer auf den sichtbaren Stack wird um zwei erh”ht.
+ < Bei der Befehlsausgabe werden die Parameteradressen zus„tzlich
+ ausgegeben (in spitzen Klammern).
+ > Bei der Befehlsausgabe werden keine Parameteradressen ausgegeben,
+ sondern nur die Darstellungen der Parameter (z.B.
+ Variableninhalte)
+
+#page#
+#ub#2. EUMEL0-Instruktionen#ue#
+
+
+#ub#2.1 Erl„uterung der Instruktionen (Thematisch sortiert)#ue#
+
+Nach der H„ufigkeit ihres Vorkommens im Code unterscheidet man 3 Klassen von
+Instruktionen: 30 Prim„rbefehle, 6 Spezialbefehle und z.Zt. 127
+Sekund„rbefehle.
+Die Prim„rbefehle enthalten im ersten Wort den Opcode (5 Bit) und 11 Bit fr
+die erste Parameteradresse d.h. den Wertebereich 0..2047. Liegt die
+Parameteradresse auáerhalb dieses Bereichs, dann ersetzt ein
+Umschaltprefix (LONGAddress) die Opcodebits und im lowbyte des
+ersten Wortes wird der Opcode codiert. Die erste Parameteradresse befindet
+sich dann als 16 Bit-Wert im zweiten Wort.
+Spezialbefehle enthalten im ersten Wort auáer dem Opcode (8 Bit) noch einen
+8 Bit-Immediatewert (Bytekonstante).
+Sekund„rebefehle enthalten im ersten Wort nur den Opcode (16 Bit), der aus
+einem Umschaltprefix (ESCape, wird im folgenden weggelassen) und im lowbyte
+dem 8 Bit Sekndaropcode besteht.
+
+Im folgenden werden Datenadressen mit 'd', Immediatewerte mit 'v' (Value),
+Codeadressen mit 'a' und Modulnummern mit 'm' bezeichnet. Die Anzahl dieser
+Buchstaben gibt die L„nge der ben”tigten Opcodebits (DIV 4) an. Ausnahmsweise
+bezeichnet .nn:dd einen 5 Bit Opcode ('nn') und eine 11 Bit Adresse ('dd').
+
+Der Adresstyp ist in den Bits 14 und 15 codiert:
+15 14 Typ Effektive Adresse
+ 0 0 global dddd + pbase (pbase wird mit PENTER eingestellt)
+ 1 0 local (dddd AND 7FFF) DIV 2 + lbase (lbase wird beim CALL gesetzt)
+ 1 1 local ref adr := ((dddd AND 7FFF) DIV 2 + lbase) ; (adr+1, adr)
+
+Der Wert eines Wortes an der ersten Parameteradresse wird mit <d1>
+bezeichnet. Ein Datentyp vor der spitzen Klammer gibt seinen Typ an. Fr die
+anderen Parameter gilt entsprechendes (<d2>, <d3>, ...).
+
+
+#ub#2.1.1 Datentransportbefehle#ue#
+
+MOV .08:dd dddd 1 Wort (z.B. INT/BOOL) wird von der linken
+ Adresse zur rechten Adresse transportiert.
+ <d2> := <d1>
+
+FMOV .34:dd dddd 4 W”rter (z.B. REAL) von linker Adresse zur
+ rechten Adresse tranportieren (kopiert).
+ <d2> := <d1>
+
+TMOV .4C:dd dddd Kopiert einen Text von der linken Adresse zur
+ rechten Adresse.
+ TEXT<d2> := TEXT<d1>
+
+MOVi FC vv dddd Die Konstante vv (1 Byte) wird als positive
+ 16 Bit-Zahl dem Wort an der Adresse dddd
+ zugewiesen.
+ <d1> := vv
+
+MOVii 7F 23 vvvv dddd Dem Wort an der Adresse dddd wird die 16-Bit
+ Konstante vvvv zugewiesen.
+ <d1> := vvvv
+
+MOVx 7D vv dddd dddd Von der linken Adresse zur rechten Adresse
+ werden vv (max. 255) W”rter transportiert.
+ <d2> := <d1> (vv W”rter)
+
+MOVxx 7F 21 vvvv dddd dddd Von der linken Adresse zur rechten Adresse
+ werden vvvv (max. 65535) W”rter transportiert.
+ <d2> := <d1> (vvvv W”rter)
+
+
+#ub#2.1.2 INT-Operationen#ue#
+
+ARITHS 7F 5B Schaltet um auf vorzeichenbehaftete
+ INT-Arithmetik (Normalfall).
+ ARITH := Signed
+
+ARITHU 7F 5C Schaltet um auf vorzeichenlose 16Bit-Arithmetik
+ (Compiler).
+ ARITH := Unsigned
+
+CLEAR .24:dd Dem Wort an der Adresse dd wird 0 zugewiesen.
+ <d1> := 0
+
+INC1 .0C:dd Der Inhalt des Wortes an der Adresse dddd wird
+ um eins erh”ht.
+ <d1> := <d1> + 1
+
+DEC1 .10:dd Der Inhalt des Wortes an der Adresse dddd wird
+ um eins verringert.
+ <d1> := <d1> - 1
+
+INC .14:dd dddd Der Inhalt des Wortes an der ersten Adresse wird
+ zum Inhalt des Wortes an der zweiten Adresse
+ addiert.
+ <d2> := <d2> + <d1>
+
+DEC .18:dd dddd Der Inhalt des Wortes an der ersten Adresse wird
+ vom Inhalt des Wortes an der zweiten Adresse
+ subtrahiert.
+ <d2> := <d2> - <d1>
+
+ADD .1C:dd dddd dddd Der Inhalt der Worte der beiden ersten
+ Adressen wird addiert und bei der dritten
+ Adresse abgelegt.
+ <d3> := <d1> + <d2>
+
+SUB .20:dd dddd dddd Der Inhalt des Wortes an der zweiten Adresse
+ wird vom Inhalt des Wortes an der ersten Adresse
+ subtrahiert und das Resultat im Wort an der
+ dritten Adresse abgelegt.
+ <d3> := <d1> - <d2>
+
+MUL 7F 29 dddd dddd dddd Der Wert der W”rter an den beiden ersten
+ Adressen wird vorzeichenbehaftet multipliziert
+ und im Wort an der dritten Adresse abgelegt.
+ Ein šberlauf wird im Falle der vorzeichenlosen
+ Arithmetik ignoriert (<d3> MOD 65536).
+ <d3> := <d1> * <d2>
+
+IMULT 7F 28 dddd dddd dddd Der Wert der W”rter an den beiden ersten
+ Adressen wird vorzeichenlos multipliziert und
+ im Wort an der dritten Adresse abgelegt.
+ Falls das Resultat ein Wert gr”áer 65535 w„re,
+ wird <d3> := FFFFH, sonst
+ <d3> := <d1> * <d2>
+
+DIV 7F 2A dddd dddd dddd Der Wert des Wortes an der ersten Adresse wird
+ durch den Wert des Wortes an der zweiten
+ Adresse dividiert und im Wort an der dritten
+ Adresse abgelegt. Eine Division durch 0 fhrt
+ zum Fehler.
+ <d3> := <d1> DIV <d2>
+
+MOD 7F 2B dddd dddd dddd Der Rest der Division (wie bei DIV) wird im
+ Wort an der dritten Adresse abgelegt. Falls
+ <d2> = 0 ist, wird ein Fehler ausgel”st.
+ <d3> := <d1> MOD <d2>
+
+NEG 7F 27 dddd Der Wert des Wortes an der Adresse dddd wird
+ arithmetisch negiert (Vorzeichenwechsel).
+ <d1> := -<d1>
+
+AND 7F 7C dddd dddd dddd Der Wert der beiden W”rter an den beiden ersten
+ Adressen wird bitweise UND-verknpft und das
+ Resultat im Wort an der dritten Adresse
+ abgelegt.
+ <d3> := <d1> AND <d2>
+
+OR 7F 7D dddd dddd dddd Der Wert der beiden W”rter an den beiden ersten
+ Adressen wird bitweise ODER-verknpft und das
+ Resultat im Wort an der dritten Adresse
+ abgelegt.
+ <d3> := <d1> OR <d2>
+
+XOR 7F 79 dddd dddd dddd Der Wert der beiden W”rter an den beiden ersten
+ Adressen wird bitweise Exklusiv-ODER-verknpft
+ und das Resultat im Wort an der dritten Adresse
+ abgelegt.
+ <d3> := <d1> XOR <d2>
+
+ROTATE 7F 53 dddd dddd Der Wert an der ersten Adresse wird um soviele
+ Bits links oder rechts rotiert, wie es der Wert
+ des zweiten Parameters angibt (positiv =
+ links).
+ IF <d2> < 0
+ THEN <d1> := <d1> ROR <d2>
+ ELSE <d1> := <d1> ROL <d2>
+ FI
+
+
+#ub#2.1.3 REAL-Operationen#ue#
+
+FADD .38:dd dddd dddd Die beiden ersten REAL-Werte werden addiert und
+ das Resultat an der dritten Adresse abgelegt.
+ REAL<d3> := REAL<d1> + REAL<d2>
+
+FSUB .3C:dd dddd dddd Der zweite REAL-Wert wird vom ersten
+ subtrahiert und das Resultat an der dritten
+ Adresse abgelegt.
+ REAL<d3> := REAL<d1> + REAL<d2>
+
+FMUL .40:dd dddd dddd Die beiden ersten REAL-Werte werden
+ multipliziert und das Resultat an der dritten
+ Adresse abgelegt.
+ REAL<d3> := REAL<d1> * REAL<d2>
+
+FDIV .44:dd dddd dddd Der erste REAL-Wert wird durch den zweiten
+ dividiert und das Resultat an der dritten
+ Adresse abgelegt.
+ REAL<d3> := REAL<d1> / REAL<d2>
+
+FNEG 7F 26 dddd Das Vorzeichen des REAL-Wertes an der Adresse
+ dddd wird gewechselt.
+ REAL<d1> := -REAL<d1>
+
+FSLD 7F 60 dddd dddd dddd Die Mantisse des REAL-Wertes an der zweiten
+ Adresse wird um ein Digit (4 Bit BCD) nach
+ links verschoben, Vorzeichen und Exponent
+ bleiben unver„ndert. Das vorher h”herwertigste
+ Digit steht danach im Wort an der dritten
+ Adresse. Das neue niederwertigste Digit wurde
+ aus dem Wort der ersten Adresse entnommen.
+ INT<d3> := digit1<d2> ;
+ REAL<d2> := REAL<d2> SLD 1 ;
+ digit13<d2> := INT<ÿ1>
+
+GEXP 7F 61 dddd dddd Der Exponent des REAL-Wertes an der ersten
+ Adresse wird in das Wort an der zweiten Adresse
+ gebracht.
+ INT<d2> := exp<d1>
+
+SEXP 7F 62 dddd dddd Der Wert des Wortes an der ersten Adresse wird
+ in den Exponenten des REAL-Wertes an der zweiten
+ Adresse gebracht.
+ exp<d2> := INT<d1>
+
+FLOOR 7F 63 dddd dddd Der REAL-Wert an der ersten Adresse wird ohne
+ Dezimalstellen an der zweiten Adresse abgelegt.
+ <d2> := floor<d1>
+
+
+#ub#2.1.4 TEXT-Operationen#ue#
+
+ITSUB 7F 2D dddd dddd dddd Aus dem TEXT an der ersten Adresse wird das
+ Wort, dessen Position durch das Wort an der
+ zweiten Adresse beschrieben wird, im Wort an
+ der dritten Adresse abgelegt.
+ INT<d3> := TEXT<d1>[INT<d2>,2] (Notation:
+ t[n,s] bezeichnet das n. Element mit einer
+ GrӇe von s Bytes, der Bytekette t an der
+ Byteposition n*s+1)
+
+ITRPL 7F 2E dddd dddd dddd In dem TEXT an der ersten Adresse wird das
+ Wort, dessen Position durch das Wort an der
+ zweiten Adresse beschrieben wird, durch das Wort
+ an der dritten Adresse ersetzt.
+ TEXT<d1>[INT<d2>,2] := INT<d3>
+
+DECOD 7F 2F dddd dddd Der dezimale ASCII-Wert des Zeichens im TEXT an
+ der ersten Adresse wird im Wort an der zweiten
+ Adresse abgelegt.
+ INT<d2> := code (TEXT<d1>)
+
+ENCOD 7F 30 dddd dddd Dem der TEXT an der zweiten Adresse wird ein
+ Zeichen zugewiesen, das dem ASCII-Wert im Wort
+ an der ersten Adresse entspricht.
+ TEXT<d2> := code (INT<d1>)
+
+SUBT1 7F 31 dddd dddd dddd Dem TEXT an der dritten Adresse wird das
+ Zeichen des TEXTes an der ersten Adresse
+ zugewiesen, dessen Position durch das Wort an
+ der zweiten Adresse bestimmt ist.
+ TEXT<d3> := TEXT<d1>[INT<d2>, 1]
+
+SUBTFT 7F 32 dddd dddd dddd dddd Dem TEXT an der vierten Adresse wird ein
+ Teiltext des TEXTes an der ersten Adresse
+ zugewiesen, dessen Startposition im Wort an der
+ zweiten Adresse steht und dessen Endposition im
+ Wort an der dritten Adresse steht.
+ TEXT<d3> := subtext (TEXT<d1>, INT<d2>, INT<d3>)
+
+SUBTF 7F 33 dddd dddd dddd Dem TEXT an der dritten Adresse wird ein
+ Teiltext des TEXTes an der ersten Adresse
+ zugewiesen, der an der durch das Wort an der
+ zweiten Adresse beschriebenen Position beginnt
+ und bis zum Ende des Sourcetextes geht.
+ TEXT<d3> := subtext (TEXT<d1>, INT<d2>, length
+ (TEXT<d1>))
+
+REPLAC 7F 34 dddd dddd dddd Der TEXT an der ersten Adresse wird ab der
+ Position, die durch das Wort an der zweiten
+ Position bestimmt wird, durch den TEXT an der
+ dritten Adresse ersetzt.
+ replace (TEXT<d1>, INT<d2>, TEXT<d3>)
+
+CAT 7F 35 dddd dddd Der TEXT an der zweiten Adresse wird an das
+ Ende des TEXTes an der ersten Adresse angefgt.
+ TEXT<d1> := TEXT<d1> + TEXT<d2>
+
+TLEN 7F 36 dddd dddd Die L„nge des TEXTes an der ersten Adresse wird
+ im Wort an der zweiten Adresse abgelegt.
+ INT<d2> := length (TEXT<d1>)
+
+POS 7F 37 dddd dddd dddd Die Position des ersten Auftretens des TEXTes
+ an der zweiten Adresse, innerhalb des TEXTes an
+ der ersten Adresse, wird im Wort an der dritten
+ Adresse abgelegt.
+ INT<d3> := pos (TEXT<d1>, TEXT<d2>, 1, length
+ (TEXT<d1>))
+
+POSF 7F 38 dddd dddd dddd dddd
+ Die Position des ersten Auftretens des TEXTes
+ an der zweiten Adresse, innerhalb des TEXTes an
+ der ersten Adresse, ab der Position die durch
+ den Inhalt des Wortes an der dritten Adresse
+ bestimmt ist, wird im Wort an der vierten
+ Adresse abgelegt.
+ INT<d4> := pos (TEXT<d1>, TEXT<d2>, INT<d3>,
+ length (TEXT<d1>))
+
+POSFT 7F 39 dddd dddd dddd dddd dddd
+ Die Position des ersten Auftretens des TEXTes
+ an der zweiten Adresse, innerhalb des TEXTes an
+ der ersten Adresse, ab der Position die durch
+ den Inhalt des Wortes an der dritten Adresse
+ bestimmt ist, bis zur Position die durch den
+ Inhalt des Wortes an der vierten Adresse
+ bestimmt ist, wird im Wort an der fnften
+ Adresse abgelegt.
+ INT<d5> := pos (TEXT<d1>, TEXT<d2>, INT<d3>,
+ INT<d4>)
+
+STRANL 7F 3A dddd dddd dddd dddd dddd dddd dddd
+ (ROW 256 INT CONST, INT VAR, INT CONST,
+ TEXT CONST, INT VAR, INT CONST, INT VAR):
+ Vereinfachte funktionsweise:
+ extension := FALSE ;
+ FOR INT<d5> FROM INT<d5> UPTO min (INT<d6>,
+ length (TEXT<d4>)) WHILE INT<d2> < INT<d3>
+ REP
+ IF extension
+ THEN extension := FALSE
+ ELSE INT<d7>:=ROW<d1>[TEXT<d4>[INT<d5>,1]];
+ IF INT<d7> < 0
+ THEN extension := TRUE ;
+ INT<d2> INCR (INT<d7>-8000H)
+ ELSE INT<d2> INCR INT<d7>
+ FI
+ FI
+ PER
+
+POSIF 7F 3B dddd dddd dddd dddd dddd
+ Die Position des ersten Auftretens des, durch
+ die beiden Zeichen des TEXTes an der zweiten
+ und dritten Adresse begrenzten ASCII-Bereichs
+ (lowchar, highchar), Zeichens innerhalb des
+ TEXTes an der ersten Adresse, wird ab der
+ Position, die durch das Wort an der vierten
+ Adresse beschrieben wird, im Wort an der
+ fnften Adresse abgelegt.
+ INT<d5> := pos (TEXT<d1>, TEXT<d2>, TEXT<d3>,
+ INT<d4>).
+
+GARB 7F 5F Es wird eine Garbagecollection fr den
+ taskeigenen TEXT-Heap durchgefhrt.
+
+HPSIZE 7F 5E dddd Die aktuelle GrӇe des TEXT-Heaps wird in dem
+ Wort an der Adresse dddd abgelegt.
+ <d1> := heapsize
+
+RTSUB 7F 64 dddd dddd dddd Aus dem TEXT an der ersten Adresse wird der
+ REAL-Wert, dessen Position durch das Wort an
+ der zweiten Adresse beschrieben wird, an der
+ dritten Adresse abgelegt.
+ REAL<d3> := TEXT<d1>[INT<d2>, 8]
+
+RTRPL 7F 65 dddd dddd dddd In dem TEXT an der ersten Adresse wird der
+ REAL-Wert, dessen Position durch das Wort an der
+ zweiten Adresse beschrieben wird, durch den
+ REAL-Wert an der dritten Adresse ersetzt.
+ TEXT<d1>[INT<d2>, 8] := REAL<d3>
+
+
+#ub#2.1.5 DATASPACE-Operationen#ue#
+
+DSACC .58:dd dddd Die dsid an der ersten Adresse wird auf
+ Gltigkeit geprft und an der zweiten Adresse
+ eine Referenzaddresse abgelegt, die auf das
+ 4. Wort des Datenraumes (den Anfang des
+ Datenbereichs) zeigt.
+ IF valid ds (DS<d1>)
+ THEN REF<d2> := DATASPACE<d1>.ds base
+ ELSE "falscher DATASPACE-Zugriff"
+ FI
+
+ALIAS 7F 22 vvvv dddd dddd Dem BOUND-Objekt an der dritten Adresse wird
+ der Datenraum an der zweiten Adresse zugewiesen
+ (INT-Move). Zuvor wird geprft, ob dies der
+ erste Zugriff auf den Datenraum ist. Falls ja,
+ wird der Datenraumtyp auf 0 gesetzt. Falls ein
+ Heap aufgebaut werden muá und noch keiner
+ angelegt wurde, wird die Anfangsadresse des
+ Heaps auf den Wert vvvv+4 innerhalb des
+ Datenraumes gesetzt.
+ IF DATASPACE<d1>.typ < 0
+ THEN DATASPACE<d1>.typ := 0
+ FI ;
+ IF DATASPACE<d1>.heapanfang < 0
+ THEN DATASPACE<d1>.heapanfang := vvvv+4
+ FI ;
+ INT<d2> := INT<d1>
+
+NILDS 7F 45 dddd Dem Datenraum an der Adresse dddd wird der
+ 'nilspace' zugewiesen.
+ INT<d1> := 0
+
+DSCOPY 7F 46 dddd dddd Dem Datenraum an der ersten Adresse wird eine
+ Kopie des Datenraumes an der zweiten Adresse
+ zugewiesen (neue dsid). Es wird ein neuer
+ Eintrag in die Datenraumverwaltung aufgenommen.
+ DATASPACE<d1> := DATASPACE<d2>
+
+DSFORG 7F 47 dddd Der Datenraum, dessen dsid an der Adresse dddd
+ steht, wird aus der Datenraumverwaltung
+ gel”scht.
+ forget (DATASPACE<d1>)
+
+DSWTYP 7F 48 dddd dddd Der Typ des Datenraums, dessen dsid an der
+ ersten Adresse steht, wird auf den Wert des
+ Wortes an der zweiten Adresse gesetzt.
+ DATASPACE<d1>.typ := INT<d2> ;
+ IF DATASPACE<d1>.heapanfang < 0
+ THEN DATASPACE<d1>.heapanfang := vvvv+4
+ FI
+
+DSRTYP 7F 49 dddd dddd Der Typ des Datenraums, dessen dsid an der
+ ersten Adresse steht, wird in dem Wort an der
+ zweiten Adresse abgelegt.
+ INT<d2> := DATASPACE<d1>.typ ;
+ IF DATASPACE<d1>.heapanfang < 0
+ THEN DATASPACE<d1>.heapanfang := vvvv+4
+ FI
+
+DSHEAP 7F 4A dddd dddd Die Endaddresse Textheaps des Datenraums, dessen
+ dsid an der ersten Adresse steht, in 1kB
+ Einehiten, wird in dem Wort an der zweiten
+ Adresse abgelegt. Falls dieser Wert = 1023 oder
+ < 96 ist, ist kein Heap vorhanden, anderenfalls
+ ist seine GrӇe (in KB): <d2>-96.
+ INT<d2> := DATASPACE<d1>.heapende DIV 1024
+
+NXTDSP 7F 4B dddd dddd dddd Fr den Datenraum an der ersten Adresse wird
+ die Nummer der Seite, die auf die Nummer der
+ Seite folgt, die in dem Wort an der zweiten Adresse
+ steht an der zweiten Adresse abgelegt. Falls
+ keine Seite mehr folt, wird -1 geliefert.
+ INT<d2> := nextdspage (DATASPACE<d1>, INT<d2>)
+
+DSPAGS 7F 4C dddd dddd dddd Fr den Datenraum mit der Nummer, die im Wort
+ an der ersten Adresse steht, und der Task deren
+ Nummer im Wort an der zweiten Adresse steht,
+ wird die Anzahl der belegten Seiten im Wort an
+ der dritten Adresse abgelegt.
+ INT<d3> := ds pages (INT<d2>, INT<d1>)
+
+SEND 7F 71 dddd dddd dddd dddd
+ Der Datenraum an der dritten Adresse wird der
+ Task, deren id an der ersten Adresse steht, mit
+ dem Messagecode der an der zweiten Adresse
+ steht, gesendet. Der Antwortcode wird im Wort
+ an der vierten Adresse abgelegt. Vereinfachte
+ Semantik:
+ send (TASK<d1>, INT<d2>, DATASPACE<d3>, INT<d4>)
+
+WAIT 7F 72 dddd dddd dddd Die eigene Task geht in einen offenen
+ Wartezustand, bei dem sie empfangsbereit ist fr
+ einen Datenraum einer anderen Task. Die id der
+ sendenden Task wird an der ersten Adresse
+ abgelegt, der Messagecode an der zweiten
+ Adresse, der gesendete Datenraum an der dritten
+ Adresse. Vereinfachte Semantik:
+ wait (TASK<d1>, INT<d2>, DATASPACE<d3>)
+
+SWCALL 7F 73 dddd dddd dddd dddd
+ Der Datenraum an der dritten Adresse wird der
+ Task, deren id an der ersten Adresse steht, mit
+ dem Messagecode der an der zweiten Adresse
+ steht, gesendet bis die Task empfangsbereit ist.
+ Dann wird auf einen zurckgesandten Datenraum
+ dieser Task gewartet, der an der dritten
+ Adresse abgelegt wird. Der zurckgesendete
+ Messagecode wird an der vierten Adresse
+ abgelegt. Vereinfachte Semantik:
+ REP
+ send (TASK<d1>, INT<d2>, DATASPACE<d3>,INT<d4>)
+ UNTIL INT<d4> <> task busy PER ;
+ wait (TASK<d1>, INT<d4>, DATASPACE<d3>)
+
+PPCALL 7F 7A dddd dddd dddd dddd
+ Wirkt wie SWCALL, wartet aber nicht bis die
+ Zieltask empfangsbereit ist, sondern liefert -2
+ an der vierten Adresse zurck, wenn die Task
+ nicht empfangsbereit ist. Vereinfachte
+ Semantik:
+ send (TASK<d1>, INT<d2>, DATASPACE<d3>,INT<d4>);
+ IF INT<d4> <> task busy
+ THEN wait (TASK<d1>, INT<d4>, DATASPACE<d3>)
+ FI
+
+SENDFT 7F 7F dddd dddd dddd dddd dddd
+ Der Datenraum an der vierten Adresse wird der
+ Task, deren id an der zweiten Adresse steht,
+ mit dem Messagecode der an der dritten Adresse
+ steht, gesendet als ob er von der Task k„me,
+ deren id an der ersten Adresse steht. Der
+ Antwortcode wird im Wort an der vierten
+ Adresse abgelegt. Dieser Befehl setzt eine
+ Priviligierung >= 1 voraus und ist nur wirksam,
+ wenn die from-Task einer anderen Station
+ angeh”rt. Vereinfachte Semantik:
+ IF station (TASK<d1>) = station (myself)
+ THEN send (TASK<d2>, INT<d3>, DATASPACE<d4>,
+ INT<d5>)
+ ELSE save myself := myself ;
+ myself := TASK<d1> ;
+ send (TASK<d2>, INT<d3>, DATASPACE<d4>,
+ INT<d5>) ;
+ myself := save myself
+ FI
+
+
+#ub#2.1.6 TASK-Operationen#ue#
+
+TWCPU 7F 52 dddd dddd Die CPU-Zeit der Task, deren Nummer an der
+ ersten Adresse steht, wird auf den REAL-Wert,
+ der an der zweiten Adresse steht gesetzt. Dieser
+ Befehl setzt eine Privilegierung > 1 voraus
+ (Supervisor).
+ pcb(INT<d1>).clock := REAL<d2>
+
+TPBEGIN 7F 5F dddd dddd dddd aaaaaa
+ Als Sohn der Task, deren Nummer an der ersten
+ Adresse steht, wird eine Task eingerichtet,
+ deren Nummer an der zweiten Adresse steht. Die
+ neue Task erh„lt die Privilegierung, deren
+ Nummer in dem Wort an der dritten Adresse
+ steht und wird mit der Prozedur gestartet,
+ deren Code bei der durch den vierten Parameter
+ bergebenen Refereznadresse beginnt. Dieser
+ Befehl setzt eine Privilegierung > 1 voraus
+ (Supervisor).
+
+TRPCB 7F 68 dddd dddd dddd Der Wert des Leitblockfeldes der Task
+ deren Nummer an der ersten Adresse steht und
+ der Nummer, die in dem Wort an der zweiten
+ Adresse steht, wird an der dritten Adresse
+ abgelegt.
+ INT<d3> := pcb(INT<d1>, INT<d2>)
+
+TWPCB 7F 69 dddd dddd dddd Der Wert an der dritten Adresse wird in das
+ Leitblockfeld mit der Nummer an der zweiten
+ Adresse der Task bertragen, deren Nummer an der
+ ersten Adresse steht. Privilegierung:
+ 0: Nur linenumber-Feld (0), der eigenen Task
+ 1: linenumber-Feld der eigenen Task und
+ prio-Feld (5) jeder Task
+ 2: Alle Felder
+ Fr den Fall, daá die Privilegierung ok ist
+ gilt:
+ pcb (INT<d1>, INT<d2>) := INT<d3>
+
+TCPU 7F 6A dddd dddd Die CPU-Zeit der Task, deren Nummer an der
+ ersten Adresse steht, wird als REAL-Wert an der
+ zweiten Adresse abgelegt.
+ REAL<d2> := pcb (INT<d1>).clock
+
+TSTAT 7F 6B dddd dddd Der Status (busy, i/o, wait) der Task, deren
+ Nummer an der ersten Adresse steht, wird im Wort
+ an der zweiten Adresse abgelegt.
+ INT<d2> := pcb (INT<d1>).status
+
+ACT 7F 6C dddd Die Task mit der Nummer, die an der Adresse dddd
+ steht wird aktiviert (entblockt). Dieser Befehl
+ setzt eine Privilegierung >= 1 voraus.
+ activate (INT<d1>)
+
+DEACT 7F 6D dddd Die Task, deren Nummer an der Adresse dddd
+ steht, wird deaktiviert (geblockt). Dieser
+ Befehl setzt eine Privilegierung >= 1 voraus.
+ deactivate (INT<d1>)
+
+THALT 7F 6E dddd In der Task, deren Nummer an der Adresse dddd
+ steht, wird ein Fehler 'halt vom Terminal'
+ induziert. Dieser Befehl setzt eine
+ Privilegierung > 1 voraus (Supervisor).
+ halt process (INT<d1>)
+
+TBEGIN 7F 6F dddd aaaaaa Eine neue Task wird eingerichtet, deren Nummer
+ an der ersten Adresse steht. Die Adresse der
+ Startprozedur wird als Referenzadresse im
+ zweiten Parameter bergeben. Der Datenraum 4
+ wird von der aufrufenden Task geerbt. Als
+ Privilegierung wird 0 eingetragen.
+ Dieser Befehl setzt eine Privilegierung > 1
+ voraus (Supervisor).
+
+TEND 7F 70 dddd Die Task, deren Nummer an der Adresse dddd
+ steht, wird gel”scht (alle Datenr„ume) und aus
+ der Prozessverwaltung entfernt. Dieser Befehl
+ setzt eine Privilegierung > 1 voraus
+ (Supervisor).
+
+PNACT 7F 76 dddd Die Nummer der n„chsten aktivierten Task
+ wird aus der Aktivierungstabelle gelesen. Die
+ Suche beginnt mit dem Wert+1 an der Adresse. Die
+ Nummer n„chsten aktivierten Task wird an dieser
+ Adresse abgelegt.
+ INT<d1> := next active (INT<d1>)
+
+DEFCOL 7F 80 dddd Die Task an der Adresse wird als Collectortask
+ (fr Datenaustausch zwischen Stationen)
+ definiert. Dieser Befehl setzt eine
+ Privilegierung >= 1 voraus.
+ TASK collector := TASK<d1>
+
+
+#ub#2.1.7 Tests und Vergleiche#ue#
+
+Alle Tests und Vergleiche liefern ein BOOL-Resultat, welches den Opcode des
+nachfolgenden Branch-Befehls bestimmt (Aus LN wird BT aus BR wird BF).
+
+TEST .28:dd Liefert TRUE, wenn das Wort an der Adresse 0
+ ist (Auch fr BOOL-Variablen gebraucht: TRUE=0,
+ FALSE=1).
+ FLAG := <d1> = 0
+
+EQU .2C:dd dddd Liefert TRUE, wenn die W”rter der beiden
+ Adressen gleich sind.
+ FLAG := <d1> = <d2>
+
+LSEQ .30:dd dddd Liefert TRUE, wenn der Wert des Wortes an der
+ ersten Adresse (vorzeichenbehaftet) kleiner oder
+ gleich dem Wert des Wortes an der zweiten
+ Adresse ist.
+ FLAG := INT<d1> <= INT<d2>
+
+FLSEQ .48:dd dddd Liefert TRUE, wenn der REAL-Wert an der ersten
+ Adresse kleiner oder gleich dem REAL-Wert an der
+ zweiten Adresse ist.
+ FLAG := REAL<d1> <= REAL<d2>
+
+FEQU 7F 24 dddd dddd Liefert TRUE, wenn der REAL-Wert an der ersten
+ Adresse gleich dem REAL-Wert an der zweiten
+ Adresse ist.
+ FLAG := REAL<d1> = REAL<d2>
+
+TLSEQ 7F 25 dddd dddd Liefert TRUE, wenn der TEXT an der ersten
+ Adresse kleiner oder gleich dem TEXT an der
+ zweiten Adresse ist.
+ FLAG := TEXT<d1> <= TEXT<d2>
+
+TEQU .50:dd dddd Liefert TRUE, wenn der TEXT an der ersten
+ Adresse gleich dem TEXT an der zweiten Adresse
+ ist.
+ FLAG := TEXT<d1> = TEXT<d2>
+
+ULSEQ .54:dd dddd Liefert TRUE, wenn der Wert des Wortes an der
+ ersten Adresse (vorzeichenlos) kleiner oder
+ gleich dem Wert des Wortes an der zweiten
+ Adresse ist.
+ FLAG := INT<d1> "<=" INT<d2>
+
+EQUIM 7C vv dddd Liefert TRUE, wenn der Wert des Wortes an der
+ Adresse dddd gleich der 8 Bit Konstanten vv
+ ist.
+ FLAG := INT<d1> = vv
+
+ISDIG 7F 12 dddd Liefert TRUE, wenn der ASCII-Code im Wort an
+ der Adresse dddd einer Ziffer entspricht.
+ FLAG := INT<d1> >= 48 AND INT<d1> <= 57
+
+ISLD 7F 13 dddd Liefert TRUE, wenn der ASCII-Code im Wort an
+ der Adresse dddd einer Ziffer oder einem
+ Kleinbuchstaben entspricht.
+ FLAG := INT<d1> >= 48 AND INT<d1> <= 57 OR
+ INT<d1> >= 97 AND INT<d1> <= 122
+
+ISLCAS 7F 14 dddd Liefert TRUE, wenn der ASCII-Code im Wort an
+ der Adresse dddd einem Kleinbuchstaben
+ entspricht.
+ FLAG := INT<d1> >= 97 AND INT<d1> <= 122
+
+ISUCAS 7F 15 dddd Liefert TRUE, wenn der ASCII-Code im Wort an
+ der Adresse dddd einem Groábuchstaben
+ entspricht.
+ FLAG := INT<d1> >= 65 AND INT<d1> <= 90
+
+ISSHA 7F 18 dddd Liefert TRUE, wenn der Wert des Wortes an der
+ Adresse dddd im Bereich 0..2047 liegt, d.h.
+ eine Kurzadresse ist, die noch zusammen mit dem
+ Opcode im ersten Wort eines Prim„rbefehls
+ untergebracht werden kann.
+ FLAG := INT<d1> < 2048
+
+ISERR 7F 4E Liefert TRUE, wenn ein Fehlerzustand vorliegt.
+ FLAG := ERROR
+
+EXTASK 7F 7B dddd Liefert TRUE, wenn die Task, deren id an der
+ Adresse dddd steht, existiert (nicht "dead" und
+ korrekte Versionsnummer).
+ FLAG := TASK<d1>.version =
+ pcb (TASK<d1>.nr).version AND
+ pcb (TASK<d1>.nr).status <> dead
+
+
+#ub#2.1.8 I/O-Operationen#ue#
+
+OUT 7F 3C dddd Der Text an der Adresse wird ausgegeben.
+ out (TEXT<d1>)
+
+COUT 7F 3D dddd Falls der Kanal frei ist und die INT-Zahl an
+ der Adresse dddd positiv ist, wird sie als
+ Dezimalzahl ausgegeben.
+ IF free (channel)
+ THEN out (text (INT<d1>, 5) + 5 * ""8"")
+ FI
+
+OUTF 7F 3E dddd dddd Der Text an der ersten Adresse wird ab der
+ Position, die durch den Wert des Wortes an der
+ zweiten Adresse bestimmt wird, bis zum Ende
+ ausgegeben.
+ out (subtext (TEXT<d1>, INT<d2>, length
+ (TEXT<d1>)))
+
+OUTFT 7F 3F dddd dddd dddd Der Text an der ersten Adresse wird ab der
+ Position, die durch den Wert an der zweiten
+ Adresse bestimmt wird, bis zur Position die
+ durch den Wert an der dritten Adresse bestimmt
+ wird, ausgegeben.
+ out (subtext (TEXT<d1>, INT<d2>, INT<d3>))
+
+INCHAR 7F 40 dddd Es wird auf ein Eingabezeichen gewartet,
+ welches dann im TEXT an der Adresse dddd
+ abgelegt wird.
+ IF zeichen da (channel)
+ THEN TEXT<d1> := incharety
+ ELSE offener wartezustand (inchar) ;
+ TEXT<d1> := incharety
+ FI
+
+INCETY 7F 41 dddd Falls kein Eingabezeichen vorhanden ist, wird
+ im TEXT an der Adresse dddd niltext geliefert,
+ sonst das Eingabezeichen.
+ IF zeichen da (channel)
+ THEN TEXT<d1> := incharety
+ ELSE TEXT<d1> := ""
+ FI
+
+PAUSE 7F 42 dddd Der Wert an der Adresse dddd bestimmt die
+ Wartezeit in Zehntelsekunden, die gewartet
+ werden soll. Die Pause kann durch eine Eingabe
+ auf dem Kanal abgebrochen werden.
+ IF NOT zeichen da (channel)
+ THEN modi := INT<d1> ;
+ offener wartezustand (pause)
+ FI
+
+GCPOS 7F 43 dddd dddd Die Cursorposition wird erfragt. Die x-Position
+ wird an der ersten Adresse abgelegt, die
+ y-Position an der zweiten Adresse.
+ getcursor (INT<d1>, INT<d2>)
+
+CATINP 7F 44 dddd dddd Aus dem Eingabepuffer werden alle Zeichen
+ gelesen und an den TEXT an der ersten Adresse
+ geh„ngt, bis entweder der Eingabepuffer leer
+ ist oder ein Zeichen mit einem Code < 32
+ gefunden wurde. Im ersten Fall wird niltext an
+ der zweiten Adresse abgelegt, im zweiten Fall
+ das Trennzeichen.
+ REP
+ IF zeichen da (channel)
+ THEN zeichen := incharety ;
+ IF code (zeichen) < 32
+ THEN TEXT<d2> := zeichen
+ ELSE TEXT<d1> CAT zeichen
+ FI
+ ELSE TEXT<d2> := "" ;
+ LEAVE CATINP
+ FI
+ PER
+
+CONTRL 7F 54 dddd dddd dddd dddd
+ Der IO-Controlfunktion mit der Nummer, die
+ an der ersten Adresse steht, werden die beiden
+ Parameter bergeben, die an der zweiten und
+ dritten Adresse stehen. Die Rckmeldung wird
+ an der vierten Adresse abgelegt.
+ IF channel > 0
+ THEN iocontrol (INT<d1>, INT<d2>, INT<d3>,
+ INT<d4>)
+ FI
+
+BLKOUT 7F 55 dddd dddd dddd dddd dddd
+ Die Seite des Datenraums, dessen dsid an der
+ ersten Adresse steht, mit der Seitennummer, die
+ an der zweiten Adresse steht, wird auf dem
+ aktuellen Kanal ausgegeben. Als Parameter
+ werden die Werte an der dritten und vierten
+ Adresse bergeben. Der Returncode wird an der
+ fnften Adresse abgelegt.
+ IF channel > 0
+ THEN blockout (DATASPACE<d1>[INT<d2>, 512],
+ INT<d3>, INT<d4>, INT<d5>)
+ FI
+
+BLKIN 7F 56 dddd dddd dddd dddd dddd
+ Die Seite des Datenraums, dessen dsid an der
+ ersten Adresse steht, mit der Seitennummer, die
+ an der zweiten Adresse steht, wird an dem
+ aktuellen Kanal eingelesen. Als Parameter
+ werden die Werte an der dritten und vierten
+ Adresse bergeben. Der Returncode wird an der
+ fnften Adresse abgelegt.
+ IF channel > 0
+ THEN blockout (DATASPACE<d1>[INT<d2>, 512],
+ INT<d3>, INT<d4>, INT<d5>)
+ FI
+
+
+#ub#2.1.9 Ablaufsteuerung (Branch und Gosub)#ue#
+
+B .70:aa bzw. .74:aa Unbedingter Sprung an die Adresse.
+ ICOUNT := aaaa (aaaa gilt nur fr den
+ Debugger/Tracer, da die Adressrechung intern
+ komplizierter ist)
+
+BF .70:aa bzw. .74:aa Wenn der letzte Befehl FALSE lieferte, Sprung an
+ die Adresse.
+ IF NOT FLAG
+ THEN ICOUNT := aaaa (aaaa s.o.)
+ FI
+
+BT .00:aa bzw. .04:aa Wenn der letzte Befehl TRUE lieferte, Sprung an
+ die Adresse (auch LN-Opcode).
+ IF FLAG
+ THEN ICOUNT := aaaa (aaaa s.o.)
+ FI
+
+BRCOMP 7F 20 dddd vvvv Wenn das Wort an der Adresse dddd kleiner als 0
+ oder grӇer als die Konstante vvvv ist, wird mit
+ dem auf den BRCOMP-Befehl folgenden Befehl
+ (i.d.R. ein B-Befehl) fortgefahren. Sonst wird
+ die Ausfhrung an der Adresse des
+ BRCOMP-Befehls + 2 + (dddd) (auch ein B-Befehl)
+ fortgesetzt.
+ IF <d1> >= 0 AND <d1> <= vvvv
+ THEN ICOUNT INCR (<d1> + 1)
+ FI
+
+GOSUB 7F 05 aaaa Die aktuelle Codeadresse wird auf den Stack
+ gebracht und das Programm an der Adresse aaaa
+ fortgesetzt.
+ <TOP>:=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ;
+ LBASE := TOP ;
+ ICOUNT := aaaa ;
+ CMOD := high (ICOUNT) + 16
+
+GORET 7F 07 Das Programm wird an der oben auf dem Stack
+ stehenden Returnadresse fortgesetzt.
+ TOP := LBASE ;
+ SP := TOP + 4 ;
+ (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := <TOP>
+
+
+#ub#2.1.10 Modul-Operationen#ue#
+
+PPV .68:dd Das Wort an der Adresse wird auf den Stack
+ gebracht. Dieser Befehl wird vom Compiler nicht
+ generiert.
+ <SP> := INT<d1> ;
+ SP INCR 2
+
+PP .6C:dd Die Referenzadresse des Objektes wird auf den
+ Stack gebracht (2 Worte).
+ <SP> := REF d1 ;
+ SP INCR 2
+
+PPROC 7F 1E mmmm Die Adresse der Prozedur mit der Modulnummer
+ mmmm wird als Referenzadresse (Codesegment,
+ Codeadresse) auf den Stack gebracht.
+ <SP> := mod addr (mmmm) ;
+ SP INCR 2
+
+HEAD vvvv (kein Opcode) Der Speicherplatz fr lokale Variablen und
+ Parameter in diesem Modul wird vermerkt, indem
+ der Stacktop um vvvv erhoht wird.
+ TOP INCR vvvv ;
+ SP := TOP + 4
+
+PENTER FE vv Die Paketbasis (Basis der globalen Adressen
+ dieses Moduls) wird auf den Wert vv*256
+ gesetzt.
+ PBASE := vv * 256
+
+CALL .78:mm Das Modul mit der Nummer mm wird aufgerufen.
+ <TOP>:=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ;
+ LBASE := TOP ;
+ ICOUNT := mod addr (mm) ;
+ CMOD := high (ICOUNT) + 16
+
+PCALL 7F 1F dddd Die (Parameter-)Prozedur, deren Startadresse
+ als Referenzadresse auf dem Stack steht, wird
+ aufgerufen.
+ <TOP>:=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ;
+ LBASE := TOP ;
+ ICOUNT := d1 ;
+ CMOD := high (ICOUNT) + 16 .
+
+EXEC 7F 1D dddd Das Modul dessen Nummer in dem Wort an der
+ Adresse dddd steht, wird aufgerufen.
+ <TOP>:=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ;
+ LBASE := TOP ;
+ ICOUNT := <d1> ;
+ CMOD := high (ICOUNT) + 16 .
+
+RTN 7F 00 Das Modul wird verlassen, die
+ Programmausfhrung setzt an der, auf dem Stack
+ gesicherten, Adresse fort.
+ TOP := LBASE ;
+ SP := TOP + 4 ;
+ (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := <TOP>
+
+RTNT 7F 01 Das Modul wird verlassen und der BOOL-Wert TRUE
+ geliefert (fr den dem CALL/PCALL folgenden
+ BT/BF-Befehl). Die Programmausfhrung setzt an
+ der, auf dem Stack gesicherten, Adresse fort.
+ TOP := LBASE ;
+ SP := TOP + 4 ;
+ (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := <TOP>;
+ FLAG := TRUE
+
+RTNF 7F 02 Das Modul wird verlassen und der BOOL-Wert
+ FALSE geliefert (fr den dem CALL/PCALL
+ folgenden BT/BF-Befehl). Die Programmausfhrung setzt an
+ der, auf dem Stack gesicherten, Adresse fort.
+ TOP := LBASE ;
+ SP := TOP + 4 ;
+ (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := <TOP>;
+ FLAG := FALSE
+
+
+#ub#2.1.10 Datenadressrechnung#ue#
+
+REF .5C:dd dddd An der zweiten Adresse wird die Referenzadresse
+ der ersten Adresse abgelegt (2 W”rt-MOV).
+ REF<d2> := d1
+
+SUBS .60:vv vvvv dddd dddd dddd
+ Wenn der Inhalt des Wortes an der dritten
+ Adresse (ROW-Index) grӇer oder gleich der
+ Konstanten vvvv (limit-1) ist, wird "Subscript
+ šberlauf" gemeldet, falls der ROW-Index kleiner
+ als eins ist wird "Subscript šnterlauf"
+ gemeldet. Andernfalls wird der um eins
+ verringerte ROW-Index mit der Konstanten vv
+ (Size eines ROW-Elements) multipliziert,
+ zur Basisaddresse (vierter Parameter) addiert
+ und als Referenzadresse an der fnften Adresse
+ abgelegt.
+ IF INT<d1> <= vvvv AND INT<d1> > 0
+ THEN REF<d3> := d2 + vv * (INT<d1>-1)
+ ELSE "Fehler" s.o.
+ FI
+
+SEL .64:dd vvvv dddd Die Konstante vvvv (Selektor-Offset einer
+ STRUCT) wird zur Adresse dd addiert und als
+ Referenzadresse auf dem Stack an der Adresse
+ dddd abgelegt.
+ REF<d2> := vv + d1
+
+CTT 7F 0C dddd dddd Die Adresse des Strings(!) an der ersten
+ Adresse wird an der zweiten Adresse als
+ Referenzadresse (Segment 0, DS 4) abgelegt.
+ CTT steht fr Compiler-Table-Text.
+ REF<d2> := REF (0004, INT<d1>)
+
+
+#ub#2.1.12 Compiler-Spezialbefehle#ue#
+
+PUTW FD v1v2 dddd dddd Das lowbyte des Opcode besteht aus den beiden
+ Nibbles v1 (Segment) und v2 (Wordoffset). Das
+ Wort an der zweiten dddd-Adresse wird an die
+ Adresse im Datenraum 4, Segment v1 geschrieben,
+ die durch den Wert des Wortes an der ersten
+ dddd-Adresse + v2 bestimmt ist.
+ <v1 * 64KW + INT<d1> + v2> := INT<d2>
+
+GETW 7E v1v2 dddd dddd Das lowbyte des Opcode besteht aus den beiden
+ Nibble v1 (Segment) und v2 (Wordoffset). Das
+ Wort im Datenraum 4, Segment v1 an der durch
+ den Wert des Wortes an der ersten dddd-Adresse
+ + v2 bestimmten Adresse wird an der zweiten
+ dddd-Adresse abgelegt.
+ INT<d2> := <v1 * 64KW + INT<d1> + v2)
+
+PW 7F 6F dddd dddd dddd Das Wort an der dritten Adresse wird im
+ Datenraum 4 an die Adresse geschrieben, die
+ durch das Segment (erste Adresse) und die
+ Adresse in diesem Segment (zweite Adresse)
+ bestimmt ist.
+ <INT<d1> * 64KW + INT<d2>> := INT<d3>
+
+GW 7F 70 dddd dddd dddd Das Wort im Datenraum 4, das durch das Segment
+ (erste Adresse) und die Adresse in diesem
+ Segment (zweite Adresse) bestimmt ist, wird an
+ der dritte Adresse abgelegt.
+ INT<d3> := <INT<d1> * 64KW + INT<d2>>
+
+BCRD 7F 08 dddd dddd Bereitet das Lesen einzelner Zeichen aus dem
+ Segment 4 des Datenraumes 4 vor (Nametable).
+ Das Wort an der ersten Adresse enth„lt die
+ Startadresse des Strings und zeigt auf das
+ L„ngenbyte. Nach dem Ausfhren des Befehls
+ enth„lt das Wort an der zweiten Adresse das
+ L„ngenbyte und der Pointer an der ersten
+ Adresse zeigt auf das erste Zeichen des Textes.
+ Das Bit 15 des Pointers ist gesetzt, wenn das
+ highbyte adressiert wird.
+ INT<d2> := length (STRING<d1>) ;
+ INT<d1> INCR 1/2
+
+CRD 7F 09 dddd dddd Liest ein Zeichen aus dem String, dessen Lesen
+ mit BCRD vorbereitet wurde. Die erste Adresse
+ enth„lt einen Stringpointer, der nach jedem
+ Lesen erh”ht wird, die zweite Adresse enth„lt
+ nach dem Aufruf des Befehls den Code des
+ gelesenen Zeichens.
+ INT<d2> := code (STRING<d1>) ;
+ INT<d1> INCR 1/2
+
+CWR 7F 0B dddd dddd dddd Der Hashcode an der ersten Adresse wird mit dem
+ zu schreibenden Zeichencode (dritte Adresse)
+ verknpft und in den Bereich 0..1023 gemapt.
+ Das Zeichen wird an die Position des Pointers
+ geschrieben (Bit 15 des Pointers unterscheidet
+ lowbyte und highbyte). Anschlieáend wird der
+ Pointer auf die Adresse des n„chsten Zeichens
+ gesetzt. Der Pointer steht an der zweiten
+ Adresse. Vor dem Schreiben des ersten Zeichens
+ muá der Hashcode auf 0 gesetzt werden.
+ INT<d1> INCR INT<d1> ;
+ IF INT<d1> > 1023 THEN INT<d1> DECR 1023 FI ;
+ INT<d1> := (INT<d1> + INT<d3>) MOD 1024 ;
+ STRING<INT<d2>> := code (INT<d3>) ;
+ INT<d2> INCR 1/2
+
+ECWR 7F 0A dddd dddd dddd Das Schreiben eines Strings wird beendet. Dazu
+ wird an der ersten Adresse der Stringpointer
+ bergegeben, an der zweiten Adresse wird die
+ endgltige Stringl„nge geliefert. An der
+ dritten Adresse wird die Adresse des n„chsten
+ freien Platzes nach diesem Stringende
+ geliefert.
+
+GETC 7F 0D dddd dddd dddd Dieser Befehl liefert ein BOOL-Result und zwar
+ TRUE, wenn das Wort an der zweiten Adresse
+ gr”áer als 0 und kleiner als die L„nge des
+ TEXTes an der ersten Adresse ist. In diesem Fall
+ wird im Wort an der dritten Adresse der Code
+ des n. Zeichens des TEXTes geliefert. Die
+ Position des Zeichens wird durch das Wort an
+ der zweiten Adresse bestimmt.
+ FLAG := INT<d2> > 0 AND INT<d2> <= length
+ (TEXT<d1>) ;
+ INT<d3> := code (TEXT<d1>[INT<d2>, 1])
+
+FNONBL 7F 0E dddd dddd dddd Dieser Befehl liefert ein BOOL-Result.
+ zaehler := INT<d3> ; (* Stringpointer *)
+ WHILE TEXT<d2>[zahler, 1] = " " REP
+ zaehler INCR 1
+ PER ;
+ IF zaehler > length (TEXT<d2>)
+ THEN FLAG := FALSE
+ ELSE INT<d1> := code (TEXT<d2>[zaehler, 1]);
+ INT<d3> := zaehler + 1
+ FI
+
+DREM256 7F 0F dddd dddd Das lowbyte des Wortes an der ersten Adresse
+ wird in das Wort an der zweiten Adresse
+ geschrieben, das highbyte des Wortes an der
+ ersten Adresse ersetzt das gesamte erste Wort.
+ INT<d2> := INT<d1> MOD 256 ;
+ INT<d1> := INT<d1> DIV 256
+
+AMUL256 7F 10 dddd dddd Umkerung von DREM256.
+ INT<d1> := INT<d1> * 256 + INT<d2>
+
+GADDR 7F 16 dddd dddd dddd "Adresswort" mit Adresstyp generieren (z.B.<d1>
+ = pbase).
+ IF INT<d2> >= 0 (* Global *)
+ THEN INT<d3> := INT<d2> - INT<d1>
+ ELIF bit (INT<d2>, 14) (* Local Ref *)
+ THEN INT<d3> := (INT<d2> AND 3FFFH)*2 + 1
+ ELSE INT<d3> := (INT<d2> AND 3FFFH)*2
+ (* Local *)
+ FI
+
+GCADDR 7F 17 dddd dddd dddd Diese Instruktion liefert ein BOOL-Result.
+ Mit <d2> = 0 wird sie eingesetzt, um die
+ Zeilennummer im LN-Befehl zu generieren, mit
+ <d2> <> 0 wird sie eingesetzt, um die Adresse im
+ Branchbefehl zu generieren. Beide Befehle gibt
+ es mit zwei Opcodes (00/04 bzw. 70/74).
+ byte := high(INT<d1>)-high(INT<d2>) ;
+ IF byte < 0
+ THEN byte INCR 16 ; (* Bit fr LN1 bzw. B1
+ Opcode *)
+ rotate (byte, right) ;
+ FI ;
+ INT<d3> := byte * 256 + low (INT<d1>) ;
+ FALSE, wenn irgendeins der Bits 11..14 = 1 ist
+
+GETTAB 7F 1A Kopiert den Inhalt der unteren 64KB des
+ Segments 5 im DS 4 in das Segment 4.
+ (permanentes Segment --> tempor„res Segment)
+ DS4: 50000..57FFF --> 40000..47FFF (Wortaddr)
+
+PUTTAB 7F 1B Kopiert den Inhalt der unteren 64KB des Segments
+ 4 im DS 4 in das Segment 5. (Tempor„re Daten
+ werden permanent)
+ DS4: 40000..47FFF --> 50000..57FFF (Wortaddr)
+
+ERTAB 7F 1C Kopiert den Inhalt des Segments 6 im DS 4
+ (besteht nur aus FF's) in die Segmente 4 und 7,
+ d.h. das tempor„re Segment (u.a. Symboltabelle)
+ und das Segment mit Compiler-Intermediatestring
+ werden gel”scht.
+ DS4: 60000..6FDFF --> 40000..4FDFF ;
+ DS4: 60000..6FDFF --> 70000..7FDFF
+
+CDBINT 7F 74 dddd dddd Das Wort mit der Nummer <d1> wird aus dem
+ Segment 5 gelesen und in <d2> abgelegt.
+ INT<d2> := <50000H + INT<d1>>
+
+CDBTXT 7F 74 dddd dddd Der String(!) an der Adresse <d1> im Segment 5
+ wird in dem TEXT <d2> abgelegt.
+ TEXT<d2> := ctt (<50000H + INT<d1>>)
+
+
+#ub#2.1.13 Instruktionen zur Programmsteuerung#ue#
+
+STOP 7F 04 Alle (aufrufenden) Module werden verlassen, bis
+ das erste im 'disablestop'-Zustand angetroffen
+ wird (Žhnlich errorstop ("")) ;
+ WHILE ENSTOP REP return PER .
+
+ return:
+ TOP := LBASE ;
+ SP := TOP + 4 ;
+ (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := <TOP>
+
+ESTOP 7F 4B Der 'enable stop'-Zustand wird eingeschaltet.
+ ENSTOP := TRUE
+
+DSTOP 7F 4C Der 'disable stop'-Zustand wird eingeschaltet.
+ ENSTOP := FALSE
+
+SETERR 7F 4D dddd Es wird der Fehlerzustand eingeschaltet, das
+ Wort an der Adresse dddd wird in das pcb-Feld
+ 'error code' gebracht. Falls das Modul im
+ 'enablestop'-Zustand ist, wird das Modul
+ verlassen.
+ IF NOT ERROR
+ THEN ERROR := TRUE ;
+ pcb.error line := pcb.line ;
+ pcb.error code := INT<d1> ;
+ WHILE ENSTOP REP return PER
+ FI
+
+CLRERR 7F 4F Falls der Fehlerzustand vorliegt, wird der
+ Fehler gel”scht.
+ ERROR := FALSE
+
+LN .00:vv und .04:vv Die Konstante vv wird in das pcb-Feld
+ 'line number' gebracht (Zur Fehlerbehandlung).
+ pcb.line := vv
+
+RPCB 7F 50 dddd dddd Der Inhalt des pcb-Feldes der eigenen Task mit
+ der Nummer, die im Wort an der ersten Adresse
+ steht, wird in das Wort an der zweiten Adresse
+ gebracht.
+ INT<d2> := pcb (myself, INT[<d1>)
+
+CLOCK 7F 66 dddd dddd Die Systemuhr mit der Nummer, die durch den
+ Wert des Wortes an der ersten Adresse
+ spezifiziert wird, wird gelesen und deren
+ REAL-Wert an der zweiten Adresse abgelegt.
+ Wenn <d1> = 0 ist, wird die CPU-Zeit der
+ eigenen Task geliefert, anderenfalls die
+ Systemuhr mit der Nummer 1..7 :
+ Nummer Funktion
+ 1 REAL-Time
+ 2 Paging Wait
+ 3 Paging Busy
+ 4 Foreground Tasks cpu-time
+ 5 Background Tasks cpu-time
+ 6 System cpu-time
+ 7 Reserviert
+
+ IF INT<d1> = 0
+ THEN REAL<d2> := pcb.clock
+ ELSE REAL<d2> := clock (INT<d1>)
+ FI
+
+
+#ub#2.1.14 Systemglobale Instruktionen#ue#
+
+KE 7F 06 Der EUMEL0-Debugger 'Info' wird aufgerufen,
+ falls dies ein infof„higes System ist.
+
+SYSG 7F 19 Sysgen (Nur beim Sysgen-Urlader).
+
+INFOPW 7F 51 dddd dddd dddd Das bis zu 10 Zeichen lange Infopassword an der
+ zweiten Adresse (TEXT) wird eingestellt, falls
+ das alte Infopassword mit dem TEXT an der
+ ersten Adresse bereinstimmt. In diesem Fall
+ wird im Wort an der dritten Adresse eine 0
+ abgelegt, andernfalls eine 1. Dies ist kein
+ privilegierter Befehl, er funktioniert
+ allerdings nur, wenn das alte Infopasswort
+ bekannt ist.
+ IF info password = TEXT<d1>
+ THEN info password := TEXT<d2> ;
+ INT<d3> := 0
+ ELSE INT<d3> := 1
+ FI
+
+STORAGE 7F 5A dddd dddd Die GrӇe des vorhandene Hintergrundspeichers
+ in KB wird im Wort an der ersten Adresse
+ abgelegt, die GrӇe des benutzten
+ Hintergrundspeichers an der zweiten Adresse.
+ INT<d1> := size ;
+ INT<d2> := used
+
+SYSOP 7F 5B dddd Es wird eine Systemoperation mit der Nummer,
+ die an der Adresse dddd steht, aufgerufen
+ (1=Garbage Collection, 11=Savesystem, 4=Shutup,
+ 2=Fixpoint). Dieser Befehl setzt eine
+ Privilegierung >= 1 voraus.
+
+SETNOW 7F 67 dddd Die Realtime-Clock (clock(1)) des Systems wird
+ auf den REAL-Wert an der Adresse dddd gesetzt.
+ Dieser Befehl setzt eine Privilegierung >= 1
+ voraus.
+ clock (1) := REAL<d1>
+
+SESSION 7F 7E dddd Der aktuelle Wert des Systemlaufz„hlers wird
+ an der Adresse dddd abgelegt.
+ INT<d1> := systemlaufzaehler
+
+ID 7F 81 dddd dddd Der Wert des id-Feldes mit der Nummer, die an
+ der ersten Adresse steht, wird in das Wort an
+ der zweiten Adresse geschrieben. Fr dei
+ Nummern der id-Felder gilt:
+ Feld Inhalt
+ 0 Kleinste HG-Version fr EUMEL0
+ 1 CPU-Type (1=Z80,3=8086,4=68000,5=80286)
+ 2 Urlader-Version
+ 3 Reserviert
+ 4 Lizenznummer des Shards
+ 5 Installationsnummer
+ 6 Frei fr Shard
+ 7 Frei fr Shard
+ IF INT<d1> < 4
+ THEN INT<d2> := eumel0 id (INT<d1>)
+ ELSE INT<d2> := shard id (INT<d1>)
+ FI
+
+
+#ub#2.1 Alphabetische Liste der Befehle#ue#
+
+ACT 7F 6C dddd
+ADD .1C:dd dddd dddd
+ALIAS 7F 22 vvvv dddd dddd
+AMUL256 7F 10 dddd dddd
+AND 7F 7C dddd dddd dddd
+ARITHS 7F 5B
+ARITHU 7F 5C
+B .70:aa bzw. .74:aa
+BCRD 7F 08 dddd dddd
+BF .70:aa bzw. .74:aa
+BLKIN 7F 56 dddd dddd dddd dddd dddd
+BLKOUT 7F 55 dddd dddd dddd dddd dddd
+BRCOMP 7F 20 dddd vvvv
+BT .00:aa bzw. .04:aa
+CALL .78:mm
+CAT 7F 35 dddd dddd
+CATINP 7F 44 dddd dddd
+CDBINT 7F 74 dddd dddd
+CDBTXT 7F 74 dddd dddd
+CLEAR .24:dd
+CLOCK 7F 66 dddd dddd
+CLRERR 7F 4F
+CONTRL 7F 54 dddd dddd dddd dddd
+COUT 7F 3D dddd
+CRD 7F 09 dddd dddd
+CTT 7F 0C dddd dddd
+CWR 7F 0B dddd dddd dddd
+DEACT 7F 6D dddd
+DEC .18:dd dddd
+DEC1 .10:dd
+DECOD 7F 2F dddd dddd
+DEFCOL 7F 80 dddd
+DIV 7F 2A dddd dddd dddd
+DREM256 7F 0F dddd dddd
+DSACC .58:dd dddd
+DSCOPY 7F 46 dddd dddd
+DSFORG 7F 47 dddd
+DSHEAP 7F 4A dddd dddd
+DSPAGS 7F 4C dddd dddd dddd
+DSRTYP 7F 49 dddd dddd
+DSTOP 7F 4C
+DSWTYP 7F 48 dddd dddd
+ECWR 7F 0A dddd dddd dddd
+ENCOD 7F 30 dddd dddd
+EQU .2C:dd dddd
+EQUIM 7C vv dddd
+ERTAB 7F 1C
+ESTOP 7F 4B
+EXEC 7F 1D dddd
+EXTASK 7F 7B dddd
+FADD .38:dd dddd dddd
+FDIV .44:dd dddd dddd
+FEQU 7F 24 dddd dddd
+FLOOR 7F 63 dddd dddd
+FLSEQ .48:dd dddd
+FMOV .34:dd dddd
+FMUL .40:dd dddd dddd
+FNEG 7F 26 dddd
+FNONBL 7F 0E dddd dddd dddd
+FSLD 7F 60 dddd dddd dddd
+FSUB .3C:dd dddd dddd
+GADDR 7F 16 dddd dddd dddd
+GARB 7F 5F
+GCADDR 7F 17 dddd dddd dddd
+GCPOS 7F 43 dddd dddd
+GETC 7F 0D dddd dddd dddd
+GETTAB 7F 1A
+GETW 7E v1v2 dddd dddd
+GEXP 7F 61 dddd dddd
+GORET 7F 07
+GOSUB 7F 05 aaaa
+GW 7F 70 dddd dddd dddd
+HEAD vvvv (kein Opcode)
+HPSIZE 7F 5E dddd
+ID 7F 81 dddd dddd
+IMULT 7F 28 dddd dddd dddd
+INC .14:dd dddd
+INC1 .0C:dd
+INCETY 7F 41 dddd
+INCHAR 7F 40 dddd
+INFOPW 7F 51 dddd dddd dddd
+ISDIG 7F 11 dddd
+ISERR 7F 4E
+ISLCAS 7F 13 dddd
+ISLD 7F 12 dddd
+ISSHA 7F 18 dddd
+ISUCAS 7F 14 dddd
+ITRPL 7F 2E dddd dddd dddd
+ITSUB 7F 2D dddd dddd dddd
+KE 7F 06
+LN .00:vv und .04:vv
+LSEQ .30:dd dddd
+MOD 7F 2B dddd dddd dddd
+MOV .08:dd dddd
+MOVi FC vv dddd
+MOVii 7F 23 vvvv dddd
+MOVx 7D vv dddd dddd
+MOVxx 7F 21 vvvv dddd dddd
+MUL 7F 29 dddd dddd dddd
+NEG 7F 27 dddd
+NILDS 7F 45 dddd
+NXTDSP 7F 4B dddd dddd dddd
+OR 7F 7D dddd dddd dddd
+OUT 7F 3C dddd
+OUTF 7F 3E dddd dddd
+OUTFT 7F 3F dddd dddd dddd
+PAUSE 7F 42 dddd
+PCALL 7F 1F dddd
+PENTER FE vv
+PNACT 7F 76 dddd
+POS 7F 37 dddd dddd dddd
+POSF 7F 38 dddd dddd dddd dddd
+POSFT 7F 39 dddd dddd dddd dddd dddd
+POSIF 7F 3B dddd dddd dddd dddd dddd
+PP .6C:dd
+PPCALL 7F 7A dddd dddd dddd dddd
+PPROC 7F 1E mmmm
+PPV .68:dd
+PUTTAB 7F 1B
+PUTW FD v1v2 dddd dddd
+PW 7F 6F dddd dddd dddd
+REF .5C:dd dddd
+REPLAC 7F 34 dddd dddd dddd
+ROTATE 7F 53 dddd dddd
+RPCB 7F 50 dddd dddd
+RTN 7F 00
+RTNF 7F 02
+RTNT 7F 01
+RTRPL 7F 65 dddd dddd dddd
+RTSUB 7F 64 dddd dddd dddd
+SEL .64:dd vvvv dddd
+SEND 7F 71 dddd dddd dddd dddd
+SENDFT 7F 7F dddd dddd dddd dddd dddd
+SESSION 7F 7E dddd
+SETERR 7F 4D dddd
+SETNOW 7F 67 dddd
+SEXP 7F 62 dddd dddd
+STOP 7F 04
+STORAGE 7F 5A dddd dddd
+STRANL 7F 3A dddd dddd dddd dddd dddd dddd dddd
+SUB .20:dd dddd dddd
+SUBS .60:vv vvvv dddd dddd dddd
+SUBT1 7F 31 dddd dddd dddd
+SUBTF 7F 33 dddd dddd dddd
+SUBTFT 7F 32 dddd dddd dddd dddd
+SWCALL 7F 73 dddd dddd dddd dddd
+SYSG 7F 19
+SYSOP 7F 5B dddd
+TBEGIN 7F 6F dddd aaaaaa
+TCPU 7F 6A dddd dddd
+TEND 7F 70 dddd
+TEQU .50:dd dddd
+TEST .28:dd
+THALT 7F 6E dddd
+TLEN 7F 36 dddd dddd
+TLSEQ 7F 25 dddd dddd
+TMOV .4C:dd dddd
+TPBEGIN 7F 5F dddd dddd dddd aaaaaa
+TRPCB 7F 68 dddd dddd dddd
+TSTAT 7F 6B dddd dddd
+TWCPU 7F 52 dddd dddd
+TWPCB 7F 69 dddd dddd dddd
+ULSEQ .54:dd dddd
+WAIT 7F 72 dddd dddd dddd
+XOR 7F 79 dddd dddd dddd
+
+#page#
+#ub#3. Beschreibung der Pakete#ue#
+
+#ub#3.1 PACKET address#ue#
+
+Mit diesem Paket werden die Operationen fr 16 Bit Adressrechnung zur
+Verfgung gestellt.
+
+TEXT PROC hex8 (INT CONST dez) :
+ Der INT-Parameter (0..255) wird in eine 2-Zeichen Hexdarstellung
+ konvertiert.
+
+
+TEXT PROC hex16 (INT CONST dez) :
+ Der INT-Parameter (0..65535) wird in eine 4-Zeichen
+ Hexdarstellung (ohne Vorzeichen) konvertiert.
+
+
+INT PROC integer (TEXT CONST hex) :
+ Der TEXT-Parameter (1-4 Byte Hexdarstellung, 0..9, a..f/A..F) wird in eine
+ Dezimalzahl konvertiert.
+
+
+INT PROC getword (INT CONST segment, address) :
+ Das Wort an der Adresse 'address' (0..65535) im Segment 'segment' (0..7)
+ wird gelesen.
+
+
+PROC putword (INT CONST segment, address, value) :
+ Der Wert 'value' wird in das Wort an der Adresse 'address' (0..65535) im
+ Segment 'segment' (0..7) geschrieben.
+
+
+INT PROC cdbint (INT CONST address) :
+ Der Wert an der Adresse 'address' (0..32767 sinnvoll) im Segment 5
+ (permanente Compilertabellen) wird gelesen.
+
+
+TEXT PROC cdbtext (INT CONST address) :
+ Der String, der an der Adresse 'address' im Segment 5 (permanente
+ Compilertabellen) beginnt, wird als TEXT gelesen.
+
+
+PROC splitword (INT VAR word, lowbyte) :
+ Das Wort 'word' wird in den h”herwertigen und niederwertigen Teil zerlegt.
+ Das highbyte steht nach dieser Operation in 'word', das lowbyte in
+ 'lowbyte'.
+
+
+PROC makeword (INT VAR word, INT CONST lowbyte) :
+ word := word * 256 + lowbyte
+
+
+BOOL PROC ulseq (INT CONST left, right) :
+ '<=' fr positive INT-Zahlen (0..65535).
+
+
+OP INC (INT VAR word) :
+ 'word INCR 1' fr positive INT-Zahlen (0..65535), ohne daá ein šberlauf
+ auftritt.
+
+
+OP DEC (INT VAR word) :
+ 'word DECR 1' fr poistive INT-Zahlen (0..65535), ohne daá ein Unterlauf
+ auftritt.
+
+
+INT OP ADD (INT CONST left, right) :
+ 'left + right' fr positive INT-Zahlen (0..65535), ohne daá ein šberlauf
+ auftritt.
+
+
+INT OP SUB (INT CONST left, right) :
+ 'left - right' fr positive INT-Zahlen (0..65535), ohne daá ein šberlauf
+ auftritt.
+
+
+INT OP MUL (INT CONST left, right) :
+ 'left * right' fr positive INT-Zahlen (0..65535), ohne daá ein šberlauf
+ auftritt.
+
+
+#ub#3.2 PACKET table routines#ue#
+
+PROC init module table (TEXT CONST name) :
+ Ein benannter Datenraum ('name') wird eingerichtet. Dieser enth„lt die
+ aufbereitete Permanenttabelle fr schnelle Zugriffe. Die Datenstruktur
+ beschreibt drei Tabellen (PACKETTABLE, MODULETABLE, TYPETABLE), ber die
+ zu einer Modulnummer deren Name und deren Parameter, sowie der zugeh”rige
+ Paketname gefunden werden kann, wenn sie in der Permanenttabelle steht.
+ Die TYPETABLE enth„lt zu jedem TYPE, der in der Permanenttabelle steht,
+ seine GrӇe in Words.
+
+
+PROC add modules :
+ Module und Typen neu insertierter Pakete werden in die 'module table'
+ aufgenommen.
+
+
+PROC dump tables (TEXT CONST name) :
+ Der Inhalt der geladenen Modultabelle wird in der FILE 'name' ausgedumpt.
+
+
+TEXT PROC module name and specifications (INT CONST module number) :
+ Der Name und die Parameter des Moduls mit der Nummer 'module number'
+ (0..2047) wird als TEXT geliefert. Falls das Modul nicht in der
+ Permanenttabelle steht, wird niltext geliefert.
+
+
+TEXT PROC packetname (INT CONST module number) :
+ Der Name des Pakets, das das Modul mit der Nummer 'module number'
+ definiert, wird als TEXT geliefert. Falls das Modul nicht in der
+ Permanenttabelle steht, wird der Name des letzten vorher insertierten
+ Pakets geliefert (In manchen F„llen also nicht der wahre Paketname).
+
+
+INT PROC storage (TEXT CONST typename) :
+ Aus der Modultabelle wird GrӇe des TYPEs mit dem Namen 'typname' gelesen.
+ Wenn der Typ nicht in der Permanenttabelle steht, wird 0 geliefert.
+
+
+PROC getmodulenumber (INT VAR module number) :
+ Erfragt eine Modulnummer am Bildschirm. Der Benutzer kann entweder eine
+ Zahl eingeben oder den Namen einer PROC/OP. Wenn mehrere Module mit diesem
+ Namen existieren, wird eine Auswahlliste angeboten. In 'module number'
+ wird die ausgew„hlte Modulnummer bergeben.
+
+
+INT PROC codeaddress (INT CONST module number) :
+ Liefert die Anfangsadresse des Moduls mit der Nummer 'module number'.
+
+
+INT PROC codesegment (INT CONST module number) :
+ Liefert die Nummer des Codesegments, in dem der Code des Moduls mit der
+ Nummer 'module number' steht.
+
+
+INT PROC hash (TEXT CONST object name) :
+ Berechnet den Hashcode des Objekts 'object name', um ber die Hashtable,
+ Nametable, Permanenttable die Parameter eines Objekts zu suchen.
+
+
+#ub#3.3 PACKET eumel decoder#ue#
+
+#ub#3.3.1 Zugriff auf globale Parameter#ue#
+
+PROC default no runtime :
+ Bereitet den Decoder darauf vor, daá keine runtime vorliegt, d.h.
+ Stackzugriffe nicht sinnvoll sind. Fr Parameter mit lokalen Adressen
+ werden deshalb keine Variableninhalte dargestellt. Bei fast allen
+ Decoderaufrufen mit 'decode'/'decode module' bis auf die 'decode' mit
+ mehr als zwei Parametern, wird 'default no runtime' automatisch aufgerufen.
+
+
+PROC set parameters (INT CONST lbase, pbase, line number, c8k) :
+PROC get parameters (INT VAR lbase, pbase, line number, c8k) :
+ Einstell- und Informationsprozeduren (fr den Tracer). 'lbase' ist die
+ lokale Basis (Stackoffset fr dies Modul), 'pbase' ist das highbyte der
+ Paketbasis, 'line number' ist die letzte 'LN'-Zeilennummer, 'c8k' (cmod)
+ wird von EUMEL0 beim Eintritt in ein Modul auf
+ high (Modulstartaddresse + 16KB) gesetzt (fr Branch-Befehle).
+
+
+PROC pbase (INT CONST pbase highbyte) :
+INT PROC pbase :
+ Einstell- und Informationsprozeduren, nicht nur fr den Tracer. Die
+ Paketbasis (Globale Daten) wird gesetzt. Dazu wird nur das Highbyte (z.B.
+ nach 'PENTER') bergeben.
+
+
+PROC lbase (INT CONST local base) :
+ Einstellprozedur fr den Tracer. Stellt w„hrend der runtime die aktuelle
+ Basis ein. Wird der Decoder nicht w„hrend runtime betrieben, sollte
+ lbase(-1) eingestellt werden.
+
+
+INT PROC line number :
+ Liefert die letzte, mit 'LN' eingestellte, Zeilennummer.
+
+PROC list filename (TEXT CONST name) :
+ Stellt den Namens-Prefix der Outputfiles ein. Voreingestellt ist "". An
+ den Filename wird ".n" angeh„ngt, wobei n mit '0' beginnt.
+
+PROC bool result (BOOL CONST status) :
+BOOL PROC bool result :
+ Einstell- und Informationsprozeduren, die fr den Tracer ben”tigt werden.
+ Lieferte der letzte disassemblierte Befehl ein BOOL-Result ?
+
+PROC with object address (BOOL CONST status) :
+BOOL with object address :
+ Einstell- und Informationsprozeduren, nicht nur fr den Tracer. Sollen
+ auáer den Darstellungen der Speicherinhalte auch die Parameteradressen (in
+ spitzen Klammern) ausgegeben werden ?
+
+PROC with code words (BOOL CONST status) :
+BOOL PROC with code words :
+ Einstell- und Informationsprozeduren, nicht fr den Tracer. Sollen ab der
+ 80. Spalte in der Outputfile die Hexdarstellungen der dekodierten
+ Codew”rter ausgegeben werden ?
+
+
+#ub#3.3.2 Aufruf des Disassemblers#ue#
+
+PROC decode :
+ Aufruf des Decoders. Die Modulnummer der ersten zu dekodierenden Prozedur
+ wird erfragt. Die Modultabelle wird ggf. erg„nzt, es wird 'default no
+ runtime' eingestellt.
+
+
+PROC decode (INT CONST first module number) :
+ Aufruf des Decoders. Die Modulnummer der ersten zu dekodierenden Prozedur
+ wird bergeben. Die Modultabelle wird ggf. erg„nzt, es wird 'default no
+ runtime' eingestellt.
+
+
+PROC decode (INT CONST segment, address) :
+ Aufruf des Decoders. Die Disassemblierung beginnt in dem
+ Codesegment/Adresse, das/die als Parameter bergeben wird. Die Modultabelle
+ wird ggf. erg„nzt, es wird 'default no runtime' eingestellt.
+
+
+PROC decode (INT CONST segment, INT VAR address, INT CONST to addr,
+ BOOL CONST only one module) :
+ Dieser Decoderaufruf setzt kein 'default no runtime', erweitert aber ggf.
+ die Modultabelle. Der bei 'address' beginnende und bei 'to addr' endende
+ Adressbereich im Codesegment 'segment' wird dekodiert. Ist 'only one
+ module' TRUE, wird nur bis zum Ende des aktuellen Moduls dekodiert.
+ 'address' zeigt nach dem Prozeduraufruf auf die n„chste Instruktion nach
+ 'to addr'.
+
+
+PROC decode (INT CONST segment, INT VAR address, TEXT VAR words,
+ instruction, INT PROC (INT CONST, INT VAR, TEXT VAR) next word)):
+ Diese Prozedur ist das Herz des Decoders. Sie disassembliert eine
+ Instruktion, die im Codesegment 'segment', Adresse 'address' beginnt und
+ legt die mit 'nextword' gelesenen W”rter als Hexdarstellung in 'words' ab.
+ Die dekodierte Instruktion steht dann in 'instruction'. Vor dem Aufruf
+ dieser Prozedur sollte 'words' und 'instruction' niltext zugewiesen werden.
+ Die passende Prozedur 'nextword' wird auch vom 'eumel decoder'
+ herausgereicht. 'address' zeigt nach der Ausfhrung des Befehls auf die
+ n„chste Instruktion.
+
+
+PROC decodemodule :
+ Wie 'decode', nur wird bis nur zum Ende des gewnschten Moduls
+ disassembliert.
+
+
+PROC decodemodule (INT CONST module number) :
+ Wie 'decode', nur wird bis nur zum Ende des gewnschten Moduls
+ disassembliert.
+
+
+#ub#3.3.3 Weitere Prozeduren#ue#
+
+PROC nextmoduleheader (INT CONST segment, INT CONST address,
+ INT VAR header address, module number) :
+ Diese Prozedur findet ab der angegeben Adresse ('segment'/'address') den
+ Anfang des n„chsten Moduls. In 'header address' wird die Startadresse des
+ gefundenen Moduls geliefert (bleibt im Segment 'segment'), in 'module
+ number' die Nummer des gefundenen Moduls.
+
+
+INT PROC next word (INT CONST segment, INT VAR address, TEXT VAR words) :
+ Diese Prozedur liefert das durch 'segment'/'address' angegeben Wort, h„ngt
+ die Hexdarstellung dieses Wortes an 'words' an und erh”ht 'address' um
+ eins.
+
+
+TEXT PROC data representation (INT CONST data addr, segment, address, type):
+ Diese Prozedur liefert die Darstellung des Parameters 'data addr' ggf. mit
+ Adresse (--> with object address). 'segment'/'address' bezeichnet die
+ Position, an der die Instruktion fr diesen Parameter steht. 'type' ist
+ ein (durch die Instruktion festgelegter) Typ des Parameters, mit dem die
+ Art der Darstellung gew„hlt wird (TEXT, REAL, INT, ...). Im Gegensatz zu
+ 'object representation' braucht bei dieser Prozedur keine Darstellung
+ vorhanden sein. In diesem Falle wird nur z.B. der Stackoffset '<L n>'
+ ausgegeben.
+
+
+TEXT PROC object representation (INT CONST data segment, data address,
+ segment, address, type) :
+ Diese Prozedur wird von 'data representation' aufgerufen und liefert die
+ Darstellung des Parameters. In 'data segment'/'data address' wird die
+ Anfangsadresse der darzustellenden Daten bergeben. Die anderen drei
+ Parameter verhalten sich wie bei 'data representation'.
+
+
+TEXT PROC last actual parameter :
+ Liefert den Wert (nach TEXT konvertiert) des letzten dekodierten aktuellen
+ Parameters (am sinnvollsten w„hrend runtime). Diese prozedur wird vom
+ Tracer benutzt.
+
+
+#ub#3.4 PACKET tracer#ue#
+
+#ub#3.4.1 Zugriff auf globale Parameter#ue#
+
+
+PROC prot file (TEXT CONST filename) :
+TEXT PROC prot file :
+ Einstell- und Informationsprozeduren fr den Namen der Protokollfile.
+ Wird ein 'filename' ungleich niltext eingestellt, dann werden die
+ dekodierten Instruktionen w„hrend der Ablaufverfolgung zus„tzlich in diese
+ File geschrieben.
+
+
+PROC source file (TEXT CONST filename) :
+TEXT PROC source file :
+ Einstell- und Informationsprozeduren fr den Namen der Quelltextdatei.
+ Wird ein 'filename' ungleich niltext eingestellt, dann wird nach dem
+ Ausfhren eines 'LN'-Befehls (LineNumber) die Zeile mit dieser Nummer aus
+ der Quelldatei gelesen und parallel zur dekodierten EUMEL0-Instruktion
+ angezeigt.
+
+
+PROC tracer channel (INT CONST) :
+INT PROC tracerchannel :
+ Einstell- und Informationsprozeduren fr den Kanal, an dem das Programm
+ ausgefhrt werden soll. Die Ablaufverfolgung bleibt an dem Kanal, an dem
+ die PROC/OP aufgerufen wurde.
+
+
+#ub#3.4.2 Aufruf des Tracers#ue#
+
+ Eine PROC/OP, in der ein Breakpoint gesetzt wurde, kann zum Beispiel im
+ Monitor aufgerufen werden. Ab der Adresse, an der der Breakpoint gesetzt
+ wurde, kann die Abarbeitung des Codes verfolgt werden. Das Setzen der
+ Breakpoints geschieht mit 'set breakpoint'.
+
+
+PROC trace :
+ Diese Prozedur erfragt vom Benutzer die PROC/OP, bei der der die
+ Ablaufverfogung beginnen soll. Anschlieáend muá der Aufruf der PROC/OP
+ eingegeben werden. Der Benutzer wird auáerdem nach dem Namen der
+ compilierten Quelldatei, dem Namen der Protokollfile und dem
+ Abarbeitungskanal gefragt. Nachdem alle Angaben gemacht worden sind, wird
+ der PROC/OP-Aufruf mit 'do' ausgefhrt.
+
+
+PROC set breakpoint :
+ Die Modultabelle wird ggf. erweitert, der Benutzer wird nach dem Namen
+ einer PROC/OP gefragt, deren Codeabarbeitung verfolgt werden soll. Der Code
+ dieser PROC/OP muá im Codesegment 3 stehen (sonst erfolgt ein 'errorstop').
+ Der Protokoll- und Sourcefilename werden auf niltext gesetzt.
+
+
+PROC set breakpoint (INT CONST breakpointnr, address) :
+ Setzt an der bergebenen Codeadresse im Segment 3 einen Breakpoint der
+ beiden Breakpoints (1 oder 2 als 'breakpointnr'). Der Benuzter ist selbst
+ dafr verantwortlich daá
+ - dies nicht die Einsprungsadresse eines Moduls ist (HEAD-Instruktion),
+ - die bergebene Adresse das erste (Opcode-) Wort einer Instruktion ist,
+ - vor dem Aufruf des Moduls die Paketbasis korrekt gesetzt ist, falls
+ vor der ersten Instruktion mit Parametern kein 'PENTER' ausgefhrt wird.
+
+
+PROC reset breakpoints :
+ Die Breakpoints werden zurckgesetzt und der (wegen des Breakpointhandler-
+ CALLs) gesicherte Code wieder an seinen Originalplatz zurckgeschrieben.
+
+
+PROC reset breakpoint (INT CONST breakpointnr) :
+ Es wird nur gezielt der eine Breakpoint mit der Nummer 'breakpointnr'
+ zurckgesetzt.
+
+
+PROC list breakpoints :
+ Der Status, die Adresse und der gesicherte Code (an dieser Adresse) werden
+ fr beide Breakpoints gelistet.
diff --git a/devel/debugger/1.8.2/src/DEBUGGER.ELA b/devel/debugger/1.8.2/src/DEBUGGER.ELA new file mode 100644 index 0000000..fddde7d --- /dev/null +++ b/devel/debugger/1.8.2/src/DEBUGGER.ELA @@ -0,0 +1,3151 @@ +(*************************************************************************)
+(** **)
+(* EUMEL - Debugger: (C) Michael Staubermann, Oktober/November '86 *)
+(* Ab EUMEL 1.7.5.4 *)
+(* Stand: 01.12.86, 1.8.2: 26.07.88 *)
+(* Noch keine BOUND-Variablen-Zugriffe implementiert *)
+(** **)
+(*************************************************************************)
+
+
+PACKET address DEFINES ADD, (* 1.7.5 861006 *)
+ SUB, (* 1.8.0 861022 *)
+ MUL, (* M. Staubermann*)
+ INC,
+ DEC,
+ ulseq,
+
+ split word ,
+ make word ,
+
+ hex16,
+ hex8 ,
+ integer ,
+
+ cdbint ,
+ cdbtext ,
+
+ get word ,
+ put word :
+
+
+(*********************** Hex-Konvertierung ********************************)
+
+LET hex digits = "0123456789ABCDEF" ;
+
+PROC paket initialisierung :
+ (* Paketinitialisierung, wird nur einmal durchlaufen *)
+ INT CONST ulseq addr :: getword (0, 512 +
+ mod nr (BOOL PROC (INT CONST, INT CONST) ulseq)) ADD 2 ;
+ IF getword (3, ulseq addr) = integer ("B009") (* bei checkoff LSEQ *)
+ THEN putword (3, ulseq addr, integer ("D409")) (* ULSEQ <LR 4> *)
+ ELIF getword (3, ulseq addr ADD 1) = integer ("B009") (* bei checkon *)
+ THEN putword (3, ulseq addr ADD 1, integer ("D409"))
+ FI
+
+ENDPROC paket initialisierung ;
+
+INT PROC integer (TEXT CONST hex) :
+ INT VAR summe := 0, i ;
+ FOR i FROM 1 UPTO min (4, LENGTH hex) REP
+ rotate (summe, 4) ;
+ summe INCR digit
+ PER ;
+ summe .
+
+digit :
+ TEXT CONST char := hex SUB i ;
+ IF char >= "a" THEN code (char) - 87
+ ELIF char >= "A" THEN code (char) - 55
+ ELSE code (char) - 48
+ FI
+
+ENDPROC integer ;
+
+TEXT PROC hex8 (INT CONST wert) :
+ (hex digits SUB ((wert DIV 16) +1)) +
+ (hex digits SUB ((wert AND 15) +1))
+
+ENDPROC hex8 ;
+
+TEXT PROC hex16 (INT CONST wert) :
+ TEXT VAR result := "" ;
+ INT VAR i, w := wert ;
+ FOR i FROM 1 UPTO 4 REP
+ rotate (w, 4) ;
+ result CAT (hex digits SUB ((w AND 15)+1))
+ PER ;
+ result
+
+ENDPROC hex16 ;
+
+(***************************** Adressarithmetik ***************************)
+
+PROC arith 15 :
+
+ EXTERNAL 91
+
+ENDPROC arith 15 ;
+
+
+PROC arith 16 :
+
+ EXTERNAL 92
+
+ENDPROC arith 16 ;
+
+
+OP INC (INT VAR a) :
+ arith 16 ;
+ a INCR 1
+
+ENDOP INC ;
+
+
+OP DEC (INT VAR a) :
+ arith 16 ;
+ a DECR 1
+
+ENDOP DEC ;
+
+
+INT OP ADD (INT CONST left, right) :
+ arith 16 ;
+ left + right
+
+ENDOP ADD ;
+
+INT OP SUB (INT CONST left, right) :
+ arith16 ;
+ left - right
+
+ENDOP SUB ;
+
+INT OP MUL (INT CONST left, right) :
+ arith 16 ;
+ left * right (* Multiplikation MOD 65536 im Gegensatz zu IMULT *)
+
+ENDOP MUL ;
+
+BOOL PROC ulseq (INT CONST left, right) :
+ left <= right (* Muá leider(!!) auf ULSEQ Code gepatcht werden *)
+ENDPROC ulseq ;
+
+(*************************** Wortoperationen ******************************)
+
+PROC split word (INT VAR word and high byte, low byte) :
+
+ EXTERNAL 15
+
+ENDPROC split word ;
+
+
+PROC make word (INT VAR highbyte and resultword, INT CONST low byte) :
+
+ EXTERNAL 16
+
+ENDPROC make word ;
+
+
+(************************** DS4-Access ***********************************)
+
+INT PROC cdbint (INT CONST adr) :
+
+ EXTERNAL 116
+
+ENDPROC cdbint ;
+
+
+TEXT PROC cdbtext (INT CONST adr) :
+
+ EXTERNAL 117
+
+ENDPROC cdbtext ;
+
+
+PROC putword (INT CONST segment, adr, value) :
+
+ EXTERNAL 119
+
+ENDPROC put word ;
+
+
+INT PROC getword (INT CONST segment, adr) :
+
+ EXTERNAL 120
+
+ENDPROC getword ;
+
+
+INT PROC mod nr (BOOL PROC (INT CONST, INT CONST) proc) :
+
+ EXTERNAL 35
+
+ENDPROC mod nr ;
+
+
+paket initialisierung
+
+ENDPACKET address ;
+
+(**************************************************************************)
+
+PACKET table routines DEFINES (* Fr eumel decoder 861017 *)
+ (* 1.8.0 by M.Staubermann *)
+ code segment ,
+ code address ,
+ packet name ,
+ module name and specifications ,
+ get module number ,
+ storage ,
+ hash ,
+ init module table,
+ add modules ,
+ dump tables :
+
+
+LET end of hash table = 1023 ,
+ begin of permanent table = 22784 ,
+ begin of pt minus ptt limit = 12784 ,
+ end of permanent table = 32767 ,
+
+ permanent param const = 10000 ,
+ permanent param var = 20000 ,
+ permanent proc op = 30000 ,
+ permanent type = 30000 ,
+ permanent row = 10 ,
+ permanent struct = 11 ,
+ permanent param proc = 12 ,
+ permanent struct end = 0 ,
+
+ ptt limit = 10000 ,
+
+ void = 0 ,
+
+ const = 1 ,
+ var = 2 ,
+
+ sysgenoff module number = 1280 ,
+ start of module number link table = 512 ,
+ highest module number 1 = 2048 ,
+ max packets = 128 ,
+ max types = 64 ;
+
+
+LET MODULETABLE = ROW highest module number 1
+ STRUCT (TEXT name, specifications, INT packet link) ,
+ PACKETTABLE = ROW max packets STRUCT (TEXT name, INT permanent address),
+ TYPETABLE = STRUCT (THESAURUS names, ROW max types INT storage),
+ TABLETYPE = BOUND STRUCT (MODULETABLE module, PACKETTABLE packet,
+ TYPETABLE types, INT number of packets,
+ end of permanent table) ;
+
+TABLETYPE VAR table ;
+
+TEXT VAR type and mode, result ;
+BOOL VAR end of params ;
+INT VAR mode, paramlink, index ;
+
+(************************* Module- und Packettablezugriff **************)
+
+PROC init module table (TEXT CONST table name) :
+ forget (table name, quiet) ;
+ table := new (table name) ;
+ table.number of packets := 0 ;
+ table.end of permanent table := begin of permanent table ;
+
+ table.types.names := empty thesaurus ;
+ insert (table.types.names, "INT", index) ;
+ table.types.storage (index) := 1 ;
+ insert (table.types.names, "REAL", index) ;
+ table.types.storage (index) := 4 ;
+ insert (table.types.names, "BOOL", index) ;
+ table.types.storage (index) := 1 ;
+ insert (table.types.names, "TEXT", index) ;
+ table.types.storage (index) := 8 ;
+ insert (table.types.names, "DATASPACE", index) ;
+ table.types.storage (index) := 1 ;
+
+ scan permanent table (table.end of permanent table) ;
+ scan hash table (begin of permanent table) ;
+
+ENDPROC init module table ;
+
+
+PROC add modules :
+ INT CONST old end of permanent table := table.end of permanent table ;
+ IF cdbint (table.end of permanent table) <> -3
+ THEN scan permanent table (table.end of permanent table) ;
+ scan hash table (old end of permanent table)
+ FI
+
+ENDPROC add modules ;
+
+
+PROC scan hash table (INT CONST minimum permanent address) :
+ INT VAR hash table pointer ;
+ FOR hash table pointer FROM 0 UPTO end of hash table REP
+ IF cdbint (hash table pointer) <> 0
+ THEN cout (hash table pointer) ;
+ list all name table objects with this hash code (hash table pointer,
+ minimum permanent address)
+ FI
+ PER
+
+ENDPROC scan hash table ;
+
+
+PROC list all name table objects with this hash code (INT CONST link,
+ minimum permanent address) :
+ TEXT VAR object name ;
+ INT VAR name table pointer := first link word, module nr,
+ permanent pointer ;
+ WHILE NOT end of name table chain REPEAT
+ permanent pointer := cdb int (nametable pointer + 1) ;
+ WHILE permanent pointer >= minimum permanent address REP
+ object name := cdbtext (name table pointer + 2) ;
+ IF permanent type definition
+ THEN insert (table.types.names, object name, index) ;
+ table.types.storage (index) := cdb int (permanent pointer + 2)
+ ELSE get specifications (permanent pointer) ;
+ module nr := cdb int (param link + 1) + 1;
+ table.module (module nr).name := object name ;
+ table.module (module nr).specifications := result;
+ table.module (module nr).packet link := packetlink(permanentpointer)
+ FI ;
+ permanent pointer := cdb int (permanent pointer)
+ PER ;
+ name table pointer := cdb int (name table pointer)
+ END REPEAT .
+
+first link word :
+ cdb int (link) .
+
+end of name table chain :
+ name table pointer = 0 .
+
+permanent type definition :
+ (object name SUB 1) <= "Z" AND (object name SUB 1) >= "A" AND
+ cdbint (permanent pointer + 1) = permanent type
+
+END PROC list all name table objects with this hash code ;
+
+
+INT PROC packet link (INT CONST permanent address) :
+ INT VAR packet pointer ;
+ FOR packet pointer FROM 1 UPTO table.number of packets REP
+ IF table.packet (packet pointer).permanent address > permanent address
+ THEN LEAVE packet link WITH packet pointer -1
+ FI
+ PER ;
+ table.number of packets
+
+ENDPROC packet link ;
+
+
+PROC scan permanent table (INT VAR permanent pointer) :
+ FOR permanent pointer FROM permanent pointer UPTO end of permanent table
+ WHILE cdbint (permanent pointer) <> -3 REP
+ IF cdbint (permanent pointer) = -2
+ THEN cout (permanent pointer) ;
+ table.number of packets INCR 1 ;
+ table.packet (table.number of packets).name :=
+ cdbtext (cdbint (permanent pointer +1) +2) ;
+ table.packet (table.number of packets).permanent address :=
+ permanent pointer
+ FI
+ PER
+
+ENDPROC scan permanent table ;
+
+
+PROC dump tables (TEXT CONST file name) :
+ INT VAR i ;
+ forget (filename, quiet) ;
+ FILE VAR f := sequentialfile (output, filename) ;
+ maxline length (f, 1000) ;
+
+ putline (f, "PACKETTABLE:") ;
+ put (f, "End of Permanenttable:") ;
+ put (f, hex16 (table.end of permanent table)) ;
+ line (f) ;
+ putline (f, "Nr. Packetname") ;
+ FOR i FROM 1 UPTO table.number of packets REP
+ cout (i) ;
+ put (f, text (i, 3)) ;
+ put (f, hex16 (table.packet (i).permanent address)) ;
+ putline (f, table.packet (i).name)
+ PER ;
+ line (f, 2) ;
+ putline (f, "TYPETABLE:") ;
+ putline (f, " Size Name") ;
+ index := 0 ;
+ get (table.types.names, type and mode, index) ;
+ WHILE index > 0 REP
+ put (f, text (table.types.storage (index), 5)) ;
+ putline (f, type and mode) ;
+ get (table.types.names, type and mode, index)
+ PER ;
+ line (f, 2) ;
+ putline (f, "MODULETABLE:") ;
+ putline (f, "Modnr.PNr.Name and Parameters") ;
+ FOR i FROM 1 UPTO highest module number 1 REP
+ IF table.module (i).packet link <> -1
+ THEN cout (i) ;
+ put (f, text (i-1, 5)) ;
+ put (f, text (table.module (i).packet link, 3)) ;
+ put (f, table.module (i).name) ;
+ putline (f, table.module (i).specifications) ;
+ FI
+ PER
+
+ENDPROC dump tables ;
+
+
+INT PROC storage (TEXT CONST typename) :
+ index := link (table.types.names, typename) ;
+ IF index = 0
+ THEN 0
+ ELSE table.types.storage (index)
+ FI
+
+ENDPROC storage ;
+
+
+TEXT PROC module name and specifications (INT CONST module number) :
+ IF LENGTH table.module (module number + 1).name > 0
+ THEN table.module (module number + 1).name + " " +
+ table.module (module number + 1).specifications
+ ELSE ""
+ FI
+
+ENDPROC module name and specifications ;
+
+
+TEXT PROC packet name (INT CONST module number) :
+ IF table.module (module number + 1).packet link > 0
+ THEN table.packet (table.module (module number + 1).packet link).name
+ ELSE FOR index FROM module number DOWNTO 1 REP
+ IF table.module (index).packet link > 0
+ THEN LEAVE packet name WITH table.packet (table.module
+ (index).packet link).name
+ FI
+ PER ;
+ ""
+ FI
+
+ENDPROC packet name ;
+
+
+(************************ Modulnummern ***********************************)
+
+INT PROC code segment (INT CONST module number) :
+ IF module number < sysgen off module number
+ THEN 2
+ ELSE 3
+ FI
+
+ENDPROC code segment ;
+
+
+INT PROC code address (INT CONST module number) :
+ get word (0, start of module number link table + module number)
+ENDPROC code address ;
+
+
+PROC get module number (INT VAR module number) :
+ TEXT VAR object ;
+ INT VAR anz objects, name table pointer, permanent pointer ;
+ put ("Name oder Modulnummer der PROC/OP:") ;
+ getline (object) ;
+ changeall (object, " ", "") ;
+ IF object = ""
+ THEN LEAVE get module number
+ FI ;
+ disablestop ;
+ module number := int (object) ;
+ IF NOT iserror AND last conversion ok AND module number >= -1 AND
+ module number < 2048
+ THEN LEAVE get module number
+ FI ;
+ clear error ;
+ enablestop ;
+ anz objects := 0 ;
+ FILE VAR f := notefile ;
+ maxlinelength (f, 1000) ;
+ note ("Modulnummer des gewnschten Objekts merken und ESC q tippen.") ;
+ noteline ;
+ noteline ;
+ module number := -1 ;
+ scan permanent table chain with object name ;
+ IF anz objects > 1
+ THEN note edit ;
+ put ("Modulnummer der PROC/OP:") ;
+ get (module number)
+ ELSE type (""27"q") ;
+ note edit
+ FI .
+
+scan permanent table chain with object name :
+ name table pointer := first link word ;
+ WHILE NOT end of name table chain REP
+ IF cdb text (name table pointer + 2) = object
+ THEN permanent pointer := cdb int (nametable pointer + 1) ;
+ IF NOT permanent type definition
+ THEN run through permanent chain
+ FI ;
+ FI ;
+ name table pointer := cdb int (name table pointer)
+ PER .
+
+run through permanent chain :
+ WHILE permanent pointer <> 0 REP
+ anz objects INCR 1 ;
+ cout (anz objects) ;
+ get specifications (permanent pointer) ;
+ IF anz objects = 1
+ THEN module number := module nr
+ FI ;
+ note (text (module nr, 4)) ;
+ note (" ") ;
+ note (object) ;
+ note (" ") ;
+ note (result) ;
+ noteline ;
+ permanent pointer := cdbint (permanent pointer)
+ PER .
+
+module nr :
+ cdb int (param link + 1) .
+
+first link word :
+ cdb int (hash (object)) .
+
+end of name table chain :
+ name table pointer = 0 .
+
+permanent type definition :
+ (object SUB 1) <= "Z" AND (object SUB 1) >= "A" AND
+ cdbint (permanent pointer + 1) = permanent type
+
+ENDPROC get module number ;
+
+
+(************************* Permanenttabellenzugriffe **********************)
+
+INT PROC hash (TEXT CONST obj name) :
+ INT VAR i, hash code ;
+ hash code := 0 ;
+ FOR i FROM 1 UPTO LENGTH obj name REP
+ addmult cyclic
+ PER ;
+ hash code .
+
+addmult cyclic :
+ hash code INCR hash code ;
+ IF hash code > end of hash table THEN wrap around FI ;
+ hash code := (hash code + code (obj name SUB i)) AND end of hash table .
+
+wrap around :
+ hash code DECR end of hash table
+
+ENDPROC hash ;
+
+
+PROC next pt param :
+ mode := cdb int (param link) MOD ptt limit ;
+ param link INCR 1 ;
+ IF mode = permanent row
+ THEN skip over permanent row
+ ELIF mode = permanent struct
+ THEN skip over permanent struct
+ FI ;
+ set end marker if end of list .
+
+skip over permanent row :
+ param link INCR 1 ; (* Skip row size *)
+ next pt param .
+
+skip over permanent struct :
+ mode := cdbint (param link) ;
+ WHILE mode <> permanent struct end REP
+ next pt param ;
+ mode := cdbint (param link)
+ PER ;
+ param link INCR 1 (* skip permanent struct end *)
+
+ENDPROC next pt param ;
+
+
+PROC set end marker if end of list :
+ mode := cdb int (param link) ;
+ end of params := mode >= permanent proc op OR mode <= 0
+
+ENDPROC set end marker if end of list ;
+
+
+PROC get type and mode (INT VAR type) :
+ mode := cdb int (param link) ;
+ IF mode = permanent param proc
+ THEN type of param proc
+ ELSE type of object
+ FI .
+
+type of param proc :
+ param link INCR 1 ;
+ get type and mode (type) ;
+ mode := permanent param proc .
+
+type of object :
+ IF mode < 0
+ THEN type := 2769 + (32767 + mode) ;
+ mode := 0
+ ELSE type := mode MOD ptt limit ;
+ mode DECR type ;
+ translate type if necessary ;
+ translate mode if necessary
+ FI .
+
+translate type if necessary :
+ IF permanent row or struct THEN translate type FI .
+
+translate type :
+ type := param link - begin of pt minus ptt limit .
+
+translate mode if necessary :
+ IF mode = permanent param const
+ THEN mode := const
+ ELIF mode = permanent param var
+ THEN mode := var
+ FI .
+
+permanent row or struct :
+ type = permanent row OR type = permanent struct
+
+ENDPROC get type and mode ;
+
+
+PROC get specifications (INT CONST permanent pointer) :
+ result := "" ;
+ to first param ;
+ IF NOT end of params THEN put param list FI ;
+ get result .
+
+to first param :
+ param link := permanent pointer + 1 ;
+ set end marker if end of list .
+
+get result :
+ INT VAR type;
+ get type and mode (type) ;
+ IF type <> void
+ THEN type and mode := " --> " ;
+ name of type (type) ;
+ result CAT type and mode
+ FI
+
+ENDPROC get specifications ;
+
+
+PROC put param list :
+ result CAT "(" ;
+ REP
+ INT VAR type;
+ get type and mode (type) ;
+ put type and mode ;
+ maybe param proc ;
+ next pt param ;
+ IF end of params
+ THEN result CAT ")" ;
+ LEAVE put param list
+ FI ;
+ result CAT ", " ;
+ PER .
+
+put type and mode :
+ INT CONST mode1 :: mode ;
+ type and mode := "" ;
+ name of type (type) ;
+ type and mode CAT name of mode ;
+ result CAT type and mode .
+
+name of mode :
+ IF mode1 = const THEN " CONST"
+ ELIF mode1 = var THEN " VAR"
+ ELIF type = void THEN "PROC"
+ ELSE " PROC"
+ FI .
+
+maybe param proc :
+ IF mode = permanent param proc THEN put virtual params FI .
+
+put virtual params :
+ skip over result type if complex type ;
+ IF NOT end of virtual params
+ THEN result CAT " " ;
+ put param list
+ FI .
+
+skip over result type if complex type :
+ next pt param .
+
+end of virtual params :
+ end of params
+
+ENDPROC put param list ;
+
+
+PROC name of type (INT CONST type) :
+ LET int = 1 ,
+ real = 2 ,
+ string = 3 ,
+ bool = 5 ,
+ bool result = 6 ,
+ dataspace = 7 ;
+
+ SELECT type OF
+ CASE void :
+ CASE int : type and mode CAT "INT"
+ CASE real : type and mode CAT "REAL"
+ CASE string : type and mode CAT "TEXT"
+ CASE bool,
+ bool result : type and mode CAT "BOOL"
+ CASE dataspace : type and mode CAT "DATASPACE"
+ OTHERWISE complex type
+ ENDSELECT .
+
+complex type :
+ IF type > ptt limit THEN perhaps permanent struct or row
+ ELSE get complex type
+ FI .
+
+perhaps permanent struct or row :
+ index := type + begin of pt minus ptt limit ;
+ mode := cdb int (index) MOD ptt limit ;
+ IF mode = permanent row THEN get permanent row
+ ELIF mode = permanent struct THEN get permanent struct
+ ELSE type and mode CAT "-"
+ FI .
+
+get complex type :
+ index := type + begin of permanent table ;
+ IF is complex type
+ THEN get name
+ ELSE type and mode CAT "<HIDDEN>"
+ FI .
+
+is complex type :
+ permanent type definition mode = permanent type .
+
+get name :
+ type and mode CAT cdb text (link to type name + 2) .
+
+link to type name :
+ cdb int (index + 3) .
+
+permanent type definition mode :
+ cdb int (index + 1) .
+
+get permanent row :
+ INT VAR t;
+ type and mode CAT "ROW " ;
+ type and mode CAT text (cdb int (index + 1)) ;
+ type and mode CAT " " ;
+ param link := index + 2 ;
+ get type and mode (t) ;
+ name of type (t) .
+
+get permanent struct :
+ type and mode CAT "STRUCT (" ;
+ param link := index + 1 ;
+ WHILE within permanent struct REP
+ get type and mode (t) ;
+ name of type (t) ;
+ next pt param ;
+ IF within permanent struct
+ THEN type and mode CAT ", "
+ FI
+ PER ;
+ type and mode CAT ")" .
+
+within permanent struct :
+ cdbint (param link) <> permanent struct end .
+
+ENDPROC name of type ;
+
+
+ENDPACKET table routines ;
+
+
+(*************************************************************************)
+
+PACKET eumel decoder DEFINES (* M. Staubermann, M„rz/April 86 *)
+ (* 1.8.0 861201 *)
+ (* 1.8.2 880726 *)
+ lbase ,
+ pbase ,
+ set parameters ,
+ get parameters ,
+ default no runtime ,
+ bool result ,
+ line number ,
+ list file name ,
+ last actual parameter ,
+ with code words ,
+ with object address ,
+
+ next word ,
+ next module header ,
+ data representation ,
+ object representation ,
+
+ decode module ,
+ decode :
+
+
+LET packet data segment = 0 ,
+ local data segment = 1 ,
+ standard dataspace = 0 , (* ds = 4 *)
+
+ first elan address = 13 584 , (* codeaddress (273) *)
+ begin of stringtable = 1 024 ,
+ begin of nametable = 4 096 ,
+ end of nametable = 22 783 ;
+
+LET try type = 0 , {?}
+ int addr = 10 , {I}
+ real addr = 19 , {R}
+ text addr = 20 , {S}
+ dataspace addr = 5 , {D}
+ task addr = 21 , {T}
+ ref addr = 1 , {@}
+ mod addr = 2 , {A}
+ bool addr = 3 , {B}
+ int value = 23 , {V}
+ hexbyte value = 9 , {H}
+ module nr value = 14 ; {M}
+
+LET OPN = STRUCT (TEXT mnemonic, params, BOOL bool result) ,
+ PRIMOP = ROW 31 OPN ,
+ SPECIALOP = ROW 6 OPN ,
+ ESCOP = ROW 130 OPN ,
+
+ rtnt opcode = 32513 ,
+ rtnf opcode = 32514 ;
+
+LET hex 3fff = 16 383 ,
+ hex 03ff = 1 023 ,
+ hex 0400 = 1 024 ,
+ hex 7c = 124 ,
+ hex 7f = 127 ,
+ hex f0 = 240 ,
+ hex fd = 253 ,
+ hex ff = 255 ;
+
+INT CONST hex 83ff :: -31745 ,
+ hex ff00 :: -256 ,
+ hex fff8 :: -8 ,
+ minus one :: -1 ;
+
+FILE VAR list file ;
+TEXT VAR file name := "" ,
+ text val := "" ;
+INT VAR file number := 0 ,
+ data base ,
+ ln := minus one ,
+ lbas := minus one ,
+ cmod := minus one ;
+
+BOOL VAR was bool result ,
+ echo ,
+ with statement line := TRUE ,
+ with object and address := TRUE ;
+
+
+INT PROC line number :
+ ln
+ENDPROC line number ;
+
+
+TEXT PROC last actual parameter :
+ text val
+ENDPROC last actual parameter ;
+
+
+PROC pbase (INT CONST i) :
+ data base := i ;
+ makeword (data base, 0)
+ENDPROC pbase ;
+
+
+INT PROC pbase :
+ INT VAR lowbyte, highbyte := data base ;
+ split word (highbyte, lowbyte) ;
+ highbyte
+ENDPROC pbase ;
+
+
+PROC lbase (INT CONST i) :
+ lbas := i
+ENDPROC lbase ;
+
+
+BOOL PROC bool result :
+ was bool result
+ENDPROC bool result ;
+
+
+BOOL PROC with object address :
+ with object and address
+ENDPROC with object address ;
+
+
+PROC with object address (BOOL CONST b) :
+ with object and address := b
+ENDPROC with object address ;
+
+
+PROC with codewords (BOOL CONST b) :
+ with statement line := b
+ENDPROC with codewords ;
+
+
+BOOL PROC with codewords :
+ with statement line
+ENDPROC with codewords ;
+
+
+PROC bool result (BOOL CONST b) :
+ was bool result := b
+ENDPROC bool result ;
+
+
+PROC list file name (TEXT CONST name) :
+ file name := name
+ENDPROC list file name ;
+
+
+PROC set parameters (INT CONST lbase, pbas, line number, codmod) :
+ lbas := lbase ;
+ pbase (pbas) ;
+ ln := line number ;
+ cmod := codmod
+ENDPROC set parameters ;
+
+
+PROC get parameters (INT VAR lbase, pbas, line number, codmod) :
+ lbase := lbas ;
+ pbas := pbase ;
+ line number := ln ;
+ codmod := cmod
+ENDPROC get parameters ;
+
+
+PROC default no runtime :
+ lbas := minus one ;
+ ln := minus one ;
+ database := minus one ;
+ cmod := minus one
+ENDPROC default no runtime ;
+
+
+PRIMOP CONST primop := PRIMOP :(
+ OPN :("LN ", "V", FALSE), (* 1 *)
+ OPN :("LN1 ", "V", FALSE),
+ OPN :("MOV ", "II", FALSE),
+ OPN :("INC1 ", "I", FALSE),
+ OPN :("DEC1 ", "I", FALSE),
+ OPN :("INC ", "II", FALSE),
+ OPN :("DEC ", "II", FALSE),
+ OPN :("ADD ", "III", FALSE),
+ OPN :("SUB ", "III", FALSE),
+ OPN :("CLEAR", "I", FALSE), (* 10 *)
+ OPN :("TEST ", "I", TRUE),
+ OPN :("EQU ", "II", TRUE),
+ OPN :("LSEQ ", "II", TRUE),
+ OPN :("FMOV ", "RR", FALSE),
+ OPN :("FADD ", "RRR", FALSE),
+ OPN :("FSUB ", "RRR", FALSE),
+ OPN :("FMUL ", "RRR", FALSE),
+ OPN :("FDIV ", "RRR", FALSE),
+ OPN :("FLSEQ", "RR", TRUE),
+ OPN :("TMOV ", "SS", FALSE),
+ OPN :("TEQU ", "SS", TRUE),
+ OPN :("ULSEQ", "II", TRUE),
+ OPN :("DSACC", "D?", FALSE),
+ OPN :("REF ", "?@", FALSE),
+ OPN :("SUBS ", "VVI?@", FALSE), (* 25 *)
+ OPN :("SEL ", "?V@", FALSE), (* 26 *)
+ OPN :("PPV ", "?", FALSE),
+ OPN :("PP ", "?", FALSE),
+ OPN :("B ", "V", FALSE),
+ OPN :("B1 ", "V", FALSE),
+ OPN :("CALL ", "M", FALSE)) ;
+
+SPECIALOP CONST special op := SPECIALOP :(
+ OPN :("EQUIM ", "HI", TRUE),
+ OPN :("MOVi ", "HI", FALSE),
+ OPN :("MOVx ", "HII", FALSE),
+ OPN :("PUTW ", "HII", FALSE),
+ OPN :("GETW ", "HII", FALSE),
+ OPN :("PENTER ", "H", FALSE)) ; (* 7F = ESC, FF = LONGA *)
+
+ESCOP CONST esc op := ESCOP :(
+ OPN :("RTN ", "", FALSE), (* 0 *)
+ OPN :("RTNT ", "", FALSE),
+ OPN :("RTNF ", "", FALSE),
+ OPN :("???????", "", FALSE), (* was repair text 1.7.1 *)
+ OPN :("STOP ", "", FALSE), (* TERM *)
+ OPN :("GOSUB ", "V", FALSE), (* 1 ist Branch Address *)
+ OPN :("KE ", "", FALSE),
+ OPN :("GORET ", "", FALSE),
+ OPN :("BCRD ", "II", FALSE), (* begin char read (pointer, length) *)
+ OPN :("CRD ", "II", FALSE), (* char read (char, pointer) *)
+ OPN :("ECWR ", "III", FALSE), (* end char write (pointer, length, next entry) *)
+ OPN :("CWR ", "III", FALSE), (* char write (hash code, pointer, char) *)
+ OPN :("CTT ", "?S", FALSE), (* REF d2:=REF compiler table text <d1>) *)
+ OPN :("GETC ", "SII", TRUE), (* INT <d3> := code (TEXT <d1> SUB INT<d2>), TRUE wenn INT<ds> <= length (TEXT) *)
+ OPN :("FNONBL ", "ISI", TRUE), (* find non blank (char, line, pointer) *)
+ OPN :("DREM256", "II", FALSE), (* <d2> := <d1> MOD 256, <d1> := <d1> DIV 256 *)
+ OPN :("AMUL256", "II", FALSE), (* <d1> := <d1> * 256 + <d2> *)
+ OPN :("???????", "", FALSE),
+ OPN :("ISDIG ", "I", TRUE),
+ OPN :("ISLD ", "I", TRUE),
+ OPN :("ISLCAS ", "I", TRUE),
+ OPN :("ISUCAS ", "I", TRUE),
+ OPN :("GADDR ", "III", FALSE), (* IF <d2> >= 0 (Global) THEN <d3> := <d2> - <d1> (<d1>=pbase) ELIF bit (<d2>, 14) (Local Ref) THEN <d3> := (<d2> AND $3FFF)*2 + 1 ELSE (Local) <d3> := (<d2> AND $3FFF)*2 FI *)
+ OPN :("GCADDR ", "III", TRUE),
+ OPN :("ISSHA ", "I", TRUE),
+ OPN :("SYSG ", "", FALSE), (* 25 *)
+ OPN :("GETTAB ", "", FALSE),
+ OPN :("PUTTAB ", "", FALSE),
+ OPN :("ERTAB ", "", FALSE),
+ OPN :("EXEC ", "M", FALSE),
+ OPN :("PPROC ", "M", FALSE),
+ OPN :("PCALL ", "A", FALSE), (* : icount Segment/Address *)
+ OPN :("BRCOMP ", "IV", FALSE),
+ OPN :("MOVxx ", "V??", FALSE),
+ OPN :("ALIAS ", "VDD", FALSE),
+ OPN :("MOVii ", "VI", FALSE),
+ OPN :("FEQU ", "RR", TRUE),
+ OPN :("TLSEQ ", "SS", TRUE),
+ OPN :("FNEG ", "RR", FALSE),
+ OPN :("NEG ", "II", FALSE),
+ OPN :("IMULT ", "III", FALSE),
+ OPN :("MUL ", "III", FALSE),
+ OPN :("DIV ", "III", FALSE),
+ OPN :("MOD ", "III", FALSE),
+ OPN :("ITSUB ", "SII", FALSE),
+ OPN :("ITRPL ", "SII", FALSE),
+ OPN :("DECOD ", "SI", FALSE),
+ OPN :("ENCOD ", "IS", FALSE),
+ OPN :("SUBT1 ", "SIS", FALSE),
+ OPN :("SUBTFT ", "SIIS", FALSE),
+ OPN :("SUBTF ", "SIS", FALSE),
+ OPN :("REPLAC ", "SIS", FALSE),
+ OPN :("CAT ", "SS", FALSE),
+ OPN :("TLEN ", "SI", FALSE),
+ OPN :("POS ", "SSI", FALSE),
+ OPN :("POSF ", "SSII", FALSE),
+ OPN :("POSFT ", "SSIII", FALSE),
+ OPN :("STRANL ", "IIISIII", FALSE),
+ OPN :("POSIF ", "SSSII", FALSE),
+ OPN :("???????", "", FALSE),
+ OPN :("OUT ", "S", FALSE), (* 60 *)
+ OPN :("COUT ", "I", FALSE),
+ OPN :("OUTF ", "SI", FALSE),
+ OPN :("OUTFT ", "SII", FALSE),
+ OPN :("INCHAR ", "S", FALSE),
+ OPN :("INCETY ", "S", FALSE),
+ OPN :("PAUSE ", "I", FALSE),
+ OPN :("GCPOS ", "II", FALSE),
+ OPN :("CATINP ", "SS", FALSE),
+ OPN :("NILDS ", "D", FALSE),
+ OPN :("DSCOPY ", "DD", FALSE),
+ OPN :("DSFORG ", "D", FALSE),
+ OPN :("DSWTYP ", "DI", FALSE),
+ OPN :("DSRTYP ", "DI", FALSE),
+ OPN :("DSHEAP ", "DI", FALSE),
+ OPN :("ESTOP ", "", FALSE),
+ OPN :("DSTOP ", "", FALSE),
+ OPN :("SETERR ", "I", FALSE),
+ OPN :("ISERR ", "", TRUE),
+ OPN :("CLRERR ", "", FALSE),
+ OPN :("RPCB ", "II", FALSE),
+ OPN :("INFOPW ", "SSI", FALSE), (* War vorher Writepcb *)
+ OPN :("TWCPU ", "TR", FALSE),
+ OPN :("ROTATE ", "II", FALSE),
+ OPN :("CONTRL ", "IIII", FALSE),
+ OPN :("BLKOUT ", "DIIII", FALSE),
+ OPN :("BLKIN ", "DIIII", FALSE),
+ OPN :("NXTDSP ", "DII", FALSE),
+ OPN :("DSPAGS ", "ITI", FALSE),
+ OPN :("STORAGE", "II", FALSE),
+ OPN :("SYSOP ", "I", FALSE), (* 90 *)
+ OPN :("ARITHS ", "", FALSE),
+ OPN :("ARITHU ", "", FALSE),
+ OPN :("HPSIZE ", "I", FALSE),
+ OPN :("GARB ", "", FALSE),
+ OPN :("TPBEGIN", "TTIA", FALSE), (* 1.8.0: privileged begin *)
+ OPN :("FSLD ", "IRI", FALSE),
+ OPN :("GEXP ", "RI", FALSE),
+ OPN :("SEXP ", "IR", FALSE),
+ OPN :("FLOOR ", "RR", FALSE),
+ OPN :("RTSUB ", "SIR", FALSE),
+ OPN :("RTRPL ", "SIR", FALSE),
+ OPN :("CLOCK ", "IR", FALSE),
+ OPN :("SETNOW ", "R", FALSE),
+ OPN :("TRPCB ", "TII", FALSE),
+ OPN :("TWPCB ", "TII", FALSE), (* 105 *)
+ OPN :("TCPU ", "TR", FALSE),
+ OPN :("TSTAT ", "TI", FALSE),
+ OPN :("ACT ", "T", FALSE),
+ OPN :("DEACT ", "T", FALSE),
+ OPN :("THALT ", "T", FALSE),
+ OPN :("TBEGIN ", "TA", FALSE), (* seg/addr icount *)
+ OPN :("TEND ", "T", FALSE),
+ OPN :("SEND ", "TIDI", FALSE),
+ OPN :("WAIT ", "TID", FALSE),
+ OPN :("SWCALL ", "TIDI", FALSE),
+ OPN :("CDBINT ", "II", FALSE), (* 116 *)
+ OPN :("CDBTXT ", "IS", FALSE), (* 117 *)
+ OPN :("PNACT ", "I", FALSE),
+ OPN :("PW ", "III", FALSE),
+ OPN :("GW ", "III", FALSE),
+ OPN :("XOR ", "III", FALSE),
+ OPN :("PPCALL ", "TIDI", FALSE), (* pingpong call *)
+ OPN :("EXTASK ", "T", TRUE),
+ OPN :("AND ", "III", FALSE),
+ OPN :("OR ", "III", FALSE),
+ OPN :("SESSION", "I", FALSE),
+ OPN :("SENDFT ", "TTIDI", FALSE),
+ OPN :("DEFCOL ", "T", FALSE),
+ OPN :("ID ", "II", FALSE)) ; (* 129 *)
+
+
+PROC decode :
+ INT VAR mod nr ;
+ get module number (mod nr) ;
+ IF mod nr >= minus one
+ THEN decode (mod nr)
+ FI
+ENDPROC decode ;
+
+
+PROC decode module :
+ INT VAR mod nr ;
+ get module number (mod nr) ;
+ IF mod nr >= minus one
+ THEN decode module (mod nr)
+ FI
+ENDPROC decode module ;
+
+
+PROC decode module (INT CONST mod nr) :
+ INT VAR address :: code address (mod nr) ;
+ default no runtime ;
+ decode (code segment (mod nr), address, minus one, TRUE)
+ENDPROC decode module ;
+
+
+PROC decode (INT CONST mod nr) :
+ INT VAR address :: code address (mod nr) ;
+ default no runtime ;
+ decode (code segment (mod nr), address, minus one, FALSE)
+ENDPROC decode ;
+
+
+PROC decode (INT CONST seg, from) :
+ INT VAR address := from ;
+ default no runtime ;
+ decode (seg, address, minus one, FALSE)
+ENDPROC decode ;
+
+
+PROC decode (INT CONST seg, INT VAR addr, INT CONST to addr,
+ BOOL CONST only one module) :
+
+ TEXT VAR taste, opcode, codewords, hex addr ;
+ BOOL VAR addr out := TRUE ,
+ output permitted := TRUE ;
+ INT VAR size, used, mod nr, header address, start address := addr ;
+
+ add modules ;
+ storage (size, used) ;
+ echo := TRUE ;
+ file number := 0 ;
+ cmod := minus one ;
+ init list file ;
+ next module header (seg, addr, header address, mod nr) ;
+ was bool result := FALSE ;
+
+ WHILE ulseq (addr, to addr) REP
+ protocoll ;
+ taste := incharety ;
+ decode one statement ;
+ analyze key ;
+ IF (addr AND 31) = 0
+ THEN storage (size, used) ;
+ FI ;
+ UNTIL taste = ""27"" OR used > size PER ;
+
+ IF used > size
+ THEN list line ("Abbruch wegen Speicherengpass!")
+ FI .
+
+protocoll :
+ IF output permitted AND NOT echo (* Falls Decoder im Hintergrund laufen soll *)
+ THEN IF addr out
+ THEN out (" ") ;
+ out (hex16 (addr)) ;
+ out (" "8""8""8""8""8""8"") ;
+ ELSE cout (ln)
+ FI
+ FI .
+
+analyze key :
+ SELECT code (taste) OF
+{l} CASE 108 : addr out := FALSE (* Zeilennummern ausgeben *)
+{d} CASE 100 : get command ("Gib Kommando:") ; do command
+{f} CASE 102 : show filename and fileline
+{a} CASE 97 : addr out := TRUE (* Hexaddressen ausgeben *)
+{e} CASE 101 : echo := NOT echo (* Bildschirmausgabe zus. *)
+{s} CASE 115 : storage (size,used) ; out(""13""5"System-Storage: " + text (used) + " ")
+{m} CASE 109 : out (""13""5"Modulnr: " + text (mod nr-1) + " ")
+{Q,W}CASE 87,81:output permitted := TRUE (* L„uft nur im Vordergrund *)
+{S} CASE 83 : output permitted := FALSE (* L„uft auch im Hintergrund *)
+{ESC}CASE 27 : IF incharety <> ""
+ THEN taste := ""
+ ELSE list line ("Abbruch mit ESC")
+ FI
+ (* Wegen Steuertasten, wie ESC P *)
+ ENDSELECT .
+
+show filename and fileline :
+ out (""13""5"Filename: " + filename + "." + text (filenumber) +
+ " Fileline: " + text (lines (list file)) + " ") .
+
+decode one statement :
+ check if module head ;
+ hex addr := hex16 (addr) ;
+ codewords := "" ;
+ opcode := "" ;
+ decode (seg, addr, codewords, opcode, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ;
+ hex addr CAT " " ;
+ hex addr CAT opcode ;
+ IF with statement line
+ THEN hex addr CAT " " ;
+ WHILE LENGTH hex addr < 80 REP
+ hex addr CAT " "
+ PER ;
+ hex addr CAT codewords ;
+ FI ;
+ list line (hex addr) .
+
+check if module head :
+ IF addr = header address
+ THEN IF only one module AND addr <> start address
+ THEN LEAVE decode
+ FI ;
+ list line (" ") ;
+ list line ("Module " + process module nr (mod nr)) ;
+ list line (" ") ;
+ IF output permitted AND NOT echo
+ THEN put ("Module:") ;
+ cout (mod nr) ;
+ 8 TIMESOUT ""8""
+ FI ;
+ calculate c8k ;
+ codewords := "" ;
+ hex addr := hex16 (addr) ;
+ hex addr CAT " HEAD " ;
+ hex addr CAT text (next word (seg, addr, codewords)) ;
+ IF with statement line
+ THEN hex addr CAT " " ;
+ WHILE LENGTH hex addr < 80 REP
+ hex addr CAT " "
+ PER ;
+ hex addr CAT code words ;
+ FI ;
+ list line (hex addr) ;
+ next module header (seg, addr, header address, mod nr) ;
+ FI .
+
+calculate c8k :
+ INT VAR dummy ;
+ cmod := addr ;
+ splitword (cmod, dummy) ;
+ cmod INCR 16 ;
+ cmod := cmod AND 255 .
+
+ENDPROC decode ;
+
+
+PROC init list file :
+ forget (filename + "." + text (filenumber), quiet) ;
+ list file := sequentialfile (output, filename + "." + text (filenumber)) ;
+ maxlinelength (list file, 2000) ;
+ list line ("Addr Opcode Parameter") ;
+ENDPROC init list file ;
+
+
+PROC list line (TEXT CONST zeile) :
+ IF lines (list file) > 4000
+ THEN file number INCR 1 ;
+ init list file
+ FI ;
+ putline (list file, zeile) ;
+ IF echo THEN outsubtext (zeile, 1, 79) ; line FI
+ENDPROC list line ;
+
+
+PROC decode (INT CONST segment, INT VAR address, TEXT VAR words, instruction,
+ INT PROC (INT CONST, INT VAR, TEXT VAR) next word) :
+
+ INT VAR opcode, word, lowbyte, highbyte,
+ opcode address := address ;
+ BOOL VAR shorta opcode ;
+
+ ln := minus one ; (* Wenn kein LN Befehl vorkam -1 *)
+
+ word := next word (segment, address, words) ;
+ highbyte := word ;
+ split word (highbyte, lowbyte) ;
+ opcode := highbyte AND hex 7c ;
+ shorta opcode := TRUE ;
+
+ IF opcode = hex 7c AND highbyte <> hex ff
+ THEN esc or special instruction (* Kann kein LONGA sein *)
+ ELSE IF highbyte = hex ff
+ THEN longa instruction
+ ELSE word := word AND hex 83ff
+ FI ;
+ primaer instruction
+ FI .
+
+esc or special instruction :
+ IF highbyte = hex 7f
+ THEN esc instruction
+ ELSE special instruction
+ FI .
+
+longa instruction :
+ IF lowbyte = hex ff
+ THEN instruction CAT "-" ;
+ LEAVE decode
+ ELIF lowbyte = hex fd
+ THEN instruction CAT "Block unlesbar" ;
+ LEAVE decode
+ ELSE instruction CAT "LONGA " ;
+ shorta opcode := FALSE ;
+ opcode := lowbyte ;
+ word := next word (segment, address, words) ;
+ highbyte := word ;
+ splitword (highbyte, lowbyte)
+ FI .
+
+special instruction :
+ opcode := (highbyte AND 3) * 2 + 1 ;
+ IF highbyte > hex 7f
+ THEN opcode INCR 1
+ FI ;
+ word := word AND hex ff ;
+ instruction CAT special op (opcode).mnemonic ;
+ instruction CAT " " ; (* ESC Ausgleich *)
+ instruction CAT params0 (special op (opcode).params, word, segment, address,
+ words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ;
+ was bool result := special op (opcode).bool result ;
+ IF opcode = 6 (* PENTER *)
+ THEN database := lowbyte ;
+ makeword (database, 0) ;
+ FI .
+
+esc instruction :
+ opcode := lowbyte + 1 ;
+ IF opcode < 1 OR opcode > 131
+ THEN instruction CAT "???????"
+ ELSE instruction CAT "ESC " ;
+ instruction CAT esc op (opcode).mnemonic ;
+ instruction CAT " " ;
+ instruction CAT params (esc op (opcode).params, segment, address,
+ words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ;
+ was bool result := esc op (opcode).bool result
+ FI .
+
+primaer instruction :
+ rotate (opcode, -2) ;
+ SELECT opcode OF
+ CASE 0, 1 : process ln
+ CASE 28, 29 : process br
+ CASE 30 : process call
+ OTHERWISE
+ opcode INCR 1 ;
+ instruction CAT prim op (opcode).mnemonic ;
+ IF shorta opcode
+ THEN instruction CAT " "
+ ELSE instruction CAT " "
+ FI ;
+ instruction CAT params0 (prim op (opcode).params, word, segment, address, words,
+ INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ;
+ IF opcode = 25 (* SUBS *)
+ THEN instruction CAT "(ESiz,Lim-1,Idx,Base,Ref) "
+ ELIF opcode = 26 (* SEL *)
+ THEN instruction CAT "(Base,Offs,Ref) "
+ FI ;
+ was bool result := prim op (opcode).bool result ;
+ ENDSELECT .
+
+process call :
+ opcode INCR 1 ;
+ word := word AND hex 03ff ;
+ IF highbyte > hex 7f
+ THEN word INCR hex 0400
+ FI ;
+ instruction CAT prim op (opcode).mnemonic ;
+ IF shorta opcode
+ THEN instruction CAT " "
+ ELSE instruction CAT " "
+ FI ;
+ was bool result := FALSE ; (* Wird von params0 ggf berschrieben *)
+ instruction CAT params0 (prim op (opcode).params, word, segment, address, words,
+ INT PROC (INT CONST, INT VAR, TEXT VAR) next word) .
+
+process ln :
+ IF shorta opcode
+ THEN word := short address (lowbyte, highbyte, opcode = 1)
+ FI ;
+ IF was bool result
+ THEN instruction CAT "BT " ;
+ IF shorta opcode
+ THEN instruction CAT " "
+ FI ;
+ instruction CAT hex16 (branch address)
+ ELSE IF segment = 2
+ THEN instruction CAT "HEAD "
+ ELSE ln := word ;
+ instruction CAT "LN "
+ FI ;
+ IF shorta opcode
+ THEN instruction CAT " "
+ FI ;
+ instruction CAT text (word)
+ FI ;
+ was bool result := FALSE .
+
+process br :
+ word := short address (lowbyte, highbyte, opcode = 29) ;
+ IF was bool result
+ THEN instruction CAT "BF " ;
+ ELSE instruction CAT "B " ;
+ FI ;
+ IF shorta opcode
+ THEN instruction CAT " "
+ FI ;
+ instruction CAT hex16 (branch address) ;
+ was bool result := FALSE .
+
+branch address :
+ INT VAR high address byte := opcode address ;
+ split word (high address byte, lowbyte) ;
+ highbyte := word ;
+ split word (highbyte, lowbyte) ;
+ high address byte INCR highbyte ;
+ IF cmod <> minus one AND high address byte >= cmod
+ THEN high address byte DECR 16 (* cms = 16 *)
+ FI ;
+ make word (high address byte, lowbyte) ;
+ high address byte .
+
+ENDPROC decode ;
+
+
+INT PROC short address (INT CONST lowbyte, highbyte, BOOL CONST bit12) :
+ (* Bit 7 des Highbytes in Bit 0 rotieren *)
+ INT VAR effective address := (highbyte * 2) AND 6 ;
+ IF highbyte > hex 7f
+ THEN effective address INCR 1
+ FI ;
+ make word (effective address, lowbyte) ; (* high and result, low *)
+ IF bit12
+ THEN effective address INCR 2048
+ FI ;
+ effective address
+
+ENDPROC short address ;
+
+
+INT PROC next word (INT CONST segment, INT VAR address, TEXT VAR words) :
+ INT CONST word :: get word (segment, address) ;
+ INC address ;
+ words CAT hex16 (word) ;
+ words CAT " " ;
+ word
+
+ENDPROC next word ;
+
+
+PROC next module header (INT CONST segment, address,
+ INT VAR header address, module number) :
+ INT VAR first, last, mid ;
+ IF segment = 2
+ THEN first := 0 ;
+ last := 1275
+ ELSE first := 1282 ; (* 1280/1281 MAIN doagain & runagain modaddr *)
+ last := 2047
+ FI ;
+ REP
+ mid := (first + last) DIV 2 ;
+ IF ulseq (address, getword (0, 512 + mid))
+ THEN last := mid
+ ELSE first := mid + 1
+ FI
+ UNTIL first = last PER ;
+ header address := getword (0, 512 + first) ;
+ module number := first
+
+ENDPROC next module header ;
+
+
+TEXT PROC params (TEXT CONST types, INT CONST segment, INT VAR address,
+ TEXT VAR words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) :
+
+ INT VAR i, param addr, type ;
+ TEXT VAR result ;
+
+ IF types = ""
+ THEN LEAVE params WITH ""
+ FI ;
+ result := "" ;
+ FOR i FROM 1 UPTO LENGTH types REP
+ param addr := next word (segment, address, words) ;
+ type := code (types SUB i)-63 ;
+ result CAT data representation (param addr, segment, address, type) ;
+ IF i <> LENGTH types
+ THEN result CAT ", "
+ FI ;
+ PER ;
+ result
+
+ENDPROC params ;
+
+
+TEXT PROC params0 (TEXT CONST types, INT CONST word, segment, INT VAR address,
+ TEXT VAR words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) :
+
+ INT VAR i, param addr, type ;
+ TEXT VAR result ;
+
+ IF types = ""
+ THEN LEAVE params0 WITH ""
+ FI ;
+ result := "" ;
+ param addr := word ;
+ FOR i FROM 1 UPTO LENGTH types REP
+ type := code (types SUB i)-63 ;
+ result CAT data representation (param addr, segment, address, type) ;
+ IF i <> LENGTH types
+ THEN result CAT ", " ;
+ param addr := next word (segment, address, words)
+ FI
+ PER ;
+ result
+
+ENDPROC params0 ;
+
+
+TEXT PROC data representation (INT CONST data addr, segment, address, type) :
+ INT VAR stack offset, ds segment, ds number, ds address ;
+ TEXT VAR result ;
+ IF is data address
+ THEN IF local data address
+ THEN stack offset := data addr ;
+ rotate (stack offset, minus one) ;
+ stack offset := stack offset AND hex 3fff ;
+ IF local reference address OR type = ref addr
+ THEN get referenced representation
+ ELSE get representation from stack
+ FI
+ ELSE get representation from packet data
+ FI
+ ELSE object representation (minus one, data addr, segment, address, type)
+ FI .
+
+is data address :
+ NOT (type = 23 OR type = 9 OR type = 14) .
+
+local data address :
+ data addr < 0 .
+
+local reference address :
+ (data addr AND 1) = 1 .
+
+is runtime :
+ lbas <> minus one .
+
+get representation from packet data :
+ IF with object and address
+ THEN result := "<G " + hex16 (data addr) + "H>"
+ ELSE result := ""
+ FI ;
+ result CAT object representation (packet data segment, data addr ADD data base,
+ segment, address, type) ;
+ result .
+
+get representation from stack :
+ result := "<L " + text (stack offset) + ">" ;
+ IF is runtime
+ THEN IF NOT with object and address
+ THEN result := ""
+ FI ;
+ result CAT object representation (local data segment,
+ lbas ADD stack offset, segment, address, type)
+ FI ;
+ result .
+
+get referenced representation :
+ IF is runtime
+ THEN ds address := getword (local data segment, lbas ADD stack offset) ;
+ ds number := getword (local data segment, lbas ADD stack offset ADD 1) ;
+ split word (ds number, ds segment) ;
+ IF ds number = standard dataspace
+ THEN IF with object and address
+ THEN result := "<LR " + text (stack offset) ;
+ result CAT " @" + text (ds segment AND 7) ;
+ result CAT hex16 (ds address) + "H>"
+ ELSE result := ""
+ FI ;
+ IF ds segment <= local data segment
+ THEN result CAT object representation (ds segment,
+ ds address, segment, address, type)
+
+ ELIF ds segment > 3 (* Illegal! *)
+ THEN result := "<LR " + text (stack offset) ;
+ result CAT " @" + text (ds segment AND 7) ;
+ result CAT "!!!" ;
+ result CAT hex16 (ds address) + "H>"
+ ELSE (* PROC-Addresse *)
+ result CAT object representation (ds segment,
+ ds address, segment, address, mod addr)
+ FI ;
+ result
+ ELSE "<LR " + text (stack offset) +
+ " DS:" + hex8 (ds number) + " @" +
+ text (ds segment AND 7) + hex16 (ds address) + "H>"
+ FI
+ ELSE "<LR " + text (stack offset) + ">"
+ FI .
+
+ENDPROC data representation ;
+
+
+INT VAR anzahl zeros, anzahl steuerzeichen ;
+
+TEXT PROC object representation (INT CONST data segment, data address,
+ segment, address, type) :
+ TEXT VAR t, result ;
+ INT VAR i, zeichen, highbyte, lowbyte, first word ;
+ SELECT type OF
+ CASE try type,refaddr: try representation
+ CASE int addr : int representation
+ CASE real addr : real representation
+ CASE text addr : text representation
+ CASE dataspace addr : dataspace representation
+ CASE task addr : task representation
+ CASE mod addr : module address representation
+ CASE bool addr : bool representation
+ CASE int value : integer value
+ CASE hexbyte value : integer hexbyte
+ CASE module nr value : module nr representation
+ OTHERWISE "unbek. Typ: " + code (type + 63)
+ ENDSELECT .
+
+module nr representation :
+ text val := text (data address) ;
+ process module nr (data address) .
+
+bool representation :
+ IF getword (data segment, data address) = 0
+ THEN text val := "TRUE"
+ ELSE text val := "FALSE"
+ FI ;
+ text val .
+
+reference address :
+ highbyte := getword (data segment, data address ADD 1) ;
+ splitword (highbyte, lowbyte) ;
+ result := "@" + hex8 (highbyte) + "-" + hex8 (lowbyte) ;
+ result CAT hex16 (getword (data segment, data address)) ;
+ text val := result ;
+ result .
+
+int representation :
+ i := get word (data segment, data address) ;
+ text val := text (i) ;
+ result := text (i) ;
+ IF i < 0
+ THEN result CAT "|" ;
+ result CAT hex16 (i) ;
+ result CAT "H"
+ ELIF i >= 256
+ THEN result CAT "|" ;
+ result CAT hex16 (i) ;
+ result CAT "H" ;
+ FI ;
+ result .
+
+integer value :
+ text val := text (data address) ;
+ text (data address) .
+
+integer hexbyte :
+ text val := text (data address) ;
+ IF (data address AND hex ff00) = 0
+ THEN hex8 (data address) + "H"
+ ELSE hex16 (data address) + "H"
+ FI .
+
+real representation :
+ result := "12345678" ;
+ FOR i FROM 0 UPTO 3 REP
+ replace (result, i + 1, get word (data segment, data address ADD i))
+ PER ;
+ disablestop ;
+ result := compress (text (result RSUB 1, 20)) ;
+ IF iserror
+ THEN clear error ;
+ result := "undefined REAL"
+ FI ;
+ text val := result ;
+ result .
+
+text representation :
+ t := copied text var (data segment, data address) ;
+ result := """" ;
+ anzahl steuerzeichen := 0 ;
+ anzahl zeros := 0 ;
+ FOR i FROM 1 UPTO length (t) REP
+ zeichen := code (t SUB i) ;
+ IF zeichen = 34 THEN result CAT """"""
+ ELIF zeichen = 251 OR zeichen > 31 AND zeichen < 127 OR
+ zeichen > 213 AND zeichen < 224 THEN result CAT code (zeichen)
+ ELSE result CAT """" ;
+ result CAT text (zeichen) ;
+ result CAT """" ;
+ anzahl steuerzeichen INCR 1 ;
+ IF zeichen = 0
+ THEN anzahl zeros INCR 1
+ FI
+ FI
+ PER ;
+ result CAT """" ;
+ text val := result ;
+ result .
+
+task representation :
+ INT CONST index := get word (data segment, data address) ,
+ version := get word (data segment, data address ADD 1) ;
+ IF index < 256
+ THEN result := hex8 (index)
+ ELSE result := hex16 (index) ;
+ insertchar (result, "-", 3)
+ FI ;
+ result CAT "-" ;
+ result CAT hex16 (version) ;
+ result CAT "/" ;
+ result CAT taskname (index, version) ;
+ text val := result ;
+ result .
+
+dataspace representation :
+ highbyte := get word (data segment, data address) ;
+ splitword (highbyte, lowbyte) ;
+ result := hex8 (highbyte) ;
+ result CAT "-" ;
+ result CAT hex8 (lowbyte) ;
+ IF (highbyte AND lowbyte) = 255
+ THEN result CAT ":not init"
+ ELIF (highbyte OR lowbyte) = 0
+ THEN result CAT ":nilspace"
+ FI ;
+ text val := result ;
+ result .
+
+module address representation :
+ (* Hier: lowbyte = mod nr, highbyte = mod addr *)
+ next module header (data segment, data address, highbyte, lowbyte) ;
+ IF highbyte <> data address
+ THEN linear search (* Adresse muá doch zu finden sein *)
+ FI ;
+ text val := text (lowbyte) ;
+ process module nr (lowbyte) .
+
+linear search :
+ IF data segment = 2
+ THEN FOR i FROM 512 UPTO 767 REP
+ IF getword (packet data segment, i) = data address
+ THEN lowbyte := i-512 ;
+ LEAVE linear search
+ FI
+ PER
+ ELSE FOR i FROM 1792 UPTO 3839 REP
+ IF getword (packet data segment, i) = data address
+ THEN lowbyte := i-512 ;
+ LEAVE linear search
+ FI
+ PER
+ FI ; (* Moduleaddress nicht gefunden, da stimmt doch was nicht! *)
+ LEAVE module address representation WITH reference address .
+
+try representation :
+ first word := getword (data segment, data address) ;
+ result := text (first word) ;
+ IF first word < 0 OR first word >= 256
+ THEN result CAT "|" ;
+ result CAT hex16 (first word) ;
+ result CAT "H"
+ FI ;
+ IF first word = 0
+ THEN result CAT "|TRUE"
+ ELIF first word = 1
+ THEN result CAT "|FALSE"
+ FI ;
+ IF vorzeichen ok AND nur digits (* real *)
+ THEN result CAT "|" ;
+ disablestop ;
+ TEXT CONST txt :: compress (text (t RSUB 1, 20)) ;
+ IF is error
+ THEN clear error
+ ELSE result CAT txt
+ FI ;
+ FI ;
+ IF within compiler
+ THEN IF first word >= begin of stringtable CAND first word <= end of nametable
+ THEN string pointer (* first word wird ggf veraendert! *)
+ ELIF first word > 9 AND first word < 32
+ THEN result CAT "|""""" + text (first word) + """""" (* Char *)
+ ELIF first word = 34
+ THEN result CAT "|"""""
+ ELIF first word >= 32 AND first word < 127
+ THEN result CAT "|""" + code (first word) + """" (* Code-Char *)
+ FI ;
+ ELIF text sinnvoll
+ THEN result CAT "|" ;
+ result CAT t
+ FI ;
+ text val := result ;
+ result .
+
+text sinnvoll :
+ keine steuerzeichen AND
+ (getword (data segment, data address ADD 1) AND 255) < 80 .
+
+within compiler :
+ segment = 2 AND ulseq (address, first elan address-1) .
+
+string pointer :
+ IF first word >= begin of name table
+ THEN first word INCR 2
+ FI ;
+ IF (cdbint (first word) AND 255) < 100
+ THEN t := cdbtext (first word) ;
+ IF pos (t, ""0"", ""31"", 1) = 0 CAND
+ pos (t, ""127"", ""213"", 1) = 0 CAND
+ pos (t, ""220"", ""255"", 1) = 0
+ THEN result CAT "|""" ;
+ result CAT t ;
+ result CAT """"
+ FI
+ FI .
+
+keine steuerzeichen :
+ t := object representation (data segment, data address,
+ segment, address, text addr) ;
+ anzahl steuerzeichen < 4 AND anzahl zeros < 2 AND
+ getword (data segment, data address ADD 1) <> minus one .
+
+vorzeichen ok :
+ (first word AND hex f0) = 0 OR (first word AND hex f0) = 128 .
+
+nur digits :
+ t := "12345678" ;
+ FOR i FROM 0 UPTO 3 REP
+ replace (t, i + 1, get word (data segment, data address ADD i))
+ PER ;
+ IF (first word AND 15) > 9 THEN FALSE
+ ELSE FOR i FROM 2 UPTO 7 REP
+ lowbyte := code (t SUB i) ;
+ IF (lowbyte AND hex f0) > 249 OR (lowbyte AND 15) > 9
+ THEN LEAVE nur digits WITH FALSE
+ FI
+ PER ;
+ TRUE
+ FI .
+
+ENDPROC object representation ;
+
+
+TEXT PROC process module nr (INT CONST module number) :
+ TEXT VAR object specification ;
+ was bool result := modules last word is bool return ;
+ IF is elan module number
+ THEN object specification := module name and specifications (module number) ;
+ IF object specification = ""
+ THEN object specification := "Hidden: PACKET " ;
+ object specification CAT packet name (module number) ;
+ IF was bool result
+ THEN object specification CAT " --> BOOL"
+ FI
+ ELSE was bool result := pos (object specification, "--> BOOL") > 0 ;
+ FI
+ ELIF one of compilers own module numbers
+ THEN object specification := "CDL (" ;
+ object specification CAT text ((getword (2, code address (module number)) - 4) DIV 2) ;
+ object specification CAT ")" ;
+ IF was bool result
+ THEN object specification CAT " --> BOOL"
+ FI
+ ELIF elan defined internal
+ THEN SELECT module number - 255 OF
+ CASE 1 : object specification := "compiler (INT CONST, FILE VAR, TEXT CONST, INT VAR, BOOL CONST ins, BOOL CONST lst, BOOL CONST rtc, BOOL CONST ser)"
+ CASE 2 : object specification := "outtext (TEXT CONST, INT CONST)"
+ CASE 3 : object specification := "outline (INT CONST)"
+ CASE 4 : object specification := "syntaxerror (TEXT CONST)"
+ CASE 5 : object specification := ":= (FILE VAR, FILE CONST)"
+ OTHERWISE object specification := "INTERNAL " + text (module number)
+ ENDSELECT
+ ELSE object specification := "Modulnummer ohne Code!" ;
+ was bool result := FALSE
+ FI ;
+ IF with object and address OR one of compilers own module numbers
+ THEN object specification CAT " (" ;
+ object specification CAT text (module number) ;
+ object specification CAT ":$" ;
+ object specification CAT text (code segment (module number)) ;
+ object specification CAT hex16 (code address (module number)) ;
+ object specification CAT ")" ;
+ FI ;
+ object specification .
+
+modules last word is bool return :
+ INT CONST last word :: getword (code segment (module number),
+ code address (module number + 1) SUB 1) ;
+ last word = rtnt opcode OR last word = rtnf opcode .
+
+one of compilers own module numbers :
+ module number < 244 .
+
+elan defined internal :
+ module number >= 256 AND module number < 272 .
+
+is elan module number :
+ module number >= 272 .
+
+ENDPROC process module nr ;
+
+
+TEXT PROC copied text var (INT CONST segment, addr) :
+ TEXT VAR result, t ;
+ INT VAR laenge, first char, address, heap segment ;
+ address := addr ADD 1 ;
+ first char := getword (segment, address) ;
+ splitword (first char, laenge) ;
+ IF laenge = 0
+ THEN ""
+ ELIF laenge = 255
+ THEN copy text from heap
+ ELSE copy text from data segment
+ FI .
+
+copy text from data segment :
+ result := code (first char) ;
+ laenge DECR 1 ;
+ t := " " ;
+ INC address ;
+ WHILE laenge > 1 REP
+ replace (t, 1, getword (segment, address)) ;
+ result CAT t ;
+ laenge DECR 2 ;
+ INC address ;
+ PER ;
+ IF laenge = 1
+ THEN result CAT code (getword (segment, address) AND 255)
+ FI ;
+ result .
+
+copy text from heap :
+ address := get word (segment, addr) ;
+ rotate (address, minus one) ;
+ heap segment := address AND 7 ;
+ address := address AND hex fff8 ; (* In Vielfachen von 8 *)
+ laenge := getword (segment, addr ADD 2) AND 255 ;
+ makeword (laenge, first char) ; (* 16 Bit Laenge ber Wortgrenze *)
+ laenge := min (laenge, 256) ; (* Mehr ist im Listing nicht sinnvoll *)
+ IF getword (heap segment, address) = minus one (* Standard DS *)
+ THEN address INCR 3 ; (* Kann nicht ber 8000H Grenze gehen *)
+ ELSE INC address (* Im Frei-Datenraum nur Wort Laenge *)
+ FI ;
+ result := "" ;
+ WHILE laenge > 1 REP
+ result CAT getword (heap segment, address) ;
+ laenge DECR 2 ;
+ INC address
+ PER ;
+ IF laenge = 1
+ THEN result CAT code (getword (heap segment, address) AND 255)
+ FI ;
+ result .
+
+ENDPROC copied text var ;
+
+
+PROC push (INT CONST a, b) :
+ INT VAR dummy1 := a, dummy2 := b
+ENDPROC push ;
+
+
+PROC pop (TASK VAR a, INT CONST dummy) :
+ TASK VAR x ;
+ a := x
+ENDPROC pop ;
+
+
+TEXT PROC task name (INT CONST id, vers) :
+ TASK VAR t ;
+ IF id = 0
+ THEN "niltask"
+ ELSE push (id, vers) ;
+ pop (t, 0) ;
+ IF exists (t)
+ THEN """" + name (t) + """"
+ ELSE "-"
+ FI
+ FI
+ENDPROC task name ;
+
+
+ENDPACKET eumel decoder ;
+
+
+(**************************************************************************)
+
+PACKET tracer DEFINES (* M. Staubermann *)
+ (* 20.04.86 *)
+ list breakpoints , (* 1.8.0, 861107 15:45 *)
+ set breakpoint ,
+ reset breakpoint ,
+ source file ,
+ prot file ,
+ tracer channel ,
+ trace ,
+ reset breakpoints :
+
+LET local base field = 25 ,
+ packet data segment = 0 ,
+ local data segment = 1 ,
+ code segment 3 = 3 ,
+
+ begin of module nr link table = 512 ,
+
+ previous local base offset = 0 ,
+ return address offset = 1 ,
+ return segment offset = 2 ,
+ c8k offset = 3 ,
+
+ opcode mask = 31744 ,
+
+ bt opcode = 0 ,
+ btlong opcode = 1024 ,
+ bf opcode = 28672 ,
+ bflong opcode = 29696 ,
+ br opcode = 28672 ,
+ brlong opcode = 29696 ,
+ brcomp opcode = 32544 ,
+
+ ln opcode = 0 ,
+ ln long opcode = 1024 ,
+ call opcode = 30720 ,
+ pcall opcode = 32543 ,
+
+ pp opcode = 27648 ,
+ ppv opcode = 26624 ,
+ pproc opcode = 32542 ,
+
+ rtn opcode = 32512 ,
+ rtnt opcode = 32513 ,
+ rtnf opcode = 32514 ,
+
+ hex 7f00 = 32512 ;
+
+INT CONST longa opcode :: -256 ,
+ longa ppv opcode :: longa opcode + 104 ,
+ longa pp opcode :: longa opcode + 108 ,
+ hex 83ff :: -31745 ,
+ minus one :: -1 ;
+
+LET nr of breakpoints = 2 , (* Max. Anzahl unvorhersehbare Verzweigungen/Branch *)
+ BREAKPOINT = STRUCT (BOOL set, INT address, saved word) ;
+
+ROW nr of breakpoints BREAKPOINT VAR breakpoints ;
+BREAKPOINT CONST init breakpoint :: BREAKPOINT:(FALSE, -5, 0) ;
+
+FOR actual linenumber FROM 1 UPTO nr of breakpoints REP
+ breakpoints (actual line number) := init breakpoint
+PER ;
+
+
+BOOL VAR auto trace := FALSE ,
+ forward trace := TRUE ,
+ source lines neu := TRUE ;
+
+INT VAR previous instruction address ,
+ prot file number ,
+ trace channel := minus one ,
+ actual line number := minus one ,
+ handler module := 339 ; (* Dummy: PROC stop *)
+
+TEXT VAR prot file name := "" ,
+ source line := "" ,
+ source file name := "" ;
+
+FILE VAR source, protocoll ;
+
+
+INT PROC tracer channel :
+ trace channel
+ENDPROC tracer channel ;
+
+
+PROC tracer channel (INT CONST c) :
+ IF c < 17 AND c > minus one
+ THEN trace channel := c
+ ELSE errorstop ("PROC tracer channel: Kanalnummer unzul„ssig")
+ FI
+ENDPROC tracer channel ;
+
+
+PROC trace :
+ TEXT VAR name ;
+ forward trace := TRUE ;
+ set breakpoint ;
+ get command ("PROC/OP-Aufruf eingeben:") ;
+ out (""13"") ;
+ put (" Sourcefilename (falls keine Sourcefile RETURN) :") ;
+ getline (name) ;
+ source file (name) ;
+ put (" Protokollfilename (falls kein Protokoll RETURN):") ;
+ getline (name) ;
+ prot file (name) ;
+ put (" Tracekanal (Ausfhrung an diesem Kanal: RETURN):") ;
+ name := "0" ;
+ editget (name) ;
+ line ;
+ tracer channel (int (name)) ;
+ do command
+
+ENDPROC trace ;
+
+
+PROC source file (TEXT CONST file name) :
+ IF exists (file name)
+ THEN source := sequentialfile (modify, file name) ;
+ source file name := file name ;
+ IF actual line number >= 0 CAND actual line number <= lines (source)
+ THEN toline (source, actual line number) ;
+ readrecord (source, source line)
+ ELSE source line := ""
+ FI
+ ELSE source file name := ""
+ FI
+
+ENDPROC source file ;
+
+
+TEXT PROC source file :
+ source file name
+ENDPROC source file ;
+
+
+TEXT PROC prot file :
+ prot file name
+ENDPROC prot file ;
+
+
+PROC prot file (TEXT CONST file name) :
+ IF file name = ""
+ THEN prot file name := ""
+ ELSE forget (file name, quiet) ;
+ prot file number := 0 ;
+ protocoll := sequentialfile (output, file name) ;
+ max line length (protocoll, 1000) ;
+ prot file name := file name ;
+ FI
+ENDPROC prot file ;
+
+
+PROC protocoll line :
+ IF prot file name <> ""
+ THEN line (protocoll) ;
+ IF lines (protocoll) > 4000
+ THEN prot file number INCR 1 ;
+ TEXT CONST file name :: prot file name + "." +
+ text (prot file number) ;
+ putline (protocoll, "Fortsetzung in Datei " + file name) ;
+ forget (file name, quiet) ;
+ protocoll := sequentialfile (output, file name) ;
+ max line length (protocoll, 1000)
+ FI
+ FI
+
+ENDPROC protocoll line ;
+
+
+PROC write protocoll (TEXT CONST t) :
+ IF prot file name <> ""
+ THEN write (protocoll, t)
+ FI
+ENDPROC write protocoll ;
+
+
+PROC breakpoint handler :
+
+ ROW 32 INT VAR offset fuer inter call stack variablen ;
+ BOOL VAR was bool result ,
+ ueberschrift neu ,
+ code lines neu ;
+ TEXT VAR key, previous key,
+ old error message ,
+ statement line, opcode,
+ previous opcode, next opcode ;
+ INT VAR i, x, y ,
+ actual opcode, actual word, op word, next instruction,
+ following word, saved word,
+ lbas, this local base, st ptr,
+ old channel, old error code, old error line,
+ user address, branch address, address,
+ lowbyte,
+ c8k, packet base,
+ actual instruction address, previous actual address,
+ next instruction address,
+ return segment, return address,
+ breakpoint address, breakpoint nr ;
+
+ determine return address and breakpoint nr ;
+ reset breakpoints ;
+ getcursor (x, y) ;
+ next instruction address := breakpoint address ;
+ IF NOT forward trace AND previous instruction address <> minus one
+ THEN decode instruction (previous instruction address, previous actual address,
+ previous opcode, FALSE) ;
+ ELSE previous opcode := ""
+ FI ;
+ decode instruction (next instruction address, actual instruction address,
+ next opcode, TRUE) ;
+ was bool result := bool result ;
+ IF forward trace
+ THEN write protocoll (" " + hex16 (actual instruction address) + " ") ;
+ write protocoll (next opcode) ;
+ protocoll line
+ ELSE write protocoll ("*" + hex16 (previous actual address) + " ") ;
+ write protocoll (previous opcode) ;
+ protocoll line
+ FI ;
+ actual word := getword (code segment 3, actual instruction address) ;
+ actual opcode := actual word AND opcode mask ;
+ following word := getword (code segment 3, actual instruction address ADD 1) ;
+ next instruction := getword (code segment 3, next instruction address) ;
+ out (""1""10""5""10""5"") ;
+ IF NOT auto trace
+ THEN out (""6""6""0"") ;
+ putline ("Auto, Bpnt, Clrr, Dstp, Estp, File, Go, Prot, Rslt, Step(CR), Term, - + < >"5"") ;
+ putline ("------------------------------------------------------------------------------"5"") ;
+ FI ;
+ ueberschrift neu := TRUE ;
+ code lines neu := TRUE ;
+ previous key := "" ;
+ REP
+ kopf schreiben ;
+ IF auto trace
+ THEN IF incharety = ""
+ THEN key := "S"
+ ELSE auto trace := FALSE
+ FI
+ FI ;
+ IF NOT auto trace
+ THEN REP
+ inchar (key)
+ UNTIL pos (""13"abcdefgprst +-<>", key) > 0 PER ;
+ IF key >= "a"
+ THEN key := code (code (key)-32)
+ FI ;
+ analyze key
+ FI ;
+ previous key := key
+ UNTIL pos ("GST!", key) > 0 PER ;
+ IF key <> "T"
+ THEN execute saved instruction
+ FI ;
+ IF key = "T"
+ THEN write protocoll (" Terminated") ;
+ protocoll line ;
+ resetbreakpoints ;
+ term
+ ELIF key = "G"
+ THEN write protocoll (" Go") ;
+ protocoll line
+ ELIF key = "S"
+ THEN singlestep
+ FI ;
+ previous instruction address := breakpoint address ;
+ cursor (x, y) ;
+ IF trace channel > 0
+ THEN IF old channel = 0
+ THEN break (quiet)
+ ELSE continue (old channel)
+ FI
+ FI ;
+ IF bit (return segment, 7)
+ THEN disablestop ;
+ set line nr (old error line) ;
+ error stop (old error code, old error message) ;
+ set line nr (0)
+ FI .
+
+analyze key :
+ IF previous key = "B"
+ THEN IF key = ""13"" OR key = "S" (* Sicherheitsabfrage *)
+ THEN key := "!" ; (* Exit-Key *)
+ write protocoll (" Skip") ;
+ protocoll line ;
+ write protocoll (" " + hex16 (user address) + " ") ;
+ write protocoll (opcode) ;
+ protocoll line ;
+ set breakpoint (breakpoint nr, user address)
+ ELSE code lines neu := TRUE
+ FI
+ ELIF key = ""13""
+ THEN key := "S"
+ ELIF key = " "
+ THEN code lines neu := TRUE ;
+ source lines neu := TRUE ;
+ ueberschrift neu := TRUE ;
+ ELSE SELECT code (key)-43 OF (* Um die Anzahl Branches klein zu halten*)
+ CASE 0 {+} : stptr := stptr ADD 2 ;
+ ueberschrift neu := TRUE
+ CASE 2 {-} : stptr := stptr SUB 2 ;
+ ueberschrift neu := TRUE
+ CASE 17 {<} : with object address (TRUE) ;
+ IF forward trace
+ THEN decode instruction (breakpoint address,
+ actual instruction address, next opcode, FALSE)
+ ELIF previous instruction address <> minus one
+ THEN decode instruction (previous instruction address,
+ previous actual address, previous opcode, FALSE)
+ FI ;
+ code lines neu := TRUE
+ CASE 19 {>} : with object address (FALSE) ;
+ IF forward trace
+ THEN decode instruction (breakpoint address,
+ actual instruction address, next opcode, FALSE)
+ ELIF previous instruction address <> minus one
+ THEN decode instruction (previous instruction address,
+ previous actual address, previous opcode, FALSE)
+ FI ;
+ code lines neu := TRUE ;
+ CASE 22 {A} : auto trace := TRUE ;
+ key := "S"
+ CASE 23 {B} : get breakpoint address from user
+ CASE 24 {C} : resetbit (return segment, 7) ;
+ ueberschrift neu := TRUE
+ CASE 25 {D} : setbit (return segment, 6) ;
+ ueberschrift neu := TRUE
+ CASE 26 {E} : resetbit (return segment, 6) ;
+ ueberschrift neu := TRUE
+ CASE 27 {F} : out (""6""5""0"Sourcefile:"5"") ;
+ editget (source file name) ;
+ source file (source file name) ;
+ ueberschrift neu := TRUE ;
+ source lines neu := TRUE
+ CASE 37 {P} : out (""6""5""0"Protokollfile:"5"") ;
+ editget (prot file name) ;
+ prot file (prot file name)
+ CASE 39 {R} : forward trace := NOT forward trace ;
+ IF NOT forward trace AND previous opcode = "" AND
+ previous instruction address <> minus one
+ THEN decode instruction (previous instruction address,
+ previous actual address, previous opcode, FALSE)
+ FI ;
+ ueberschrift neu := TRUE ;
+ code lines neu := TRUE
+ ENDSELECT
+ FI .
+
+kopf schreiben :
+ out (""6""5""0""5"") ;
+ IF ueberschrift neu
+ THEN schreibe ueberschrift ;
+ ueberschrift neu := FALSE
+ FI ;
+ IF source lines neu
+ THEN schreibe source lines ;
+ source lines neu := FALSE
+ FI ;
+ IF code lines neu
+ THEN IF forward trace
+ THEN show decoded opcode (next opcode,
+ actual instruction address, TRUE, TRUE)
+ ELIF previous instruction address <> minus one
+ THEN show decoded opcode (previous opcode,
+ previous actual address, TRUE, TRUE)
+ ELSE out (""6""5""0"Kein vorhergehender Befehl")
+ FI ;
+ code lines neu := FALSE
+ FI .
+
+schreibe ueberschrift :
+ out (""1"") ;
+ put (breakpoint nr) ;
+ IF forward trace
+ THEN put ("F") (* forward *)
+ ELSE put ("R") (* result *)
+ FI ;
+ IF bit (return segment, 4)
+ THEN out ("u") (* ARITHU *)
+ ELSE out ("s")
+ FI ;
+ IF bit (return segment, 6)
+ THEN out ("d") (* Disablestop *)
+ ELSE out ("e")
+ FI ;
+ IF bit (return segment, 7)
+ THEN put ("E") (* iserror *)
+ ELSE put (" ")
+ FI ;
+ put ("lbas:") ; put (hex16 (lbas)) ;
+ out ("stack(") ; out (hex16 (stptr)) ; put ("):") ;
+ out (hex16 (getword (local data segment, stptr))) ; out ("-") ;
+ put (hex16 (getword (local data segment, stptr ADD 1))) ;
+ put ("pbas:") ; put (hex8 (packet base)) ;
+ put ("c8k:") ; put (hex8 (c8k)) ;
+ IF valid source
+ THEN out ("""") ; outsubtext (source file name, 1, 19) ; put ("""")
+ FI ;
+ out (""5"") .
+
+schreibe source lines :
+ out (""1""10"") ;
+ IF valid source AND source line <> ""
+ THEN put (text (actual line number, 4)) ;
+ put ("|") ;
+ outsubtext (source line, 1, 72) ;
+ out (""5"") ;
+ line ;
+ IF LENGTH source line <= 72
+ THEN put (text (actual line number +1, 4)) ;
+ put ("|") ;
+ toline (source, actual line number +1) ;
+ out (subtext (source, 1, 72)) ;
+ out (""5"") ;
+ toline (source, actual line number) ;
+ line
+ ELSE put ("_____|") ;
+ outsubtext (source line, 73, 144) ;
+ out (""5"") ;
+ line
+ FI
+ FI .
+
+valid source :
+ exists (source file name) .
+
+get breakpoint address from user :
+ put ("N„chste Breakpointaddresse (hex) in Segment 3:") ;
+ statement line := hex16 (next instruction address) ;
+ editget (statement line) ;
+ user address := integer (statement line) ;
+ opcode := "" ;
+ statement line := "" ;
+ address := user address ;
+ bool result (FALSE) ;
+ decode (code segment 3, address, statement line,
+ opcode, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ;
+ show decoded opcode (opcode, user address, TRUE, TRUE) ;
+ code lines neu := FALSE .
+
+singlestep :
+ IF is return opcode
+ THEN set breakpoint behind previous call
+ ELIF was bool result AND NOT is call opcode
+ THEN set first breakpoint behind branch instruction ;
+ set second breakpoint at branch address
+ ELIF is bool return opcode
+ THEN set first breakpoint behind branch instruction at return address ;
+ set second breakpoint at branch address of branch instruction at
+ return address
+ ELIF is brcomp opcode
+ THEN set computed branch breakpoint
+ ELIF is branch instruction
+ THEN set breakpoint at branch address
+ ELIF is call opcode AND NOT auto trace CAND segment 3 module CAND
+ ask if subroutine trace
+ THEN write protocoll (" Subroutine Trace") ;
+ protocoll line ;
+ calculate subroutine segment and address ;
+ set breakpoint behind next instruction
+ ELSE set breakpoint behind next instruction
+ FI .
+
+ask if subroutine trace :
+ IF forward trace
+ THEN yes (""6""5""0"Subroutine Trace")
+ ELSE show decoded opcode (next opcode, actual instruction address, FALSE, FALSE) ;
+ yes (""6""6""0"Subroutine Trace"5"")
+ FI .
+
+is line number :
+ actual opcode = ln opcode OR (* Kein LONGA, da ln < 4095 *)
+ actual opcode = lnlong opcode .
+
+is branch instruction :
+ actual opcode = br opcode OR
+ actual opcode = brlong opcode .
+
+is conditional branch :
+ op word = bf opcode OR op word = bflong opcode OR
+ op word = bt opcode OR op word = btlong opcode .
+
+is brcomp opcode :
+ actual word = brcomp opcode .
+
+is return opcode :
+ actual word = rtn opcode .
+
+is bool return opcode :
+ actual word = rtnt opcode OR
+ actual word = rtnf opcode .
+
+is call opcode :
+ actual opcode = call opcode OR
+ actual word = pcall opcode .
+
+read source line :
+ actual line number := actual word ;
+ split word (actual line number, lowbyte) ;
+ actual line number := (actual line number * 2) AND 6 ;
+ IF actual word < 0
+ THEN actual line number INCR 1
+ FI ;
+ IF actual opcode = lnlong opcode
+ THEN actual line number INCR 8
+ FI ;
+ makeword (actual line number, lowbyte) ;
+ actual line number DECR 1 ;
+ source lines neu := TRUE ;
+ IF valid source
+ THEN IF lineno (source) = actual line number CAND source line <> ""
+ THEN (* nichts*)
+ ELIF actual line number >= 0 AND actual line number <= lines(source)
+ THEN toline (source, actual line number) ;
+ readrecord (source, source line)
+ ELSE source line := ""
+ FI
+ ELSE source line := ""
+ FI .
+
+set first breakpoint behind branch instruction :
+ op word := next instruction AND opcode mask ;
+ IF is conditional branch
+ THEN write protocoll (" ") ;
+ write protocoll (hex16 (next instruction address) + " ") ;
+ bool result (TRUE) ;
+ statement line := "" ;
+ opcode := "" ;
+ address := next instruction address ;
+ decode (code segment 3, next instruction address, statement line, opcode,
+ INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ;
+ write protocoll (opcode) ;
+ protocoll line ;
+ show decoded opcode (opcode, address, FALSE, FALSE) ;
+ IF NOT auto trace
+ THEN pause (20)
+ FI ;
+ next free breakpoint ;
+ set breakpoint (i, next instruction address) ;
+ ELSE putline ("Interner Fehler: Nach BOOL-Result folgt kein Branch"5"");
+ LEAVE singlestep
+ FI .
+
+set second breakpoint at branch address :
+ calculate branch address ;
+ next free breakpoint ;
+ set breakpoint (i, branch address) .
+
+set breakpoint at branch address :
+ next instruction := actual word ;
+ next instruction address := actual instruction address ;
+ calculate branch address ;
+ set breakpoint (breakpoint nr, branch address) .
+
+set first breakpoint behind branch instruction at return address :
+ IF (getword (local data segment, lbas + return segment offset) AND 7) = code segment 3
+ THEN next instruction address := getword (local data segment,
+ lbas + return address offset) ;
+ next instruction := getword (code segment 3, next instruction address) ;
+ c8k := getword (local data segment, lbas + c8k offset) AND 255 ;
+ set first breakpoint behind branch instruction
+ ELSE putline ("Trace bei Vorw„rtssprung beendet."5"")
+ FI .
+
+set second breakpoint at branch address of branch instruction at return address :
+ set second breakpoint at branch address .
+
+set computed branch breakpoint :
+ address := following word ;
+ IF address < 0 (* Local/Local Ref *)
+ THEN rotate (address, minus one) ;
+ address := (address AND 16 383) ADD lbas ;
+ IF bit (following word, 0)
+ THEN branch address := getword (getword (local data segment,
+ address ADD 1) AND 7,
+ getword (local data segment,
+ address))
+ ELSE branch address := getword (local data segment, address)
+ FI
+ ELSE branch address := getword (packet data segment,
+ address ADD packet base)
+ FI ;
+ IF switch out of range
+ THEN branch address := actual instruction address ADD 3
+ ELSE branch address := actual instruction address ADD branch address ADD 4
+ FI ;
+ set breakpoint (breakpoint nr, branch address) .
+
+switch out of range :
+ branch address < 0 OR
+ branch address > getword (code segment 3, actual instruction address ADD 2) .
+
+determine return address and breakpoint nr :
+ FOR x FROM 1 UPTO 10 REP
+ determine return address ;
+ determine breakpoint nr ;
+ PER ;
+ line ;
+ put ("Returnaddresse nicht gefunden:"5"") ;
+ out (text (return segment AND 3)) ;
+ putline (hex16 (return address)) ;
+ list breakpoints ;
+ reset breakpoints ;
+ enablestop ;
+ errorstop ("Falsche Returnaddresse") .
+
+determine return address :
+ fix local base ; (* Fix pcb's: RAM --> Leitblock *)
+ this local base := getword (local data segment, pcb (local base field)) ;
+ lbas := getword (local data segment, this local base +
+ previous local base offset) ;
+ c8k := getword (local data segment, this local base +
+ c8k offset) AND 255 ;
+ return segment := getword (local data segment, this local base +
+ return segment offset) ;
+ return address := getword (local data segment, this local base +
+ return address offset) ;
+ packet base := HIGH return segment ; (* Wort besteht aus zwei Teilen!*)
+ set parameters (lbas, packet base, minus one, c8k) ;
+ stptr := lbas ADD 4 ;
+ DEC return address ; (* auf CALL breakpointhandler (ein Wort zurck) *)
+ IF bit (return segment, 7) (* ISERR *)
+ THEN old error line := error line ;
+ old error code := error code ;
+ old error message := error message
+ FI ;
+ clear error ;
+ enablestop ;
+ IF trace channel > 0 AND trace channel <> channel
+ THEN old channel := channel ;
+ disablestop ;
+ continue (trace channel) ;
+ clear error ;
+ enablestop
+ FI .
+
+determine breakpoint nr :
+ FOR i FROM 1 UPTO nr of breakpoints REP
+ IF breakpoints (i).set CAND
+ breakpoints (i).address = return address
+ THEN breakpoint nr := i ;
+ breakpoint address := breakpoints (i).address ;
+ saved word := breakpoints (i).saved word ;
+ LEAVE determine return address and breakpoint nr
+ FI
+ PER .
+
+segment 3 module :
+ IF actual word = pcall opcode
+ THEN op word := following word ;
+ rotate (op word, minus one) ;
+ op word := (op word AND 16 383) ADD lbas ;
+ LEAVE segment 3 module WITH (getword (local data segment,
+ op word ADD 1) AND 7) = code segment 3
+ ELSE op word := actual word AND 1023 ;
+ IF actual word < 0
+ THEN op word INCR 1024
+ FI ;
+ FI ;
+ op word >= 1280 .
+
+calculate subroutine segment and address :
+ IF actual word = pcall opcode
+ THEN next instruction address := getword (local data segment, op word)
+ ELSE next instruction address := getword (packet data segment,
+ begin of module nr link table + op word)
+ FI ;
+ INC next instruction address . (* Ab PENTER tracen *)
+
+calculate branch address :
+ branch address := next instruction ;
+ split word (branch address, low byte) ;
+ branch address := (branch address * 2) AND 6 ;
+ IF next instruction < 0
+ THEN branch address INCR 1
+ FI ;
+ IF branch long
+ THEN branch address INCR 8
+ FI ;
+ branch address INCR HIGH next instruction address ;
+ IF branch address >= c8k
+ THEN branch address DECR 16
+ FI ;
+ makeword (branch address, lowbyte) .
+
+branch long :
+ bit (next instruction, 10) .
+
+execute saved instruction :
+ putword (local data segment, this local base + return address offset,
+ return address) ;
+ putword (local data segment, this local base + return segment offset,
+ return segment) .
+
+
+set breakpoint behind next instruction :
+ IF is line number THEN read source line FI ;
+ set breakpoint (breakpoint nr, next instruction address) .
+
+
+set breakpoint behind previous call :
+ return segment := getword (local data segment,
+ lbas + return segment offset) AND 3 ;
+ return address := getword (local data segment,
+ lbas + return address offset) ;
+ IF return segment = code segment 3
+ THEN set breakpoint (breakpoint nr, return address)
+ ELSE putline ("Trace bei Rcksprung beendet."5"")
+ FI .
+
+next free breakpoint :
+ FOR i FROM 1 UPTO nr of breakpoints REP
+ IF NOT breakpoints (i).set
+ THEN LEAVE next free breakpoint
+ FI
+ PER ;
+ putline ("Alle " + text(nr of breakpoints) + " Breakpoints sind belegt"5"") ;
+ LEAVE singlestep
+
+ENDPROC breakpoint handler ;
+
+
+PROC show decoded opcode (TEXT CONST opcode, INT CONST address,
+ BOOL CONST zweizeilig, oben) :
+ IF oben
+ THEN out (""6""3""0"")
+ ELSE out (""6""5""0"")
+ FI ;
+ put (hex16 (address)) ;
+ put ("|") ;
+ outsubtext (opcode, 1, 72) ;
+ out (""5"") ;
+ line ;
+ IF zweizeilig
+ THEN put (" |") ;
+ outsubtext (opcode, 73, 144) ;
+ out (""5"") ;
+ line
+ FI
+
+ENDPROC show decoded opcode ;
+
+
+PROC decode instruction (INT VAR address, actual address, TEXT VAR opcode,
+ BOOL CONST var) :
+
+ INT VAR actual word, actual opcode, temp address ;
+ TEXT VAR statement line := "" ;
+ opcode := "" ;
+ temp address := address ;
+ actual address := address ;
+ actual word := getword (code segment 3, temp address) ;
+ actual opcode := actual word AND opcode mask ;
+ bool result (FALSE) ;
+ IF is param push opcode
+ THEN opcode := module with actual params (temp address, actual address) ;
+ ELSE decode (code segment 3, temp address,
+ statement line, opcode,
+ INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ;
+ FI ;
+ IF var THEN address := temp address FI .
+
+is param push opcode :
+ actual opcode = pp opcode OR
+ actual word = pproc opcode OR
+ actual word = longa pp opcode OR
+ actual word = longa ppv opcode OR
+ actual opcode = ppv opcode .
+
+ENDPROC decode instruction ;
+
+
+TEXT PROC module with actual params (INT VAR address, actual address) :
+
+ TEXT VAR result, statement line, symbol, type text ;
+ INT VAR end address, start address := address, module nr,
+ actual word, actual opcode ;
+ BOOL VAR known paramtypes, was bool result ;
+
+ skip until next call opcode ;
+ determine module name and module nr ;
+ collect actual parameters ;
+ perhaps result type ;
+ bool result (was bool result) ;
+ address := end address ;
+ result .
+
+skip until next call opcode :
+ actual word := getword (code segment 3, address) ;
+ REP
+ IF (actual word AND hex 7f00) = hex 7f00 (* LONGA oder ESC *)
+ THEN INC address
+ FI ;
+ INC address ;
+ actual word := getword (code segment 3, address) ;
+ actual opcode := actual word AND opcode mask ;
+ UNTIL is call opcode PER .
+
+determine module name and module nr :
+ result := "" ;
+ statement line := "" ;
+ actual address := address ; (* Addresse des CALL/PCALL Befehls *)
+ decode (code segment 3, address, statement line, result,
+ INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ;
+ was bool result := bool result ;
+ bool result (FALSE) ;
+ end address := address ;
+ module nr := int (last actual parameter) ;
+ statement line := module name and specifications (module nr) ;
+ scan (statement line) ;
+ IF statement line = ""
+ THEN symbol := "(" ;
+ known paramtypes := FALSE ;
+ actual word := getword (code segment 3, start address) ;
+ actual opcode := actual word AND opcode mask ;
+ IF is call opcode (* Hidden ohen Result und Parameter *)
+ THEN LEAVE module with actual params WITH result
+ ELSE result CAT " (" (* Result wird als VAR Parameter betr.*)
+ FI
+ ELSE nextsymbol (symbol) ; (* Skip Name *)
+ nextsymbol (symbol) ;
+ known paramtypes := TRUE ;
+ IF symbol = "" (* Weder Parameter, noch Result *)
+ THEN LEAVE module with actual params WITH result
+ ELIF symbol = "("
+ THEN result := subtext (result, 1, pos (result, "(")) ;
+ ELSE result := subtext (result, 1, pos (result, "-->")-2)
+ FI ;
+ FI ;
+ address := start address . (* Rcksetzen auf ersten param push *)
+
+collect actual parameters :
+ IF symbol <> "("
+ THEN LEAVE collect actual parameters
+ FI ;
+ REP
+ nextsymbol (symbol) ;
+ IF symbol = "ROW"
+ THEN typetext := "ROW..." ;
+ nextsymbol (symbol) ; (* ROW-Size *)
+ skip until end of type (symbol) ;
+ ELIF symbol = "STRUCT"
+ THEN typetext := "STRUCT..." ;
+ nextsymbol (symbol) ;
+ skip over brackets (symbol) ;
+ ELIF symbol = "<" (* HIDDEN *)
+ THEN typetext := "<HIDDEN>" ;
+ nextsymbol (symbol) ;
+ nextsymbol (symbol) ;
+ nextsymbol (symbol) ;
+ ELIF symbol <> "PROC"
+ THEN typetext := symbol ;
+ nextsymbol (symbol)
+ FI ; (* symbol jetzt 'PROC', 'CONST' oder 'VAR' *)
+ IF getword (code segment 3, address) = pproc opcode
+ THEN result CAT "PROC " ;
+ type text := "" ;
+ decode (code segment 3, address, statement line, type text,
+ INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ;
+ result CAT subtext (type text, 13) ;
+ next symbol (symbol) ;
+ IF symbol = "(" THEN skip over brackets (symbol) FI
+ ELSE IF statement line <> "" (* Keine Hidden PROC *)
+ THEN result CAT typetext ;
+ result CAT " " ;
+ result CAT symbol ; (* CONST oder VAR *)
+ result CAT ":" ;
+ typetext := ":" + typetext ; (* Fr Pos-Suche *)
+ nextsymbol (symbol) ; (* Jetzt auf ',' oder ')' *)
+ FI ;
+ IF (getword (code segment 3, address) AND hex 7f00) = hex 7f00 (* ESC OR LONGA *)
+ THEN result CAT data representation (getword (code segment 3,
+ address ADD 1), code segment 3, address, object type) ;
+ INC address
+ ELSE result CAT data representation (getword (code segment 3, address)
+ AND hex 83ff, code segment 3, address, object type)
+ FI ;
+ INC address
+ FI ;
+ actual word := getword (code segment 3, address) ;
+ actual opcode := actual word AND opcode mask ;
+ IF symbol <> ")" AND NOT is call opcode
+ THEN result CAT ", "
+ FI ;
+ UNTIL symbol = ")" OR is call opcode PER ;
+ result CAT ")" .
+
+perhaps result type :
+ WHILE symbol <> "" REP nextsymbol (symbol) UNTIL symbol = ">" PER ; (* --> *)
+ IF symbol <> ""
+ THEN nextsymbol (symbol) ;
+ IF symbol = "ROW"
+ THEN symbol := "ROW..." ;
+ ELIF symbol = "STRUCT"
+ THEN symbol := "STRUCT..." ;
+ ELIF symbol = "<" (* HIDDEN *)
+ THEN symbol := "<HIDDEN>" ;
+ FI ;
+ type text := ":" ;
+ type text CAT symbol ;
+ result CAT " --> " ;
+ result CAT symbol ;
+ IF symbol = "BOOL" (* BOOl-Result nicht mit PP *)
+ THEN LEAVE perhaps result type
+ FI ;
+ result CAT ":" ;
+ IF (getword (code segment 3, address) AND hex 7f00) = hex 7f00 (* ESC OR LONGA *)
+ THEN result CAT data representation (getword (code segment 3,
+ address ADD 1), code segment 3, address, object type) ;
+ INC address
+ ELSE result CAT data representation (getword (code segment 3, address)
+ AND hex 83ff, code segment 3, address, object type)
+ FI ;
+ INC address
+ FI .
+
+object type :
+ IF known paramtypes
+ THEN INT CONST p := pos (types, type text) ;
+ IF p = 0
+ THEN 0 (* Try Type auch bei STRUCT/ROW *)
+ ELSE code (types SUB (p-1))-63
+ FI
+ ELSE 0 (* Try all types *)
+ FI .
+
+types :
+ "B:BOOL I:INT R:REAL S:TEXT T:TASK D:DATASPACE D:FILE S:THESAURUS" .
+
+is call opcode :
+ actual opcode = call opcode OR
+ actual word = pcall opcode .
+
+ENDPROC module with actual params ;
+
+
+PROC skip until end of type (TEXT VAR symbol) :
+ nextsymbol (symbol) ;
+ IF symbol = "ROW"
+ THEN nextsymbol (symbol) ; (* ROW-Size *)
+ skip until end of type (symbol)
+ ELIF symbol = "STRUCT"
+ THEN next symbol (symbol) ;
+ skip over brackets (symbol)
+ ELSE nextsymbol (symbol) (* steht auf ',' oder ')' *)
+ FI
+
+ENDPROC skip until end of type ;
+
+
+PROC skip over brackets (TEXT VAR symbol) :
+ REP
+ next symbol (symbol) ;
+ IF symbol = "(" THEN skip over brackets (symbol) FI
+ UNTIL symbol = ")" PER ;
+ nextsymbol (symbol)
+
+ENDPROC skip over brackets ;
+
+
+INT OP HIGH (INT CONST word) :
+ INT VAR highbyte := word, lowbyte ;
+ split word (highbyte, lowbyte) ;
+ highbyte
+
+ENDOP HIGH ;
+
+
+PROC fix local base :
+ (* Kein direkter EXTERNAL-Aufruf, da bei 'CALL' lbas auf Stack gelegt wird*)
+ REP UNTIL incharety = "" PER ; (* Damit pause ausgefhrt wird *)
+ internal pause (0) (* ^ War Grund fr 'falsche Returnaddresse'*)
+
+ENDPROC fix local base ;
+
+
+PROC reset breakpoints :
+ INT VAR i ;
+ FOR i FROM 1 UPTO nr of breakpoints REP
+ IF breakpoints (i).set
+ THEN reset breakpoint (i)
+ ELSE breakpoints (i) := init breakpoint
+ FI
+ PER
+
+ENDPROC reset breakpoints ;
+
+
+PROC reset breakpoint (INT CONST nr) :
+ IF nr < 1 OR nr > nr of breakpoints
+ THEN errorstop ("Unzulaessige Breakpoint Nummer")
+ ELIF NOT breakpoints (nr).set
+ THEN display ("Warnung: Breakpoint " + text (nr) + " war nicht gesetzt")
+ ELSE putword (code segment 3, breakpoints (nr).address, breakpoints (nr).saved word) ;
+ breakpoints (nr) := init breakpoint
+ FI
+
+ENDPROC reset breakpoint ;
+
+
+PROC set breakpoint (INT CONST nr, address) :
+ INT VAR new word ;
+ IF nr < 1 OR nr > nr of breakpoints
+ THEN errorstop ("Unzulaessige Breakpoint Nummer")
+ ELIF breakpoints (nr).set
+ THEN errorstop ("Breakpoint " + text (nr) + " ist bereits gesetzt")
+ ELSE breakpoints (nr).address := address ;
+ breakpoints (nr).saved word := get word (code segment 3, address) ;
+ new word := call opcode + (handler module AND 1023) ;
+ IF handler module >= 1024
+ THEN setbit (new word, 15)
+ FI ;
+ putword (code segment 3, address, new word) ;
+ IF getword (code segment 3, address) <> new word
+ THEN errorstop ("Addresse Schreibgeschuetzt")
+ ELSE breakpoints (nr).set := TRUE
+ FI
+ FI
+ENDPROC set breakpoint ;
+
+
+PROC handlers module nr (INT CONST module nr) :
+ handler module := module nr
+ENDPROC handlers module nr ;
+
+
+INT PROC handlers module nr :
+ handler module
+ENDPROC handlers module nr ;
+
+
+INT PROC module number (PROC proc) :
+
+ EXTERNAL 35
+
+ENDPROC module number ;
+
+
+PROC internal pause (INT CONST time) :
+
+ EXTERNAL 66
+
+ENDPROC internal pause ;
+
+
+PROC term :
+
+ EXTERNAL 4
+
+ENDPROC term ;
+
+
+PROC set breakpoint :
+ INT VAR i ;
+ handlers module nr (module number (PROC breakpointhandler)) ;
+ auto trace := FALSE ;
+ source lines neu := TRUE ; (* Zum L”schen *)
+ source file ("") ;
+ prot file ("") ;
+ actual line number := minus one ;
+ previous instruction address := minus one ;
+ with object address (FALSE) ;
+ INT VAR module nr ;
+ add modules ;
+ get module number (module nr) ;
+ IF code segment (module nr) <> code segment 3
+ THEN errorstop ("PROC/OP liegt nicht im Codesegment 3")
+ FI ;
+ naechsten freien breakpoint setzen ;
+ put ("Breakpoint") ;
+ put (i) ;
+ putline ("wurde gesetzt.") .
+
+naechsten freien breakpoint setzen :
+ FOR i FROM 1 UPTO nr of breakpoints REP
+ IF NOT breakpoints (i).set
+ THEN set breakpoint (i, code address (module nr) ADD 1) ;
+ LEAVE naechsten freien breakpoint setzen
+ FI
+ PER ;
+ errorstop ("Alle " + text (nr of breakpoints) + " Breakpoints sind belegt").
+
+ENDPROC set breakpoint ;
+
+
+PROC list breakpoints :
+ INT VAR header address, mod nr, i ;
+
+ line ;
+ putline (" Nr Set Address Word Module") ;
+ FOR i FROM 1 UPTO nr of breakpoints REP
+ put (text (i, 2)) ;
+ IF breakpoints (i).set
+ THEN put (" Y ")
+ ELSE put (" N ")
+ FI ;
+ out ("3") ;
+ put (hex16 (breakpoints (i).address)) ;
+ put (" ") ;
+ put (hex16 (breakpoints (i).saved word)) ;
+ IF breakpoints (i).set
+ THEN next module header (code segment 3, breakpoints (i).address,
+ header address, mod nr) ;
+ IF module name and specifications (modnr - 1) = ""
+ THEN put ("Hidden: PACKET") ; put (packet name (modnr -1)) ;
+ ELSE put (module name and specifications (modnr -1))
+ FI
+ FI ;
+ line
+ PER
+
+ENDPROC list breakpoints ;
+
+ENDPACKET tracer ;
+
+init module table ("table.module") ;
+type (""27"q") ;
+note ("") ;
|