TITLE	TEXT - PPL TEXT EDITING AND MANIPULATION  /EAT/15-FEB-73

	HISEG
	SEARCH	PPL

	SUBTTL	CONVERSE.WITH.USER

;'CONVERSE.WITH.USER' - CONVER(A)
;CALLED ON USER SUSPENSION, OCCURRENCE OF A STOP CODE, TERMINATION
;OF A PREVIOUS EXECUTABLE STATEMENT, OR EXECUTION OF THE INSTMT
;SYSTEM FN.  RETURNS THE PZ ADDRESS OF
;AN IMMEDIATELY EXECUTABLE STATEMENT, WHICH HAS A LINE NUMBER OF -2
;AND WHICH HAS BEEN TRANSLATED IN THE ENVIRONMENT OF THE AR ADDRESSED
;BY REGISTER A.  IN THE PROCESS OF CONVERSATION THE USER MAY EDIT
;FUNCTIONS AND ISSUE SYNTAX AND DATA DEFINITIONS.

;THIS ROUTINE DOES NOT CLOBBER ANY AC'S EXCEPT R AND R2

	A==	AC1	;ARG - ACTIVATION RECORD

CONVER:	MOVEM	CAR,SAVCAR	;SAVE CURRENT ACTIVATION RECORD
	SAVE	<A,B>		;PROTECT SOME AC'S
CONV1:	PUSHJ	P,GETTXT	;PERFORM EDITING, ETC.
	  JRST	  DDF		;DATA DEFINITION SEEN

;GETTXT HAS RETURNED WITH WHAT IT THINKS IS AN IMMEDIATELY EXECUTABLE
;LINE.
	MOVE	A,R		;GET ADDRESS OF ASCII TEXT BLOCK
	SETZM	L0BUF		;EX LINE TRANSLATION; NO LCLS,LBLS,ETC
	SETZM	LINENO		;DON'T PRINT LINE # IF ERROR
	TRO	FF,LEXCHK	;ONE PASS FOR CHECKING
	PUSHJ	P,PARSE		;IF ERRORS, NO DATA WILL HAVE BEEN CREATED
	  JRST	  CONV1		;ERROR, LET USER TRY AGAIN
	TRZ	FF,LEXCHK	;NOW TRANSLATE FOR REAL
	PUSHJ	P,PARSE
	  JRST	  CONV1
	MOVNI	R2,2		;LOAD -2
	HRRZ	B,(R)		;FETCH DZADR OF RETURNED LINE BLOCK
	SET	R2,NF		;SET LINE # FIELD TO -2
	SET	R2,INHF		;SET INH LINE # FIELD TO -2
;NOW WE MUST SCAN THE TRANSLATED LINE AND CHANGE GLOBALS TO LOCALS
;WHERE APPROPRIATE.

	PUSH	P,R		;SAVE PZADR OF LINE
	HRRZ	A,-2(P)		;GET AR ADDRESS
	JUMPE	A,CNVX		;A=0 MEANS NO ENVIRONMENT
	HRRZ	A,(A)		;GET ABS ADDRESS OF AR BLOCK
	HLRZ	A,1(A)		;GET FN ENTRY
	JUMPE	A,CNVX		;ZERO MEANS GLOBAL ENVIRONMENT
	HRRZ	A,(A)		;GET ABS ADDR OF FN BLOCK
	HLRZ	T2,1(A)		;SAVE #LCLS ENTRY (LCLS+FORMLS+PROCID)
	HLRZ	A,3(A)		;GET LINE 0 ENTRY
	HRRZ	A,(A)		;GET ABS ADDR OF LINE 0 BLOCK
	MOVSI	A,2(A)		;PREPARE TO TRANSFER ITS CONTENTS INTO L0BUF
	HRRI	A,L0BUF
	BLT	A,L0BUF+1(T2)	;TRANSFER COUNTS,PROCID,FORMLS,LCLS
	HLRZ	R,(B)		;FETCH LENGTH OF LINE BLOCK
	MOVNI	R,-2(R)		;COMPUTE - # OF LEXEMES
	HRLI	B,(R)		;PUT IN LH. RH POINTS TO 1ST LEXEME -2
SCNLXM:	HRRZ	A,2(B)		;FETCH RH OF A LEXEME
	HLRZ	R,2(B)		;FETCH LH OF A LEXEME
	CAIN	R,(LXM(STAK,ID)) ;IS IT AN ID?
	PUSHJ	P,SRCHL0	;YES, SEE IF IT IS AMOUNG LINE0 PARAMETERS
	JRST	SNXTID		;NO
	HRRZ	R,L0BUF(R)	;YES, GET PARAMETER NUMBER
	ANDCMI	R,CBRBIT	;REMOVE CALL-BY-REF BIT
	HRLI	R,(LXM(STAK,LCL)) ;ASSUME LEXEME IS LOCAL
	LDB	A,[POINT 12,L0BUF,11]	;GET # OF PARAMETERS
	CAIL	A,(R)		;SKIP IF LOCAL
	HRLI	R,(LXM(STAK,FORML)) ;NOT LOCAL, ASSUME FORMAL
	TRNN	R,-1		;SKIP IF NOT PROCID
	HRLI	R,(LXM(STAK,PROCID)) ;IT IS PROCEDURE ID
	MOVEM	R,2(B)		;STORE LEXEME BACK
SNXTID:	AOBJN	B,SCNLXM	;LOOP THRU LINE BLOCK
CNVX:	POP	P,R		;RESTORE PZADR OF LINE BLOCK
	POP	P,B		;RESTORE B
	JRST	X1		;RESTORE AC1 AND RETURN
;ACCEPT, CHECK, AND STORE A DATA DEFINITION
;LEX DOES MOST OF THE WORK, AND RETURNS AS FOLLOWS:
; LXMBUF[LH] : B.TYPE OF THE DDEF (WITH SYSBIT SET)
; LXMBUF[RH] : INTERNAL NAME OF THE DDEF
; R: SIZE OF DDEF BLOCK, CONTENTS OF WHICH START AT LXMBUF+1

