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.