delphi - 使用FPC : Allocation and Pointers编写Scheme解释器

Question

作为一名历史学家，撰写Scheme interpreter in FPC对我来说，在第一阶段就已经是一项艰巨的任务了。 :) 我正在关注 Peter Michaux 的博客，who showed how to do it in C (还有 Ada 的翻译，这可能对 Pascal 有帮助)。

考虑 Michaux 著作中的这两个 C 函数 (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;
}

据我了解(只是C语言的基本阅读知识)，构造函数make_fixnum返回一个指向结构体的指针(fixnum类型的标记数据)；对于构造的对象，必须分配内存(感谢 @David Heffernan 昨天的 point)。

这是我迄今为止对 FPC 的翻译，编译时没有任何错误:

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.

但是...:

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

我怀疑，我使用和引用指针的方式存在严重缺陷。

非常感谢任何帮助我理解指针和内存的工作原理的人(也欢迎引用常见问题解答、论文等)。

Answer 1

您的 AllocateObject 函数是错误的。它在变量 x 中创建一个新对象，但它不会将创建的对象传递给调用函数，因为它是按值调用的。如果您更改调用约定，它会起作用:

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

如果您查看调试器中的 fixnum 变量，您会发现它保持为零。

<小时/> <小时/>

与您的问题无关，我认为在解释器中使用记录不是一个好主意。它很快就变成了内存管理的噩梦(至少在我编写的解释器中发生了这种情况，当它接近 20 kloc 时，我不得不按如下方式替换记录:)

代替你的记录

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

您可以使用类，例如:

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;

然后您可以使用

轻松创建它

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

如果您的方案实现中没有循环引用，您甚至可以使用接口(interface)。然后对其进行引用计数并自动释放:

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)!