COMMENT ⊗   VALID 00022 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00003 00002	LISP INTERPRETER SUBROUTINES   --- PAGE 10
 00005 00003	
 00006 00004	EQ:	CAMN A,B
 00007 00005	SASSOC:	PUSHJ P,SAS1
 00008 00006	GET:	CDR A,(A)
 00009 00007	PUTPROP:	LAC T,A
 00010 00008	EQUAL:	LAC C,P
 00011 00009	SUBS5:	CDR A,SUBAS
 00012 00010	NCONC:	TDZA R,R
 00013 00011	MEMBER:	DAC A,SUBAS
 00014 00012	GENSYM:	LAC B,[POINT 7,GNUM,34]
 00015 00013	LIST:	LAC B,A
 00017 00014	PA3:	0	lh=0=>rh =next prog statement		*
 00020 00015	ARITHMETIC SUBROUTINES --- PAGE 11
 00021 00016	
 00022 00017	MAKNUM:
 00023 00018	FLOAT:	IDIVI A,400000
 00024 00019	DIVIDE:	CAIN B,INUM0
 00025 00020	general arithmetic op code routine for mixed types
 00027 00021	EXPLODE, READLIST AND FRIENDS --- PAGE 12
 00028 00022	READLIST:	TDZA T,T
 00030 ENDMK
⊗;
SUBTTL LISP INTERPRETER SUBROUTINES   --- PAGE 10

CADADR:	SKIPA A,(A)
CADAAR:	CAR A,(A)↔JRST CADAR
CAAADR:	SKIPA A,(A)
CAAAAR:	CAR A,(A)↔JRST CAAAR
CAADDR:	SKIPA A,(A)
CAADAR:	CAR A,(A)
CAADR:	SKIPA A,(A)
CAAAR:	CAR A,(A)↔JRST CAAR

CADDDR:	SKIPA A,(A)
CADDAR:	CAR A,(A)
CADDR:	SKIPA A,(A)
CADAR:	CAR A,(A)
CADR:	SKIPA A,(A)
CAAR:	CAR A,(A)
CAR.:	CAR A,(A)↔POPJ P,

CDDADR:	SKIPA A,(A)
CDDAAR:	CAR A,(A)↔JRST CDDAR
CDAADR:	SKIPA A,(A)
CDAAAR:	CAR A,(A)↔JRST CDAAR
CDADDR:	SKIPA A,(A)
CDADAR:	CAR A,(A)
CDADR:	SKIPA A,(A)
CDAAR:	CAR A,(A)↔JRST CDAR

CDDDDR:	SKIPA A,(A)
CDDDAR:	CAR A,(A)
CDDDR:	SKIPA A,(A)
CDDAR:	CAR A,(A)
CDDR:	SKIPA A,(A)
CDAR:	CAR A,(A)
CDR.:	CDR A,(A)↔POPJ P,

QUOTE:	CAR A,(A)	;car and quote duplicated for backtrace
	POPJ P,

AASCII:	PUSHJ P,NUMVAL
	LSH A,=29
	PUSHJ P,FWCONS
	PUSHJ P,NCONS
PNGNK1:	PUSHJ P,NCONS
FOO	MOVEI B,PNAME
	PUSHJ P,XCONS
ACONS:	TROA B,-1
NCONS:	TRZA B,-1
XCONS:	EXCH B,A
CONS:	AOS CONSVAL
	HRL B,A
	SKIPN A,F
	JRST [	HLR A,B
		PUSHJ P,AGC
		JRST .-1]
	LAC F,(F)
	DAC B,(A)
	POPJ P,

PATOM:	CAML A,orgFWS
	JRST TRUE
	CAML A,orgHWS
ATOM:	CAILE A,INUMIN
	JRST TRUE
	HLLE A,(A)
	AOJE A,TRUE
	JRST FALSE
EQ:	CAMN A,B
	JRST TRUE
	JRST FALSE

LENGTH:	MOVEI B,0
LNGTH1:	CAILE A,INUMIN
	JRST FIX1
	HLLE C,(A)
	AOJE C,FIX1
	CDR A,(A)
	AOJA B,LNGTH1

LAST:	CDR B,(A)
	CAILE B,INUMIN
	POPJ P,
	HLLE B,(B)
	AOJE B,CPOPJ
	CDR A,(A)
	JRST LAST

DIP.:	EXCH A,B
RPLACA:	DIP B,(A)
	POPJ P,

