(*
 * August 1992/bp/AMSoft
 * Dieses Modul ist wenig sinnvoll, es soll lediglich viele der
 * Möglichkeiten des M2Amiga-Systems aufzeigen.
 *
 * In der Demo-Version sind Register- und externe Variablen nicht erlaubt!
 *
 *)
MODULE Features;

(*
 * Compileroptionen können an jedem Ort abgefragt, aber einige nur
 * an bestimmten Orten verändert werden.
 * Vordefinierte Namen aller Compileroptionen:
 * Die Buchstaben und Ziffern in Klammern bezeichnen die Angabe
 * der entsprechenden Option von der Kommandozeile.
 * CaseChk	 (c)
 * ChipBSS
 * ChipCODE
 * ChipDATA
 * CopyDyn
 * CStrings
 * EntryExitCode
 * Implementation
 * Joker	 (j)
 * LargeVars	 (y) (-y => residente Programme!)
 * LoadA4
 * LongAlign	 (l)
 * m68010	 (1)
 * m68020	 (2)
 * m68030	 (3)
 * m68040	 (4)
 * m68881	 (8)
 * NameChk
 * NilChk	 (n)
 * OverflowChk	 (v)
 * ParDealloc
 * RangeChk	 (r)
 * ReturnChk	 (f)
 * SaveA4
 * SaveAllRegs
 * StackChk	 (s)
 * StackParms	 (z)
 * Volatile	 (h)
 * (d) => -d heißt: Code optimieren und kein .ref-File erzeugen
 *)
(*
 * Dies ist eine Compiler-Anweisung. Compiler-Anweisungen beginnen
 * mit (,* und $. Diese Anweisung löscht die Option LargeVars,
 * woraufhin dieses Modul im SMALL-Data-Modell kompiliert wird.
 *)
(*$ LargeVars:=FALSE *)

(*
 * Die nachfolgende Compiler-Anweisung deklariert eine
 * benutzerdefinierte Option und belegt sie mit dem Wert FALSE.
 * Wenn der Bediener von der Kommandozeile "+oEnglish" eingibt,
 * erhält die Option den Wert TRUE.
 *)
(*$ DEFINE English:=FALSE *)

FROM SYSTEM	IMPORT	ADR,ASSEMBLE,CAST,TAG;
FROM DosD	IMPORT	FileInfoBlock;
IMPORT
	Arts,
	R,
	IL:IntuitionL,
	ID:IntuitionD;

CONST
(*
 * Wir deklarieren nun eine Konstante, die abhängig von der Option
 * "English" unterschiedliche Werte erhält.
 * Nebenbei geben wir noch einmal ausdrücklich auf dem Bildschirm
 * aus, welche Version wir gerade erstellen.
 *)
  (*$ IF English "Dies wird eine englische Version!\n\n" *)
    message="No Window!";
  (*$ ELSE "Deutsche Version!\n\n" *)
    message="Kein Fenster!";
  (*$ ENDIF *)

VAR
(*
 * Die nachfolgende Variable wird auf einer Langwortgrenze
 * abgelegt, die dos.library wird es uns danken:
 *)
  (*$ LongAlign:=TRUE *)
  info: FileInfoBlock;
(*
 * Die nächsten Variablen werden entweder auf Wort- oder auf
 * Langwortgrenzen abgelegt. Dies hängt davon ab, welche Optionen
 * der Bediener von der Kommandozeile angab.
 *)
  (*$ POP LongAlign *) (* alten Wert wiederherstellen *)
  i,j:INTEGER;
(*
 * Die folgenden Variablen und Prozeduren sind extern, d.h. mit
 * einem fremden Assembler oder Compiler erstellt.
 * Die erste Variable muß in einem Hunk mit den Namen __MERGED
 * liegen und wird als SMALL-Variable deklariert.
 * Die zweite Variable "chipImage" wird als LARGE-Variable
 * deklariert und somit absolut adressiert. Da wir später nur
 * ihre Adresse benötigen, deklarieren wir sie einfach als INTEGER.
 * Da die Symbole einen Unterstrich enthalten, werden sie vom
 * Linker in der Datei "FDemo.obj" gesucht, andernfalls müßten
 * wir ihm den Dateinamen angeben.
 *)
  myMenu[<"FDemo_Menu"]: ID.Menu;
  chipImage["FDemo_Image"]: INTEGER;

PROCEDURE Extern(VAR i: INTEGER; j:LONGINT):LONGINT; "FDemo_Proc";


(*
 * Die folgende Prozedur demonstriert den Gebrauch von Register-
 * Variablen und -Parametern. Zwei INTEGER-Variablen werden
 * vertauscht. Die Parameter legen wir in Adressregister, weil
 * sie VAR-Parameter sind, die aufrufende Prozedur also ihre Adressen
 * übergibt. Der generierte Code steht in den Kommentaren.
 *)
PROCEDURE Swap(VAR a{R.A0},b{R.A1}:INTEGER);
VAR help{R.D0}:INTEGER;
BEGIN
  help:=a;  (* MOVE.W (A0),D0    *)
  a:=b;     (* MOVE.W (A1),(A0)  *)
  b:=help;  (* MOVE.W D0,(A1)    *)
END Swap;   (* RTS               *)

(*
 * Diese Prozedur demonstriert die Benutzung des Assemblers und der
 * bedingten Kompilierung. Sie multipliziert zwei Zahlen und liefert
 * den Betrag des Ergebnisses zurück. Das Gleiche würde natürlich durch
 * den Ausdruck ABS(a*b) erreicht! Wir sehen hieran auch, daß die
 * bedingte Kompilierung verschachtelt sein darf, und daß jede Option
 * abgefragt werden kann.
 * Da wir sie komplett in Assembler implementieren, darf der Compiler
 * keinen Ein- und Ausgangscode generieren, was wir durch eine
 * Compiler-Anweisung verhindern.
 * Die Prozedur ist mit bedingter Kompilierung künstlich überladen,
 * um einige Möglichkeiten aufzuzeigen. Man sollte sie GENAU ansehen!
 *)
(*$ EntryExitCode:=FALSE *)
PROCEDURE MulAbs(z1,z2:LONGINT):LONGINT;
BEGIN
  ASSEMBLE(
     (*$ IF NOT EntryExitCode *) (* Ist zwar hier sicher AUS, aber
				  * vielleicht ändern wir es später? *)
	LINK	A5,#0	(* Im Grunde unnötig, erleichtert aber
			 * die Adressierung der Parameter *)
     (*$ ENDIF *)

     (*$ IF m68020 *)   (* Wird dies Modul für die 68020 oder höhere
			 * kompiliert, dürfen wir MULS.L benutzen? *)
	MOVE.L	z1(A5),D0
	MULS.L	z2(A5),D0
       (*$ IF OverflowChk *) (* Soll eine Überlaufprüfung erfolgen? *)
	TRAPVS
       (*$ ENDIF *)
     (*$ ELSE *)	(* Nicht 68020ff, wir brauchen Arts! *)
	MOVE.L	z1(A5),D0
	MOVE.L	z2(A5),D1
	JSR	Arts.Muls32(PC)
       (*$ IF OverflowChk *) (* Soll eine Überlaufprüfung erfolgen? *)
	TRAPV
       (*$ ENDIF *)
     (*$ ENDIF *)

	TST.L	D0	(* Die Flags sind zwar schon gesetzt, aber *)
	BPL.S	IsPos   (* wir wollen doch auch noch ein Label zeigen *)
	NEG.L	D0
IsPos:

     (*$ IF NOT EntryExitCode *)
	UNLK	A5
     (*$ ENDIF *)

     (*$ IF m68010 AND NOT EntryExitCode *) (* Wir müssen die Parameter
					     * selbst abbauen, dürfen
					     * wir RTD benutzen? *)
	RTD	#4	(* Wir haben 2 INTEGER, also 4 Byte *)
     (*$ ELSIF NOT EntryExitCode *)	(* Nein, 68000! *)
	MOVE.L	(A7)+,A0
	ADDQ.L	#4,A7
	JMP	(A0)
     (*$ ENDIF *)

  END);
