TOS Silver 2000/TOS Silver 2000.iso/programm/MM2_DEV/S/COMP/MM2COMP.I

Text File | 1994-08-17 | 125.4 KB | 3 lines

⓪ IMPLEMENTATION MODULE MM2Comp;⓪ (*$ z-,m-,r-,l-,q+,p+,v+,c-,g+ *)⓪ ⓪ (* -----------------------------------------------------⓪#Modula Compiler  /4.3 /  fuer Atari ST⓪#-----------------------------------------------------⓪#File mc1: Compiler-Rumpf, Statement-Uebersetzung⓪#⓪#17.10.85     Auswertung von AutoCommands⓪#21.02.86     LastGSD2 deklariert fuer Assembler⓪#22.02.86     Neuordnung der Texte⓪#26.02.86     esc-Konstante definiert;⓪0Codes fuer RunErrFile- und RunAskName-⓪0AutoCommands vertauscht;⓪0Default-Setzung der Compileroptions nach Neustart/⓪1neue Compilation Unit getrennt⓪#21.03.86     (TT) Assembler : LINK-Instr. berichtigt (V#0738)⓪#14.04.86     richtige Fehlermeldung bei lok. Modulen (Nr. 109);⓪0$Konfig-Option abfragen, Default auf K-.⓪#15.04.86     DirectLoc, LastOffs als ZW fuer Open-Array-Zugriff.⓪#16.04.86     Array/Record Zuweisung mit Inline-Code uebersetzen⓪#21.04.86     Default fuer $K ist K+⓪#11.07.86     Assign kopiert jetzt auch Array/Record vom Stack;⓪0in FormRes Array & Record als Funkt.Ergebnis zugelassen⓪#28.07.86     EXIT aus WITH restauriert jetzt den A2-Pointer vor der⓪0auessersten WITH-Anweisung⓪#08.09.86     neues Modula-Symbol -> FirstAsmSbl, AND, OR, NOT erhoeht⓪0'FROM Module IMPORT IdList' in lok. Module erlaubt⓪#09.09.86     ASSEMBLER ... END alternativ zur $A-Option⓪#06.10.86     Var. OpenConds fuer Conditional Comments eingefuehrt;⓪0StorVar synchronisiert alle (!) Parameter auf gerade Adressen⓪#15.10.86     Export von Aufzaehlungstypen aus lokalen Modulen (LocXp);⓪0Import dito (ImpId, SetRelay, MarkId, MakeId);⓪0TypPtr fuer Word/Long/Address entfallen;⓪0Standardprozeduren nicht mehr als res. Worte behandelt⓪#16.10.86     Voreinstellung der Option G+ in OpToSet;⓪0dLayout = 3 wegen neuer Pseudo/System-Module;⓪0Statseq: nach Stat10 auf Stat17 verzweigen⓪#17.10.86     MinReal, MaxReal eingefuehrt;⓪0EXCL / INCL / INC / DEC fuer Bytes modifiziert;⓪0Assign fuer einzelne Bytes⓪3(nicht fuer Rec/Arr ungerader Laenge!);⓪0CASE fuer Byte-Selektoren (durch Expandieren des Selektors);⓪0FOR fuer Byte-Laufvar.⓪#18.10.86     DefVolume als Default fuer DefMod-Suche (bisher #A0: - tsk!)⓪#20.10.86     Reihenfolge Excl/Incl in StandardProc-Sprungtabelle vertauscht⓪#22.10.86     Block16 synchronisiert VarSpace am Ende jedes Dekl.teils;⓪0UProc erlaubt leere '()' wenn keine Parameter erwartet.⓪#23.10.86     Assign9 behandelt Array [..] of Char wie Strings (Atari);⓪0andere @StAs-Prozedur fuer Atari-Version!⓪#24.10.86     ConstExpr statt ConstEx; Typ kommt jetzt auf IntStack zurueck,⓪0naechstes Symbol ist schon geholt!⓪#25.10.86     Pointer als Argument in INC/DEC zugelassen⓪#26.10.86     String-Assignment: in der Gepard-Version Laenge der Source⓪0synchronisiert uebergeben!⓪#28.10.86     IOTRANSFER erwartet Address als Exception-Vektorangabe;⓪0Buffer und Groessenkonst. fuer SETs auf max. 2^16 Elemente⓪$1.11.86     Assign benutzt fuer Strings gleicher Laenge normale Zuweisung⓪$2.11.86     Assign orientiert sich bei skalaren Zuw. an der Dest-Laenge⓪0(wg. Anpassung Short -> LongTypen)⓪$8.11.86     PROCESS-Typ durch ADDRESS ersetzt⓪#30.11.86     mehrere DC.L in einer Zeile vermieden (Assembler-Fehler)⓪$3.12.86     aReturn erzeugt Code fuer Laengenanpassung, wenn ein String⓪0Funktionsergebnis ist⓪#19.12.86     in FpSect Deklaration von Open Array als ValPar erlaubt;⓪#20.12.86     StorVar markiert Open Arrays IMMER als VAR-Parameter (weil⓪0sie als lokale Variablen immer so zu behandeln sind).⓪#11. 1.87     Table.D erzeugt 8 Byte pro Table-Element⓪#14. 1.87     RealConst-Format umschaltbar⓪#18. 1.87     CopyArrays, ProcDesc (OpenArr by Val) wieder raus⓪#29. 1.87     neue Variable AdrOnStk gibt an, ob die Adresse der im folgenden⓪1aufzurufenden Proc auf (A7) steht (bei ProcVar-Call)⓪#31. 1.87     nach jedem ProcCall wird ReleaseArrays aufgerufen, um ggf.⓪1angelegte Kopien von Open Arrays zu loeschen⓪#15. 2.87     UseFormat wird jetzt fuer jedes Modul auf 2 gesetzt.⓪#16. 2.87     Strings (bei Atari auch Array of Char) werden stets mit⓪2byteweisem Zugriff umkopiert;⓪$1. 3.87 TT  Anpassungen für Atari-MOS in Importen, sowie bei Allocate-⓪0Aufruf; String-Variablen alle nun 80 Zeichen lang; SysReturn-⓪0Aufruf am Ende v. 'Comp' weg, dafür Retten v. A1/A2/A4.⓪#25. 3.87     Atari: Zuweisung kurzerString := langerString verboten⓪2(Assign0);⓪#30.03.87  TT ARGCV nicht mehr importiert.⓪#07.04.87  TT XtendedCode und RealIsUsed - Flags -> Kennung wird gesetzt⓪#08.04.87  TT Gepard: Set auf 256 Elem, beschr., wg. Speichermangel⓪0bei 512 KB Systemen⓪#12.04.87  TT 6 pTxt...-Variablen definiert für Assembler; GdosTypes import.;⓪0ReadChar aus Console import.; Option $W für Warnings (Default⓪0ist $W+); Warnigs für Compiler erstmal ausgeschaltet.⓪0Achtung !!! Auch der Compiler ist hier fehlerhaft ! A3 muß⓪0statt nach 'EvalStack' geladen zu werden, mit 'SaveHP'⓪0gesichert werden !⓪#13.04.87  TT neue Versionsnummer 3.4; UseFormat wird jetzt⓪0für jedes Modul zurückgesetzt⓪#16.06.87     geforderte Platzreserve in Codespc auf $400 verdoppelt⓪2(wegen gelegentlicher Abstürze)⓪#16.06.87     SetLänge für Atari-Version halbiert (Long -> Short);⓪0Realformat-Kennung im Header nur bei Gepard-Modulen!⓪#24.06.87     FROM LocalModule IMPORT zugelassen (aImport);⓪#26.06.87     Atari: LINK #0 auch im Modulbody;⓪0BackOpt für Rückschaltung auf vorige CompOption mit $ x=;⓪#27.06.87     Module lokal zu Prozeduren zugelassen:⓪2(ModDec) Prüfung auf globale Deklaration rausgenommen;⓪2(ImpId, LocXp, SetRelay) Eintrag der ScopeDifferenz in⓪2Relay-Einträgen⓪#28.06.87     ImpId sucht ID beim Relay-Anlegen in dem Scope, wo er auch⓪2gefunden wurde;⓪0Block: versuchsweise lokale Forward-Dekl. erlaubt⓪#29.06.87     'OpenFwds' zählt in lokalen Scopes offene FWD-Deklarationen⓪2(OldHead, Block)⓪#30.06.87     aFOR erkennt auch Integer-Subrange als signed⓪#02.07.87     Source- und Modulnamen in Atari-Module;⓪0aRETURN räumt auch in Prozeduren vor UNLINK-Aufruf (putRET)⓪1den Stack ab (wegen neuer Atari-Konvention: erst LINK, dann⓪1Register retten); bei $L- entfällt Fehler rRetFo. (?gehts?)⓪#03.07.87     Variable StackReserve: Mindestplatz für Runtime-Stackcheck⓪#04.07.87     Strings.Insert importiert (für IO-Module);⓪0auch lokale fehlende FORWARD-Impl. über TravTre suchen;⓪0Atari: $S schaltet Prozeduranfangs-Stackcheck (Block10)⓪#08.07.87     Aufrufe FinExp/FinVar vertauscht (IPMod)⓪#14.07.87 TT  ARETURN korrgiert (ADD.W #XX,A7 wurde nie ausgeführt, weil⓪0eine alte Anweisung übriggeblieben war.⓪#21.07.87 TT  LINK-Erzeugung in Modulbody wieder raus.⓪#22.07.87 TT  LISTEN-Anweisung impl. (aListen)⓪#23.07.87 TT  Priorität wird anders gesetzt: Wenn Body, dann wird direkt⓪0SetPriority aufgerufen, sonst wird's in put5 erledigt⓪0(vor Block11).⓪#03.11.87 TT  DefVolume wird nur bei Gepard hinter ClockStart gesetzt.⓪#16.11.87 jm  TxtLine (Zeile innerhalb des laufenden Textfiles, für⓪1Übergabe an Editor) wird nicht mehr für jedes Modul⓪1gesetzt. Startwert ist 0.⓪0TxtCol definiert (wird zur Fehlermeldung an Editor in⓪1Compio.ErrorEntry gesetzt).⓪0IOCall implementiert (aIOCall)⓪#17.11.87     Korrektur für IOCALL: Obergrenze 4 in SysProc;⓪0aListen erlaubt optional leere Argument-Klammern⓪#15.12.87     SerLead vor Seriennummern: tarnt Seriennummern als Operanden;⓪1ermöglicht eindeutiges Finden durch Patch-Programm⓪#18.12.87     aReturn: ERST Ergebnis-Expression ausrechnen,⓪1DANN ggf. Stack-Reste abräumen!⓪#22.12.87 TT  Text-I/O über FileBase statt TextWindows⓪#11.01.88     'ProcNames' definiert (Flag: "vor ProcBody Namen der⓪2Prozeduren einfügen") und ausgewertet (bei Block16)⓪#16.01.88 TT  Nach Proc-Namen wird Verkettungs-^ abgelegt.⓪#17.01.88 TT  'ProcNames' nun als Comp-Option (M(ark procedures, Default: +),⓪0Innerhalb des Codes bewirkt Rückschalten auf $M- nur, daß⓪0leere Namen abgelegt werden, also immer noch 8 Byte pro Proz.⓪#03.04.88 TT  Version 3.5h wg. aVal m. unterschiedl. Sizes⓪#15.04.88     Längenliste für Procs vorbereitet⓪#18.05.88     neues Format der Längenliste: enthält immer {Adresse Länge};⓪1bei globalen Prozeduren ist die Adresse der Beginn der⓪1zugehörigen lokalen Prozeduren, sonst immer die Anfangs-⓪1adresse (des Modulrumpfs, des Tables) selbst.⓪0Dazu Baumeintrag für Prozeduren, TABLEs, Module um zus.⓪1Long-Feld mit relativer Anfangsadresse der lokalen Procs⓪1erweitert.⓪0Modul-Layout-Kennung auf 2 erhöht.⓪#28.05.88 TT  Proc-Entry-Code optimiert (bedingter Aufruf von Runtime-⓪1Hilfsroutinen) (siehe !tt 28.5.88);⓪#29.05.88 TT  In Header steht auf Offset 42 ein Pointer.L auf den Beginn⓪1des Codes, also dem Ende des Headers.⓪#05.06.88 TT  Damit Key-Berechnung sich nicht ändert, wird im Baum f.⓪1Prozedureinträge bei Def-Modulen 8 Byte weniger (wie vorm⓪118.5.) angelegt (NEWPROC).⓪#07.06.88 TT  ModDec: Abfrage des Flags 'ProcNames'.⓪#10.06.88 TT  InOutBase statt FileBase importiert.⓪#28.06.88     IDArg akzeptiert LONG im 2. Argument, wenn das erste LONG ist.⓪#29.06.88     Variable myScope für Record-Deklarationen (in Symbol.Icl);⓪0ImpId: findet den importierten ID auch, wenn er über⓪2Relay erreicht wird.⓪0MinReal und MaxReal an Atari-Realformat angepaßt.⓪0hinter Block10: Platzbedarf für lokale Vars wird vor Put5-⓪2Aufruf gerettet (ging kaputt, falls Put5 Priorität setzt).⓪#24.10.88 >>> VERSION 3.6h⓪#⓪#10.12.89     Nachtrag der Änderungen aus einteiligem Compiler:⓪#⓪)28.12.88     TravTre übersieht keine lokalen Module mehr⓪9beim Relozieren⓪*1.01.89     In TabDec wird ggf. ProcName abgelegt (14.07.88 TT)⓪*1.01.89     aCase: CASE-Syntax mit leeren Feldern korrigiert;⓪9stolpert nicht mehr über völlig fehlende '|'.⓪9Dazu neue Fehlermeldung Nr. 67 !!!⓪)29.01.89     fParm erkennt REF-Parameter und setzt bit9 im VarPar-Wort;⓪6StorVar laesst REF-Flag ($200) in D0;⓪6SetPar markiert REF-Parameter in Flagbit 0;⓪6Assign verbietet Zuweisung auf RefPar;⓪6provisorisch: WITH RefPar verboten!⓪6neue Fehlermeldung Nr. 89⓪*6.3.89      StorVar: läßt REF-Flag auch bei Open Arrays.⓪6SetPar verwechselt REF und VAR nicht mehr. REF-Parameter⓪9haben auch das VAR-Flag gesetzt!⓪)31.3.89      IDArg: 2. Parameter von INC, DEC jetzt Integer bzw.⓪9LongInt. (Änderung der erwarteten Typen und des Codes⓪9für Expansion des 2. Arguments bei INC (long, word);⓪9Kommentare mit ///)⓪6K-Option ist nur noch im Gepard-Modus für Konfiguration⓪7zuständig;⓪6K+ schaltet im Atari-Modus erweiterte Key-Berechnung ein.⓪7(Kommentare mit +++)⓪)02.07.89     neue Fehlermeldung rRefRs (REF-Restriktion, Nr. 85).⓪6Assign0 ruft bei Stringzuweisungen ungleicher Länge immer⓪7STAS auf.⓪)11.05.89 TT  (Nachtrag) In IDARG 2mal Compat durch ASCOMP ersetzt,⓪8damit sowohl INT als auch CARD als 2. Arg. bei INC/DEC⓪8gehen⓪)25.07.89 TT  LibFiles immer importiert; $Q+ ist nun default⓪)07.09.89     REFs sind mit Ausnahme von Open Arrays zunächst wieder⓪8verboten. Änderung in fpSect mit %%% markiert.⓪)08.11.89     (Symbol): T+ aktiviert invertierte Reihenfolge der⓪8FieldList⓪8⓪$13.12.89     Nachtrag der Änderungen aus TTs einteiligem Compiler:⓪$⓪)20.08.89 TT  IPMOD: "MM2Code" wird zu Beginn des Codes eingetragen⓪)31.08.89 TT  erw. Key-Berechnung nun immer (unabh. von $K-Option);⓪6FindError-Pos nun immer relativ zum echten Code-Beginn.⓪)03.09.89 TT  Options: $B- default⓪)09.09.89 TT  B-Option wird erst am Code-Ende übernommen⓪)20.09.89 TT  AWITH meldet bei REF-Parm rRefRs statt rRefPa-Fehler;⓪6$W+ ist default⓪)08.10.89 TT  Zum Decomprimieren wird nun mind. 12KB freigelassen,⓪6dazu intelligenterer Allocate-Aufruf;⓪6Assign meckert nicht mehr bei Aufruf einer Proc-Var als⓪6REF-Parameter.⓪)22.11.89 TT  OptForLink enthält alle unbenutzten Options⓪+⓪$13.12.89 jm  fpSect, oldPar: Deklaration von LONGARRAY OF <type> in⓪3Prozedurköpfen zugelassen; Eintrag in der Parameterkette⓪3wie Open Arrays, jedoch mit Kennung 42 statt 32.⓪1fpSect erlaubt Deklaration mehrdim. Open Arrays⓪3(Syntax {ARRAY OF} <type>). oldPar kommt sowieso schon⓪3damit klar.⓪1fpSect erlaubt Deklaration von REF-Parametern bei allen⓪3Typen.⓪1(Symbol) neues reserviertes Wort LONGARRAY (Nr. 71).⓪1(Symbol) VarDec legt Variablen stets auf gerade Adressen.⓪1(Import) neue Standardbezeichner VAL, LENGTH, LONGREAL;⓪:neuer System-Bezeichner CAST⓪1NewProc: Compileroption $E(xternal) für Prozeduren definiert:⓪4wenn E+ gesetzt ist, wird in der Proc.-Beschreibung⓪4Bit 3 gesetzt (sonst für VarPar-Kennung)⓪4-> Parameter-Übergabe über A7-Stack.⓪4!!! Wird bei der Parameterübernahme am Blockanfang⓪8noch nicht berücksichtigt!⓪$14.12.89 TT  Nachträge:⓪1TraceProc neu: bei $E+ wird Proc-Name durch Debug ausgegeben⓪1StatSeq: Ruft bei Proc-Type 'Assign' statt 'UProc' auf⓪$29.12.89 TT  fpsect: LONGARRAY hat nun endlich Kennung 42 (bisher 44)⓪$30.12.89 TT  Default nun $T+⓪$05.01.90 TT  StatSeq: leeres ASSEMBLER END nun möglich;⓪1Comp: TxtLine wird nun in CompIO init.⓪$27.01.90 TT  fpu() neu: Real-Format wird testweise erstmal über $F+/-⓪1gewählt. -- danach wird entweder für 'softReal' oder⓪1'externalFPU' entschieden. Um Code für eine PAK-881 zu⓪1generieren, müßte noch eine weitere Information ausgewertet⓪1werden: entweder über eine Comp-Option oder, wenn das system-⓪1format genommen werden soll, muß dies über 'MOSCtrl.UsedFPU'⓪1ermittelt werden.⓪$03.02.90 TT  StorVar markiert Open Arrays NICHT MEHR IMMER als VAR-Parms;⓪1ITEMS, SetVar, SetPar reservieren ein Word mehr compile-time-⓪1lokal im Tree f. Reg-Var-Verwaltung; Bei Procs ohne Ergebnis⓪1werden Parameter auf A3-Stack belassen.⓪$07.02.90 TT  TraceProc nun bei jedem RETURN, nicht nur am Proc-Ende;⓪1diverse Erweiterungen wg. Reg-Vars hier und in Symbol.VarDec;⓪1Reg-Vars können z.Zt. nur in Procs, jedoch nicht im Level von⓪1Modulen definiert werden. Entsprechend wird nur bei Proc-⓪1Entries überhaupt berücksichtigt, Regs f. Vars zu retten⓪$10.02.90 TT  Bei mehreren RETURNs in Proc-Body werden alle weiteren auf⓪1den ersten mit einem BRA gelenkt.⓪1Wenn EXIT-Stack voll, wird ebenso Sprung zum Forward-BRA des⓪1letzten EXITs generiert.⓪1Funktionsergebnisse <= 4Byte werden in Reg geliefert, sofern⓪1nicht extra $J- gesetzt ist. PrHead & SetType setzen dann⓪1Bit 4 im Flag-Byte des Proc-Items. Außerdem Anpassung in⓪1M2if wg. Compat-Vergleich Proc <-> Proc-Var⓪$18.02.90 TT  StorVar: Stackbedarf f. LONGARRAY nun korrekt auf 8 Byte;⓪$25.02.90 TT  fpSect: Bei $H+ werden 8 Byte f. PROC-Parms reserviert und⓪3neue Kennung 44 vergeben⓪1$K+ für Zuweisungskompat LONG -> SHORT reserviert⓪$01.03.90 TT  geforderte Platzreserve in Codespc auf $1000 vervierfacht⓪3(wegen Baum-Zerstörungen bei knappem Speicher)⓪$21.04.90 TT  Nun wieder Rückgabe über (A3) statt D0 als Default. Per $Z+⓪3kann nun die D0-Rückgabe aktiviert werden, $J hat keinen⓪3Einfluß mehr darauf.⓪1IMPORT: Key-Berechnung präzisiert (Item-Flags werden nun mit⓪3einbezogen), sollte nun auch unabhängig von Symbol-Erweite-⓪3rungen sein.⓪1$J+ löst nun bei nicht erfülltem CASE ohne ELSE Laufzeit-⓪3fehler aus.⓪1CASE nun auch mit LONGCARDs funktionsfähig⓪$20.07.90 TT  $U+ nun default (SETs nach neuem Format)⓪$30.07.90 TT  DLayout nun 5, da Record-Beschreibung f. Aggregate erweitert⓪$12.09.90 TT  RealConstUsed entfernt, ConFact setzt RealIsUsed selbst;⓪3fpu() setzt RealIsUsed nur bei IEEE-Reals, denn solange⓪3nur die MM2Real-Routinen aus Runtime benutzt werden, ist⓪3das Format egal, weil die für alle Modi vorhanden sind⓪3und Runtime selbst prüft, ob die ggf. benötigte FPU⓪3vorhanden ist.⓪$24.09.90 TT  fpSect: Auch bei LocalProc-Parms wird nun die $Z-Einstellung⓪1berücksichtigt/kopiert; OldPar/OldHead: vergleichen D0-⓪1Rückgabe-Flags bei Prozeduren/Prozedur-Typen; "Code" heißt⓪1nun "Header", zus. bezeichnet "CodeStart" den Beginn des⓪1echten Codes (Ende des Headers), rel.^ zum Code werden nun⓪1rel. zu "CodeStart" eingetragen; aExport meldet Fehler, wenn⓪1res. Worte exportiert werden (bisher wurde das nur beim 1.⓪1ID gemacht); LocXp exportiert nun den richtigen ID auch bei⓪1Relays; meldet Fehler bei $J+ und leerem CASE;⓪1ProcDec: Stellt am Ende einer Proc den RStkPtr wieder so⓪3her, wie er vorher war (Erklärung s. unten).⓪1AsComp20: Berücksichtigt keine Relays bei Parms mehr - die⓪3dürften doch bei Opaque-Nachdekl. gar nicht mehr vorkommen!?⓪1LocXp: Erlaubt nun auch EXPORT von lok. Impl. Procs, die global⓪3im Defmod exportiert wurden.⓪$10.10.90 TT  nun kann TT-FPU-Format extra angewählt werden (z.T. mit $F* )⓪$18.10.90 TT  CLRTRE prüft, ob Baum fehlerfrei war.⓪$20.10.90 TT  aCASE erzeugt ggf. SUBQ statt SUBI, erzeugt kein SUBI #0 mehr.⓪$11.11.90 TT  $[+ erreicht Parm-Übergabe auf A7, A5 wird dann als FramePtr⓪1benutzt und A6 bleibt frei.⓪1$\+ erreicht Parm-Übergabe nach Turbo-C.⓪$06.12.90 TT  Im Modulheader 8 longs reserviert⓪$08.12.90 TT  Bei TC gibt es zwei Rückgabemodi: bei 'cdecl' alles in D0,⓪1bei TC-Modus scalare in D0, pointer aber in A0. Um das in den⓪1Item-Flags zu unterscheiden, gibt es folg. Regeln:⓪1- wenn A7-Parm-Übergabe, wird die Rückgabe-Direktive ($Z)⓪3ignoriert und stattdessen immer eine optimierte Rückgabe im⓪3Reg angestrebt.⓪1- wenn TC-Parm-Übergabe, wird das Bit 0, das sonst f. $Z⓪3benutzt wird, gesetzt, um anzuzeigen, daß Pointer in A0⓪3statt D0 geliefert werden.⓪1In beiden Fällen muß die Entscheidung, ob ein Return-Wert⓪1vorliegt und ob er in ein Reg paßt, in 'funcCall' geschehen!⓪1Die Bits werden hier immer unabh. vom Rtn-Wert gesetzt!⓪$19.12.90 TT  Prio wird nur noch einmal gesetzt, und zwar zw. LINK und⓪1"pushRegs". Allerdings läuft es nicht auf dem Atari TT,⓪1da ein "MOVE from SR" erzeugt wird!⓪$20.12.90 TT  Korrektur zum 19.12.: Static Link wieder korrekt gesichert⓪$11.03.91 TT  AsComp20: Erkannte "isCompat", wenn die D0-Parm-Kette vor⓪1der D2-Kette aufhörte.⓪$28.03.91 TT  Version 4.1⓪$08.04.91 TT  SetRelay: Bei lok. Nachdekl. einer extern exportierten oder⓪1Forward-dekl. Proc wird der Relay-Ptr korrekt eingesetzt⓪1(zeigte bisher auf sich selbst); Export einer Proc. aus zwei⓪1Leveln von lok. Modulen geht nun; A5/A6 werden nun in Modulen⓪1lok. zu Procs nicht mehr zerstört (waren bisher freie Regs);⓪1kein spradischer Bus-Error mehr bei BEGIN von Modulen lok.⓪1zu Procs (^letzte Ref wurde an falscher Stelle reserviert -⓪12. dummy.L eingefügt bei 15er-Kennung); Wenn 'SuppressCode'⓪1TRUE, wird kein Code bei RETURN generiert.⓪$14.07.91 TT  Version 4.1b⓪1Größe d. ID-Stacks über "/In" bestimmbar, default = 2048.⓪$15.09.91 TT  Version 4.1c (s. MM2COMP2, SYMBOL.ICL)⓪1Bei TC-Übergabe werden auch Opaques und PROC-Types in Regs⓪1übergeben.⓪$13.10.91 TT  Version 4.1d: Scan-Offsets beim Protokoll stimmen jetzt wieder.⓪$20.11.91 TT  Version 4.2 wg. 0C-Anfügung bei String-Consts⓪$15.05.92 TT  MAC-Option: Proc-Namen am Ende der Proc (Achtung: Können von⓪1Linker nicht entfernt werden!)⓪$30.05.93 TT  Version 4.2b: kein Stack-Check mehr bei REF-Parms⓪$10.12.93 TT  Version 4.2c: TRAP f. vergessenes RETURN wird wieder erzeugt,⓪1allerdings nicht erzeugt, wenn in der äußersten Statement-⓪1Ebene der Funktion ein RETURN vorkam, denn dann ist sicher,⓪1daß man nicht mehr ans Ende der Funktion gelangen kann.⓪$13.12.93 TT  Prgheader: "prgFlags" wird auf 7 gesetzt (f. TT-RAM usw.);⓪1Version 4.3: DATA-Segment wird für Konstanten reserviert.⓪$16.01.94 TT  Das System-Real-Format wird nicht mehr über die installierte⓪1FPU sondern über die Var. RealMode ermittelt.⓪1V4.3b⓪$13.02.94 TT  A7- und Reg-Übergabe wird auch bei Definition von PROC-Types⓪1berücksichtigt.⓪1Dlayout nun 6 f. erweitertes Format des Def-Modulkopfes⓪1V4.3c⓪$03.06.94 TT  V4.3d wg. Korrektur bei verschachtelten Constructors⓪1(s. TREFIN.ICL)⓪1DynSpace, MaxSpace und DataLen konfigurierbar (s. OpenIO)⓪$-----------------------------------------------------⓪ *)⓪ ⓪ ⓪ FROM MM2Comp2 IMPORT adjustSubrange, aIncl, aExcl, boolExpr, assign, aFor,⓪3constExpr, expr, pushAdr, pushExpr, aWith, SuppressCode,⓪3freeVarRegs, aInc, aDec, aBegin, aEnd, getRegVar,⓪3initBlock, freeRegs,⓪3BITSETfromSYSTEM, discardA7, caseExpr, aCallSys, aCallExt,⓪3constExprZZ, aLoad, aStore;⓪ (*$C+*)IMPORT MM2Comp2;(*$C=*)⓪ ⓪ FROM Strings  IMPORT Pos, Concat, Delete, Length, Compare, Relation,⓪5PosLen, String;⓪ ⓪ FROM StrConv  IMPORT IntToStr, CardToStr, LHexToStr, StrToReal, StrToLCard,⓪5StrToCard;⓪ FROM Files    IMPORT Access, State, File, ReplaceMode;⓪ FROM Binary   IMPORT ReadBytes, WriteBytes, Seek, SeekMode, FileSize;⓪ FROM MOSGlobals IMPORT MemArea, PathStr, fInsufficientMemory;⓪ FROM RealCtrl IMPORT AnyRealFormat, Conv;⓪ FROM PrgCtrl  IMPORT TermCarrier, CatchProcessTerm,TermProcess, GetBasePageAddr;⓪ FROM Storage  IMPORT ALLOCATE, DEALLOCATE, MemAvail;⓪ FROM Lists    IMPORT ResetList, NextEntry;⓪ FROM Paths    IMPORT SearchFile, ListPos, MakeFullName;⓪ FROM PathCtrl IMPORT PathList, PathEntry;⓪ FROM PathEnv  IMPORT HomePath, ReplaceHome;⓪ FROM ShellMsg IMPORT ScanMode, ScanAddr, CodeName,⓪5CodeSize, ModuleName, ErrorMsg, TextName,⓪5DefPaths, ImpPaths, SrcPaths, ModPaths, Active, DefSfx,⓪5DefLibName, DefOutPath, ModOutPath, ImpOutPath,⓪5ShellPath, TextLine, TextCol, ImpSfx, ModSfx, ErrListFile;⓪ FROM Clock    IMPORT Time, Date, CurrentTime, CurrentDate;⓪ FROM Block    IMPORT Copy;⓪ FROM ModCtrl IMPORT  GetProcAddr;⓪ FROM MOSCtrl IMPORT  RealMode;⓪ IMPORT               Files, Text, NumberIO, TimeConvert, Convert, LibFiles,⓪5Compressions, Strings, InoutBase, FastStrings, Directory,⓪5FileNames;⓪ ⓪ VAR ErrorNr, AutoCmd : Cardinal;⓪ ⓪ CONST RealForm = 0;⓪ ⓪ CONST Asm20 = TRUE ;⓪&MAC = FALSE;⓪ ⓪ CONST⓪ ⓪ (***** Versionsnummern *****)⓪ ⓪&CompilerVersion = 4;⓪#CompilerSubVersion = 3;⓪&internalVersion = 'e'; (* Anhängsel an "Version.Subversion" *)⓪ ⓪ (*$ ? Gepard: dlayout = 3;⓪/layout = 0;  *)⓪ (*$ ? Atari:  dlayout = 6;⓪/layout = 2; *)⓪ ⓪.SerVal2 = $312F;   (* verschlüsselt nach Verfahren 2 *)⓪.SerCnt2 = 366;     (* Iterationszahl-1 für Schlüssel 2 *)⓪-SerLead2 = $0240;   (*   mit #data16 - Operanden     *)⓪+SerOffset2 = $3C78;   (*   mit #data16 - Operanden     *)⓪ ⓪ (***** Implementationskonstanten *****)⓪ ⓪(DynSpcDft =   $8000;     (* Reserve fuer dyn. Variablen fuer GDOS *)⓪(MaxSpcDft = 3000000;     (* Max. belegter Platz vom Compiler *)⓪(DataSpcDft=   20000;     (* Reserv. Platz für DATA-Bereich (default) *)⓪(maxStrLen =     255;     (* max StringLaenge *)⓪(DefaStr   =      80;     (* Default StringLaenge *)⓪$DefaReserve   =    $200;     (* Default für Runtime Stack Reserve *)⓪ ⓪ (***** Symbolnummern *****)⓪ ⓪&FirstAsmSbl = 93;          (* Nummer des ersten Assm-Symbols,⓪Dmuss bei Erweiterung der Modula-Symbole⓪Dentsprechend erhoeht werden ! (TT)  *)⓪ ⓪ (***** ASCII-Konstanten *****)⓪ ⓪-eof =  3c; (* Ctrl-C - muß bleiben wg. Editoren *)⓪-tab =  9c;⓪.cr = 13c;⓪.lf = 10c;⓪-dle = 16c;⓪-DC1 = 17c;⓪-esc = 27c;⓪-spc = 32c;⓪*⓪ (***** Auto-Commands *****)⓪ ⓪%ScanAskName = 3;        (* Error-Scan, Textnamen erfragen *)⓪%ScanErrFile = 8;        (* Error-Scan, Textname = ErrorFileName *)⓪&RunAskName = 6;        (* Compile & Start, Textnamen erfragen *)⓪&RunErrFile = 7;        (* Compile & Start, Textname = ErrFile *)⓪%CompErrFile = 2;        (* Compile, Textname = ErrorFileName *)⓪%ExecErrFile = 9;        (* Start Codefile, nach Run hinterlassen *)⓪%EditErrFile = 1;        (* Editor Aufruf, nach Syntaxfehler *)⓪%⓪ (***** Default Compileroptions *****)⓪ ⓪ (*$ ? Gepard:⓪$⓪$AllOptions = $00851880;  (* einmalige Voreinstellung beim Compilerstart *)⓪$OptToClear = $00038000;  (* 0 = "fuer jede CompUnit als Def. loeschen,⓪Efalls nicht sowieso in OptToSet"       *)⓪$OptToSet   = $00841880;  (* 1 = "fuer jede CompUnit als Def. setzen"    *)⓪ *)⓪ (*$ ? Atari:⓪$⓪$(* einmalige Voreinstellung beim Compilerstart *)⓪$AllOptions = (*_^]\[zyxwvutsrqponmlkjihgfedcba@ *)⓪300000000101111110011010000001000%;⓪$⓪$(* 0 = "fuer jedes Mod als Dft. loeschen, falls nicht sowieso in OptToSet"*)⓪$OptToClear = (*_^]\[zyxwvutsrqponmlkjihgfedcba@ *)⓪300000000010000110000000000000000%;⓪$⓪$(* 1 = "fuer jede CompUnit als Dft. setzen"    *)⓪$OptToSet   = (*_^]\[zyxwvutsrqponmlkjihgfedcba@ *)⓪300000000101111000011010000001000%;⓪$⓪$(* 1 = "Bits am Code-Ende f. Linker übernehmen", auch teilw. unbenutzt*)⓪$OptForLink = (*_^]\[zyxwvutsrqponmlkjihgfedcba@ *)⓪311111010000000000000000000000100%;⓪ *)⓪ ⓪ (***** Fehlernummern *****)⓪ ⓪ (*$ I CompErr.ICL *)⓪ ⓪ (*⓪!*   ---------------⓪!*   BUFFER / STACKS⓪!*   ---------------⓪!*)⓪ ⓪ VAR⓪ ⓪ pTxtMne: ADDRESS;  (* Zeigt in Textpuffer auf den Asm-Mnemonic *)⓪ pTxtOp1: ADDRESS;  (* Werden bei RELOAD korrigiert ! *)⓪ pTxtOp2: ADDRESS;⓪ pTxtOp3: ADDRESS;⓪ pTxtLin: ADDRESS;⓪ pTxtLin2:ADDRESS;⓪ pLastSym:ADDRESS;⓪ ⓪ LastGSD2 : LongCard;            (* rettet letztes D2 fuer AsmSameSbl *)⓪ ⓪ DoingAsm: BYTE;                 (* Flag f. SyntaxErr: In Asm *)⓪ OprndCnt: BYTE;                 (* f. SyntaxErr: Nr. des bearb. Ops *)⓪ ⓪ FindError: address;             (* runtime error position *)⓪ HeaderLen: LONGCARD;            (* Offset vom Header zum Code (f. ProtLine) *)⓪ ⓪ SYMTRE:ADDRESS;                 (* Wurzel des Symbolbaums *)⓪ ⓪ SRCBUF: STRING;                 (* Buffer fuer TreeSearch *)⓪ IDSTART: ADDRESS;               (* ^ vor ID (falls nicht bekannt) *)⓪ ⓪ IDSTKBPtr,⓪ IDSTKEPtr: ADDRESS;             (* Platz fuer ID-Stack, aufwärts *)⓪ IDStkSize: LONGCARD;⓪ ⓪ INTSTKE:⓪"ARRAY[1..$400] OF WORD;   (* Platz fuer Integer-Stack, abwärts *)⓪ INTSTK:⓪"ARRAY[1..$40] OF WORD;    (* Exit Stack: abwaerts *)⓪ EXSTK:⓪"ARRAY[1..$40] OF WORD;    (* Display Stack: abwaerts *)⓪ DISPLAY:WORD;⓪ ⓪ DUMMY:ARRAY[1..$40] OF WORD;    (* Relocate Stack fuer alte Module *)⓪ RELSTK:WORD;⓪@(* FP Akkus *)⓪ TXTNAME:   ARRAY[1..10] OF WORD;⓪ CNBUF:     ARRAY[1..15] OF WORD;⓪ ⓪ ⓪ (*⓪!*   ----------------⓪!*   ZWISCHENSPEICHER⓪!*   ----------------⓪!*)⓪ ⓪ VAR⓪(linePtr: address;⓪*⓪'saveRegs: ARRAY [0..2] OF ADDRESS;⓪(⓪'txtline2,⓪+line,⓪(txtline,⓪(cmtLine,⓪)cmtCol,⓪(endtext,⓪)endmod,⓪)ipflag: cardinal;⓪)⓪(backopt: LongCard;⓪(⓪(version: string;⓪'protfile: boolean;⓪'NoReload: boolean;             (* Reload unterdruecken *)⓪&OpenConds: Cardinal;            (* Zaehler fuer offene Cond. Comments *)⓪'MustSync: boolean;             (* lokale Var fuer Record-Deklaration *)⓪&RecOffset: LONGINT;             (* Base-Offset der Rec-Felder *)⓪'OpenFwds: Cardinal;            (* offene FORWARD-Deklarationen⓪3(nur in lokalen Scopes auszuwerten, global über TravTre) *)⓪$⓪ ⓪#XtendedCode: BOOLEAN;   (* TRUE: X+ Option wurde angewählt *)⓪#RealIsUsed: BOOLEAN;    (* TRUE: Real-Format ist endgültig festgelegt *)⓪#SysFormat: Cardinal;            (* vom MOS verwendetes Real-Format;⓪F0 = Gepard, 1 = ST-FPU, 2 = TT-FPU *)⓪ GlobalUseFormat,⓪&UseFormat: Cardinal;            (* zu erzeugendes Real-Format;⓪[3 = SysFormat *)⓪ (*⓪&FormConst: String;      (* Name des ID, der UseFormat wahlt   *)⓪ *)⓪#⓪&ProcNames: BOOLEAN;     (* TRUE: vor ProcBody Prozedurnamen im Code *)⓪#LastProcAddr: ADDRESS;⓪ ⓪$LoopDiscOfs: LONGINT;     (* Position des A7 vor LOOP *)⓪ ⓪$UseRegister: BOOLEAN;     (* Zw. f. $Reg-Deklaration (-> CompOpt) *)⓪ ⓪(RetFlag: BOOLEAN;     (* TRUE: Bei RETURN Wert nach D0 statt auf A3 *)⓪'VarA3Ofs: LONGCARD;    (* A3-Offset v. Parms, von putRET benutzt *)⓪ ⓪$OptToSetVar,⓪$OptToClrVar: LONGWORD;    (* globale Options für jedes Modul *)⓪ ⓪(gotFrwd: BOOLEAN;     (* f. ProcDec, Block *)⓪ ⓪(DynSpace : LONGCARD;  (* Reserve fuer dyn. Variablen fuer GDOS *)⓪(MaxSpace : LONGCARD;  (* Max. belegter Platz vom Compiler *)⓪ ⓪ TABLE.W  OLDSBL: 0                     (* LETZTES GEFUNDENES SYMBOL *);⓪ TABLE.L  IDSTKPtr:0                    (* ^ID STACK *);⓪ TABLE.W  VARCNT:0;⓪ TABLE.L  VARSPC:0;⓪ TABLE.L  ISTKPtr:0                     (* ^INTEGER STACK *);⓪ TABLE.L  HOOK:0                        (* ^BAUMANSCHLUSS *);⓪ TABLE.L  TypeLen:0                     (* TYP-LAENGE *);⓪ TABLE.W  PARCNT:0                      (* ANZ. LOKALE VAR *);⓪ TABLE.L  FPARM:0                       (* ^PROC-Parameter *);⓪ ⓪!(*    zur Benutzung von FPARM:⓪$1. ModDec, ProcDec übergeben Adresse, an der BLOCK einen ^Body⓪'ablegt.⓪$2. Zwischenspeicher in PrHead etc. (Anlegen der Parameter-Liste)  *)⓪$⓪ TABLE.L  RESTYPE:0         ;⓪ TABLE.W  LastRet:0                     (* FLAG FUER RETURN im Blk vorgekommen *);⓪ TABLE.W  LastWasRet:0                  (* FLAG FUER RETURN als letztes Stmt *);⓪ TABLE.L  RetAddr:0                     (* Adr. des letzten RETURN *);⓪ TABLE.L  LastExit:0                    (* Adr. des letzten EXIT *);⓪ TABLE.W  VARPAR:0;                     (* Bits: 8: VarPar; 7: Ref; 15: OpArr *)⓪ TABLE.B  RegDnCnt:$FF;                 (* Zähler f. vergebene Reg-Parms *)⓪ TABLE.B  RegAnCnt:$FF;                 (* Zähler f. vergebene Reg-Parms *)⓪ ⓪ TABLE.W  LOOPLEV  :    0;⓪ TABLE.L  EXSTKPtr :    0;⓪ TABLE.L  PARADR   :    0;⓪ TABLE.W  parmsOnA7:    0;⓪ TABLE.W  negVarSpc:    0;⓪ TABLE.L  CASETYPE :    0;⓪ TABLE.W  secondBcc:    0;⓪ TABLE.W  MINCASE  :    0;⓪ TABLE.W  MINCASE2 :    0; (* ERSETZT MINCASE+2 *)⓪ TABLE.W  MAXCASE  :    0;⓪ TABLE.W  MAXCASE2 :    0; (* ERSETZT MAXCASE+2 *)⓪ TABLE.W  CASECNT  :    0;⓪ TABLE.W  FRSTCASE :    0;⓪ TABLE.L  REGSAV   :    0,0,0,0,0;⓪ TABLE.W  XPCNT    :    0;⓪ TABLE.W  MODCNT   :    0;⓪ TABLE.W  MODFLAG  :    0             (* 0:PROC, 1:LOCAL MOD, 2:MAIN PRG *);⓪ TABLE.W  PRIORITY :    0             (* Interrupt-Priority des Moduls *);⓪ TABLE.W  LBLCNT   :    0             (* ANZ. CASE-LBL FUER 1 CASE *);⓪ TABLE.L  ENUMTYPE :    0             (* ^ENUMERATION *);⓪ TABLE.L  RSTKPtr  :    0;⓪ TABLE.L  KEY      :    0             (* MODULE KEY FUER DEFMOD *);⓪ TABLE.W  PERVIMP  :    0;⓪ TABLE.W  WASQUAL  :    0             (* QUAL.ID-FLAG VON GetSbl *);⓪ TABLE.L  ASMSCOPE :    0             (* ^BAUM DER ASM-SYMBOLE *);⓪ TABLE.L  ZW1      :    0;⓪ TABLE.W  ZW2      :    0;⓪ TABLE.W  CODEGEN  :    0             (* FLAG: CODEERZEUGUNG? *);⓪ TABLE.W  NewTyp   :    0             (* Flag fuer Typdeklarationen  *);⓪ ⓪ VAR SourceScope: Address;            (* ^ScopeTree beim Importieren in⓪Hlok. Module *)⓪*myScope: Address;          (* ^Scope, in das bei Record-Decl. die⓪Hneuen Feldnamen eingetragen werden *)⓪)lastElem: ADDRESS;          (* ^Eintrag zur Verkettung v. Rec-Feldern*)⓪ ⓪ (* FORWARD DEKLARATIONEN *)⓪ ⓪ FORWARD AAssm;⓪ FORWARD ACASE;⓪ FORWARD aCode;⓪ FORWARD ADISPOSE;⓪ FORWARD AERR6;⓪ FORWARD AEXIT;⓪ FORWARD AExport;⓪ FORWARD AIF;⓪ FORWARD AImport;⓪ FORWARD AIOCall;⓪ FORWARD AIOTransfer;⓪ FORWARD AListen;⓪ FORWARD ALOOP;⓪ FORWARD ANEW;⓪ FORWARD ANewProcess;⓪ FORWARD AREPEAT;⓪ FORWARD AReturn;⓪ FORWARD AsComp20;⓪ FORWARD ASSM;⓪ FORWARD ASTRING;⓪ FORWARD ATransfer;⓪ FORWARD AWHILE;⓪ FORWARD BLOCK;⓪ FORWARD CALLAL;⓪ FORWARD CALLDEAL;⓪ FORWARD CHECKID;⓪ FORWARD CLRTRE;⓪ FORWARD CODESPC;⓪ FORWARD COMMENT;⓪ FORWARD COMPOPT;⓪ FORWARD CONSDEC;⓪ FORWARD CSP;⓪ FORWARD DEFMOD;⓪ FORWARD DUMP;⓪ FORWARD EXECMOD;⓪ FORWARD FETCH;⓪ FORWARD FETNOSP;⓪ FORWARD FINEXP;⓪ FORWARD FINIMP;⓪ FORWARD FINVAR;⓪ FORWARD FwdKnot;⓪ FORWARD GETID;⓪ FORWARD GETID0;⓪ FORWARD GETID1;⓪ FORWARD GETID2;⓪ FORWARD GETID3;⓪ FORWARD GetLPar;⓪ FORWARD GetRPar;⓪ FORWARD GetSbl;⓪ FORWARD GLOBIMP;⓪ FORWARD ImpID;⓪ FORWARD InitImports;⓪ FORWARD INITRE;⓪ FORWARD IPMOD;⓪ FORWARD ITEMS;⓪ FORWARD LABEL;⓪ FORWARD LoadBadID;⓪ FORWARD LOCXP;⓪ FORWARD LookID;⓪ FORWARD ModDec;⓪ FORWARD NDARG;⓪ FORWARD OldHead;⓪ FORWARD NewOpaque;⓪ FORWARD OLDID;⓪ FORWARD OLDID0;⓪ FORWARD PrHead;⓪ FORWARD PRTID;⓪ FORWARD PRTSTR;⓪ FORWARD PROCDEC;⓪ FORWARD PULLID;⓪ FORWARD PullInt;⓪ FORWARD PushInt;⓪ FORWARD LookINT;⓪ FORWARD SAMESBL;⓪ FORWARD SearchID;⓪ FORWARD SetAdr;⓪ FORWARD SetId;⓪ FORWARD SetId0;⓪ FORWARD SetId2;⓪ FORWARD SetIdI;⓪ FORWARD SETKNG;⓪ FORWARD SETTYPE;⓪ FORWARD SETTYP13;⓪ FORWARD StatSeq;⓪ FORWARD SUELZ;⓪ FORWARD TABDEC;⓪ FORWARD TRESRC;⓪ FORWARD TraceProc;⓪ FORWARD TRESRC0;⓪ FORWARD TYPEDEC;⓪ FORWARD VARDEC;⓪ ⓪ ⓪ (*$i CompIO.ICL *)⓪ (*$i TreFin.ICL *)⓪ (*$i CodeMain.ICL *)⓪ (*$i Symbol.ICL  *)⓪ ⓪ ⓪ (*   -----------------------------------------⓪!*   COMPILER INITIALISIERUNG fuer Compile-Cmd⓪!*   ------------------------------------------⓪!*)⓪ ⓪ PROCEDURE INITCOM;⓪ BEGIN ASSEMBLER⓪(JSR     GetSourceName⓪(TST.W   ProtFile⓪(BEQ     noProt⓪(JSR     OpenProt⓪ !noProt CLR.W   CODEGEN⓪(CLR.L   FindError⓪&END⓪ END INITCOM;⓪ ⓪ (*   -----------------------------------------⓪!*   COMPILER INITIALISIERUNG fuer Find-Cmd⓪!*   ------------------------------------------⓪!*)⓪ ⓪ PROCEDURE INITfind;⓪ BEGIN ASSEMBLER⓪(JSR     GetSearchName⓪(CLR.W   ProtFile                ;hier immer ohne ProtFile!⓪(CLR.W   CODEGEN⓪ (*$ ? RunGep:⓪(MOVE.L  CODE,D0⓪(ADD.L   ERRORPOS,D0     *)⓪ (*$ ? RunST:⓪(MOVEQ   #-12,D0         *)⓪(MOVE.L  D0,FINDERROR⓪&END⓪ END INITfind;⓪ ⓪ (* ';' oder '[priority];' verarbeiten *)⓪ ⓪ PROCEDURE GetPriority;⓪ BEGIN ASSEMBLER⓪(MOVE.W  #$FFFF,priority⓪(JSR     GetSbl⓪(CMP.W   #15,D3    ; [?⓪(BNE     nopr⓪(JSR     GetSbl⓪(MOVE.L  ZZTyp,-(A7)⓪(MOVE.L  #$12345,ZZTyp⓪(JSR     ConFact⓪(CMP.L   ZZTyp,D2⓪(BEQ     scard⓪(MOVE    #rCarXp,D5⓪(JMP     SyntaxErr⓪ !scard  MOVE.L  (A7)+,ZZTyp⓪(MOVE.W  AccuS14,priority⓪(JSR     GetSbl⓪(CMP.W   #27,D3    ; ]?⓪(BEQ     ok2⓪(MOVE    #rBrkXp,D5⓪(JMP     SyntaxErr⓪ !ok2    JSR     GetSbl⓪ !nopr   CMP.W   #11,D3    ; ;?⓪(BEQ     ok1⓪(MOVE    #rSemXp,D5⓪(JMP     SyntaxErr⓪ !ok1⓪&END⓪ END GetPriority;⓪ ⓪ (* Code fuer Setzen der Interrupt-Priority erzeugen,⓪#falls priority gesetzt ist.⓪ *)⓪ ⓪ PROCEDURE SetPriority;⓪ BEGIN ASSEMBLER⓪(MOVE.W   priority,D0⓪(BMI      nix⓪(JMP      put146       ;altes SR retten und neues setzen⓪ !nix⓪&END⓪ END SetPriority;⓪ ⓪ PROCEDURE fpu (): FPUType;⓪"BEGIN⓪$ASSEMBLER⓪)MOVE    UseFormat,D0⓪)CMPI    #3,D0          ; wurde $F benutzt?⓪)BCS     retUse         ; ja: gewünschte Einstellung liefern⓪)MOVE    SysFormat,D0   ; liefert softReal oder externalFPU,⓪@; je nach System, unter dem compiliert wird⓪'retUse⓪)MOVE    D0,(A3)+⓪$END⓪"END fpu;⓪ ⓪ PROCEDURE RealConstIsUsed;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE    #1,RealIsUsed  ; wenn Real-Konst, dann ist nun Format festgelegt⓪$END⓪"END RealConstIsUsed;⓪ ⓪ PROCEDURE IEEERuntimeCall;⓪"BEGIN⓪$ASSEMBLER⓪(; wird auch aufgerufen, wenn direkter 68881-Code erzeugt wird!⓪(MOVE    #1,RealIsUsed  ; wenn internalFPU o. externalFPU, dann⓪?; ist nun Format festgelegt⓪$END⓪"END IEEERuntimeCall;⓪ ⓪ (*⓪!*   -------------------------------⓪!*   COMPILER ANFANG⓪!*   -------------------------------⓪!*)⓪ ⓪ PROCEDURE COMP;⓪ BEGIN⓪(ASSEMBLER⓪*⓪*(* RAM-Platzvergabe *)⓪ ⓪*LEA     Header,A0⓪*MOVE.L  A0,(A3)+⓪*JSR     MemAvail⓪*MOVE.L  -(A3),D0⓪*CMP.L   MaxSpace,D0     ;mehr als 3 MB brauchen wir keinesfalls⓪*BLS     takeAll⓪*MOVE.L  MaxSpace,D0⓪ takeAll:  MOVE.L  D0,(A3)+⓪*MOVE.L  D0,-(A7)⓪*JSR     ALLOCATE        ;größten Speicherblock komplett anfordern⓪*TST.L   Header⓪*BEQ     outofmem⓪*JSR     MemAvail        ;ist noch ein großes Gap übrig?⓪*MOVE.L  -(A3),D0⓪*CMP.L   DYNSPACE,D0    ;Reserve fuer GDOS & Co⓪*BCC     allocOK⓪*; Speicher nochmal anfordern, Gap übrig lassen⓪*LEA     Header,A0⓪*MOVE.L  A0,(A3)+⓪*CLR.L   (A3)+⓪*JSR     DEALLOCATE⓪*LEA     Header,A0⓪*MOVE.L  A0,(A3)+⓪*JSR     MemAvail⓪*MOVE.L  DynSpace,D0      ;Reserve fuer GDOS & Co⓪*SUB.L   D0,-4(A3)⓪*BCS     outofmem⓪*MOVE.L  -4(A3),(A7)⓪*JSR     ALLOCATE         ;Speicher anfordern⓪*TST.L   Header⓪*BNE     allocOK⓪!outofmem MOVE.W  #fInsufficientMemory,(A3)+⓪*JMP     TermProcess⓪"allocOK⓪*MOVE.L  (A7)+,A1       ;reservierte Anzahl Bytes⓪*ADDA.L  Header,A1⓪*MOVE.L  A1,SYMTRE      ;Ende des Speicherblocks: Symbolbaum-Root⓪*; Platz. f. DATA-Puffer reservieren⓪*MOVE.L  Header,D0⓪*MOVE.L  D0,DataStart⓪*ADD.L   DataLen,D0⓪*ADDQ.L  #1,D0⓪*BCLR    #0,D0⓪*MOVE.L  D0,DataEnd⓪*MOVE.L  D0,Header⓪*MOVE.L  D0,A0⓪*ADDA.W  #32000,A0      ;Platz f. Header/Code muß mind. 32KB sein⓪*CMPA.L  A1,A0⓪*BHI     outofmem⓪*⓪*MOVE.L  A3,EVALSTK     ;^EvalStack retten⓪*CLR.W   NoReload⓪*⓪*; Voreinstellungen fuer ges. Uebersetzung (auch mehrere Module)⓪*; (GlobalUseFormat wird *vor* 'OpenIO' gesetzt)⓪ (*$ ? RunGep:⓪*JSR     RealForm⓪*MOVE    -(A3),SysFormat  *)⓪ (*$ ? RunST:⓪*(* vor 16.1.94:⓪,CLR.W   SysFormat⓪,CMPI    #IEEEReal,UsedFormat⓪,BNE     sysFormSet⓪,JSR     SysInfo.FPU      ; wenn IEEE, dann verwendete FPU ermitteln⓪,MOVE.W  -(A3),SysFormat⓪**)⓪*(* neu: *)⓪*MOVE    RealMode,D0  ;0:keine Reals (kommt nicht vor), 1:MM2Reals usw.⓪*SUBQ    #1,D0⓪*MOVE.W  D0,SysFormat⓪ sysFormSet:⓪ *)⓪*⓪*MOVE.L  #AllOptions,Options ;Default Options setzen⓪*MOVE.L  #OptToClear,OptToClrVar⓪*MOVE.L  #OptToSet,OptToSetVar⓪*MOVE.L  #DefaReserve,StackReserve⓪*⓪*; Puffer für ID-Stack reservieren (default: 2KB)⓪*MOVE.L  Header,A0⓪*MOVE.L  A0,IDStkBPtr⓪*ADDA.L  IDStkSize,A0⓪*MOVE.L  A0,IDStkEPtr⓪*MOVE.L  A0,Header⓪*⓪*; AutoCommands auswerten und loslegen⓪*⓪*MOVE.W  AutoCmd,D0      ;*** AutoCommands auswerten⓪*BEQ     CompAsk         ; gar keins⓪*CLR.W   AutoCmd         ; sonst: schon mal zuruecksetzen⓪*CMP.W   #ScanErrFile,D0 ;Find Runtime Error in ErrFile⓪*BEQ     Find⓪*CMP.W   #ScanAskName,D0 ;Find Runtime Error, Namen erfragen⓪*BEQ     FindAsk⓪*CMP.W   #CompErrFile,D0 ;ErrFile nur ueberetzen?⓪*BEQ     CompIt⓪*MOVE.W  #ExecErrFile,AutoCmd  ;nein, also exec vorbereiten⓪*CMP.W   #RunErrFile,D0        ;Run mit Namen in ErrFile?⓪*BEQ     CompIt                 ;ja⓪ !CompAsk  CLR.W   ErrorFileName   ;Compile oder Run, Namen erfragen⓪ !CompIt   JSR     INITCOM⓪*BRA     ReStart⓪ !FindAsk  CLR.W   ErrorFileName   ;Scan, Namen erfragen⓪ !Find     JSR     INITFIND⓪ ⓪*; Folgendes passiert fuer jedes uebersetzte Modul⓪*⓪ !ReStart  MOVE.L  IDStkEPtr,A4⓪*MOVE.L  #$4D4D3243,(A4)+        ; "MM2C"⓪*MOVE.L  #$6F646500,(A4)+        ; "ode"⓪*MOVE.L  A4,Header⓪*MOVE.L  DataStart,DataPtr⓪*⓪*JSR     ClockStart⓪ (*$? Gepard: MOVE.W  #$012D,DEFVOLUME ;GDOS Defn-Volume '-' fuer DefModule *)⓪*CLR.W   GLOBAL        ;Restart mit neuem Modul⓪*CLR     LINE          ;Zeile innerhalb des Moduls⓪*CLR     RealIsUsed⓪*CLR     XtendedCode⓪*MOVE.L  Options,D0    ;einige Options fuer jede CompUnit neu setzen⓪*AND.L   OptToClrVar,D0⓪*OR.L    OptToSetVar,D0⓪*MOVE.L  D0,Options⓪*MOVE.L  D0,BackOpt⓪*JSR     validateOpts  ;Abhängigkeiten entspr. der Options setzen⓪ ⓪*CLR.W   D7            ;PEEPHOLE ZU⓪*CLR.L   Peephole⓪*CLR.W   ROSCOPE       ;keine ReadOnly-Scopes⓪*CLR.L   LINEPtr⓪*CLR.L   KEY⓪*CLR.W   OpenConds     ;keine offenen Cond.Comments⓪*⓪*MOVE.W  GlobalUseFormat,UseFormat  ; die Format-Wahl soll fuer jedes⓪M; Modul neu geschehen.⓪*; CMPI.W  #2,UseFormat  ;Reals im GDOS-Systemformat (Default)?⓪*; BEQ     noUser        ; ja⓪*; MOVE.W  #3,UseFormat  ; nein: neue Auswertung der FormConst noetig⓪ noUser    MOVE.L  IDSTKBPtr,A0    ;ID STACK INITIALISIEREN⓪*CLR.B   (A0)⓪*ADDQ.L  #1,A0⓪*MOVE.L  A0,IDSTKPtr⓪*MOVE.L  #INTSTK,ISTKPtr⓪*MOVE.L  #EXSTK,EXSTKPtr ;EXIT STACK⓪*LEA     RELSTK,A0⓪*CLR.L   -(A0)         ;ENDMARKE⓪*MOVE.L  A0,RSTKPtr⓪*LEA     DISPLAY,A6⓪*MOVE.L  #1,-(A6)      ;DISPLAY STACK⓪*JSR     INITRE        ;SYMBOLE IN BAUM EINTRAGEN⓪*CLR.W   ENDTEXT⓪*MOVE.W  #1,ENDMOD      ;jetzt Modul-Ende: evtl. Textende⓪*JSR     GetSbl         ;MODULE-ANFANG⓪*TST.W   ENDTEXT⓪*BNE.L   DONE⓪*CLR.W   ENDMOD⓪*CMPI.W  #51,D3         ;'MODULE'?⓪*BNE     COMP1⓪*MOVE.W  #1,IPFLAG      ;PGM MOD⓪*BRA     COMP2⓪ !COMP1    CMPI.W  #66,D3         ;IMPLEMENTATION⓪*BNE     COMP3⓪*MOVE.W  #2,IPFLAG⓪*BRA     COMP4⓪ !COMP3    CMPI.W  #67,D3        ;DEFINTION⓪*BEQ     ok1⓪ !ER4      MOVE    #rModXp,D5⓪*JMP     SyntaxErr⓪ !ok1      MOVE.W  #3,IPFLAG⓪ !COMP4    JSR     GetSbl⓪*CMPI.W  #51,D3⓪*BNE     ER4⓪ !COMP2    JSR     GETID         ;MODUL-NAME⓪*JSR     GetPriority   ;evtl. Priority und Semikolon holen⓪ !ok2      CMPI.W  #3,IPFLAG     ;DEFMODUL?⓪*BNE     COMP5⓪*JSR     DEFMOD⓪*BRA     COMP6⓪ !COMP5    JSR     IPMOD⓪ !COMP6    JSR     OLDID⓪*JSR     CHECKID⓪*BEQ     ok4           ;IDs sind gleich⓪*MOVE    #rIdMis,D5    ;MisMatch⓪*JMP     SyntaxErr⓪ ok4       JSR     GetSbl⓪*CMPI.W  #9,D3⓪*BEQ     ok3⓪*MOVE    #rPerXp,D5          ;'.' EXPECTED⓪*JMP     SyntaxErr⓪ !ok3⓪*JSR     CLRTRE⓪*⓪*; Kennung fürs Real-Format in Modulkopf⓪*CLR     D0⓪*TST     RealIsUsed    ;Real-Kennung nur setzen, wenn Real-Konsts oder⓪*BNE     realsUsed     ;FPU-Code oder $F+ o. $F* vorkommen.⓪*; Keine Real-Consts oder FPU-Code: bei $F+/* trotzdem markieren⓪*MOVE    UseFormat,D1⓪*BEQ     noRealsUsed⓪*CMP.W   #3,D1⓪*BEQ     noRealsUsed⓪ realsUsed MOVE    UseFormat,D0⓪*CMP.W   #3,D0          ;SystemFormat benutzen ?⓪*BCS     ccc⓪*MOVE    SysFormat,D0⓪ ccc       ; D0 ist 0 (Gepard Reals) oder 1 (ST-FPU) oder 2 (TT-FPU)⓪*ADDQ    #1,D0⓪*LSL.B   #5,D0         ; Real-Kennung nach Bit 5&6⓪ noRealsUsed⓪*; Kennung für 68020/881-Code in Modulkopf⓪*MOVE    XtendedCode,D1⓪*ROR.B   #1,D1⓪*OR.B    D1,D0⓪*⓪*; Kennung f. "Prozedur-Namen vorhanden"⓪*⓪*CMPI.W  #3,IPFLAG     ; nicht bei Defmods⓪*BEQ     ccc3⓪*TST.W   ProcNames⓪*BEQ     ccc3⓪*BSET    #4,D0         ; Bit 4 in Kennung setzen⓪*⓪ ccc3      MOVE.L  Header,A0⓪*OR.B    1(A0),D0      ; Kennungbyte⓪*MOVE.B  D0,1(A0)⓪*⓪ ⓪*JSR     ClockStop⓪*JSR     SUELZ         ;TEXT/CODELEN⓪*TST.L   FINDERROR⓪*BNE     FIND          ;RuntimeError Pos nicht gefunden⓪*JSR     CSAVE         ;CODE SPEICHERN⓪*TST.W   ProtFile⓪*BEQ     NoVerbos      ;Kein Protokoll⓪*MOVE.L  Options,D0⓪*BTST    #22,D0        ;Verbose?⓪*BEQ     NoVerbos⓪*JSR     Statistics⓪ !NoVerbos JSR     PULLID⓪*BRA     RESTART⓪ !DONE     JSR     CloseProt⓪*MOVE.L  EVALSTK,A3⓪'END⓪ END COMP;⓪ ⓪ ⓪!(*  Source- und Modulnamen als Atari-Strings ins Codefile schreiben;⓪%Pointer auf Offset 26 und 30 setzen...⓪%⓪%SourceName = Top of FilenameStack⓪%ModuleName = Top of IDStack⓪%⓪%(A0,A4,A5,D0-D7)⓪!*)⓪ PROCEDURE EnterNames;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  Header,A0         ;^Sourcename setzen⓪(MOVE.L  A4,D0⓪(SUB.L   A0,D0⓪(MOVE.L  D0,26(A0)⓪(MOVE.L  A4,A5⓪(JSR     GetFn           ;Sourcenamen von FnStack holen⓪(MOVE.L  A5,A4⓪(JSR     put0            ;sync⓪(⓪(MOVE.L  Header,A0         ;^ModuleName setzen⓪(MOVE.L  A4,D0⓪(SUB.L   A0,D0⓪(MOVE.L  D0,30(A0)⓪(⓪(JSR     LookId          ;A0 := ^ Top of ID-Stack⓪ en3     MOVE.B  (A0)+,(A4)+⓪(BNE     en3             ;kopieren bis Endmarke 0.B⓪(JSR     put0            ;sync⓪$END⓪"END EnterNames;⓪ ⓪ (*⓪!*   IMPLEMENTATION ODER PROGRAM MODULE⓪!*)⓪ ⓪ PROCEDURE IPMOD;⓪ BEGIN ASSEMBLER⓪(MOVE.W  IPFLAG,D0⓪(MOVE.B  #LAYOUT,(A4)+⓪(MOVE.B  D0,(A4)+⓪(JSR     put3          ; 2:KEY⓪(MOVE.L  A4,FPARM      ;   hier trägt BLOCK die Rumpf-Adr ein⓪(JSR     put3          ; 6:^Body⓪(JSR     put3          ;10:^Ende⓪(JSR     put3          ;14:^ImportListe⓪(JSR     put3          ;18:^ExportListe⓪(JSR     put3          ;22:^Var/Proc-Liste (Reloc-Liste)⓪ (*$ ? Atari:⓪(JSR     put3          ;26:^Modulname⓪(JSR     put3          ;30:^SourceName⓪(JSR     put3          ;34:^SymbolName (später mal)⓪(JSR     put3          ;38:^Längenliste⓪(JSR     put3          ;42:^Codebeginn/Ende des Headers⓪(MOVE.L  Options,(A4)+ ;46:Options zu Beginn (z.B. durch ArgLine)⓪(JSR     put3          ;50:clinkresv⓪(JSR     put3          ;54:stackSize⓪(MOVE.L  #$00000007,(A4)+  ;58:prgFlags⓪(JSR     put3          ;62:dataStart (Data liegt zw. Code und Reloc-List)⓪(JSR     put3          ;66:reserviert⓪(JSR     put3          ;70:reserviert⓪(JSR     put3          ;74:reserviert⓪(JSR     put3          ;78:reserviert⓪(JSR     EnterNames⓪ *)⓪ ⓪(MOVE.W  #$2,MODFLAG   ;COMP UNIT⓪(CLR.W   GLOBAL⓪(CLR.W   LastRet⓪(CLR.L   LastExit⓪(CLR.W   LOOPLEV       ;LOOP NESTING LEVEL⓪(CLR     RetFlag       ;keine Parm-Rückgabe in D0⓪(JSR     GetSbl⓪(JSR     GLOBIMP       ;Lädt Importe, auch eigenes Def-Mod und erstellt⓪>;dabei die Import- und Exportliste⓪(CLR.L   LastProcAddr⓪(MOVE.L  Options,D0⓪(BTST    #13,D0        ;M-Option (Mark Procedures)⓪(SNE     D0⓪(ANDI    #1,D0⓪(MOVE    D0,ProcNames⓪ ⓪(MOVE.L  A4,D0         ;Anfangsadresse des Codes eintragen⓪(MOVE.L  Header,A0⓪(SUB.L   A0,D0⓪(MOVE.L  D0,42(A0)⓪(MOVE.L  D0,HeaderLen⓪((* doch erstmal nicht wg. zu viel Aufwand f. Linker, da u.A.⓪+dann einige Offsets Null werden können und dies bisher⓪+als Endmarke benutzt wurde.⓪*MOVE.L  A4,CodeStart    ;Wahre Adr. des Codes⓪(*)⓪(MOVE.L  Header,CodeStart  ;erstmal wie bisher gleich lassen⓪ ⓪(TST.L   FINDERROR⓪(BEQ     noFind⓪(MOVE.L  A4,D0           ; ADR des Code-Beginns⓪(ADD.L   ScanAddr,D0     ; plus Such-Offset⓪(MOVE.L  D0,FINDERROR⓪ noFind⓪ ⓪(JSR     initBlock       ;reg./temp. Vars freigeben (incl. A5,A6)⓪(MOVE.L  freeRegs,D0⓪(CLR     parmsOnA7⓪(CLR     gotFrwd⓪(JSR     Block⓪(⓪(; hinter dem Code werden die Konstanten aus dem DATA-Puffer abgelegt:⓪(MOVE.L  A4,D0⓪(MOVE.L  Header,A0⓪(SUB.L   A0,D0⓪(MOVE.L  D0,62(A0)       ;^Data-Beginn⓪(JSR     FinishData⓪(⓪(; Ende des Codes - Beginn der Variablen hiermit festlegen:⓪(MOVE.L  A4,D0⓪(MOVE.L  Header,A0⓪(SUB.L   A0,D0⓪(MOVE.L  D0,22(A0)       ;^VAR/PROC-Liste⓪(ADD.L   VARSPC,D0⓪(BPL     notNeg⓪(TRAP    #6              ;interner Fehler⓪(DC.W    -124⓪ notNeg  MOVE.L  D0,10(A0)       ;Modulende (hinter Code & Vars)⓪(⓪(; einige Options im Header nachtragen:⓪(MOVE.L  Header,A0⓪(ADDA.W  #46,A0          ; ADR (COMPOPTS)⓪(MOVE.L  (A0),D0⓪(MOVE.L  #OptForLink,D1  ; diese Bits sind nachzutragen⓪(MOVE.L  D1,D2⓪(NOT.L   D1⓪(AND.L   D1,D0           ; Bits aus Header löschen⓪(MOVE.L  Options,D1⓪(AND.L   D2,D1           ; Bits aus akt. Options maskieren⓪(OR.L    D1,D0           ; und in Header einsetzen⓪(MOVE.L  D0,(A0)⓪(⓪(JSR     FINIMP        ;ImportListe (muß vor Relozierungen bleiben)⓪(JSR     FINVAR        ;VAR/PROC/CONST relozieren, Längenliste erstellen⓪(JSR     FINEXP        ;ExportListe: Reloziereinträge⓪&END⓪ END IPMOD;⓪ ⓪ ⓪ PROCEDURE TraceProc;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L  Options,D2⓪(BTST    #5,D2         ; $E-Option prüfen⓪(BEQ     noTrace⓪ ⓪(JSR     PUTDebug      ; Trap-No steht schon in D0⓪(JSR     LookID⓪(MOVE.B  (A0)+,(A4)+   ;es sind mind. 2 Zeichen⓪ en3     MOVE.B  (A0)+,(A4)+⓪(BNE     en3           ;kopieren bis Endmarke 0.B⓪(JSR     put0          ;sync⓪&noTrace⓪$END⓪"END TraceProc;⓪ ⓪ (*⓪!*   === Block ===⓪!*⓪!* Erhält in D0.L die 'freeRegs', die zum Code-Beginn zu setzen sind.⓪!*)⓪ ⓪ PROCEDURE Block;⓪ BEGIN⓪!ASSEMBLER⓪*MOVE.W  negVarSpc,-(A7)⓪*MOVE.W  parmsOnA7,negVarSpc⓪*MOVE.W  MODCNT,-(A7)⓪*CLR.W   MODCNT⓪*MOVE.W  OpenFwds,-(A7)⓪*CLR.W   OpenFwds⓪*MOVE.W  RetFlag,-(A7) ;kann u.U. in Proc/ModDec zerstört werden⓪*MOVE.L  PARADR,-(A7)  ;ENDE DER Parameter⓪*MOVE.L  FPARM,-(A7)   ;^Rumpf-Adresse (wird nachher nachgetragen)⓪*MOVE.W  parmsOnA7,-(A7)⓪*MOVE.L  D0,-(A7)      ;freeRegs⓪ ⓪*TST     gotFrwd⓪*BEQ     Block5⓪*BRA     isFrwd        ;FORWARD wurde bereits in ProcDec erkannt⓪ !Block1   JSR     GetSbl⓪ !Block5   CMPI.W  #58,D3        ;TYPE⓪*BNE     Block2⓪*JSR     TYPEDEC⓪*BRA     Block5⓪ !Block2   CMPI.W  #56,D3        ;VAR⓪*BNE     Block13⓪*JSR     VARDEC⓪*BRA     Block5⓪ !Block13  CMPI.W  #57,D3        ;CONSTANT⓪*BNE     Block3⓪*JSR     CONSDEC⓪*BRA     Block5⓪ !Block3   CMPI.W  #59,D3        ;PROCEDURE⓪*BNE     Block4⓪*JSR     PROCDEC⓪*BRA     Block1⓪ !Block4   CMPI.W  #51,D3        ;MODULE⓪*BNE     Block15⓪*JSR     ModDec⓪*BRA     Block1⓪ !Block15  CMPI.W  #84,D3        ;TABLE⓪*BNE     Block20⓪*JSR     TABDEC⓪*BRA     Block5⓪ !Block20  CMPI.W  #90,D3        ;FORWARD⓪*BNE     Block16⓪*⓪*; FORWARD nach Gepard-Syntax auswerten⓪*JSR     GetSbl⓪ isFrwd    MOVE.L  VARSPC,-(A7)⓪*JSR     PrHead⓪*JSR     PullInt    ;WIRD BEI PROC-DEC NACH BEGIN GEMACHT (ERGEBNISTYP)⓪*JSR     CLRTRE        ;LOKALE VAR ETC LOESCHEN⓪*JSR     PULLID⓪*SUBQ.W  #1,GLOBAL⓪*MOVE.L  (A7)+,VARSPC  ;VAR-ADR DER GLOBALEN EBENE⓪*ADDQ.W  #1,OpenFwds⓪*BRA     Block1⓪ ⓪ ; Ende der Deklarationen: hier beginnt der Modul-/Prozedur-Rumpf!⓪ ⓪ emptyName DC.W   0⓪ ⓪ !Block16 MOVE.L  freeRegs,freeVarRegs  ; die belegten Var-Regs merken zum Retten⓪)MOVE.L  (A7)+,freeRegs        ; Regs erstmal wieder freigeben⓪)MOVE.W  (A7)+,parmsOnA7⓪ ⓪)TST     parmsOnA7⓪)BNE     parOnA7⓪)(*$C+*) MOVE.W  #MM2Comp2.A6,D0 (*$C-*)⓪)BRA     setVarRg⓪ parOnA7  (*$C+*) MOVE.W  #MM2Comp2.A5,D0 (*$C-*)⓪ setVarRg MOVE    D0,VarReg  ; Reg. f. Var-Zugriff definieren⓪)MOVE    D0,ParReg  ; Reg. f. Parm-Zugriff definieren⓪ ⓪)TST.W   ProcNames⓪)BEQ     noName        ;Name ist nicht gefragt⓪)⓪); Proc-/Module-Name in den Code⓪)⓪)CLR.B   (A4)+         ;Startmarke⓪)LEA     emptyName(PC),A0⓪)MOVE.L  Options,D0⓪)BTST    #13,D0        ;M-Option (Mark Procedures)⓪)BEQ     en4           ; $M-: nur Leernamen eintragen⓪)JSR     LookID⓪!en4     MOVE.B  (A0)+,(A4)+   ;es sind mind. 2 Zeichen⓪!en3     MOVE.B  (A0)+,(A4)+⓪)BNE     en3           ;kopieren bis Endmarke 0.B⓪)JSR     put0          ;sync⓪)⓪); Link-^ für rückw. verk. Liste aller Procs anfügen⓪)⓪)MOVE.L  LastProcAddr,(A4)+⓪)MOVE.L  A4,D0⓪)SUB.L   CodeStart,D0⓪)MOVE.L  D0,LastProcAddr⓪ ⓪ noName   MOVE.L  (A7)+,A0⓪)JSR     SETADR        ;Adresse des Rumpfes und Länge eintragen⓪)MOVE.L  (A7)+,PARADR⓪)MOVE.W  (A7)+,RetFlag⓪)⓪)MOVE.L  VarSpc,D0     ;Gesamt-VarPlatz (und damit Modullaenge)⓪)TST     negVarSpc     ;neg. Offsets? (bei A5-relativem Zugriff)⓪)BEQ     notNeg⓪)SUBQ.L  #1,D0         ; synchronisieren⓪)BCLR    #0,D0⓪)BRA     negOK⓪ notNeg   ADDQ.L  #1,D0         ; synchronisieren⓪)BCLR    #0,D0⓪ negOK    MOVE.L  D0,VarSpc⓪ ⓪)TST.W   Global⓪)BEQ     ok5           ;fehlende globale Procs werden eh bemerkt⓪)TST.W   OpenFwds      ;prüfe, ob FORWARD-Referenzen offengeblieben⓪)BMI     ok5           ;kann in Impl.modulen negativ sein (Defns)⓪)BEQ     ok5⓪)LEA     FwdKnot,A5    ;benutzte undekl. Forwards anmäkeln⓪)MOVE.L  (A6),D2       ;Scope kann nicht leer sein⓪)JSR     TravTr1⓪ ok5      MOVE.W  (A7)+,OpenFwds⓪)⓪); Bei $E+ TRAP f. Proc-Namensausgabe erzeugen⓪)MOVEQ   #66,D0        ; markiert Entry der Proc⓪)JSR     TraceProc⓪)⓪)CLR     WithScope          ; wir sind nicht in einem WITH⓪)CLR.L   VarA3Ofs           ; erstmal keine A3-Korrektur beim Return⓪)⓪)MOVE.L  Options,D2⓪)BTST    #12,D2⓪)BEQ.L   Block8        ;L-  kein Rangecheck, kein Link, keine Priority⓪ ⓪)MOVE.W  MODFLAG,D0    ;Module Body?⓪)BEQ     Block11       ;nee: Link durchführen⓪ ⓪ (* FPU-Check nicht mehr machen, weil der nur bei wirklicher Real-Verwendung⓪"stattfinden sollte⓪)CMPI    #2,D0         ;Main Body?⓪)BNE     noFPUChk⓪)⓪)MOVE.L  Options,D0⓪)BTST    #6,D0         ; $F+?⓪)BEQ     noFPUChk⓪ ⓪); FPU prüfen und ggf. initialisieren⓪)MOVEQ   #90,D3⓪)JSR     CSP           ;Runtime: FPU prüfen⓪ *)⓪ ⓪ noFPUChk JSR     SetPriority   ;neue Interrupt-Priority faellig ?⓪)BRA.L   Block8        ;kein Link, kein Rangecheck⓪ ⓪ ;⓪ ; *** LINK und Parm-Copy durchführen ***⓪ ;⓪ Block11⓪ (*⓪)CMPI.W  #1,GLOBAL     ;globale Proc ?⓪)BNE     islocal       ;nein⓪)JSR     SetPriority   ;neue Interrupt-Priority faellig ?⓪ islocal⓪ *)⓪)MOVE.L  Options,D1⓪)BTST    #19,D1        ;Stackcheck on?⓪)BEQ     noCheck1      ;nein⓪)MOVE.L  VARSPC,D0⓪)BPL     doCheck⓪)NEG.L   D0⓪ doCheck  JSR     put56b        ;StackSpc Check (kurz)⓪); JSR     put56a        ;StackSpc Check (schnell)⓪);!!! hier könnte per Option auf Speed/Size optimiert werden⓪ noCheck1⓪ ⓪); Wenn Prozedur mit Parms und kein Result oder Result in D0,⓪); oder wenn Parms auf A7,⓪); bleiben Parms auf A3/A7-Stack (kein lokales Umkopieren).⓪)TST.L   ParAdr         ;wenn keine Parms, dann normalen Link⓪)BEQ.W   moveParm⓪)⓪)TST     parmsOnA7⓪)BEQ     notOnA7      ;Parms sind nicht auf A7⓪)⓪); Werte bleiben auf A7-Stack. Dazu muß gesonderter LINK gen. werden:⓪); (D2 muß vom Aufrufer zuletzt auf den A7 gebracht worden sein!)⓪); LINK   A5,#-(varspc-parspc)  (* parspc wurde bereits subtrahiert *)⓪)MOVE.L  VarSpc,D0⓪)JSR     putLink       ;LINK ERZEUGEN⓪)CMPI.W  #1,GLOBAL     ;lokale Proc:⓪)BNE     Put502        ; kein Prio setzen⓪)JSR     SetPriority⓪ put502   JSR     pushRegs      ;Reg-Vars (nicht A5) retten⓪)BRA.W   endOfParmCopy⓪ ⓪ notOnA7  JSR     LookInt        ;^Resulttype der Proc/Function⓪)TST.L   D0⓪)BEQ     noFunc         ;wenn kein Erg, dann bleiben Parms auf A3⓪ ⓪)TST     RetFlag        ;F-Result > 4 Byte?⓪)BEQ     moveParm       ;ja -> Link mit lokalem Copy auf A7⓪ ⓪ noFunc   ; ** Proc erhält Parms. -> auf A3 belassen **⓪); Werte bleiben auf A3-Stack. Dazu muß gesonderter LINK gen. werden:⓪); LINK    A5,#0⓪); MOVE.L  A6,-(A7)⓪); MOVE.L  A3,A6⓪); MOVE.L  D2,(A3)+   ; falls lok. Proc⓪); ADDI    #varspc-parspc,A3⓪)MOVE.L  VarSpc,D0⓪)CMPI.W  #1,GLOBAL     ;globale Proc?⓪)BEQ     Block102      ;ja⓪)SUBQ.L  #4,D0         ;lokale Proc: 4 Byte f. stat. Link nicht addieren⓪ Block102 JSR     PutLinkWOcopy⓪)MOVE.L  VarSpc,D0⓪)ADD.L   ParAdr,D0⓪)MOVE.L  D0,VarA3Ofs   ;für putRET, damit A3 am Ende korrig. wird⓪)BRA.W   endOfParmCopy⓪ ⓪ moveParm MOVE.L  VARSPC,D0⓪)BPL     movePar2⓪)NEG.L   D0⓪ movePar2 CMPI.W  #1,GLOBAL     ;globale Proc?⓪)BEQ     Block10       ;ja⓪)SUBQ.L  #4,D0         ;lokale Proc: 4 Byte in Wirklichkeit für Link⓪ Block10  MOVE.L  D0,-(A7)      ;Netto-VarPlatz merken⓪ ⓪);normalen (alten) Link erzeugen:⓪); LINK   A5,#-varspc⓪); MOVE.L D2,-(A7)⓪); MOVE.L A7,A2⓪); MOVEM  A6,-(A7)⓪); MOVE.L A2,A6⓪)NEG.L   D0⓪)JSR     put5          ;LINK ERZEUGEN⓪ ⓪ linkOK   MOVE.L  (A7)+,D1      ;Platz für lokale Var⓪)MOVE.L  PARADR,D0     ;Platz für Parameter⓪)BEQ     Block8        ;KEINE⓪)⓪)LSR.L   #1,D0⓪)SUBQ.L  #1,D0⓪)SUB.L   PARADR,D1     ;Offset: Ende der Parameter bis Ende lok.Var.⓪)⓪); lok. Daten dürfen > 32K werden, Parameter aber erstmal nicht!⓪)CMP.L   #$7FFF,D1⓪)BCS     Block78⓪)MOVE    #rParOv,D5⓪)JMP     SyntaxErr⓪)⓪ Block78  NEG.L   D1⓪)JSR     put7          ;lokale Variablen umkopieren⓪ ⓪ endOfParmCopy⓪ ⓪ ;⓪ ; *** Nun sind LINK und Parm-Copy durchgeführt ***⓪ ;⓪ ⓪ Block8⓪ (*$ ? Gepard:                  ;+++ Konfiguration nicht für Atari⓪)TST.W   MODFLAG       ;Module Body?⓪)BEQ     NoConf        ; nein, keine Konfiguration⓪)MOVE.L  Options,D1⓪)BTST    #11,D1        ;Konfig-Option?⓪)BNE     NoConf        ; K+, also auch nicht⓪)JSR     Put147        ; K-, Leer-Branch erzeugen⓪ *)⓪ !NoConf  CMPI.W  #1,MODFLAG⓪)BEQ     Block18       ;LOCAL MODULE⓪)JSR     LookID        ;PROC UND MAIN PROG: ID AUSGEBEN⓪)JSR     PRTID⓪ !Block18 JSR     EXECMOD       ;MODULE INIT⓪)CLR.L   RESTYPE⓪)TST.W   MODFLAG⓪)BNE     Block21⓪)JSR     PullInt       ;^RESULTTYPE BEI PROC⓪)MOVE.L  D0,RESTYPE⓪ !Block21 CLR.W   LastRet⓪)JSR     SAMESBL⓪)CMPI.W  #36,D3        ;BEGIN⓪)BNE.L   Block19⓪)⓪); Programmcode erzeugen⓪)NOT.W   CODEGEN⓪)MOVE.L  A7Offset,-(A7)⓪)MOVE.L  A3Offset,-(A7)⓪)CLR.L   A3Offset⓪)CLR.L   A7Offset⓪)JSR     aBegin⓪)JSR     StatSeq⓪)JSR     aEnd⓪)MOVE.L  (A7)+,A3Offset⓪)MOVE.L  (A7)+,A7Offset⓪)NOT.W   CODEGEN⓪ ⓪ !Block19 CMPI.W  #35,D3        ;END⓪)BEQ     ok2⓪)MOVE    #rBdSym,D5    ;END EXPECTED⓪)JMP     SyntaxErr⓪ !ok2⓪)TST.W   MODFLAG⓪)BNE     Block9        ;MODULE BODY: KEIN RETURN NOETIG⓪)TST.L   RESTYPE⓪)BEQ     Block9⓪)MOVE.L  Options,D2⓪)BTST    #12,D2        ;Link off?⓪)BEQ     Block9        ;  ja, RETURN nicht nötig⓪)TST.W   LASTRET⓪)BNE     ok3⓪)MOVE    #rNoRet,D5⓪)JMP     SyntaxErr⓪ !ok3⓪ ; Funktion liefert Ergebnis und es kam bereits mind. 1 RETURN vor.⓪ ; Am Ende der Prov einen TRAP anfügen, um zu erkennen, wenn Programm⓪ ; dorthin ohne eine RETURN-Anweisung kommt.⓪)TST.W   LastWasRet    ;haben wir gerade ein RETURN gehabt?⓪)BNE     ok4           ;  dann brauchen wir den Trap nicht.⓪)JSR     put55         ;TRAP f. vergessenes RETURN bei Function⓪ !ok4⓪ (*$?~MAC: ; beim Mac muß immer RTS am Ende stehen f. Procname/MacsBug⓪)BRA     Block6⓪ *)⓪ ⓪ !Block9⓪ (*$?~MAC: ; beim Mac muß immer RTS am Ende stehen f. Procname/MacsBug⓪)TST.W   LastRet⓪)BEQ     putit⓪)JSR     jmpToRet       ;Sprung zum letzten RETURN gen.⓪)BRA     Block6⓪ *)⓪ putit    JSR     putRET⓪)ADDQ.W  #1,LastRet⓪ ⓪ (*$?MAC: ; Proc-/Module-Name im Mac-Style hinter die Proc⓪)MOVE.B  #$80,(A4)+⓪)MOVE.L  A4,-(A7)⓪)ADDQ.L  #1,A4⓪)JSR     LookID⓪!en5     MOVE.B  (A0)+,(A4)+⓪)BNE     en5           ;kopieren bis Endmarke 0.B⓪)SUBQ.L  #1,A4⓪)MOVE.L  A4,D0⓪)MOVE.L  (A7)+,A0⓪)SUB.L   A0,D0⓪)SUBQ    #1,D0⓪)MOVE.B  D0,(A0)⓪)JSR     put0          ;sync⓪)CLR.W   (A4)+⓪ *)⓪ Block6:  TST.W   GLOBAL⓪)BEQ     isglobl⓪)JSR     FinConst      ;die lokal dekl. CONSTs in DATA-Puffer kopieren⓪ isglobl: MOVE.W  (A7)+,MODCNT⓪)MOVE.W  (A7)+,negVarSpc⓪)JMP     FinLblAndFwrd  ;Sind alle Fwrd-Refs aufgelöst?⓪'END⓪ END Block;⓪ ⓪ (*⓪!*   TABLE⓪!*)⓪ ⓪ PROCEDURE TABDEC;⓪ BEGIN  ASSEMBLER⓪)⓪ ⓪ los      TST.W   GLOBAL        ;GLOBALES LEVEL?⓪)BEQ     ok⓪)MOVE    #rLocTb,D5    ; LOKAL NICHT ERLAUBT⓪)JMP     SyntaxErr⓪ !ok      JSR     GetSbl⓪)CMPI.W  #9,D3         ;.?⓪)BNE     TABDEC1⓪)JSR     FETNOSP       ;LAENGEN-SUFFIX HOLEN⓪)ANDI.W  #$5F,D2       ;KLEINSCHRIFT WEG⓪)MOVE.W  D2,-(A7)⓪)JSR     GetSbl⓪)BRA     TABDEC2⓪ !TABDEC1 MOVE.W  #'W',-(A7)⓪ !TABDEC2 TST.W   D3⓪)JSR     GETID0        ;TABELLEN-NAME⓪)JSR     PULLID⓪)JSR     SetId⓪)MOVE.W  #$801C,D0⓪)JSR     SETKNG⓪)MOVE.L  D6,-(A7)      ;Baumeintrag merken⓪)MOVE.L  A4,D0⓪)SUB.L   CodeStart,D0⓪)MOVE.L  D0,-6(A1,D6.L)   ;Adr⓪)MOVE.L  D0,-18(A1,D6.L)  ;Adr nochmal für Längenliste⓪)⓪); !TT 14.07.88⓪)TST.W   ProcNames⓪)BEQ     noName         ;Name ist nicht gefragt⓪)CLR.L   (A4)+          ; Leernamen einfügen, damit Linker klarkommt⓪)CLR.L   (A4)+⓪)ADDQ.L  #8,-6(A1,D6.L)   ;Adr korrigieren (hinter ProcName)⓪ noName   CLR.L   -10(A1,D6.L)     ;^letzte Ref.⓪)SUBI.L  #18,D6⓪)MOVE.L  D6,TRESPC⓪)JSR     GetSbl⓪)CMPI.W  #25,D3        ;:⓪)BEQ     TABDEC3⓪)MOVE    #rColXp,D5         ; EXP⓪)JMP     SyntaxErr⓪ !TABDEC3 JSR     GetSbl⓪)JSR     ConstExpr⓪)JSR     PullInt⓪)MOVE.L  D0,D2⓪)CMP.L   StrPtr,D2     ;STRING?⓪)BNE     TABDEC4⓪)LEA     STRBUF,A0⓪)MOVE.W  STRLEN,D2⓪)SUBQ.W  #1,D2⓪)BMI     TABDEC5⓪)CLR.L   D0⓪)MOVE.W  4(A7),D1⓪ !TABDEC6 MOVE.B  (A0)+,D0⓪)BSR.L   TABELM⓪)DBF     D2,TABDEC6⓪)BRA     TABDEC5⓪ ⓪ !TABDEC4 CMPI.B  #2,-1(A1,D2.L) ;Real ?⓪)BEQ     ok1            ; ja⓪)BTST    #0,-2(A1,D2.L) ; nein, dann also Skalar?⓪)BNE ok1⓪)MOVE    #rConTp,D5     ;ILL.TYPE⓪)JMP     SyntaxErr⓪ !ok1     MOVE.L  Accu,D0         ;S1<=>I1⓪)MOVE.L  AccuS14,D2⓪)MOVE.W  4(A7),D1      ;LAENGE⓪)BSR.L   TABELM        ;put B/W/L/D⓪ ⓪ !TABDEC5 JSR     SameSbl⓪)CMPI.W  #10,D3        ;,⓪)BEQ     TABDEC3⓪)CMPI.W  #11,D3        ;;⓪)BEQ     ok2⓪)MOVE    #rSemXp,D5⓪)JMP     SyntaxErr⓪ !ok2     JSR     put0          ;SYNC⓪)⓪)MOVE.L  (A7)+,D6        ;^Baumeintrag⓪)MOVE.L  A4,D0           ;aktuelle Code-Adr⓪)SUB.L   CodeStart,D0    ;relativ⓪)SUB.L   -18(A1,D6.L),D0 ;Anfangsadr abziehen: Länge⓪)MOVE.L  D0,-14(A1,D6.L) ;in Baum eintragen⓪)⓪)JSR     GetSbl⓪)BLS     TABDEC2         ;weitere ID's zur gleichen Elementlänge⓪)⓪)ADDQ.L  #2,A7           ;Elementlänge vom Stack⓪)RTS⓪ ⓪ !TABELM  CMPI.B  #'W',D1⓪)BEQ     TABELM4⓪)CMPI.B  #'L',D1⓪)BEQ     TABELM5⓪)CMPI.B  #'D',D1⓪)BEQ     ok4⓪)CMPI.B  #'B',D1⓪)BEQ     ok3⓪)MOVE    #rBdSuf,D5⓪)JMP     SyntaxErr⓪ !ok4     MOVE.L  D0,(A4)+⓪)MOVE.L  D2,(A4)+⓪)BRA     TABELM6⓪ !ok3     MOVE.B  D0,(A4)+⓪)BRA     TABELM6⓪ !TABELM4 MOVE.W  D0,(A4)+⓪)BRA     TABELM6⓪ !TABELM5 MOVE.L  D0,(A4)+⓪ !TABELM6⓪'END⓪ END TABDEC;⓪ ⓪ (*⓪!*   PROCEDURE⓪!*)⓪ ⓪ PROCEDURE PROCDEC;⓪ BEGIN  ASSEMBLER⓪*; Der Relocation-Stackptr für lokale Module muß hier gerettet⓪*; und am Proc-Ende zurückgesetzt werden. Das ist nötig, weil⓪*; Module lok. zu Procs ja ihre Deklarationen im Baum anlegen,⓪*; dieser aber über ClrTre bei Proc-Ende gelöscht wird und sonst beim⓪*; erneuten Wachsen des Baums die Items des Modulbaums überschrieben⓪*; würden. Macht aber nix, da solche Module nicht nach außen über die⓪*; Proc hinweg exportieren können.⓪*MOVE.L  RStkPtr,-(A7)⓪*MOVE    StatLinkOffs,-(A7)⓪*CLR     StatLinkOffs⓪*MOVE.L  VARSPC,-(A7)⓪*CLR.L   VARSPC⓪*⓪*TST.W   GLOBAL        ;GLOBALE PROC?⓪*BEQ     PROCDEC1⓪*ADDQ.L  #4,VARSPC     ;4 BYTE OFFSET WEGEN StatLINK⓪ !PROCDEC1 MOVE.W  MODFLAG,-(A7)⓪*CLR.W   MODFLAG       ;PROC BODY⓪*MOVE.L  freeRegs,-(A7)⓪*⓪*JSR     GetSbl⓪*JSR     PrHead        ;formale Parameter auswerten⓪*⓪*MOVE.L  fparm,A0      ;^Baumeintrag-6⓪*BTST    #0,4(A0)      ;kommt Result in ein Reg?⓪*SNE     D0⓪*ANDI    #1,D0⓪*MOVE    D0,RetFlag⓪*BTST    #3,4(A0)      ;Stehen Parms auf A7?⓪*SNE     D0⓪*ANDI    #1,D0⓪*MOVE    D0,parmsOnA7⓪*⓪*JSR     initBlock     ; definiert alle Regs, außer A3,A7 als frei⓪*(*$C+*)⓪*MOVEQ   #MM2Comp2.A5,D0⓪*JSR     MM2Comp2.exclFromFreeRegs ; A5 als belegt kennzeichnen⓪*(*$C=*)⓪*TST     parmsOnA7⓪*BNE     noA6excl⓪*(*$C+*)⓪*MOVEQ   #MM2Comp2.A6,D0⓪*JSR     MM2Comp2.exclFromFreeRegs ; A6 als belegt kennzeichnen⓪*(*$C=*)⓪ noA6excl  MOVE.L  freeRegs,-(A7)⓪*⓪*; Nun prüfen, ob "FORWARD;" folgt.⓪*CLR     gotFrwd⓪*JSR     GetSbl⓪*CMPI.W  #90,D3        ;FORWARD⓪*BNE     noFrwd⓪*⓪*ADDQ    #1,gotFrwd    ; merken, daß bereits FORWARD gefunden⓪*JSR     GetSbl⓪*CMPI.W  #11,D3        ; ";"⓪*BNE     noFrwd⓪*⓪*; es ist eine FORWARD-Deklaration nach Pascal-Syntax.⓪*; nun wird aufgeräumt:⓪*JSR     PullInt       ;Erg-Typ (in PrHead gesetzt)⓪*JSR     CLRTRE        ;LOKALE VAR ETC LOESCHEN⓪*ADDQ.W  #1,OpenFwds⓪*BRA.W   frwdExit⓪*⓪ noFrwd    ; ParAdr enthält die Anzahl der als Parms übergebenen Bytes, also⓪*;   immer ohne evtl. stat.Link-Ptr, weil der ja nicht auf dem Stack,⓪*;   sondern in einem Reg übergeben wird.⓪*; VarSpc die bisher benötigten Bytes für den lokalen Stack,⓪*;   das sind bis jetzt nur evtl. die 4 Byte f. die Speicherung des⓪*;   stat.Link. Der Rest wird erst in "Block" bei der VAR-Dekl.⓪*;   errechnet.⓪*⓪*MOVE.L  fparm,A0      ;^Baumeintrag-6⓪*SUBA.W  #20,A0        ;jetzt ^Adress-Eintrag⓪*MOVE.L  A4,D0         ;Anfangsadresse eintragen⓪*SUB.L   CodeStart,D0⓪*MOVE.L  D0,(A0)       ;Offset: -26⓪*MOVE.L  A0,-(A7)⓪*⓪*; Wenn Prozedur mit Parms und kein Result oder Result in D0,⓪*; bleiben Parms auf A3-Stack (kein lokales Umkopieren). Dazu⓪*; werden hier die Offsets korrigiert⓪ moveParms TST.L   ParAdr        ;wenn keine Parms, dann normalen Link⓪*BEQ     isFunc2⓪*⓪*TST     parmsOnA7⓪*BEQ     notOnA7      ;Parms sind nicht auf A7⓪*⓪*; nun müssen die Offsets f. A7-Parms korrigiert werden.⓪*CMPI.W  #1,GLOBAL     ;globale Proc?⓪*BEQ     Block103      ;ja⓪*ADDQ.L  #4,ParAdr     ;lokale Proc: 4 Byte f. stat. Link reservieren⓪*MOVE    #8,StatLinkOffs ; und Offset f. Zugriff (A5) merken⓪ Block103  LEA     MovParA7Knot,A5⓪*MOVE.L  (A6),D2       ;^Tree der lok. Vars⓪*JSR     TravTr1⓪*; und VarSpc rücksetzen⓪*CLR.L   VarSpc⓪*BRA     isFunc2⓪ ⓪ notOnA7   JSR     LookInt       ;^RESULTTYPE BEI PROC⓪*TST.L   D0            ;wenn kein F-Ergebnis, dann korrigieren⓪*BEQ     moveParm2⓪*TST     RetFlag       ;Result in D0?⓪*BEQ     isFunc2       ;nein -> Parms werden normal umkopiert⓪ ⓪ moveParm2 ; nun müssen die Offsets der Parms f. A3 korrigiert werden.⓪*LEA     MovParA3Knot,A5⓪*MOVE.L  (A6),D2       ;^Tree der lok. Vars⓪*JSR     TravTr1⓪*; und VarSpc wieder rücksetzen⓪*CLR.L   VarSpc⓪*CMPI.W  #1,GLOBAL     ;globale Proc ?⓪*BEQ     isFunc2⓪*ADDQ.L  #4,VarSpc⓪ ⓪ isFunc2   JSR     SameSbl⓪*MOVE.L  4(A7),D0      ;freeRegs⓪*JSR     Block⓪*JSR     CLRTRE⓪ ⓪*MOVE.L  (A7)+,A0      ;Eintrag f. Längenliste fertigstellen⓪*MOVE.L  A4,D0⓪*SUB.L   CodeStart,D0  ;relative Pos. des Endes⓪*SUB.L   (A0),D0       ;Adresse (Offset: -26)⓪*MOVE.L  D0,4(A0)      ;Länge (Offset: -22)⓪ ⓪*JSR     OLDID⓪*JSR     CHECKID⓪*BEQ     ok4           ;IDs sind gleich⓪*MOVE    #rIdMis,D5    ;MisMatch⓪*JMP     SyntaxErr⓪ ok4       JSR     GetSbl⓪*CMPI.W  #11,D3⓪*BEQ     ok⓪*MOVE    #rSemXp,D5          ;';' EXPECTED⓪*JMP     SyntaxErr⓪ !ok⓪ frwdExit  ADDQ.L  #4,A7⓪*MOVE.L  (A7)+,freeRegs⓪*MOVE.W  (A7)+,MODFLAG⓪*MOVE.L  (A7)+,VARSPC⓪*MOVE    (A7)+,StatLinkOffs⓪*MOVE.L  (A7)+,RStkPtr⓪*SUBQ.W  #1,GLOBAL⓪*JSR     PULLID⓪'END⓪ END PROCDEC;⓪ ⓪ (*⓪!*   ------------------⓪!*   MODULE DEKLARATION⓪!*   ------------------⓪!*)⓪ ⓪ PROCEDURE ModDec;⓪ BEGIN  ASSEMBLER⓪ !ok2     JSR     GETID⓪)JSR     LookID⓪)JSR     PRTID⓪)JSR     LookID⓪)JSR     SetId⓪)MOVE.W  #$800F,D0⓪)JSR     SETKNG⓪)LEA     -10(A1,D6.L),A0⓪)MOVE.L  A0,FPARM      ;für BLOCK: hier Rumpf-Adr eintragen⓪)CLR.L   -6(A1,D6.L)   ;^LOK. BAUM BEI QUAL.EXP⓪)CLR.L   -14(A1,D6.L)  ;DUMMY⓪)CLR.L   -18(A1,D6.L)  ;DUMMY⓪)CLR.L   -22(A1,D6.L)  ;^ LETZTE REF⓪)⓪)MOVE.L  D6,-(A7)      ;für späteren Längeneintrag⓪)MOVE.L  D6,D0         ;fuer spätere Initialisierung⓪)JSR     PushInt       ;Modul-Eintrag merken⓪)ADDQ.W  #1,MODCNT⓪)SUBI.L  #30,D6⓪)MOVE.L  D6,TRESPC⓪)MOVE.L  #1,-(A6)⓪)CLR.L   -(A6)         ;DISP STACK ERHOEHEN⓪)MOVE.W  Priority,-(A7)⓪)JSR     GetPriority⓪)JSR     GetSbl⓪)JSR     aImport⓪)JSR     aExport⓪)MOVE.W  XPCNT,-(A7)⓪)MOVE.W  MODFLAG,-(A7)⓪)MOVE.W  #$1,MODFLAG   ;LOCAL MODULE⓪)CLR     RetFlag       ;keine Parm-Rückgabe in D0⓪)CLR     parmsOnA7⓪)MOVE.L  freeRegs,-(A7)⓪)JSR     initBlock     ;reg./temp. Vars freigeben (incl. A5,A6)⓪); bei Modulen lokal zu Procs A5/A6 nicht freigeben:⓪)TST.W   GLOBAL        ;in Proc?⓪)BEQ     isglobal      ;nein⓪)(*$C+*)⓪)MOVEQ   #MM2Comp2.A5,D0⓪)JSR     MM2Comp2.exclFromFreeRegs ; A5 als belegt kennzeichnen⓪)MOVEQ   #MM2Comp2.A6,D0⓪)JSR     MM2Comp2.exclFromFreeRegs ; A6 als belegt kennzeichnen⓪)(*$C=*)⓪ isglobal MOVE.L  freeRegs,D0⓪)CLR     gotFrwd⓪)JSR     Block⓪)MOVE.L  (A7)+,freeRegs⓪)MOVE.W  (A7)+,MODFLAG⓪)MOVE.W  (A7)+,XPCNT⓪)MOVE.W  (A7)+,Priority⓪)JSR     LOCXP          ; Local Export⓪)⓪);*** Eintrag f. Längenliste fertigstellen⓪)⓪)MOVE.L  (A7)+,D1⓪)MOVE.L  -10(A1,D1.L),A0 ;Rumpfanfang⓪)ADDA.L  CodeStart,A0⓪)TST.W   ProcNames⓪)BEQ     fertig          ;kein Name vorhanden⓪)SUBQ.L  #8,A0           ;so lang ist der Namenseintrag mindestens⓪ look     TST.B   (A0)            ;suche 0-Marke vor dem Namen⓪)BEQ     fertig⓪)SUBQ.L  #2,A0⓪)BRA     look⓪ fertig   MOVE.L  A4,D0⓪)SUB.L   A0,D0⓪)MOVE.L  D0,-26(A1,D1.L) ;Länge des Rumpfes inkl. Name⓪)⓪)MOVE.L  A0,D0⓪)SUB.L   CodeStart,D0⓪)MOVE.L  D0,-30(A1,D1.L) ;Anfang des Rumpfes vor dem Namen⓪)⓪)MOVE.L  (A6)+,D0⓪)BEQ     ModDec1⓪)MOVE.L  RSTKPtr,A0    ;MERKEN⓪)MOVE.L  D0,-(A0)⓪)MOVE.L  A0,RSTKPtr⓪ !ModDec1 ADDQ.L  #4,A6⓪)JSR     OLDID⓪)JSR     CHECKID⓪)BEQ     ok4           ;IDs sind gleich⓪)MOVE    #rIdMis,D5    ;MisMatch⓪)JMP     SyntaxErr⓪ ok4      JSR     PULLID⓪)JSR     GetSbl⓪)CMPI.W  #11,D3⓪)BEQ     ok1⓪)MOVE    #rSemXp,D5⓪)JMP     SyntaxErr⓪ !ok1     RTS⓪!END⓪ END ModDec;⓪ ⓪ ⓪ PROCEDURE aImport;⓪ BEGIN⓪ ASSEMBLER⓪ ;⓪ ;   ----------------------------⓪ ;   Import-STATEMENT UEBERSETZEN⓪ ;   ----------------------------⓪ ;⓪ aImports CMPI.W  #69,D3       ;'Import'?⓪)BNE     Import1⓪)MOVE.L  A6,D0⓪)ADDQ.L  #8,D0        ;die importierbaren Ids finden wir im⓪)MOVE.L  D0,SourceScope ;naechsthoeheren Scope Level⓪ Import2  JSR     ImpID⓪)JSR     GetSbl⓪)CMPI.W  #10,D3        ;,⓪)BEQ     Import2⓪)CMPI.W  #11,D3⓪)BEQ     ok2⓪)MOVE    #rSemXp,D5⓪)JMP     SyntaxErr⓪ ok2      JSR     GetSbl⓪)BRA     aImports⓪ Import1  CMP.W   #68,D3        ;'FROM'?⓪)BNE     Import3       ;nein, also gar kein Import-Statement⓪)ADDQ.L  #8,A6         ;naechsthoeheres Scope waehlen⓪)JSR     GetSbl        ;Modul-Namen holen⓪)LEA     -8(A6),A6     ;zurueck ins Scope des lok. Moduls⓪)BEQ     Er58          ;undecl.⓪)BPL     Er5           ;kein Id⓪)CMPI.B  #16,-1(A1,D2.L) ;DefMod-Qualifier ?⓪)BEQ     ok5⓪)CMPI.B  #15,-1(A1,D2.L) ;lokales Modul ?⓪)BEQ     ok5⓪)MOVE    #rMdDXp,D5     ;kein Module-Name⓪)JMP     SyntaxErr⓪ Er5      MOVE    #rIdXp,D5      ;kein Id, sondern res. Wort⓪)JMP     SyntaxErr⓪ ER58     MOVE    #rIdUn,D5      ;undeclared⓪)JMP     SyntaxErr⓪ ok5      MOVE.L  -6(A1,D2.L),-(A7) ;^lokalen Baum hinter dem Qualifier⓪)JSR     GetSbl⓪)CMPI.W  #69,D3        ;'IMPORT'?⓪)BEQ     ok6           ;klar doch!⓪)MOVE    #rImpXp,D5    ;nein? sollte aber kommen!⓪)JMP     SyntaxErr⓪ ok6      MOVE.L  #1,-4(A6)     ;neues, abgeschl. ScopeLevel simulieren,⓪)MOVE.L  (A7)+,-8(A6)  ;das die qualif. Ids enthaelt⓪)MOVE.L  A6,D0⓪)SUBQ.L  #8,D0⓪)MOVE.L  D0,SourceScope ;aus diesem neuen  Level wird importiert⓪)BRA     Import2        ;weiter wie IMPORT ohne FROM⓪ Import3⓪!END⓪ END aImport;⓪ ⓪ PROCEDURE aExport;⓪ BEGIN⓪!ASSEMBLER⓪ ;⓪ ;   ------------------------⓪ ;   LOKALE Export-STATEMENTS⓪ ;   ------------------------⓪ ;⓪)CLR.W   XPCNT⓪)CMPI.W  #1,D3⓪)BNE     Export1⓪)CLR.L   -(A7)            ;DEFAULT IST UNQUAL.⓪ Export3  JSR     GetSbl⓪)BLS     Export2       ;ID (0 ODER NEG.)⓪)CMPI.W  #64,D3        ;QUALIFIED?⓪)BEQ     ok3⓪ idxp     MOVE    #rIdXp,D5⓪)JMP     SyntaxErr⓪ ok3      MOVE.L  FPARM,D0⓪)ADDQ.L  #4,D0         ;HIER ^LOKALEN BAUM NACHTRAGEN⓪)MOVE.L  D0,(A7)⓪ Export4  JSR     GetSbl⓪)BHI     idxp⓪ Export2  JSR     OLDID0        ;BEI QUALEXP AUCH BEKANNTE ID'S ERLAUBT⓪)ADDQ.W  #1,XPCNT⓪)JSR     GetSbl⓪)CMPI.W  #10,D3        ; ',' -> MEHR ID'S⓪)BEQ     Export4⓪)CMPI.W  #11,D3        ; ';' ?⓪)BEQ     ok4⓪)MOVE    #rSemXp,D5⓪)JMP     SyntaxErr⓪ ok4      MOVE.L  (A7)+,D0      ;QUAL.FLAG AUF STACK⓪)JSR     PushInt⓪)JMP     GetSbl⓪ Export1⓪!END⓪ END aExport;⓪ ⓪ (* zwei Proc-Types vergleichen. Source in D2, Dest in D0, Returncode in D1 *)⓪ PROCEDURE AsComp20;⓪ BEGIN ASSEMBLER⓪*MOVEM.L D0/D2,-(A7)⓪*MOVE.W  -2(A1,D2.L),D1  ;Source-Kennung⓪*CMPI.B  #19,D1        ;SOURCE DARF PROC.TYPE SEIN⓪*BEQ     AsComp21⓪*CMPI.B  #6,D1         ; ODER PROC⓪*BEQ     AsComp21⓪*CMPI.B  #44,D1        ;SOURCE DARF local PROC.TYPE SEIN⓪*BNE.W   noCompat⓪*MOVE.L  -10(A1,D2.L),D2 ;bei lok.Proctypes ^19er-Kennung laden⓪ AsComp21⓪*;prüfen, ob beide die selben Übergabe-Flags f. Parms & Result haben⓪*MOVE    D3,-(A7)⓪*ANDI    #$0900,D1⓪*MOVE.W  -2(A1,D0.L),D3⓪*ANDI    #$0900,D3⓪*CMP     D1,D3⓪*BNE     noCompat3⓪*MOVE    (A7)+,D3⓪*⓪*SUBQ.L  #4,D0⓪*SUBQ.L  #4,D2⓪*BRA     AsComp26        ;hier gibt's noch kein VarPar-Flag!⓪ ⓪ noCompat3 ANDI    #$0800,D1⓪*ANDI    #$0800,D3⓪*CMP     D1,D3⓪*BNE     noCompat4⓪*MOVE    (A7)+,D3⓪*MOVEM.L (A7)+,D0/D2⓪*MOVE    #rZopt,D1⓪*RTS⓪ noCompat4 MOVE    (A7)+,D3⓪ noCompa4b MOVEM.L (A7)+,D0/D2⓪*MOVE    #rParOp,D1⓪*RTS⓪ ⓪ noCompat2 CMP.B   -11(A1,D2.L),D1 ;stimmt Reg-Übergabe?⓪*BNE     noCompa4b⓪*BRA.W   noCompat⓪ ⓪ !AsComp24 MOVE.W  -12(A1,D0.L),D1 ;*** VarPar-Flags vergleichen⓪*CMP.W   -12(A1,D2.L),D1⓪*BNE     noCompat2       ;not ok⓪*⓪ !AsComp26 MOVEM.L D0/D2,-(A7)⓪*MOVE.L  -10(A1,D2.L),D2 ;*** Typ-Eintrag vergleichen⓪*MOVE.L  -10(A1,D0.L),D0⓪ ⓪ compar⓪ (* TT: das dürfte doch gar nicht mehr nötig sein?⓪*TST.B   -1(A1,D0.L)     ;Relay (nachdekl. Opaque) ?⓪*BNE     noRel1⓪*MOVE.L  -6(A1,D0.L),D0⓪ noRel1    TST.B   -1(A1,D2.L)     ;Relay (nachdekl. Opaque) ?⓪*BNE     noRel2⓪*MOVE.L  -6(A1,D2.L),D2⓪ noRel2⓪ *)        CMP.L   D0,D2⓪*BEQ.W   nextPar         ;direkt gleich⓪*MOVE.B  -1(A1,D2.L),D1  ;nicht gleich: OpenArray oder String ?⓪*BEQ     foundDif        ;Relay? Dann sicher Fwrd-Typ⓪*CMP.B   -1(A1,D0.L),D1⓪*BNE.W   foundDif        ;auch verschiedene Kennung: falsch⓪*⓪*CMPI.B  #42,D1⓪*BEQ     isOpen⓪*CMPI.B  #32,D1⓪*BNE     noOpen⓪*⓪ isOpen    MOVE.L  -6(A1,D2.L),D2  ;zwei Open Arrays:⓪*MOVE.L  -6(A1,D0.L),D0⓪*BRA     compar          ;Elementtypen vergleichen⓪ ⓪ noOpen    CMPI.B  #44,D1⓪*BNE     noPr44⓪*; Proc-Parm vergleichen⓪*MOVE.L  -10(A1,D0.L),D1  ;^Type⓪*CMP.L   -10(A1,D2.L),D1⓪*BNE     foundDif⓪*MOVE.B  -2(A1,D0.L),D1⓪*MOVE.B  -2(A1,D2.L),D2⓪*ANDI.B  #1,D1⓪*ANDI.B  #1,D2⓪*CMP.B   D2,D1            ;D0-Rückgabe-Flags vergleichen⓪*BEQ     nextPar⓪*BRA     foundDif⓪ ⓪ noPr44    CMPI.B  #27,D1⓪*BNE     foundDif⓪*MOVE.L  -10(A1,D0.L),D1 ;zwei Strings⓪*CMP.L   -10(A1,D2.L),D1 ;Laengen gleich ?⓪*BEQ     nextPar⓪ ⓪ foundDif  ;prüfen, ob einer der Parms ein Fwrd-Typ ist - dann andere Meldung⓪*TST.B   -1(A1,D2.L)⓪*BEQ     fwrdTyp⓪*TST.B   -1(A1,D0.L)⓪*BEQ     fwrdTyp⓪*ADDQ.L  #8,A7           ;Abweichung: alte D0/D2 vergessen⓪ noCompat  MOVEM.L (A7)+,D0/D2⓪*MOVEQ   #-1,D1⓪*RTS⓪ ⓪ fwrdTyp   ADDQ.L  #8,A7           ;Abweichung: alte D0/D2 vergessen⓪*MOVEM.L (A7)+,D0/D2⓪*MOVE    #rBdPrc,D1⓪*RTS⓪ ⓪ nextPar   MOVEM.L  (A7)+,D0/D2    ;zurueck in die Parameter-LinkedList⓪*MOVE.L  -6(A1,D2.L),D2  ;*** Pointerkette weiter verfolgen⓪*BEQ     AsComp23⓪*MOVE.L  -6(A1,D0.L),D0⓪*BNE     AsComp24⓪*BRA     noCompat⓪ ⓪ AsComp23  MOVE.L  -6(A1,D0.L),D0⓪*BNE     noCompat⓪ isCompat  MOVEM.L (A7)+,D0/D2⓪*CLR     D1⓪!END⓪ END AsComp20;⓪ ⓪ FORWARD   MarkId1;⓪ PROCEDURE MarkId;⓪ ⓪#(*   ID (und evtl. EnumElemente) im Baum markieren⓪$*⓪$*      (D2)⓪$*⓪$*      (A1,D2.L) = ^ zu markierenden Eintrag⓪$*      D0        = zu setzendes Bit im FlagByte (0..7)⓪$*)⓪ ⓪ BEGIN⓪ ASSEMBLER⓪)BSET    D0,-2(A1,D2.L) ;Eintrag markieren⓪)BNE     dblExp         ;wurde schon exportiert⓪)TST.B   -1(A1,D2.L)    ;ist es ein Relay-Eintrag?⓪)BNE     norel⓪)MOVE.L  -6(A1,D2.L),D2⓪ norel:   JMP     MarkId1⓪ dblExp   JSR     LoadBadID⓪)MOVE    #rDblEx,D5     ;doppelter Export⓪)JMP     SyntaxErr⓪ END⓪ END MarkId;⓪ ⓪ PROCEDURE MarkId1;⓪ ⓪#(*   NUR evtl. EnumElemente im Baum markieren⓪$*⓪$*      (D2)⓪$*⓪$*      (A1,D2.L) = ^ Enum-Typ-Eintrag⓪$*      D0        = zu setzendes Bit im FlagByte (0..7)⓪$*)⓪ ⓪ BEGIN⓪ ASSEMBLER⓪)CMPI.B  #9,-1(A1,D2.L) ;Enum?⓪)BNE     mark2⓪)MOVE.L  -14(A1,D2.L),D2⓪ mark3    BSET    D0,-2(A1,D2.L) ;Element exportieren⓪)MOVE.L  -12(A1,D2.L),D2⓪)BNE     mark3⓪ mark2⓪ END⓪ END MarkId1;⓪ ⓪ VAR  IdBuffer: ARRAY [0..255] OF Char;⓪ ⓪ PROCEDURE MakeId;⓪#⓪#(*   traegt ID aus Baum vorwaerts in IDBuffer ein.⓪$*   A0  =  ^ hinter Id im Baum⓪$*   A0 :=  ^ IdBuffer⓪$*)⓪ ⓪ BEGIN ASSEMBLER⓪)MOVE.L   A2,-(A7)⓪)LEA      IdBuffer,A2⓪ lp       MOVE.B   -(A0),(A2)+⓪)CMPI.B   #$FE,(A0)⓪)BCS      lp⓪)CLR.B    -1(A2)        ;Null als Endmarke⓪)LEA      IdBuffer,A0⓪)MOVE.L   (A7)+,A2⓪&END⓪ END MakeId;⓪ ⓪ ⓪ PROCEDURE SetRelay;⓪ ⓪"(*   lokaler Import & Export: Knoten-Handler fuer TravTre;⓪#*   traegt fuer markierte Objekte ein Relay im obersten Scope des⓪#*   Display-Stacks ein.⓪#*⓪#*   Sieht dabei immer die Markierung des Original-Eintrags an,⓪#*   bei Relays also den Relay-Eintrag und nicht den Verwiesenen.⓪#*   Das ist f. LocXp nötig (s.u.).⓪#*⓪#* Testprg: EXPDUPES.M⓪#*⓪#*   D1 = übersprungene StatLink-Level (im Relay-Eintrag vermerken)⓪#*)⓪ ⓪ BEGIN ASSEMBLER⓪);wir müssen an den Original-Eintrag zum Namen kommen. Bei Relays⓪);zeigt D2 nicht darauf, D4 dafür vor dessen Namen.⓪)⓪);zuerst aber prüfen, ob der Eintrag nicht anonym ist, denn dann⓪);ist er nicht interessant. Da es keine anonymen Relays gibt (sinnlos),⓪);geht uns dabei auch kein evtl. markierter Relay durch die Lappen.⓪); TestPrg: ENUMRLAY.M⓪)CMPI.B  #$FE,-9(A1,D4.L) ; ist Name anonym?⓪)BCC.W   nomark           ; dann ignorieren⓪)⓪)MOVE.L  D4,D0⓪ !TravTr5 SUBQ.L  #2,D0          ;NAME WEG⓪)CMPI.W  #$FE00,-8(A1,D0.L)⓪)BCS     TravTr5        ;noch keine Endmarke⓪)BCLR    #6,-10(A1,D0.L) ;Flag ggf. gleich wieder loeschen!⓪)BNE     mark            ;markiert: kopieren⓪)⓪);da MarkId1 bei Enum-Elems nur die Consts selbst und nicht evtl.⓪);die Relays markiert, müssen wir auch noch das Export-Flag beim⓪);Originaleintrag prüfen⓪); TestPrg: ENUMRLAY.M⓪)BCLR    #6,-10(A1,D2.L) ;Flag ggf. gleich wieder loeschen!⓪)BEQ     nomark          ;markiert: kopieren⓪)⓪ mark     BCLR    #6,-10(A1,D2.L) ;Flag sicherheitshalber immer löschen⓪)MOVE.L  D0,-(A7)⓪)MOVE.W  D1,-(A7)⓪)MOVE.L  D2,-(A7)⓪)LEA     -8(A1,D4.L),A0 ; ^ID holen⓪)JSR     MakeId         ; vorwaerts in Buffer schreiben⓪);bei Prozeduren prüfen, ob lokale Dekl. erfolgt ist⓪)CMPI.B  #6,-9(A1,D2.L)⓪)BNE     noProc⓪)MOVE.L  A0,-(A7)⓪)MOVE.L  A2,-(A7)⓪)MOVE.L  A0,A2⓪)MOVE.B  (A0),D1⓪)MOVE.L  (A6),D2⓪)JSR     LocalSearch    ;nach Proc im globalen Level suchen⓪)MOVE.L  (A7)+,A2⓪)MOVE.L  (A7)+,A0⓪)BCC     localProcExport ;existiert schon außen -> umtragen⓪ noProc:  ; ID mit Relay global eintragen⓪)JSR     SetId⓪)MOVE.L  (A7)+,D2⓪)MOVE.W  (A7)+,D1⓪)MOVE.L  (A7)+,D0       ;dummy⓪)SUBQ.L  #8,D2          ;jetzt ist D2 = ^Id-Beschreibung⓪)CLR.W   -2(A1,D6.L)⓪)MOVE.L  D2,-6(A1,D6.L) ;RELAY-EINTRAG⓪)MOVE.W  D1,-8(A1,D6.L) ;übersprungene ScopeDifferenz⓪)SUBQ.L  #8,D6⓪)MOVE.L  D6,TRESPC⓪ nomark   RTS⓪ ⓪ noCompat MOVE    #rBdIpl,D5⓪)BRA     error⓪ twice    MOVE    #rId2x,D5      ;decl. twice⓪ error    LEA     IdBuffer,A0⓪)JSR     LoadBadID⓪)JMP     SyntaxErr⓪ ⓪ localProcExport⓪); Lokal deklarierte Proc, die schon außen über Def-Modul oder FORWARD⓪); definiert wurde, umtragen.⓪); Dazu werden die Adr., die Länge und die Ref-Verkettung nach außen⓪); kopiert und dann die lokale Definition in ein Relay umgewandelt.⓪)MOVE.L  D2,D0          ;D0 zeigt nun auf globale Proc-Beschreibung⓪)CMPI.B  #6,-1(A1,D2.L) ;ist's auch eine Proc?⓪)BNE     twice⓪)TST.L   -6(A1,D2.L)    ;ist Adr. außen noch unbekannt?⓪)BNE     twice          ;Nein, dann wurde sie schon deklariert⓪)MOVE.L  (A7)+,D2       ;D2 zeigt auf lokale Proc-Beschreibung⓪)SUBQ.L  #8,D2⓪)JSR     AsComp20       ; Definitionen vergleichen⓪)MOVE    D1,D5⓪)BMI     noCompat⓪)BNE     error⓪); Werte umtragen⓪)MOVE.L  -6(A1,D2.L),-6(A1,D0.L) ; Adresse der Proc⓪)MOVE.L  -22(A1,D2.L),-22(A1,D0.L) ; Länge der Proc f. Längenliste⓪)MOVE.L  -26(A1,D2.L),-26(A1,D0.L) ; Adresse der Proc f. Längenliste⓪); jetzt Ref-Kette umtragen. Dazu das Ende der lokalen Kette⓪); finden und dies mit globaler verbinden⓪)LEA     -18(A1,D2.L),A0⓪ next     MOVE.L  (A0),D3⓪)BEQ     ende⓪)ADD.L   CodeStart,D3⓪)MOVE.L  D3,A0⓪)BRA     next⓪ ende     MOVE.L  -18(A1,D0.L),(A0)      ;letzte glob. Ref ans Ende der lok.Kette⓪)MOVE.L  -18(A1,D2.L),-18(A1,D0.L) ; letzte Ref der lok. Kette umtragen⓪); zuletzt lok. Proc-Eintrag zum Relay-Eintrag umwandeln⓪)CLR.B   -1(A1,D2.L)⓪)MOVE.L  D0,-6(A1,D2.L)⓪)MOVE.W  (A7)+,D1⓪)CLR.W   -8(A1,D2.L)    ;SCOPE-Differenz dürfte egal sein, oder?⓪); Falls markierte Eintrag ein Relay war, muß auch der umgebogen werden.⓪); Das kommt z.B. vor, wenn ein lok. Modul einen global Forw-dekl. Bez.⓪); exportiert, der aber erst in einem nochmals dazu lok. Modul dekl. &⓪); exportiert wird. Dann wird zuerst bei Ende des inneren lok. Moduls⓪); ein Relay im äußeren lok. Modul auf die Dekl. angelegt. Hier kommen⓪); wir dann erst beim LocXp vom äußeren lok. Modul hin, wenn die Forw-⓪); dekl. von ganz außen bemerkt wird. Dann muß 1. die Dekl. aus dem lok.⓪); Modul nach ganz außen umgetragen werden (bereits oben geschehen) und⓪); dann auch der Relay-^ im äußern lok. Modul umgebogen werden:⓪)MOVE.L  (A7)+,D1⓪)SUBQ.L  #8,D1⓪)CMP.L   D2,D1⓪)BEQ     ende2⓪); Nun müßte (A1,D1.L) bereits ein Relay-Eintrag sein⓪)MOVE.L  D0,-6(A1,D1.L)⓪)CLR.W   -8(A1,D1.L)    ;SCOPE-Differenz dürfte egal sein, oder?⓪ ende2⓪ END⓪ END SetRelay;⓪ ⓪ ⓪ PROCEDURE ImpID;⓪ BEGIN⓪ ASSEMBLER⓪ ⓪ ;   -----------------------------------⓪ ;   ID aus lokaler Import-ID-Liste lesen⓪ ;   -----------------------------------⓪ ⓪)MOVE.L  A6,-(A7)      ;einiges Getrickse mit A6 wird noetig...⓪)MOVE.L  SourceScope,A6⓪)JSR     GetSbl⓪)BMI     ok5⓪)⓪)MOVE.L  (A7)+,A6      ;kein ID gelesen:⓪)BEQ     Er58          ; - voellig unbekannt⓪)MOVE    #rIdXp,D5     ; - res. Wort⓪)JMP     SyntaxErr⓪ !ER58    MOVE    #rIdUn,D5⓪)JMP     SyntaxErr⓪)⓪ ok5      JSR     OldId0         ;auf ID-Stack⓪)MOVE.L  D2,-(A7)       ;^Id merken⓪)CMPI.B  #9,-1(A1,D2.L) ;Enum?⓪)BNE     ImpId1⓪)⓪); ein Enum-Typ wird importiert:⓪); markiere alle zugehörigen Elementnamen...⓪)⓪)MOVEQ   #6,D0⓪)JSR     MarkId1       ;nur evtl. EnumElemente markieren⓪)MOVE.W  Tiefe,D1      ;durch den Import übersprungene StatLink-Ebenen:⓪?; Tiefe # 0 mögl., wenn Modul lokal zu Prozedur⓪)⓪); ... suche das Scope, in dem der importierte Enum und die Elemente⓪); deklariert sind...⓪)⓪)MOVE.L  (A7),D0⓪ ImpId2   CMPA.L  #Display,A6⓪)BEQ     ImpId3        ;Stack ist leer; ID muß aus pervasive Level sein⓪)MOVE.L  (A6)+,D2⓪)BEQ     ImpId2        ;leeres oder pervasive-Scope, ignorieren⓪)BPL     ImpId2        ;Modul-Grenze⓪)CMP.L   D2,D0⓪)BGT     ImpId2        ;D0 größer: gehört zu 'globalerem' Level⓪)BRA     ImpId4⓪ ImpId3   MOVEQ   #0,D2         ;ins Pervasive Scope⓪ ⓪); ... trage alle in diesem Scope markierten IDs lokal ein⓪)⓪ ImpId4   MOVE.L  4(A7),A6      ;wieder ins normale Scope zum Eintragen⓪)LEA     SetRelay,A5   ;Knoten-Handler-Routine⓪)JSR     TravTr1       ;durchsucht den Source-Baum; SetRelay trägt⓪?; Relays auf alle markierten Objekte ein⓪?; (das sind die importierten IDs und ggf.⓪?; Enumeration-Elemente⓪)JSR     TravTr0       ;auch lok. Module, weil ggf.⓪?;Relays auf die bestehen und dort Enum-Elems⓪?;herkommen (die würden sonst nicht gefunden).⓪)⓪); nun den ID selbst eintragen (egal, ob Enum oder nicht)⓪)⓪ ImpId1   MOVE.L  4(A7),A6      ;zurück ins lokale Scope⓪)JSR     PullId⓪)JSR     SetId         ;im aktuellen Level eintragen⓪)MOVE.W  Tiefe,D1      ;!!! darf von SetId nicht verändert werden⓪)MOVE.L  (A7)+,D2⓪)CLR.W   -2(A1,D6.L)⓪)MOVE.L  D2,-6(A1,D6.L) ;RELAY-EINTRAG⓪)MOVE.W  D1,-8(A1,D6.L) ;übersprungene ScopeDifferenz⓪)SUBQ.L  #8,D6⓪)MOVE.L  D6,TRESPC⓪)ADDQ.L  #4,A7         ;Display Stack stimmt schon wieder⓪!END⓪ END ImpID;⓪ ⓪ ⓪ PROCEDURE LoadBadID;⓪"BEGIN⓪$ASSEMBLER⓪)MOVE.L  A0,A2⓪)LEA     BadId,A0⓪)MOVEQ   #0,D0          ; optional Term-Char⓪)MOVEQ   #40,D2 ; max. Length⓪)JSR     FetchString⓪$END⓪"END LoadBadID;⓪ ⓪ ⓪ PROCEDURE LOCXP;⓪ BEGIN⓪!ASSEMBLER⓪ ⓪ ;   --------------------------⓪ ;   Export AUS LOKALEN MODULEN:⓪ ;       NACH ENDE ID'S RETTEN⓪ ;   --------------------------⓪ ⓪ ; Die ID-Namen werden vom ID-Stack geholt, dann jeweils im Baum gesucht⓪ ; und dann das Flag 6 (exported) im Eintrag gesetzt. Wenn alle IDs durch,⓪ ; wird der Baum nochmal gescanned und alle markierten Einträge über Relays⓪ ; ins äußere Scope übertragen.⓪ ; TT 26.09.90:⓪ ; Damit bei Relay-Einträgen wirklich der Original-ID und nicht etwa dessen⓪ ; Verweis exportiert wird, wird hier dafür gesorgt, daß das Flag im Relay-⓪ ; eintrag selbst gesetzt und abgefragt wird.⓪ ; dazu Testprg: EXPDUPES.M⓪ ⓪)TST.W   XPCNT⓪)BEQ     LOCXP1        ;GAR KEINE Exports⓪)JSR     PullInt⓪)TST.L   D0⓪)BEQ     LOCXP2        ;UNQUAL. Export⓪)MOVE.L  8(A6),-(A7)   ;GLOBALES SCOPE RETTEN⓪)CLR.L   8(A6)         ;STATT DESSEN NEUES EINRICHTEN⓪)MOVE.L  D0,-(A7)⓪)BSR.L   LOCXP2⓪)MOVE.L  (A7)+,A0⓪)MOVE.L  8(A6),(A0)    ;^LOKALEN BAUM HINTER QUALIFIER⓪)MOVE.L  (A7)+,8(A6)   ;GLOBALES SCOPE REPARIEREN⓪)RTS⓪ ⓪); exportierten Id zunaechst nur im Baum markieren⓪)⓪ LOCXP2   JSR     PullID        ;EXP. ID ANGUCKEN⓪)MOVE.L  A0,-(A7)⓪)MOVE.L  A2,-(A7)⓪)MOVE.L  A0,A2⓪)MOVE.B  (A0),D1⓪)MOVE.L  (A6),D2       ;INS LOKALE LEVEL⓪)JSR     LocalSearch     ;  DURCHSUCHEN⓪)MOVE.L  (A7)+,A2⓪)MOVE.L  (A7)+,A0⓪)BCC     ok6⓪)JSR     LoadBadID⓪)MOVE    #rExpUn,D5    ;  -> UNDEFINED⓪)JMP     SyntaxErr⓪ ok6      MOVE.L  D1,D2         ;wir wollen ggf. Relay-Eintrag markieren⓪)MOVEQ   #6,D0         ;Markierung in Bit 6⓪)JSR     MarkId        ;ID (und evtl. EnumElemente) markieren⓪)SUBQ.W  #1,XPCNT⓪)BNE     LOCXP2        ;MEHR ExportS⓪)⓪); jetzt den Baum durchscannen und alles exportieren,⓪); was markiert wurde:⓪)⓪)LEA     SetRelay,A5   ;Export-Handler-Routine⓪)MOVE.L  (A6),D2       ;^Baumwurzel⓪)ADDQ.L  #8,A6         ; fuer Eintragungen: auf 'globales'⓪?; (nächsthöheres) Scope⓪)CLR.W   D1            ;Export überspringt kein StatLink-Level⓪)JSR     TravTr1       ;globalen Baum durchlaufen⓪)JSR     TravTr0       ;auch lok. Module, weil ggf.⓪?;Relays auf die bestehen und dort Enum-Elems⓪?;herkommen (die würden sonst nicht gefunden).⓪)SUBQ.L  #8,A6         ;zurueck ins lokale Scope⓪ LOCXP1⓪!END⓪ END LOCXP;⓪ ⓪ (*⓪!*   Call local module⓪!*)⓪!⓪ PROCEDURE CMOD;⓪ BEGIN ASSEMBLER⓪)MOVE.W  -2(A1,D2.L),D0 ;KENNUNG⓪)BTST    #9,D0          ;muss immer global sein!⓪)BEQ     CUP3          ;LOCAL⓪)JSR     put8          ;JSR.L⓪)MOVE.L  A4,D0⓪)SUB.L   CodeStart,D0⓪)MOVE.L  -22(A1,D2.L),(A4)+⓪)MOVE.L  D0,-22(A1,D2.L)⓪ !CUPRTS  RTS⓪ !CUP3    JSR     put54         ;BSR.L⓪)MOVE.L  -10(A1,D2.L),D0⓪)ADD.L   CodeStart,D0⓪ !CUP6    SUB.L   A4,D0⓪)MOVE.W  D0,(A4)+⓪)BPL     CUP4⓪)NEG.L   D0⓪ !CUP4    SWAP    D0⓪)TST.W   D0⓪)BEQ     CUPRTS⓪)MOVE    #rBranc,D5         ;BRANCH TOO LONG⓪)JMP     SyntaxErr⓪'END⓪ END CMOD;⓪ ⓪ (*⓪!*  POINTERKETTE FUER LOKALE VORWAERTS-AUFRUFE ABARBEITEN⓪!*)⓪!⓪ PROCEDURE SETADR;⓪ BEGIN ASSEMBLER⓪)MOVE.L  A4,D0⓪)SUB.L   CodeStart,D0      ;REL. ^ BERECHNEN⓪)MOVE.L  D0,(A0)       ;ADR EINTRAGEN⓪)CMPI.W  #1,GLOBAL⓪)BLS     SETADR1       ;GLOBALE PROC ODER MAIN PGM⓪)MOVE.L  -12(A0),D1    ;Abs ^LETZTE REF⓪)BEQ     SETADR1       ;KEINE⓪)MOVE.L  D1,A0⓪ !SETADR2 MOVE.W  (A0),D4⓪)SUB.L   A4,D1⓪)NEG.L   D1⓪)CMP.L   #$7FFF,D1⓪)BLS     ok1⓪)MOVE    #rBranc,D5            ;BRA TOO LONG⓪)JMP     SyntaxErr⓪ !ok1     MOVE.W  D1,(A0)⓪)ADDA.W  D4,A0⓪)MOVE.L  A0,D1⓪)TST.W   D4⓪)BNE     SETADR2⓪ !SETADR1⓪'END⓪ END SETADR;⓪ ⓪ PROCEDURE EXECMOD;⓪ BEGIN⓪ ASSEMBLER⓪ ;⓪ ;   ----------------------------⓪ ;   Lokale MODULE INITIALISIEREN⓪ ;   ----------------------------⓪ ;⓪*TST.W   MODCNT⓪*BEQ     EXECMOD1⓪*CLR.L   -(A7)⓪ !EXECMOD2 JSR     PullInt       ;MODULE UMSTAPELN⓪*MOVE.L  D0,-(A7)      ;  UM RICHTIGE REIHENFOLGE⓪*SUBQ.W  #1,MODCNT     ;  EINZUHALTEN⓪*BNE     EXECMOD2⓪ !EXECMOD3 MOVE.L  (A7)+,D2      ;CODE ZUM AUFRUF⓪*BEQ     EXECMOD1      ;  DER MODULE ERZEUGEN⓪*JSR     CMOD          ;Call local module⓪*BRA     EXECMOD3⓪ !EXECMOD1⓪!END⓪ END EXECMOD;⓪ ⓪ (*⓪!*   CALL USER PROCEDURE⓪!*)⓪ (*⓪ PROCEDURE CUP;⓪ BEGIN ASSEMBLER⓪)MOVE.W  -2(A1,D2.L),D0 ;KENNUNG⓪)BTST    #9,D0⓪)BEQ     CUP3          ;LOCAL⓪)JSR     put8          ;JSR.L⓪)MOVE.L  A4,D0⓪)SUB.L   CodeStart,D0⓪)MOVE.L  -18(A1,D2.L),(A4)+⓪)MOVE.L  D0,-18(A1,D2.L)⓪ !CUPRTS  RTS⓪ !CUP3    MOVE.W  TIEFE,D0      ;SCOPE DIFFERENZ⓪)JSR     put142        ;statlink -> D2⓪)JSR     put54         ;BSR.L⓪)MOVE.L  -6(A1,D2.L),D0⓪)BEQ     CUP5          ;ADR NOCH UNBEKANNT⓪)ADD.L   CodeStart,D0⓪ !CUP6    SUB.L   A4,D0⓪)MOVE.W  D0,(A4)+⓪)BPL     CUP4⓪)NEG.L   D0⓪ !CUP4    SWAP    D0⓪)TST.W   D0⓪)BEQ     CUPRTS⓪)MOVE    #rBranc,D5         ;BRANCH TOO LONG⓪)JMP     SyntaxErr⓪ !CUP5    MOVE.L  -18(A1,D2.L),D0 ;LETZTE REF⓪)MOVE.L  A4,-18(A1,D2.L) ;EIGENE ADR ALS LETZTE REF.⓪)TST.L   D0⓪)BNE     CUP6            ;DIES IST NICHT 1. REF⓪)CLR.W   (A4)+⓪'END⓪ END CUP;⓪ *)⓪ ⓪ PROCEDURE CLRTRE;⓪ BEGIN⓪ ASSEMBLER⓪ ;⓪ ;   ---------------------------------------⓪ ;   BAUM LOESCHEN NACH ABSCHLUSS EINER PROC⓪ ;   ---------------------------------------⓪ ;⓪)MOVE.L  (A6)+,D0      ;POP DISPLAY STACK⓪)BEQ     CLRTRE1       ;KEINE LOKALE EINTRAGUNG⓪)MOVE.L  TRESPC,D3⓪)MOVE.L  D0,TRESPC     ;LOKALE ID'S FREIGEBEN⓪)MOVE.L  D0,D2⓪); vorher nochmal prüfen, ob Baum nicht fehlerhaft ist⓪)JSR     VerifyTree⓪ !CLRTRE1⓪!END⓪ END CLRTRE;⓪ ⓪ PROCEDURE SetPar;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  VARSPC,D4         ;^PARADR'S⓪)JSR     PullInt⓪)ADD.L   D0,VARSPC⓪ SetPar6  SUBQ.W  #1,D5             ;noch Variablen auf dem Stack?⓪)BMI.W   SetPar1           ;nein ->⓪)JSR     PULLID⓪)JSR     SetId⓪)JSR     PullInt           ;Flag: 0 = ValPar⓪)ANDI.W  #$7F00,D0⓪)BEQ     SetPar2           ;ValPar⓪)BTST    #8,D0             ;VarPar?⓪)BNE     SetPar4⓪)MOVE.W  #$8911,D0         ;als Ref-Parameter eintragen⓪)BRA     SetPar3⓪ SetPar4  MOVE.W  #$8811,D0         ;als Var-Parameter eintragen⓪)BRA     SetPar3⓪ SetPar2  MOVE.W  #$8011,D0         ;als Val-Parameter eintragen⓪ SetPar3  JSR     SETKNG⓪)JSR     PullInt           ;Laenge der einzutragenden Var⓪)ADD.L   D4,D0             ;ADR⓪)MOVE.L  D0,-6(A1,D6.L)⓪)JSR     PullInt           ;Typ der einzutragenden Var⓪)MOVE.L  D0,-10(A1,D6.L)⓪)MOVE.W  D5,-(A7)⓪)MOVE.L  D0,D5⓪)JSR     PullInt           ;Flag, ob Reg-Var⓪)TST.W   D0⓪)BEQ     noReg⓪)⓪);!!!  erstmal Fehler melden, weil das autom. Laden solcher⓪);     Vars sofort erfolgen müßte und nicht erst bei Zugriff,⓪);     weil sonst z.B. Fehler auftreten, wenn 1. Zugriff in einem⓪);     IF vorkommt -> wird der IF-Zweig nicht durchlaufen, wird⓪);     Reg nicht geladen, danach aber benutzt⓪)MOVE    #rRegVa,D5⓪)JMP     SyntaxErr⓪)⓪)JSR     allocReg⓪)ANDI    #$00FF,D0⓪)⓪ noReg    MOVE.W  (A7)+,D5⓪)MOVE    D0,-16(A1,D6.L)      ;Kennungen f. Reg-Vars⓪)SUBI.L  #16,D6⓪)MOVE.L  D6,TRESPC⓪)BRA     SetPar6⓪ SetPar1⓪!END⓪ END SetPar;⓪ ⓪ PROCEDURE procFlags;⓪"BEGIN⓪$ASSEMBLER⓪)MOVE.L  D1,-(A7)⓪)MOVE.L  Options,D1⓪)BTST    #27,D1        ;$[+ (f. A7-Parameterübergabe)?⓪)BEQ     norm⓪)BSET    #3,D0         ;Flagbit 3 setzen⓪ norm     BTST    #28,D1        ;$\+ (f. TC-Parameterübergabe & -rückgabe)?⓪)BEQ     norm2⓪)BSET    #3,D0         ;Flagbit 3 setzen⓪)BSET    #0,D0         ;Flagbit 0 setzen⓪ norm2    MOVE.L  (A7)+,D1⓪$END⓪"END procFlags;⓪ ⓪ PROCEDURE procParFlags;⓪"BEGIN⓪$ASSEMBLER⓪); verändert ParFlags in D3. /D0/⓪); in D2 muß ^Par-Type übergeben werden⓪)⓪)MOVE.L  Options,D0⓪)BTST    #28,D0    ; $\⓪)BEQ.W   noReg⓪)⓪); REF/VAR-Parms sowie PROCEDURE/ADDRESS/POINTER/Opaque⓪); kommen nach A0/A1, aber z.Zt. keine Open Arrays!⓪); Rest der Skalaren nach D0-D2⓪)MOVE.W  D3,D0⓪)BMI.W   noReg         ;-> open array⓪)ANDI    #$0300,D0⓪)BNE     allocAn       ;-> var/ref⓪)MOVE.B  -1(A1,D2.L),D0         ; Typkennung⓪)CMPI.B  #19,D0⓪)BEQ     allocAn⓪)CMPI.B  #20,D0⓪)BEQ     allocAn⓪)CMPI.B  #23,D0⓪)BEQ     allocAn⓪)CMPI.B  #8,D0         ;Opaque?⓪)BEQ     allocAn⓪)CMPI.B  #25,D0        ;Opaque?⓪)BEQ     allocAn⓪)BTST.B  #0,-2(A1,D2.L)         ; skalar?⓪)BEQ     noReg⓪)CMPI.L  #4,-6(A1,D2.L)         ; Größe <= 4?⓪)BHI     noReg⓪)CMPI.B  #2,RegDnCnt⓪)BGE     noReg                  ; schon alle D-Regs vergeben⓪)ADDQ.B  #1,RegDnCnt⓪)MOVE.B  RegDnCnt,D3⓪)ORI.B   #$80,D3⓪)BRA     noReg⓪ allocAn  CMPI.B  #1,RegAnCnt⓪)BGE     noReg                  ; schon alle A-Regs vergeben⓪)ADDQ.B  #1,RegAnCnt⓪)MOVE.B  RegAnCnt,D3⓪)ADDQ.B  #8,D3⓪)ORI.B   #$80,D3⓪ noReg⓪$END⓪"END procParFlags;⓪ ⓪ PROCEDURE NEWPROC;⓪ BEGIN⓪ ASSEMBLER⓪ ;⓪)JSR     LookID⓪)JSR     SetId⓪)MOVE.W  #$8006,D0     ;TYP⓪)JSR     SETKNG⓪)CLR     D0⓪)JSR     procFlags⓪)OR.B    D0,-2(A1,D6.L)⓪)CLR.L   -6(A1,D6.L)   ;ADR⓪)CLR.L   -10(A1,D6.L)  ;^PAR⓪)CLR.L   -14(A1,D6.L)  ;^RES⓪)CLR.L   -18(A1,D6.L)  ;^REFERENZ⓪)SUBQ.L  #6,D6⓪)MOVE.L  D6,FPARM      ;^PAR-Liste⓪)CMPI.W  #3,ipflag     ; DEF-Mod ?⓪)BEQ     isdef⓪)SUBQ.L  #8,D6         ;18.5.⓪'isdef⓪)SUBI.L  #12,D6        ;18.5.⓪)MOVE.L  D6,TRESPC⓪!END⓪ END NEWPROC;⓪ ⓪ ⓪ PROCEDURE fpSect;⓪ (*⓪$Formale Parameter-Sektion aus dem Text lesen.⓪$IDs auf Id-Stack, VarPar-Flag in D3, Typ in D2 zurueckgeben⓪ *)⓪ BEGIN⓪ ASSEMBLER⓪)CLR.W   VARPAR⓪)CLR.W   VARCNT⓪)CMPI.W  #56,D3        ;VAR⓪)BEQ     isVar⓪)CMPI.W  #70,D3        ;REF⓪)BNE     fpSect2⓪)BSET    #1,VARPAR⓪)BRA     fpSect1⓪ isVar    BSET    #0,VARPAR⓪ ⓪ fpSect1  JSR     GetSbl        ;IDs auf den Stack schaufeln⓪ fpSect2  TST.W   D3⓪)JSR     GETID0⓪)⓪)MOVE.W  UseRegister,D0⓪)CLR.W   UseRegister⓪)JSR     PUSHINT       ;merken, ob Reg-Var⓪)⓪)ADDQ.W  #1,VARCNT⓪)ADDQ.W  #1,PARCNT⓪)JSR     GetSbl⓪)CMPI.W  #10,D3        ;,?⓪)BEQ     fpSect1       ;weiter, solange ',' folgt⓪)⓪)CMPI.W  #25,D3        ;:?⓪)BNE     colxp⓪ ⓪); Typbeschreibung abarbeiten⓪)⓪ hdltype  JSR     GetSbl⓪)CMPI.W  #60,D3        ;'ARRAY'?⓪)BEQ     soparr⓪)CMPI.W  #71,D3        ;'LONGARRAY'?⓪)BNE     fpSect5       ;nein, einfacher Typ⓪)⓪); Open Array-Parm auswerten⓪)⓪)MOVE.W  #$802A,D0⓪)BRA     oparr⓪ soparr   MOVE.W  #$8020,D0⓪ oparr    MOVE.L  TRESPC,D6     ;Beschreibung für Open Arrays abarbeiten⓪)JSR     SETKNG⓪)MOVE.L  D6,-(A7)      ;merken für Nachtrag des Elementtyps⓪)SUBQ.L  #6,D6⓪)MOVE.L  D6,TRESPC⓪)BSET    #7,VARPAR⓪);weitere Syntax muß sein: OF <type>⓪)JSR     GetSbl⓪)CMPI.W  #46,D3        ;OF⓪)BNE     ofxp⓪)BSR     hdltype⓪)MOVE.L  (A7)+,D6       ;Pointer auf Open Array-Beschreibung⓪)MOVE.L  D2,-6(A1,D6.L) ;ElementTyp nachtragen⓪)MOVE.L  D6,D2          ;neuer ^Parametertyp⓪)RTS⓪)⓪ colxp    MOVE    #rColXp,D5⓪)JMP     SyntaxErr⓪ ofxp     MOVE    #rOFXp,D5⓪)JMP     SyntaxErr⓪ typxp    MOVE    #rTyDXp,D5⓪)JMP     SyntaxErr⓪)⓪);einfachen Parametertyp parsen (kein Open Array)⓪ ⓪ fpSect5  BTST    #10,D3        ;TYP?⓪)BNE     fpSect3⓪)CMPI.W  #47,D3        ;'STRING'⓪)BNE     typxp⓪)JSR     SETTYP13⓪)BRA     fpSect4⓪ ⓪ fpSect3  CMPI.B  #19,D3        ;PROC-Type?⓪)BNE     fpSect6⓪)TST.B   VarPar        ;nur bei value-Parms Kennung 44 verwenden!⓪)BNE     fpSect6⓪)⓪)MOVE.L  Options,D0⓪)BTST    #08,D0         ;$H- ? Dann PROC-Type m. 4 Byte belassen⓪)BEQ     fpSect6⓪)⓪); Proc-Typen mit 8 Byte anlegen⓪)MOVE.L  TRESPC,D6⓪)MOVE.W  D3,D0         ;alte Flags übernehmen!⓪)MOVE.B  #$2C,D0       ;neue Kennung: 44⓪)JSR     SETKNG⓪)SUBI.L  #10,TRESPC⓪)MOVE.L  #8,-6(A1,D6.L)                 ; Länge auf 8 setzen⓪)MOVE.L  D2,-10(A1,D6.L)                ; ^normalen Typ eintragen⓪)MOVE.L  D6,D2                          ; dies ist der neue Typ⓪ ⓪ fpSect6  MOVE.L  D2,-(A7)⓪)JSR     GetSbl⓪)MOVE.L  (A7)+,D2⓪ fpSect4  MOVE.W  VARPAR,D3⓪"END⓪ END fpSect;⓪ ⓪ ⓪ PROCEDURE StorVar;⓪ (*⓪$Daten einer fp-Sektion (von fpSect) auf Int-Stack retten⓪$(fuer spaeteren Eintrag als lokale Variablen);⓪$dabei Platzbedarf der Parameter ausrechnen und Adressen hochzaehlen.⓪ *)⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  D2,D0         ;^Typ⓪)JSR     PushInt⓪)MOVE.L  PARADR,D0     ;relative Adresse⓪)JSR     PushInt⓪)MOVE.W  D3,D0         ;welche Art von Parameter?⓪)BMI     StorVar3      ;Open Array⓪)ANDI    #$FF00,D0⓪)BEQ     StorVar1      ;by Value⓪)ADDQ.L  #4,PARADR     ;Laenge bei Var- und Ref-Parameter⓪)BRA     StorVar2⓪ StorVar3 ADDQ.L  #4,PARADR     ;Laenge bei Open-Array-Parameter⓪)MOVE.L  D2,-(A7)⓪ StorVar6 CMPI.B  #42,-1(A1,D2.L) ; LONGARRAY?⓪)BEQ     StorVar4⓪)CMPI.B  #32,-1(A1,D2.L) ; SHORTARRAY?⓪)BEQ     StorVar7⓪)MOVE.L  (A7)+,D2⓪)BRA     StorVar2⓪ StorVar7 ADDQ.L  #2,PARADR     ;Laenge bei SHORTOpen-Array-Parameter⓪)BRA     StorVar5⓪ StorVar4 ADDQ.L  #4,PARADR     ;Laenge bei LONGOpen-Array-Parameter⓪ StorVar5 MOVE.L  -6(A1,D2.L),D2 ;Element-Typ bei Open Array⓪)BRA     StorVar6⓪ StorVar1 MOVE.L  -6(A1,D2.L),D0 ;Laenge bei Val-Parameter (und nicht OpArr)⓪)ADDQ.L  #1,D0         ;Laenge muss immer synchronisiert sein⓪)BCLR    #0,D0⓪)ADD.L   D0,PARADR⓪ StorVar2⓪); nun ggf. Reg-Parm zuweisen⓪)JSR     procParFlags⓪)⓪)MOVE.W  D3,D0         ;VarPar-Flag⓪)JMP     PushInt       ;..auch auf den Stack⓪ END⓪ END StorVar;⓪ ⓪ PROCEDURE NEWPAR;⓪ (* weiteren Link in der Parameter-Kette anlegen *)⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.W  #$8007,D0     ;KENNUNG: PAR-KETTE⓪)JSR     SETKNG⓪)CLR.L   -6(A1,D6.L)⓪)MOVE.L  D2,-10(A1,D6.L)⓪)MOVE.W  D3,-12(A1,D6.L) ;VARPAR FLAG⓪)MOVE.L  D6,-6(A1,D5.L) ;^ParameterListe⓪)MOVE.L  D6,D5⓪)SUBI.L  #12,D6⓪ END⓪ END NEWPAR;⓪ ⓪ PROCEDURE OLDPAR;⓪ BEGIN⓪ ASSEMBLER⓪)MOVEM.L D2/D3,-(A7)⓪)MOVE.L  -6(A1,D5.L),D6 ;^NEXT PAR⓪)BNE     ok⓪ !ER91    MOVEM.L (A7)+,D2/D3⓪)MOVE    #rBdIpl,D5⓪)JMP     SyntaxErr⓪ !ER92    ANDI.B  #8,D3⓪)ANDI.B  #8,D2⓪)CMP.B   D2,D3            ;Parm-Übergabeflags vergleichen⓪)BEQ     isZopt⓪)MOVEM.L (A7)+,D2/D3⓪)MOVE    #rParOp,D5⓪)JMP     SyntaxErr⓪ isZopt   MOVEM.L (A7)+,D2/D3⓪)MOVE    #rZopt,D5⓪)JMP     SyntaxErr⓪ !ok      MOVE.L  -10(A1,D6.L),D0 ;STIMMT TYP?⓪)TST.W   -2(A1,D0.L)⓪)BNE     OLDPAR1⓪)MOVE.L  -6(A1,D0.L),D0  ;OPAQUE-TYP WURDE NACHDEKLARIERT⓪ !OLDPAR1 CMP.W   -12(A1,D6.L),D3 ;STIMMT VARPAR-FLAG?⓪)BEQ     OLDPAR4⓪)CMP.B   -11(A1,D6.L),D3 ;stimmt Reg-Übergabe?⓪)BEQ     ER91⓪)MOVEM.L (A7)+,D2/D3⓪)MOVE    #rParOp,D5⓪)JMP     SyntaxErr⓪ !OLDPAR4 CMP.L   D0,D2⓪)BEQ     OLDPAR6⓪)MOVE.B  -1(A1,D2.L),D3  ;NICHT GLEICH:⓪)CMP.B   -1(A1,D0.L),D3⓪)BNE     Er91           ;AUCH VERSCHIEDENE KENNUNG⓪)CMPI.B  #42,D3         ;                          ||⓪)BEQ     twoloas        ;zwei Long Open Arrays     ||⓪)CMPI.B  #32,D3⓪)BNE     OLDPAR5⓪ twoloas  MOVE.L  -6(A1,D2.L),D2  ;ZWEI OPEN ARRAYS⓪)MOVE.L  -6(A1,D0.L),D0⓪)BRA     OLDPAR4         ;ELEMENTTYPEN VERGLEICHEN⓪ !OLDPAR5 CMPI.B  #27,D3⓪)BNE     OLDPAR3⓪)MOVE.L  -10(A1,D0.L),D3  ;ZWEI STRINGS⓪)CMP.L   -10(A1,D2.L),D3  ;LAENGEN GLEICH?⓪)BNE     Er91⓪)BRA     OLDPAR6⓪ !OLDPAR3 CMPI.B  #44,D3⓪)BNE     Er91⓪); Proc-Parm vergleichen⓪)MOVE.L  -10(A1,D0.L),D3  ;^Typ⓪)CMP.L   -10(A1,D2.L),D3⓪)BNE     Er91⓪)MOVE.L  -6(A1,D0.L),D3   ;Länge (8 Byte)⓪)CMP.L   -6(A1,D2.L),D3⓪)BNE     Er91⓪)MOVE.B  -2(A1,D0.L),D3⓪)MOVE.B  -2(A1,D2.L),D2⓪)ANDI.B  #9,D3⓪)ANDI.B  #9,D2⓪)CMP.B   D2,D3            ;D0-Rückgabe-Flags vergleichen⓪)BNE     ER92⓪ !OLDPAR6 MOVEM.L (A7)+,D2/D3⓪)MOVE.L  D6,D5⓪!END⓪ END OLDPAR;⓪ ⓪ PROCEDURE FORMRES; (* holt Result-Type bei Function *)⓪ BEGIN⓪ ASSEMBLER⓪)JSR     GetSbl⓪)BTST    #10,D3         ; Type-ID?⓪)BNE     FORMRES1⓪ (*⓪)CMPI.W  #47,D3         ; "STRING"?⓪)BEQ     ok⓪ *)⓪)MOVE    #rTyDXp,D5⓪)JMP     SyntaxErr⓪ (*⓪ !ok      JSR     SETTYP13       ; STRING auswerten⓪)BRA     FORMRES2⓪ *)⓪ FORMRES1 MOVE.L  D2,-(A7)⓪)MOVE.W  D3,-(A7)⓪)JSR     GetSbl         ; Semikolen holen⓪)MOVE.W  (A7)+,D3⓪)MOVE.L  (A7)+,D2⓪ FORMRES2 MOVE.L  FPARM,D6⓪)MOVE.L  D2,RESTYPE⓪)BMI     ok3⓪)JSR     HALT           ;interner Fehler⓪)MOVE    #rIntEr,D5⓪)JMP     SyntaxErr⓪'ok3⓪)JMP     SAMESBL⓪!END⓪ END FORMRES;⓪ ⓪ (*⓪ PROCEDURE AsmVisible;⓪"(* Liefert EQ, wenn ASSEMBLER im akt. Modul sichtbar *)⓪"BEGIN⓪$ASSEMBLER⓪)BRA     cont⓪'t ACZ     'ASSEMBLER'⓪)SYNC⓪'cont⓪)MOVE.L  A2,-(A7)⓪)LEA     t(PC),A2⓪)MOVE.B  (A2),D2⓪)JSR     TRESRC⓪)MOVE.L  (A7)+,A2⓪)SCS     D0⓪)MOVE.B  D0,-(A7)⓪)JSR     SameSbl⓪)MOVE.B  (A7)+,D0⓪$END⓪"END AsmVisible;⓪ *)⓪ ⓪ PROCEDURE PrHead;⓪ BEGIN⓪ ASSEMBLER⓪);22.4.90: GetSbl muß nun schon vorher aufgerufen werden⓪)TST     D3⓪)BEQ     PrHead6⓪)BMI     ok⓪ ER5      MOVE    #rIdXp,D5⓪)JMP     SyntaxErr⓪ ok       TST.W   Tiefe⓪)BNE     PRH1          ;lokale Neudeklaration⓪)JMP     OldHead       ;aus FORWARD oder DefMod bekannt ?⓪ PrH1     TST.W   D3⓪ PrHead6  JSR     GETID0⓪)JSR     NEWPROC⓪)CLR.L   PARADR        ;Parameter-VAR-ADR'S, wird hochgezaehlt⓪)CLR.W   PARCNT⓪)CLR.L   RESTYPE       ;^Ergebnistyp; NIL bei Procs⓪)MOVE.B  #-1,RegAnCnt⓪)MOVE.B  #-1,RegDnCnt⓪)CLR.L   -(A6)         ;neues Display⓪)JSR     GetSbl⓪)CMPI.W  #14,D3        ;(⓪)BNE.L   PrHead1⓪)CLR.W   UseRegister⓪)JSR     GetSbl⓪)CMPI.W  #26,D3        ;)⓪)BEQ.L   PrHead5⓪)MOVE.L  FPARM,D5      ;^Param List, kommt schliesslich in Proc-Eintrag⓪)ADDQ.L  #2,D5⓪)MOVE.L  D5,-(A7)⓪)⓪); aufgezählte Parms einlesen samt ihres Typs⓪ !PrHead2 JSR     fpSect         ; liefert Varpar-Flag in D3!⓪)MOVE.L  (A7)+,D5⓪)MOVE.L  TRESPC,D6⓪ ⓪); erstmal die Reg-Var-Flags wieder vom IntStack holen⓪)MOVE.L  A3,-(A7)⓪)MOVE.L  EVALSTK,A3⓪)MOVE.W  VarCnt,D1⓪ !PrHead7 JSR     PullInt⓪)MOVE.W  D0,(A3)+⓪)SUBQ    #1,D1⓪)BNE     PrHead7⓪ ⓪); nun die aufgezählten Vars anlegen⓪ !PrHead3 MOVE.W  -(A3),D0⓪)JSR     PushInt⓪)MOVE    D3,-(A7)      ;D3 wird bei Reg-Parms verändert⓪)JSR     StorVar       ;bekommt Varpar-Flag in D3!⓪)JSR     newPar        ;Parameter-KETTE⓪)MOVE.W  (A7)+,D3⓪)SUBQ.W  #1,VarCnt⓪)BNE     PrHead3       ;WEITERE VAR DIESES TYPS⓪)⓪)MOVE.L  (A7)+,A3⓪)⓪)MOVE.L  D6,TRESPC⓪)JSR     SAMESBL⓪)CMPI.W  #26,D3        ;)⓪)BEQ     PrHead5⓪)CMPI.W  #11,D3⓪)BEQ     ok1⓪)MOVE    #rParXp,D5⓪)JMP     SyntaxErr⓪ !ok1     MOVE.L  D5,-(A7)⓪)JSR     GetSbl⓪)BRA     PrHead2        ;nächsten Parm & Typ auswerten⓪ ⓪ !PrHead5 JSR     GetSbl⓪ !PrHead1 MOVE.L  PARADR,D0     ;GESAMTPLATZ FUER PAR'S⓪)JSR     PushInt⓪)CMPI.W  #25,D3        ;:⓪)BNE     PrHead4⓪ ⓪);Result-Type der Function holen⓪)JSR     FORMRES⓪)MOVE.L  D2,-8(A1,D6.L) ;^RES-TYPE⓪)BTST    #3,4(A1,D6.L)⓪)BNE     PrHead4        ;bei A7-Parm-Übergabe ist $Z irrelevant⓪); prüfen, ob Result in Register statt auf A3-Stack lieferbar ist⓪)MOVE.L  Options,D0⓪)BTST    #26,D0         ;$Z- ? Dann keine D0-Rückgabe⓪)BEQ     PrHead4⓪)CMPI.L  #4,-6(A1,D2.L) ;paßt Result in ein Register?⓪)BHI     PrHead4⓪)BSET    #0,4(A1,D6.L)  ;ja: Bit 0 in Item-Flags setzen⓪ ⓪ !PrHead4 CMPI.W  #11,D3         ;';'?⓪)BEQ     ok2⓪)MOVE    #rSemXp,D5⓪)JMP     SyntaxErr⓪ !ok2     ADDQ.W  #1,GLOBAL⓪)MOVE.W  PARCNT,D5⓪)JSR     SetPar⓪)MOVE.L  RESTYPE,D0⓪)JSR     PushInt⓪)MOVE.L  FPARM,D6⓪)LEA     0(A1,D6.L),A0  ;^ADR-EINTRAG⓪)MOVE.L  A0,FPARM      ;FUER Block⓪ END⓪ END PrHead;⓪ ⓪ PROCEDURE OldHead;⓪ BEGIN⓪ ASSEMBLER⓪*CMPI.B  #6,D3         ;PROC?⓪*BEQ     ok⓪ !ER18     MOVE    #rId2,D5      ;DECL. TWICE⓪*JMP     SyntaxErr⓪ ErrParm   MOVE    #rParOp,D5    ;diff. Parm-Modes⓪*JMP     SyntaxErr⓪ !ok       TST.L   -6(A1,D2.L)   ;REL.ADR=0: NOCH UNDECLARED⓪*BNE     ER18⓪*SUBQ.W  #1,OpenFwds⓪*TST.W   D3⓪*JSR     OLDID0        ;FUER END-ID-CHECK⓪*⓪*; stimmen Parm-Übergaben überein?⓪*CLR     D0⓪*JSR     procFlags⓪*MOVE.B  -2(A1,D2.L),D1⓪*ANDI.B  #$09,D1       ;Bits 0 & 3 maskieren⓪*BTST    #3,D0⓪*BNE     nomask0⓪*BCLR    #0,D1         ;Bit 0 wg. ggf. Z-Direktive wegmaskieren⓪ nomask0   CMP.B   D0,D1⓪*BNE     ErrParm⓪*⓪*CLR.L   PARADR        ;Parameter-VAR-ADR'S⓪*CLR.W   PARCNT⓪*CLR.L   RESTYPE⓪*CLR.L   -(A6)         ;NEUES DISPLAY⓪*SUBQ.L  #6,D2⓪*MOVE.L  D2,FPARM⓪*ADDQ.L  #2,D2⓪*MOVE.L  D2,-(A7)⓪*JSR     GetSbl⓪*CMPI.W  #14,D3        ;(⓪*BNE.L   OldHead1⓪*JSR     GetSbl⓪*CMPI.W  #26,D3        ;)⓪*BEQ.L   OldHead5⓪ ⓪ !OldHead2 JSR     fpSect⓪*MOVE.L  (A7)+,D5⓪*MOVE.L  TRESPC,D6⓪*⓪*; erstmal die Reg-Var-Flags wieder vom IntStack holen⓪*MOVE.L  A3,-(A7)⓪*MOVE.L  EVALSTK,A3⓪*MOVE.W  VarCnt,D1⓪!!PrHead7 JSR     PullInt⓪*MOVE.W  D0,(A3)+⓪*SUBQ    #1,D1⓪*BNE     PrHead7⓪*⓪ !OldHead3 MOVE.W  -(A3),D0⓪*JSR     PushInt⓪*MOVE    D3,-(A7)      ;D3 wird bei Reg-Parms verändert⓪*JSR     StorVar⓪*JSR     OLDPAR        ;Parameter-KETTE VERFOLGEN⓪*MOVE.W  (A7)+,D3⓪*SUBQ.W  #1,VARCNT⓪*BNE     OldHead3      ;WEITERE VAR DIESES TYPS⓪*MOVE.L  (A7)+,A3⓪*⓪*MOVE.L  D5,-(A7)⓪*JSR     SAMESBL⓪*CMPI.W  #26,D3        ;)⓪*BEQ     OldHead5⓪*CMPI.W  #11,D3⓪*BEQ     ok1⓪*MOVE    #rParXp,D5⓪*JMP     SyntaxErr⓪ !ok1      JSR     GetSbl⓪*BRA     OldHead2⓪ !OldHead5 JSR     GetSbl⓪ !OldHead1 MOVE.L  PARADR,D0     ;GESAMTPLATZ FUER PAR'S⓪*JSR     PushInt⓪*MOVE.L  (A7)+,D5⓪*TST.L   -6(A1,D5.L)⓪*BEQ     ok2⓪ !ER91     MOVE    #rBdIpl,D5    ;PAR-KETTE MUSS HIER ENDEN!⓪*JMP     SyntaxErr⓪ ErrZOpt   MOVE    #rZopt,D5     ;different Z-Directives⓪*JMP     SyntaxErr⓪ !ok2      CLR.L   D2⓪*MOVE.L  FPARM,D6⓪*CMPI.W  #25,D3        ;:⓪*BNE     OldHead4⓪*⓪*JSR     FORMRES⓪*; bei Result prüfen, ob D0-Rückgabe-Flags übereinstimmen⓪*BTST    #3,4(A1,D6.L)⓪*BNE     checked        ;bei A7-Parm-Übergabe ist $Z irrelevant⓪*MOVE.L  Options,D0⓪*BTST    #26,D0         ;$Z-⓪*BEQ     noRegD0⓪*CMPI.L  #4,-6(A1,D2.L) ;paßt Result in ein Register?⓪*BHI     noRegD0⓪*BTST    #0,4(A1,D6.L)⓪*BEQ     ErrZOpt⓪*BRA     checked⓪ noRegD0   BTST    #0,4(A1,D6.L)⓪*BNE     ErrZOpt⓪ checked⓪ ⓪ !OldHead4 MOVE.L  -8(A1,D6.L),D0  ;D0: ^Original-Beschreibung⓪*TST.W   -2(A1,D0.L)⓪*BNE     OldHead7⓪*MOVE.L  -6(A1,D0.L),D0  ;OPAQUE-TYP WURDE NACHDEKLARIERT⓪ !OldHead7 CMP.L   D0,D2           ;STIMMT RES.TYPE?⓪*BEQ     OldHead6⓪*CMPI.B  #27,-1(A1,D0.L) ;STRINGS?⓪*BNE     ER91⓪*CMPI.B  #27,-1(A1,D2.L)⓪*BNE     ER91⓪*MOVE.L  -10(A1,D0.L),D0 ;GLEICHE LAENGEN?⓪*CMP.L   -10(A1,D2.L),D0⓪*BNE     ER91⓪ !OldHead6 CMPI.W  #11,D3        ;;⓪*BEQ     ok3⓪*MOVE    #rSemXp,D5⓪*JMP     SyntaxErr⓪ !ok3      ADDQ.W  #1,GLOBAL⓪*MOVE.W  PARCNT,D5⓪*JSR     SetPar⓪*MOVE.L  RESTYPE,D0⓪*JSR     PushInt⓪*MOVE.L  FPARM,D6⓪*LEA     0(A1,D6.L),A0  ;^ADR-EINTRAG⓪*MOVE.L  A0,FPARM      ;für Block⓪!END⓪ END OldHead;⓪ ⓪ PROCEDURE CODESPC;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.L  A1,D1⓪)ADD.L   TRESPC,D1⓪)SUB.L   A4,D1⓪)CMPI.L  #$1000,D1⓪)BCC     ok⓪)MOVE    #rSpace,D5⓪)JMP     SyntaxErr⓪ !ok⓪ END⓪ END CODESPC;⓪ ⓪ ⓪ VAR PrevWasRet: BYTE;⓪ ⓪ PROCEDURE StatSeq;⓪ BEGIN⓪!ASSEMBLER⓪*; sollte in dieser Loop das Flag auf (A7) gesetzt werden, so⓪*; dürften alle weiteren Statements bis zum Verlassen dieser Schleife⓪*; ignoriert werden, weil dann nämlich ein RETURN bereits die⓪*; Statement-Sequenz abgebrochen hat.⓪*CLR.W   -(A7)⓪ !StatSeqL JSR     CODESPC       ;NOCH PLATZ?⓪*BSR.L   StatSeq0      ;VERTEILER⓪*CMPI.W  #11,D3        ;;?⓪*BEQ     StatSeqL⓪*MOVE.W  (A7)+,LastWasRet⓪*RTS⓪ ⓪ ;        STATEMENT⓪ ⓪ StatSeq0 JSR     GetSbl⓪)TST     AsmMode       ;Assembler-Option antesten⓪)BEQ     NOASS⓪)JMP     ASSM⓪ ⓪ noAss    MOVE.L  Options,D0⓪)BCLR    #0,D0⓪)BEQ     NoBrk⓪)MOVE.L  D0,Options⓪)BREAK⓪ NoBrk⓪)TST.W   D3⓪)BNE     ok⓪)MOVE    #rIdUn,D5⓪)JMP     SyntaxErr⓪ ok       BPL.L   StatSeq1      ;MODULA WORT⓪)⓪); Identifier⓪)BTST    #2+8,D3       ;Typ (bei $A+)⓪)BNE     StatAsn⓪)CMPI.B  #6,D3         ;PROC⓪)BEQ     StatAsn⓪)CMPI.B  #17,D3        ;VAR⓪)BEQ     StatAsn⓪ !Stat2   CMPI.B  #14,D3        ;REC.FELD⓪)BNE     Stat11⓪ StatAsn  JMP     Assign⓪ !Stat11  CMPI.B  #36,D3        ;Standardproc⓪)BNE     Bad           ;nix gueltiges⓪)⓪); Standardprozeduren⓪)⓪)MOVE.W  -4(A1,D2.L),D3⓪)CMP.W   #104,D3⓪)BEQ     StatAsn        ;CAST (bei $A+)⓪)CMP.W   #100,D3⓪)BHI     SysProc        ;aus dem SystemModul⓪)SUB.W   #20,D3         ;kleinste gueltige StdProc-Nummer⓪)BCS     Bad⓪)CMP.W   #5,D3⓪)BHI     Bad⓪)LEA     ProcAdrs(pc),A0⓪)LSL.W   #2,D3⓪)MOVE.L  0(A0,D3.W),A0⓪)JMP     (A0)⓪ ⓪ ProcAdrs DC.L    aInc⓪)DC.L    aDec⓪)DC.L    aNew⓪)DC.L    aDispose⓪)DC.L    aIncl⓪)DC.L    aExcl⓪ ⓪ SysProc  SUB.W   #120,D3⓪)CMP.W   #10,D3⓪)BHI     Bad⓪)LEA     SysAdrs(pc),A0⓪)LSL.W   #2,D3⓪)MOVE.L  0(A0,D3.W),A0⓪)JMP     (A0)⓪ ⓪ Bad      MOVE    #rStatm,D5⓪)JMP     SyntaxErr⓪ ⓪ SysAdrs  DC.L    aNewProcess⓪)DC.L    aTransfer⓪)DC.L    aIOTransfer⓪)DC.L    aListen⓪)DC.L    aIOCall⓪)DC.L    aAssm⓪)DC.L    aCallSys⓪)DC.L    aCallExt⓪)DC.L    aCode⓪)DC.L    aLoad⓪)DC.L    aStore⓪ ⓪); reserviertes Wort⓪ ⓪ StatSeq1 CMPI.W  #37,D3        ;REPEAT⓪)BNE     Stat3⓪)JMP     AREPEAT⓪ !Stat3   CMPI.W  #39,D3        ;WHILE⓪)BNE     Stat4⓪)JMP     AWHILE⓪ !Stat4   CMPI.W  #31,D3        ;IF⓪)BNE     Stat5⓪)JMP     AIF⓪ !Stat5   CMPI.W  #65,D3        ;RETURN⓪)BNE     Stat6⓪)MOVE.W  #1,4(A7)      ;Flag setzen, daß RETURN gerade vorkam⓪)JMP     ARETURN⓪ !Stat6   CMPI.W  #41,D3        ;LOOP⓪)BNE     Stat7⓪)JMP     ALOOP⓪ !Stat7   CMPI.W  #54,D3        ;EXIT⓪)BNE     Stat8⓪)JMP     AEXIT⓪ !Stat8   CMPI.W  #42,D3        ;FOR⓪)BNE     Stat9⓪)JMP     aFOR⓪ !Stat9   CMPI.W  #45,D3        ;CASE⓪)BNE     Stat10⓪)JMP     ACASE⓪ !Stat10  CMPI.W  #55,D3        ;WITH⓪)BNE     Stat18⓪)JMP     aWith⓪ (*⓪ !Stat17  CMPI.W  #92,D3        ;ASSEMBLER⓪)BNE     Stat18⓪ *)⓪ Stat18⓪"END⓪ END StatSeq;⓪ ⓪ PROCEDURE aAssm;⓪"BEGIN⓪$ASSEMBLER⓪)ST      AsmMode⓪)MOVE.L  ASMSCOPE,-(A6) ;AssemblerScope oeffnen⓪)ADDQ.W  #4,ROSCOPE⓪)JSR     GetSbl⓪)CMP.W   #35,D3        ;leere ASSEMBLER-Anweisung: nicht Assm aufrufen⓪)BEQ     noAssm⓪)JSR     Assm⓪ noAssm   SUBQ.W  #4,ROScope    ;Assembler-Scope wieder dicht⓪)ADDQ.L  #4,A6⓪)CLR     AsmMode⓪)CMP.W   #35,D3        ;jetzt sollte ein END folgen⓪)BNE     Er2⓪)JMP     GetSbl⓪ Er2      MOVE    #rEndXp,D5⓪)JMP     SyntaxErr⓪$END⓪"END aAssm;⓪ ⓪ PROCEDURE ARETURN;⓪ BEGIN⓪ ASSEMBLER⓪); Return ohne Ergebnis-Expression aussortieren⓪)⓪)TST.W   MODFLAG⓪)BNE     RETURN2       ;Module Body: kein Ergebnis möglich⓪)MOVE.L  RESTYPE,D0⓪)BEQ     RETURN2⓪)⓪); Ergebnis zurückgeben⓪)⓪)JSR     PushInt⓪)MOVE.W  RetFlag,D0⓪)JSR     pushExpr⓪)BRA     Return1⓪ ⓪); Return aus FOR: ggf. Reste des Stacks abräumen⓪)⓪ Return2  JSR     GetSbl        ;kein Ergebnis: folgendes Symbol holen⓪ ⓪ Return1  TST     SuppressCode⓪)BNE     noCode⓪); Stack ggf. wg. FOR, WITH, usw, abräumen⓪)CLR.L   D0⓪)JSR     discardA7⓪)TST.W   LastRet⓪)BEQ     putit⓪)JMP     jmpToRet⓪ putit    JSR     putRET⓪)ADDQ.W  #1,LastRet⓪ noCode⓪!END⓪ END ARETURN;⓪ ⓪ ⓪ ⓪ PROCEDURE SolveForwRefs;⓪"BEGIN⓪$ASSEMBLER⓪)BRA     start⓪ solve2   JSR     PullInt⓪)MOVE.L  D0,D2⓪)JSR     ToHere⓪ start    DBF     D4,solve2⓪$END⓪"END SolveForwRefs;⓪ ⓪ PROCEDURE AWHILE;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.W  SuppressCode,-(A7)⓪)JSR     LABEL         ;SETZEN⓪)JSR     PullInt       ;Label vom Int-Stack retten⓪)MOVE.L  D0,-(A7)⓪)JSR     boolExpr⓪)MOVE    D0,-(A7)      ;Anz. der Forward-Refs auf Stack⓪)CMPI.W  #40,D3        ;DO?⓪)BEQ     ok⓪)MOVE    #rDoXp,D5⓪)JMP     SyntaxErr⓪ !ok      JSR     StatSeq⓪)CMPI.W  #35,D3        ;END⓪)BEQ     ok1⓪)MOVE    #rBdSym,D5⓪)JMP     SyntaxErr⓪ !ok1     MOVE    (A7)+,D4⓪)MOVE.L  (A7)+,D0      ;VOR-BRA.L LUECKE⓪)TST     SuppressCode⓪)BNE     noBra⓪)JSR     BRAToLabelD0⓪ noBra    JSR     SolveForwRefs⓪)MOVE.W  (A7)+,SuppressCode⓪)JMP     GetSbl⓪!END⓪ END AWHILE;⓪)⓪ PROCEDURE AREPEAT;⓪ BEGIN⓪ ASSEMBLER⓪)JSR     LABEL⓪)JSR     PullInt       ;Label vom Int-Stack retten⓪)MOVE.L  D0,-(A7)⓪)JSR     StatSeq⓪)CMPI.W  #38,D3        ;UNTIL⓪)BEQ     ok⓪)MOVE    #rUntXp,D5⓪)JMP     SyntaxErr⓪ !ok      MOVE.W  SuppressCode,-(A7)⓪)JSR     boolExpr⓪)MOVE.W  (A7)+,SuppressCode     ; hat hier ja keinen Sinn mehr⓪)MOVE    D0,D4⓪)BRA     start⓪ solve    JSR     PullInt       ;Ref von 'boolExpr' zu FALSE-target⓪)MOVE.L  D0,D1⓪)MOVE.L  (A7),D0       ;Adr. des Labels⓪)JSR     SolveLabel⓪ start    DBF     D4,solve⓪)ADDQ.L  #4,A7⓪ END⓪ END AREPEAT;⓪)⓪ PROCEDURE ALOOP;⓪ BEGIN⓪ ASSEMBLER⓪)JSR     LABEL⓪)ADDQ.W  #1,LOOPLEV⓪)MOVE.L  EXSTKPtr,A0⓪)CLR.W   -(A0)          ;EXIT COUNT⓪)MOVE.L  A0,EXSTKPtr⓪)MOVE.L  LoopDiscOfs,-(A7)   ;BYTES AUF DEM STACK VON FOR/WITH⓪)MOVE.L  LastExit,-(A7)⓪)MOVE.L  A7Offset,LoopDiscOfs⓪)CLR.L   LastExit⓪)JSR     StatSeq⓪)MOVE.L  (A7)+,LastExit⓪)MOVE.L  (A7)+,LoopDiscOfs⓪)CMPI.W  #35,D3⓪)BEQ     ok⓪)MOVE    #rBdSym,D5         ;END EXPECTED⓪)JMP     SyntaxErr⓪ !ok      JSR     BRAToLabel⓪)MOVE.L  EXSTKPtr,A5⓪)MOVE.W  (A5)+,D0⓪)BEQ     LOOP2⓪ !LOOP1   MOVE.L  (A5)+,D2⓪)JSR     ToHere⓪)SUBQ.W  #1,D0⓪)BNE     LOOP1⓪ !LOOP2   MOVE.L  A5,EXSTKPtr⓪)SUBQ.W  #1,LOOPLEV⓪)JMP     GetSbl⓪ END⓪ END ALOOP;⓪)⓪ PROCEDURE AEXIT;⓪ BEGIN⓪ ASSEMBLER⓪)TST.W   LOOPLEV⓪)BNE     ok⓪)MOVE    #rNoLop,D5⓪)JMP     SyntaxErr⓪ ok⓪);noch Muell/gerettete Regs auf dem Stack?⓪)MOVE.L  LoopDiscOfs,D0⓪)JSR     discardA7⓪)⓪)MOVE.L  EXSTKPtr,A0⓪)LEA     INTSTK,A5⓪)ADDQ.L  #6,A5⓪)CMPA.L  A5,A0⓪)BLS     isFull         ; Stack ist voll -> BRA zum letzten EXIT gen.⓪)MOVE.W  (A0)+,D0⓪)ADDQ.W  #1,D0⓪)MOVE.L  A4,D1⓪)ADDQ.L  #2,D1⓪)MOVE.L  D1,-(A0)⓪)MOVE.W  D0,-(A0)⓪)MOVE.L  A0,EXSTKPtr⓪ ⓪ (* brauchen wir nicht mehr:⓪)CMPA.L  #INTSTK,A0⓪)BHI     ok1⓪)MOVE    #rExiOv,D5⓪)JMP     SyntaxErr⓪'ok1⓪ *)⓪)MOVE.L  A4,LastExit⓪)JSR     put39         ;BRA forward⓪)JSR     put2          ;BRA-WEITE RESERVIEREN⓪)JMP     GetSbl⓪ ⓪ isFull   ; Sprung zum letzten Exit erzeugen⓪)MOVE.L  LastExit,D0⓪)JSR     BRAToLabelD0⓪)JMP     GetSbl⓪ END⓪ END AEXIT;⓪ ⓪ ⓪ PROCEDURE AIF;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.W  SuppressCode,-(A7) ;IF-global merken⓪)MOVE.L  ISTKPTR,-(A7)  ;INTEGER-SP merken⓪)CLR.W   -(A7)          ;zählt die BRAs zum END⓪)CLR.W   -(A7)          ;zählt die Labels der letzten 'boolExpr'⓪ ⓪ !IF2     MOVE.W  SuppressCode,-(A7) ;merken f. THEN bis END/ELSE/ELSIF⓪)JSR     boolExpr⓪)MOVE    D0,2(A7)⓪ ⓪)CMPI.W  #32,D3        ;THEN⓪)BEQ     ok⓪)MOVE    #rTheXp,D5⓪)JMP     SyntaxErr⓪ ⓪ !ok      JSR     StatSeq⓪)MOVE.W  (A7)+,SuppressCode⓪)⓪)TST     (A7)⓪)BNE     doCode⓪); IF/ELSIF war TRUE -> keinen weiteren Code gen.⓪)MOVE    #1,SuppressCode⓪ doCode⓪)CMPI.W  #34,D3        ;ELSIF⓪)BNE     IF1⓪ ⓪)JSR     Put39         ; BRA...⓪)JSR     ForwardRef⓪)ADDQ.W  #1,2(A7)⓪); nun alle false-Labels von boolExpr auflösen⓪)MOVE    (A7),D4⓪)BSR     solve⓪)BRA     IF2⓪ ⓪ !IF1     CMPI.W  #33,D3        ;ELSE⓪)BNE     IF3⓪ ⓪)JSR     Put39         ; BRA...⓪)JSR     ForwardRef⓪)ADDQ.W  #1,2(A7)⓪); nun alle false-Labels von boolExpr auflösen⓪)MOVE    (A7),D4⓪)BSR     solve⓪)CLR     (A7)⓪)JSR     StatSeq⓪ ⓪ !IF3     CMPI.W  #35,D3        ;END⓪)BEQ     ok1⓪)MOVE    #rBdSym,D5⓪)JMP     SyntaxErr⓪ ⓪ !ok1     ; zuletzt die BRA-Label zum END lösen⓪)MOVE.W  (A7)+,D4⓪)ADD.W   (A7)+,D4⓪)JSR     SolveForwRefs⓪)MOVE.L  ISTKPTR,D0  ;INTEGER-SP⓪)CMP.L   (A7)+,D0⓪)BEQ     StkOk⓪)JSR     HALT        ; da stimmt was nicht!⓪ StkOk    MOVE.W  (A7)+,SuppressCode⓪)JMP     GetSbl⓪ ⓪ solve    ; Lösen der letzten Label-Liste vom 'boolExpr'-Aufruf⓪)JSR     PullInt     ; aber zuvor noch die neue Forw-Ref retten⓪)MOVE.L  D0,-(A7)⓪)JSR     SolveForwRefs⓪)MOVE.L  (A7)+,D0⓪)JMP     PushInt⓪"END⓪ END AIF;⓪)⓪)⓪ PROCEDURE Acase;⓪ BEGIN⓪ ASSEMBLER⓪)JSR     caseExpr        ;CASE-Selektor nach D0⓪)JSR     PullInt         ;SELECTOR TYPE⓪)CMPI.B  #11,-1(A1,D0.L) ;Subrange ?⓪)BNE     noSubR⓪)MOVE.L  -18(A1,D0.L),D0 ;Basistyp nehmen⓪ !noSubR  MOVE.L  D0,caseTYPE⓪)CLR.W   FRSTcase⓪)CLR.W   caseCNT⓪)JSR     Put39         ; BRA...⓪)JSR     ForwardRef⓪)CMPI.W  #46,D3        ;OF?⓪)BEQ     case3⓪)MOVE    #rOFXp,D5⓪)JMP     SyntaxErr⓪ !case3   JSR     GetSbl        ;jetzt auch leere ||| erlaubt⓪ ⓪);folgt ein <case> oder ist er leer (d.h. | oder END folgt) ?⓪)CMPI.W  #29,D3        ;|⓪)BEQ     case3⓪)CMPI.W  #30,D3        ;!⓪)BEQ     case3⓪)CMP.W   #33,D3        ;ELSE?⓪)BEQ     case2⓪)CMP.W   #35,d3        ;END?⓪)BEQ     case4⓪)⓪); muss nicht-leerer <case> sein⓪)ADDQ.W  #1,caseCNT    ;muss weiterer case sein⓪)BSR.L   onecase⓪)⓪);jetzt muss '|' oder END folgen!⓪)CMPI.W  #29,D3        ;|⓪)BEQ     case3⓪)CMPI.W  #30,D3        ;!⓪)BEQ     case3⓪)CMP.W   #33,D3        ;ELSE?⓪)BEQ     case2⓪)CMP.W   #35,d3        ;END?⓪)BEQ     case4⓪)MOVE    #rCaStr,D5⓪)JMP     SyntaxErr⓪)⓪ !case4   JSR     label         ;default case⓪)MOVE.L  Options,D0⓪)BTST    #10,D0        ;$J-?⓪)BEQ     nocaseEr⓪)TST.W   caseCNT⓪)BEQ     emptyCas⓪)BTST    #18,D0        ;$R-?⓪)BEQ     nocaseEr⓪)JSR     PutTRAPCaseErr⓪)BRA     nocaseEr⓪ emptyCas MOVE    #rNoCas,D5    ;bei J+ Fehler bei leerem Case melden⓪)JMP     SyntaxErr⓪ nocaseEr TST.W   caseCNT⓪)BEQ     ignCase       ;bei J- leeres Case ignorieren⓪)JSR     Put39         ; BRA...⓪)JSR     ForwardRef⓪)BRA     ok2⓪ ⓪ !case2   JSR     label⓪)BSR.L   casestat      ;statement seq⓪)CMPI.W  #35,D3        ;END?⓪)BEQ     ok2⓪)MOVE    #rBdSym,D5⓪)JMP     SyntaxErr⓪ ⓪ !ok2     BSR     caseTBL       ;SPRUNGTABELLE⓪ ignCase  JMP     GetSbl⓪ ;⓪ caseTBL  MOVE.L  caseTYPE,D0⓪)MOVE.L  A4,-(A7)        ;case VERTEILER-ADR⓪)SF      secondBcc⓪)CMPI.L  #4,-6(A1,D0.L) ;LONG TYPE?⓪)BNE     caseTBL4        ;WORD⓪)⓪); CaseTbl fuer Long-Selektoren⓪)⓪)JSR     Put79b         ; CMPI.L⓪)MOVE.L  MaxCase,(A4)+⓪)CMPI.B  #1,-1(A1,D0.L) ; LONGINT?⓪)BEQ     CASETBL6⓪ CASETBL0 JSR     PUT47          ; BHI⓪)MOVE.L  A4,-(A7)⓪)JSR     PUT2           ; put 0.W⓪)MOVE.L  MinCase,D0⓪)BEQ.W   CASETBL8⓪)JSR     PutSubIL_D0   ;SUB.L #MINcase⓪)JSR     Put46         ;BCS⓪)BRA.L   CASETBL7⓪ CASETBL6 ; vorzeichenbehafteter Vergleich⓪)TST.L   MinCase       ;wenn LowBound=0, dann Vergl. ohne Vorzeichen!⓪)BEQ     CASETBL0⓪)JSR     Put49         ;BGT⓪)MOVE.L  A4,-(A7)⓪)JSR     PUT2           ; put 0.W⓪)MOVE.L  MinCase,D0⓪)BEQ.W   CASETBL8⓪)JSR     PutSubIL_D0   ;SUB.L #MINcase⓪)JSR     Put48         ;BLT⓪)BRA.W   CASETBL7⓪ ⓪); CaseTbl fuer Word-Selektoren⓪)⓪ CASETBL4 MOVE.L  D0,-(A7)⓪)JSR     PUT79         ;CMPI.W⓪)MOVE.W  MAXcase2,(A4)+⓪)MOVE.L  (A7)+,D0⓪)CMPI.B  #33,-1(A1,D0.L) ;ShortInt?⓪)BEQ     caseTBL5      ;SIGNED⓪ caseTBL9 JSR     Put47         ;BHI⓪)MOVE.L  A4,-(A7)⓪)JSR     PUT2           ; put 0.W⓪)MOVE.W  MinCase2,D0⓪)BEQ     CASETBL8⓪)JSR     PutSubIW_D0   ;SUB.W #MINcase⓪)JSR     Put46         ;BCS⓪)BRA     caseTBL7⓪ caseTBL5 ; vorzeichenbehafteter Vergleich⓪)TST.L   MinCase       ;wenn LowBound=0, dann Vergl. ohne Vorzeichen!⓪)BEQ     CASETBL9⓪)JSR     Put49         ;BGT⓪)MOVE.L  A4,-(A7)⓪)JSR     Put2⓪)MOVE.W  MinCase2,D0⓪)BEQ     CASETBL8⓪)JSR     PutSubIW_D0   ;SUB.W #MINcase⓪)JSR     Put48         ;BLT⓪ ⓪); Weiter für alle Selektoren⓪)⓪ caseTBL7 ST      secondBcc⓪)MOVE.L  A4,-(A7)⓪)JSR     PUT2           ; put 0.W⓪ caseTBL8 JSR     Put70         ;VERTEILER⓪)MOVE.L  A4,A5         ;^ANFANG DER SPRTAB⓪)MOVE.L  MAXcase,D0⓪)SUB.L   MINcase,D0⓪)LSL.L   #1,D0⓪)MOVE.W  D0,D4         ;^LAST ADR⓪)ADDQ.L  #2,D0⓪)ADDA.L  D0,A4         ;CODE-PTR HINTER TAB⓪)JSR     PullInt       ;BRA NACH ELSETEIL⓪)MOVE.L  D0,D2⓪)JSR     ToHere⓪)JSR     LookINT       ;DEFAULT ADR⓪)MOVE.L  D0,D1⓪)MOVE.L  (A7)+,A0⓪)MOVE.L  D1,D2⓪)SUB.L   A0,D2⓪)MOVE.W  D2,(A0)       ;OUT OF RNG caseS NACHTRAGEN⓪)TST.B   secondBcc⓪)BEQ     no2nd⓪)MOVE.L  (A7)+,A0⓪)MOVE.L  D1,D2⓪)SUB.L   A0,D2⓪)MOVE.W  D2,(A0)⓪ no2nd    JSR     PullInt       ;DEFAULT-ADR HOLEN⓪)SUB.L   A5,D0⓪)MOVE.W  D0,D5⓪ caseTBL1 MOVE.W  D0,0(A5,D4.W)⓪)SUBQ.W  #2,D4⓪)BPL     caseTBL1⓪ caseTBL3 JSR     PullInt⓪)MOVE.L  D0,D2⓪)JSR     ToHere        ;STATEMENT-ENDE⓪)JSR     PullInt       ;STATEMENT-ADR⓪)SUB.L   A5,D0         ;RELATIV ZUM VERTEILER⓪)MOVE.W  D0,D2⓪)JSR     PullInt⓪)MOVE.L  D0,D4         ;case-ZAEHLER⓪ caseTBL2 JSR     PullInt⓪)SUB.L   MINcase,D0⓪)LSL.W   #1,D0⓪)CMP.W   0(A5,D0.W),D5  ;STEHT NOCH DIE DEFAULT-ADR DA?⓪)BEQ     CSTOK⓪)MOVE    #rCase2,D5        ;case LABEL DECL. TWICE⓪)JMP     SyntaxErr⓪ CSTOK    MOVE.W  D2,0(A5,D0.W)  ;IN TABELLE EINTRAGEN⓪)SUBQ.W  #1,D4⓪)BNE     caseTBL2⓪)SUBQ.W  #1,caseCNT    ;MEHR caseS?⓪)BNE     caseTBL3⓪)JSR     PullInt⓪)MOVE.L  D0,D2⓪)MOVE.L  (A7)+,D1      ;VERTEILER-ADR⓪)JMP     ToHere0⓪)⓪); Im Folgenden werden alle CASE-Labels stets Long bearbeitet;⓪); die Subroutines sind daher fuer alle Selektor-Typen zu verwenden:⓪)⓪); eine Case-Variante verarbeiten⓪)⓪ !onecase  CLR.W   LBLCNT        ;LABEL-ZAEHLER⓪*MOVE.L  A4,-(A7)⓪*BRA     onecase2⓪ !onecase1 JSR     GetSbl⓪ !onecase2 BSR.L   caseLBL⓪*CMPI.W  #8,D3         ;..⓪*BNE     onecase3⓪*BSR.L   LBLRNG⓪ !onecase3 CMPI.W  #10,D3        ;,⓪*BEQ     onecase1⓪*CMPI.W  #25,D3        ;:⓪*BEQ     OCSOK⓪*MOVE    #rColXp,D5⓪*JMP     SyntaxErr⓪ !ocsok    CLR.L   D0⓪*MOVE.W  LBLCNT,D0⓪*JSR     PushInt⓪*MOVE.L  (A7)+,D0      ;LABEL AUF StatSeq SETZEN⓪*JSR     PushInt⓪*CLR.W   D7⓪ !casestat MOVE.L  MINcase,-(A7)⓪*MOVE.L  MAXcase,-(A7)⓪*MOVE.L  caseTYPE,-(A7)⓪*MOVE.W  caseCNT,-(A7)⓪*JSR     StatSeq⓪*JSR     Put39         ; BRA...⓪*JSR     ForwardRef⓪*MOVE.W  (A7)+,caseCNT⓪*MOVE.L  (A7)+,caseTYPE⓪*MOVE.L  (A7)+,MAXcase⓪*MOVE.L  (A7)+,MINcase⓪*RTS⓪ ⓪); ein CaseLabel holen und verdauen⓪ ⓪ !caseLBL JSR     ConstExpr⓪)MOVE.L  caseTYPE,D2⓪)JSR     PullInt⓪)JSR     adaptSStoCHAR⓪)JSR     constTyp⓪)JSR     COMPATRR⓪)BEQ     CsLblok⓪)MOVE    #rBdTyp,D5⓪)JMP     SyntaxErr⓪ !CsLblok BSR.L   minmax⓪)MOVE.L  Accu,D0⓪)JMP     PushInt⓪ ⓪); 'Label .. Label' verdauen⓪)⓪ LBLRNG   MOVE.L  Accu,-(A7)      ;LOW BND MERKEN⓪)JSR     GetSbl⓪)JSR     ConstExpr⓪)MOVE.L  caseTYPE,D2⓪)JSR     PullInt⓪)JSR     adaptSStoCHAR⓪)JSR     constTyp⓪)JSR     COMPATRR⓪)BEQ     LRNGok⓪)MOVE    #rBdTyp,D5⓪)JMP     SyntaxErr⓪ LRNGok   MOVE.L  (A7),D0⓪)BSR.L   compar⓪)BEQ     LBLRNG1⓪)MOVE    #rLowHi,D5         ;LOW BND > HIGH BND⓪)JMP     SyntaxErr⓪ LBLRNG1  MOVE.L  (A7),D0⓪)CMP.L   Accu,D0⓪)BEQ     LBLRNG2       ;BEI GLEICHHEIT FERTIG⓪)BSR.L   minmax⓪)MOVE.L  Accu,D0⓪)JSR     PushInt⓪)SUBQ.L  #1,Accu⓪)BRA     LBLRNG1⓪ LBLRNG2  ADDQ.L  #4,A7⓪)RTS⓪ ⓪ ;⓪ ;   VERGLEICHT D0 MIT Accu SIGNED ODER UNSIGNED⓪ ;   D0 <= I1: EQ⓪ ;   D0 > I1: NE⓪ ;⓪ !compar  CMPI.B  #33,-1(A1,D2.L) ;ShortInt?⓪)BEQ     compare3⓪)CMPI.B  #01,-1(A1,D2.L) ;LongInt?⓪)BEQ     compare3⓪)CMP.L   Accu,D0         ;UNSIGNED⓪)BHI     compare1      ;NE⓪ compare2 CLR.W   D0            ;SETZT EQ⓪ compare1 RTS⓪ compare3 CMP.L   Accu,D0⓪)BGT     compare1      ;NE GESETZT⓪)BRA     compare2      ;EQ⓪)⓪); minimales und maximales CaseLabel ermitteln⓪)⓪ minmax   ADDQ.W  #1,LBLCNT⓪)TST.W   FRSTcase⓪)BNE     minmax1⓪)MOVE.L  Accu,MINcase⓪)MOVE.L  Accu,MAXcase⓪)NOT.W   FRSTcase⓪)RTS⓪ minmax1  MOVE.L  Accu,D0⓪)CMPI.B  #33,-1(A1,D2.L) ;ShortInt?⓪)BEQ     minmax2⓪)CMPI.B  #01,-1(A1,D2.L) ;LongInt?⓪)BEQ     minmax2⓪ minmax3  CMP.L   MINcase,D0    ;UNSIGNED⓪)BCS     minmax6⓪)CMP.L   MAXcase,D0⓪)BHI     minmax7⓪)RTS⓪ minmax2  CMP.L   MINcase,D0    ;SIGNED⓪)BLT     minmax6⓪)CMP.L   MAXcase,D0⓪)BGT     minmax7⓪)RTS⓪ minmax7  MOVE.L  D0,MAXcase⓪)RTS⓪ minmax6  MOVE.L  D0,MINcase⓪!END⓪ END Acase;⓪ ⓪ ⓪ (*⓪!*    Hilfsprozeduren zur Parameter-Auswertung⓪!*)⓪!⓪ PROCEDURE GetLPar;              (* Linke Klammer holen *)⓪ BEGIN ASSEMBLER⓪)JSR     GetSbl⓪)CMPI.W  #14,D3⓪)BEQ     ok⓪)MOVE    #rLPaXp,D5⓪)JMP     SyntaxErr⓪ ok     END⓪ END GetLPar;⓪ ⓪ PROCEDURE GetRPar;        (* Rechte Klammer pruefen, folgendes Symbol holen *)⓪ BEGIN ASSEMBLER⓪)CMPI.W  #26,D3⓪)BEQ     ok⓪)MOVE    #rParXp,D5⓪)JMP     SyntaxErr⓪ ok       JMP     GetSbl⓪'END⓪ END GetRPar;⓪ ⓪ PROCEDURE GetComma;      (* Komma pruefen *)⓪ BEGIN ASSEMBLER⓪)CMPI.W  #10,D3⓪)BEQ     ok⓪)MOVE    #rComXp,D5⓪)JMP     SyntaxErr⓪ ok     END⓪ END GetComma;⓪ ⓪ PROCEDURE GetAdr;       (* Var/Rec-Adresse auf Stack holen lassen,⓪;pruefen, ob Typ mit (D0) kompatibel *)⓪ BEGIN ASSEMBLER⓪)JSR     PushInt⓪)JSR     GetSbl⓪)BMI     ok1⓪)MOVE    #rVarXp,D5⓪)JMP     SyntaxErr⓪ !ok1     JSR     pushAdr⓪)JSR     compat⓪)BEQ     ok2⓪)MOVE    #rOpTyp,D5⓪)JMP     SyntaxErr⓪ ok2   END⓪ END GetAdr;⓪ ⓪ PROCEDURE GetVal;       (* Expressionwert auf Stack holen lassen,⓪;pruefen, ob Typ mit (D0) kompatibel *)⓪ BEGIN⓪"ASSEMBLER⓪)JSR     PushInt⓪)MOVEQ   #0,D0⓪)JSR     pushExpr⓪"END⓪ END GetVal;⓪ ⓪(⓪ (*⓪!*     Standard-Prozeduren⓪!*)⓪!⓪ PROCEDURE ANEW;⓪ BEGIN ASSEMBLER⓪)JSR     NDARG         ;Parameter AUSWERTEN⓪)JSR     CALLAL⓪)JMP     SameSbl⓪&END⓪ END ANEW;⓪)⓪ PROCEDURE ADISPOSE;⓪ BEGIN ASSEMBLER⓪)JSR     NDARG⓪)JSR     CALLDEAL⓪)JMP     SameSbl⓪&END⓪ END ADISPOSE;⓪ ⓪ PROCEDURE NDARG;⓪ BEGIN ASSEMBLER⓪)JSR     GetLPar⓪)JSR     GetSbl⓪)BMI     ok1⓪)MOVE    #rVarXp,D5⓪)JMP     SyntaxErr⓪ !ok1     JSR     pushAdr⓪)JSR     PullInt⓪)CMPI.B   #20,-1(A1,D0.L) ;POINTER?⓪)BEQ     ok2⓪)MOVE    #rBdTyp,D5         ;TYPE CONFLICT⓪)JMP     SyntaxErr⓪ !ok2     MOVE.L  -10(A1,D0.L),D2 ;BASETYPE⓪)JSR     Put25             ;MOVE.L #xx,(A3)+⓪)MOVE.L  -6(A1,D2.L),(A4)+ ;LAENGE DES BASETYPE⓪)JSR     SameSbl⓪)JMP     GetRPar⓪!END⓪ END NDARG;⓪ ⓪ PROCEDURE aCode;⓪"BEGIN⓪$ASSEMBLER⓪(JSR     GetLPar⓪ again   JSR     GetSbl⓪(JSR     ConstExpr⓪(MOVE.L  SBothTyp,D2⓪(JSR     PullInt⓪(JSR     COMPATRR⓪(BEQ     LRNGok⓪(MOVE    #rCarXp,D5      ; CARDINAL-Const exp.⓪(JMP     SyntaxErr⓪ LRNGok  MOVE.L  Accu,D0⓪(CMPI.L  #$FFFF0000,D0⓪(BCC     ok⓪(CMPI.L  #$0000FFFF,D0⓪(BLS     ok⓪(MOVE    #rConRg,D5      ; Const range error⓪(JMP     SyntaxErr⓪ ok      MOVE.W  D0,(A4)+⓪(CMPI.W  #10,D3        ;,?⓪(BEQ     again         ;weiter, solange ',' folgt⓪(JMP     GetRPar⓪$END⓪"END aCode;⓪"⓪ PROCEDURE aNewProcess;⓪ BEGIN ASSEMBLER⓪(MOVE.L  -8(A1,D2.L),-(A7)  ;^Parameter-Kette⓪(JSR     GetLPar⓪(MOVE.L  (A7)+,D2⓪(MOVE.L  -14(A1,D2.L),-(A7) ;^ naechstes El. der Kette⓪(MOVE.L  -6(A1,D2.L),D0  ;^Parameter-Typ PROC⓪(JSR     GetVal          ;PROC-Expression holen⓪(JSR     GetComma⓪(MOVE.L  (A7),D2⓪(MOVE.L  -6(A1,D2.L),D0  ;^Parameter-Typ ADDRESS⓪(JSR     GetVal          ;Address-Expr holen⓪(JSR     GetComma⓪(MOVE.L  CardPtr,D0⓪(JSR     GetVal          ;LongCard-Expr holen⓪(JSR     GetComma⓪(MOVE.L  (A7)+,D2⓪(MOVE.L  -6(A1,D2.L),D0  ;^Parameter-Typ ADDRESS⓪(JSR     GetAdr          ;Process-VAR (Typ Address) holen⓪(JSR     GetRPar⓪(MOVEQ   #35,D3⓪(JSR     CSP             ;Runtime-Modul aufrufen⓪(JMP     SameSbl⓪%END⓪ END aNewProcess;⓪ ⓪ PROCEDURE aIOTransfer;⓪ BEGIN ASSEMBLER⓪(MOVE.L  -8(A1,D2.L),-(A7)  ;^Parameter-Kette⓪(JSR     GetLPar⓪(MOVE.L  (A7),D2⓪(MOVE.L  -6(A1,D2.L),D0  ;^Parameter-Typ ADDRESS⓪(JSR     GetAdr          ;Process-VAR holen⓪(JSR     GetComma⓪(MOVE.L  (A7),D2⓪(MOVE.L  -6(A1,D2.L),D0  ;^Parameter-Typ ADDRESS⓪(JSR     GetAdr          ;Process-VAR holen⓪(JSR     GetComma⓪(MOVE.L  (A7)+,D2⓪(MOVE.L  -6(A1,D2.L),D0  ;^Parameter-Typ ADDRESS⓪(JSR     GetVal          ;Exc.Nr: Address-Expr holen⓪(JSR     GetRPar⓪(MOVEQ   #34,D3⓪(JSR     CSP             ;Runtime-Modul aufrufen⓪(JMP     SameSbl⓪&END⓪ END aIOTransfer;⓪ ⓪ PROCEDURE aTransfer;⓪ BEGIN ASSEMBLER⓪(MOVE.L  -8(A1,D2.L),-(A7)  ;^Parameter-Kette⓪(JSR     GetLPar⓪(MOVE.L  (A7),D2⓪(MOVE.L  -6(A1,D2.L),D0  ;^Parameter-Typ ADDRESS⓪(JSR     GetAdr          ;Process-VAR holen⓪(JSR     GetComma⓪(MOVE.L  (A7)+,D2⓪(MOVE.L  -6(A1,D2.L),D0  ;^Parameter-Typ ADDRESS⓪(JSR     GetAdr          ;Process-VAR holen⓪(JSR     GetRPar⓪(MOVEQ   #33,D3⓪(JSR     CSP             ;Runtime-Modul aufrufen⓪(JMP     SameSbl⓪&END⓪ END aTransfer;⓪ ⓪ PROCEDURE aIOCall;⓪ BEGIN ASSEMBLER⓪(MOVE.L  -8(A1,D2.L),-(A7)  ;^Parameter-Kette⓪(JSR     GetLPar⓪(MOVE.L  (A7)+,D2⓪(MOVE.L  -6(A1,D2.L),D0  ;^Parameter-Typ ADDRESS⓪(JSR     GetVal          ;Exc.Nr: Address-Expr holen⓪(JSR     GetRPar⓪(MOVEQ   #40,D3⓪(JSR     CSP             ;Runtime-Modul aufrufen⓪(JMP     SameSbl⓪&END⓪ END aIOCall;⓪ ⓪ PROCEDURE aListen;⓪ BEGIN ASSEMBLER⓪(MOVEQ   #39,D3⓪(JSR     CSP             ;Runtime-Modul aufrufen⓪(JSR     GetSbl⓪(CMPI.W  #14,D3          ;linke Klammer?⓪(BNE     noPar⓪(JSR     GetSbl⓪(JMP     GetRPar         ;rechte Klammer muß folgen⓪"noPar⓪&END⓪ END aListen;⓪ ⓪ (*⓪ (*$ i Q:mc6.Expr.Text    *)⓪ (*$ i Q:mc7.Import.Text  *)⓪ (*$p-*)⓪ (*$ i Q:mc8.Assm.Text    *)⓪ (*$p+*)⓪ *)⓪ ⓪ (*$ i Import.ICL   *)⓪ (*$ i Assm.ICL     *)⓪ ⓪ PROCEDURE Compile ();⓪ BEGIN⓪ ⓪"(*$ ? runGep:    pname := 'System.List.Text'; *)⓪"(*$ ? runST:     pname := 'MODULA.LST'; *)⓪"⓪"BadID := '';⓪"(*$ ? runST:⓪$IF ScanMode THEN AutoCmd := ScanErrFile⓪$ELSE AutoCmd := 0⓪$END;⓪"*)⓪"⓪"ASSEMBLER⓪$(*$ ? runGep: MOVEM.L A1/A2/A4,saveRegs    *)⓪$(*$ ? runST:  MOVEM.L A4/A5/A6,saveRegs    *)⓪)MOVE.L  A3,LoSysStack⓪)MOVE.L  A7,HiSysStack⓪"END;⓪"⓪"ASSEMBLER⓪)MOVE.W  #3,GlobalUseFormat  ;Default: benutze GDOS-Realformat⓪"END;⓪"DataLen:= DataSpcDft;⓪"MaxSpace:= MaxSpcDft;⓪"DynSpace:= DynSpcDft;⓪"⓪"OpenIO;⓪"Comp;⓪"CloseIO;⓪"⓪"ASSEMBLER⓪$(*$ ? runGep: MOVEM.L saveRegs,A1/A2/A4    *)⓪$(*$ ? runST:  MOVEM.L saveRegs,A4/A5/A6    *)⓪"END;⓪"⓪"CodeSize:= csize;⓪"FastStrings.Assign (cname, CodeName);⓪"Strings.Upper (CodeName);⓪"⓪ END Compile;⓪ ⓪ BEGIN⓪"Compile⓪ (*$p+*)⓪ END MM2Comp.⓪ ə
(* $00014D41$00018757$FFE118F8$0000FE7D$000102F6$00010488$FFFCF6B2$FFFCF6B2$FFFCF6B2$FFFCF6B2$FFFCF6B2$000054E7$FFFCF6B2$0001F352$FFFCF6B2$00008AF5$FFFCF6B2$00014D41$0000B68B$0001BC8E$FFF6EC04$FFFCF6B2$FFFCF6B2$FFFCF6B2$00018197$000058CC$00012DCD$FFFCF6B2$FFFCF6B2$FFFCF6B2$FFFCF6B2$FFFCF6B2$FFFCF6B2$FFFCF6B2$FFFCF6B2$00019A27$0001030C$FFFCF6B2$FFFCF6B2$FFFCF6B2$FFFCF6B2$FFFCF6B2Ç$00008B06T........T.......T......T.......T.T.....T.......T.......T.......T.......T.......$FFE4EE62$0001F1EF$00008881$0000888F$0000887F$000088D5$00008D7E$00008AF5$00008AD2$FFE4EE62$00008AFF$000054E7$0001F21F$0001F207$000089D0$00008AFDãÇâ*)