basic: backport separate evaluation of the function from step8

asarhaddon · Nov 13, 2024 · cf0d422 · cf0d422
1 parent af8d7fc
commit cf0d422
Show file tree

Hide file tree

Showing 9 changed files with 131 additions and 95 deletions.
diff --git a/impls/basic/step2_eval.in.bas b/impls/basic/step2_eval.in.bas
@@ -11,9 +11,8 @@ REM $INCLUDE: 'debug.in.bas'
 REM READ is inlined in RE
 
 REM EVAL_AST(A, E) -> R
+REM A must be a list, map or vector
 SUB EVAL_AST
-  REM A must be a list, sequence or map
-
   REM push A and E on the stack
   Q=E:GOSUB PUSH_Q
   GOSUB PUSH_A
@@ -98,25 +97,38 @@ SUB EVAL
     GOTO EVAL_RETURN
 
   APPLY_LIST:
-
     GOSUB EMPTY_Q
     IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN
 
     EVAL_INVOKE:
-      CALL EVAL_AST
-      W=R
 
-      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
-
-      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
+      IF T<>9 THEN ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
+
+      REM evaluate the arguments
+      Q=F:GOSUB PUSH_Q
+      A=Z%(A+1):CALL EVAL_AST
+      GOSUB POP_Q:F=Q
+      IF ER<>-2 THEN GOTO EVAL_RETURN
+      AR=R
+
+      REM push f/args for release after call
+      GOSUB PUSH_Q
+      GOSUB PUSH_R
+
       GOSUB DO_FUNCTION
-      EVAL_INVOKE_DONE:
-      AY=W:GOSUB RELEASE
+
+      REM pop and release f/args
+      GOSUB POP_Q:AY=Q
+      GOSUB RELEASE
+      GOSUB POP_Q:AY=Q:GOSUB RELEASE
       GOTO EVAL_RETURN
 
   EVAL_RETURN:

diff --git a/impls/basic/step3_env.in.bas b/impls/basic/step3_env.in.bas
@@ -12,9 +12,8 @@ REM $INCLUDE: 'debug.in.bas'
 REM READ is inlined in RE
 
 REM EVAL_AST(A, E) -> R
+REM A must be a list, map or vector
 SUB EVAL_AST
-  REM A must be a list, sequence or map
-
   REM push A and E on the stack
   Q=E:GOSUB PUSH_Q
   GOSUB PUSH_A
@@ -169,20 +168,34 @@ SUB EVAL
         A=A2:CALL EVAL: REM eval A2 using let_env
         GOTO EVAL_RETURN
     EVAL_INVOKE:
-      CALL EVAL_AST
-      W=R
 
-      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
-
-      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
+      IF T<>9 THEN ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
+
+      REM evaluate the arguments
+      Q=F:GOSUB PUSH_Q
+      A=Z%(A+1):CALL EVAL_AST
+      GOSUB POP_Q:F=Q
+      IF ER<>-2 THEN GOTO EVAL_RETURN
+      AR=R
+
+      REM push f/args for release after call
+      GOSUB PUSH_Q
+      GOSUB PUSH_R
+
       GOSUB DO_FUNCTION
-      EVAL_INVOKE_DONE:
-      AY=W:GOSUB RELEASE
+
+      REM pop and release f/args
+      GOSUB POP_Q:AY=Q
+      GOSUB RELEASE
+      GOSUB POP_Q:AY=Q:GOSUB RELEASE
       GOTO EVAL_RETURN
 
   EVAL_RETURN:

diff --git a/impls/basic/step4_if_fn_do.in.bas b/impls/basic/step4_if_fn_do.in.bas
@@ -13,9 +13,8 @@ REM $INCLUDE: 'debug.in.bas'
 REM READ is inlined in RE
 
 REM EVAL_AST(A, E) -> R
+REM A must be a list, map or vector
 SUB EVAL_AST
-  REM A must be a list, sequence or map
-
   REM push A and E on the stack
   Q=E:GOSUB PUSH_Q
   GOSUB PUSH_A
@@ -210,26 +209,31 @@ 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
+      F=R
+
+      GOSUB TYPE_F
+      IF T<>9 AND T<>10 THEN ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
+
+      REM evaluate the arguments
+      Q=F:GOSUB PUSH_Q
+      A=Z%(A+1):CALL EVAL_AST
+      GOSUB POP_Q:F=Q
       IF ER<>-2 THEN GOTO EVAL_RETURN
 
       REM push f/args for release after call
+      GOSUB PUSH_Q
       GOSUB PUSH_R
 
-      AR=Z%(R+1): REM rest
-      F=Z%(R+2)
+      AR=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
-
-      REM if error, pop and return f/args for release by caller
-      GOSUB POP_R
-      ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
+      ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION
 
       EVAL_DO_FUNCTION:
         REM regular function
@@ -241,6 +245,7 @@ SUB EVAL
         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:
@@ -265,6 +270,7 @@ SUB EVAL
         REM pop and release f/args
         GOSUB POP_Q:AY=Q
         GOSUB RELEASE
+        GOSUB POP_Q:AY=Q:GOSUB RELEASE
 
         REM A set above
         E=R:GOTO EVAL_TCO_RECUR: REM TCO loop

