diff --git a/impls/basic/step2_eval.in.bas b/impls/basic/step2_eval.in.bas index 38dec57333..f8912d39f3 100755 --- a/impls/basic/step2_eval.in.bas +++ b/impls/basic/step2_eval.in.bas @@ -19,21 +19,8 @@ SUB EVAL_AST IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A - IF T=5 THEN GOTO EVAL_AST_SYMBOL - IF T>5 AND T<9 THEN GOTO EVAL_AST_SEQ + IF T<6 OR 8-2 THEN GOTO EVAL_RETURN - - AR=Z%(R+1): REM rest - F=Z%(R+2) + F=R GOSUB TYPE_F - IF T<>9 THEN R=-1:ER=-1:E$="apply of non-function":GOTO EVAL_INVOKE_DONE - GOSUB DO_FUNCTION - EVAL_INVOKE_DONE: - AY=W:GOSUB RELEASE - GOTO EVAL_RETURN + + REM ON .. GOTO here reduces the diff with later steps. + T=T-8 + IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + + GOSUB DO_FUNCTION + + REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE + GOSUB POP_Q:AY=Q + GOSUB RELEASE EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR diff --git a/impls/basic/step3_env.in.bas b/impls/basic/step3_env.in.bas index c247825725..5dc942a516 100755 --- a/impls/basic/step3_env.in.bas +++ b/impls/basic/step3_env.in.bas @@ -20,21 +20,8 @@ SUB EVAL_AST IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A - IF T=5 THEN GOTO EVAL_AST_SYMBOL - IF T>5 AND T<9 THEN GOTO EVAL_AST_SEQ + IF T<6 OR 8-2 THEN GOTO EVAL_RETURN - - AR=Z%(R+1): REM rest - F=Z%(R+2) + F=R GOSUB TYPE_F - IF T<>9 THEN R=-1:ER=-1:E$="apply of non-function":GOTO EVAL_INVOKE_DONE - GOSUB DO_FUNCTION - EVAL_INVOKE_DONE: - AY=W:GOSUB RELEASE - GOTO EVAL_RETURN + + REM ON .. GOTO here reduces the diff with later steps. + T=T-8 + IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + + GOSUB DO_FUNCTION + + REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE + GOSUB POP_Q:AY=Q + GOSUB RELEASE EVAL_RETURN: REM AZ=R: B=1: GOSUB PR_STR diff --git a/impls/basic/step4_if_fn_do.in.bas b/impls/basic/step4_if_fn_do.in.bas index 6061890413..5dcf6daade 100755 --- a/impls/basic/step4_if_fn_do.in.bas +++ b/impls/basic/step4_if_fn_do.in.bas @@ -21,21 +21,8 @@ SUB EVAL_AST IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A - IF T=5 THEN GOTO EVAL_AST_SYMBOL - IF T>5 AND T<9 THEN GOTO EVAL_AST_SEQ + IF T<6 OR 8-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R + F=R - AR=Z%(R+1): REM rest - F=Z%(R+2) - - REM if metadata, get the actual object GOSUB TYPE_F - IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F - ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION + T=T-8 + IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -265,6 +289,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/step5_tco.in.bas b/impls/basic/step5_tco.in.bas index e2fc26f0e1..969b4d2c8d 100755 --- a/impls/basic/step5_tco.in.bas +++ b/impls/basic/step5_tco.in.bas @@ -21,21 +21,8 @@ SUB EVAL_AST IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A - IF T=5 THEN GOTO EVAL_AST_SYMBOL - IF T>5 AND T<9 THEN GOTO EVAL_AST_SEQ + IF T<6 OR 8-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R + F=R - AR=Z%(R+1): REM rest - F=Z%(R+2) - - REM if metadata, get the actual object GOSUB TYPE_F - IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F - ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION + T=T-8 + IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -289,6 +313,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/step6_file.in.bas b/impls/basic/step6_file.in.bas index 4d7a96d3c7..53d8a6d088 100755 --- a/impls/basic/step6_file.in.bas +++ b/impls/basic/step6_file.in.bas @@ -21,21 +21,8 @@ SUB EVAL_AST IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A - IF T=5 THEN GOTO EVAL_AST_SYMBOL - IF T>5 AND T<9 THEN GOTO EVAL_AST_SEQ + IF T<6 OR 8-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R + F=R - AR=Z%(R+1): REM rest - F=Z%(R+2) - - REM if metadata, get the actual object GOSUB TYPE_F - IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F - ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION + T=T-8 + IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -289,6 +313,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/step7_quote.in.bas b/impls/basic/step7_quote.in.bas index 708e5e50e5..d6bf92153a 100755 --- a/impls/basic/step7_quote.in.bas +++ b/impls/basic/step7_quote.in.bas @@ -122,7 +122,6 @@ SUB QQ_FOLDR QQ_FOLDR_DONE: END SUB - REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack @@ -132,21 +131,8 @@ SUB EVAL_AST IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A - IF T=5 THEN GOTO EVAL_AST_SYMBOL - IF T>5 AND T<9 THEN GOTO EVAL_AST_SEQ - - REM scalar: deref to actual value and inc ref cnt - R=A - GOSUB INC_REF_R - GOTO EVAL_AST_RETURN + IF T<6 OR 8-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R + F=R - AR=Z%(R+1): REM rest - F=Z%(R+2) - - REM if metadata, get the actual object GOSUB TYPE_F - IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F - ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION + T=T-8 + IF 0-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -417,6 +440,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/step8_macros.in.bas b/impls/basic/step8_macros.in.bas index 99667ed211..de37575260 100755 --- a/impls/basic/step8_macros.in.bas +++ b/impls/basic/step8_macros.in.bas @@ -122,42 +122,6 @@ SUB QQ_FOLDR QQ_FOLDR_DONE: END SUB -REM MACROEXPAND(A, E) -> A: -SUB MACROEXPAND - GOSUB PUSH_A - - MACROEXPAND_LOOP: - REM list? - GOSUB TYPE_A - IF T<>6 THEN GOTO MACROEXPAND_DONE - REM non-empty? - IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE - B=Z%(A+2) - REM symbol? in first position - IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE - REM defined in environment? - B$=S$(Z%(B+1)):CALL ENV_GET - IF R3=0 THEN GOTO MACROEXPAND_DONE - B=R - REM macro? - IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE - - GOSUB INC_REF_R - F=B:AR=Z%(A+1):CALL APPLY - A=R - - GOSUB PEEK_Q:AY=Q - REM if previous A was not the first A into macroexpand (i.e. an - REM intermediate form) then free it - IF A<>AY THEN GOSUB PEND_A_LV - - IF ER<>-2 THEN GOTO MACROEXPAND_DONE - GOTO MACROEXPAND_LOOP - - MACROEXPAND_DONE: - GOSUB POP_Q: REM pop original A -END SUB - REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack @@ -167,21 +131,8 @@ SUB EVAL_AST IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A - IF T=5 THEN GOTO EVAL_AST_SYMBOL - IF T>5 AND T<9 THEN GOTO EVAL_AST_SEQ - - REM scalar: deref to actual value and inc ref cnt - R=A - GOSUB INC_REF_R - GOTO EVAL_AST_RETURN - - EVAL_AST_SYMBOL: - B$=S$(Z%(A+1)):CALL ENV_GET - IF R3=0 THEN R=-1:ER=-1:E$="'"+B$+"' not found":GOTO EVAL_AST_RETURN - GOSUB INC_REF_R - GOTO EVAL_AST_RETURN + IF T<6 OR 81 THEN GOTO EVAL_NOT_LIST GOSUB EMPTY_Q IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN @@ -421,40 +381,69 @@ SUB EVAL GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R + F=R - AR=Z%(R+1): REM rest - F=Z%(R+2) - - REM if metadata, get the actual object GOSUB TYPE_F - IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F - ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION + T=T-8 + IF 0-2 THEN GOTO EVAL_RETURN + + REM Evaluate the result of this macro expansion. + A=R:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_DO_FUNCTION: REM regular function + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -474,6 +463,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/step9_try.in.bas b/impls/basic/step9_try.in.bas index ecc50203c4..936fa09675 100755 --- a/impls/basic/step9_try.in.bas +++ b/impls/basic/step9_try.in.bas @@ -122,42 +122,6 @@ SUB QQ_FOLDR QQ_FOLDR_DONE: END SUB -REM MACROEXPAND(A, E) -> A: -SUB MACROEXPAND - GOSUB PUSH_A - - MACROEXPAND_LOOP: - REM list? - GOSUB TYPE_A - IF T<>6 THEN GOTO MACROEXPAND_DONE - REM non-empty? - IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE - B=Z%(A+2) - REM symbol? in first position - IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE - REM defined in environment? - B$=S$(Z%(B+1)):CALL ENV_GET - IF R3=0 THEN GOTO MACROEXPAND_DONE - B=R - REM macro? - IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE - - GOSUB INC_REF_R - F=B:AR=Z%(A+1):CALL APPLY - A=R - - GOSUB PEEK_Q:AY=Q - REM if previous A was not the first A into macroexpand (i.e. an - REM intermediate form) then free it - IF A<>AY THEN GOSUB PEND_A_LV - - IF ER<>-2 THEN GOTO MACROEXPAND_DONE - GOTO MACROEXPAND_LOOP - - MACROEXPAND_DONE: - GOSUB POP_Q: REM pop original A -END SUB - REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack @@ -167,21 +131,8 @@ SUB EVAL_AST IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A - IF T=5 THEN GOTO EVAL_AST_SYMBOL - IF T>5 AND T<9 THEN GOTO EVAL_AST_SEQ - - REM scalar: deref to actual value and inc ref cnt - R=A - GOSUB INC_REF_R - GOTO EVAL_AST_RETURN - - EVAL_AST_SYMBOL: - B$=S$(Z%(A+1)):CALL ENV_GET - IF R3=0 THEN R=-1:ER=-1:E$="'"+B$+"' not found":GOTO EVAL_AST_RETURN - GOSUB INC_REF_R - GOTO EVAL_AST_RETURN + IF T<6 OR 81 THEN GOTO EVAL_NOT_LIST GOSUB EMPTY_Q IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN @@ -454,40 +414,69 @@ SUB EVAL GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R + F=R - AR=Z%(R+1): REM rest - F=Z%(R+2) - - REM if metadata, get the actual object GOSUB TYPE_F - IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F - ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION + T=T-8 + IF 0-2 THEN GOTO EVAL_RETURN + + REM Evaluate the result of this macro expansion. + A=R:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_DO_FUNCTION: REM regular function + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -507,6 +496,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE diff --git a/impls/basic/stepA_mal.in.bas b/impls/basic/stepA_mal.in.bas index 1aaf1305d8..bfadda40a8 100755 --- a/impls/basic/stepA_mal.in.bas +++ b/impls/basic/stepA_mal.in.bas @@ -122,42 +122,6 @@ SUB QQ_FOLDR QQ_FOLDR_DONE: END SUB -REM MACROEXPAND(A, E) -> A: -SUB MACROEXPAND - GOSUB PUSH_A - - MACROEXPAND_LOOP: - REM list? - GOSUB TYPE_A - IF T<>6 THEN GOTO MACROEXPAND_DONE - REM non-empty? - IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE - B=Z%(A+2) - REM symbol? in first position - IF (Z%(B)AND 31)<>5 THEN GOTO MACROEXPAND_DONE - REM defined in environment? - B$=S$(Z%(B+1)):CALL ENV_GET - IF R3=0 THEN GOTO MACROEXPAND_DONE - B=R - REM macro? - IF (Z%(B)AND 31)<>11 THEN GOTO MACROEXPAND_DONE - - GOSUB INC_REF_R - F=B:AR=Z%(A+1):CALL APPLY - A=R - - GOSUB PEEK_Q:AY=Q - REM if previous A was not the first A into macroexpand (i.e. an - REM intermediate form) then free it - IF A<>AY THEN GOSUB PEND_A_LV - - IF ER<>-2 THEN GOTO MACROEXPAND_DONE - GOTO MACROEXPAND_LOOP - - MACROEXPAND_DONE: - GOSUB POP_Q: REM pop original A -END SUB - REM EVAL_AST(A, E) -> R SUB EVAL_AST REM push A and E on the stack @@ -167,21 +131,8 @@ SUB EVAL_AST IF ER<>-2 THEN GOTO EVAL_AST_RETURN GOSUB TYPE_A - IF T=5 THEN GOTO EVAL_AST_SYMBOL - IF T>5 AND T<9 THEN GOTO EVAL_AST_SEQ - - REM scalar: deref to actual value and inc ref cnt - R=A - GOSUB INC_REF_R - GOTO EVAL_AST_RETURN - - EVAL_AST_SYMBOL: - B$=S$(Z%(A+1)):CALL ENV_GET - IF R3=0 THEN R=-1:ER=-1:E$="'"+B$+"' not found":GOTO EVAL_AST_RETURN - GOSUB INC_REF_R - GOTO EVAL_AST_RETURN + IF T<6 OR 81 THEN GOTO EVAL_NOT_LIST GOSUB EMPTY_Q IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN @@ -454,40 +414,71 @@ SUB EVAL GOTO EVAL_RETURN EVAL_INVOKE: - CALL EVAL_AST - REM if error, return f/args for release by caller + REM evaluate A0 + GOSUB PUSH_A + A=A0:CALL EVAL + GOSUB POP_A IF ER<>-2 THEN GOTO EVAL_RETURN - REM push f/args for release after call + REM set F, push it in the stack for release after call GOSUB PUSH_R - - AR=Z%(R+1): REM rest - F=Z%(R+2) + F=R REM if metadata, get the actual object GOSUB TYPE_F IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F - ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION + T=T-8 + IF 0-2 THEN GOTO EVAL_RETURN + + REM Evaluate the result of this macro expansion. + A=R:GOTO EVAL_TCO_RECUR: REM TCO loop + EVAL_DO_FUNCTION: REM regular function + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + IF Z%(F+1)<65 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP REM for recur functions (apply, map, swap!), use GOTO IF Z%(F+1)>64 THEN CALL DO_TCO_FUNCTION EVAL_DO_FUNCTION_SKIP: REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE GOTO EVAL_RETURN EVAL_DO_MAL_FUNCTION: + + REM Evaluate the arguments + A=Z%(A+1):CALL EVAL_AST + IF ER<>-2 THEN GOSUB POP_Q:AY=Q:GOSUB RELEASE:GOTO EVAL_RETURN + + REM set F and AR, push AR (after F) in the stack for release after call + GOSUB PEEK_Q:F=Q + GOSUB PUSH_R + AR=R + Q=E:GOSUB PUSH_Q: REM save the current environment for release REM create new environ using env and params stored in function @@ -507,6 +498,7 @@ SUB EVAL LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 REM pop and release f/args + GOSUB POP_Q:AY=Q:GOSUB RELEASE GOSUB POP_Q:AY=Q GOSUB RELEASE