ooc-compiler

[ooc-compiler] wrapper to SYSTEM.VAL

[Norayr C. <ch...@gm...>]

Hey,
I am porting Ulm's Oberon Library to use with ooc.
All separate definition/implementation modules are already merged, and I
have managed to compile some set of modules.
Every occurence of INTEGER also must be changed to the LONGINT. I don't deal
with it now, because LONGINT in Ulm's system also may be used as an ADDRESS,
so, I would like to review every occurence and change it according to the
context later.

So, most important parts of the library use the SYSTEM module described
here: http://www.mathematik.uni-ulm.de/oberon/current/lib/man/SYSTEM.html
and SYSTEM.UNIXCALL calls.
I have created a wrapper module ULMSYSTEM.Mod, which currently has the
following state:

MODULE ULMSYSTEM;
(* Norayr Chilingaryan, 2010
This module is a wrapper which emulates SYSTEM module of Ulm's Oberon
Library *)

IMPORT SYSTEM;

TYPE INT16* = INTEGER (*oo2c's INTEGER is 2 bytes long, norayr*) (* 2-byte
integer type *);
TYPE ADDRESS* = SYSTEM.ADDRESS (*in oo2c SYSTEM.ADDRESS is 4 bytes long on
32bit systems and 8 bytes long on 64bit systems, norayr *) (*
LONGINT-compatible & traced by the GC *);
TYPE UNTRACEDADDRESS* = SYSTEM.ADDRESS (* see above line, norayr *)(*
LONGINT-compatible & ignored by the GC *);
TYPE BYTE* = SYSTEM.BYTE; (* added by me because of existence of BYTE in
ULMs library. For instance, needed by Types.Mod, norayr *)

PROCEDURE TAS*(VAR flag : BOOLEAN): BOOLEAN;
VAR tmpfl: BOOLEAN;
BEGIN
   tmpfl := flag;
   flag := TRUE;
   RETURN tmpfl
END TAS;

PROCEDURE VAL*(type: AnyTypeName; value: AnyType) : type;
BEGIN
RETURN SYSTEM.VAL(type, value);
END VAL;

END ULMSYSTEM.

So, is it possible in principle to create a VAL wrapper, by taking in
consideration that it is implemented on the compiler level actually.
Usually, modules in Ulm's library import SYSTEM by using SYS alias, like
this:
IMPORT SYS:=SYSTEM
which I replace by SYS := ULMSYSTEM
It is of course possible to change every occurence of SYS.VAL by the
SYSTEM.VAL, but I consider it as a dirty option.
It is also possible to wrap VAL by using C implementation, what I also would
like to avoid for now.

Any ideas, Stewart? (or anybody besides you still read this mail list?)

Sincerely,
Norayr

Re: [ooc-compiler] wrapper to SYSTEM.VAL

[Duke N. <duk...@ml...>]

On Sat, 2 Oct 2010, Norayr Chilingaryan wrote:

Hello Norayr

[snip]

> Any ideas, Stewart? (or anybody besides you still read this mail list?)

No ideas! I'm an Oberon noob. However I'll be listening in with much
interest. Also now we know that there's at least 2 of us reading this
list :) L8r...
-- 
Duke

Re: [ooc-compiler] wrapper to SYSTEM.VAL

[Stewart G. <sgr...@us...>]

Hi Norayr,

On 2/10/10 5:42 AM, Norayr Chilingaryan wrote:
[...]
> So, is it possible in principle to create a VAL wrapper, by taking in
> consideration that it is implemented on the compiler level actually.
> Usually, modules in Ulm's library import SYSTEM by using SYS alias, like
> this:
> IMPORT SYS:=SYSTEM
> which I replace by SYS := ULMSYSTEM
> It is of course possible to change every occurence of SYS.VAL by the
> SYSTEM.VAL, but I consider it as a dirty option.
> It is also possible to wrap VAL by using C implementation, what I also
> would like to avoid for now.

You can't wrap the SYSTEM.VAL function because it is implemented in the 
compiler. There's no way to pass type parameters to Oberon-2 procedures; 
although OOC supports generics, this only works for Object types. I 
think the solution you suggested is probably the best option, though as 
you say it is not ideal.

Cheers,
   Stewart

Re: [ooc-compiler] wrapper to SYSTEM.VAL

[Norayr C. <ch...@gm...>]

MODULE test;
IMPORT SYSTEM;
PROCEDURE ToInt16*(int: LONGINT) : INTEGER;
BEGIN
    RETURN SYSTEM.VAL(INTEGER, int)
END ToInt16;


END test.

test.Mod:5:32: Size mismatch between type and expression

Is it normal behavour to not permit LONGINT->INTEGER cast?
I am still translating Types.Mod from Ulm library.
Types.Mod contains type conversions. It is supposed that people will use
Types exported functions like ToInt16, ToInt32 instead of importing SYSTEM
and use VAL in their higher level modules.

This is why I have this question.
In Ulm's compiler, according to the docs:
*VAL* allows a large number of system-dependent type conversions. It permits
any numerical type to be converted to any other numerical type. Other type
conversions are supported only if both, type and the type of value, occupy
the same number of bytes.
However, Wirth report states:

Name	 |  Argument types	  |  Result type|  Function
_________|________________________|_____________|____________________________

VAL(T, x)|  T, x: any type	  |  T		|  x interpreted as of type T

ooc's reference manual for SYSTEM module is incomplete.

Sincerely,
Norayr

On Mon, Oct 4, 2010 at 6:53 AM, Stewart Greenhill
<sgr...@us...>wrote:

> Hi Norayr,
>
> On 2/10/10 5:42 AM, Norayr Chilingaryan wrote:
> [...]
>
>  So, is it possible in principle to create a VAL wrapper, by taking in
>> consideration that it is implemented on the compiler level actually.
>> Usually, modules in Ulm's library import SYSTEM by using SYS alias, like
>> this:
>> IMPORT SYS:=SYSTEM
>> which I replace by SYS := ULMSYSTEM
>> It is of course possible to change every occurence of SYS.VAL by the
>> SYSTEM.VAL, but I consider it as a dirty option.
>> It is also possible to wrap VAL by using C implementation, what I also
>> would like to avoid for now.
>>
>
> You can't wrap the SYSTEM.VAL function because it is implemented in the
> compiler. There's no way to pass type parameters to Oberon-2 procedures;
> although OOC supports generics, this only works for Object types. I think
> the solution you suggested is probably the best option, though as you say it
> is not ideal.
>
> Cheers,
>  Stewart
>

Re: [ooc-compiler] wrapper to SYSTEM.VAL

[Stewart G. <sgr...@us...>]

Hi Norayr,

Normally, you would to a LONGINT->INTEGER conversion like this:
   RETURN SHORT(int);

Personally I'm not a fan of SHORT. It requires you to know the size of 
the original types in order to figure out how many SHORTs are required 
to do the conversion. So a LONGINT -> SHORTINT conversion goes:
   RETURN SHORT(SHORT(int));
...but you can't for example convert an arbitrary integer type to a 
SHORTINT.

It looks like OOC's interpretation of SYSTEM.VAL requires it to be a 
pure type-cast. Normally you would use it like this for casting pointer 
types. You would need to explicitly SHORTen the argument if casting to a 
smaller size. Since conversion between numeric types is supported in the 
language anyway its probably not a big problem.

Cheers,
   Stewart

On 5/10/10 3:19 AM, Norayr Chilingaryan wrote:
> MODULE test;
> IMPORT SYSTEM;
> PROCEDURE ToInt16*(int: LONGINT) : INTEGER;
> BEGIN
>      RETURN SYSTEM.VAL(INTEGER, int)
> END ToInt16;
>
>
> END test.
>
> test.Mod:5:32: Size mismatch between type and expression
>
> Is it normal behavour to not permit LONGINT->INTEGER cast?
> I am still translating Types.Mod from Ulm library.
> Types.Mod contains type conversions. It is supposed that people will use
> Types exported functions like ToInt16, ToInt32 instead of importing
> SYSTEM and use VAL in their higher level modules.
>
> This is why I have this question.
> In Ulm's compiler, according to the docs:
> *VAL* allows a large number of system-dependent type conversions. It
> permits any numerical type to be converted to any other numerical type.
> Other type conversions are supported only if both, type and the type of
> value, occupy the same number of bytes.
> However, Wirth report states:
>
> Name	|Argument  types	|Result  type|Function
> _________|________________________|_____________|____________________________
>
> VAL(T,x)|T,x: any type	  |T		|x  interpreted as of typeT
>
> ooc's reference manual for SYSTEM module is incomplete.
>
> Sincerely,
> Norayr
>
> On Mon, Oct 4, 2010 at 6:53 AM, Stewart Greenhill
> <sgr...@us... <mailto:sgr...@us...>> wrote:
>
>     Hi Norayr,
>
>     On 2/10/10 5:42 AM, Norayr Chilingaryan wrote:
>     [...]
>
>         So, is it possible in principle to create a VAL wrapper, by
>         taking in
>         consideration that it is implemented on the compiler level actually.
>         Usually, modules in Ulm's library import SYSTEM by using SYS
>         alias, like
>         this:
>         IMPORT SYS:=SYSTEM
>         which I replace by SYS := ULMSYSTEM
>         It is of course possible to change every occurence of SYS.VAL by the
>         SYSTEM.VAL, but I consider it as a dirty option.
>         It is also possible to wrap VAL by using C implementation, what
>         I also
>         would like to avoid for now.
>
>
>     You can't wrap the SYSTEM.VAL function because it is implemented in
>     the compiler. There's no way to pass type parameters to Oberon-2
>     procedures; although OOC supports generics, this only works for
>     Object types. I think the solution you suggested is probably the
>     best option, though as you say it is not ideal.
>
>     Cheers,
>       Stewart
>
>
>
>
> ------------------------------------------------------------------------------
> Virtualization is moving to the mainstream and overtaking non-virtualized
> environment for deploying applications. Does it make network security
> easier or more difficult to achieve? Read this whitepaper to separate the
> two and get a better understanding.
> http://p.sf.net/sfu/hp-phase2-d2d
>
>
>
> _______________________________________________
> ooc-compiler mailing list
> ooc...@li...
> https://lists.sourceforge.net/lists/listinfo/ooc-compiler

Re: [ooc-compiler] wrapper to SYSTEM.VAL

[Norayr C. <ch...@gm...>]

Hello, yet another question which came out during library porting work.
MODULE test2;

TYPE T1 = POINTER TO TRec;
     TRec = RECORD
     a : INTEGER
     END;

TYPE T2 = POINTER TO T2Rec;
     T2Rec = RECORD (TRec)
     b : REAL
     END;
VAR p1 : T1;
    p2 : T2;

PROCEDURE aaa (VAR p : T1);
BEGIN

END aaa;

BEGIN
p2 := NEW(T2);
p1 := NEW(T1);
aaa(p2);

END test2.

So, this won't compile unless:
we change procedure to PROCEDURE aaa (p : T1); i. e. without VAR
or
pointer passed to the procedure is not a pointer to the extended type, so
aaa(p1) will work.

Are that restrictions intentional?
What would be an optimal (or nicer) workaround to solve this if I need to
compile library which have been written like this.

Thank you
Norayr

On Tue, Oct 5, 2010 at 6:54 AM, Stewart Greenhill
<sgr...@us...>wrote:

> Hi Norayr,
>
> Normally, you would to a LONGINT->INTEGER conversion like this:
>  RETURN SHORT(int);
>
> Personally I'm not a fan of SHORT. It requires you to know the size of the
> original types in order to figure out how many SHORTs are required to do the
> conversion. So a LONGINT -> SHORTINT conversion goes:
>  RETURN SHORT(SHORT(int));
> ...but you can't for example convert an arbitrary integer type to a
> SHORTINT.
>
> It looks like OOC's interpretation of SYSTEM.VAL requires it to be a pure
> type-cast. Normally you would use it like this for casting pointer types.
> You would need to explicitly SHORTen the argument if casting to a smaller
> size. Since conversion between numeric types is supported in the language
> anyway its probably not a big problem.
>
> Cheers,
>  Stewart
>
>
> On 5/10/10 3:19 AM, Norayr Chilingaryan wrote:
>
>> MODULE test;
>> IMPORT SYSTEM;
>> PROCEDURE ToInt16*(int: LONGINT) : INTEGER;
>> BEGIN
>>     RETURN SYSTEM.VAL(INTEGER, int)
>> END ToInt16;
>>
>>
>> END test.
>>
>> test.Mod:5:32: Size mismatch between type and expression
>>
>> Is it normal behavour to not permit LONGINT->INTEGER cast?
>> I am still translating Types.Mod from Ulm library.
>> Types.Mod contains type conversions. It is supposed that people will use
>> Types exported functions like ToInt16, ToInt32 instead of importing
>> SYSTEM and use VAL in their higher level modules.
>>
>> This is why I have this question.
>> In Ulm's compiler, according to the docs:
>> *VAL* allows a large number of system-dependent type conversions. It
>> permits any numerical type to be converted to any other numerical type.
>> Other type conversions are supported only if both, type and the type of
>> value, occupy the same number of bytes.
>> However, Wirth report states:
>>
>> Name    |Argument  types        |Result  type|Function
>>
>> _________|________________________|_____________|____________________________
>>
>> VAL(T,x)|T,x: any type    |T            |x  interpreted as of typeT
>>
>> ooc's reference manual for SYSTEM module is incomplete.
>>
>> Sincerely,
>> Norayr
>>
>> On Mon, Oct 4, 2010 at 6:53 AM, Stewart Greenhill
>> <sgr...@us... <mailto:sgr...@us...>> wrote:
>>
>>    Hi Norayr,
>>
>>    On 2/10/10 5:42 AM, Norayr Chilingaryan wrote:
>>    [...]
>>
>>        So, is it possible in principle to create a VAL wrapper, by
>>        taking in
>>        consideration that it is implemented on the compiler level
>> actually.
>>        Usually, modules in Ulm's library import SYSTEM by using SYS
>>        alias, like
>>        this:
>>        IMPORT SYS:=SYSTEM
>>        which I replace by SYS := ULMSYSTEM
>>        It is of course possible to change every occurence of SYS.VAL by
>> the
>>        SYSTEM.VAL, but I consider it as a dirty option.
>>        It is also possible to wrap VAL by using C implementation, what
>>        I also
>>        would like to avoid for now.
>>
>>
>>    You can't wrap the SYSTEM.VAL function because it is implemented in
>>    the compiler. There's no way to pass type parameters to Oberon-2
>>    procedures; although OOC supports generics, this only works for
>>    Object types. I think the solution you suggested is probably the
>>    best option, though as you say it is not ideal.
>>
>>    Cheers,
>>      Stewart
>>
>>
>>
>>
>>
>> ------------------------------------------------------------------------------
>> Virtualization is moving to the mainstream and overtaking non-virtualized
>> environment for deploying applications. Does it make network security
>> easier or more difficult to achieve? Read this whitepaper to separate the
>> two and get a better understanding.
>> http://p.sf.net/sfu/hp-phase2-d2d
>>
>>
>>
>> _______________________________________________
>> ooc-compiler mailing list
>> ooc...@li...
>> https://lists.sourceforge.net/lists/listinfo/ooc-compiler
>>
>
>

Re: [ooc-compiler] wrapper to SYSTEM.VAL

[Stewart G. <sgr...@ii...>]

Hi Norayr,

I think the restriction is correct.

This can be confusing, but think of it like this: if your parameter is 
declared "aaa(VAR p : T1)" then it means the procedure can write ANY 
value of type T1 to p. Sure, T2 is a subtype of T1 but there are other 
subtypes of T1 which are not also T2. It would be an error for the 
compiler to allow aaa(p2) because you could then assign something to p2 
which is not a subtype of T2. For example:

PROCEDURE aaa (VAR p : T1);
BEGIN
   NEW(p);  (* assign new instance of T1 to p *)
END aaa;

Now, allowing aaa(p2) would break the type system.

Its hard to say how to best handle this without knowing some more 
details of what you're trying to do. This sort of pattern could work:

VAR
   p1 : T1;
...
   p1 := NEW(T2);
   aaa(p1);

Cheers,
   Stewart

On 6/10/10 1:18 AM, Norayr Chilingaryan wrote:
 > Hello, yet another question which came out during library porting work.
 > MODULE test2;
 >
 > TYPE T1 = POINTER TO TRec;
 >       TRec = RECORD
 >       a : INTEGER
 >       END;
 >
 > TYPE T2 = POINTER TO T2Rec;
 >       T2Rec = RECORD (TRec)
 >       b : REAL
 >       END;
 > VAR p1 : T1;
 >      p2 : T2;
 >
 > PROCEDURE aaa (VAR p : T1);
 > BEGIN
 >
 > END aaa;
 >
 > BEGIN
 > p2 := NEW(T2);
 > p1 := NEW(T1);
 > aaa(p2);
 >
 > END test2.
 >
 > So, this won't compile unless:
 > we change procedure to PROCEDURE aaa (p : T1); i. e. without VAR
 > or
 > pointer passed to the procedure is not a pointer to the extended type,
 > so aaa(p1) will work.
 >
 > Are that restrictions intentional?
 > What would be an optimal (or nicer) workaround to solve this if I need
 > to compile library which have been written like this.
 >
 > Thank you
 > Norayr
[...]