diff --git a/impls/basic/step5_tco.in.bas b/impls/basic/step5_tco.in.bas
@@ -13,9 +13,8 @@ REM $INCLUDE: 'debug.in.bas'
 REM READ is inlined in RE
 
 REM EVAL_AST(A, E) -> R
+REM A must be a list, map or vector
 SUB EVAL_AST
-  REM A must be a list, sequence or map
-
   REM push A and E on the stack
   Q=E:GOSUB PUSH_Q
   GOSUB PUSH_A
@@ -234,26 +233,31 @@ 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
+      F=R
+
+      GOSUB TYPE_F
+      IF T<>9 AND T<>10 THEN ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
+
+      REM evaluate the arguments
+      Q=F:GOSUB PUSH_Q
+      A=Z%(A+1):CALL EVAL_AST
+      GOSUB POP_Q:F=Q
       IF ER<>-2 THEN GOTO EVAL_RETURN
 
       REM push f/args for release after call
+      GOSUB PUSH_Q
       GOSUB PUSH_R
 
-      AR=Z%(R+1): REM rest
-      F=Z%(R+2)
+      AR=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
-
-      REM if error, pop and return f/args for release by caller
-      GOSUB POP_R
-      ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
+      ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION
 
       EVAL_DO_FUNCTION:
         REM regular function
@@ -265,6 +269,7 @@ SUB EVAL
         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:
@@ -289,6 +294,7 @@ SUB EVAL
         REM pop and release f/args
         GOSUB POP_Q:AY=Q
         GOSUB RELEASE
+        GOSUB POP_Q:AY=Q:GOSUB RELEASE
 
         REM A set above
         E=R:GOTO EVAL_TCO_RECUR: REM TCO loop

diff --git a/impls/basic/step6_file.in.bas b/impls/basic/step6_file.in.bas
@@ -13,9 +13,8 @@ REM $INCLUDE: 'debug.in.bas'
 REM READ is inlined in RE
 
 REM EVAL_AST(A, E) -> R
+REM A must be a list, map or vector
 SUB EVAL_AST
-  REM A must be a list, sequence or map
-
   REM push A and E on the stack
   Q=E:GOSUB PUSH_Q
   GOSUB PUSH_A
@@ -234,26 +233,31 @@ 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
+      F=R
+
+      GOSUB TYPE_F
+      IF T<>9 AND T<>10 THEN ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
+
+      REM evaluate the arguments
+      Q=F:GOSUB PUSH_Q
+      A=Z%(A+1):CALL EVAL_AST
+      GOSUB POP_Q:F=Q
       IF ER<>-2 THEN GOTO EVAL_RETURN
 
       REM push f/args for release after call
+      GOSUB PUSH_Q
       GOSUB PUSH_R
 
-      AR=Z%(R+1): REM rest
-      F=Z%(R+2)
+      AR=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
-
-      REM if error, pop and return f/args for release by caller
-      GOSUB POP_R
-      ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
+      ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION
 
       EVAL_DO_FUNCTION:
         REM regular function
@@ -265,6 +269,7 @@ SUB EVAL
         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:
@@ -289,6 +294,7 @@ SUB EVAL
         REM pop and release f/args
         GOSUB POP_Q:AY=Q
         GOSUB RELEASE
+        GOSUB POP_Q:AY=Q:GOSUB RELEASE
 
         REM A set above
         E=R:GOTO EVAL_TCO_RECUR: REM TCO loop

diff --git a/impls/basic/step7_quote.in.bas b/impls/basic/step7_quote.in.bas
@@ -125,9 +125,8 @@ QQ_FOLDR_DONE:
 END SUB
 
 REM EVAL_AST(A, E) -> R
+REM A must be a list, map or vector
 SUB EVAL_AST
-  REM A must be a list, sequence or map
-
   REM push A and E on the stack
   Q=E:GOSUB PUSH_Q
   GOSUB PUSH_A
@@ -363,26 +362,31 @@ 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
+      F=R
+
+      GOSUB TYPE_F
+      IF T<>9 AND T<>10 THEN ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
+
+      REM evaluate the arguments
+      Q=F:GOSUB PUSH_Q
+      A=Z%(A+1):CALL EVAL_AST
+      GOSUB POP_Q:F=Q
       IF ER<>-2 THEN GOTO EVAL_RETURN
 
       REM push f/args for release after call
+      GOSUB PUSH_Q
       GOSUB PUSH_R
 
-      AR=Z%(R+1): REM rest
-      F=Z%(R+2)
+      AR=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
-
-      REM if error, pop and return f/args for release by caller
-      GOSUB POP_R
-      ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
+      ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION
 
       EVAL_DO_FUNCTION:
         REM regular function
@@ -394,6 +398,7 @@ SUB EVAL
         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:
@@ -418,6 +423,7 @@ SUB EVAL
         REM pop and release f/args
         GOSUB POP_Q:AY=Q
         GOSUB RELEASE
+        GOSUB POP_Q:AY=Q:GOSUB RELEASE
 
         REM A set above
         E=R:GOTO EVAL_TCO_RECUR: REM TCO loop