DAP.:	EXCH A,B
RPLACD:	DAP B,(A)
	POPJ P,

ZEROP:	PUSHJ P,NUMVAL
NOT:
NULL:	JUMPN A,FALSE
TRUE:
FOO	MOVEI A,TRUTH
	POPJ P,

FW0CNS:	MOVEI A,0
FWCONS:	JUMPN FF,FWC1
	EXCH A,FWC0#
	PUSHJ P,AGC
	EXCH A,FWC0
FWC1:	EXCH A,(FF)
	EXCH A,FF
	POPJ P,

SASSOC:	PUSHJ P,SAS1
	JCALLF 0,(C)
	POPJ P,

SAS0:	CAR B,T
SAS1:	JUMPE B,CPOPJ
	MOVS T,(B)
	MOVS TT,(T)
	CAIE A,(TT)
	JRST SAS0
	CDR A,T
CPOPJ1:	AOS (P)
	POPJ P,

ASSOC:	PUSHJ P,SAS1
FALSE:	MOVEI A,NIL
CPOPJ:	POPJ P,

REVERSE:	LAC T,A
	MOVEI A,0
	JUMPE T,CPOPJ
	CAR B,(T)
	CDR T,(T)
	PUSHJ P,XCONS
	JUMPN T,.-3
	POPJ P,


REMPROP:	CDR T,(A)
	MOVS TT,(T)
	CAIN B,(TT)
	JRA TT,REMP1
	CAR A,TT
	CDR T,(A)
	JUMPN T,REMPROP+1
	JRST FALSE

REMP1:	DAP TT,(A)
	JRST TRUE
GET:	CDR A,(A)
	MOVS D,(A)
	CAIN B,(D)
	JRST CADR
	CAR A,D
	CDR A,(A)
	JUMPN A,GET+1
	POPJ P,

GETL:	CDR A,(A)
GETL0:	CAR T,(A)
	LAC C,B
GETL1:	MOVS TT,(C)
	CAIN T,(TT)
	POPJ P,
	CAR C,TT
	JUMPN C,GETL1
	CDR A,(A)
	CDR A,(A)
	JUMPN A,GETL0
	POPJ P,

NUMBERP:	CAILE A,INUMIN
	JRST TRUE
	HLLE T,(A)
	AOJN T,FALSE
	CDR A,(A)
	CAR A,(A)
FOO	CAIE A,FIXNUM
FOO	CAIN A,FLONUM
	JRST TRUE
NUMBP2:	JRST FALSE	;bignums change this to JRST BIGNP
PUTPROP:	LAC T,A
	CDR A,(A)
CSET3:	MOVS TT,(A)
	CAR A,TT
	CAIN C,(TT)
	JRST CSET2
	CDR A,(A)
	JUMPN A,CSET3
	CDR A,(T)
	PUSHJ P,XCONS
	CDR B,C
	PUSHJ P,XCONS
	DAP A,(T)
	JRST CADR

CSET2:
FOO	CAIE C,VALUE
	JRST CSET1
	CDR T,(B)
	CAR A,(A)
	DAP T,(A)
	JRST PROG2

CSET1:	DIP B,(A)
PROG2:	LAC A,B
	POPJ P,

DEFPROP:	
	CDR B,(A)
	CDR C,(B)
	CAR A,(A)
	CAR B,(B)
	CAR C,(C)
	PUSH P,A
	PUSHJ P,PUTPROP
	JRST POPAJ
EQUAL:	LAC C,P
EQUAL1:	CAMN A,B
	JRST TRUE
	LAC T,A
	LAC TT,B
	PUSHJ P,ATOM
	EXCH A,B
	PUSHJ P,ATOM
	CAMN A,B
	JRST EQUAL3
EQUAL4:	LAC P,C
	JRST FALSE

EQUAL3:	JUMPN A,EQ2
	PUSH P,T
	PUSH P,TT
	CAR A,(T)
	CAR B,(TT)
	PUSHJ P,EQUAL1
	JUMPE A,EQUAL4
	POP P,B
	POP P,A
	CDR A,(A)
	CDR B,(B)
	JRST EQUAL1

EQ2:	PUSH P,T
	LAC A,T
	PUSHJ P,NUMBERP
	JUMPE A,EQUAL4
	LAC A,TT
	PUSHJ P,NUMBERP
	JUMPE A,EQUAL4
	LAC A,(P)
	DAC C,(P)
	LAC B,TT
	JSP C,OP
	JUMPL COMP3
	JUMPL COMP3

