EJECT PAGE/100-340
PUSH12=PUSH
POP12=POP
EV12=EV
RET12, EVRET
EVAL12, LEVAL
TEST12=TEST
/SETHD & SETTL ROUTINES
ASETHD, /WILL SET THE DOWN POINTER TO THE ARGUMENT.
  TAD SHTYPE
SHON, DCA DOITS
  JMP DOIT
SHTYPE, CLL RAL
ASETTL, /WILL SET THE NEXT POINTER TO THE ARGUMENT.
  TAD STTYPE
  JMP SHON
STTYPE, CLL CML RAL
/MAIN ROUTINE.  NOT DEFINED FOR NULL ARGUMENTS, OR FOR
/  ATOMIC ARGUMENTS.
DOIT,
  JMS I SHPUSH /RECURSIVE SELF-PROTECTION
   SHLIST
  JMS I SHEV /1ST ARGUMENT
  DCA SHLIST /SAVE IT
  JMS I SHPUSH /RECURSIVE SELF-PROTECTION
   DOITS
  JMS I SHEV /2ND ARGUMENT
  JMS I SHPOP
   DOITS
  DCA SH1 /SAVE IT
  JMS I SHTEST /REALLY?
  JMP SHRETR /NO
  TAD DOITS/SETHD OR SETTL?
  CIA
  TAD STTYPE
  SZA CLA
  JMP .+5/SETHD
  TAD SH1/GET 2ND ARG
  CLL RAR
  SNL CLA
  HLT /2ND ARG OF SETTL NOT A LIST
  TAD SHLIST /GET 1ST ARG
  RAR
  SNL /ATOM?
  HLT /YES
  SNA /NULL?
  HLT /YES
DOITS, 0 /PUT IN BY SETHD & SETTL
  DCA SHLIST /SAVE IT
  TAD SH1 /GET 2ND ARG
  DCA I SHLIST /SET HEAD OR TAIL, AS SPECIFIED
  TAD I SHLIST /RETURN 2ND ARG AS VALUE
SHRETR, JMS I SHPOP  /POP & RETURN
   SHLIST
  JMP I SHRET
SH1, 0
SHEV=EV12
SHPUSH=PUSH12
SHPOP=POP12
SHRET=RET12
SHTEST=TEST12
/IF ROUTINE
/IF FIRST ARGUMENT IS T, THEN RETURNS (EXECUTES) SECOND ARG.
/  ELSE DOES NOT EXECUTE SECOND ARG.
AIF,
  JMS I IFPUSH /RECURSIVE SELF-PROTECTION
   IFSAVE
  TAD I IFSW /SAVE SWITCH
  DCA IFSAVE
  JMS I IFEV /GET CONDITION
  DCA I IFSW /SAVE IT
  TAD IFSAVE /COND SW=1?
  SNA CLA
  DCA I IFSW /NO:  SET SWITCH=0
  JMS I IFEV /GET VALUE
  DCA IFVAL
  TAD IFSAVE /RESTORE SWITCH
  DCA I IFSW
  TAD IFVAL /RETURN VALUE
  JMS I IFPOP
   IFSAVE
  JMP I IFRET
IFSW, CNSW
IFSAVE, 0
IFVAL, 0
IFPUSH=PUSH12
IFPOP=POP12
IFEV=EV12
IFRET=RET12
/BEGIN ROUTINE
/SIMILAR TO PROG, BUT WITHOUT THE AUTOMATIC PUSH-DOWN
ABEGIN,
  JMS I BGEV /GET AN ARG
  CMA /-1?
  SNA
  JMP BGEND /YES
  CMA /NO
  DCA BGVAL /SAVE VALUE
  JMP ABEGIN /TRY AGAIN
BGEND, TAD BGVAL
  JMP I BGRET
BGVAL, 0
BGEV=EV12
BGRET=RET12
/RETURN ROUTINE
/FOR USE IN THE IMMEDIATE RANGE OF A PROG.  THIS WILL CAUSE
/ THE PROG TO 'DROP THROUGH', RETURNING AS THE PROG VALUE
/ THE VALUE OF THE RETURN ARGUMENT.
ARETURN,
  JMS I REPUSH /RECURSIVE SWITCH PROTECTION
   CNSW
  JMS I REEV /GET RETURN VALUE
  JMS I RETEST /REALLY?
  JMP REARND  /NO
  DCA I RE1
  DCA I RESW /SET SWITCH VALUE F
  JMS I REPUSH /RECURSIVE SELF PROTECTION
RE1,  BGVAL
  JMS I REEV /GET NEXT
  JMS I REPOP /RECURSIVE SELF PROTECTION
   BGVAL
  CMA
  SZA CLA
  JMP .-7
  STA /RETURN -1
REARND, JMS I REPOP
RESW, CNSW
  JMP I RERET
RETEST=TEST12
REPUSH=PUSH12
REPOP=POP12
REEV=EV12
RERET=RET12
/ERR ROUTINE
/THIS ROUTINE CALLED WHENEVER A HLT IS NORMALLY EXECUTED.
ERR, 0
  CLA
  TAD ERR /DISPLAY ERROR ADDRESS
  MQL
  TAD I EREVAL/DISPLAY POINTER ADDRESS
  7402 /HLT
  JMP ERR+1
EREVAL=EVAL12
/EXIT, PAUSE ROUTINES
AEXIT2,
  JMS I STTEST
  JMP I STRET
  ICF /CLEAR INK FLAG
  TCF /CLEAR PRINT FLAG
  EFC /CLEAR ERASE FLAG
  JMP I .+1
   7600
APAUSE, JMS I STTEST
  JMP I STRET
  MQL
  TAD I STEVAL
  7402
  JMP I STRET
STEVAL=EVAL12
STRET=RET12
STTEST=TEST12
/QUOTE ROUTINE
/PREVENTS THE EVALUATION OF ITS ARGUMENT.  HAS AS ITS VALUE
/  THE CONTENTS OF THE CELL FOLLOWING THE CALL ON 'QUOTE'
AQUOTE,
  ISZ I QUEVAL
  TAD I QUEVAL
  DCA QUTMP
  TAD I QUTMP
  JMP I QURET
QUEVAL=EVAL12
QUTMP, 0
QURET=RET12
$