% File TRACE.MUS  (c)		10/01/80	The Soft Warehouse %


MOVD (FIRST, #FIRST) $
MOVD (SECOND, #SECOND) $
MOVD (REST, #REST) $
MOVD (ADJOIN, #ADJOIN) $
MOVD (EMPTY, #EMPTY) $
MOVD (ATOM, #ATOM) $
MOVD (MEMBER, #MEMBER) $
MOVD (EVAL, #EVAL) $
MOVD (APPLY, #APPLY) $
MOVD (PLUS, #PLUS) $
MOVD (LIST, #LIST) $

FUNCTION TRACE LEX1,
  LOOP
    WHEN #ATOM (LEX1) EXIT,
    TRACE1 (POP (LEX1)),
  ENDLOOP,
ENDFUN $

FUNCTION TRACE1 (FUNC,
    % Local: %  BODY, FUNC#),
  BODY: GETD (FUNC),
  WHEN #EMPTY (BODY),
    PRINT ("UNDEFINED FUNCTION: "),
    PRINTLINE (FUNC) EXIT,
  WHEN FUNC EQ ':,
    PRINTLINE ("CANNOT TRACE ':'") EXIT,
  FUNC#: COMPRESS (#LIST (FUNC, ##)),
  MOVD (FUNC, FUNC#),
  WHEN SUBR (FUNC),
    PUTD (FUNC, #LIST ('FUNCTION, 'ARG1,
      #LIST (TRACE#, FUNC, 'ARG1, FUNC#))) EXIT,
  WHEN FSUBR (FUNC),
    PUTD (FUNC, #LIST ('SUBROUTINE, 'ARG1,
      #LIST (TRACE#, FUNC, 'ARG1, FUNC#))) EXIT,
  WHEN #FIRST (BODY) = 'FUNCTION,
    PUTD (FUNC, #LIST ('FUNCTION, #SECOND (BODY),
      #LIST (TRACE#, FUNC, #SECOND (BODY), FUNC#))) EXIT,
  WHEN #FIRST (BODY) = 'SUBROUTINE,
    PUTD (FUNC, #LIST ('SUBROUTINE, #SECOND (BODY),
      #LIST (TRACE#, FUNC, #SECOND (BODY), FUNC#))) EXIT,
  PRINT ("UNDEFINED FUNCTION: "),
  PRINTLINE (FUNC),
ENDFUN $

FUNCTION SUBR (FUNC),
  WHEN INTEGER (GETD (FUNC)),
    #EMPTY (FSUBR (FUNC)) EXIT,
ENDFUN $

FUNCTION FSUBR (FUNC),
  #MEMBER (FUNC, '(LIST, COND, AND, OR, LOOP, PUSH, POP)),
ENDFUN $


FUNCTION UNTRACE LEX1,
  LOOP
    WHEN #ATOM (LEX1) EXIT,
    UNTRACE1 (POP (LEX1)),
  ENDLOOP,
ENDFUN $

FUNCTION UNTRACE1 (FUNC,
  % Local: %  FUNC#),
  FUNC#: COMPRESS (#LIST (FUNC, ##)),
  WHEN GETD (FUNC#),
    MOVD (FUNC#, FUNC),
    MOVD (FALSE, FUNC#) EXIT,
ENDFUN $


SUBROUTINE TRACE# (FUNC, ARGS, FUNC#, LEX#),
  PRTARGS# (FUNC, ARGS),
  PRTRSLT# (FUNC, #APPLY (FUNC#, MKARGS# (ARGS))),
ENDSUB $

FUNCTION MKARGS# (ARGS),
  WHEN #EMPTY (ARGS), FALSE EXIT,
  WHEN #ATOM (ARGS), #EVAL (ARGS) EXIT,
  #ADJOIN (#EVAL (POP (ARGS)), MKARGS# (ARGS)),
ENDFUN $

FUNCTION PRTARGS# (FUNC, ARGS),
  SPACES (INDENT),
  INDENT: #PLUS (INDENT, 1),
  PRINT (FUNC),
  PRINT (" ["),
  WHEN #EMPTY (ARGS),
    PRINTLINE (']) EXIT,
  WHEN #ATOM (ARGS),
    ARGS: #EVAL (ARGS),
    LOOP
      BLOCK
	WHEN NOT MATHTRACE,
	  PRINT (POP (ARGS)) EXIT,
	PRTMATH (POP (ARGS), 0, 0),
      ENDBLOCK,
      WHEN #ATOM (ARGS) EXIT,
      PRINT (", "),
    ENDLOOP,
    PRINTLINE (']) EXIT,
  LOOP
    BLOCK
      WHEN NOT MATHTRACE,
        PRINT (#EVAL (POP (ARGS))) EXIT,
      WHEN EXARG (#FIRST (ARGS)),
        PRTMATH (#EVAL (POP (ARGS)), 0, 0) EXIT,
      WHEN LEXARG (#FIRST (ARGS)),
	PRINT (LPAR),
	LEX#: #EVAL (POP (ARGS)),
	WHEN #EMPTY (LEX#), PRINT (RPAR) EXIT,
	LOOP
	  PRTMATH (POP(LEX#), 0, 0),
	  WHEN #EMPTY (LEX#), PRINT (RPAR) EXIT,
	  PRINT (", "),
	ENDLOOP EXIT,
      PRINT (#EVAL (POP (ARGS))),
    ENDBLOCK,
    WHEN FALSLST (ARGS) EXIT,
    PRINT (", "),
  ENDLOOP,
  PRINTLINE (']),
ENDFUN $

FUNCTION FALSLST (ARGS),
  LOOP
    WHEN #EMPTY (ARGS) EXIT,
    WHEN #ATOM (ARGS), FALSE EXIT,
    WHEN #EVAL (POP (ARGS)), FALSE EXIT,
  ENDLOOP,
ENDFUN $

FUNCTION EXARG (ARGS),
  #MEMBER (ARGS, '(EX1, EX2, EX3, EX4, EX5)),
ENDFUN $

FUNCTION LEXARG (ARGS),
  #MEMBER (ARGS, '(LEX1, LEX2, LEX3, LEX4)),
ENDFUN $

FUNCTION PRTRSLT# (FUNC, RSLT),
  INDENT: #PLUS (INDENT, -1),
  SPACES (INDENT),
  PRINT (FUNC),
  PRINT (" = "),
  WHEN NOT MATHTRACE,
    PRINTLINE (RSLT) EXIT,
  PRTMATH (RSLT, 0, 0, TRUE),
  NEWLINE(),
  RSLT,
ENDFUN $

INDENT: 0 $
MATHTRACE: TRUE $

RDS () $