COMP3:	POP P,C
	CAME A,TT
	JRST EQUAL4
	JRST TRUE
SUBS5:	CDR A,SUBAS
	POPJ P,

SUBST:	DAC A,SUBAS#
	DAC B,SUBBS#
SUBS0A:	LAC A,SUBAS
	LAC B,SUBBS
	PUSH P,C
	LAC A,C
	PUSHJ P,EQUAL
	POP P,C
	JUMPN A,SUBS5
	CAILE C,INUMIN
	JRST EV6A
	HLLE T,(C)
	AOJN T,SUBS2
EV6A:	LAC A,C
	POPJ P,

SUBS2:	PUSH P,C
	CAR C,(C)
	PUSHJ P,SUBS0A
	EXCH A,(P)
	CDR C,(A)
	PUSHJ P,SUBS0A
	POP P,B
	JRST XCONS
NCONC:	TDZA R,R
APPEND:	MOVEI R,.APPEND-.NCONC
	JUMPE T,FALSE
	POP P,B
APP2:	AOJE T,PROG2
	POP P,A
	PUSHJ P,.NCONC(R)
	LAC B,A
	JRST APP2

.NCONC:	JUMPE A,PROG2
	LAC TT,A
	LAC C,TT
	CDR TT,(C)
	JUMPN TT,.-2
	DAP B,(C)
	POPJ P,

.APPEND:	JUMPE A,PROG2
	MOVEI C,AR1
	LAC TT,A
APP1:	CAR A,(TT)
	PUSH P,B
	PUSHJ P,CONS	;saves b
	POP P,B
	DAP A,(C)
	LAC C,A
	CDR TT,(TT)
	JUMPN TT,APP1
	JRST SUBS4
MEMBER:	DAC A,SUBAS
MEMB1:	JUMPE B,FALSE
	DAC B,SUBBS
	LAC A,SUBAS
	CAR B,(B)
	PUSHJ P,EQUAL
	JUMPN A,CPOPJ
	LAC B,SUBBS
	CDR B,(B)
	JRST MEMB1

MEMQ:	JUMPE B,FALSE
	MOVS C,(B)
	CAIN A,(C)
	JRST TRUE
	CAR B,C
	JUMPN B,MEMQ+1
	JRST FALSE

AND:
FOO	HRLI A,TRUTH
OR:	CAR C,A
	PUSH P,C
ANDOR:	CDR C,A
	JUMPE C,AOEND
	MOVSI C,(<SKIPE (P)>)
	TLNE A,-1
	MOVSI C,(<SKIPN (P)>)
	XCT C
	JRST AOEND
	DAC A,(P)
	CAR A,(A)
	PUSHJ P,EVAL
	EXCH A,(P)
	HRR A,(A)
	JRST ANDOR

AOEND:	POP P,A
	SKIPE A
FOO	MOVEI A,TRUTH
	POPJ P,
GENSYM:	LAC B,[POINT 7,GNUM,34]
	MOVNI C,4
	MOVEI TT,"0"

GENSY2:	LDB T,B
	AOS T
	DPB T,B
	CAIG T,"9"
	JRST GENSY1
	DPB TT,B
	ADD B,[XWD 70000,0]
	AOJN C,GENSY2

GENSY1:	LAC A,GNUM
	PUSHJ P,FWCONS
	PUSHJ P,NCONS
	JRST PNGNK1

GNUM:	ASCII /G0000/			;*

CSYM:	CAR A,(A)
	PUSH P,A
FOO	MOVEI B,PNAME
	PUSHJ P,GET
	JUMPE A,NOPNAM
	CAR A,(A)
	LAC A,(A)
	DAC A,GNUM
	JRST POPAJ
LIST:	LAC B,A
FOO	MOVEI A,CEVAL
	JRST MAPCAR

EELS:	CAR TT,(T)	;interpret lsubr call
	CDR A,(AR1)
ILIST:	MOVEI T,0
	JUMPE A,ILIST2
ILIST1:	PUSH P,A
	CAR A,(A)
	PUSH P,TT
	DIP T,(P)
	PUSHJ P,EVAL
ILIST3:	POP P,TT
	HLRE T,TT
	EXCH A,(P)
	CDR A,(A)
	SOS T
	JUMPN A,ILIST1
