peter
/
universalservice
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

uns_lisp: swap

This commit is contained in:
Peter McGoron 2024-07-16 14:46:27 -04:00
parent 3c119ee11f
commit f440716bf9
1 changed files with 47 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
examples/lisp/uns_lisp.c
View File

@ -1035,6 +1035,7 @@ enum cps_return {
CPS_EXEC_INVALID_APPL_LIST, CPS_EXEC_INVALID_APPL_LIST,
CPS_APP_UNDERFLOW, CPS_APP_UNDERFLOW,
CPS_FCALL_IMPROPER_LIST, CPS_FCALL_IMPROPER_LIST,
CPS_SWAP_UNDERFLOW,
CPS_RETURN_LEN CPS_RETURN_LEN
}; };
@ -1071,6 +1072,7 @@ static const char *cps_return_to_string[CPS_RETURN_LEN] = {
"CPS_EXEC_INVALID_APPL_LIST", "CPS_EXEC_INVALID_APPL_LIST",
"CPS_APP_UNDERFLOW", "CPS_APP_UNDERFLOW",
"CPS_FCALL_IMPROPER_LIST", "CPS_FCALL_IMPROPER_LIST",
"CPS_SWAP_UNDERFLOW"
}; };
/* {K (quote QUOTED)} {cps} = {(-> (quote QUOTED) K)} */ /* {K (quote QUOTED)} {cps} = {(-> (quote QUOTED) K)} */
@ -1738,6 +1740,49 @@ end:
return r; return r;
} }
static enum cps_return cps_swap(struct uns_ctr *prevstack,
int places,
struct uns_ctr *readstack
)
{
struct uns_ctr top = {0};
struct uns_ctr tmp = {0};
struct uns_ctr tmpstack = {0};
enum cps_return r = CPS_CONTINUE;
int i;
uns_root_add(gc, &top);
uns_root_add(gc, &tmp);
uns_root_add(gc, &tmpstack);
if (!stack_pop(prevstack, &top)) {
r = CPS_SWAP_UNDERFLOW;
goto end;
}
tmpstack.p = empty_list.p;
for (i = 0; i < places; i++) {
if (!stack_pop(prevstack, &tmp)) {
r = CPS_SWAP_UNDERFLOW;
goto end;
}
stack_push(&tmpstack, &tmp);
}
tmp.p = tmpstack.p;
stack_push(prevstack, &top);
for (i = 0; i < places; i++) {
stack_pop(&tmpstack, &tmp);
stack_push(prevstack, &tmp);
}
end:
uns_root_remove(gc, &top);
uns_root_remove(gc, &tmp);
uns_root_remove(gc, &tmpstack);
return r;
}
static enum cps_return cps(struct uns_ctr *prevstack, static enum cps_return cps(struct uns_ctr *prevstack,
struct uns_ctr *readstack) struct uns_ctr *readstack)
{ {
@ -1762,6 +1807,8 @@ static enum cps_return cps(struct uns_ctr *prevstack,
r = cps_exec(prevstack, readstack); r = cps_exec(prevstack, readstack);
} else if (strcmp(cmd, "cps-list") == 0) { } else if (strcmp(cmd, "cps-list") == 0) {
r = cps_list(prevstack, readstack); r = cps_list(prevstack, readstack);
} else if (strcmp(cmd, "swap2") == 0) {
r = cps_swap(prevstack, 2, readstack);
} else { } else {
r = CPS_INVALID_CMD; r = CPS_INVALID_CMD;
} }