mirror of
https://github.com/PDP-10/its.git
synced 2026-02-17 13:17:18 +00:00
Builds all LISP; * FASL files that are on autoload properties when
the lisp interpreter is first booted. Redumps lisp compiler with updated FASL files built from source.
This commit is contained in:
Eric Swenson
645
src/lspsrc/edit.37
Executable file
645
src/lspsrc/edit.37
Executable file
@@ -0,0 +1,645 @@
|
||||
|
||||
;;; -*-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
|
||||
Reference in New Issue
Block a user