ILIST2:	JRST (TT)

MAPC:	TLO A,400000
MAP:	TLOA A,200000
MAPCAR:	TLO A,400000
MAPLIST:	JUMPE B,FALSE
	PUSH P,A
	PUSH P,B
	PUSH P,B
	DIPZ P,(P)
MAPL2:	LAC A,-1(P)
	SKIPGE -2(P)
	CAR A,(A)
	CALLF 1,@-2(P)
	LDB C,[POINT 1,-2(P),1]
	JUMPN C,MAP1
	PUSHJ P,NCONS
	HLR B,(P)
	DAP A,(B)
	DIP A,(P)
MAP1:	CDR B,@-1(P)
	DAC B,-1(P)
	JUMPN B,MAPL2
	POP P,AR1
	SUB P,[XWD 2,2]
SUBS4:	CDR A,AR1
	POPJ P,0
PA3:	0	;lh=0=>rh =next prog statement		*
	;lh - =>rh = tag to go to
PA4:	0	;lh=-1,rh=pntr to prog less bound var list	*
	;lh=+,rh return value
	;2.1=>dont do unbnd

PROG:	PUSH P,PA3
	PUSH P,PA4
	CAR TT,(A)
	CDR A,(A)
	HRROM A,PA4
	DAC A,PA3
	JUMPE TT,PG0
	MOVSI C,1
FOO	MOVEI B,VALUE
	DAC SP,SPSV#
	ANDCAM C,PA4

PG7A:	CAR A,(TT)
	MOVEI AR1,0
	PUSHJ P,BIND
	CDR TT,(TT)
	JUMPN TT,PG7A
	PUSH SP,SPSV

PG0:	SKIPA T,PA3
PG5A:	LAC T,A
PG1:	JUMPE T,PG2
	CAR A,(T)
	CDR T,(T)
	HLLE B,(A)
	AOJE B,PG1
	DAC T,PA3
	PUSHJ P,EVAL
	SKIPL A,PA4
	JRST PG4	;return
	SKIPL T,PA3
	JRST PG1
PG5:	JUMPE A,EG1
	CAR TT,(A)
	CDR A,(A)
	CAIN TT,(T)
	JRST PG5A	;found tag
	JRST PG5

PG2:	TDZA A,A
PG4:	HRRZS A
	MOVSI B,1
	TDNN B,PA4
	PUSHJ P,UNBIND
ERRP4:	POP P,PA4
	POP P,PA3
	POPJ P,


GO:	CAR A,(A)
	HRROM A,PA3
	HLLE B,(A)
	AOJE B,FALSE
	PUSHJ P,EVAL
	JRST GO+1


RETURN:	HLL A,PA4
	TLZ A,-2
	DAC A,PA4
	POPJ P,

SETQ:	CAR B,(A)
	PUSH P,B
	PUSHJ P,CADR
	PUSHJ P,EVAL
	LAC B,A
	POP P,A
SET:	LAC AR1,B
	PUSHJ P,BIND
	SUB SP,[XWD 1,1]
	LAC A,AR1
	POPJ P,

CON2:	CDR A,(T)
COND:	JUMPE A,CPOPJ	;entry
	PUSH P,A
	CAR A,(A)
	CAR A,(A)
	PUSHJ P,EVAL
	POP P,T
	JUMPE A,CON2
	CAR T,(T)
COND2:	CDR T,(T)
	JUMPE T,CPOPJ
	PUSH P,T
	CAR A,(T)
	PUSHJ P,EVAL
	POP P,T
	JRST COND2
SUBTTL ARITHMETIC SUBROUTINES --- PAGE 11

;macro expander -- (foo a b c) => (*foo (*foo a b) c)
EXPAND:	LAC C,B
	CDR A,(A)
	PUSHJ P,REVERSE
	JRST EXPA1

EXPN1:	LAC C,B
EXPA1:	CDR T,(A)
	CAR A,(A)
	JUMPE T,CPOPJ
	PUSH P,A
	LAC A,T
	PUSHJ P,EXPA1
	EXCH A,(P)
	PUSHJ P,NCONS
	POP P,B
	PUSHJ P,XCONS
	LAC B,C
	JRST XCONS


ADD1:	CAILE A,INUMIN
	CAIL A,-2
	SKIPA B,[INUM0+1]
	AOJA A,CPOPJ
.PLUS:	JSP C,OP
	ADD A,TT
	FADR A,TT