END MulAbs;

(*
 * Eine typisierte Konstante:
 *)
TYPE
  MyArr8 = ARRAY [0..7] OF INTEGER;
CONST
  mix = MyArr8{ -10, 5, 9, 0, 0, 4, 3, 1};
  alleEins = MyArr8{ 1, ..};

(*
 * Nun kommt eine initialisierte Variable:
 *)
VAR
  myNewWin:=ID.NewWindow{
	leftEdge: 150,	topEdge: 90,
	width:200,	height: 80,
	detailPen: 0,	blockPen: 1,
	idcmpFlags: ID.IDCMPFlagSet{},
	flags: ID.WindowFlagSet{ID.windowDrag,ID.windowDepth,
				ID.windowSizing,ID.activate},
	title: ADR("Mein altes Fenster"),
	screen: NIL,
	(* alle anderen Elemente sind 0 *)
	type:ID.ScreenFlagSet{ID.wbenchScreen}
	};

  tagBuffer: ARRAY [0..14] OF LONGINT;
  myWin: ID.WindowPtr;

(*
 * Im Hauptprogramm öffnen wir ein Window und warten ein Weilchen
 * Falls das Fenster nicht geöffnet werden konnte, bringt das Modul
 * Arts in einem Requester die Fehlermeldung auf den Schirm.
 *)
BEGIN (* Hauptprogramm *)
  IF Arts.kickVersion>=37 THEN (* haben wir Kickstart 2.0? *)
    myWin:=IL.OpenWindowTagList(NIL,TAG(tagBuffer,
	ID.waLeft,	150,
	ID.waTop,	90,
	ID.waWidth,	200,
	ID.waHeight,	90,
	ID.waIDCMP,	0,
	ID.waFlags,	ID.WindowFlagSet{ID.windowDrag,ID.windowDepth,
				ID.windowSizing,ID.activate},
	ID.waTitle,	ADR("Mein neues Fenster"),
	0));
  ELSE
    myWin:=IL.OpenWindow(myNewWin);
  END;
  Arts.Assert(myWin <> NIL, ADR(message));
  Arts.BreakPoint(ADR("Absichtliche Unterbrechung"));
(*
 * Der folgende Code wird am Programmende ausgeführt. Hier wird das
 * Fenster geschlossen, wenn es noch geöffnet ist.
 *)
CLOSE
  IF myWin#NIL THEN
    IL.CloseWindow(myWin);
    myWin:=NIL
  END;
END Features.