This is block.c in view mode; [Download] [Up]
/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
*/
/*
block.c
blocks and exits
*/
#include "include.h"
Fblock(args)
object args;
{
object *oldlex = lex_env;
object id;
object body;
object *top;
if(endp(args))
FEtoo_few_argumentsF(args);
lex_copy();
id = alloc_frame_id();
vs_push(id);
lex_block_bind(MMcar(args), id);
vs_pop;
frs_push(FRS_CATCH, id);
if (nlj_active)
nlj_active = FALSE;
else {
body = MMcdr(args);
if (endp(body)) {
vs_base = vs_top;
vs_push(Cnil);
} else {
top = vs_top;
do {
vs_top = top;
eval(MMcar(body));
body = MMcdr(body);
} while (!endp(body));
}
}
frs_pop();
lex_env = oldlex;
}
Freturn_from(args)
object args;
{
object lex_block;
frame_ptr fr;
if (endp(args))
FEtoo_few_argumentsF(args);
if (!endp(MMcdr(args)) && !endp(MMcddr(args)))
FEtoo_many_argumentsF(args);
lex_block = lex_block_sch(MMcar(args));
if (MMnull(lex_block))
FEerror("The block name ~S is undefined.", 1, MMcar(args));
fr = frs_sch(MMcaddr(lex_block));
if(fr == NULL)
FEerror("The block ~S is missing.", 1, MMcar(args));
if(endp(MMcdr(args))) {
vs_base = vs_top;
vs_push(Cnil);
}
else
eval(MMcadr(args));
unwind(fr, MMcaddr(lex_block));
/* never reached */
}
Freturn(args)
object args;
{
object lex_block;
frame_ptr fr;
if(!endp(args) && !endp(MMcdr(args)))
FEtoo_many_argumentsF(args);
lex_block = lex_block_sch(Cnil);
if (MMnull(lex_block))
FEerror("The block name ~S is undefined.", 1, Cnil);
fr = frs_sch(MMcaddr(lex_block));
if (fr == NULL)
FEerror("The block ~S is missing.", 1, Cnil);
if(endp(args)) {
vs_base = vs_top;
vs_push(Cnil);
} else
eval(MMcar(args));
unwind(fr, MMcaddr(lex_block));
/* never reached */
}
init_block()
{
Sblock = make_special_form("BLOCK", Fblock);
enter_mark_origin(&Sblock);
make_special_form("RETURN-FROM", Freturn_from);
make_special_form("RETURN", Freturn);
}
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.