SUB1:	CAILE A,INUMIN+1
	SOJA A,CPOPJ
	MOVEI B,INUM0+1
.DIF:	JSP C,OP
	SUB A,TT
	FSBR A,TT

.TIMES:	JSP C,OP
	IMUL A,TT
	FMPR A,TT

.QUO:	CAIN B,INUM0
	JRST ZERODIV
	JSP C,OP
	IDIV A,TT
	FDVR A,TT

.GREAT:	EXCH A,B
	JUMPE B,FALSE
.LESS:	JUMPE A,CPOPJ
	JSP C,OP
	JRST COMP2	;bignums know about me
	JRST COMP2

COMP2:	CAML A,TT
	JRST FALSE
	JRST TRUE
MAKNUM:
FOO	CAIN B,FIXNUM
	JRST FIX1A
FLO1A:
FOO	MOVEI B,FLONUM
	PUSHJ P,FWCONS
	JRST ACONS-1

FIX1B:	SUBI A,INUM0
FOO	MOVEI B,FIXNUM
	PUSHJ P,FWCONS
	JRST ACONS-1

NUMVLX:	JFCL 17,.+1
NUMVAL:	CAIG A,INUMIN
	JRST NUMAG1
	SUBI A,INUM0
FOO	MOVEI B,FIXNUM
	POPJ P,

NUMAG1:	DAC A,AR1
	CDR A,(A)
	CAR B,(A)
	CDR A,(A)
FOO	CAIE B,FIXNUM
FOO	CAIN B,FLONUM
	SKIPA A,(A)
NUMV4:	SKIPA A,AR1
	POPJ P,
NUMV2:	PUSHJ P,EPRINT	;bignums know about me
	JRST NONNUM

NUMV3:	JRST NONNUM		;bignums change me to JRST BIGDIS
FLOAT:	IDIVI A,400000
	SKIPE A
	TLC A,254000
	TLC B,233000
	FADR A,B
	POPJ P,

FIX:	PUSH P,A
	PUSHJ P,NUMVAL
FOO	CAIE B,FLONUM
	JRST POPAJ
	MULI A,400
	TSC A,A
	JFCL 17,.+1
	ASH B,-243(A)
FIX2:	JFCL 10,FIXOV	;bignums change me to jfcl 10,bfix
	POP P,A
FIX1:	LAC A,B
	JRST FIX1A

MINUSP:	PUSHJ P,NUMVAL
	JUMPGE A,FALSE
	JRST TRUE

MINUS:	PUSHJ P,NUMVLX
	MOVNS A
	JFCL 10,@OPOV
	JRST MAKNUM

ABS:	PUSHJ P,NUMVLX
	MOVMS A
	JRST MINUS+2
DIVIDE:	CAIN B,INUM0
	JRST ZERODIV
	JSP C,OP
	JUMPN RDIV		;bignums know about me
	JRST ILLNUM
RDIV:	IDIV A,TT
	PUSH P,B
	PUSHJ P,FIX1A
	EXCH A,(P)
	PUSHJ P,FIX1A
	POP P,B
	JRST XCONS

REMAINDER:
	PUSHJ P,DIVIDE
	JRST CDR.

FIXOV:	ERR1 [SIXBIT /INTEGER OVERFLOW!/]
ZERODIV:ERR1 [SIXBIT /ZERO DIVISOR!/]
FLOOV:	ERR1 [SIXBIT /FLOATING OVERFLOW!/]
ILLNUM:	ERR1 [SIXBIT /NON-INTEGRAL OPERAND!/]

GCD:	JSP C,OP
	JUMPA GCD2	;bignums know about me
	JRST ILLNUM
GCD2:	MOVMS A
	MOVMS TT
;euclid's algorithm
GCD3:	CAMG A,TT
	EXCH A,TT
	JUMPE TT,FIX1A
	IDIV A,TT
	LAC A,B
	JRST GCD3
;general arithmetic op code routine for mixed types

OP:	CAIG A,INUMIN
	JRST OPA1
	SUBI A,INUM0
	CAIG B,INUMIN
	JRST OPA2
	HRREI TT,-INUM0(B)
	XCT (C)	;inum op  (cannot cause overflow)
FIX1A:	ADDI A,INUM0
	CAILE A,INUMIN
	CAIL A,-1
	JRST FIX1B
	POPJ P,

