mirror of
https://github.com/PDP-10/its.git
synced 2026-01-27 12:42:10 +00:00
cc8e6c1964
the lisp interpreter is first booted. Redumps lisp compiler with updated FASL files built from source.
646 lines
13 KiB
Plaintext
Executable File
646 lines
13 KiB
Plaintext
Executable File
|
||
;;; -*-MIDAS-*-
|
||
;;; **************************************************************
|
||
;;; ***** MACLISP ****** KLUDGY BINFORD EDITOR *******************
|
||
;;; **************************************************************
|
||
;;; ** (C) COPYRIGHT 1980 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 EDIT,37
|
||
|
||
.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, ;SKIP IF TYPEP IS "LIST"
|
||
LSH TT,-SEGLOG
|
||
SKIPL TT,ST(TT)
|
||
POPJ P,
|
||
TLNN TT,ST.HNK
|
||
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
|