tips@free BLOG

■ [z80][xlisp]自作Z80 CP/Mマシン(39)

引き続き XLISPのメモ。

うまく動かない if関数を調べるために確認用の printfを追加して流れを追ったり、デバッガをかけて引数をチェックしたりとしてみましたが、どうやらソース自体が間違っていそうなので後のバージョンのソースを探して比べて見ました。

下に ver1.1と 1.2の該当部分のソースを示しますが、やはり処理が違っています、修正されたのでしょうねぇ、、

具体的には、 引数の取り出しが xlmatch(LIST, &arg.n_ptr) から xlarg(&args) へ、 引数の評価が xlevarg(thenexpr.n_ptr) から xleval(thenexpr.n_ptr) へ変わっています。

XLISP v1.1 xlsubr.c

/* fif - builtin function if */
static struct node *fif(args)
  struct node *args;
{
    struct node *oldstk,arg,testexpr,thenexpr,elseexpr,*val;
    int dothen;

   /* create a new stack frame */
   oldstk = xlsave(&arg,&testexpr,&thenexpr,&elseexpr,NULL);

    /* initialize */
    arg.n_ptr = args; 

    /* evaluate the test expression */
    testexpr.n_ptr = xlevarg(&arg.n_ptr);

    /* get the then clause */
    thenexpr.n_ptr = xlmatch(LIST,&arg.n_ptr);    <- 真の場合の引数を取り出し

    /* get the else clause */
    if (arg.n_ptr != NULL)
	elseexpr.n_ptr = xlmatch(LIST,&arg.n_ptr);  <- 偽の場合の引数を取り出し
    else
	elseexpr.n_ptr = NULL;

    /* make sure there aren't any more arguments */
    xllastarg(arg.n_ptr);

    /* figure out which expression to evaluate */
    dothen = testvalue(testexpr.n_ptr);

    /* default the result value to the value of the test expression */
    val = testexpr.n_ptr;

    /* evaluate the appropriate clause */
    if (dothen)
	while (thenexpr.n_ptr != NULL)
	    val = xlevarg(&thenexpr.n_ptr);        <- 真の評価
    else
	while (elseexpr.n_ptr != NULL)
	    val = xlevarg(&elseexpr.n_ptr);        <- 偽の評価

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the last value */
    return (val);
}

XLISP v1.2 xlcont.c

/* xif - builtin function 'if' */
struct node *xif(args)
  struct node *args;
{
    struct node *oldstk,testexpr,thenexpr,elseexpr,*val;

    /* create a new stack frame */
    oldstk = xlsave(&testexpr,&thenexpr,&elseexpr,NULL);

    /* get the test expression, then clause and else clause */
    testexpr.n_ptr = xlarg(&args);                  <- 真の場合の引数を取り出し
    thenexpr.n_ptr = xlarg(&args);                  <- 偽の場合の引数を取り出し
    elseexpr.n_ptr = (args ? xlarg(&args) : NULL);
    xllastarg(args);

    /* evaluate the appropriate clause */ 　　　　　 <- 真・偽の評価
    val = xleval(xleval(testexpr.n_ptr) ? thenexpr.n_ptr : elseexpr.n_ptr);

    /* restore the previous stack frame */
    xlstack = oldstk;

    /* return the last value */
    return (val);
}

修正後は思ったとおりの結果になりました。

P>xlisp
XLISP version 1.1
> (if t 1 2)
1                       <- 1 が返ってくる
> (if t (1)(2))
error: bad function     <- エラーになる
(1)
(if t (1) (2))

(環境は CP/M Z80 HI-TECH C ver3.09でコンパイル)

• Z80に関するエントリ、　動画（ニコニコ）はこちら