home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
jËzyki_programowania
/
oberon
/
system
/
opm.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1977-12-31
|
11KB
|
358 lines
Syntax10.Scn.Fnt
MODULE OPM;
(* System dependant constants for the MC68020.
Diplomarbeit Samuel Urech
Programming language: Oberon-2 on Ceres-1.
Date: 30.10.92 Current version: 19.2.93
changed for newer OP2s 10.5.96 *)
IMPORT Texts, Oberon, Files, SYSTEM;
CONST
ByteSize* = 1; CharSize* = 1; BoolSize* = 1; SetSize* = 4; SIntSize* = 1; IntSize* = 2;
LIntSize* = 4; RealSize* = 4; LRealSize* = 8; ProcSize* = 4; PointerSize* = 4;
nilval* = LONG( LONG( 0 ) );
MinSInt* = -80H;
MinInt* = -8000H;
MinLInt* = 80000000H; (*-2147483648*)
MinRealPat = 0FF7FFFFFH; (* most negative, 32-bit pattern *)
MinLRealPatL = 0FFFFFFFFH; (* most negative, lower 32-bit pattern *)
MinLRealPatH = 0FFEFFFFFH; (* most negative, higher 32-bit pattern *)
MaxSInt* = 7FH;
MaxInt* = 7FFFH;
MaxLInt* = 7FFFFFFFH; (*2147483647*)
MaxRealPat* = 7F7FFFFFH;
MaxLRealPatL* = 0FFFFFFFFH;
MaxLRealPatH* = 7FEFFFFFH;
MaxSet* = 31;
MaxStruct*= 255; (* must be < 256 *)
MaxIndex* = MaxLInt; (* of array *)
MaxRExp* = 38; (* maximum exponent for REALs *)
MaxLExp* = 308; (* maximum exponent for LONGREALs *)
MaxHDig* = 8; (* maximum number of hexadecimal digits *)
CaseTrap* = 16;
FuncTrap* = 17;
MinHaltNr* = 20; (* 30 *)
MaxHaltNr* = 255; (* 127 *)
MaxSysFlag* = 0; (* not used so far *)
MaxCC* = 15; (* used for SYSTEM.CC*)
MinRegNr* = 0; (* SYSTEM.GETREG, PUTREG *)
MaxRegNr* = 23;
LANotAlloc* = -1; (* XProc link adr initialization *)
ConstNotAlloc* = 0; (* for allocation of string and real constants *)
TDAdrUndef* = -1; (* no type desc allocated *)
MaxCases* = 128; (* maximum number of cases in a case statement. *)
MaxCaseRange* = 512; (* maximum difference between least and greatest case label. *)
MaxHdFld* = 512; (* maximal number of hidden fields in an exported record: *)
ExpHdPtrFld* = TRUE; HdPtrName* = "@ptr";
ExpHdProcFld* = FALSE; HdProcName* = "@proc";
ExpHdTProc* = TRUE; HdTProcName* = "@tproc";
ExpVarAdr* = TRUE;
ExpParAdr* = TRUE;
NEWusingAdr* = FALSE;
Eot* = 0X;
SFext = ".Sym"; (* symbol file extension *)
OFext = ".Obj"; (* object file extension *)
SFtag = 0F9X; (* symbol file tag *)
OFtag = 0F1X; (* object file tag *)
TYPE
FileName = ARRAY 32 OF CHAR;
MinReal*, MaxReal* : REAL;
MinLReal*, MaxLReal* : LONGREAL;
noerr* : BOOLEAN;
curpos*, errpos* : LONGINT; (* character and error position in source file *)
breakpc* : LONGINT; (* set by OPV.Init *)
LRealPat : RECORD H, L : LONGINT END;
lastpos : LONGINT; (* last error position in source file *)
inR : Texts.Reader;
Log : Texts.Text;
W : Texts.Writer;
oldSF, newSF, ObjF, RefF : Files.Rider;
oldSFile, newSFile, ObjFile, RefFile : Files.File;
PROCEDURE Init*( source : Texts.Reader; log : Texts.Text );
BEGIN (* Init *)
inR := source;
Log := log;
noerr := TRUE;
curpos := Texts.Pos( inR );
errpos := curpos;
lastpos := curpos - 10;
END Init;
PROCEDURE Get*( VAR ch : CHAR );
(* Read next character from source text, 0X if eof *)
BEGIN (* Get *)
Texts.Read( inR, ch );
INC( curpos );
END Get;
PROCEDURE NewKey*( ) : LONGINT;
(* Generates a new module key. *)
VAR time, date : LONGINT;
BEGIN (* NewKey *)
Oberon.GetClock( time, date );
RETURN time DIV 4 * date
END NewKey;
PROCEDURE MakeFileName( VAR name, fName : ARRAY OF CHAR; ext : ARRAY OF CHAR );
(* Makes a file name from name and ext. *)
VAR i, j : INTEGER;
ch : CHAR;
BEGIN (* MakeFileName *)
i := 0;
WHILE name[ i ] # 0X DO
fName[ i ] := name[ i ];
INC( i );
END; (* WHILE *)
j := 0;
WHILE ext[ j ] # 0X DO
fName[ i ] := ext[ j ];
INC( i );
INC( j );
END; (* WHILE *)
fName[ i ] := 0X;
END MakeFileName;
(* ------------------------- Log Output ------------------------- *)
PROCEDURE LogW*( ch: CHAR );
BEGIN
Texts.Write( W, ch );
Texts.Append( Log, W.buf );
END LogW;
PROCEDURE LogWStr*( s : ARRAY OF CHAR );
BEGIN
Texts.WriteString( W, s );
Texts.Append( Log, W.buf );
END LogWStr;
PROCEDURE LogWNum*( i, len : LONGINT );
BEGIN
Texts.WriteInt( W, i, len );
Texts.Append( Log, W.buf );
END LogWNum;
PROCEDURE LogWLn*;
BEGIN
Texts.WriteLn( W );
Texts.Append( Log, W.buf );
END LogWLn;
PROCEDURE Mark*( n : INTEGER; pos : LONGINT );
(* Writes an error message to the log. *)
BEGIN
IF n >= 0 THEN
noerr := FALSE;
IF ( pos < lastpos ) OR ( lastpos + 9 < pos ) THEN
lastpos := pos;
LogWLn;
LogWStr( " pos" ); LogWNum( pos, 6 );
IF n = 255 THEN LogWStr( " pc " ); LogWNum( breakpc, 4 );
ELSIF n = 254 THEN LogWStr( " pc not found" );
ELSE LogWStr( " err" ); LogWNum( n, 4 );
END;
END;
ELSE
LogWLn;
LogWStr( " pos" ); LogWNum( pos, 6 );
LogWStr( " warning" ); LogWNum( -n, 4 );
END;
END Mark;
PROCEDURE err*( n : INTEGER );
BEGIN
Mark( n, errpos );
END err;
(* ------------------------- Read Symbol File ------------------------- *)
PROCEDURE SymRCh*( VAR b : CHAR );
BEGIN
Files.Read(oldSF, b)
END SymRCh;
PROCEDURE SymRTag*( VAR k : INTEGER );
VAR i : LONGINT;
BEGIN
Files.ReadNum( oldSF, i );
k := SHORT( i );
END SymRTag;
PROCEDURE SymRInt*( VAR k : LONGINT );
BEGIN
Files.ReadNum( oldSF, k )
END SymRInt;
PROCEDURE SymRLInt*( VAR k : LONGINT );
BEGIN
Files.ReadNum( oldSF, k );
END SymRLInt;
PROCEDURE SymRXInt*( VAR k : LONGINT );
BEGIN
Files.ReadNum( oldSF, k );
END SymRXInt;
PROCEDURE SymRSet*( VAR s : SET );
BEGIN
Files.ReadNum( oldSF, SYSTEM.VAL( LONGINT, s ) );
END SymRSet;
PROCEDURE SymRReal*( VAR r : REAL );
BEGIN
Files.ReadBytes( oldSF, r, RealSize );
END SymRReal;
PROCEDURE SymRLReal*( VAR lr : LONGREAL );
BEGIN
Files.ReadBytes( oldSF, lr, LRealSize );
END SymRLReal;
PROCEDURE CloseOldSym*;
END CloseOldSym;
PROCEDURE OldSym*( VAR modName : ARRAY OF CHAR; self : BOOLEAN; VAR done : BOOLEAN );
(* Open symbol file in read mode *)
VAR ch : CHAR; fileName : FileName;
BEGIN
MakeFileName( modName, fileName, SFext );
oldSFile := Files.Old( fileName );
done := oldSFile # NIL;
IF done THEN
Files.Set( oldSF, oldSFile, 0 );
SymRCh( ch );
IF ch # SFtag THEN err( 151 ); (* not a symbol file *)
CloseOldSym;
done := FALSE;
END;
ELSIF ~self THEN err( 152 ) (* symbol file not found *)
END
END OldSym;
PROCEDURE eofSF*( ) : BOOLEAN;
BEGIN
RETURN oldSF.eof
END eofSF;
(* ------------------------- Write Symbol File ------------------------- *)
PROCEDURE SymWCh*( ch : CHAR );
BEGIN
Files.Write( newSF, ch )
END SymWCh;
PROCEDURE SymWTag*( k : INTEGER );
BEGIN
Files.WriteNum( newSF, k )
END SymWTag;
PROCEDURE SymWInt*( i : LONGINT );
BEGIN
Files.WriteNum( newSF, i );
END SymWInt;
PROCEDURE SymWLInt*( k : LONGINT );
BEGIN
Files.WriteNum( newSF, k );
END SymWLInt;
PROCEDURE SymWSet*( s : SET );
BEGIN
Files.WriteNum( newSF, SYSTEM.VAL( LONGINT, s ) );
END SymWSet;
PROCEDURE SymWReal*( r : REAL );
BEGIN
Files.WriteBytes( newSF, r, RealSize );
END SymWReal;
PROCEDURE SymWLReal*( lr : LONGREAL );
BEGIN
Files.WriteBytes( newSF, lr, LRealSize );
END SymWLReal;
PROCEDURE RegisterNewSym*( VAR modName : ARRAY OF CHAR );
(* Delete possibly already existing file with the same name, register new created file. *)
VAR fileName : FileName;
BEGIN
MakeFileName( modName, fileName, SFext );
Files.Register( newSFile );
END RegisterNewSym;
PROCEDURE DeleteNewSym*;
(* Delete new created file, don't touch possibly already existing file with same name *)
END DeleteNewSym;
PROCEDURE NewSym*( VAR modName : ARRAY OF CHAR; VAR done : BOOLEAN );
(* Open new symbol file in write mode, don't touch possibly already existing file with same name. *)
VAR fileName : FileName;
BEGIN (* NewSym *)
MakeFileName( modName, fileName, SFext );
newSFile := Files.New( fileName );
done := newSFile # NIL;
IF done THEN
Files.Set( newSF, newSFile, 0 );
SymWCh( SFtag );
ELSE err( 153 );
END;
END NewSym;
PROCEDURE EqualSym*( VAR oldkey : LONGINT ) : BOOLEAN;
(* Compare old and new symbol file, close old file. *)
VAR ch0, ch1: CHAR; equal: BOOLEAN;
BEGIN
Files.Set( newSF, newSFile, 2 );
Files.ReadNum( newSF, oldkey );
Files.Set( oldSF, oldSFile, 2 );
Files.ReadNum( oldSF, oldkey );
REPEAT
Files.Read( oldSF, ch0 );
Files.Read( newSF, ch1 );
UNTIL ( ch0 # ch1 ) OR newSF.eof;
equal := oldSF.eof & newSF.eof;
CloseOldSym;
RETURN equal
END EqualSym;
(* ------------------------- Write Reference & Object Files ------------------------- *)
PROCEDURE RefW*( ch : CHAR );
BEGIN
Files.Write( RefF, ch );
END RefW;
PROCEDURE RefWInt*( n : LONGINT );
BEGIN
Files.WriteNum( RefF, n );
END RefWInt;
PROCEDURE RefWBytes*( VAR bytes : ARRAY OF SYSTEM.BYTE; n : LONGINT );
BEGIN
Files.WriteBytes( RefF, bytes, n );
END RefWBytes;
PROCEDURE ObjW*( ch : CHAR );
BEGIN
Files.Write( ObjF, ch )
END ObjW;
PROCEDURE ObjWInt*( i : INTEGER );
BEGIN
Files.Write( ObjF, CHR( i DIV 100H ) );
Files.Write( ObjF, CHR( i ) );
END ObjWInt;
PROCEDURE ObjWLInt*( i : LONGINT );
BEGIN
ObjWInt( SHORT( i DIV 10000H ) );
ObjWInt( SHORT( i MOD 10000H ) );
END ObjWLInt;
PROCEDURE ObjWBytes*( VAR bytes : ARRAY OF SYSTEM.BYTE; n : LONGINT );
BEGIN
Files.WriteBytes( ObjF, bytes, n );
END ObjWBytes;
PROCEDURE OpenRefObj*( VAR modName : ARRAY OF CHAR );
VAR fName : ARRAY 32 OF CHAR;
i : INTEGER;
BEGIN
RefFile := Files.New( "" ); Files.Set( RefF, RefFile, 0 );
MakeFileName( modName, fName, OFext );
ObjFile := Files.New( fName );
IF ObjFile # NIL THEN
Files.Set( ObjF, ObjFile, 0 );
ObjW( OFtag );
ObjW( "6" );
FOR i := 0 TO 7 DO ObjW( 0X ); END; (* space for reflen and refpos. *)
ELSE err( 153 );
END;
END OpenRefObj;
PROCEDURE CloseRefObj*;
VAR refpos, reflen : LONGINT;
ch : CHAR;
ref : Files.Rider;
BEGIN (* ref block *)
refpos := Files.Pos( ObjF );
reflen := Files.Pos( RefF );
ObjW( 88X );
Files.Set( ref, RefFile, 0 );
Files.Read( ref, ch );
WHILE ~ref.eof DO
ObjW( ch );
Files.Read( ref, ch );
END;
Files.Set( ObjF, ObjFile, 2 );
ObjWLInt( refpos );
ObjWLInt( reflen );
Files.Register( ObjFile );
END CloseRefObj;
BEGIN
curpos := MinRealPat; SYSTEM.MOVE( SYSTEM.ADR( curpos ), SYSTEM.ADR( MinReal ), 4 ); (* -3.40282346E38 *)
curpos := MaxRealPat; SYSTEM.MOVE( SYSTEM.ADR( curpos ), SYSTEM.ADR( MaxReal ), 4 ); (* 3.40282346E38 *)
LRealPat.H := MinLRealPatH;
LRealPat.L := MinLRealPatL;
SYSTEM.MOVE( SYSTEM.ADR( LRealPat ), SYSTEM.ADR( MinLReal ), 8 ); (* -1.7976931348623157D308 *)
LRealPat.H := MaxLRealPatH;
LRealPat.L := MaxLRealPatL;
SYSTEM.MOVE( SYSTEM.ADR( LRealPat ), SYSTEM.ADR( MaxLReal ), 8 ); (* 1.7976931348623157D308 *)
Texts.OpenWriter( W );
Log := Oberon.Log;
END OPM.