(*
 * Dezember 1990/bp
 * 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 dr Kommandozeile.
 * CaseChk	 (c)
 * ChipBSS
 * ChipCODE
 * 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
 * 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;
FROM Dos	IMPORT	FileInfoBlock,Delay;
IMPORT Arts,R,Intuition;
FROM Intuition	IMPORT	IDCMPFlagSet,WindowFlagSet,ScreenFlagSet,
			WindowFlags,ScreenFlags;

CONST
(*
 * Wir deklarieren nun eine Konstante, die abhängig von der Option
 * "English" unterschiedliche Werte erhält.
 *)
  (*$ IF English *)
    message="No Window!";
  (*$ ELSE *)
    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 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"]: Intuition.Menu;
  chipImage["FDemo_Image"]: INTEGER;

(*
 * 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;

(*
 * Und nun eine "Prozedur", die nur als Verpackung von Daten dient.
 * Hier ist zu beachten, daß die Daten unveränderlich sind, da diese
 * Prozedur in einem CODE-Hunk liegt! Der Zeiger auf einen Screen
 * dürfte z.B. nicht eingetragen werden.
 * Zu Beginn sind einige Konstanten-Deklarationen notwendig, da der
 * Assembler nicht mit Mengen umgehen kann.
 * Die RELOCATION-Anweisung erlaubt die Benutzung des Labels "Title"
 * als absolute Adresse. Hierfür muß eine 32Bit-Relokation erzeugt
 * werden, die der Assembler normalerweise mit einer Fehlermeldung
 * zurückweist, um den Programmierer vor unbeabsichtigten Dingen
 * zu bewahren.
 *)
(*$ EntryExitCode:=FALSE *)
PROCEDURE NewWin; (* NewWindow-Struktur in eine Prozedur verpackt *)
CONST if=CAST(LONGINT,IDCMPFlagSet{});
      wf=CAST(LONGINT,WindowFlagSet{windowDrag,windowDepth, activate});
      screenflags=CAST(INTEGER,ScreenFlagSet{wbenchScreen});
BEGIN
  ASSEMBLE(
	RELOCATION (* erlaube die absolute Benutzung von Title *)
	DC.W	150,130,100,20 (* left top width height *)
	DC.B	0,1 (* detailPen blockPen *)
	DC.L	if,wf,0,0 (* idcmp, flags, firstGadget, checkMark *)
	DC.L	Title (* title *)
	DC.L	0,0 (* screen, bitMap *)
	DC.W	0,0,0,0 (* min..max *)
	DC.W	screenflags
 Title:	DC.B	'My Last Window!',0
 	EVEN	(* auf gerade Adresse! *)
  END);
END NewWin;

VAR
  nwPointer: POINTER TO Intuition.NewWindow;
  myWin: Intuition.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 *)
  nwPointer:=ADR(NewWin); (* OpenWindow braucht einen VAR-Parameter!*)
  myWin:=Intuition.OpenWindow(nwPointer^);
  Arts.Assert(myWin <> NIL, ADR(message));
  Delay(150);
(*
 * Der folgende Code wird am Programmende ausgeführt. Hier wird das
 * Fenster geschlossen, wenn es noch geöffnet ist.
 *)
CLOSE
  IF myWin#NIL THEN
    Intuition.CloseWindow(myWin);
    myWin:=NIL
  END;
END Features.