;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** KLUDGY BINFORD EDITOR *******************
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1979 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************

.FASL
IF1,[
.INSRT SYS:.FASL DEFS
10% .INSRT DSK:SYSTEM;FSDEFS >
10$ .INSRT LISP;DECDFS >
10$ .DECDF
NEWRD==0
]		;END OF IF1
TMPC==0		;TEMPORARY I/O CHANNEL IN NEWIO

VERPRT K/l/u/d/g/y/ B/i/n/f/o/r/d/ E/d/i/t/o/r

.SXEVAL (SETQ EDPRFL/| T EDPRN/| #11.  EDSRCH/| ()
		EDLP/| (COPYSYMBOL (QUOTE %I/(%) ())
		EDRP/| (COPYSYMBOL (QUOTE %I/)%) ())
		EDSTAR/|  (COPYSYMBOL (QUOTE %D/(/)%) ())
		EDEX2-SB/| () EDEX2-INDEX/| #0 ^^^ () )
.SXEVAL (AND (OR (NOT (BOUNDP (QUOTE EDIT))) (NULL EDIT)) 
	     (SETQ EDIT (QUOTE (EXPR FEXPR MACRO))))
.SXEVAL (SSTATUS FEATURE EDIT)


SUBTTL	KLUDGY BINFORD EDITOR

EDPRW==13	;PRINT WIDTH,PRINT N ATOMS ON 
			;EITHER SIDE OF POINTER
	R4==AR1
	R5==AR2A
	R6==T

.ENTRY EDIT FSUBR 0
$EDIT:	MOVE B,A

	JSP D,BRGEN	;ERRSET LOOP
	JUMPE B,EDTTY
	HLRZ A,(B)
	PUSH P,CEDTTY
	JRST EDY0

EDTTY:	SKIPE .SPECIAL EDPRFL/|
	PUSHJ P,EDPRINT
EDTTY4:	MOVEI C,0	;INIT NUMBER
	MOVEI B,0	;INIT SYMBOL,NUMBERS COME HERE
	MOVE R4,[220600,,B]	;SETUP BYTEP
EDTYIN:	SAVE B C R4
	NCALL 0,.FUNCTION *TYI
	RSTR R4 C B
	MOVE R5,.SPECIAL READTABLE
	MOVE R5,@TTSAR(R5)
NW%	TLNN R5,4
NW$	TRNN R5,RS.DIG
	JRST EDTTY1	;NOT NUMBER
EDNUM:	IMULI C,10.	;ACCUMULATE DECIMAL NUMBER
NW%	ADDI C,-"0(R5)
NW$	ANDI R5,777
NW$	ADDI C,-"0(R5)
	JRST EDTYIN

EDTTY1:	CAIE TT,15
	CAIN TT,12
	JRST EDTYIN
	CAIE TT,33
	CAIN TT,177
	JRST EDTTY3
	CAIN TT,40
	JRST EDTTY2
NW%	TLNN R5,377777
NW$	TDNN R5,[001377777000]	;??
	JRST EDTYIN
NW%	TLNN R5,70053	;LEGIT CHARS ARE <ALPHA> ( ) - , .
NW$	TDNN R5,[RS.LTR+RS.XLT+RS.LP+RS.RP+RS.DOT+RS.SGN+RS.ALT]	;RS.ALT??
	JRST EDERRC
	ADDI R5,40
	TLNE R4,770000	;SIXBIT THREE CHARS
	IDPB R5,R4
	JRST EDTYIN	;READ NEXT CHAR

EDTTY2:	JUMPE B,EDTYIN	;IGNORE LEADING SPACES
	PUSHJ P,EDSYM
	JRST EDTTY

EDTTY3:	SKIPE .SPECIAL EDPRFL/|
	STRT7 [ASCII \
  
!\]
	JRST EDTTY4

		;SEARCH SYMBOL TABLE
EDSYM:	MOVEI R5,EDSYML-1
EDSYM1:	MOVS R6,EDSYMT(R5)
	CAIE B,(R6)
	SOJGE R5,EDSYM1
	JUMPL R5,EDSYM3
	MOVE R4,R5
	ADDI R4,IN0
	MOVEM R4,.SPECIAL EDEX2-INDEX/| 
	MOVSS R6
	CAIL R5,EDRPT
	 JRST (R6)
EDEX1:	PUSH P,C
	MOVE R6,@.SPECIAL EDEX2-INDEX/| 
	MOVE R6,EDSYMT(R6)
	PUSHJ P,(R6)			;EXECUTE COMMAND
	SOSLE C,(P)
	JUMPN A,.-4
EDEX3:	POP P,B
	POPJ P,

EDSYM3:	PUSH FXP,C
	MOVE C,[440700,,PNBUF]
	MOVE R4,[440600,,B]
	MOVSI B,(B)
	SETOM LPNF
	SETZM PNBUF
	JRST EDSYM5
EDSYM4:	ADDI A,40
	IDPB A,C
EDSYM5:	ILDB A,R4
	JUMPN A,EDSYM4
	PUSHJ P,RINTERN
	MOVEI B,.ATOM EDIT
	CALL 2,.FUNCTION GET
	POP FXP,TT
	JUMPE A,EDERRC
	MOVEI AR1,(A)
	JSP T,FXCONS
	JCALLF 1,(AR1)

EDERRC:	STRT [SIXBIT \?? !\]
CEDTTY:	JRST EDTTY


EDSYMT:		;COMMAND TABLE
EDSYMB:	+(SIXBIT \B\),,EDB	;BACK,LEFT PAST ATOM
	+(SIXBIT \D\),,EDDOWN	;DOWN
EDSYMF:	+(SIXBIT \F\),,EDF	;FORWARD,RIGHT ATOM
	+(SIXBIT \U\),,EDUP	;UP
	+(SIXBIT \L\),,EDLL	;LEFT PAST S-EXPR
	+(SIXBIT \R\),,EDRR	;RIGHT PAST S-EXPR
	+(SIXBIT \K\),,EDKILL	;KILL
	+(SIXBIT \-K\),,EDLKILL	;LEFT, THEN KILL
	+(SIXBIT \-L\),,EDRR
	+(SIXBIT \-R\),,EDLL
	+(SIXBIT \PW\),,EDPW	;SET PRINT WIDTH
EDSYMP:	+(SIXBIT \PQ\),,EDPRA	;INTERNAL PRINT

	+(SIXBIT \EV\),,REP	;EVAL
	+(SIXBIT \I\),,EDI	;INSERT
	+(SIXBIT \KI\),,EDKI	;REPLACE,I E KILL INSERT
	+(SIXBIT \-KI\),,EDMKI	;REPLACE TO LEFT
	+(SIXBIT \IV\),,EDIV	;INSERT VALUE OF ARG
	+(SIXBIT \P\),,EDPR0	;PRINT
	+(SIXBIT \Q\),,EDQ	;QUIT,EXIT FROM EDIT
	+(SIXBIT \S\),,EDS	;SEARCH
	+(SIXBIT \SS\),,EDSAVE	;SAVE SPOT
	+(SIXBIT \RS\),,EDRSTR	;RESTORE SPOT
	+(SIXBIT \SP\),,EDCHPR	;START-PRINTING (OR STOP-PRINTING)
	+(SIXBIT \J\),,EDTOP	;TOP
	+(SIXBIT \Y\),,EDY	;YANK
	+(SIXBIT \YP\),,EDYP	;YANK PROP LIST, OR SPECIFIC PROPERTY
	+(SIXBIT \YV\),,EDYV	;YANK VALUE
	+(SIXBIT \(\),,EDLP.	;INSERT VIRTUAL LEFT PAREN
	+(SIXBIT \)\),,EDRP.	;INSERT VIRTUAL RIGHT PAREN
	+(SIXBIT \D(\),,EDXLP	;VIRTUAL DELETION OF PAREN
	+(SIXBIT \D)\),,EDXLP	;VIRTUAL DELETION OF PAREN
	+(SIXBIT \()\),,EDZZ	;RESTRUCTURE ACCORDING TO VIRTUAL PARENS

EDSYML==.-EDSYMT
EDRPT==EDSYMP+1-EDSYMT	;NO REPEAT FOR COMMANDS ABOVE EDSYMP



		;EDIT MANIPULATES TWO LISTS FOR BACKING UP
		;THE LEFT LIST CALLED L (VALUE OF  (3 ALTMODES))
		;RIGHT: (COND ((PTR (CAR L)) (SETQ L (CONS (CDAR L) L))))
		;LEFT: (COND ((PTR L) (SETQ L (CDR L))))
		;THE UP LIST U (KEPT AT EDUPLST)
		;DOWN: (COND ((AND (PTR (CAR L)) (PTR (CAAR L)))
		;	      (SETQ U (CONS L U))
		;	      (SETQ L (LIST L))))
		;UP:   (COND ((PTR U) (SETQ L (CAR U))
		;	      (SETQ U (CDR U))))

EDQ:	MOVEI A,.ATOM *
	MOVEI B,.ATOM BREAK
	JRST ERUNDO-1		;THROW OUT OF BREAK ERRSET LOOP

		;RIGHT PAST S-EXPR
		;USES ONLY A,B ;NIL IF FAILS
EDR:	PUSHJ P,EDCAR
	JRST EFLSE			;NOT A PTR
	HRRZ A,(A)			;TAKE CDAR L
	HRRZ B,.SPECIAL 
	CALL 2,.FUNCTION CONS		;CONS ONTO L
EDR1:	HRRZM A,.SPECIAL 		;STORE IN L
	POPJ P,				;NON-ZERO,VALUE EDIT

EDLEFT:	SKIPE A,.SPECIAL  		;TAKE CDR IF NON-NIL
	HRRZ A,(A)
	JUMPE A,EFLSE
	JRST EDR1


		;DOWN ONE LEVEL
		;USES ONLY A,B	
		;NIL IN A IF FAILS
EDDOWN:	PUSHJ P,EDCAAR			;IS (CAAR L) A PTR
	JRST EFLSE			;NOT PTR
	CALL 1,.FUNCTION NCONS
	EXCH A,.SPECIAL 		;STORE IN L
	HRRZ B,.SPECIAL ^^^
	CALL 2,.FUNCTION CONS		;CONS L U
EDD1:	HRRZM A,.SPECIAL ^^^		;STORE IN U
	POPJ P,	;NON-ZERO




		;BACK
EDB:	PUSHJ P,EDLEFT	;LEFT?
	JUMPE A,EDUP
	PUSHJ P,EDCAAR	;NEXT IS ATOM?
	JRST EDTRUE
EDB1:	PUSHJ P,EDDOWN	;DOWN
	JUMPE A,EDUP
EDXR:	PUSHJ P,EDR	;EXTREME RIGHT
	JUMPN A,.-1
	JRST EDTRUE


		;FORWARD
		;RIGHT ATOM
EDF:	PUSHJ P,EDCAR	;CAR L PTR?
	 JRST EDF2	;NOT PTR
	PUSHJ P,EDCAR1	;(CAAR L) ATOM
	 JRST EDR	;ATOM,GO RIGHT
EDF1:	PUSHJ P,EDDOWN	;DOWN?
	JUMPN A,CPOPJ
EDF2:	PUSHJ P,EDUP		;UP?
	JUMPN A,EDR		;AND RIGHT?OTHERWISE FALLS THROUGH TO EDUP
EDUP:	SKIPN A,.SPECIAL ^^^	;UP ONE LEVEL
	 JRST EFLSE
	MOVE A,(A)
	JUMPE A,EFLSE
	HLRZM A,.SPECIAL 	;L=(CAR U)
	JRST EDD1

EFLSE:	TDZA A,A
EDTRUE:	MOVEI A,.ATOM T
	POPJ P,

EDRR:	PUSHJ P,EDR
	JUMPN A,CPOPJ
	JRST EDF
EDLL:	PUSHJ P,EDLEFT
	JUMPN A,CPOPJ
	JRST EDUP


REP:	PUSHJ	P,EIREAD
	CALL 1,.FUNCTION *EVAL
	JCALL 1,.FUNCTION READ-EVAL-*-PRINT


EDPR0:	SKIPE .SPECIAL EDPRFL/|
	POPJ P,
EDPRINT:	PUSH P,.SPECIAL 
	PUSH P,.SPECIAL ^^^		;SAVE CURRENT LOCATION
	CALL 0,.FUNCTION *TERPRI
	MOVN C,@.SPECIAL EDPRN/|	;ATOM COUNT
	PUSHJ P,EDB			;MOVE BACK N TOKENS
	JUMPE A,.+2
	AOJL C,.-2
	ADD C,@.SPECIAL EDPRN/|		;PRINT FORWARD 2N ATOMS
	ADD C,@.SPECIAL EDPRN/|	
	MOVEI T,IN0+<EDSYMP-EDSYMT>
	MOVEM T,.SPECIAL EDEX2-INDEX/|
	SKIPE @.SPECIAL EDPRN/|
	PUSHJ P,EDEX1
	CALL 0,.FUNCTION *TERPRI
EDPRX:	POP P,.SPECIAL ^^^	;RESTORE CURRENT LOCATION
	POP P,.SPECIAL 
	POPJ P,

EDPRA:	MOVSI T,400000
	CAME C,@.SPECIAL EDPRN/|		;CURRENT LOCATION?
	JRST .+3
	STRT7 [ASCII \  \]
	SETZM .SPECIAL EDEX2-SB/|
	SKIPN A,.SPECIAL 
	JRST EDF		;EXIT IF NOTHING MORE
	PUSH P,.-1		;PRINT ONE TOKEN AND MOVE FORWARD
	PUSHJ P,EDCAR1		;(CAR L) A PTR
	JRST EDPRG
	SKIPE .SPECIAL EDEX2-SB/|
	STRT [SIXBIT \ !\]		;  CALL REQUESTED IT
	MOVE T,.ATOM T
	MOVEM T,.SPECIAL EDEX2-SB/|	;ASSUMING NEXT IS ATOM, ASK FOR SPACE
	PUSHJ P,EDCAR1
	 JRST EIPRIN1			;(CAAR L) IS ATOM, SO PRIN1 IT
	SETZM .SPECIAL EDEX2-SB/|
	MOVEI A,IN0+"(			;AND BEGIN PRINTING A LIST
	JCALL 1,.FUNCTION *TYO

EDPRG:	MOVE T,.ATOM T			;SINCE THIS SECTIONS ENDS BY PRINTING
	MOVEM T,.SPECIAL EDEX2-SB/|	;ASSUMING NEXT IS ATOM, ASK FOR SPACE
	JUMPE A,EDPRG1			;A ")", THEN REQUEST SPACE ON NEXT
	STRT [SIXBIT \ . !\]
	PUSHJ P,EIPRIN1
EDPRG1:	MOVEI A,IN0+")
	JCALL 1,.FUNCTION *TYO


EDSAVE:	CALL 0,.FUNCTION *-READ-EVAL-PRINT	;SAVE CURRENT EDITING SPOT AS THE VALUE OF SOME ATOM
	SKIPN AR1,A
	JRST EDERRC
	CALL 1,.FUNCTION TYPEP
	CAIE A,.ATOM SYMBOL
	JRST EDERRC
	MOVE A,.SPECIAL 
	MOVE B,.SPECIAL ^^^
	CALL 2,.FUNCTION CONS
	JSP T,.SET
	POPJ P,

EDRSTR:	CALL 0,.FUNCTION *-READ-EVAL-PRINT	;SET CURRENT EDITINT SPOT TO THAT SAVED UP IN SOME ATOM
	CALL 1,.FUNCTION *EVAL
	HLRZ B,(A)
	MOVEM B,.SPECIAL 
	HRRZ A,(A)
	MOVEM A,.SPECIAL ^^^
	POPJ P,



EDCHPR:	SKIPE .SPECIAL EDPRFL/|
	TDZA T,T
	MOVEI T,.ATOM T
	MOVEM T,.SPECIAL EDPRFL/|
	POPJ P,

EDPW:	PUSH FXP,TT
	MOVE TT,C
	JSP T,FIX1A
	MOVEM A,.SPECIAL EDPRN/|	;SET PRINT WIDTH
	POP FXP,TT
	MOVEI A,NIL
EPOPJ1:	POP P,T
	JRST 1(T)

EDCAAR:	PUSHJ P,EDCAR
EDCAR:	SKIPE A,.SPECIAL 
EDCAR1:	HLRZ A,(A)		;MUST PRESERVE T FOR EDPRA
	SKIPN TT,A
	POPJ P,
	LSH TT,-SEGLOG
	SKIPGE ST(TT)
	AOS (P)
	POPJ P,


		;INSERT:(SETQ L2(CAR L))
		;   (COND((LEFT)(RPLACD(CAR L)(CONS I L2))
			;		(RIGHT)(RIGHT))
		;	((UP)(RPLACA(CAR L)(CONS I L2))
		;		(DOWN)(RIGHT)))


		;KILL:(SETQ L2(CAR L))
		;  (COND((LEFT)(RPLACD(CAR L)(CDR L))
		;		(RIGHT))
		;	((UP)(RPLACA(CAR L)(CDR L2))
		;		(DOWN)))



		;INSERT ONE S-EXPR
		;USES A,B AND WHATEVER READ SMASHES
EDI:	PUSHJ P,EDREAD	;GET S-EXPR
EDIB:	MOVEI D,EDIA
	JRST EDMAP
EDIV:	CALL 0,.FUNCTION *-READ-EVAL-PRINT
	CALL 1,.FUNCTION *EVAL
	MOVE B,A


EDIA:	SKIPE A,.SPECIAL 
	HLRZ A,(A)
EDIC:	CALL 2,.FUNCTION XCONS
	MOVE B,A
EDID:	PUSHJ P,EDK1	
	JRST EDR



EDLKILL:	PUSHJ P,EDLEFT
	JUMPE A,CPOPJ
EDKILL:
EDKA:	PUSHJ P,EDCAR	;KILL ONE S-EXP
	SKIPA B,A	;USES A,B
	HRRZ B,(A)
	HLRZ A,(A)
	HRRZM A,.SPECIAL 
EDK1:	PUSHJ P,EDLEFT	;LEFT?
	JUMPE A,EDI2
	PUSHJ P,EDCAR
	JRST EDI2
	HRRM B,(A)	;(RPLACD (CAR L) Q)
EDK2:	JRST EDR

		;RETURNS NIL IF FAILS
EDI2:	PUSHJ P,EDUP	;UP?
	JUMPE A,EFLSE
	PUSHJ P,EDCAR	;IS (CAR L) POINTER
	JRST EFLSE
	HRLM B,(A)	;(RPLACA (CAR L) Q)
EDI3:	JRST EDDOWN


EDRDATOM:	CALL 0,.FUNCTION *-READ-EVAL-PRINT
	MOVE B,A
	CALL 1,.FUNCTION ATOM
	JUMPE A,EDERRC
	MOVEI A,(B)
	POPJ P,

EDY:	PUSHJ P,EDRDATOM
EDY0:	MOVE B,.SPECIAL EDIT
	CALL 2,.FUNCTION GETL
	JUMPE A,EDERRC
EDYX:	CALL 1,.FUNCTION NCONS
EDYX1:	SETZM .SPECIAL ^^^
	JRST EDR1

EDYV:	PUSHJ P,EDRDATOM
	MOVEI B,.ATOM VALUE
	JRST EDY2A

EDYP:	PUSHJ P,EDREAD
	HRRZ B,(A)
	JUMPE B,EDY1
	HLRZ A,(A)
EDY2:	HLRZ B,(B)
EDY2A:	MOVEI C,(B)
	CAIN C,.ATOM VALUE
	 JRST EDY3
	CALL 2,.FUNCTION GET
	JRST EDYX

EDY1:	HLRZ A,(A)		;GET ATOM READ
	HRRZ A,(A)		;GET ITS PLIST
	JRST EDYX

EDY3: 	NCALL 1,.FUNCTION VALUE-CELL-LOCATION
	HRRZ A,(TT)
	CAIN A,QUNBOUND
	 JRST EDERRC
	JRST EDYX



		;READS A STRING OF S-EXPRS TERM BY 
		;FORMS A LIST IN PROPER DIRECTION


EDREAD:	PUSHJ P,EIREAD	;GET S-EXPR
	CAIN A,.ATOM 		; TERMINATES
	JRST EFLSE
	PUSH P,A
	PUSHJ P,EDREAD	;FORM LIST BY RECURSION
	POP P,B
	JCALL 2,.FUNCTION XCONS

EIREAD:	MOVEI T,0
	SKIPE .SPECIAL READ
	JCALLF 16,@.SPECIAL READ
	JCALL 0,.FUNCTION *-READ-EVAL-PRINT

EIPRIN1: SKIPN T,.SPECIAL PRIN1
	  JCALL 1,.FUNCTION *PRIN1
	JCALLF 1,(T)

		;SEARCH
		;PERMITS SEARCH FOR FRAGMENTS OF AN
		;S-EXPR.  FORMATS 3S A B C 
		;3S A B C /)      OR S /( X Y Z 

EDS:	PUSH P,.SPECIAL 
	PUSH P,.SPECIAL ^^^	;SAVE ORIGINAL LOCATION
	PUSH P,C		;SAVE COUNT
	PUSHJ P,EDREAD		;READ STRING OF S-EXPRS
	JUMPN A,.+2
	SKIPA A,.SPECIAL EDSRCH/|
	MOVEM A,.SPECIAL EDSRCH/|
	PUSH P,A	;SAVE READ LIST
EDS1:	PUSH P,.SPECIAL 
	PUSH P,.SPECIAL ^^^
EDS11:	MOVE A,-2(P)	;ARG IN B
	MOVEI D,EDS3
	PUSHJ P,EDMAP	;DOES CURRENT LOC MATCH?
	JUMPN A,EDSN	;WE HAVE A MATCH
EDS1A:	POP P,.SPECIAL ^^^
	POP P,.SPECIAL 
	PUSHJ P,EDF	;NO MATCH,GO RIGHT ATOM
	JUMPN A,EDS1	;FINISHED,SEARCH FAILS
EDSF:	SUB P,R70+2
	JRST EDPRX	;EXIT RESTORE ORIG LOC
EDSN:	SOSLE -3(P)	;DECREMENT COUNT
	JRST EDS11	;NOT FININSHED,MATCH AGAIN
	SUB P,R70+6	;RESTORE PDL
	JRST EFLSE	;TO AVOID REPEATS BY EDEV



		;TEST CURRENT LOCATION
		;A IS QUANTITY TO TEST
		;(CAR L) IS THE CURRENT LIST
		;(COND
		;	((NULL(PTR(CAR L)))
		;		(COND((EQ A(QUOTE /) ))(RIGHTA))))
		;	((NULL(PTR(CAAR L)))
		;		(COND((EQ A(CAAR L))(RIGHTA))))
	
		;	((EQUAL A(CAAR L))(RIGHT))
		;	((EQ A(QUOTE /())(RIGHTA)))



		;TEST CURRENT LOCATION
		;ARG A IS IN B

EDS3:	PUSHJ P,EDCAR	;IS(CAR L)POINTER
	JRST EFLSE 
	HLRZ A,(A)
	CALL 2,.FUNCTION EQUAL	;(EQUAL A(CAAR L))
	JUMPE A,EFLSE
	JRST EDR

		;MAP DOWN LIST
EDMAP:	MOVE R,A
EDMAP2:	JUMPE R,EDTRUE
	HLRZ B,(R)	;TAKE CAR
	PUSHJ P,(D)	;FUNARG
	JUMPE A,CPOPJ	;MATCH FAILS
	HRRZ R,(R)
	JRST EDMAP2

EDTOP:	MOVEI C,100000
	HLRZ B,EDSYMB
	JRST EDSYM


EDMKI:	PUSHJ P,EDLEFT
	JUMPE A,CPOPJ
EDKI:	CALL 0,.FUNCTION *-READ-EVAL-PRINT
EDKI1:	MOVE B,A
	PUSHJ P,EDCAR		;IF PTR IS ATOM RPLACD
	JRST EDID
;	HRRZ C,(A)		;I THINK THESE SCREW UP TOTALLY - GLS
;	HLRZ C,(C)
;	HRRZM C,.SPECIAL 
	HRLM B,(A)		;RPLACA
	JRST EDR


;		;(CAAR L) ATOM MATCH ONLY (EQ A(CAAR L))
;EDS3B:	CAME A,B
;	JRST EFLSE
;	JRST EDR
;		;CURRENT LIST FINISHED,CAN ONLY MATCH /)
;EDS3A:	JUMPN A,EDS3B
;	CAIN B,RPAREN
;	JRST EDF
;	JRST EFLSE
;EDIP:	PUSHJ P,EDCAR	;INSERT PARENS
;	JUMPN A,EFLSE	;AROUND NEXT ELEMENT
;	HLRZ A,(A)
;	PUSHJ P,NCONS
;	JRST EDKI1
;
;EDDP:	PUSHJ P,EDCAAR	;DELETE PARENS
;	JRST EFLSE
;	PUSHJ P,EDIB
;	JRST EDKA