Re: [ooc-compiler] wrapper to SYSTEM.VAL

[Norayr C. <ch...@gm...>]

Hey,
thank you for reply.
ok, I see, indeed.

So, here we have Resources.Mod from Ulm's Oberon LIbrary which contains:

   TYPE
      List = POINTER TO ListRec;
      ListRec =
     RECORD
        resource: Resource;
        next: List;
     END;
      Discipline = POINTER TO DisciplineRec;
      DisciplineRec =
     RECORD
        (Disciplines.DisciplineRec)
        state: State;           (* alive, unreferenced, or terminated *)
        stopped: BOOLEAN;       (* may be TRUE, if alive or unreferenced *)
        refcnt: LONGINT;        (* # of Attach - # of Detach *)
        eventType: Events.EventType; (* may be NIL *)
        dependants: List;       (* list of resources which depends on us *)
        dependsOn: Resource;    (* we depend on this resource *)
        key: Key;               (* attach key for dependsOn *)
     END;

...

   PROCEDURE GetDisc(resource: Resource; VAR disc: Discipline);
   BEGIN
     IF ~Disciplines.Seek(resource, discID, disc) THEN
     NEW(disc); disc.id := discID;
     disc.state := alive; disc.refcnt := 0;
     disc.eventType := NIL;
     disc.dependants := NIL; disc.dependsOn := NIL;
     Disciplines.Add(resource, disc);
   END;
   END GetDisc;

Procedure GetDisc is called a lot of times:
hacktar ulmoberonlib # grep GetDisc *
Resources.Mod:   PROCEDURE GetDisc(resource: Resource; VAR disc:
Discipline);
Resources.Mod:   END GetDisc;
Resources.Mod:      GetDisc(resource, disc);
Resources.Mod:      GetDisc(resource, resourceDisc);
Resources.Mod:      GetDisc(dependant, dependantDisc);
Resources.Mod:      GetDisc(resource, disc);
Resources.Mod:      GetDisc(resource, disc);
Resources.Mod:      GetDisc(resource, disc);
Resources.Mod:     GetDisc(resource, disc);
Resources.Mod:     GetDisc(resource, disc);
Resources.Mod:      GetDisc(resource, resourceDisc);
Resources.Mod:      GetDisc(dependant, dependantDisc);
Resources.Mod:      GetDisc(resource, disc);
Resources.Mod:      GetDisc(resource, disc);
Resources.Mod:      GetDisc(resource, disc);
hacktar ulmoberonlib #

like this:

  PROCEDURE GenEvent(resource: Resource; change: StateChange);
      VAR
     disc: Discipline;
     event: Event;
   BEGIN
      GetDisc(resource, disc);
      IF disc.eventType # NIL THEN
     NEW(event);
     event.type := disc.eventType;
     event.message := "Resources: state change notification";
     event.change := change;
     event.resource := resource;
     Events.Raise(event);
      END;
   END GenEvent;

   PROCEDURE ^ Detach(resource: Resource; key: Key);
   PROCEDURE Unlink(dependant, resource: Resource);
      (* undo DependsOn operation *)
      VAR
     dependantDisc, resourceDisc: Discipline;
     prev, member: List;
   BEGIN
      GetDisc(resource, resourceDisc);
      IF resourceDisc.state = terminated THEN
     (* no necessity for clean up *)
     RETURN
      END;
      GetDisc(dependant, dependantDisc);

      prev := NIL; member := resourceDisc.dependants;
      WHILE member.resource # dependant DO
     prev := member; member := member.next;
      END;
      IF prev = NIL THEN
     resourceDisc.dependants := member.next;
      ELSE
     prev.next := member.next;
      END;

      (* Detach reference from dependant to resource *)
      Detach(dependantDisc.dependsOn, dependantDisc.key);
      dependantDisc.dependsOn := NIL; dependantDisc.key := NIL;
   END Unlink;


   PROCEDURE InternalNotify(resource: Resource; change: StateChange);
      VAR
     disc: Discipline;
     event: Event;
     dependant: List;
   BEGIN
      GetDisc(resource, disc);
      CASE change OF
      | communicationResumed: disc.stopped := FALSE;
      | communicationStopped: disc.stopped := TRUE;
      | terminated:           disc.stopped := FALSE; disc.state :=
terminated;
      END;
      GenEvent(resource, change);

      (* notify all dependants *)
      dependant := disc.dependants;
      WHILE dependant # NIL DO
     InternalNotify(dependant.resource, change);
     dependant := dependant.next;
      END;

      (* remove dependency relation in case of termination, if present *)
      IF (change = terminated) & (disc.dependsOn # NIL) THEN
     Unlink(resource, disc.dependsOn);
      END;
   END InternalNotify;

   (* === exported procedures =========================================== *)

   PROCEDURE TakeInterest*(resource: Resource; VAR eventType:
Events.EventType);
      (* return resource specific event type for state notifications;
     eventType is guaranteed to be # NIL even if
     the given resource is already terminated
      *)
      VAR
     disc: Discipline;
   BEGIN
      GetDisc(resource, disc);
      IF disc.eventType = NIL THEN
     Events.Define(disc.eventType);
     Events.Ignore(disc.eventType);
      END;
      eventType := disc.eventType;
   END TakeInterest;

   PROCEDURE Attach*(resource: Resource; VAR key: Key);
      (* mark the resource as being used until Detach gets called *)
      VAR
     disc: Discipline;
   BEGIN
      GetDisc(resource, disc);
      IF disc.state IN {terminated, unreferenced} THEN
     key := NIL;
      ELSE
     INC(disc.refcnt); NEW(key); key.valid := TRUE;
     key.resource := resource;
      END;
   END Attach;

   PROCEDURE Detach*(resource: Resource; key: Key);
      (* mark the resource as unused; the returned key of Attach must
     be given -- this allows to check for proper balances
     of Attach/Detach calls;
     the last Detach operation causes a state change to unreferenced
      *)
      VAR
     disc: Discipline;
   BEGIN
      IF (key # NIL) & key.valid & (key.resource = resource) THEN
     GetDisc(resource, disc);
     IF disc.state # terminated THEN
        key.valid := FALSE; DEC(disc.refcnt);
        IF disc.refcnt = 0 THEN
           GenEvent(resource, unreferenced);
           disc.state := unreferenced;
           IF disc.dependsOn # NIL THEN
          Unlink(resource, disc.dependsOn);
           END;
        END;
     END;
      END;
   END Detach;

   PROCEDURE Notify*(resource: Resource; change: StateChange);
      (* notify all interested parties about the new state;
     only valid state changes are accepted:
     - Notify doesn't accept any changes after termination
     - unreferenced is generated conditionally by Detach only
     - communicationResumed is valid after communicationStopped only
     valid notifications are propagated to all dependants (see below);
      *)
      VAR
     disc: Discipline;
     event: Event;
     dependant: List;
   BEGIN
      IF change # unreferenced THEN
     GetDisc(resource, disc);
     IF (disc.state # terminated) & (disc.state # change) &
           ((change # communicationResumed) OR disc.stopped) THEN
        InternalNotify(resource, change);
     END;
      END;
   END Notify;

   PROCEDURE DependsOn*(dependant, resource: Resource);
      (* states that `dependant' depends entirely on `resource' --
     this is usually the case if operations on `dependant'
     are delegated to `resource';
     only one call of DependsOn may be given per `dependant' while
     several DependsOn for one resource are valid;
     DependsOn calls implicitly Attach for resource and
     detaches if the dependant becomes unreferenced;
     all other state changes propagate from `resource' to
     `dependant'
      *)
      VAR
     dependantDisc, resourceDisc: Discipline;
     member: List;
   BEGIN
      GetDisc(resource, resourceDisc);
      IF resourceDisc.state <= unreferenced THEN
     (* do not create a relationship to dead or unreferenced objects
        but propagate a termination immediately to dependant
     *)
     IF resourceDisc.state = terminated THEN
        Notify(dependant, resourceDisc.state);
     END;
     RETURN
      END;

      GetDisc(dependant, dependantDisc);
      IF dependantDisc.dependsOn # NIL THEN
     (* don't accept changes *)
     RETURN
      END;
      dependantDisc.dependsOn := resource;

      NEW(member); member.resource := dependant;
      member.next := resourceDisc.dependants;
      resourceDisc.dependants := member;
      Attach(resource, dependantDisc.key);
   END DependsOn;

   PROCEDURE Alive*(resource: Resource) : BOOLEAN;
      (* returns TRUE if the resource is not yet terminated
     and ready for communication (i.e. not communicationStopped)
      *)
      VAR
     disc: Discipline;
   BEGIN
      GetDisc(resource, disc);
      RETURN ~disc.stopped & (disc.state IN {alive, unreferenced})
   END Alive;

   PROCEDURE Stopped*(resource: Resource) : BOOLEAN;
      (* returns TRUE if the object is currently not responsive
     and not yet terminated
      *)
      VAR
     disc: Discipline;
   BEGIN
      GetDisc(resource, disc);
      RETURN disc.stopped
   END Stopped;

   PROCEDURE Terminated*(resource: Resource) : BOOLEAN;
      (* returns TRUE if the resource is terminated *)
      VAR
     disc: Discipline;
   BEGIN
      GetDisc(resource, disc);
      RETURN disc.state = terminated
   END Terminated;

BEGIN
   discID := Disciplines.Unique();
END Resources.



And we have module Disciplines:


MODULE Disciplines;

   (* Disciplines allows to attach additional data structures to
      abstract datatypes like Streams;
      these added data structures permit to parametrize operations
      which are provided by other modules (e.g. Read or Write for Streams)
   *)

   IMPORT Objects;

   TYPE
      Identifier* = LONGINT;

      Discipline* = POINTER TO DisciplineRec;
      DisciplineRec* =
     RECORD
        (Objects.ObjectRec)
        id*: Identifier; (* should be unique for all types of disciplines *)
     END;

      DisciplineList = POINTER TO DisciplineListRec;
      DisciplineListRec =
     RECORD
        discipline: Discipline;
        id: Identifier; (* copied from discipline.id *)
        next: DisciplineList;
     END;

      Object* = POINTER TO ObjectRec;
      ObjectRec* =
     RECORD
        (Objects.ObjectRec)
        (* private part *)
        list: DisciplineList; (* set of disciplines *)
     END;

...

   PROCEDURE Seek*(object: Object; id: Identifier;
          VAR discipline: Discipline) : BOOLEAN;
      (* returns TRUE if a discipline with the given id is found *)
      VAR
     dl: DisciplineList;
   BEGIN
      dl := object.list;
      WHILE (dl # NIL) & (dl.id # id) DO
     dl := dl.next;
      END;
      IF dl # NIL THEN
     discipline := dl.discipline;
      ELSE
     discipline := NIL;
      END;
      RETURN discipline # NIL
   END Seek;

If I change PROCEDURE GetDisc(resource: Resource; VAR disc: Discipline);
to
PROCEDURE GetDisc(resource: Resource; VAR disc: Disciplines.Discipline);
Then this code:
   IF ~Disciplines.Seek(resource, discID, (*disctmp*)disc) THEN
     NEW(disc); disc.id := discID;
     disc.state := alive; disc.refcnt := 0;
     disc.eventType := NIL;
     disc.dependants := NIL; disc.dependsOn := NIL;
     Disciplines.Add(resource, disc);
   END;
will not work.

If I use local tmpdisc, assign tmpdisc.id := disc.id and pass it instead,
I anyway have to assign back pointer disc := tmpdisc which is not allowed,
and this is not an optimal solution as well.

Any idea?
Thank you.

On Wed, Oct 6, 2010 at 7:24 AM, Stewart Greenhill
<sgr...@ii...>wrote:

> Hi Norayr,
>
> I think the restriction is correct.
>
> This can be confusing, but think of it like this: if your parameter is
> declared "aaa(VAR p : T1)" then it means the procedure can write ANY value
> of type T1 to p. Sure, T2 is a subtype of T1 but there are other subtypes of
> T1 which are not also T2. It would be an error for the compiler to allow
> aaa(p2) because you could then assign something to p2 which is not a subtype
> of T2. For example:
>
>
> PROCEDURE aaa (VAR p : T1);
> BEGIN
>  NEW(p);  (* assign new instance of T1 to p *)
> END aaa;
>
> Now, allowing aaa(p2) would break the type system.
>
> Its hard to say how to best handle this without knowing some more details
> of what you're trying to do. This sort of pattern could work:
>
> VAR
>  p1 : T1;
> ...
>  p1 := NEW(T2);
>  aaa(p1);
>
> Cheers,
>  Stewart
>
>
> On 6/10/10 1:18 AM, Norayr Chilingaryan wrote:
> > Hello, yet another question which came out during library porting work.
> > MODULE test2;
> >
> > TYPE T1 = POINTER TO TRec;
> >       TRec = RECORD
> >       a : INTEGER
> >       END;
> >
> > TYPE T2 = POINTER TO T2Rec;
> >       T2Rec = RECORD (TRec)
> >       b : REAL
> >       END;
> > VAR p1 : T1;
> >      p2 : T2;
> >
> > PROCEDURE aaa (VAR p : T1);
> > BEGIN
> >
> > END aaa;
> >
> > BEGIN
> > p2 := NEW(T2);
> > p1 := NEW(T1);
> > aaa(p2);
> >
> > END test2.
> >
> > So, this won't compile unless:
> > we change procedure to PROCEDURE aaa (p : T1); i. e. without VAR
> > or
> > pointer passed to the procedure is not a pointer to the extended type,
> > so aaa(p1) will work.
> >
> > Are that restrictions intentional?
> > What would be an optimal (or nicer) workaround to solve this if I need
> > to compile library which have been written like this.
> >
> > Thank you
> > Norayr
> [...]
>
>

Re: [ooc-compiler] wrapper to SYSTEM.VAL

[Stewart G. <sgr...@us...>]

Hi Norayr,

Sorry for the delay. I see the problem, but I'm not sure what you're 
trying to achieve. Within Resources, Discipline is an extension of 
Discipline.Discipline and it looks like most of the procedures in this 
module require the extended type. These will break if you change the 
signature of GetDisc. Why do you want to change the signature of GetDisc?

Cheers,
   Stewart

On 7/10/10 5:46 AM, Norayr Chilingaryan wrote:
> Hey,
> thank you for reply.
> ok, I see, indeed.
>
> So, here we have Resources.Mod from Ulm's Oberon LIbrary which contains:
>
>     TYPE
>        List = POINTER TO ListRec;
>        ListRec =
>       RECORD
>          resource: Resource;
>          next: List;
>       END;
>        Discipline = POINTER TO DisciplineRec;
>        DisciplineRec =
>       RECORD
>          (Disciplines.DisciplineRec)
>          state: State;           (* alive, unreferenced, or terminated *)
>          stopped: BOOLEAN;       (* may be TRUE, if alive or unreferenced *)
>          refcnt: LONGINT;        (* # of Attach - # of Detach *)
>          eventType: Events.EventType; (* may be NIL *)
>          dependants: List;       (* list of resources which depends on us *)
>          dependsOn: Resource;    (* we depend on this resource *)
>          key: Key;               (* attach key for dependsOn *)
>       END;
>
> ...
>
>     PROCEDURE GetDisc(resource: Resource; VAR disc: Discipline);
>     BEGIN
>       IF ~Disciplines.Seek(resource, discID, disc) THEN
>       NEW(disc); disc.id <http://disc.id> := discID;
>       disc.state := alive; disc.refcnt := 0;
>       disc.eventType := NIL;
>       disc.dependants := NIL; disc.dependsOn := NIL;
>       Disciplines.Add(resource, disc);
>     END;
>     END GetDisc;
>
> Procedure GetDisc is called a lot of times:
> hacktar ulmoberonlib # grep GetDisc *
> Resources.Mod:   PROCEDURE GetDisc(resource: Resource; VAR disc:
> Discipline);
> Resources.Mod:   END GetDisc;
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, resourceDisc);
> Resources.Mod:      GetDisc(dependant, dependantDisc);
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:     GetDisc(resource, disc);
> Resources.Mod:     GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, resourceDisc);
> Resources.Mod:      GetDisc(dependant, dependantDisc);
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, disc);
> Resources.Mod:      GetDisc(resource, disc);
> hacktar ulmoberonlib #
>
> like this:
>
>    PROCEDURE GenEvent(resource: Resource; change: StateChange);
>        VAR
>       disc: Discipline;
>       event: Event;
>     BEGIN
>        GetDisc(resource, disc);
>        IF disc.eventType # NIL THEN
>       NEW(event);
>       event.type := disc.eventType;
>       event.message := "Resources: state change notification";
>       event.change := change;
>       event.resource := resource;
>       Events.Raise(event);
>        END;
>     END GenEvent;
>
>     PROCEDURE ^ Detach(resource: Resource; key: Key);
>     PROCEDURE Unlink(dependant, resource: Resource);
>        (* undo DependsOn operation *)
>        VAR
>       dependantDisc, resourceDisc: Discipline;
>       prev, member: List;
>     BEGIN
>        GetDisc(resource, resourceDisc);
>        IF resourceDisc.state = terminated THEN
>       (* no necessity for clean up *)
>       RETURN
>        END;
>        GetDisc(dependant, dependantDisc);
>
>        prev := NIL; member := resourceDisc.dependants;
>        WHILE member.resource # dependant DO
>       prev := member; member := member.next;
>        END;
>        IF prev = NIL THEN
>       resourceDisc.dependants := member.next;
>        ELSE
>       prev.next := member.next;
>        END;
>
>        (* Detach reference from dependant to resource *)
>        Detach(dependantDisc.dependsOn, dependantDisc.key);
>        dependantDisc.dependsOn := NIL; dependantDisc.key := NIL;
>     END Unlink;
>
>
>     PROCEDURE InternalNotify(resource: Resource; change: StateChange);
>        VAR
>       disc: Discipline;
>       event: Event;
>       dependant: List;
>     BEGIN
>        GetDisc(resource, disc);
>        CASE change OF
>        | communicationResumed: disc.stopped := FALSE;
>        | communicationStopped: disc.stopped := TRUE;
>        | terminated:           disc.stopped := FALSE; disc.state :=
> terminated;
>        END;
>        GenEvent(resource, change);
>
>        (* notify all dependants *)
>        dependant := disc.dependants;
>        WHILE dependant # NIL DO
>       InternalNotify(dependant.resource, change);
>       dependant := dependant.next;
>        END;
>
>        (* remove dependency relation in case of termination, if present *)
>        IF (change = terminated) & (disc.dependsOn # NIL) THEN
>       Unlink(resource, disc.dependsOn);
>        END;
>     END InternalNotify;
>
>     (* === exported procedures
> =========================================== *)
>
>     PROCEDURE TakeInterest*(resource: Resource; VAR eventType:
> Events.EventType);
>        (* return resource specific event type for state notifications;
>       eventType is guaranteed to be # NIL even if
>       the given resource is already terminated
>        *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        GetDisc(resource, disc);
>        IF disc.eventType = NIL THEN
>       Events.Define(disc.eventType);
>       Events.Ignore(disc.eventType);
>        END;
>        eventType := disc.eventType;
>     END TakeInterest;
>
>     PROCEDURE Attach*(resource: Resource; VAR key: Key);
>        (* mark the resource as being used until Detach gets called *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        GetDisc(resource, disc);
>        IF disc.state IN {terminated, unreferenced} THEN
>       key := NIL;
>        ELSE
>       INC(disc.refcnt); NEW(key); key.valid := TRUE;
>       key.resource := resource;
>        END;
>     END Attach;
>
>     PROCEDURE Detach*(resource: Resource; key: Key);
>        (* mark the resource as unused; the returned key of Attach must
>       be given -- this allows to check for proper balances
>       of Attach/Detach calls;
>       the last Detach operation causes a state change to unreferenced
>        *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        IF (key # NIL) & key.valid & (key.resource = resource) THEN
>       GetDisc(resource, disc);
>       IF disc.state # terminated THEN
>          key.valid := FALSE; DEC(disc.refcnt);
>          IF disc.refcnt = 0 THEN
>             GenEvent(resource, unreferenced);
>             disc.state := unreferenced;
>             IF disc.dependsOn # NIL THEN
>            Unlink(resource, disc.dependsOn);
>             END;
>          END;
>       END;
>        END;
>     END Detach;
>
>     PROCEDURE Notify*(resource: Resource; change: StateChange);
>        (* notify all interested parties about the new state;
>       only valid state changes are accepted:
>       - Notify doesn't accept any changes after termination
>       - unreferenced is generated conditionally by Detach only
>       - communicationResumed is valid after communicationStopped only
>       valid notifications are propagated to all dependants (see below);
>        *)
>        VAR
>       disc: Discipline;
>       event: Event;
>       dependant: List;
>     BEGIN
>        IF change # unreferenced THEN
>       GetDisc(resource, disc);
>       IF (disc.state # terminated) & (disc.state # change) &
>             ((change # communicationResumed) OR disc.stopped) THEN
>          InternalNotify(resource, change);
>       END;
>        END;
>     END Notify;
>
>     PROCEDURE DependsOn*(dependant, resource: Resource);
>        (* states that `dependant' depends entirely on `resource' --
>       this is usually the case if operations on `dependant'
>       are delegated to `resource';
>       only one call of DependsOn may be given per `dependant' while
>       several DependsOn for one resource are valid;
>       DependsOn calls implicitly Attach for resource and
>       detaches if the dependant becomes unreferenced;
>       all other state changes propagate from `resource' to
>       `dependant'
>        *)
>        VAR
>       dependantDisc, resourceDisc: Discipline;
>       member: List;
>     BEGIN
>        GetDisc(resource, resourceDisc);
>        IF resourceDisc.state <= unreferenced THEN
>       (* do not create a relationship to dead or unreferenced objects
>          but propagate a termination immediately to dependant
>       *)
>       IF resourceDisc.state = terminated THEN
>          Notify(dependant, resourceDisc.state);
>       END;
>       RETURN
>        END;
>
>        GetDisc(dependant, dependantDisc);
>        IF dependantDisc.dependsOn # NIL THEN
>       (* don't accept changes *)
>       RETURN
>        END;
>        dependantDisc.dependsOn := resource;
>
>        NEW(member); member.resource := dependant;
>        member.next := resourceDisc.dependants;
>        resourceDisc.dependants := member;
>        Attach(resource, dependantDisc.key);
>     END DependsOn;
>
>     PROCEDURE Alive*(resource: Resource) : BOOLEAN;
>        (* returns TRUE if the resource is not yet terminated
>       and ready for communication (i.e. not communicationStopped)
>        *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        GetDisc(resource, disc);
>        RETURN ~disc.stopped & (disc.state IN {alive, unreferenced})
>     END Alive;
>
>     PROCEDURE Stopped*(resource: Resource) : BOOLEAN;
>        (* returns TRUE if the object is currently not responsive
>       and not yet terminated
>        *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        GetDisc(resource, disc);
>        RETURN disc.stopped
>     END Stopped;
>
>     PROCEDURE Terminated*(resource: Resource) : BOOLEAN;
>        (* returns TRUE if the resource is terminated *)
>        VAR
>       disc: Discipline;
>     BEGIN
>        GetDisc(resource, disc);
>        RETURN disc.state = terminated
>     END Terminated;
>
> BEGIN
>     discID := Disciplines.Unique();
> END Resources.
>
>
>
> And we have module Disciplines:
>
>
> MODULE Disciplines;
>
>     (* Disciplines allows to attach additional data structures to
>        abstract datatypes like Streams;
>        these added data structures permit to parametrize operations
>        which are provided by other modules (e.g. Read or Write for Streams)
>     *)
>
>     IMPORT Objects;
>
>     TYPE
>        Identifier* = LONGINT;
>
>        Discipline* = POINTER TO DisciplineRec;
>        DisciplineRec* =
>       RECORD
>          (Objects.ObjectRec)
>          id*: Identifier; (* should be unique for all types of
> disciplines *)
>       END;
>
>        DisciplineList = POINTER TO DisciplineListRec;
>        DisciplineListRec =
>       RECORD
>          discipline: Discipline;
>          id: Identifier; (* copied from discipline.id
> <http://discipline.id> *)
>          next: DisciplineList;
>       END;
>
>        Object* = POINTER TO ObjectRec;
>        ObjectRec* =
>       RECORD
>          (Objects.ObjectRec)
>          (* private part *)
>          list: DisciplineList; (* set of disciplines *)
>       END;
>
> ...
>
>     PROCEDURE Seek*(object: Object; id: Identifier;
>            VAR discipline: Discipline) : BOOLEAN;
>        (* returns TRUE if a discipline with the given id is found *)
>        VAR
>       dl: DisciplineList;
>     BEGIN
>        dl := object.list;
>        WHILE (dl # NIL) & (dl.id <http://dl.id> # id) DO
>       dl := dl.next;
>        END;
>        IF dl # NIL THEN
>       discipline := dl.discipline;
>        ELSE
>       discipline := NIL;
>        END;
>        RETURN discipline # NIL
>     END Seek;
>
> If I change PROCEDURE GetDisc(resource: Resource; VAR disc: Discipline);
> to
> PROCEDURE GetDisc(resource: Resource; VAR disc: Disciplines.Discipline);
> Then this code:
>     IF ~Disciplines.Seek(resource, discID, (*disctmp*)disc) THEN
>       NEW(disc); disc.id <http://disc.id> := discID;
>       disc.state := alive; disc.refcnt := 0;
>       disc.eventType := NIL;
>       disc.dependants := NIL; disc.dependsOn := NIL;
>       Disciplines.Add(resource, disc);
>     END;
> will not work.
>
> If I use local tmpdisc, assign tmpdisc.id <http://tmpdisc.id> := disc.id
> <http://disc.id> and pass it instead,
> I anyway have to assign back pointer disc := tmpdisc which is not
> allowed, and this is not an optimal solution as well.
>
> Any idea?
> Thank you.
>
> On Wed, Oct 6, 2010 at 7:24 AM, Stewart Greenhill
> <sgr...@ii... <mailto:sgr...@ii...>> wrote:
>
>     Hi Norayr,
>
>     I think the restriction is correct.
>
>     This can be confusing, but think of it like this: if your parameter
>     is declared "aaa(VAR p : T1)" then it means the procedure can write
>     ANY value of type T1 to p. Sure, T2 is a subtype of T1 but there are
>     other subtypes of T1 which are not also T2. It would be an error for
>     the compiler to allow aaa(p2) because you could then assign
>     something to p2 which is not a subtype of T2. For example:
>
>
>     PROCEDURE aaa (VAR p : T1);
>     BEGIN
>       NEW(p);  (* assign new instance of T1 to p *)
>     END aaa;
>
>     Now, allowing aaa(p2) would break the type system.
>
>     Its hard to say how to best handle this without knowing some more
>     details of what you're trying to do. This sort of pattern could work:
>
>     VAR
>       p1 : T1;
>     ...
>       p1 := NEW(T2);
>       aaa(p1);
>
>     Cheers,
>       Stewart
>
>
>     On 6/10/10 1:18 AM, Norayr Chilingaryan wrote:
>      > Hello, yet another question which came out during library porting
>     work.
>      > MODULE test2;
>      >
>      > TYPE T1 = POINTER TO TRec;
>      >       TRec = RECORD
>      >       a : INTEGER
>      >       END;
>      >
>      > TYPE T2 = POINTER TO T2Rec;
>      >       T2Rec = RECORD (TRec)
>      >       b : REAL
>      >       END;
>      > VAR p1 : T1;
>      >      p2 : T2;
>      >
>      > PROCEDURE aaa (VAR p : T1);
>      > BEGIN
>      >
>      > END aaa;
>      >
>      > BEGIN
>      > p2 := NEW(T2);
>      > p1 := NEW(T1);
>      > aaa(p2);
>      >
>      > END test2.
>      >
>      > So, this won't compile unless:
>      > we change procedure to PROCEDURE aaa (p : T1); i. e. without VAR
>      > or
>      > pointer passed to the procedure is not a pointer to the extended
>     type,
>      > so aaa(p1) will work.
>      >
>      > Are that restrictions intentional?
>      > What would be an optimal (or nicer) workaround to solve this if I
>     need
>      > to compile library which have been written like this.
>      >
>      > Thank you
>      > Norayr
>     [...]
>
>
>
>
> ------------------------------------------------------------------------------
> Beautiful is writing same markup. Internet Explorer 9 supports
> standards for HTML5, CSS3, SVG 1.1,  ECMAScript5, and DOM L2&  L3.
> Spend less time writing and  rewriting code and more time creating great
> experiences on the web. Be a part of the beta today.
> http://p.sf.net/sfu/beautyoftheweb
>
>
>
> _______________________________________________
> ooc-compiler mailing list
> ooc...@li...
> https://lists.sourceforge.net/lists/listinfo/ooc-compiler