DDF:	MOVE	AC1,R		;POINT TO ASCII TEXT
	PUSH	P,AC2		;SAVE ANOTHER AC
	MOVEI	AC2,2		;INDICATE TRANSLATION OF DDEF
	SETZM	LINENO		;PREVENT PRINTOUT OF LINE NUMBER IF ERROR
	CALL	LEX		;LEXICALLY ANALYZE AND TRANSLATE
	JRST	DDFDON		;AN ERROR WAS DETECTED
	HRRZ	AC1,R		;ALL OK, GET RETURNED BLOCK SIZE
	CALL	ALLOC		;ALLOCATE DDEF BLOCK OF PROPER SIZE
	MOVE	AC2,LXMBUF	;GET XWD BLOCK TYPE,DDEF NAME
	HLLM	AC2,(R)		;STORE BLOCK TYPE IN PZ WORD
	HRLI	R,I.DDEF	;CONSTRUCT IDT SYMBOL TABLE ENTRY
	ADD	AC2,@IDTP	;POINT AC2 TO ABSOLUTE STE
	MOVEM	R,(AC2)		;STORE DDEF ENTRY IN IDT
	ADD	AC1,R2		;POINT TO END+1 OF NEW BLOCK
	HRLI	R2,LXMBUF+1	;CONSTRUCT BLT POINTER
	ADDI	R2,1
	BLT	R2,-1(AC1)	;STORE DDEF BLOCK CONTENTS
	TTOS	1,[SIXBIT/#/]	;SIGNAL SUCCESSFUL DEFINITION
DDFDON:	POP	P,AC2		;RESTORE CLOBBERED AC
	JRST	CONV1
SUBTTL	CHARACTER TYPE TABLE

;THE TABLE IS PACKED HALF WORDS, EACH CHARACTER
;HAVING 18 BITS ASSOCIATED WITH IT.
;EDITING AND LEXICAL CHARACTERISTICS NOW DEFINED IN PPL.MAC

;MACRO FOR TABLE GENERATION

	DEFINE	X(A)
<	IFE CTN,<	CTHLF==	EXP A	>
	IFN CTN,<	XWD CTHLF,A	>
	CTN==	1-CTN	>

	CTN==	0
;CHARACTER TYPE TABLE

CTTBL:	X FNHDR				;NULL
	X SPEDT1+SPINS			;^A
	X 0				;^B
	X 0				;^C
	X 0				;^D
	X SPEDT1			;^E
	X 0				;^F
	X SPTIN+SPEDT1+ANYTIM		;^G
	X 0				;^H
	X NINS+SPEDT1+SPDEL+SEPRTR+SPINS ;^I (TAB)
	X SPTIN+SPEDT1+SPDEL+ANYTIM+SEPRTR	;LF
	X SPTIN+SPEDT1+ANYTIM		;VT
	X SPTIN+SPEDT1+ANYTIM		;FF
	X SPTIN+SPEDT1+ANYTIM		;CR
	X SPEDT1			;^N
	X 0				;^O
	X 0				;^P
	X 0				;^Q
	X SPEDT1			;^R
	X SPEDT1			;^S
	X SPEDT1			;^T
	X SPTIN+SPEDT1+ANYTIM		;^U
	X 0				;^V
	X 0				;^W
	X SPEDT1			;^X
	X 0				;^Y
IFE CTRLZU,<	X 0			;^Z NOT NORMALLY USED>
IFN CTRLZU,<	X SPTIN+SPEDT1+ANYTIM	;^Z REPLACES ^U ON SOME SYSTEMS>
REPEAT 5,<	X 0	>		;^[ TO ^_
	X NINS+SEPRTR			;SPACE
	X NINS+PUNCT			;!
	X NINS				;"
	X NINS+PUNCT			;#
	X NINS+PUNCT			;$
	X NINS+PUNCT+SPTYP		;%
	X NINS+PUNCT			;&
	X NINS				;'
	X NINS+PUNCT+FNHDR		;(
	X NINS+PUNCT			;)
	X NINS+PUNCT			;*
	X NINS+PUNCT+PLSMIN		;+
	X NINS+PUNCT			;,
	X NINS+PUNCT+PLSMIN		;-
	X NINS+PUNCT+SPTYP+PERIOD	;.
	X NINS+PUNCT			;/
REPEAT ^D8,<	X NINS+DIGIT+ODIGIT>	;0-7
	X NINS+DIGIT			;8
	X NINS+DIGIT			;9
	X NINS+PUNCT			;:
	X NINS+PUNCT+FNHDR		;;
	X NINS+PUNCT			;<
	X NINS+PUNCT			;=
	X NINS+PUNCT			;>
	X NINS				;?
	X NINS+PUNCT			;@
REPEAT 3,<	X NINS+LETTR	>	;A-C
REPEAT 2,<	X NINS+LETTR+LETDE>	;D-E
REPEAT ^D21,<	X NINS+LETTR	>	;F-Z
	X NINS+PUNCT			;[
	X NINS+PUNCT			;\
	X NINS+PUNCT			;]
	X NINS+PUNCT			;^
	X NINS+PUNCT			;_
	X 0				;ACCENT GRAVE (?)
REPEAT 3,<	X NINS+LETTR+SMLLET>	;SMALL LETTERS A-C
REPEAT 2,<	X NINS+LETTR+SMLLET+LETDE>	;D-E
REPEAT ^D21,<	X NINS+LETTR+SMLLET>	;F-Z
	X 0				;FUNNY CHARACTERS
	X 0
	X SPTIN+SPEDT1+ANYTIM		;ALTMODE
	X 0
	X SPTIN+SPEDT1+SPINS		;RUBOUT
SUBTTL	TEXT ACCEPTANCE AND EDITING

REPEAT 0,<	EDITING CONVENTIONS FOR STATEMENT TYPE-IN

1. INITIALIZATION
	A. IF NO FUNCTION IS OPEN, WE CALL AT ACCTXT.
	B. IF A FUNCTION IS OPEN, WE CALL EDITXT(PT), WHERE PT POINTS TO
	   THE TEXT OF THE LINE BEING EDITED.
2. FIRST CHARACTER TYPED
	A. ALTMODE
		1. FN NOT OPEN:  EDIT PREVIOUS CONTENTS OF TXTBUF.
		2. FN OPEN:  READ TEXT USING PT, AND EDIT THAT.
	B. ANY OTHER CHARACTER:  CLEAR BUFFER, INSERT CHARACTER
3. NORMAL CHARACTER ENTRY (NON-EDIT MODE)
	A. LF:  BEGIN A CONTINUATION LINE
	B. RUBOUT:  DELETE AND ECHO PREVIOUS CHARACTER
4. EDIT MODE
	A. ANY PRINTING CHAR:  OVERLAY CHARACTER ABOVE IT
	B. ^E:  MOVE TO END OF LINE
	C. ^N:  MOVE PAST AND ECHO NEXT CHARACTER
	D. ^S:  MOVE TO NEXT SEPARATOR CHARACTER
	E. ^T:  MOVE PAST AND ECHO TEN CHARACTERS
	F. LF:	MOVE TO NEXT CONTINUATION LINE, OR START ONE IF NONE
		ALREADY EXISTS
	G. ^A:	ENTER INSERT MODE FOR INSERTION OF FOLLOWING TEXT
		IMMEDIATELY BEFORE THE CHAR. OVER THE TYPEHEAD WHEN ^A
		WAS STRUCK.
	H. RUBOUT:  DELETE ABOVE CHARACTER, ECHOING \.
5. INSERT MODE
	A. ANY PRINTING CHARACTER:  INSERT IT
	B. LF:  AS USUAL
	C. ^A:  SAME AS ^R
	D. RUBOUT:  DELETE PREVIOUS CHARACTER AND ECHO IT.  (NOTE: CAN
	   ALSO DELETE CHARACTERS BEFORE THE INSERTION IF ENOUGH RUBOUTS
	   ARE TYPED.)
6. AT ANY TIME *********
	A. CR, VT, FF:  STATEMENT TERMINATOR
	B. ^U:  DELETE ENTIRE STATEMENT AND TRY AGAIN
	C. ^G:  SAME AS ^U, BUT IF EDITING THE TEXT OF A FUNCTION ALSO
	   DELETES THE LINE NUMBER AND SEQUENCES TO THE NEXT LINE.
	D. ALTMODE:  RETYPE FIRST LINE OF STMT, ENTER EDIT MODE.
	E. ^R:  RETYPE CURRENT LINE OF STMT, ENTER EDIT MODE.

>
;COMMON AC ASSIGNMENTS FOR TEXT ACCEPTANCE/EDITING.
;THESE AC'S ARE SAVED AT GETTXT.
;*******************************************************************
; ROUTINES FROM HERE TO NEXT OCCURRENCE OF ****** USE THESE AC'S
;FREELY.

	BP==	AC10	;BYTE POINTER TO CURRENT TEXT CHARACTER
	C==	AC11	;CURRENT CHARACTER
	N==	AC12	;LENGTH OF TEXT BUFFER, IN CHARACTERS
	CT==	AC13	;CHARACTER TYPE (BITS)
	CLSB==	AC14	;CURRENT LINE SEQUENCE BLOCK

;ACCTXT, EDITXT(PT)
;ACCEPT AND/OR EDIT A LINE OF TEXT
;RETURNS: (1) ^U STRUCK, (2) ^D STRUCK, (3) LINE IS BLANK
;	(4) NORMAL - LINE CONTAINS TEXT

	PT==	AC1	;ARG (EDITXT ONLY) - POINTS TO OLD TEXT LINE

ACCTXT:	TRZA	FF,EDIT		;CLEAR EDIT FLAG
EDITXT:	TRO	FF,EDIT		;SET EDIT FLAG
	PUSH	P,PT
	TRZ	FF,DNTRTP	;CLEAR DON'T RETYPE FLAG
	SKIPE	IFILE		;FILE INPUT IN PROGRESS?
	JRST	RFFILE		;YES, GO READ ENTIRE LINE FROM FILE
IFN FTBAKG,<
	MOVEI	R,INITIC	;RESET BACKGROUND MODE INTERVAL COUNTER
	MOVEM	R,JIFCNT	;  SINCE INTERACTION HAS OCCURRED
	SETZM	SLPTIM		;INDICATE SLEEP TIME IS OBSOLETE
>
	HRLS	OUTPOS		;REMEMBER OUTPUT POSITION AFTER PROMPT
	HLLZS	INTFLG		;CLEAR REENTER FLAG, SINCE WE GOT HERE OK
	MOVE	BP,[POINT 7,TXTBUF,6]	;INIT POINTER TO TEXT BUFFER
BEGTXT:	TLZ	FF,TTIFLG	;INDICATE LINE-INPUT MODE
	TTI	C		;GET FIRST USER-TYPED CHARACTER
	PUSHJ	P,GETCT		;AND ITS TYPE BITS
IFN FTCCIN,<
	HRRZS	INTFLG		;INDICATE 1ST CHAR TYPED WAS NOT ^C
>
	CAIN	C,175		;FIRST CHAR AN ALTMODE?
	JRST	FRSALT		;YES, RETRIEVE OLD LINE OR LAST STMT
	TRNN	CT,NINS+SPTIN	;NO, PRINTING OR SPECIAL CHAR?
	JRST	BEGTXT		;NONE OF THOSE, IGNORE
	SETZM	TXTBUF		;OK, STORE RPAD AND BEGIN
	IBP	BP
	MOVEI	N,2		;# OF CHARACTERS NOW IN BUFFER (LPAD,RPAD)
	SKIPN	IFILE		;SKIP IF INPUT FROM FILE
	TRO	FF,DNTRTP	;SET DON'T RETYPE FLAG IN CASE OF ERROR
	JRST	.+3

;NON-EDIT CHARACTER ACCEPTANCE

NXTCHR:	TTI	C		;GET CHAR. AND TYPE BITS
	PUSHJ	P,GETCT
	TRNE	CT,SPTIN	;SPECIAL?
	JRST	SPCNED		;YES
	TRNE	CT,SPEDT1	;1:1 EDITING CHARACTER?
	JRST	EDTTPI		;YES, POSSIBLE EDITING SIGNIFICANCE
	TRNN	CT,NINS		;NO, A NORMAL PRINTING CHAR?
	JRST	NXTCHR		;NO, IGNORE
INSC:	PUSHJ	P,MOV1R		;YES, OPEN UP A SPACE
	JRST	TXTBIG		;NOT ENOUGH SPACE IN BUFFER
	DPB	C,BP		;PLACE THE NEW CHARACTER THERE
	IBP	BP
	JRST	NXTCHR

EDTTPI:	CAIN	C,TAB		;TAB?
	JRST	INSC		;YES, INSERT NORMALLY
	TLNN	FF,TTIFLG	;INPUT CHAR MODE OR LINE MODE?
	JRST	NXTCHR		;LINE MODE, CONTROLS DON'T FUNCTION
	CAIN	C,22		;CHAR MODE. ^R?
	JRST	RETYPE		;YES, RETYPE CURRENT LINE
	LDB	R,BP		;FETCH CURRENT CHAR IN BUFFER
	JUMPE	R,NXTCHR	;OTHER CONTROLS DON'T WORK AT END OF LINE
	TTOS	[SIXBIT/#/]	;OK, GO TO NEXT CONTINUATION LINE
	IBP	BP		;INCREMENT TO 1ST CHAR OF LINE
	SAVE	<C>
	CALL	PRNTLN		;PRINT LINE
	RESTOR	<C>
	JRST	EDITSP		;PERFORM 1:1 EDITING ACTION
;SPECIAL CHARACTER ENCOUNTERED IN NON-EDIT SEQUENCE
SPCNED:	TRNE	CT,ANYTIM	;A "SPECIAL ANYTIME" CHARACTER?
	JRST	SPANY		;YES
	CAIE	C,177		;NO, MUST BE A RUBOUT
	HALT	NXTCHR
	TRZ	FF,DNTRTP	;CLEAR DON'T RETYPE FLAG
	PUSHJ	P,RUBOUT	;RUB OUT CHAR. BEHIND THE ONE AT BP
	JRST	RETYP1		;RUBBED OUT A LF, EXECUTE A ^R
	JRST	NXTCHR		;NORMAL CHAR. RUBBED OUT

;RUBOUT
;ROUTINE TO DELETE AND ECHO THE CHARACTER BEFORE THE ONE POINTED TO
;BY BP.  RETURNS: (1) RPBBED OUT A LF, (2) RUBBED OUT ANYTHING ELSE.

RUBOUT:	PUSHJ	P,BACKBP	;BACK UP A CHARACTER
	LDB	C,BP		;SAVE WHAT I'M DELETING
	JUMPN	C,.+3
	IBP	BP		;A NULL - CAN'T DELETE THAT
	JRST	RUBX
	TTO	C		;OK, ECHO DELETED CHARACTER
	PUSHJ	P,MOV1L		;DELETE THE CHARACTER
	CAIE	C,12		;LF?
RUBX:	AOSA	(P)		;NO, NORMAL EXIT 2
	TTOA	[BYTE(7) 15,15];	YES, ECHO A C.R.
	POPJ	P,

;"SPECIAL-ANYTIME" CHARACTER PROCESSING
SPANY:	CAIN	C,25
	JRST	TXTX1		;^U, ABORT LINE (EXIT 1)
IFN CTRLZU,<
	CAIN	C,32		;^Z DOES ^U ON SYSTEMS WITHOUT ^U PATCH
	JRST	CTRLZ		;DO ^Z PROCESSING LIKE ^U
	>
	CAIN	C,7
	JRST	TXTX2		;^G, DELETE THIS NUMBERED LINE (EXIT 2)
	CAIN	C,15
	JRST	TERM2		;CR, TERMINATE THE LINE
	TRZ	FF,DNTRTP	;CLEAR DON'T RETYPE FLAG
	CAIE	C,13
	CAIN	C,14
	JRST	TERM1		;VT OR FF, ECHO CR AND TERMINATE
	CAIN	C,12
	JRST	NXTLIN		;LF, ADVANCE TO NEXT CONTINUATION LINE
	CAIE	C,175
	HALT	NXTCHR
ALT1:	MOVE	BP,[POINT 7,TXTBUF,13]	;ALTMODE, START EDITING FROM START
	TTOS	[SIXBIT/#/]
	TLO	FF,TTIFLG	;INDICATE SINGLE-CHARACTER MODE INPUT
	JRST	RETYP2
IFN CTRLZU,<	;HERE ON CONTROL-Z, PROCESS LIKE CONTROL-U
CTRLZ:	SKIPLE	IMGFLG		;IF 5.03 OR LATER, HAVE TO ECHO ^Z OURSELF
	TTOA	[ASCIZ/^Z
/]
	JRST	X1		;EXIT LIKE ^U
>

;COME HERE TO READ A LINE FROM AN INPUT FILE RATHER THAN TTY.

RFFILE:	MOVE	BP,[POINT 7,TXTBUF,6] ;INIT POINTER TO TEXT BUFFER
	SETZM	TXTBUF		;NULL OUT FIRST WORD
	MOVEI	N,MAXTXT-2	;MAX # OF CHARACTERS

;HERE TO READ NEXT CHAR FROM INPUT FILE

RDNXCH:	TTI	C		;INPUT A CHARACTER INTO C
RDNXC0:	CALL	GETCT		;GET TYPE BITS
	TRNN	CT,NINS		;NORMAL INSERTABLE CHAR?
	JRST	RDNXC3		;NO
	IDPB	C,BP		;YES, STORE AT END OF TXTBUF
	SOJG	N,RDNXCH	;GO BACK UNLESS FULL
RDNXC1:	MOVE	R,IFILE		;BUFFER IS FULL, GIVE ERROR MESSAGE
	FILERR	R,MSG(STLNG)	;STATEMENT TOO LONG

;HERE ON NON-TEXT CHARACTER

RDNXC3:	CAIN	C,LF		;LINE FEED?
	JRST	RDNXC5		;YES, HANDLE CONTINUATION
	CAIL	C,13		;NO, END-OF-LINE CHARACTER?
	CAILE	C,CR
	JRST	RDNXCH		;NONE OF THOSE, IGNORE
	SETZ	C,		;YES, PACK A NULL AT END OF BUFFER
	IDPB	C,BP
	JRST	TERM3		;RETURN WITH ACCEPTED LINE

;HERE TO HANDLE LINE FEED FOR CONTINUATION

RDNXC5:	IDPB	C,BP		;STORE LINE FEED
	SOJLE	N,RDNXC1	;GUARD AGAINST OVERFLOW
	TTI	C		;GET NEXT CHAR
	CAIE	C,CR		;RETURN?
	JRST	RDNXC0		;NO, STORE IT
	TTI	C		;YES, IGNORE CR AND GET ANOTHER CHAR
	CAIN	C,TAB		;TAB?
	TTI	C		;YES, IGNORE TAB AND GET NEXT CHAR
	JRST	RDNXC0		;STORE NEXT CHAR AND RESUME
;EXITS
TERM1:	TTOA	[BYTE(7) 15,15]	;ECHO CR FOR VT,FF
TERM2:	CAILE	N,2		;A BLANK LINE? (IF SO, EXIT 3)
TERM3:	AOS	-1(P)		;NO, EXIT 4
	AOSA	-1(P)
TXTX2:	TTOS	[SIXBIT/^G#/]	;^G, EXIT 2
	AOSA	-1(P)
TXTX1:	TTOS	[SIXBIT/^U#/]	;^U, EXIT 1
	JRST	X1		;RESTORE AC1 AND RETURN
;LF TYPED, MOVE TO NEXT LINE IF THERE IS ONE
NXTLIN:	TTOA	[BYTE(7) 15,15]	;ECHO CR
	PUSHJ	P,BACKBP
	ILDB	C,BP		;SEARCH FOR END OF LINE
	CAIN	C,12
	JRST	NXTLN1		;THERE IS ANOTHER CONTINUATION LINE
	JUMPN	C,.-3		;NOT YET, KEEP LOOKING
	MOVEI	C,12		;END OF STMT, INSERT LF
	TTOI	11
	JRST	INSC		;START NEW CONTINUATION LINE
NXTLN1:	IBP	BP		;CONT. LINE SEEN, RETYPE AND EDIT IT
	JRST	RETYP1
;ALTMODE,^R,LF LET YOU EDIT A LINE OF A STMT
RETYPE:	TTOS	[SIXBIT/#/]	;^R
RETYP1:	PUSHJ	P,BEGLN		;LF, MOVE TO START OF LINE
RETYP2:	PUSHJ	P,PRNTLN	;ALTMODE - RETYPE LINE

;STANDARD EDITING - 1:1 CHARACTER REPLACEMENT
EDIT1:	LDB	C,BP		;AT END OF A LINE?
	JUMPE	C,NXTCHR	;IF SO, LEAVE EDIT MODE
	CAIN	C,12
	JRST	NXTCHR
	TTI	C		;GET CHARACTER FROM USER
	PUSHJ	P,GETCT
	TRNE	CT,SPEDT1	;SPECIAL ACTION CHARACTER?
	JRST	EDITSP		;YES
	TRNN	CT,NINS		;NO, A NORMAL INSERTION CHAR?
	JRST	EDIT1		;IGNORE IT THEN
	LDB	CT,BP		;YES, FIND OUT WHAT IT REPLACES
	DPB	C,BP
	IBP	BP
	CAIN	CT,11		;A TAB WIPED OUT?
	TTOI	11		;YES, REALIGN TYPEHEAD
	JRST	EDIT1
;SPECIAL ACTION DURING 1:1 REPLACEMENT
EDITSP:	TRNE	CT,ANYTIM
	JRST	SPANY		;HANDLED SAME WAY ALWAYS
	CAIN	C,1
	JRST	INSRT		;^A, INSERT FOLLOWING STRING
	CAIN	C,5
	JRST	GOEOL		;^E, END OF LINE
	CAIN	C,11
	JRST	ITAB		;^I, INSERT A TAB
	CAIN	C,16
	JRST	PASS1		;^N, PASS AND ECHO 1 CHAR.
	CAIN	C,22
	JRST	RETYPE		;^R, RETYPE CURRENT LINE AND EDIT AGAIN
	CAIN	C,23
	JRST	CHRSRC		;^S, ENTER CHARACTER SEARCH MODE
	CAIN	C,30
	JRST	PASSID		;^X, MOVE TO NEXT SEPARATOR
	CAIN	C,24
	JRST	PASS10		;MOVE PAST 10 CHARACTERS
	CAIE	C,177
	HALT	EDIT1
	LDB	C,BP		;RUBOUT, DELETE ABOVE CHAR.
	PUSHJ	P,MOV1L
	TTOI	"\"
	CAIN	C,11		;DELETED A TAB?
	TTOI	11		;YES, REALIGN TYPEHEAD
	JRST	EDIT1
GOEOL:	PUSHJ	P,MPAST1	;^E, MOVE PAST REST OF THIS LINE
	JRST	EDIT1
	JRST	GOEOL
PASS1:	MOVEI	CT,1		;^N, MOVE PAST 1 CHAR.
	JRST	.+2
PASS10:	MOVEI	CT,^D10		;^T, PASS 10 CHARACTERS
	PUSHJ	P,MPAST1
	JRST	EDIT1
	SOJG	CT,.-2
	JRST	EDIT1
PASSID:	PUSHJ	P,MPAST1	;MOVE TO NEXT SEPARATOR
	JRST	EDIT1
	PUSHJ	P,GETCT
	TRNE	CT,LETTR+DIGIT+PERIOD
	JRST	PASSID
	JRST	EDIT1

ITAB:	DPB	C,BP		;INSERT A TAB
	JRST	RETYPE		;NOW TYPEHEAD IS OUT OF LINE!
;CHARACTER SEARCH MODE INVOKED BY ^S

CHRSRC:	GETSTS	TT,R2		;GET CURRENT TTY STATUS BITS
	TRO	R2,200		;SET ECHO-SUPPRESS BIT
	SETSTS	TT,(R2)		;SET STATUS
	TTI	R		;FETCH SEARCH CHARACTER
	TRZ	R2,200		;CLEAR ECHO-SUPPRESS BIT
	SETSTS	TT,(R2)		;SET STATUS

CHRSC1:	CALL	MPAST1		;FETCH AND MOVE PAST ONE CHAR
	  JUMPE	  C,EDIT1	;SEARCH FAILED IF END OF STMT
	CAIN	C,12		;LINE FEED?
	JRST	CHRSC2		;YES, SPECIAL HANDLING
	CAIE	C,(R)		;NO, MATCH SEARCH CHARACTER?
	JRST	CHRSC1		;NO, TRY NEXT
	JRST	EDIT1		;YES, RESUME EDITING

CHRSC2:	IBP	BP		;STEP PAST LINE FEED
	TTOA	[BYTE(7)CR,LF,TAB] ;BEGIN CONTINUATION LINE
	CAIN	C,(R)		;IS SEARCH CHAR A LINE FEED?
	JRST	CHRSC5		;YES, STOP HERE

CHRSC3:	CALL	MPAST1		;FETCH AND MOVE PAST ONE CHAR
	  JUMPE	  C,EDIT1	;STOP HERE IF END OF STATEMENT
	CAIN	C,12		;LINE FEED?
	JRST	CHRSC2		;YES, ANOTHER CONTINUATION
	CAIE	C,(R)		;MATCH SEARCH CHAR?
	JRST	CHRSC3		;NO, TRY NEXT

CHRSC5:	MOVE	R,BP		;SEARCH CHAR FOUND. SAVE BP
	CALL	MPAST1		;FETCH AND PRINT NEXT CHAR
	  JRST	  .+2		;WAS END OF CONTINUATION
	JRST	.-2		;NOT END YET, KEEP PRINTING
	CALL	BEGLN		;END, NOW GO BACK TO BEGINNING OF LINE
	TTOA	[BYTE(7)CR,LF,TAB]
CHRSC6:	CAMN	BP,R		;BACK TO PLACE WHERE CHAR WAS FOUND?
	JRST	EDIT1		;YES, RESUME EDITING
	CALL	MPAST1		;NO, KEEP SCANNING
	  JFCL			; (IMPOSSIBLE)
	JRST	CHRSC6
;^A SEEN, INSERT FOLLOWING TEXT AT CURRENT CHAR. POSITION

INSRT:	TTOA	[BYTE(7) 12,"^"]	;SIGNAL INSERT MODE
	TTI	C		;GET CHAR. FROM USER
	PUSHJ	P,GETCT
	TRNE	CT,SPINS	;SPECIAL INSERTION CONTROL?
	JRST	SPINS1		;YES
	TRNE	CT,SPEDT1	;IS CHAR SPECIAL DURING 1:1 REPLACEMENT?
	JRST	EDITSP		;YES,EXIT INSERT MODE
	TRNN	CT,NINS		;NO, INSERT CHAR INTO STMT IF PRINTABLE
	JRST	INSRT+1
INSRT1:	PUSHJ	P,MOV1R
	  JRST	TXTBIG
	DPB	C,BP
	IBP	BP
	JRST	INSRT+1

SPINS1:	CAIN	C,1		;^A?
	JRST	RETYPE		;YES. RETYPE LINE AND REENTER EDIT MODE
	CAIN	C,11		;A TAB?
	JRST	INSRT1		;YES, INSERT IT NORMALLY
	CAIE	C,177		;A RUBOUT?
	HALT	EDIT1		;NO, SYSTEM ERROR
	PUSHJ	P,RUBOUT	;ERASE PRECEDING CHARACTER
	  JRST	RETYP1		;RUBBED OUT A LINE FEED
	JRST	INSRT+1		;NORMAL RETURN

;MPAST1
;ROUTINE TO MOVE BP PAST 1 CHARACTER AND ECHO IT.
;DOES NOT MOVE PAST END OF LINE.  EXITS: (1) ALREADY AT EOL,
;(2) NOT YET AT EOL

MPAST1:	LDB	C,BP		;GET THIS CHAR.
	CAIE	C,12
	JUMPN	C,.+2
	POPJ	P,		;AT END ALREADY
	TTO	C		;OK, ECHO CHAR.
	IBP	BP
	JRST	CPOPJ1		;SKIP RETURN

;BACKBP
;BACK UP THE BYTE POINTER BY 1 CHARACTER
;****** WARNING *********   SETS ARITH OVERFLOW FLAG

BACKBP:	ADD	BP,[EXP 7B5]	;POSITION 7 TO LEFT IN WORD
	JUMPGE	BP,CPOPJ	;JUMP IF STILL IN SAME WORD
	TLC	BP,450000	;NO--RESET TO RIGHTMOST BYTE
	SOJA	BP,CPOPJ	;  OF PREVIOUS WORD
;SCAN
;SCAN THE NEXT CHARACTER POINTED TO BY BP, LOADING C AND CT.

SCAN:	ILDB	C,BP		;GET A CHARACTER AND UPDATE BP

;GETCT
;GET CHARACTER TYPE BITS FOR CHARACTER CONTAINED IN C.  RESULT IN CT.

GETCT:	MOVE	CT,C		;GET THE CHARACTER
	ROT	CT,-1		;USE FIRST 6 BITS TO GET WORD
	JUMPGE	CT,.+2		;LAST BIT TO DETERMINE RH OR LH
	SKIPA	CT,CTTBL(CT)
	MOVS	CT,CTTBL(CT)
	POPJ	P,

;BEGLN
;MOVE BP TO THE BEGINNING OF THE CURRENT LINE, AND SET C AND CT

BEGLN:	PUSHJ	P,BACKBP	;DECREMENT BYTE POINTER
	LDB	C,BP		;GET CHARACTER
	CAIE	C,12		;LF OR LPAD?
	JUMPN	C,BEGLN
	ILDB	C,BP		;YES, AT START OF LINE NOW
	JRST	GETCT

;PRNTLN
;PRINT THE LINE OF TEXT STARTING AT (BP), THEN RESPOND WITH AN EDIT PROMPT.

	T==	AC1

PRNTLN:	PUSH	P,T
	TTOI	11		;PRINT A TAB
	MOVE	T,BP		;GET BYTE POINTER
	LDB	C,T		;GET A CHARACTER
	CAIN	C,12		;LF OR EOL?
	JRST	PRNTX
	JUMPE	C,PRNTX
	TTO	C		;NO, PRINT IT
	IBP	T
	JRST	PRNTLN+3
PRNTX:	TTOA	[ASCIZ/
  EDIT> /]
	JRST	X1		;RESTORE AC1 AND RETURN

;UNSCAN
;BACK UP BP AND GET THE PREVIOUS CHARACTER

UNSCAN:	PUSHJ	P,BACKBP
	LDB	C,BP
	JRST	GETCT
;MOV1R
;ROUTINE TO MOVE ALL CHARACTERS FROM (BP) TO THE END OF THE TEXT BUFFER
;ONE CHARACTER POSITION TO THE RIGHT.  UPDATES N.  EXITS:  (1) ERROR-
;BUFFER FULL.  (2) OK, BP POINTS TO GAP

	T==	AC1		;TEMPS
	TL==	AC2
	TR==	AC3
	PS==	AC4

MOV1R:	CAIN	N,MAXTXT	;ROOM FOR A NEW CHAR.?
	POPJ	P,		;NO, ERROR
	PUSHJ	P,SAVE4		;SAVE AC1-AC4
	ADDI	N,1		;UPDATE BUFFER LENGTH
	MOVEI	T,4(N)		;COMPUTE NEW BUFFER SIZE (WORDS)
	IDIVI	T,5
	ADDI	T,TXTBUF	;COMPUTE # FO WORDS FROM (BP) TO END
	SUBI	T,(BP)
	MOVNI	T,-1(T)		;MOVE NEG. OF ONE LESS TO LH
	HRLZ	T,T
	HRR	T,BP		;MAKE AOBJN POINTER
	LDB	PS,[POINT 6,BP,5]	;GET POSITION FIELD FROM BP
	MOVE	TL,(BP)		;GET WORD INTO WHICH CHAR. IS TO BE INSERTED
	MOVEI	TR,0
	MOVN	PS,PS		;NEGATE FIELD WORD
	LSHC	TL,-7(PS)	;MOVE RIGHT TO PLACE POINTED CHAR. IN TR
	LSH	TL,7		;CREATE 1-CHAR. GAP IN TR RIGHT-JUSTIFIED
	MOVN	PS,PS		;MAKE THIS POSITIVE AGAIN
	LSHC	TL,-1(PS)	;MOVE BACK 1 LESS THAN BEFORE, WITH GAP.
	LSH	TL,1		;VACATE BIT 35 OF TL
	JUMPGE	T,MOV1RX	;ONLY 1 WORD OF TEXT?
MOV1RN:	MOVEM	TL,(T)		;NO, STORE A SHIFTED WORD
	MOVE	TL,1(T)		;GET NEXT
	ROT	TR,7		;RIGHT-JUSTIFY LEFTOVER CHAR.
	ROTC	TL,-^D8		;SHIFT IT IN AND SHIFT OUT THE OTHER END
	LSH	TL,1		;VACATE BIT 35
	AOBJN	T,MOV1RN
MOV1RX:	MOVEM	TL,(T)		;SAVE LAST TEXT WORD
	JRST	CPOPJ1		;SKIP RETURN
;MOV1L
;ROUTINE TO DELETE THE CHARACTER AT (BP) AND SHIFT ALL SUBSEQUENT CHARACTERS
;ONE POSITION TO THE LEFT.   UPDATES N.

	T==	AC1	;TEMPS
	TL==	AC2
	TR==	AC3
	PS==	AC4

MOV1L:	PUSHJ	P,SAVE4		;SAVE AC1-AC4
	SUBI	N,1		;UPDATE BUFFER LENGTH
	MOVEI	T,4(N)		;COMPUTE NEW BUFFER LENGTH (WORDS)
	IDIVI	T,5
	ADDI	T,TXTBUF	;COMPUTE # OF WORDS FROM (BP) TO END
	SUBI	T,(BP)
	MOVNI	T,-1(T)		;MOVE NEG OF 1 LESS TO LH FOR AOBJN POINTER
	HRLZ	T,T
	HRR	T,BP
	LDB	PS,[POINT 6,BP,5]	;GET CHAR. POSITION
	MOVE	TL,(BP)		;GET FIRST TWO WORDS AFFECATED
	MOVE	TR,1(BP)
	LSH	TL,-1		;RIGHT-JUSTIFY FIRST WORD
	MOVN	PS,PS
	LSHC	TL,1(PS)	;PLACE CHAR. TO BE REMOVED AT RIGHT END OF TL
	LSH	TL,-7		;REMOVE THE CHARACTER
	MOVN	PS,PS
	LSHC	TL,6(PS)	;SHIFT EVERYTHING BACK
	LSH	TL,1		;VACATE BIT 35
	JUMPGE	T,MOV1LX
MOV1LN:	MOVEM	TL,(T)		;STORE WORD
	MOVE	TL,1(T)		;GET NEXT TWO
	MOVE	TR,2(T)
	LSH	TL,-1		;I HATE THAT EXTRA BIT
	LSHC	TL,7		;SHIFT LEFT 7
	LSH	TL,1		;LEFT-JUSTIFY AGAIN
	AOBJN	T,MOV1LN
MOV1LX:	MOVEM	TL,(T)		;STORE LAST TEXT WORD
	POPJ	P,		;RETURN
;ALTMODE SEEN AS FIRST TYPED-IN CHARACTER
FRSALT:	TRNN	FF,EDIT		;HAVE AN OLD LINE TO GET?
	JRST	GETPRV		;NO, USE PREVIOUS C(TXTBUF)
	SETZM	TXTBUF		;YES, TAKE CHARACTERS USING PT
NXTOLD:	ILDB	C,PT		;GET AN OLD CHARACTER
	CAIE	C,3		;A CONTROL-C?
	JRST	NXTOL1		;NO
	MOVEI	C,"%"		;YES, SUBSTITUTE A PERCENT SIGN
	IDPB	C,BP
	ILDB	C,PT		;PASS UP TO 2 LEADING ZEROES
	CAIN	C,"0"
	ILDB	C,PT
	CAIN	C,"0"
	ILDB	C,PT
NXTOL1:	IDPB	C,BP		;STORE NEW CHAR. IN TXTBUF
	JUMPN	C,NXTOLD	;CONTINUE TILL END OF OLD LINE
	MOVE	BP,[POINT 7,TXTBUF,6]
GETPRV:	MOVEI	N,2		;NOW USE PREVIOUS C(TXTBUF)
	ILDB	C,BP		;FIND LENGTH OF LINE
	JUMPE	C,.+2
	AOJA	N,.-2
	JRST	ALT1		;NOW EDIT IT

TXTBIG:	EDIERR	MSG(STLNG)	;STATEMENT TOO LONG
;STOTXT
;ROUTINE TO STORE THE ASCII TEXT OF THE LINE IN THE TEXT BUFFER, AND
;RETURN A PZ POINTER TO IT.  CLOBBERS N,BP,C,CT

	T==	AC1	;TEMP

STOTXT:	MOVE	BP,[POINT 7,TXTBUF,6] ;INIT BYTE PTR TO TEXT BUFFER
				;  AND FALL INTO STOREM

;ROUTINE TO STORE THE REMAINDER OF THE TEXT BUFFER IN A BLOCK, AND
;   RETURN A PZ POINTER AS FOR STOTXT.  CALL WITH B=BYTE PTR SET
;   ONE CHARACTER BEFORE THE FIRST CHARACTER TO BE STORED.

STOREM:	PUSH	P,T		;SAVE AC1
	PUSH	P,BP		;SAVE INITIAL BYTE PTR
	SETZB	N,DOTCNT	;INIT TEXT COUNTERS
	TRZ	FF,QUOTF+COMMF+RELF+SQUOTF	;INIT TEXT FLAGS
	PUSHJ	P,GETC		;GET A CHARACTER
	JUMPE	C,.+2		;END OF LINE?
	AOJA	N,.-2		;NO, KEEP LOOKING
	IDIVI	N,5		;GET LENGTH-1 (WORDS)
	PUSHJ	P,MKBLK		;ALLOCATE A BLOCK OF SIZE LENGTH+1
	  BLKARG SYSBIT+B.TLINE,2(N)
	POP	P,BP		;RESTORE INITIAL BYTE PTR
	PUSH	P,R		;SAVE PZ POINTER
	SETZM	DOTCNT
	TRZ	FF,QUOTF+COMMF+RELF+SQUOTF
	HRRZ	T,(R)		;USE T AS DEPOSIT BYTE POINTER
	HRLI	T,(POINT 7,0,35);WILL INCREMENT ACROSS FIRST WORD BDY.
	PUSHJ	P,GETC		;PICK UP A CHARACTER FROM THE TEXT BUFFER
	IDPB	C,T
	JUMPN	C,.-2		;KEEP STORING UNTIL NULL (END) REACHED
	POP	P,R		;RETURN PZ POINTER
	JRST	X1		;RESTORE AC1 AND RETURN
;GETC
;ROUTINE TO LOAD THE NEXT CHARACTER, USING BYTE POINTER BP.  THIS ROUTINE
;RETURNS CORRECT CONTENTS OF C AND CT, UPDATES BP, AND DOES THE
;REQUIRED SPECIAL PROCESSING FOR RELOCATABLE NUMBERS

	T1==	AC1		;TEMPS
	T2==	AC2

GETC:	PUSH	P,T1
	PUSH	P,T2
	TRNE	FF,RELF		;A RELOC LINE REF. IN PROGRESS?
	JRST	NXTRLD		;YES, GO GET NEXT RELOCATION DIGIT
	ILDB	C,BP		;NO, GET A CHARACTER FROM THE TEXT BUFFER
GETC1:	PUSHJ	P,GETCT		;AND TYPE BITS
	TRZE	FF,SQUOTF	;WAS LAST CHAR. A SINGLE QUOTE?
	JRST	GETCX		;YES. TAKE THIS CHAR. LITERALLY
	CAIN	C,42		;A DOUBLE QUOTE?
	TRC	FF,QUOTF	;YES, FLIP QUOTE FLOP
	TRNE	FF,QUOTF+COMMF	;IN A STRING OR COMMENT?
	JRST	GETCX		;YES, NO FURTHER PROCESSING
	CAIN	C,"'"		;A SINGLE QUOTE?
	TRO	FF,SQUOTF	;YES.  SIGNAL TO TAKE NEXT CHAR. LITERALLY
	CAIN	C,"%"		;NO, RELOC. LINE NUMBER FLAG?
	JRST	GETRLN		;YES, GO LOOK FOR RELOC. LINE #
	CAIN	C,"."		;A PERIOD?
	JRST	CHKDOT		;YES, MIGHT BE A COMMENT
GETCX:	SETZM	DOTCNT		;NOT ONE OF THOSE, EXIT WITH NEW CHAR.
	JRST	X21		;RESTORE AC2,AC1 AND RETURN
;CONTINUATION OF GETC ROUTINE

CHKDOT:	AOS	T1,DOTCNT	;PERIOD SEEN, SEE IF THIRD IN ROW
	CAIN	T1,3
	TRO	FF,COMMF	;YES, SET COMMENT FLAG
	JRST	GETCX+1
GETRLN:	ILDB	C,BP		;PERCENT SIGN SEEN, SEE IF DIGIT FOLLOWS
	PUSHJ	P,GETCT
	TRNE	CT,DIGIT
	JRST	GTRLN1		;YES
	PUSHJ	P,BACKBP	;NO, BACK UP AND RETURN
	MOVEI	C,"%"
	PUSHJ	P,GETCT
	JRST	GETCX
GTRLN1:	PUSHJ	P,DCODE3	;OK, DECODE UP TO 3 DIGITS
	MOVE	AC1,R		;GET INTEGER RESULT
	MOVE	AC2,[POINT 7,PCKDIG]
	MOVEM	AC2,PKDIGP	;SET POINTER TO DEPOSIT 3 DIGITS
	SETZM	PCKDIG
	PUSHJ	P,NCODE3	;DEPOSIT AS 3 DIGITS
	MOVEI	C,3		;LOAD A ^C CHARACTER
	PUSHJ	P,GETCT
	TRO	FF,RELF		;SET RELOC CONST FLAG
	JRST	GETCX
NXTRLD:	ILDB	C,PKDIGP	;GET A RELOC DIGIT
	JUMPN	C,GETC1		;USE IT IF ONE LEFT
	TRZ	FF,RELF		;END OF RELOC DIGITS
	LDB	C,BP		;PICK UP A REGULAR CHARACTER
	JRST	GETC1
;'DECODE3' - DCODE3
;DECODE UP TO 3 ASCII DECIMAL DIGITS STARTING AT (BP), AND RETURN AN
;INTEGER IN R.  ASSUMES FIRST DIGIT HAS ALREADY BEEN READ, AND READS
;CHARACTER AFTER LAST DIGIT IN C.

DCODE3:	MOVEI	R2,3		;UP TO 3 DIGITS
	MOVEI	R,0		;INITIALIZE RESULT
	TRNN	CT,DIGIT	;A DIGIT?
	POPJ	P,		;NO, EXIT NOW
	IMULI	R,^D10		;YES, TACK ON ITS VALUE
	ADDI	R,-60(C)
	ILDB	C,BP		;GET NEXT CHARACTER AND TYPE BITS
	PUSHJ	P,GETCT
	SOJG	R2,DCODE3+2	;AND CONTINUE IF NOT YET 3 DIGITS
	POPJ	P,

;'ENCODE3(T,PT)' - NCODE3
;CONVERT AN INTEGER IN T (UP TO 999) INTO 3 ASCII DIGITS, DEPOSITING
;THEM WITH BYTE POINTER PT, WHICH IS UPDATED.

	T==	AC1	;ARG - NUMBER TO BE ENCODED
	PT==	AC2	;ARG - BYTE POINTER

NCODE3:	MOVE	R,T		;GET NUMBER
	IDIVI	R,^D100		;EXTRACT HUNDREDS
	ADDI	R,60
	IDPB	R,PT
	MOVE	R,R2
	IDIVI	R,^D10		;EXTRACT TENS
	ADDI	R,60
	IDPB	R,PT
	ADDI	R2,60		;EXTRACT ONES
	IDPB	R2,PT
	POPJ	P,
;TYPLNO(LN)
;TYPE OUT THE LINE # IN LN, IN BRACKETS (E.G. [3] OR [14.7]), LEAVING
;TYPEHEAD AT FIRST TAB POSITION 

	LN==	AC1	;ARG - DEWEY-DECIMAL LINE NO.
	T==	R-1	;SPECIAL TEMP - NOT CLOBBERED

TYPLNO::PUSH	P,LN
	PUSH	P,T
	ROT	LN,-7		;PLACE INT PART OF LN IN RH
	PUSHJ	P,DECPRT	;CONVERT RH TO DECIMAL DIGIT STRING
	LSH	LN,-^D29	;PLACE FRAC PART OF LN IN RH
	JFFO	R,.+1		;FIND NUMBER OF LEADING NULL CHARACTERS
	LSH	R,-1(R2)	;LEFT-JUSTIFY THE DIGIT STRING
	MOVEI	T,(SIXBIT/  [/)	;FLOAT A LEFT BRACKET AGAINST THE #
	MOVN	R2,R2
	LSHC	T,^D37(R2)	;PLACE THE ENTIRE STRING IN T, CLEAR R
	JUMPE	LN,.+4		;HAVE A FRACTIONAL PART?
	PUSHJ	P,DECPRT	;YES, CONVERT TO DIGIT STRING
	HRLI	R,(SIXBIT/./)	;PUT IN DECIMAL POINT
	LSHC	T,6		;SHIFT IT TO RIGHT OF INT PART,MAKE A GAP IN R
	ADDI	R,(SIXBIT/  ]/)	;PUT ON A RIGHT BRACKET (FRAC PART OR NOT)
	LSH	R,6		;LEFT-JUSTIFY THE FRACTIONAL PART
	TLNN	R,770000
	JRST	.-2
	LSHC	T,6		;NOW TRY TO NEATEN PRINTOUT BY CLEARING R
	JUMPE	R,.+2
	JUMPGE	T,.-2		;BUT SOMETIMES WE CAN'T
	TLO	R,(SIXBIT/  !/)	;TERMINATE STRING AT EIGHTH CHAR POSITION
	TTOS	T		;PRINT RESULT
	POP	P,T
	JRST	X1		;RESTORE AC1 AND RETURN
;GETID
;SCAN THE ID STARTING AT (BP) AND CONVERT IT TO A SIXBIT STRING IN
;LXBUF.  A WORD COUNT IS DEPOSITED AS THE FIRST CHARACTER IN THE APPROVED
;FORMAT.  LEAVES BP POINTING TO THE FIRST CHARACTER AFTER THE ID.

	PT==	AC1	;TEMP

GETID:	PUSH	P,PT
	MOVE	PT,[POINT 6,LXBUF,5]
GETID0:	TRNN	CT,LETTR+DIGIT	;A LETTER OR DIGIT?
	JRST	GETID2		;NO
	TRNN	CT,SMLLET	;ALREADY GOOD SIXBIT IF SMALL LETTER
GETID1:	TRC	C,40		;OK, ADD THE CHARACTER TO THE STRING
	CAMN	PT,[POINT 6,LXBUF+LXBSIZ-1,34]	;YESS, SEE IF BUFFER IS FULL
	EDIERR	MSG(IDTLN)	;ID TOO LONG
	IDPB	C,PT
	PUSHJ	P,SCAN		;SCAN THE NEXT CHARACTER
	JRST	GETID0
GETID2:	CAIE	C,"."		;NOT <L> OR <D>, IS IT A PERIOD?
	JRST	GETIDX		;NO, EXIT NOW
	PUSHJ	P,SCAN		;YES, LOOK AT NEXT CHAR.
	PUSHJ	P,BACKBP	;JUST WANT TO SEE TYPE BITS
	MOVEI	C,"."
	TRNE	CT,LETTR+DIGIT	;LETTER OR DIGIT FOLLOW .?
	JRST	GETID1		;YES, GO PACK THE PERIOD
	PUSHJ	P,GETCT
GETIDX:	PUSHJ	P,CLRBYT	;NO, CLEAR REST OF LAST WORD OF ASSEMBLED ID
	SUBI	PT,LXBUF-2	;STORE WORD COUNT +1 AS FIRST CHAR.
	DPB	PT,[POINT 6,LXBUF,5]
	JRST	X1		;RESTORE AC1 AND RETURN

;CLRBYT(PT)
;ROUTINE TO CLEAR THE REST OF THE WORD AFTER THE BYTE POINTED TO BY BYTE
;POINTER PT

	PT==	AC1

CLRBYT:	PUSH	P,PT
	LDB	R,[POINT 6,PT,5]	;GET P FIELD
	DPB	R,[POINT 12,PT,11]	;SAVE AS S FIELD AND CLEAR P FIELD
	MOVEI	R,0
	DPB	R,PT		;CLEAR REMAINDER OF WORD
	JRST	X1		;RESTORE AC1 AND RETURN
;ROUTINE TO ACCEPT A LINE OF INPUT FROM THE USER AND RETURN
;   IT AS A STRING.  CURRENT PROMPT MUST BE IN CPRMPT.
;   RETURNS PZADR OF STRING IN R.

DMDSTR:	MOVEM	CAR,SAVCAR	;SAVE IN CASE OF ERROR
	CALL	SAVALL		;SAVE TEXT EDITING ACCUMULATORS
DMDST1:	CALL	INITTY		;TERMINATE EFFECT OF ^O, IF ANY
	MOVE	AC1,CPRMPT	;FETCH CURRENT PROMPT LEXEME
	SKIPN	IFILE		;UNLESS INPUT FROM FILE
	CALL	PRINT		;PRINT THE PROMPT
	CALL	ACCTXT		;ACCEPT A LINE OF TEXT
	  JRST	  DMDST1	;^U , TRY AGAIN
	  JRST	  DMDST1	;^G , TRY AGAIN
	  JFCL			;BLANK LINE, ACCEPT AS IS
	SETZB	R2,N		;CLEAR CHAR COUNTER, BYTE PTR

;THE FOLLOWING CODE IS EXECUTED TWICE, FIRST TO COMPUTE THE SIZE OF
;   THE STRING, THEN TO ACTUALLY PACK IT.  THE FIRST PASS IS INDICATED
;   BY R2 CONTAINING ZERO, THE SECOND BY R2 CONTAINING A BYTE PTR.

DMDST2:	MOVE	BP,[POINT 7,TXTBUF,6] ;INIT READOUT OF TXTBUF
	MOVEI	AC1,15		;SETUP CR CONSTANT
DMDST3:	ILDB	C,BP		;FETCH A CHARACTER FROM TXTBUF
	JUMPE	C,DMDST5	;JUMP IF NULL (END OF BUFFER)
	CAIE	C,12		;LINE FEED?
	JRST	DMDST4		;NO
	JUMPE	R2,.+2		;YES, INSERT A CR FIRST
	IDPB	AC1,R2		;   (BUT ONLY IF R2#0)
	ADDI	N,1		;COUNT THE INSERTED CHARACTER
DMDST4:	JUMPE	R2,.+2		;SECOND PASS?
	IDPB	C,R2		;YES, STORE CHARACTER
	AOJA	N,DMDST3	;INC COUNTER AND GO BACK FOR MORE

;HERE WHEN TXTBUF END REACHED.

DMDST5:	JUMPN	R2,RSTALL	;RESTORE AC'S AND RETURN IF PASS 2 DONE
	MOVEI	AC1,4(N)	;PASS 1 DONE, N CONTAINS # OF CHARS
	IDIVI	AC1,5		;COMPUTE NUMBER OF WORDS NEEDED FOR STRING
	CALL	MKBLK		;CONSTRUCT USERTYPE STRING
	  BLKARG(U.STRING,2(AC1)) ;LENGTH OF STRING ITSELF +2
	HRRZM	N,1(R2)		;STORE UPPER BOUND FIELD
	HRLI	R2,(POINT 7,,35) ;SETUP BYTE PTR INTO BLOCK
	AOJA	R2,DMDST2	;ENTER SECOND PASS, STORE STRING.
;GETTXT
;MASTER TEXT ACCEPTANCE/EDITING ROUTINE.  RETURNS WITH A PZ POINTER
;TO A BLOCK OF TEXT WHICH IS A DDEF, SYNTAX DEF, OR IMMEDIATELY
;EXECUTABLE LINE.  EXITS:
;(1) SAW  $ID=  SO IT SHOULD BE A DATA DEF
;(2) SAW SOMETHING ELSE, SO IT SHOULD BE AN EXECUTABLE LINE

	T==	AC1	;TEMP
	T2==	AC2
	LN==	AC7	;SPECIAL TEMP - NOT CLOBBERED

;AC 'LN' IS OCCASIONALLY USED BY LOWER-LEVEL ROUTINES CALLED BY GETTXT

GETTXT:	PUSHJ	P,SAVALL	;SAVE AC1-14
	MOVEM	P,EDIREC	;SAVE P FOR ERROR RECOVERY

ACCL1:	TRZ	FF,<FOPN!TUPARG>;INDICATE NO FN OPEN
	TRZE	FF,EDIFLG	;REPEATING EDIT COMMAND AFTER AUTO RESET?
	JRST	ACCL2A		;YES, USE TEXT ALREADY IN THE BUFFER
	CALL	INITTY		;RE-INIT TO CLEAR ^O IF TYPED.
	MOVE	AC1,CPRMPT	;FETCH LEXEME FOR CURRENT PROMPT
	SKIPN	IFILE		;UNLESS INPUT FROM FILE
	CALL	PRINT		;PRINT PROMPT
ACCL2:	PUSHJ	P,ACCTXT	;ACCEPT A LINE OF TEXT
	  JRST	  ACCL1		;^U, TRY AGAIN
	  JRST	  ACCL1		;^D, BUT NOTHING TO DELETE
	  JRST	  IMMEDX	;BLANK LINE, EXECUTE IMMEDIATELY
ACCL2A:	MOVE	BP,[POINT 7,TXTBUF,6]	;INIT READOUT OF TXTBUF
	PUSHJ	P,SCPSP		;SCAN AND PASS SPACES
	CAIN	C,"?"
	JRST	TXTQUS		; ? - REQUEST FOR DISPLAY
	CAIE	C,"$"
	JRST	IMMEDX		;EXIT - THINK IT IS IMMEDIATE EX.
;DOLLAR SIGN SEEN.  TWO POSSIBLE BRANCHES:
; (1)  $ID    OR    $ID;    OR    $ID( 		:: FN HEADER
; (2)  $ID=	:: DDEF

	PUSHJ	P,SCPSP
	TRNE	CT,DIGIT	;DIGIT FOLLOW?
	JRST	IMMEDX		;YES, USER IS STARTING AN OCTAL NUMBER
	TRNN	CT,LETTR	;NO, ID MUST APPEAR NOW FOR ANY FORM
	EDIERR	MSG(ILEDC)	;ILLEGAL EDITING COMMAND
	PUSHJ	P,GETID		;OK, GET ID AND LEAVE IN LXBUF
	PUSHJ	P,PASSP
	CAIN	C,"="
	JRST	DATDEF		;DATA DEF
	CAIN	C,"["
	JRST	EDIFN		;COMMAND TO OPEN FN AT LINE N
	TRNN	CT,FNHDR	;NO, MUST BE FUNCTION HEADER
	EDIERR	MSG(ILEDC)	;ILLEGAL EDITING COMMAND
;USER HAS CALLED FOR OPENING A NEW FUNCTION

	MOVE	BP,[POINT 7,TXTBUF,6] ;RESET TO START OF LINE
	CALL	SCAN		;GET FIRST CHAR OF LINE
	CAIE	C,"$"		;START WITH DOLLAR SIGN?
	TRZ	FF,DNTRTP	;NO, ENSURE ALIGNMENT IN CASE OF ERROR
	CALL	PASSP		;PASS LEADING BLANKS BEFORE $
	CALL	BACKBP		;BACKUP ONE
	CALL	STOREM		;STORE REMAINDER OF LINE AS LINE 0
	MOVE	T,R		;SAVE ADDR OF PZ POINTER TO TEXT
	MOVEI	T2,1		;INDICATE FN HEADER TRANSLATION
	SETZM	LINENO		;NO LINE #
	TRO	FF,LEXCHK	;LEX CHECKING MODE
	IDPB	T,PZSAV		;PROTECT TEXT OF BLOCK FROM GC
	PUSHJ	P,LEX		;CHECK FN HEADER
	  JRST	  ACCL3		;ERROR IN LINE
	HLRZ	T2,L0BUF+2	;OK, GET INTERNAL NAME OF FN
	HRRZM	T2,THISFN	;SAVE IT FOR LATER CHECK
	ADD	T2,@IDTP	;CONV TO ABS ADDR IN IDT
	SKIPE	(T2)		;IS THE NAME IN USE ALREADY?
	EDIERR	MSG(FNAIU)	;FUNCTION NAME ALREADY IN USE
	PUSHJ	P,MKBLK		;NO, GO MAKE A LSB
	  BLKARG  SYSBIT+B.LSB,2
	MOVEM	R,@PZSAV	;REMOVE INPUT TEXT FROM PZ SAVE LIST
				;  AND PROTECT NEWLY-CREATED LSB
	MOVE	CLSB,R		;SAVE PZ ADDR AS CURRENT LSB
	HRRZM	T,1(R2)		;STORE ADDR OF LINE 0 TEXT AS 1ST ITEM
	MOVEI	LN,200		;STE TO INTEGER LINE 1
	JRST	EDIMOD		;ENTER OPEN-FUNCTION EDITING

ACCL3:	SOS	PZSAV		;REMOVE TEXT POINTER FROM PZSTK
	JRST	ACCL1		;GO ASK FOR NEW LINE

;SAW   $ID[    ; START TO EDIT OLD FUNCTION

EDIFN:	PUSHJ	P,GETDDL	;GET DEWEY-DECIMAL LINE NUMBER
	JUMPN	C,ILEDCM	;ERROR IF ANYTHING AFTER ]
	PUSHJ	P,FINDID	;LOOK UP THE FUNCTION NAME
	  SKIPA	  T,R		;FOUND
NSFUN:	EDIERR	MSG(NSFUN)	;NO SUCH FUNCTION
	HRRZM	T,THISFN	;SAVE AS CURRENT FN NAME
	PUSHJ	P,GETSTE	;GET TABLE ENTRY FOR FN
	HRRZ	CLSB,R		;ADDR OF SEQ BLOCK
	JUMPE	CLSB,NSFUN	;0=NO SUCH FUNCTION
	LDB	T,[POINT 15,(CLSB),17]	;GET ADDRESSED BLOCK TYPE
	HRRZ	T2,(CLSB)	;GET ADDR OF BLOCK
	CAIN	T,B.FN		;A FN BLOCK?
	HRRZ	CLSB,2(T2)	;YES, GET THE TEXT ENTRY
	LDB	T,[POINT 15,(CLSB),17]
	CAIE	T,B.LSB		;HAS TO BE TEXT NOW
	EDIERR	MSG(NSFUN)	;NO SUCH FUNCTION

;CHECK TO SEE WHETHER THERE EXIST ANY ACTIVE OR SUSPENDED AR'S
;   THAT USE THE FUNCTION ABOUT TO BE EDITED.  IF SO, GIVE A WARNING
;   MESSAGE AND PERFORM A RESET BEFORE EDITING.

	HRRZ	AC1,R		;FETCH PZADR OF FN TO BE EDITED
	SKIPE	AC2,RAF		;ANY ACTIVE FNS?
	CALL	CKRING		;YES, CHECK FOR USE OF FN AMOUNG ACTIVE AR'S
	SKIPE	AC2,RSF		;ANY SUSPENDED FNS?
	CALL	CKRING		;YES, CHECK SUSPENDED FNS

;NOW MAKE A COPY OF THE LINE SEQUENCE BLOCK TO DO EDITING ON.

	HRRZ	T,(CLSB)	;FETCH DZADR OF LSB
	HLRZ	T,(T)		;GET ITS LENGTH
	CALL	MKBLK		;CONSTRUCT NEW LSB OF SAME LENGTH
	  BLKARG  SYSBIT+B.LSB,(T)
	ADDI	T,(R2)		;COMPUTE ABS ADR OF END+1 OF NEW BLOCK
	HRL	R2,(CLSB)	;R2[LH]_DZADR OF OLD BLOCK
	AOBJN	R2,.+1		;SEQUENCE PAST FIRST WORD
	BLT	R2,-1(T)	;COPY CONTENTS OF OLD BLOCK INTO NEW
	HRRZ	CLSB,R		;NOW REMEMBER PZADR OF NEW BLOCK
	IDPB	CLSB,PZSAV	;PROTECT LSB AGAINST GC
;ENTER EDIT MODE ON LINE LN OF THE CLSB

EDIMOD:	TRO	FF,FOPN		;SIGNAL FUNCTION IS OPEN
	MOVEM	LN,LINENO	;STORE LINE # IN CASE OF ERROR
	MOVE	T,LN		;PRINT LINE NUMBER
	SKIPN	IFILE		;UNLESS INPUT FROM A FILE
	PUSHJ	P,TYPLNO
	PUSHJ	P,FINDLN	;DOES LINE ALREADY EXIST?
	JRST	LNOTX		;NO, WE MAKE ONE
	HRRZ	T,(CLSB)	;YES, GET ADDR OF PREV. LINE WITH THIS NUMBER
	ADD	T,R		;T_ADDR OF LSB ENTRY
	HRRZ	T,(T)		;T_ADDR OF PZ POINTER TO BLOCK
	HRRZ	T,(T)		;T_ADDR OF TEXT
	HRLI	T,(POINT 7,0,35);MAKE A BYTE POINTER
	PUSHJ	P,EDITXT	;ACCEPT TEXT, POSSIBLY DOING EDITING
	JRST	EDIMOD		;^U, LET HIM TRY AGAIN ON THIS LINE
	JRST	DELOLN		;^D, DELETE OLD LINE WITH THIS NUMBER
	JRST	SEQLN		;BLANK LINE, SEQUENCE TO NEXT
	JRST	CHKLN		;A LINE TYPED, CHECK IT FOR COMMANDS

;NO OLD LINE EXISTED WITH THIS NUMBER
LNOTX:	PUSHJ	P,ACCTXT	;ACCEPT LINE OF TEXT
	JRST	EDIMOD		;^U, LET HIM TRY AGAIN
	JRST	EDIMOD		;^D, BUT NOTHING TO ERASE
	JRST	SEQLN		;BLANK, SKIP TO NEXT LINE NO.

;A LINE HAS BEEN TYPED, SEE IF IT IS AN EDITING COMMAND
CHKLN:	MOVE	BP,[POINT 7,TXTBUF,6]
	PUSHJ	P,SCPSP		;SCAN 1ST CHAR AND PASS SPACES
	CAIN	C,"$"
	JRST	EDIDLR		; $ = EXIT, CLOSING AND RENUMBERING FN
	CAIE	C,"["
	JRST	STOLN		; NOT [, SO THIS MUST BE TEXT TO STORE
	PUSHJ	P,GETDDL	;GET LINE NO.
	JUMPE	C,EDIMOD	;GO ASK FOR NEW TEXT IF END OF LINE
	TRZ	FF,DNTRTP	;FORCE LINE TO BE RETYPED ON ERROR
	CALL	BACKBP		;NO, MORE TEXT.  BACKUP ONE
	CALL	STOREM		;STORE REMAINDER OF LINE IN TEXT BLOCK
	JRST	STOLN0		;GO PROCESS
;STORE THE CONTENTS OF TXTBUF, AND PLACE POINTER IN LSB

STOLN:	PUSHJ	P,STOTXT	;MAKE A BLOCK OUT OF TXTBUF
STOLN0:	MOVE	T,R		;SAVE POINTER
	TRO	FF,LEXCHK	;LEXICAL CHECKING ONLY
	IDPB	T,PZSAV		;SAVE POINTER TO TEXT BLOCK
	MOVEM	LN,LINENO	;STORE LINE # IN CASE OF ERROR
	JUMPN	LN,STOLNN	;JUMP IF NOT LINE ZERO
	MOVEI	T2,1		;LINE ZERO, CHECK THE HEADER
	PUSHJ	P,LEX
	  EDIERR  MSG(OFNHU)	;OLD FN HEADER UNCHANGED
	HLRZ	T2,L0BUF+2	;GET FUNCTION NAME FROM PARSED HEADER
	MOVEM	T2,THISFN	;STORE IN CASE CHANGED
	JRST	STOLN1		;GO STORE TEXT OF LINE
STOLNN:	PUSHJ	P,PARSE		;CHECK THE LINE JUST TYPED IN
	  SETOM	LINENO		;FLAG THAT AN ERROR OCCURRED
STOLN1:	HRL	T,LN		;GET CURRENT LINE #
	PUSHJ	P,FINDLN	;SEE IF I AM REPLACING
	JRST	INSLN		;NO, HAVE TO MAKE ROOM IN LSB
	HRRZ	T2,(CLSB)	;YES, GET ABS POSITION OF SLOT
	ADD	T2,R
	MOVEM	T,(T2)		;STORE LN,,PZPTR
	JRST	SEQLN0		;SEQUENCE TO NEW LINE NUMBER
;LINE BEING INSERTED IN LSB FOR WHICH LINE NO. DID NOT PREVIOUSLY EXIST

INSLN:	MOVEM	T,TSV1		;SAVE THE ENTRY TO BE INSERTED
	HRRZ	AC1,CLSB	;INSERT OPERATION - ARG 1: ADDR OF BLOCK
	MOVEI	AC2,1		;ARG 2: LENGTH OF ITEM BEING INSERTED
	MOVEI	AC3,TSV1	;ARG 3: ADDR. OF ITEM BEING INSERTED
	MOVE	AC4,R		;ARG 4: REL ADDR OF INSERTION
	PUSHJ	P,INSERT

;SEQLN - ADD .1 OR 1 TO LN AND GO PROCESS MORE INPUT

SEQLN0:	SOS	PZSAV		;REMOVE SAVED TEXT FROM STACK
SEQLN:	SKIPGE	LINENO		;DID AN ERROR OCCUR?
	JRST	EDIMOD		;YES, DON'T INCREMENT
	CAIE	LN,^D999B28	;DON'T INCREMENT 999 OR 999.99
	CAIN	LN,^D999B28+^D99
	JRST	EDIMOD
	LDB	R,[POINT 7,LN,35]	;CHECK FOR DEWEY .0 OR .99
	JUMPE	R,.+3
	CAIE	R,^D99
	AOJA	LN,EDIMOD	;NO, INCREMENT DEWEY DECIMAL AND CONTINUE
	TRZ	LN,177		;YES, INCREMENT INTEGER PART
	ADDI	LN,200
	JRST	EDIMOD

;^G STRUCK WHEN OLD LINE EXISTED
DELOLN:	JUMPN	LN,.+3		;CAN'T DELETE LINE ZERO
	TTOS	MSG(FHDEL)	;FUNCTION HEADER MAY NOT BE DELETED
	JRST	SEQLN
	PUSHJ	P,FINDLN	;OK, SET POINTER TO LINE # ENTRY
	HALT	SEQLN		;BUT I FOUND IT BEFORE!
	HRRZ	T,(CLSB)	;GET ABS. ADDR
	MOVSI	T2,-1		;DECREMENT WLENGTH
	ADDB	T2,(T)
	HLRZ	T2,T2		;COMPUTE ABS ADDR. OF OLD LAST WORD
	ADD	T2,T
	ADD	T,R		;T_ABS ADDR OF WORD TO BE DELETED
	HRLI	T,1(T)		;MAKE BLT POINTER TO MOVE DOWN HIGHER ENTRIES
	CAIE	T2,(T)		;SKIP IF LAST ENTRY IS BEING DELETED
	BLT	T,-1(T2)
	HRLI	T2,1		;LEAVE LEFTOVER WORD WITH WLENGTH=1
	MOVEM	T2,(T2)		;AND POINTER LOOPED TO ITSELF
	JRST	SEQLN		;IT WILL DISAPPEAR ON NEXT GARB. COLL.
;SAW $ , PREPARE TO EXIT FUNCTION
;ALL REFERENCES WITHIN THE TEXT MUST BE RENUMBERED

EDIDLR:	PUSHJ	P,SCPSP		; $ MUST APPEAR ALONE ON LINE
	JUMPE	C,CLSF
	JUMPE	LN,STOLN	;BUT STORE IF FN HEADER
	EDIERR	MSG(ILEDC)	;ILLEGAL EDITING COMMAND
CLSF:	HRRZ	AC3,(CLSB)	;GET ABS ADDR OF LSB
	HLRZ	T2,(AC3)	;MAKE AOBJN POINTER
	MOVN	T2,T2
	HRLZI	N,1(T2)		;POINT TO FIRST ENTRY IN LSB
	HRRI	N,1(AC3)
	MOVEM	N,TSV1
	AOBJP	N,EDIX		;JUMP IF NO LINES TO RENUMBER
RENBR:	HRRZ	BP,(N)		;MAKE A BYTE POINTER TO THIS LINE
	HRRZ	BP,(BP)
	HRLI	BP,(POINT 7,0,35)
RENBR1:	PUSHJ	P,SCAN		;GET A CHARACTER FROM TEXT
	JUMPE	C,RENBRX	;END OF LINE?
	CAIE	C,3		;NO, A RELOC REF?
	JRST	RENBR1		;NO
	MOVE	T2,BP
	PUSHJ	P,SCAN		;YES, DECODE RELOC. REFERENCE
	PUSHJ	P,DCODE3	;RESULT IS INTEGER IN R
	LSH	R,7		;MAKE A LN IN STANDARD FORM
	MOVE	T,TSV1		;START TO SEARCH LINE NO.'S IN LSB
	HLRZ	R2,(T)
	CAMGE	R2,R		;A MATCH OR BEYOND REFERENCED LN?
	AOBJN	T,.-2		;NO, KEEP LOOKING.
	SUBI	T,1(AC3)	;GET ORDINAL POSITION (NO MATCH RESULTS
	HLLI	T,		;  IN REFERENCE TO LAST LINE +1)
	PUSHJ	P,NCODE3	;DEPOSIT 3 DIGITS OF RELOCATED #
	JRST	RENBR1+1
RENBRX:	AOBJN	N,RENBR		;END OF ONE TEXT LINE, GOT ANOTHER?
	MOVE	T,TSV1		;GASP, FINALLY WE RENUMBER LSB ENTRIES
	MOVEI	T2,0
	HRLM	T2,(T)
	ADDI	T2,200		;GIVE IT CONSECUTIVE NUMBERS
	AOBJN	T,.-2
;***** THIS CODE DOES FINAL TRANSLATION TO BASE-LANGUAGE TEXT ***
;AC ASSIGNMENTS FOR FINAL TRANSLATION

	TBP==	AC3	;TEXT BYTE POINTER INTO LSB
	FBP==	AC4	;FN BYTE POINTER INTO FN BLOCK
	LC==	AC5	;NUMBER OF LINES LEFT TO TRANSLATE
	CFN==	AC6	;PZ POINTER TO FN BLOCK

EDIX:	TTOS	1,[SIXBIT/#/]	;SIGNAL CLOSING OF FN
	TRZ	FF,LEXCHK+TRNERR+DNTRTP ;ZERO ERROR FLAG, SIGNAL NO CHECKING
	HRRZ	LC,(CLSB)	;COMPUTE # OF LINES + 1 (INCL LINE 0)
	HLRZ	LC,(LC)
	ROT	LC,-1		;SINCE WE PACK LINE ADDRESSES
	PUSHJ	P,MKBLK		;MAKE FN BLOCK
	BLKARG	SYSBIT+B.FN,3(LC)
	MOVE	CFN,R		;PRESERVE PZ ADDR
	MOVEM	R,@PZSAV	;PROTECT FN BLOCK FROM GC, AND
				;  UNPROTECT LSB
	ROT	LC,1		;LC _ # OF LINES INCL LINE 0
	SUBI	LC,1
	MOVSI	TBP,(POINT 36,(R2),35)	;SET UP BYTE POINTERS
	MOVE	FBP,[POINT 18,3(R2),17]	;THIS WILL MISS LINE 0 SLOT
	HRLZM	LC,2(R2)	;STORE NUMBER OF LINES
	HRRM	CLSB,2(R2)	;STORE ADDRESS OF TEXT LSB
	HRRZ	R2,(CLSB)	;FETCH DZADR OF LSB
	ILDB	AC1,TBP		;GET PZADR OF LINE 0 OF TEXT
	HLRZM	AC1,LINENO	;STORE LINE NUMBER IN CASE OF ERROR
	MOVEI	AC2,1		;INDICATE FN HEADER TRANSLATION TO BE DONE
	PUSHJ	P,LEX		;CALL LEXICAL ANALYZER
	  TRO	  FF,TRNERR	;TRANSLATION ERROR, SET FLAG

;TRANSLATE A LINE OF ASCII TEXT
TRNLN:	SOJLE	LC,TRNX		;JUMP IF OUT OF LINES TO TRANSLATE
	HRRZ	R2,(CLSB)	;GET DZADR OF LSB
	ILDB	AC1,TBP		;FETCH PZADR OF ASCII TEXT BLOCK
	HLRZM	AC1,LINENO	;STORE LINE NUMBER
	PUSHJ	P,PARSE		;CALL PARSER
	  TRO	  FF,TRNERR	;SYNTAX ERROR, SET FLAG
	HRRZ	R2,(CFN)	;FETCH DZADR OF FN BLOCK
	TRNE	FF,TRNERR	;DON'T STORE IF TRANSLATION ERROR
	AOJA	AC2,TRNLN
	IDPB	R,FBP		;STORE PTR TO TRANSLATED LINE BLOCK
	HRRZ	R2,(R)		;FETCH DZADR OF LINE BLOCK
	MOVEM	AC2,1(R2)	;STORE LINE NUMBER
	AOJA	AC2,TRNLN	;INCREMENT LINE NUMBER
;ALL LINES HAVE BEEN TRANSLATED.  NOW STORE FINISHED LINE 0

TRNX:	TRNE	FF,TRNERR	;ANY TRANSLATION ERRORS?
	JRST	NOTRN		;YES, WE DO NOT STORE TRANSLATED TEXT
	LDB	AC7,[POINT 12,L0BUF,11]	;OK, DETERMINE LINE 0 LENGTH
	LDB	R,[POINT 12,L0BUF,23]
	ADDI	AC7,1(R)	;AC7_# OF FORMLS+LCLS+PROCID
	HRRZ	R2,(CFN)	;FETCH DZADR OF FN BLOCK
	HRLM	AC7,1(R2)	;STORE #LCLS FIELD IN FN BLOCK
	LDB	AC1,[POINT 12,L0BUF,35]
	ADDI	AC1,-1(AC7)	;AC1_# OF LCLS+FORMLS+ASGNMTS
	PUSHJ	P,MKBLK		;MAKE LINE 0 BLOCK
	BLKARG	B.LIN0+SYSBIT,5(AC1)
	SETZM	1(R2)		;LINE # 0
	ADDI	AC7,-1(R2)	;COMPUTE ADDR OF LAST LCL -4
	HRLZI	AC1,TUPATR	;GET THE TUPATR BIT
	ANDCAM	AC1,L0BUF+1	;CLEAR THE BIT INITIALLY
	TRZE	FF,TUPARG	;WAS TUPARG SET DURING LEX
	ORM	AC1,L0BUF+1	;SET IT IF REQUIRED
	HRLI	R2,L0BUF	;MAKE BLT POINTER TO STORE LINE 0
	ADDI	R2,2
	BLT	R2,4(AC7)
	LDB	AC1,[POINT 12,L0BUF,35]	;GET # ASGNMTS
	JUMPE	AC1,NOASGN
	MOVEI	R2,5(AC7)	;PREPARE TO STORE ASGNMTS AT END OF LINE 0
	HRLI	R2,LBLBUF
	ADDI	AC1,-1(R2)
	BLT	R2,(AC1)
NOASGN:	HRRZ	R2,(CFN)	;STORE ADDR OF LINE 0 IN FN BLOCK
	HRLM	R,3(R2)
	MOVE	AC1,FBP		;CLEAR LAST LINE SLOT IF NECESSARY
	PUSHJ	P,CLRBYT

;NOW SCAN THE TEXT OF ALL LINES (N>0) AND CHANGE GLOBALS TO PROCID,
;FORMLS, OR LCLS WHERE APPROPRIATE

	MOVE	FBP,[POINT 18,3(R2),17]	;POINT TO GET LINE 1 FIRST
	HLRZ	LC,2(R2)	;GET # OF LINES INCL LINE 0
NXTSCN:	SOJLE	LC,SCNX		;JUMP IF OUT OF LINES
	HRRZ	R2,(CFN)	;GET PZ ADDR OF A LINE
	ILDB	AC7,FBP
	HRRZ	AC7,(AC7)	;GET LENGTH
	HLRZ	AC1,(AC7)
	MOVNI	AC1,-2(AC1)	;MAKE AOBJN POINTER FOR LEXEMES
	HRL	AC7,AC1
NXTLXM:	MOVE	AC1,2(AC7)	;GET A LEXEME
	TLC	AC1,(LXM(STAK,ID)) ;SET LH TO ZERO IF ID
	TLNN	AC1,-1		;IS IT AN ID?
	PUSHJ	P,SRCHL0	;YES, SEARCH L0BUF FOR THE NAME
	JRST	NOTID		;MUST BE GLOBAL, LEAVE IT AS IS
	HRRZ	R,L0BUF(R)	;YES, GET PARAMETER NUMBER
	ANDCMI	R,CBRBIT	;REMOVE CALL-BY-REFERENCE BIT
	HRLI	R,(LXM(STAK,LCL)) ;ASSUME LOCAL LEXEME
	LDB	AC1,[POINT 12,L0BUF,11]
	CAIL	AC1,(R)		;SKIP IF LOCAL
	HRLI	R,(LXM(STAK,FORML)) ;NOT LOCAL, ASSUME FORMAL
	TRNN	R,-1		;SKIP IF NOT PROCID
	HRLI	R,(LXM(STAK,PROCID)) ;PROCEDURE ID
	MOVEM	R,2(AC7)
NOTID:	AOBJN	AC7,NXTLXM	;JUMP IF MORE LEXEMES IN THIS LINE
	JRST	NXTSCN		;NEXT LINE PLEASE

;COME HERE IF THERE WAS AT LEAST ONE TRANSLATION ERROR.
;WE STORE CLSB INSTEAD OF CFN (E.G. IDT ENTRY POINTS DIRECTLY TO LSB)
;SO USER CAN STILL EDIT IT

NOTRN:	MOVE	CFN,CLSB
	TTOS	MSG(FNUNX)	;FUNCTION UNEXECUTABLE

;COME HERE TO STORE THE IDT ENTRY FOR FN AND EXIT TO USER

SCNX:	HRLI	CFN,I.FN	;IDENTIFY THE STE AS A FN
	MOVE	AC2,CFN
	HRRZ	AC1,THISFN	;GET FN INTERNAL NAME
	PUSHJ	P,SETSTE	;STORE POINTER
	SOS	PZSAV		;REMOVE FN BLOCK FROM PROTECT LIST
	JRST	ACCL1		;GO ACCEPT A NEW LINE
; ? SEEN, PRINT OUT A LINE OF A FUNCTION, OR THE WHOLE FUNCTION

TXTQUS:	PUSHJ	P,SCPSP		;PASS ? AND SPACES
	TRNN	CT,LETTR	;MUST BE ID NOW
	EDIERR	MSG(ILEDC)	;ILLEGAL EDITING COMMAND
	PUSHJ	P,GETID		;RECOVER ID NAME, RESULT IN LXBUF
	PUSHJ	P,PASSP
	JUMPE	C,TYALL		;NOTHING ELSE :: TYPE WHOLE FN
	CAIE	C,"["
	EDIERR	MSG(ILEDC)	;ILLEGAL EDITING COMMAND
	PUSHJ	P,GETDDL	;GET LINE NO. WANTED
	JUMPN	C,ILEDCM	;ERROR IF ANYTHING AFTER "]"
	TRZA	FF,TALL		;SET TO TYPE ONE LINE
TYALL:	TRO	FF,TALL		;SET TO TYPE ALL LINES
	PUSHJ	P,FINDID	;FIND THE FN
	SKIPN	T,R		;OK, GET THE STE
NSUFN:	EDIERR	MSG(NSUDF)	;NO SUCH USER-DEFINED FN
	PUSHJ	P,GETSTE
	HLRZ	T,R		;A FN HEADER?
	CAIE	T,I.FN
	JRST	NSUFN		;NO
	MOVE	T,(R)		;YES, GET ADDRESSED PZ WORD
	TLC	T,B.FN(SYSBIT)	;IS IT A FN?
	TLNE	T,-1
	JRST	.+3		;LSB, USE IT DIRECTLY
	HRRZ	T,2(T)		;FN, GET TEXT ENTRY FROM IT
	HRRZ	T,(T)
	TRNN	FF,TALL		;TYPING WHOLE FN?
	JRST	.+4		;NO
	HRRZ	T,(T)		;YES, GET BACK PZ ADR OF LSB
	CALL	TYFN		;PRINT TEXT
	JRST	ACCL1
	HLRZ	T2,(T)		;SINGLE LINE. GET LENGTH OF LSB
	ROT	LN,-7		;COMPUTE INTEGER LINE NUMBER
	CAIL	T2,2(LN)	;ERROR IF LINE NUMBER OUT OF RANGE
	TLNE	LN,-1		;OR IF USER GAVE A FRACTIONAL PART
	EDIERR	MSG(NSLIN)	;NO SUCH LINE
	ADDI	T,1(LN)		;OK, POINT T TO CORRECT LINE
	CALL	PRLN		;PRINT THE LINE
	JRST	ACCL1		;GO BACK TO EXEC.

;EXITS
IMMEDX:	AOS	-14(P)		;IMMEDIATE EXECUTION (2)
DATDEF:	PUSHJ	P,STOTXT	;DATA DEF (1): MAKE A BLOCK OUT OF IT
	JRST	RSTALL		;RESTORE AC'S 1-14 AND RETURN
;TYFN
;ROUTINE TO TYPE OUT A FUNCTION GIVEN THE PZ ADDRESS OF ITS
;LINE SEQUENCE BLOCK

TYFN:	SAVE	AC1
	HRRZ	AC1,(AC1)	;GET DZ ADR OF LSB
	HLL	AC1,(AC1)	;PUT WLENGTH IN LH
	TLC	AC1,-1		;TAKE COMPLEMENT, CONSTRUCT AOBJN POINTER
	ADD	AC1,[XWD 2,1]
	TTOS	[SIXBIT/#/]	;SPACE DOWN A LINE
	CALL	PRLN		;PRINT TEXT OF LINE
	AOBJN	AC1,.-1		;LOOP
	TTOA	[BYTE(7) TAB,"$",CR,LF,CR,LF,0]
	JRST	X1		;RESTORE AC1 AND RETURN
;PRLN(T)
;PRINT OUT THE TEXT OF THE LINE WHOSE LSB ENTRY IS ADDRESSED BY T

PRLN:	PUSH	P,T
	HLRZ	T,(T)		;GET LINE NO.
	JUMPN	T,.+3		;DON'T PRINT IF ZERO
	TTOI	11
	JRST	.+2		;JUST A TAB FOR FN HEADER
	PUSHJ	P,TYPLNO	;PRINT LINE NO.
	HRRZ	T,(P)		;T_ADDR OF ENTRY
	HRRZ	T,(T)		;T_ADDR OF PZ POINTER TO BLOCK
	HRRZ	T,(T)		;T_ABS ADDR. OF TXT BLOCK
	HRLI	T,(POINT 7,0,35);MAKE A BYTE POINTER
NXTPRC:	ILDB	R,T		;PICK UP A CHARACTER
	JUMPE	R,PRLNX		;END?
	CAIE	R,12		;NO, LF?
	JRST	.+3
	TTOA	[BYTE(7) 12,15,11]	;YES, MOVE TO NEXT LINE
	JRST	NXTPRC
	CAIE	R,3		;^C?
	JRST	PRCH		;NO, PRINT CHARACTER NORMALLY
	TTOI	"%"		;YES, SUBSTITUTE PERCENT SIGN
	ILDB	R,T		;PASS ^C
	CAIN	R,"0"		;PASS UP TO 2 LEADING ZEROES
	ILDB	R,T
	CAIN	R,"0"
	ILDB	R,T
PRCH:	TTO	R		;PRINT OUT A CHARACTER
	JRST	NXTPRC
PRLNX:	TTOS	[SIXBIT/#/]	;FINISH LINE
	POP	P,T
	POPJ	P,

;PASSP,SCPSP
;PASSP - PASS SPACES, TABS AND LINEFEEDS, STARTING AT (BP)
;SCPSP - SCAN FIRST, THEN PASSP

SCPSP:	PUSHJ	P,SCAN		;MOVE TO A NEW CHARACTER
PASSP:	TRNE	CT,SEPRTR	;SEPARATOR?
	JRST	.-2		;YES, PASS IT
	POPJ	P,
;FINDLN
;FIND THE LINE IN THE CLSB WHOSE NUMBER IS IN LN.  SKIP IF IT IS
;FOUND, AND RETURN ITS RELATIVE ADDRESS.  IF NOT FOUND, IT RETURNS
;THE RELATIVE ADDRESS OF THE PLACE WHERE IT SHOULD BE PUT

FINDLN:	HRRZ	R,(CLSB)	;GET ABS ADDR OF BLOCK
	HLRZ	R2,(R)		;GET WLENGTH
	MOVN	R2,R2
	HRL	R,R2		;MAKE AOBJN POINTER
	AOBJP	R,FINDLX	;SHOULD NEVER HAPPEN
	HLRZ	R2,(R)		;LOOK AT A LINE #
	CAMN	R2,LN		;MATCH?
	AOS	(P)		;YES, WILL SKIP EXIT
	CAMGE	R2,LN		;AT OR PAST WANTED LINE NUMBER?
	AOBJN	R,.-4		;OR END OF LSB?
FINDLX:	SUB	R,(CLSB)	;EXIT WITH REL ADDR
	HLLI	R,
	POPJ	P,

;GETDDL
;GET AND RETURN THE DEWEY-DECIMAL LINE NUMBER AFTER BP, WHICH
;SHOULD NOW POINT TO A LEFT SQUARE BRACKET.  CHECKS FOR PROPER FORMAT

GETDDL:	PUSHJ	P,SCPSP		;PASS [ AND SPACES
	SETZB	R,R2		;INIT INT AND FRAC PARTS
GETDD1:	CAIN	C,"."		;PERIOD?
	JRST	GETDDF		;YES, BEGIN FRACTION
	TRNN	CT,DIGIT	;NO, DIGIT?
	JRST	GETDDX		;NO, END OF NUMBER
	IMULI	R,^D10		;OK, PUT ON DIGIT
	ADDI	R,-60(C)
	CAILE	R,^D999		;CHECK SIZE
	EDIERR	MSG(ILLIN)	;ILLEGAL LINE NUMBER
	PUSHJ	P,SCAN
	JRST	GETDD1		;YES
GETDDF:	PUSHJ	P,SCAN		;YES, MOVE PAST IT
	TRNN	CT,DIGIT	;LOAD UP WITH DIGITS AS BEFORE
	JRST	GETDDX
	IMULI	R2,^D10
	ADDI	R2,-60(C)
	CAIG	R2,^D99		;CHECK SIZE
	JRST	GETDDF
	EDIERR	MSG(ILLIN)	;ILLEGAL LINE NUMBER
GETDDX:	PUSHJ	P,PASSP		;DONE, PASS TRAILING SPACES IF ANY
	LSH	R,7		;PUT LINE NO. IN STANDARD FORM
	ADD	R,R2
	CAIE	C,"]"		;CHECK FOR ]
ILEDCM:	EDIERR	MSG(ILEDCM)	;ILLEGAL EDITING COMMAND
	MOVE	LN,R		;PUT NEW LINE NO. IN LN
	JRST	SCPSP		;PASS "]" AND TRAILING BLANKS
;ROUTINE TO CHECK AN AR RING FOR USE OF A PARTICULAR FUNCTION.
;   IF THE FUNCTION IS NOT IN USE BY ANY AR IN THE RING, THEN
;   THE NORMAL RETURN IS TAKEN.  IF IT IS IN USE, PERFORM THE
;   "RESET" OPERATION AND RESTART THE SUPERVISOR.  THE "EDIFLG"
;   FLAG IS SET SO THAT, WHEN CONVER IS CALLED TO GET ANOTHER
;   LINE FROM THE USER, THE EDITING COMMAND ALREADY IN THE
;   TEXT BUFFER WILL BE RE-EXECUTED.

;ARGUMENTS:
;	AC1 =	PZADR OF FN WHOSE USE IS TO BE CHECKED
;	AC2 =	PZADR OF SOME AR ON ONE OF THE RINGS

CKRING:	MOVEI	R,(AC2)		;FETCH PZADR OF THIS AR
	SAVE	<B>
CKRNG1:	HRRZ	B,(R)		;FETCH DZADR OF AR
	GET	R2,FNF		;FETCH FUNCTION FIELD
	CAIN	R2,(AC1)	;IS IT THE FN WE ARE LOOKING FOR?
	JRST	CKRNG2		;YES, GO DO RESET
	GET	R,RRF		;NO, FETCH PZADR OF RIGHT NEIGHBOR OF AR
	CAIE	R,(AC2)		;GONE COMPLETELY AROUND THE RING?
	JRST	CKRNG1		;NO, CONTINUE
	RESTOR	<B>		;YES, RESTORE B AND RETURN
	RETURN

;HERE TO PERFORM "RESET" OPERATION

CKRNG2:	TRO	FF,EDIFLG	;REMEMBER EDIT COMMAND ALREADY GIVEN
	JRST	RESETP		;PRINT WARNING MESSAGE AND PERFORM RESET


	LIT
	END