Added MinosLinker source to A2

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@7372 8c9fc860-2736-0410-a75d-ab315db34111

source/MinosLinker.Mod

@@ -0,0 +1,340 @@
+MODULE MinosLinker;   (**  AUTHOR "fof"; PURPOSE "Link Minos Image. Standalone Linker taken from OSACompiler from Niklaus Wirth";  **)
+
+IMPORT Streams, Commands, Files, KernelLog;
+
+TYPE 
+	Name = ARRAY 32 OF CHAR;
+	Command = RECORD name: Name; offset: LONGINT END;
+	Module = POINTER TO RECORD
+		name: Name;
+		key:  LONGINT;
+		dbase, pbase: LONGINT;
+		size, refcnt: LONGINT;
+		next: Module;
+		entries: LONGINT;
+		entry: ARRAY 256 OF LONGINT;
+		command: ARRAY 64 OF Command;
+	END ;
+
+	Linker* = OBJECT
+	VAR 
+		first, last: Module;
+		base, heap, descriptorBase, bodyBase: LONGINT;
+		W: Streams.Writer;
+		Out: Files.File; Rout: Files.Writer;
+		code: ARRAY 256*1024 OF LONGINT;		(* tt: increased image size to one megabyte *)
+		plain, descriptors: BOOLEAN;
+
+		PROCEDURE &InitLinker* (w: Streams.Writer; plain, descriptors: BOOLEAN);
+		BEGIN W := w;
+			SELF.plain := plain; SELF.descriptors := descriptors;
+		END InitLinker;
+
+		PROCEDURE SetPos (pos: LONGINT);
+		BEGIN
+			Rout.Update;
+			IF pos > Out.Length () THEN
+				Files.OpenWriter(Rout, Out, Out.Length ());
+				pos := pos - Out.Length (); REPEAT Rout.Char (0X); DEC (pos) UNTIL pos = 0
+			ELSE Files.OpenWriter(Rout, Out, pos)
+			END;
+		END SetPos;
+
+		PROCEDURE WriteCodeBlock(len, adr: LONGINT);
+		VAR i: LONGINT;
+		BEGIN
+			IF plain THEN SetPos (adr - base) ELSE Rout.RawLInt (len); Rout.RawLInt (adr) END;
+			WHILE i < len DO Rout.RawLInt( code[i]); INC(i) END;
+			IF ~plain & (len # 0) THEN Rout.RawLInt( 0) END
+		END WriteCodeBlock;
+
+		PROCEDURE Fixup(fixloc, offset, base: LONGINT; VAR entry: ARRAY OF LONGINT);
+			VAR instr, next, pno: LONGINT;
+		BEGIN
+			WHILE fixloc # 0 DO
+				instr := code[fixloc]; next := instr MOD 10000H;
+				pno := instr DIV 10000H MOD 100H;
+				IF instr DIV 1000000H MOD 100H = 0EBH THEN  (* case  BL *)
+					instr := instr DIV 1000000H * 1000000H + (entry[pno] + offset - fixloc - 2) MOD 1000000H
+				ELSE (*indir. proc. address or indir. variable address *) instr := entry[pno]*4 + base
+				END ;
+				code[fixloc] := instr; fixloc := next
+			END
+		END Fixup;
+
+		PROCEDURE FixSelf(fixloc, base: LONGINT);
+			VAR instr, next: LONGINT;
+		BEGIN
+			WHILE fixloc # 0 DO
+				instr := code[fixloc]; next := instr MOD 10000H;
+				code[fixloc] := instr DIV 10000H * 4 + base; fixloc := next
+			END
+		END FixSelf;
+
+		PROCEDURE ThisMod(VAR modname: ARRAY OF CHAR; VAR success: BOOLEAN): Module;
+			VAR mod, imp: Module;
+				nofimp, nofentries, codelen, fix, fixself, i: LONGINT;
+				R: Files.Reader; F: Files.File;
+				name: Name;
+				key, datasize: LONGINT;
+				import: ARRAY 256 OF Module;			(* tt: Increased from 16 to 256 *)
+				fixroot: ARRAY 256 OF LONGINT;		(* tt: Increased from 16 to 256 *)
+
+		BEGIN
+			success := TRUE;
+			mod := first;
+			WHILE (mod # NIL) & (mod.name # modname) DO mod := mod.next END ;
+			IF mod = NIL THEN  (*load*)
+(*				W.String(" trying to load module with name: "); W.String(modname); W.Ln; W.Update; *)
+				F := ThisFile(modname);
+				IF F # NIL THEN
+					Files.OpenReader(R, F, 0);
+					NEW(mod); mod.next := NIL; mod.refcnt := 0;
+					R.RawString( mod.name); R.RawLInt( mod.key);
+					R.RawLInt( fixself);
+					R.RawString( name); success := TRUE; i := 0;
+					W.String( "module "); W.String( mod.name); W.String(" key: "); W.Hex( mod.key, -9); W.Ln();
+					WHILE (name[0] # 0X) & success DO
+						R.RawLInt (key); R.RawLInt (fix);
+(*						W.String ("    importing "); W.String(name); W.String(" Key: " );
+						W.Hex (key, 9); W.String(" fix: "); W.Int (fix, 6); W.Ln; W.Update;
+*)						imp := ThisMod(name, success);
+						IF imp # NIL THEN
+							IF (key = imp.key) THEN
+								import[i] := imp; INC (imp.refcnt); fixroot[i] := fix; INC(i)
+							ELSE success := FALSE;
+								W.String( name); W.String( " wrong version");
+								W.Ln(); W.Update();
+							END ;
+						ELSE success := FALSE;
+							W.String( name); W.String( " not found");
+							W.Ln();
+						END ;
+					R.RawString( name); W.Update()
+					END ;
+					nofimp := i;
+					IF success THEN
+						IF first = NIL THEN first := mod ELSE last.next := mod END; last := mod;
+						i := 0; R.RawString( mod.command[i].name);
+						WHILE mod.command[i].name[0] # 0X DO  (*skip commands*)
+							R.RawLInt( mod.command[i].offset); INC (i);
+							R.RawString( mod.command[i].name);
+						END ;
+						R.RawLInt( nofentries); R.RawLInt( mod.entry[0]); i := 0;
+						W.String("modEntry ="); W.Int(mod.entry[0],1); W.Ln;
+						WHILE i < nofentries DO INC(i); R.RawLInt( mod.entry[i]) END ; INC (i); mod.entry[i] := 0; mod.entries := i;
+						mod.dbase := heap; R.RawLInt( datasize); INC (heap, datasize); mod.pbase := heap;
+						R.RawLInt( codelen); mod.size := codelen*4; INC (heap, mod.size); i := 0;
+						WHILE i < codelen DO R.RawLInt( code[i]); INC(i) END ;
+						FixSelf(fixself, mod.pbase); i := 0;
+						WHILE i < nofimp DO
+							Fixup(fixroot[i], (import[i].pbase - mod.pbase) DIV 4, import[i].pbase, import[i].entry); INC(i)
+						END ;
+						W.String( "    loading "); W.String( mod.name);
+						W.Int( codelen*4, 6);
+						W.String(" ");
+						W.Hex( mod.dbase,-8);
+						W.String(" ");
+						W.Hex( mod.pbase,-8);
+						W.String(" ");
+						W.Hex( mod.entry[0]*4 + mod.pbase,-8);
+						WriteCodeBlock(codelen, mod.pbase)
+					END
+				ELSE
+					W.String( modname); W.String( " not found");
+					success := FALSE;
+				END;
+				W.Ln();  W.Update();
+			END ;
+			RETURN mod
+		END ThisMod;
+
+		PROCEDURE Bodies;
+		VAR len, base: LONGINT; mod: Module;
+		BEGIN
+			len := 0; base := heap; mod := first;
+			WHILE mod # NIL DO
+				code[len] := BodyBranch (mod, heap); INC (len); INC (heap, 4);
+				mod := mod.next;
+			END;
+			code[len] := Branch (heap, heap); INC (len); INC (heap, 4);
+			WriteCodeBlock (len, base);
+		END Bodies;
+
+		PROCEDURE String (VAR str: ARRAY OF CHAR; VAR index: LONGINT);
+		VAR i, len: LONGINT;
+		BEGIN
+			len := 0; WHILE str[len] # 0X DO INC (len) END; i := 0;
+			WHILE i <= len DO
+				code[index] := ORD (str[i]) + ORD (str[i+1]) * 100H + ORD (str[i+2]) * 10000H + ORD (str[i+3]) * 1000000H;
+				INC (index); INC (i, 4)
+			END;
+		END String;
+
+		PROCEDURE ModuleDescriptors;
+		VAR mod: Module; len, prevmod, prevcmd, i, cfix, efix: LONGINT;
+		BEGIN
+			mod := first; len := 0; prevmod := 0;
+			WHILE mod # NIL DO
+				(* Module *)
+(*		W.String (mod.name); W.String (": "); W.Hex (heap + len * 4,9); W.Ln; W.Update; *)
+				code[len] := prevmod; prevmod := heap + len * 4; INC (len);
+				code[len] := mod.key; INC (len);
+				code[len] := mod.dbase; INC (len);
+				code[len] := mod.pbase; INC (len);
+				code[len] := mod.size; INC (len);
+				code[len] := mod.refcnt; INC (len);
+				cfix := len; INC (len);
+				efix := len; INC (len);
+				String (mod.name, len);
+				(* Commands *)
+				i := 0; prevcmd := 0;
+				WHILE mod.command[i].name[0] # 0X DO
+(*		W.String ("   "); W.String (mod.command[i].name); W.String (":"); W.Hex (heap + len * 4,10); W.Hex (mod.command[i].offset,10); W.Ln; W.Update; *)
+					code[len] := prevcmd; prevcmd := heap + len * 4; INC (len);
+					code[len] := mod.command[i].offset; INC (len);
+					String (mod.command[i].name, len); INC (i)
+				END;
+				IF i # 0 THEN code[len] := 0; INC (len) END; (* sentinel *)
+				code[cfix] := prevcmd;
+				code[efix] := heap + len * 4; i := 0;
+
+(*			W.String ("   Entries:"); W.Ln; *)
+				WHILE i # mod.entries DO
+(* 			W.String ("      "); W.Int (i,0); W.String (": "); W.Hex (mod.entry[i], 0); W.Ln; *)
+					code[len] := mod.entry[i]; INC (len); INC (i);
+				END;
+				mod := mod.next;
+			END;
+			WriteCodeBlock (len, heap);
+			INC (heap, len * 4);
+			code[0] := prevmod;
+			WriteCodeBlock (1, descriptorBase);
+		END ModuleDescriptors;
+
+		PROCEDURE AddHeader(fileHeader: ARRAY OF CHAR; VAR success: BOOLEAN);
+		VAR
+			header: Files.File;
+			in: Files.Reader;
+			data, i: LONGINT;
+		BEGIN
+			i := 0;
+			IF fileHeader # "" THEN
+				header := Files.Old(fileHeader);
+				IF header = NIL THEN
+					W.String("Could not open header file "); W.String(fileHeader); W.Ln; W.Update;
+					success := FALSE;
+				ELSE
+			 		Files.OpenReader(in, header, 0);
+			 		WHILE in.Available() >= 4 DO
+			 			in.RawLInt(data); code[i] := data; INC(heap, 4); INC(i);
+			 		END;
+
+					WriteCodeBlock(i, base);
+				END;
+			END;
+		END AddHeader;
+
+		PROCEDURE Begin* (base: LONGINT; fileOut, fileHeader: ARRAY OF CHAR; VAR success: BOOLEAN);
+		BEGIN SELF.base := base; heap := base;
+			first := NIL; last := NIL;
+			Out := Files.New(fileOut);  Files.OpenWriter(Rout, Out, 0);
+			AddHeader(fileHeader, success);
+			bodyBase := heap;
+			IF plain THEN INC (heap, 4) END; (* jump to entry point *)
+			IF descriptors THEN descriptorBase := heap; INC (heap, 4) END; (* pointer to first module descriptor *)
+		END Begin;
+
+		PROCEDURE Link*(fileIn: ARRAY OF CHAR; VAR success: BOOLEAN);
+		VAR mod: Module;
+		BEGIN
+			success := TRUE;
+			mod := ThisMod(fileIn, success);
+		END Link;
+
+		PROCEDURE End*;
+		VAR link: LONGINT;
+			fileName: Files.FileName;
+		BEGIN
+			IF first = NIL THEN
+				W.String ("No output");
+			ELSE
+				IF descriptors THEN ModuleDescriptors END;
+				link := heap; Bodies;
+				IF plain THEN code[0] := Branch (link, bodyBase); WriteCodeBlock (1, bodyBase)
+				ELSE WriteCodeBlock (0, link) END;
+				Out.GetName(fileName); Rout.Update(); Files.Register(Out);
+				W.String("Wrote image file "); W.String(fileName); W.Ln;
+				W.String( "Output file length ="); W.Int( Out.Length(), -8); W.Char(' ');
+				W.String("First entry at "); W.Hex( first.entry[0]*4 + first.pbase, -9); W.Ln(); W.Update();
+				SELF.first := NIL; SELF.last := NIL; Out := NIL;
+			END;
+		END End;
+
+	END Linker;
+
+	PROCEDURE Branch (dest, pc: LONGINT): LONGINT;
+	BEGIN RETURN LONGINT(0EA000000H) + ((dest - pc) DIV 4 - 2) MOD 1000000H
+	END Branch;
+
+	PROCEDURE BranchLink (dest, pc: LONGINT): LONGINT;
+	BEGIN RETURN LONGINT(0EB000000H) + ((dest - pc) DIV 4 - 2) MOD 1000000H
+	END BranchLink;
+
+	PROCEDURE BodyBranch (m: Module; pc: LONGINT): LONGINT;
+	BEGIN RETURN BranchLink (m.pbase + m.entry[0] * 4, pc);
+	END BodyBranch;
+
+	PROCEDURE ThisFile(name: ARRAY OF CHAR): Files.File;
+		VAR i: INTEGER;
+	BEGIN i := 0;
+		WHILE name[i] # 0X DO INC(i) END ;
+		name[i] := "."; name[i+1] := "a"; name[i+2] := "r"; name[i+3] := "m"; name[i+4] := 0X;
+		RETURN Files.Old(name)
+	END ThisFile;
+
+VAR
+	log: Streams.Writer;   (* logger to KernelLog *)
+
+	PROCEDURE DoLink( linker: Linker; addHeaderFile: BOOLEAN; context: Commands.Context );
+	VAR S: Streams.Reader;  fileOut,fileIn, fileHeader: ARRAY 256 OF CHAR; base: LONGINT;
+		success: BOOLEAN; intRes: LONGINT;
+	BEGIN
+		success := TRUE;
+		S := context.arg;
+		IF addHeaderFile THEN
+			S.SkipWhitespace;  S.String( fileHeader );
+		ELSE
+			fileHeader := "";
+		END;
+		S.SkipWhitespace;  S.Int( base, TRUE );
+		S.SkipWhitespace;  S.String( fileOut );
+		Files.Delete(fileOut, intRes);				(* Try to delete an existing output file *)
+		linker.Begin (base, fileOut, fileHeader, success);
+		WHILE (S.res = Streams.Ok) & success DO
+			S.SkipWhitespace;  S.String( fileIn );
+			IF fileIn[0] # 0X THEN linker.Link (fileIn, success) END;
+		END;
+		IF success THEN linker.End; END;
+		SetLog(NIL);
+	END DoLink;
+
+	PROCEDURE Link*( context: Commands.Context );
+	VAR linker: Linker;
+	BEGIN
+		SetLog(context.out);
+		NEW (linker, log, TRUE, TRUE);
+		DoLink(linker, TRUE, context);
+		SetLog(NIL);
+	END Link;
+
+	PROCEDURE SetLog*( Log: Streams.Writer );
+	BEGIN
+		IF Log = NIL THEN NEW( log, KernelLog.Send, 512 ) ELSE log := Log END;
+	END SetLog;
+
+BEGIN
+	SetLog( NIL );
+END MinosLinker.
+
+SystemTools.Free MinosLinker ~