Writing a Scheme interpreter with FPC: Allocation and Pointers

Question

Being a historian, writing a Scheme interpreter in FPC turns already in the first stage out to be a serious task for me. :) I am following the blog of Peter Michaux, who showed how to do it in C (there is also a translation to Ada, which may be helpful for Pascal).

Consider these two functions in C from Michaux’s work (v 0.1):

object *alloc_object(void) {
    object *obj;

    obj = malloc(sizeof(object));
    if (obj == NULL) {
        fprintf(stderr, "out of memory\n");
        exit(1);
    }
    return obj;
}

object *make_fixnum(long value) {
    object *obj;

    obj = alloc_object();
    obj->type = FIXNUM;
    obj->data.fixnum.value = value;
    return obj;
}

As far as I understand (just basic reading knowledge in C), the constructor make_fixnum returns a pointer to a struct (tagged data of type fixnum); for the constructed object, memory has to be allocated (thanks @David Heffernan for his point yesterday).

This is my translation to FPC so far, which compiles without any error:

program scheme;

type
   TTag = (ScmFixnum);
   PScmObject = ^TScmObject;
   TScmObject = record
      case ScmObjectTag: TTag of
         ScmFixnum: (ScmObjectFixnum: integer);
      end;

var Test: PScmObject = nil;

procedure AllocateObject(x: PScmObject);
begin
    new(x);
end;

function MakeFixnum(x: integer): PScmObject;
var
   fixnum: PScmObject = nil;
begin
   AllocateObject(fixnum);
   fixnum^.ScmObjectTag := ScmFixnum;
   fixnum^.ScmObjectFixnum := x;
   MakeFixnum := fixnum;
end;

begin
   Test := MakeFixnum(1);
   writeln(Test^.ScmObjectTag);
   writeln(Test^.ScmObjectFixnum);
end.

However...:

$ ./test 
Runtime error 216 at $080480DD
  $080480DD
  $08048117
  $08063873

I suspect, there is a serious flaw how I am using and referencing pointers.

Many thanks to anybody who helps me to understand how this pointer and memory stuff works (references to FAQ’s, papers etc. are welcome as well).

Answer 1

Your AllocateObject function is wrong. It is creating a new object in the variable x, but it does not pass the created object to the calling function, since it is called by value. If you change the calling convention it works:

 procedure AllocateObject(out x: PScmObject);
 begin 
    new(x);
 end;

You can see the if you look at the the fixnum variable in the debugger, it stayed nil.

---

---

Unrelated to your question, I do not think it is a good idea to use records in an interpreter. It turns soon in a memory managing nightmare (at least that happened in an interpreter I wrote when it came close to 20 kloc, and I had to replace records as follows:)

Instead of your record

 PScmObject = ^TScmObject;
 TScmObject = record
    case ScmObjectTag: TTag of
       ScmFixnum: (ScmObjectFixnum: integer);
    end;

you can use classes, like:

TScmObject = class()
  function Tag: TTag; virtual; abstract;
  function Fixnum: integer; virtual; abstract;
end;
TScmObjectFixNum = class(TScmObject)
  function Tag: TTag; override;
  function Fixnum: integer; override;
private
  value: integer;
end;

function TScmObjectFixNum.Tag: TTag;
begin
  result := ScmFixnum; 
end;
function TScmObjectFixNum.Fixnum: integer; 
begin
  result := value; 
end;

Then you create it easily with

 var x: TScmObject;
 x := TScmObjectFixNum.create() ;
 if x.tag = scmfixnum (* or x is TScmObjectFixNum *) then
    ... x.scmfixnum ...
 x.free

If there are no circular references in your scheme implementation, you can even use interfaces. Then it is reference counted and automatically freed:

IScmObject = interface
  function Tag: TTag;
  function Fixnum: integer;
end;
TScmObject = class(TInterfacedObject, IScmObject)
  function Tag: TTag; virtual; abstract;
  function Fixnum: integer; virtual; abstract;
end;
TScmObjectFixNum = class(TScmObject)
  function Tag: TTag; override;
  function Fixnum: integer; override;
private
  value: integer;
end;



 var x: IScmObject;
 x := TScmObjectFixNum.create() ;
 if x.tag = scmfixnum (* or x is TScmObjectFixNum *) then
    ... x.scmfixnum ...
 //x.free no longer necessary (or allowed)!