OPA1:	CDR A,(A)
	CAR T,(A)
	CDR A,(A)
FOO	CAIE T,FIXNUM
	JRST OPA6
	SKIPA A,(A)
OPA2:
FOO	MOVEI T,FIXNUM
	CAILE B,INUMIN
	JRST OPB2
	CDR B,(B)
	CDR TT,(B)
	CAR B,(B)
FOO	CAIE B,FIXNUM
	JRST OPA5
	SKIPA TT,(TT)
OPB2:	HRREI TT,-INUM0(B)
	LAC AR1,A
	JFCL 17,.+1
	XCT (C)	;fixed pt op
OPOV:	JFCL 10,FIXOV	;bignums change this to jfcl 10,fixovl
	JRST FIX1A

OPA6:	CAILE B,INUMIN
	JRST OPB7
	CDR B,(B)
	CDR TT,(B)
	CAR B,(B)
FOO	CAIE B,FLONUM
	JRST OPB3
FOO	CAIE T,FLONUM
	JRST NUMV3
	LAC A,(A)
	LAC TT,(TT)
OPR:	JFCL 17,.+1
	XCT 1(C)	;flt pt op
	JFCL 10,FLOOV
	JRST FLO1A

OPA5:
FOO	CAIE B,FLONUM
	JRST NUMV3
	PUSHJ P,FLOAT
	JRST OPR-1

OPB3:
FOO	CAIE B,FIXNUM
	JRST NUMV3
	SKIPA TT,(TT)
OPB7:	HRREI TT,-INUM0(B)
FOO	MOVEI B,FIXNUM
FOO	CAIE T,FLONUM
	JRST NUMV3
	LAC A,(A)
	EXCH A,TT
	PUSHJ P,FLOAT
	EXCH A,TT
	JRST OPR
SUBTTL EXPLODE, READLIST AND FRIENDS --- PAGE 12

FLATSIZE:	HLLZS FLAT1
	MOVEI R,FLAT2
	PUSHJ P,PRINTA
FLAT1:	MOVEI A,X			;*
	JRST FIX1A
FLAT2:	AOS FLAT1
	POPJ P,


%EXPLODE:	SKIPA R,.+1
EXPLODE:	HRRZI R,EXPL1
	MOVSI AR1,AR1
	PUSHJ P,PRINTA
	JRST SUBS4

EXPL1:	PUSH P,B
	PUSH P,C
	ANDI A,177
	CAIL A,"0"
	CAILE A,"9"
	JRST EXPL2
	ADDI A,INUM0-"0"
	JRST EXPL4

EXPL2:	PUSH P,AR1
	PUSH P,TT
	PUSH P,T
	LSH A,35
	LAC C,SP
	PUSH C,A
	MOVEI AR1,1
	PUSHJ P,INTER0
	POP P,T
	POP P,TT
	POP P,AR1
EXPL4:	PUSHJ P,NCONS
	HLR B,AR1
	DAP A,(B)
	DIP A,AR1
	POP P,C
	JRST POPBJ
READLIST:	TDZA T,T
MAKNAM:	MOVNI T,1
	DAC T,NOINFG
	PUSH P,OLDCH
	SETZM OLDCH
	JUMPE A,NOLIST
	DAP A,MKNAM3
	MOVEI A,MKNAM2
	PUSHJ P,READ0
	CDR T,MKNAM3
	CAIE T,-1
	JUMPN T,[ERR1 [SIXBIT /MORE THAN ONE S-EXPRESSION-MKNAM!/]]
	POP P,OLDCH
	POPJ P,

MKNAM2:	PUSH P,B
	PUSH P,T
	PUSH P,TT
MKNAM3:	MOVEI TT,X
	JUMPE TT,MKNAM6
	CAIN TT,-1
	ERR1 [SIXBIT /READ UNHAPPY-MAKNAM!/]
	CDR B,(TT)
	DAP B,MKNAM3
	CAR A,(TT)
	CAIGE A,INUMIN
	JRST MKNAM5
	SUBI A,INUM0-"0"
MKNAM4:	POP P,TT
	POP P,T
	JRST POPBJ

MKNAM5:	CAR A,(TT)
FOO	MOVEI B,PNAME
	PUSHJ P,GET
	CAR A,(A)
	LDB A,[POINT 7,(A),6]
	JRST MKNAM4

MKNAM6:	MOVEI A," "
	HLLOS MKNAM3
	JRST MKNAM4