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 >
Oberon Text  |  1977-12-31  |  11KB  |  358 lines
  1. Syntax10.Scn.Fnt
  2. MODULE OPM;
  3. (* System dependant constants for the MC68020.
  4.  Diplomarbeit Samuel Urech
  5.  Programming language: Oberon-2 on Ceres-1.
  6.  Date: 30.10.92   Current version: 19.2.93 
  7.  changed for newer OP2s 10.5.96 *)
  8.  IMPORT Texts, Oberon, Files, SYSTEM;
  9.  CONST
  10.   ByteSize* = 1; CharSize* = 1; BoolSize* = 1; SetSize* = 4; SIntSize* = 1; IntSize* = 2;
  11.   LIntSize* = 4; RealSize* = 4; LRealSize* = 8; ProcSize* = 4; PointerSize* = 4;
  12.   nilval* = LONG( LONG( 0 ) );
  13.   MinSInt* = -80H;
  14.   MinInt* = -8000H;
  15.   MinLInt* =  80000000H; (*-2147483648*)
  16.   MinRealPat = 0FF7FFFFFH; (* most  negative, 32-bit pattern *)
  17.   MinLRealPatL = 0FFFFFFFFH; (* most  negative, lower 32-bit pattern *)
  18.   MinLRealPatH = 0FFEFFFFFH; (* most  negative, higher 32-bit pattern *)
  19.   MaxSInt* = 7FH;
  20.   MaxInt* = 7FFFH;
  21.   MaxLInt* = 7FFFFFFFH; (*2147483647*)
  22.   MaxRealPat* = 7F7FFFFFH;
  23.   MaxLRealPatL* = 0FFFFFFFFH;
  24.   MaxLRealPatH* = 7FEFFFFFH;
  25.   MaxSet* = 31;
  26.   MaxStruct*= 255; (* must be < 256 *)
  27.   MaxIndex* = MaxLInt; (* of array *)
  28.   MaxRExp* = 38; (* maximum exponent for REALs *)
  29.   MaxLExp* = 308; (* maximum exponent for LONGREALs *)
  30.   MaxHDig* = 8; (* maximum number of hexadecimal digits *)
  31.   CaseTrap* = 16;
  32.   FuncTrap* = 17;
  33.   MinHaltNr* = 20; (* 30 *)
  34.   MaxHaltNr* = 255; (* 127 *)
  35.   MaxSysFlag* = 0; (* not used so far *)
  36.   MaxCC* = 15; (* used for SYSTEM.CC*)
  37.   MinRegNr* = 0; (* SYSTEM.GETREG, PUTREG *)
  38.   MaxRegNr* = 23;
  39.   LANotAlloc* = -1; (* XProc link adr initialization *)
  40.   ConstNotAlloc* = 0; (* for allocation of string and real constants *)
  41.   TDAdrUndef* = -1; (* no type desc allocated *)
  42.   MaxCases* = 128; (* maximum number of cases in a case statement. *)
  43.   MaxCaseRange* = 512; (* maximum difference between least and greatest case label. *)
  44.   MaxHdFld* = 512; (* maximal number of hidden fields in an exported record: *)
  45.   ExpHdPtrFld* = TRUE;    HdPtrName* = "@ptr";    
  46.   ExpHdProcFld* = FALSE;    HdProcName* = "@proc";
  47.   ExpHdTProc* = TRUE;    HdTProcName* = "@tproc";
  48.   ExpVarAdr* = TRUE;
  49.   ExpParAdr* = TRUE;
  50.   NEWusingAdr* = FALSE;
  51.   Eot* = 0X;
  52.   SFext = ".Sym"; (* symbol file extension *)
  53.   OFext = ".Obj"; (* object file extension *)
  54.   SFtag = 0F9X; (* symbol file tag *)
  55.   OFtag = 0F1X; (* object file tag *)
  56.  TYPE
  57.   FileName = ARRAY 32 OF CHAR;
  58.   MinReal*, MaxReal* : REAL;
  59.   MinLReal*, MaxLReal* : LONGREAL;
  60.   noerr* : BOOLEAN;
  61.   curpos*, errpos* : LONGINT; (* character and error position in source file *)
  62.   breakpc* : LONGINT; (* set by OPV.Init *)
  63.   LRealPat : RECORD H, L : LONGINT END;
  64.   lastpos : LONGINT; (* last error position in source file *)
  65.   inR : Texts.Reader;
  66.   Log : Texts.Text;
  67.   W : Texts.Writer;
  68.   oldSF, newSF, ObjF, RefF : Files.Rider;
  69.   oldSFile, newSFile, ObjFile, RefFile : Files.File;
  70.  PROCEDURE Init*( source : Texts.Reader; log : Texts.Text );
  71.  BEGIN (* Init *)
  72.   inR := source;
  73.   Log := log;
  74.   noerr := TRUE;
  75.   curpos := Texts.Pos( inR );
  76.   errpos := curpos;
  77.   lastpos := curpos - 10;
  78.  END Init;
  79.  PROCEDURE Get*( VAR ch : CHAR );
  80.  (* Read next character from source text, 0X if eof *)
  81.  BEGIN (* Get *)
  82.   Texts.Read( inR, ch );
  83.   INC( curpos );
  84.  END Get;
  85.  PROCEDURE NewKey*( ) : LONGINT;
  86.  (* Generates a new module key. *)
  87.   VAR time, date : LONGINT;
  88.  BEGIN (* NewKey *)
  89.   Oberon.GetClock( time, date );
  90.   RETURN time DIV 4 * date
  91.  END NewKey;
  92.  PROCEDURE MakeFileName( VAR name, fName : ARRAY OF CHAR; ext : ARRAY OF CHAR );
  93.  (* Makes a file name from name and ext. *)
  94.   VAR i, j : INTEGER;
  95.     ch : CHAR;
  96.  BEGIN (* MakeFileName *)
  97.   i := 0;
  98.   WHILE name[ i ] # 0X DO
  99.    fName[ i ] := name[ i ];
  100.    INC( i );
  101.   END; (* WHILE *)
  102.   j := 0;
  103.   WHILE ext[ j ] # 0X DO
  104.    fName[ i ] := ext[ j ];
  105.    INC( i );
  106.    INC( j );
  107.   END; (* WHILE *)
  108.   fName[ i ] := 0X;
  109.  END MakeFileName;
  110.  (* ------------------------- Log Output ------------------------- *)
  111.  PROCEDURE LogW*( ch: CHAR );
  112.  BEGIN
  113.   Texts.Write( W, ch );
  114.   Texts.Append( Log, W.buf );
  115.  END LogW;
  116.  PROCEDURE LogWStr*( s : ARRAY OF CHAR );
  117.  BEGIN
  118.   Texts.WriteString( W, s );
  119.   Texts.Append( Log, W.buf );
  120.  END LogWStr;
  121.  PROCEDURE LogWNum*( i, len : LONGINT );
  122.  BEGIN
  123.   Texts.WriteInt( W, i, len );
  124.   Texts.Append( Log, W.buf );
  125.  END LogWNum;
  126.  PROCEDURE LogWLn*;
  127.  BEGIN
  128.   Texts.WriteLn( W );
  129.   Texts.Append( Log, W.buf );
  130.  END LogWLn;
  131.  PROCEDURE Mark*( n : INTEGER; pos : LONGINT );
  132.  (* Writes an error message to the log. *)
  133.  BEGIN
  134.   IF n >= 0 THEN
  135.    noerr := FALSE;
  136.    IF ( pos < lastpos ) OR ( lastpos + 9 < pos ) THEN
  137.     lastpos := pos;
  138.     LogWLn;
  139.     LogWStr( "  pos" ); LogWNum( pos, 6 );
  140.     IF n = 255 THEN LogWStr( "  pc " ); LogWNum( breakpc, 4 );
  141.     ELSIF n = 254 THEN LogWStr( "  pc not found" );
  142.     ELSE LogWStr( "  err" ); LogWNum( n, 4 );
  143.     END;
  144.    END;
  145.   ELSE
  146.    LogWLn;
  147.    LogWStr( "  pos" ); LogWNum( pos, 6 );
  148.    LogWStr( "  warning" ); LogWNum( -n, 4 );
  149.   END;
  150.  END Mark;
  151.  PROCEDURE err*( n : INTEGER );
  152.  BEGIN
  153.   Mark( n, errpos );
  154.  END err;
  155.  (* ------------------------- Read Symbol File ------------------------- *)
  156.  PROCEDURE SymRCh*( VAR b : CHAR );
  157.  BEGIN
  158.   Files.Read(oldSF, b)
  159.  END SymRCh;
  160.  PROCEDURE SymRTag*( VAR k : INTEGER );
  161.   VAR i : LONGINT;
  162.  BEGIN
  163.   Files.ReadNum( oldSF, i );
  164.   k := SHORT( i );
  165.  END SymRTag;
  166.  PROCEDURE SymRInt*( VAR k : LONGINT );
  167.  BEGIN
  168.   Files.ReadNum( oldSF, k )
  169.  END SymRInt;
  170.  PROCEDURE SymRLInt*( VAR k : LONGINT );
  171.  BEGIN
  172.   Files.ReadNum( oldSF, k );
  173.  END SymRLInt;
  174.  PROCEDURE SymRXInt*( VAR k : LONGINT );
  175.  BEGIN
  176.   Files.ReadNum( oldSF, k );
  177.  END SymRXInt;
  178.  PROCEDURE SymRSet*( VAR s : SET );
  179.  BEGIN
  180.   Files.ReadNum( oldSF, SYSTEM.VAL( LONGINT, s ) );
  181.  END SymRSet;
  182.  PROCEDURE SymRReal*( VAR r : REAL );
  183.  BEGIN
  184.   Files.ReadBytes( oldSF, r, RealSize );
  185.  END SymRReal;
  186.  PROCEDURE SymRLReal*( VAR lr : LONGREAL );
  187.  BEGIN
  188.   Files.ReadBytes( oldSF, lr, LRealSize );
  189.  END SymRLReal;
  190.  PROCEDURE CloseOldSym*;
  191.  END CloseOldSym;
  192.  PROCEDURE OldSym*( VAR modName : ARRAY OF CHAR; self : BOOLEAN; VAR done : BOOLEAN );
  193.  (* Open symbol file in read mode *)
  194.   VAR ch : CHAR; fileName : FileName;
  195.  BEGIN
  196.   MakeFileName( modName, fileName, SFext );
  197.   oldSFile := Files.Old( fileName );
  198.   done := oldSFile # NIL;
  199.   IF done THEN
  200.    Files.Set( oldSF, oldSFile, 0 );
  201.    SymRCh( ch );
  202.    IF ch # SFtag THEN err( 151 );  (* not a symbol file *)
  203.     CloseOldSym;
  204.     done := FALSE;
  205.    END;
  206.   ELSIF ~self THEN err( 152 )   (* symbol file not found *)
  207.   END
  208.  END OldSym;
  209.  PROCEDURE eofSF*( ) : BOOLEAN;
  210.  BEGIN
  211.   RETURN oldSF.eof
  212.  END eofSF;
  213.  (* ------------------------- Write Symbol File ------------------------- *)
  214.  PROCEDURE SymWCh*( ch : CHAR );
  215.  BEGIN
  216.   Files.Write( newSF, ch )
  217.  END SymWCh;
  218.  PROCEDURE SymWTag*( k : INTEGER );
  219.  BEGIN
  220.   Files.WriteNum( newSF, k )
  221.  END SymWTag;
  222.  PROCEDURE SymWInt*( i : LONGINT );
  223.  BEGIN
  224.   Files.WriteNum( newSF, i );
  225.  END SymWInt;
  226.  PROCEDURE SymWLInt*( k : LONGINT );
  227.  BEGIN
  228.   Files.WriteNum( newSF, k );
  229.  END SymWLInt;
  230.  PROCEDURE SymWSet*( s : SET );
  231.  BEGIN
  232.   Files.WriteNum( newSF, SYSTEM.VAL( LONGINT, s ) );
  233.  END SymWSet;
  234.  PROCEDURE SymWReal*( r : REAL );
  235.  BEGIN
  236.   Files.WriteBytes( newSF, r, RealSize );
  237.  END SymWReal;
  238.  PROCEDURE SymWLReal*( lr : LONGREAL );
  239.  BEGIN
  240.   Files.WriteBytes( newSF, lr, LRealSize );
  241.  END SymWLReal;
  242.  PROCEDURE RegisterNewSym*( VAR modName : ARRAY OF CHAR );
  243.  (* Delete possibly already existing file with the same name, register new created file. *)
  244.   VAR fileName : FileName;
  245.  BEGIN
  246.   MakeFileName( modName, fileName, SFext );
  247.   Files.Register( newSFile );
  248.  END RegisterNewSym;
  249.  PROCEDURE DeleteNewSym*;
  250.  (* Delete new created file, don't touch possibly already existing file with same name *)
  251.  END DeleteNewSym;
  252.  PROCEDURE NewSym*( VAR modName : ARRAY OF CHAR; VAR done : BOOLEAN );
  253.  (* Open new symbol file in write mode, don't touch possibly already existing file with same name. *)
  254.   VAR fileName : FileName;
  255.  BEGIN (* NewSym *)
  256.   MakeFileName( modName, fileName, SFext );
  257.   newSFile := Files.New( fileName );
  258.   done := newSFile # NIL;
  259.   IF done THEN
  260.    Files.Set( newSF, newSFile, 0 );
  261.    SymWCh( SFtag );
  262.   ELSE err( 153 );
  263.   END;
  264.  END NewSym;
  265.  PROCEDURE EqualSym*( VAR oldkey : LONGINT ) : BOOLEAN;
  266.  (* Compare old and new symbol file, close old file. *)
  267.   VAR ch0, ch1: CHAR; equal: BOOLEAN;
  268.  BEGIN
  269.   Files.Set( newSF, newSFile, 2 );
  270.   Files.ReadNum( newSF, oldkey );
  271.   Files.Set( oldSF, oldSFile, 2 );
  272.   Files.ReadNum( oldSF, oldkey );
  273.   REPEAT
  274.    Files.Read( oldSF, ch0 );
  275.    Files.Read( newSF, ch1 );
  276.   UNTIL ( ch0 # ch1 ) OR newSF.eof;
  277.   equal := oldSF.eof & newSF.eof;
  278.   CloseOldSym;
  279.   RETURN equal
  280.  END EqualSym;
  281.  (* ------------------------- Write Reference & Object Files ------------------------- *)
  282.  PROCEDURE RefW*( ch : CHAR );
  283.  BEGIN
  284.   Files.Write( RefF, ch );
  285.  END RefW;
  286.  PROCEDURE RefWInt*( n : LONGINT );
  287.  BEGIN
  288.   Files.WriteNum( RefF, n );
  289.  END RefWInt;
  290.  PROCEDURE RefWBytes*( VAR bytes : ARRAY OF SYSTEM.BYTE; n : LONGINT );
  291.  BEGIN
  292.   Files.WriteBytes( RefF, bytes, n );
  293.  END RefWBytes;
  294.  PROCEDURE ObjW*( ch : CHAR );
  295.  BEGIN
  296.   Files.Write( ObjF, ch )
  297.  END ObjW;
  298.  PROCEDURE ObjWInt*( i : INTEGER );
  299.  BEGIN
  300.   Files.Write( ObjF, CHR( i DIV 100H ) );
  301.   Files.Write( ObjF, CHR( i ) );
  302.  END ObjWInt;
  303.  PROCEDURE ObjWLInt*( i : LONGINT );
  304.  BEGIN
  305.   ObjWInt( SHORT( i DIV 10000H ) );
  306.   ObjWInt( SHORT( i MOD 10000H ) );
  307.  END ObjWLInt;
  308.  PROCEDURE ObjWBytes*( VAR bytes : ARRAY OF SYSTEM.BYTE; n : LONGINT );
  309.  BEGIN
  310.   Files.WriteBytes( ObjF, bytes, n );
  311.  END ObjWBytes;
  312.  PROCEDURE OpenRefObj*( VAR modName : ARRAY OF CHAR );
  313.   VAR fName : ARRAY 32 OF CHAR;
  314.     i : INTEGER;
  315.  BEGIN
  316.   RefFile := Files.New( "" ); Files.Set( RefF, RefFile, 0 );
  317.   MakeFileName( modName, fName, OFext );
  318.   ObjFile := Files.New( fName );
  319.   IF ObjFile # NIL THEN
  320.    Files.Set( ObjF, ObjFile, 0 );
  321.    ObjW( OFtag );
  322.    ObjW( "6" );
  323.    FOR i := 0 TO 7 DO ObjW( 0X ); END; (* space for reflen and refpos. *)
  324.   ELSE err( 153 );
  325.   END;
  326.  END OpenRefObj;
  327.  PROCEDURE CloseRefObj*;
  328.   VAR refpos, reflen : LONGINT;
  329.     ch : CHAR;
  330.     ref : Files.Rider;
  331.  BEGIN (* ref block *)
  332.   refpos := Files.Pos( ObjF );
  333.   reflen := Files.Pos( RefF );
  334.   ObjW( 88X );
  335.   Files.Set( ref, RefFile, 0 );
  336.   Files.Read( ref, ch );
  337.   WHILE ~ref.eof DO
  338.    ObjW( ch );
  339.    Files.Read( ref, ch );
  340.   END;
  341.   Files.Set( ObjF, ObjFile, 2 );
  342.   ObjWLInt( refpos );
  343.   ObjWLInt( reflen );
  344.   Files.Register( ObjFile );
  345.  END CloseRefObj;
  346. BEGIN
  347.  curpos := MinRealPat; SYSTEM.MOVE( SYSTEM.ADR( curpos ), SYSTEM.ADR( MinReal ), 4 ); (* -3.40282346E38 *)
  348.  curpos := MaxRealPat; SYSTEM.MOVE( SYSTEM.ADR( curpos ), SYSTEM.ADR( MaxReal ), 4 ); (* 3.40282346E38 *)
  349.  LRealPat.H := MinLRealPatH;
  350.  LRealPat.L := MinLRealPatL;
  351.  SYSTEM.MOVE( SYSTEM.ADR( LRealPat ), SYSTEM.ADR( MinLReal ), 8 ); (* -1.7976931348623157D308 *)
  352.  LRealPat.H := MaxLRealPatH;
  353.  LRealPat.L := MaxLRealPatL;
  354.  SYSTEM.MOVE( SYSTEM.ADR( LRealPat ), SYSTEM.ADR( MaxLReal ), 8 ); (* 1.7976931348623157D308 *)
  355.  Texts.OpenWriter( W );
  356.  Log := Oberon.Log;
  357. END OPM.
  358.