Оберон-клуб «ВЄДАsoft»

 
  FUNCTION _DIV(CONST x, y: INT64): INT64;
  FUNCTION _MOD(CONST x, y: INT64): INT64;
  FUNCTION _ASH (e, bit : INTEGER)  : INTEGER;
  FUNCTION _LSL(CONST x, y: INTEGER): INTEGER;
  FUNCTION _ASR(CONST x, y: INTEGER): INTEGER;
  FUNCTION _ROR(CONST x, y: INTEGER): INTEGER;
  FUNCTION _FLT(CONST i: INTEGER)   : SINGLE;
  FUNCTION _ITR(CONST i: INTEGER)   : SINGLE;
  FUNCTION _RTI(CONST r: SINGLE)    : INTEGER;
  FUNCTION _HTR(CONST i: INT64)     : DOUBLE;
  FUNCTION _RTH(CONST r: DOUBLE)    : INT64;
  FUNCTION _AND(CONST x, y: INTEGER): INTEGER;
  FUNCTION _HASH(p: POINTER; l: INTEGER): INTEGER;
 

 
  Type_   = CLASS
    ...
  END;
 
  Item    = CLASS
    ...
  END;
 
  Object_ = CLASS (Item)
    ...
  END;
 

 
  PROCEDURE Enter(name: ARRAY OF CHAR; clas: INTEGER; typ: Type_; val: LONGINT);
  PROCEDURE Create(VAR x: Type_; form: INTEGER; size: LONGINT);
 

 
  PROCEDURE Enter(name: ARRAY OF CHAR; clas: INTEGER; typ: Type_; val: LONGINT);
  VAR
    x: Object_;
  BEGIN
    ...
    x.c     := hidden;
    hidden  := x;
    ...
  END;
 

 
  PROCEDURE OpenScope;
  PROCEDURE CloseScope;
  PROCEDURE NewObj(VAR x: Object_; id: Ident; clas: INTEGER);
 

 
  x.dsc    := topScope;
  x.c      := NIL;
  topScope := x; 
  ...
  topScope := topScope.dsc
 

 
  INTEGER
  BOOLEAN
  O0
  O1
    O2
    O3
    O4
    O5
      O6
      O7
      O8
 

project1.exe 1.9Mb

 
  ItemDesc* = RECORD
      tag*: INTEGER;
      ...
  END ;
 
  ObjDesc* = RECORD (ItemDesc)
      next*: Object;
      ...
  END ;

 
  PROCEDURE NewObj(VAR x: Object_; id: Ident; clas: INTEGER);
  PROCEDURE Enter(name: ARRAY OF CHAR; clas: INTEGER; typ: Type_; val: LONGINT);
 

 
  ^ BOOLEAN
  ^ INTEGER
------ hidden (* Это метка для быстрого доступа к верхней ветке *)
  | O1
  | O2
  | ...
 

 
  ^ BOOLEAN
  ^ INTEGER
------ hidden (* Это метка для быстрого доступа к верхней ветке *)
  | Module1
    | O1
    | O2
      | O3
      | O4
    | O5
    | O6
  | Module2
    | O1
    | O2
  | ...
 

 
  ^ BOOLEAN
  ^ INTEGER
------ hidden (* Это метка для быстрого доступа к верхней ветке *)
  | Module1
    | O1 (* Не видит Module2.O1*)
    ...
  | Module2
    | O1 (* Не видит Module1.O1*)
  | ...
 

 
FUNCTION ThisObj(id: Ident): Object_;
VAR
  s, x: Object_;
BEGIN
  s := topScope;
  REPEAT
    x := s.c;
    WHILE (x <> NIL) AND (x.name <> id) DO x := x.c;
    s := s.dsc;
  UNTIL (x <> NIL) OR (s = NIL);
  RESULT := x;
END;
 

 
PROCEDURE FindInScope*(name: ARRAY OF CHAR; scope: Object; VAR res: Object);
VAR
  obj, head: Object;
  inRec: BOOLEAN;
BEGIN
  head := scope;
  inRec := FALSE;
  LOOP
    IF (head.link#NIL)&(head.link.mode=Typ) THEN	(*inside a record*)
      FindField(name, head.link.typ, obj, TRUE);
      IF inRec & (obj # NIL) & ~(obj.mode IN {Typ, Con}) THEN  err(200)  END;	(*a record inside a record, cannot access its fields/methods*)
      inRec := TRUE;
      IF (obj # NIL) OR head.link.typ.incomplete THEN  EXIT  END ;
    ELSE
      obj := head^.right;
      LOOP
        IF obj = NIL THEN EXIT END ;
        IF name < obj^.name THEN
           obj := obj^.left
        ELSIF name > obj^.name THEN
          obj := obj^.right
        ELSE (*found*)
          IF inRec & (head.link # NIL) & (head.link.mode # Mod) & ~(obj.mode IN {Typ, Con}) THEN err(200) END;	(*record accesses proc vars: illegal*)
          INCL(obj.flag, used);
          EXIT
        END
      END ;
      IF obj # NIL THEN EXIT END;
    END;
    head := head^.left;
    IF head = NIL THEN EXIT END
  END ;
  IF (obj # NIL) & (obj.mode < 0) THEN obj := NIL END;
  res := obj;
END FindInScope;
 

 
  PROCEDURE NEW(VAR x: Type_);
  PROCEDURE NEW(VAR x: Item); OVERLOAD;
  PROCEDURE NEW(VAR x: Object_); OVERLOAD;

 
  PROCEDURE Factor(VAR x: MCB.Item);
  PROCEDURE Term(VAR x: MCB.Item);
  PROCEDURE SimpleExpression(VAR x: MCB.Item);
  PROCEDURE Expression(VAR x: MCB.Item);
 

 
  PROCEDURE CheckTypes(op: INTEGER; VAR x, y: MCB.Item);