EDRP.:	SKIPA B,.SPECIAL EDRP/|
EDLP.:	MOVE B,.SPECIAL EDLP/|		;INSERT VIRTUAL LEFT PAREN
	JRST EDIA
EDXLP:	MOVE B,.SPECIAL EDSTAR/|	;INSERT CHAR TO DELETE NEXT PAREN
	JRST EDIA


EDZZ:	PUSHJ P,EDTOP	;RESTRUCTURE W/ VIRTUAL PARENS
	PUSHJ P,EDF
	PUSHJ P,EDXA
	PUSH P,A
	PUSHJ P,EDTOP
	PUSHJ P,EDF
	POP P,A
	JRST EDKI1
EDXE:	SKIPE A,.SPECIAL ^^^
	PUSHJ P,EDF
EDXZ:	SKIPE A,.SPECIAL ^^^
EDXA:	PUSHJ P,EDF		;FORWARD
EDXX:	SKIPE  A,.SPECIAL ^^^
	PUSHJ P,EDCAR		;(PTR(CAR L))
	POPJ P,			;ATOM(CAR L)
	HLRZ B,(A)		;(CAAR L)
	CAMN B,.SPECIAL EDRP/|	;IS IS /)?
	JRST EFLSE		;SKIP AND RETURN FALSE
	CAMN B,.SPECIAL EDSTAR
	JRST EDXE
;	CAIN B,EDDOT	;IS IT /.?
;	JRST EDXD	;SKIP AND (EDXX(CAR A))
	PUSH P,A
	PUSHJ P,EDCAAR
	PUSHJ P,EDXY
EDXG:	PUSHJ P,EDXZ	;CONS(EDXX(CAR A))(EDXX(CDR A)))
EDXGA:	PUSH P,A
	PUSHJ P,EDXZ
	POP P,C
	POP P,B
	HRLM C,(B)	;RPLACA A (EDXX(CAR A))
	HRRM A,(B)
EXPOP:	EXCH A,B
	POPJ P,


EDXY:	CAME A,.SPECIAL EDLP/|
	 JRST EPOPJ1
	POPJ P,


FASEND