/**** FOCAL 5/69 ****
/E.A.TAFT - REVISION OF FOCALW 8/68	/EAT/ 25-JUL-72





/ASSEMBLY INSTRUCTIONS FOR DECUS VERSION:

/INPUT FILES:
/	FOCAL.569	FOCAL LANGUAGE PROCESSOR
/	FLOAT.569	FLOATING POINT PACKAGE
/	EXTEND.569	EXTENDED FUNCTION PACKAGE
/	2USER.569	2-USER OVERLAY

/ASSEMBLY USING PAL10 V.141
/	.R PAL10
/	*FOCAL.BIN_FOCAL.569,FLOAT.569
/	*EXTEND.BIN_EXTEND.569
/	*2USER.BIN_2USER.569
/	*^C
/	.R PIP
/	*FOCAL.BIN/B_FOCCAL.BIN,EXTEND.BIN,2USER.BIN
/	*PTP:/I_FOCAL.BIN

/WHEN READ-IN ON A PDP-8, THE LOADER WILL STOP 3 TIMES.  THE FIRST
/   SECTION CONTAINS THE BASIC PROCESSOR AND FLOATING POINT PACKAGE.
/   THE SECOND SECTION CONTAINS THE EXTENDED FUNCTIONS.  THE LAST
/   SECTION CONTAINS THE 2-USER OVERLAY (REQUIRES 2 TERMINALS AND 8K).
	EXPUNGE
/PROCESSOR INSTRUCTIONS
FIXMRI AND=0000
FIXMRI TAD=1000
FIXMRI ISZ=2000
FIXMRI DCA=3000
FIXMRI JMS=4000
FIXMRI JMP=5000
/FLOATING POINT INSTRUCTIONS
FIXMRI FPW=0000
FIXMRI FAD=1000
FIXMRI FSB=2000
FIXMRI FMY=3000
FIXMRI FDV=4000
FIXMRI FGT=5000
FIXMRI FPT=6000

FNR=7000
FEXT=0
FENT=JMS I 7
NOP=7000
CLA=7200
CLL=7100
CMA=7040
RAL=7004
CML=7020
RAR=7010
RTR=7012
RTL=7006
IAC=7001
SMA=7500
SZA=7440
SPA=7510
SNA=7450
SNL=7420
SZL=7430
SKP=7410
CIA=7041
ION=6001
IOF=6002
KSF=6031
KRB=6036
TSF=6041
TCF=6042
TPC=6044
TLS=6046
RSF=6011
RRB=6012
RFC=6014
	FIXTAB

/ * FOCAL * - BY RICK MERRILL - FOR THE FAMILY OF 8.
/REVISED BY EDWARD TAFT		5/69

/MISCELLANEOUS ITEMS
*1
	JMP I .+1	/INTERRUPT PROCESSOR ENTRY
	INTRPT
MINUSA,	-301	/CONSTANT
FNEGSW,	0	/USED FOR CALCULATING SIGNS
P13,	13	/CONSTANT
C100,	100	/CONSTANT
	FPNT	/ADDRESS OF FLOATING POINT INTERPRETER.

/AUTO-INDEX REGISTERS

AXIN,	0 	/STORAGE INDEX
XRT,	0	/EXTRA XR
XRT2,	0	/EXTRA XR
PDLXR,	0	/PUSHDOWN LIST INDEX REGISTER.
FLTXR,	IOBUF-1	/XR15 FOR FLOATING POINT
C200,	200	/CONSTANT
XRT3,	0	/USED BY PUSHDOWN LIST CONTROLS


TEXTP=.	/TEXT POINTERS
AXOUT,	FRSTX	/OUTPUT INDEX
XCT,	0	/UNPACK SWITCH
GTEM,	0	/UNPACK STORAGE

/NUMBERS

PER,	256	/PERIOD
M77,	-77	/RIGHT MASK
P7600,	7600	/GROUP MASK
M20,	-20	/CONSTANT
P177,	177	/STEP MASK
BOTTOM,	DBCONV-1/END OF TEXT BUFFER
FLOAT=	JMS I .	/FLOAT C(AC) SUBROUTINE
	XFLOAT
P17,	17	/BCD MASK
P277,	277	/"?"
C240,	240	/SPACE
M2,	-2	/CONSTANT
P2,	2	/CONSTANT
C260,	260	/ASCII FOR ZERO
HINBUF,	0	/HIGH SPEED INPUT BUFFER

FLOP=.	/FLOATING OPERAND STORAGE
FLOP0,	0
FLOP1,	0
FLOP2,	0
FLOP3,	0
FLAC=.	/FLOATING POINT ACCUMULATOR
FLAC0,	0
FLAC1,	0
FLAC2,	0
FLAC3,	0
NEGATE=	JMS I .	/NEGATE FLAC ROUTINE
	NEGAC
TOTDIG,	10	/TOTAL DIGITS IN OUTPUT FIELD
FIX=	JMS I .	/FIX FLAC ROUTINE
	XFIX
TABCTR,	0	/CARRIAGE INDEX

/CONSTANTS


LIST6=.	/INPUT LIST FOR "SFOUND".
P337,	337	/LEFT ARR
	214	/F.F.
	207	/BELL
CLF,	212	/L.F.
LIST3=. /EXCRETION LIST
CCR,	215	/LIST BRANCHER.
	0	/SEARCH CHARACTER (VARIABLE)

M100=.
P7700,	7700	/LEFT MASK
M240,	-240	/SPACE TEST
MPER,	-256	/PERIOD TEST
MCR,	-215	/C.R. TEST
MFLT=.	/3-WORD FLOATING POINT
M3,	-3
M5,	-5	/PAREN TEST
M11,	-11	/PAREN TEST
P77,	77	/RIGHT MASK

FOUTPUT,BDCONV	/FLOATING OUTPUT
FINPUT,	DBCONV	/FLOATING INPUT
COMBUF,	COMEIN	/COMMAND BUFFER`START
CFRS,	FRST	/ADDRESS OF DUMMY LINE.
END,	BUFBEG 	/FIRST LOCATION USED.
ENDT,	BUFBEG	/START OF STORAGE AREA **
RETURN=	JMP I .	/FUNCTION RETURN
EFUN3I,	EFUN3

/NEW INSTRUCTIONS:

PUSHJ=JMS I .	/RECURSIVE SUBROUTINE CALL
	XPUSHJ
POPA=TAD I PDLXR/RESTORE AC
POPJ=JMP I .	/SUBROUTINE RETURN
	XPOPJ
PUSHA=JMS I .	/SAVE AC
	XPUSHA
PUSHF=JMS I .	/SAVE GROUP OF DATA
	PD2
POPF=JMS I .	/RESTORE GROUP
	PD3
GETC=JMS I .	/UNPACK A CHARACTER
	UTRA
PACKC=JMS I .	/PACK A CHARACTER
	PACBUF
SORTJ=JMS I .	/SORT AND BRANCH ON AC OR CHAR
	SORTB
SORTC=JMS I .	/SORT CHAR
	XSORTC
PRINTC=JMS I .	/PRINT AC OR CHAR
	OUT
READC=JMS I .	/READ ASR-33 INTO CHAR AND PRINT IT
	CHIN
PRNTLN=JMS I .	/PRINT C(LINENO)
	XPRNTLN
GETLN=JMS I .	/UNPACK AND FORM A LINENUMBER
	XGETLN
FINDLN=JMS I .	/SEARCH FOR A GIVEN LINE
	XFIND
ENDLN=JMS I .	/INSERT LINE POINTERS
	XENDLN
RTL6=JMS I .	/ROTATE LEFT SIX
	XRTL6
SPNOR=JMS I .	/IGNORE SPACES AND LEADING ZEROS
	XSPNOR
TESTN=JMS I .	/PERIOD; OTHER; NUMBER
	XTESTN
TSTLPR=JMS I .	/SKIP IF 5<SORTCN<= 11 (I.E. AN L-PAR)
	LPRTST
TSTGRP=JMS I .	/SKIP IF G(AC) = G(LINENO)
	GRPTST
TESTC=JMS I .	/TERM; NUMBER; FUNCTION; LETTER
	XTESTC
ERROR=JMS I .	/GENERAL ERROR ROUTINE
	ERR2


SORTCN,	0	/NUMBER IN TABLE`FROM SORTC
LASTOP,	0	/LAST OPERATION FOR EVAL
EFOP=.		/FUNCTION CODE.
ATSW,	0	/ASK-TYPE SWITCH
CNTR,	-20	/DELETE AND ERROR COUNTER(USED BY F.P. ALSO)

DECP,	4	/NUMBER OF DECIMAL POINTS

STARTV=.	/=END FOR 8K

BUFR,	BUFBEG	/NEXT LOCATION IN BUFFER = LAST LOCATION OF TEXT.

ADD,	0	/CHAR BUF INPUT
XCTIN,	0	/PACK SWITCH
OUTDEV,	XOUTL	/OUTPUT SUBROUTINE
INDEV,	XI33	/INPUT SUBROUTINE

NAGSW,	0001	/NOT ALL AND/OR GROUP SWITCH (4000=ONE;1=ALL;0=GROUP)
CHAR,	215	/THE MOST IMPORTANT REGISTER
LINENO,	0000	/LINE NUMBER READ BY GETLN
GINC,	5	/WORDS TO STORE 1 VARIABLE

PC,	FLTZER	/PROGRAM COUNTER
THISLN,	0	/LINE POINTER FROM 'FINDLN'
THISOP,	0	/CURRENT 'EVAL' OPERATION
LASTLN,	0	/BACK POINTER FROM 'FINDLN'
DEBGSW,	1	/DEBUG SWITCH	; NON-ZERO FOR LITERAL.
DMPSW,	1	/=0 FOR TRACE ON.
PACKST,	0	/RUBOUT PROTECTION
PT1,	0	/VARIABLE POINTER
LASTV,	BUFBEG	/ADDRESS OF LAST VARIABLE
T1,	0	/TEMPORARY REGISTER - MAIN
T2,	0	/TEMP REGISTER - FOR NEW INST. ROUTINES.
FLARGP,	FLARG	/DATA ADDRESS
PTCH,	CHIN	/GENERAL CHARACTER INPUT ROUTINE.
/USED BY NEW FLOATING PT. PACKAGE
TEMP1,	0
TEMP2,	0
TEMP3,	0
TSTERM=	JMS I .	/TEST FOR ,;CR
	XTSTERM	/RETURNS: OTHER, ; OR CR, COMMA
DIGITS=6	/SIGNIFICANT DIGITS
/FOCAL'S COMMAND/INPUT DRIVER

*176
	BEGIN		/(RECOVR+1 AFTER INITIALIZATION)
START,	SKP CLA		/PROGRAM START FROM SELF
	JMP I .-2	/CONSOLE START: SW=200.
	TAD CFRSX	/(PC) => 0
	DCA PC		/FOR COMMAND MODE
	DCA DEBGSW	/ENABLE TRACE FOR INPUT OF (?).
	TAD COMBOT	/PROTECT COMMAND BUFFER.
	DCA PDLXR	/NO PATCH TEST.
	ISZ DMPSW	/INIT UNPACK AND TRACE SWITCH.
	DCA LIST3+1	/CLEAR SEARCH CHARACTER FOR INPUT.
	TAD P337	/ANNOUNCE PRESENCE
	PRINTC		/BY TYPING THE LEAD-IN CHARACTER
IBAR,	TAD COMBUF	/INITIALIZE COMMAND BUFFER
	DCA AXIN	/FOR UNPACKING.
	DCA XCTIN
	TAD COMBUF	/RUBOUT PROTECTION
	DCA PACKST
IGNOR,	READC		/READ COMMAND STRING
	SORTJ
		LIST6-1
		INLIST-LIST6
	PACKC		/SAVE STRING CHARACTER.
	JMP IGNOR
/////
P4000,	4000		/LINE NUMBER TEST
COMBOT,	COMOUT+12	/END OF COMMAND BUFFER,LESS PROTECTION COUNT.
CFRSX,	FLTZER		/POINTER FOR PC=COMMAND OR INPUT
/////
/COMMAND/INPUT PROCESSOR

IRETN,	PACKC		/START TO PACK C.R.
	PACKC		/FINISH C.R.
	TAD COMBUF	/INITIALIZE "TEXTP"
GONE,	DCA AXOUT	/SETUP CURRENT LINE
	DCA XCT
	GETC		/READ FIRST CHARACTER.
	TAD BOTTOM	/INIT PUSH-DOWN-LIST
	DCA PDLXR
	SPNOR		/IGNORE LEADING BLANKS
	TESTN		/DOES THE LINE BEGIN WITH 1-9?
	ERROR4		/ILLEGAL GROUP ZERO USAGE
	JMP INPUTX	/NO
	IOF		/YES,STOP INPUT MOMENTARILY.
	ISZ DEBGSW	/DISABLE TRACE FOR REPACKING
	GETLN		/READ THIS LINE NUMBER
	TAD NAGSW
	TAD P4000	/TEST FOR SINGLE LINE
	SZA CLA
	ERROR3		/ILLEGAL LINE NUMBER ON INPUT
	TAD BUFR	/SET POINTERS
	DCA AXIN
	DCA XCTIN
	TAD LINENO	/SAVE LINE #
	DCA I AXIN	/(X-MEM)
	SPNOR		/IGNORE SPACES AFTER LINE NUMBER
	SKP
	GETC		/READ 1ST AFTER LINENO TERMINATOR.
	PACKC		/SAVE TEXT AND RESTORE DATA FIELD
	TAD CHAR	/TEST FOR END OF INPUT STRING
	TAD MCR
	SZA CLA
	JMP .-5
	PUSHJ		/REMOVE OLD LINE, IF ANY.
		DELETE
	ENDLN		/INSERT NEW LINE
	JMP START
/////
INPUTX,	PUSHJ		/PROCESS IMMEDIATE COMMAND.
		PROC
	TAD I PC	/CHECK NEXT LINE (X-MEM)
	SNA		/END OF PROGRAM? 
	JMP START	/YES
	DCA PC		/SAVE NEW LINE NO.
	TAD PC		/START NEW LINE
	IAC
	JMP GONE	/PROCESS OTHER COMMANDS
/TEXT LINE BUFFER FORMAT*
/#1 : POINTER OR ZERO IN LAST
/#2 : LINENO
/#3 - #N+1 : TEXT
/#N : C.R.

XRTL6,	0	/ROTATE AC LEFT 6
	CLL RTL
	RTL
	RTL
	JMP I XRTL6
/
/PROCESS A LINE NUMBER - "GETLN"
XGETLN,	0
	SPNOR
	TAD P4000	/INITIALIZE TO SINGLE LINE
	DCA NAGSW
	SORTC		/TEST FOR A SIGN
		SNLIST-1
	JMP EVLN	/EVALUATE IN FLOATING POINT
	JMS I INPINT	/FIXED POINT: GET GROUP
	TESTN
	GETC		/GO PAST . IF THERE
	JMS GEG		/GET 1ST STEP DIGIT
	CLL RTL		/MULTIPLY BY TEN
	TAD SORTCN
	RAL
	JMS GEG		/GET 2ND STEP DIGIT
	TAD LINENO	/COMBINE
GEXIT,	SNA
	DCA NAGSW	/MUST BE GROUP
	DCA LINENO	/SAVE STEP NUMBER
	TAD DECNUM	/GROUP
	SNA
	JMP GTESTA	/GROUP 0: MUST BE "ALL"
	RTL6		/CONSTRUCT LINE NUMBER
	RAL
	TAD LINENO
	DCA LINENO
	TAD DECNUM	/TEST FOR LEGAL GROUP
	AND C7760
	JMP .+3
GTESTA,	ISZ NAGSW	/SET TO "ALL"
	TAD LINENO	/MAKE SURE LINE # IS ZERO
	SNA CLA
	TESTN		/OK, TEST FOR EXTRA DIGITS
	JMP LNERR	/DOUBLE ., ILLEGAL G. 0, OR G.>15
	JMP I XGETLN	/OK
	JMP LNERR	/TOO MANY DIGITS

GEG,	0		/GET A STEP DIGIT
	DCA LINENO
	TESTN
LNERR,	ERROR		/DOUBLE PERIODS
	JMP GEXIT-1	/NO DIGIT
	GETC		/DIGIT, PASS IT
	TAD SORTCN	/EXIT WITH VALUE
	JMP I GEG
/////
INPINT,	DECINT
C7760,	7760
/////
/EVALUATE A LINE NUMBER IN FLOATING POINT
EVLN,	PUSHJ		/GET VALUE
		EVAL
	FIX		/GET GROUP #
	PUSHA
	TAD FLAC1
	SZA CLA
	JMP LNERR	/TOO BIG
	FENT		/GET STEP #
	FNR
	FSB I FLARGP	/THIS GIVES -(FRACTIONAL PART)
	FMY I F10P
	FMY I F10P
	FSB I FP10P	/KILL ANY ROUNDOFF ERROR
	FEXT
	NEGATE
	POPA		/RESTORE GROUP
	DCA DECNUM
	FIX
	JMP I .+1
		GEXIT
/////
F10P,	FLTEN
FP10P,	FLPTEN

/RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 15.99

/NAGSW:
/GROUP=0000
/LINE=4000
/ALL=0001
/RECURSIVE OPERATE, EXECUTE, OR CALL 

DO,	GETLN		/EXECUTE ONE LINE, A GROUP,OR ALL
	TAD PC		/SAVE ADDRESS
	PUSHA		/OF CURRENT LINE
	PUSHF		/SAVE REST OF THIS LINE
		TEXTP	/ADDRESS OF TEXT POINTERS
DGRP,	PUSHF		/SAVE NAGSW; CHAR; AND LINENO.
		NAGSW
	TAD NAGSW	/CHECK DATA FROM GETLN.
	SPA CLA		/SKIP IF GROUP OR ALL
	JMP DOONE	/DO ONE LINE
	FINDLN		/INIT FOR GROUP AND SET THISLN
	JMP TGRP2
DGRP1,	PUSHJ		/EXECUTE OBJECT LINE AND SET PC.
		PROCESS-2
	POPF		/RESTORE THE DATA
		NAGSW
	TAD I PC	/CHECK FOR END OF TEXT (X-MEM)
	SNA
	JMP DCONT	/ALL DONE
	IAC
	DCA PT1		/SAVE POINTER TO LINENO
	TAD NAGSW	/CHECK FOR GROUP
	SMA SZA CLA
	JMP .+4		/DO ALL
	TAD I PT1	/TEST GROUP (X-MEM)
	TSTGRP
	JMP DCONT	/NOT IN GROUP
	TAD I PT1	/READ NEXT LINE NO. (X-MEM)
	DCA LINENO
	JMP DGRP	/CONTINUE THE SUBROUTINE
/////
DOONE,	FINDLN		/FIND THE LINE
	ERROR2		/NO SUCH LINE NUMBER
	PUSHJ		/EXECUTE IT
		PROCESS
	POPF		/RESTORE CHAR
		NAGSW
DCONT,	POPF		/RESTORE TEXT POINTERS
		TEXTP
	POPA		/RESTORE ADDRESS OF CURRENT LINE.
	DCA PC
	TSTERM		/GO TO TERMINATOR
	JMP .-1
	JMP I .+2	/END OF DO, CONTINUE PROCESSING
	JMP DO		/COMMA, DO ANOTHER
		PROC

TGRP2,	TAD THISLN	/TEST FOR GOOD GROUP NUMBER.
	DCA XRT
	TAD I XRT
	TSTGRP
	ERROR2		/NO SUCH GROUP NUMBER
	JMP DGRP1
/PUSHDOWN LIST CONTROLS
/
XPUSHA,	0		/PUSHDOWN THE AC - "PUSHA"
	DCA PD2		/SAVE AC
	CMA		/BACK UP POINTER
	JMS PCHK	/CHECK CORE USAGE
	TAD PD2
	DCA I XRT3	/SAVE
	JMP I XPUSHA
/////
PCHK,	0
	TAD PDLXR	/INC IN AC
	DCA PDLXR
	TAD PDLXR
	DCA XRT3	/DUPLICATE POINTER
	TAD PDLXR
	CLL CIA
	TAD LASTV
	SZL CLA
	ERROR		/STORAGE FILLED BY PUSHDOWN LIST
	JMP I PCHK
/////
XPUSHJ,	0		/RECURSIVE SUBROUTINE CALL - "PUSHJ"
	CLA IAC
	TAD XPUSHJ	/SAVE RETURN
	JMS XPUSHA	/(PUSHA)
	TAD I XPUSHJ	/TO NEW ROUTINE
	DCA XPUSHJ
	JMP I XPUSHJ
/////
PD2,	0		/SAVE A FLOATING PT NUMBER - "PUSHF"
	CLA CMA		/COMPUTE ADDRESS
	TAD I PD2
	DCA XRT
	ISZ PD2
	TAD M3		/BACKUP THREE
	JMS PCHK
	TAD I XRT	/SAVE 3 WORDS
	DCA I XRT3
	TAD I XRT
	DCA I XRT3
	TAD I XRT
	DCA I XRT3
	JMP I PD2

PD3,	0		/RESTORE A FLOATING PT # - "POPF"
	CLA CMA
	TAD I PD3
	ISZ PD3
	DCA XRT
	TAD I PDLXR
	DCA I XRT
	TAD I PDLXR
	DCA I XRT
	TAD I PDLXR
	DCA I XRT
	JMP I PD3
/
/INPUT CONTROL CHARACTERS
INLIST,	IBAR	/B.A.=RESTART
	IGNOR+4	/F.F.
	IGNOR+4	/BELL
	IGNOR	/L.F.=IGNORED
	IRETN	/C.R.=TERMINATE INPUT
/
/LIST OF FUNCTION ADDRESSES
FNTABF,	XABS	/ABSOLUTE VALUE
	FSGN	/SIGN PART
	XINT	/INTEGER PART
	XDYS	/FDIS- DISPLAY Y AND INTENSIFY
	FRAN	/RANDOM NUMBER
	XDXS	/SET X-COORDINATE FOR DISPLAY
	XADC	/READ ANALOG-DIGITAL CONVERTER
	ERROR5	/ATN	THESE ROUTINES NOT IN PACKAGE
	ERROR5	/EXP
	ERROR5	/LOG
	ERROR5	/SIN
	ERROR5	/COS
	FSQT	/SQUARE ROOT
	ERROR5	/NEW- USER-DEFINED FUNCTION
/
MF,	-306	/USED BY TESTC
/PRIMARY CONTROL AND TRANSFER

GOTO,	GETLN		/READ THE LINE NUMBER REQUESTED
	FINDLN		/LOCATE IT AND RESET TEXTP
	ERROR2		/NOT THERE OR A TIGHT LOOP.
	TAD THISLN	/SET PC
	DCA PC
PROCESS,GETC		/TEST FOR END OF LINE
PROC,	SORTC		/FIRST CHARACTER READY = USE PROC
	 CCR-1
PC1,	POPJ		/EXIT "PROCESS"
	SORTC		/IGNORE SPACE ; ,
	 GLIST-1
	JMP PROCESS
	TAD CHAR	/SAVE COMMAND CHARACTER
	PUSHA
	GETC		/GO TO TERMINATOR
	SORTC
		TERMS-4
	SKP
	JMP .-4
	SPNOR
	POPA
	SORTJ		/GO DO COMMAND
		COMLST-1
		COMGO-COMLST
	ERROR2		/ILLEGAL COMMAND
/////

COMMENTS=PC1	/ALSO IS CONTINUE

/OUTPUT COMMAND TEXT

WRITE,	JMS I WTXS	/SAVE CHAR AND TEXT POINTERS
	GETLN		/SET LINENO
	ISZ DEBGSW	/DISABLE TRACE
	FINDLN		/SEARCH FOR LINE NUMBER
	JMP WTESTG	/NOT THERE OR GROUP
	TAD LINENO
	SZA CLA
	PRNTLN		/PRINT LINE NUMBER AND A SPACE.
	GETC
	PRINTC		/PRINT TEXT OF A LINE.
	TAD CHAR
	TAD MCR
	SZA CLA		/SKIP IF END OF LINE
	JMP .-5
	TAD I THISLN	/TEST FOR END OF TEXT (X-MEM)
WTEST2,	SNA
	JMP WEXIT	/WRITE FINISHED
	IAC
	DCA PT1		/SAVE POINTER TO LINENO OF`NEXT (X-MEM)
	TAD NAGSW
	SMA CLA
	TAD I PT1	/(X-MEM)
	TSTGRP		/TRY NEXT LINENO FOR GROUP.
	JMP WX
WALL,	TAD I PT1	/SET LINENO (X-MEM)
	DCA LINENO
	JMP WRITE+3
///
WTESTG,	TAD THISLN	/INIT GROUP PRINTOUT
	JMP WTEST2
/////
WX,	TAD NAGSW
	SPA SNA CLA	/SKIP IF ALL
	JMP WEXIT
	PRINTC	/PRINT C.R. AGAIN
	JMP WALL
/////
WEXIT,	JMS I WTXR	/RESTORE CURRENT LINE
	DCA DEBGSW	/RESTORE TRACE
	TSTERM
	JMP .-1
	JMP PROC	/END OF WRITE
	JMP WRITE	/COMMA, MORE TO WRITE
/////
WTXS,	TXTSAV
WTXR,	TXTRES

XTESTC,	0	/TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC"
	SPNOR		/IGNORE SPACES
	SORTC		/TEST THE VARIABLE TERMINATORS
		TERMS-1
	JMP I XTESTC	/YES - SORTCN IS SET
	ISZ XTESTC
	TESTN
	JMP I XTESTC	/. (PART OF NUMBER)
	SKP		/OTHER
	JMP I XTESTC	/NUMBER
	TAD CHAR	/TEST FOR "F"
	TAD MF
	SZA CLA
	ISZ XTESTC	/NO
	ISZ XTESTC	/RETURNS:
	JMP I XTESTC	/TERMINATOR;NUMBER;FUNCTION;OTHER
/////
XSORTC,	0	/SORT CHAR AGAINST TABLE - "SORTC"
	TAD I XSORTC
	DCA XRT2	/1ST ARG IS LIST-1
	TAD I XRT2
	SPA		/LIST IS ENDED BY A NEGATIVE NUMBER
	JMP SEXC	/2AND EXIT = NOT IN LIST
	CIA
	TAD CHAR
	SZA CLA		/COMPARE
	JMP .-6
	TAD I XSORTC	/COMPUTE INCREMENT : 0 - N
	CMA
	TAD XRT2
	DCA SORTCN
	SKP		/1ST EXIT = YES
SEXC,	ISZ XSORTC
	ISZ XSORTC
	CLA CLL
	JMP I XSORTC

/COMMAND DECODING LIST
COMLST,	323	/SET
	306	/FOR
	311	/IF
	304	/DO
	307	/GOTO
	303	/COMMENT OR CONTINUE
	301	/ASK
	324	/TYPE
	314	/LIBRARY
	305	/ERASE
	327	/WRITE
	315	/MODIFY
	321	/QUIT
	322	/RETURN
	317	/OPTION
	310	/HELLO
/CONDITIONAL TRANSFER PROCESS
/ IF (EXP) A,B,C
IF,	SORTC		/LOOK FOR L-PAR
	 PLPR-1
	SKP
	ERROR		/NO ( AFTER IF
	PUSHJ		/EVALUATE EXPRESSION
	 EVAL-1
	GETC		/PASS )
	TAD FLAC1	/TEST FOR -,0,+
	SPA CLA
	JMP I PGOTO	/NEGATIVE, USE 1ST REF
	TSTERM		/0 OR POS, GET TO NEXT
	JMP .-1
	JMP I PRCP	/; OR CR, CONTINUE SAME LINE
	TAD FLAC1	/COMMA, SEE IF 0 OR POS
	SNA CLA
	JMP I PGOTO	/ZERO, USE 2ND REF
	TSTERM		/POSITIVE, GET TO NEXT
	JMP .-1
	JMP I PRCP	/; OR CR
	JMP I PGOTO	/COMMA, USE 3RD REF
PGOTO,	GOTO
PLPR,	250
/ASSIGNMENT AND LOOP CONTROL
SET=.
FOR,	PUSHJ		/GET POINTER TO VAR.
	 GETARG
	SPNOR
	SORTC		/SEARCH FOR =
	 TERMS+17-1
	SKP
	ERROR		/LEFT OF = IN ERROR: "FOR" OR "SET"
	TAD PT1		/SAVE VARIABLE POINTER
	DCA PT2
	PUSHJ		/EVALUATE INITIAL EXPRESSION
	 EVAL-1
	FENT		/SAVE INITIAL VALUE
	FPT I PT2
	FEXT
	TSTERM		/CHECK TERMINATOR
	ERROR		/PROBABLY EXCESS R-PAR
	JMP I PRCP	/; OR CR: THIS IS A SET; CONTINUE
	TAD PT2		/COMMA, SAVE LOOP VAR POINTER
	PUSHA
	PUSHJ		/EVALUATE SECOND EXPRESSION
	 EVAL
	TSTERM		/CHECK TERMINATOR
	ERROR		/EXCESS R-PAR OR BAD TERMINATOR
	JMP ONEINC	/; OR CR, THAT'S ALL (INC=1)
	PUSHF		/COMMA, SAVE INCREMENT
	 FLARG
	PUSHJ		/EVALUATE FINAL EXPRESSION
	 EVAL
SFINAL,	PUSHF		/SAVE FINAL VALUE
	 FLARG
	JMS I FTXS	/SAVE CHAR AND TEXT POINTERS
	FLOAT		/FLOAT A ZERO TO START
FCONT,	FENT		/COMPARE LOOP VAR TO FINAL
	FAD I PT2	/LOOP VAR
	FPT I PT2
	FSB I FLARGP	/FINAL
	FEXT
	TAD PDLXR	/CHECK SIGN OF INCREMENT
	TAD PINC
	DCA PT2
	TAD I PT2
	SPA CLA
	NEGATE		/BACKWARD COUNTING
	TAD FLAC1
	SMA SZA CLA
	JMP FEND	/LIMIT REACHED OR EXCEEDED

	PUSHJ		/NOT YET, DO OBJECT STATEMENTS
PRCP,	 PROC
	JMS I FTXR	/RESET TO BEGINNING OF OBJ. STMT.
	POPF		/RESTORE LIMIT
	 FLARG
	POPF		/RESTORE INC
	 FLAC
	POPA		/RESTORE LOOP VAR POINTER
	DCA PT2
	TAD M13		/PUSH DOWN ALL OF ABOVE
	TAD PDLXR
	DCA PDLXR
	JMP FCONT
/////
ONEINC,	PUSHF		/NO INCREMENT GIVEN, SET TO 1
	 FLTONE
	JMP SFINAL
/////
PINC,	11
M13,	-13
FTXS,	TXTSAV
FTXR,	TXTRES
FEND,	TAD P13		/END OF LOOP
	TAD PDLXR	/REMOVE VALUES!FROM PUSHDOWN LIST
	DCA PDLXR
	POPJ
PT2,	0
/////
/ASK/TYPE SPECIAL CHARACTERS
ALIST,	246	/&
	245	/%
	242	/"
	241	/!
	243	/#
	244	/$
GLIST,	240	/SPACE
TLIST,	254	/,
	273	/;
	215	/C.R.
/SET Y AND INTENSIFY THE POINT
XDYS,	FIX
	6063	/DYL
	CLA
	TAD X0
	6053	/DXL DIX
	SKP
/
/SET X
XDXS,	FIX
	DCA X0	/(DXL)
	RETURN
/
/TAKE THE INTEGER PART
XINT,	FIX
	CLA
	RETURN
X0,	0
/////
TLIST3,	TASK4	/"
	TASK	/C.R. - AUTOMATIC QUOTE MATCH
/COMMAND POINTERS
COMGO,	SET
	FOR
	IF
	DO
	GOTO
	COMMENTS
	ASK
	TYPE
	LIBRARY
	ERASE
	WRITE
	MODIFY
	START
	RETRN
	OPTION
	HELLO
/////
PACLS2,	PQUES
	RUB1
/INPUT-OUTPUT STATEMENTS

ASK,	CLA CMA		/REMEMBER WHICH CALL.
TYPE,	DCA ATSW
TASK,	DCA DEBGSW	/RE-ENABLE THE TRACE
	SORTJ		/SPECIAL CHARACTER? 
		ALIST-1
		ATLIST-ALIST
	ISZ ATSW	/TEST QUOTE SWITCH
	JMP TYPE2
	PUSHJ		/DO ASK; SETUP PT1
		GETARG
	JMS I TTXTS	/PROTECT TEXT
	TAD COL		/TYPE COLON
TASKCL,	PRINTC		/(CLA) TO SUPPRESS ":"
	JMS I INTERP	/CALL INPUT CONVERSION ROUTINE
	JMS I TTXTR	/RESTORE TEXT
	JMP ASK		/CONTINUE PROCESSING
INTERP,	INTASK
////
TYPE2,	PUSHJ		/DO TYPE
		EVAL
	TSTERM
	ERROR		/BAD TERMINATOR IN "TYPE"
COL,	272
	JMS I OUTS	/PRINT
	JMP TYPE
/////
TTXTS,	TXTSAV
TTXTR,	TXTRES
OUTS,	OUTPT

TQUOT,	ISZ DEBGSW	/DISABLE TRACE
	GETC		/TYPE LITERALS
	SORTJ
		TLIST2-1
		TLIST3-TLIST2
	PRINTC
	JMP TQUOT+1
//////
TCRLF,	TAD CCR		/SLASH=CR,LF.
	PRINTC
TASK4,	GETC		/MOVE TO NEXT CHARACTER
	JMP TASK
////
TCRLF2,	TAD CCR		/SPLAT=CR
	JMS I OUTDEV
	TAD C200	/DELAY FOR C.R.
	JMP TCRLF+1

/IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW"
/	#0: DISABLE AND RETURN ALL"?" ' S.
/IF DMPSW = 0: TRACE ON, IF ENABLED
/	#0: TRACE OFF
/IF BOTH = 0 : PRINT TRACE.


TINTR,	GETC		/PASS PERCENT SIGN
	JMS I INTG	/READ FORMAT CONTROL: "%7.3"
	TAD DECNUM	/INTEGER PART (TOTAL DIGITS)
	DCA TOTDIG
	TESTN		/GET PAST . IF ANY
	GETC
	JMS I INTG	/RIGHT-HAND PART (DECIMAL PLACES)
	TAD DECNUM
	DCA DECP
	JMP TASK
INTG,	DECINT
/SEARCH ROUTINES

MODIFY,	GETLN		/READ LINE NO.
	FINDLN		/LOOK IT UP NOW.
	ERROR2		/NOT THERE = BAD COMMAND UNLESS ZERO.
	TAD BUFR	/SET POINTERS
	DCA AXIN	/FOR INPUT
	DCA XCTIN
	TAD LINENO	/COPY THE SAME LINE NUMBER.
	SNA		/CHECK FOR ALL
	JMP MODIFY+2	/ERROR IN ARG
	DCA I AXIN	/(X-MEM)
	TAD AXIN	/SAVE START OF NEW LINE
	DCA PACKST
SCONT,	JMS I INDEV	/READ THE TELETYPE INPUT SILENTLY.
	DCA LIST3+1	/SAVE SEARCH CHARACTER
	ISZ DEBGSW	/NO BREAKS.
SCHAR,	GETC		/TYPE+TEST-F.F.
	PRINTC
	SORTJ		/LOOK FOR MATCH
		LIST3-1
		LISTGO-LIST3
	PACKC		/SAVE NEW LINE.
	JMP SCHAR
/////
SBAR,	TAD BUFR	/RESTART-B.A.
	IAC
	DCA AXIN	/SET POINTERS
	DCA XCTIN
SFOUND,	READC		/READ FROM KEYBOARD
	SORTJ		/TEST
		LIST6-1
		SRNLST-LIST6
SGOT,	PACKC		/PACK CHAR.
	JMP SFOUND	/MORE

SORTB,	0	/SORT AND BRANCH ROUTINE. - "SORTJ"
	SNA
	TAD CHAR	/ASSUME CHAR IF AC=0
	CIA
	DCA T2		/SAVE SORT ITEM
	TAD I SORTB	/FIRST ARG IS LIST LESS ONE
	ISZ SORTB	/2AND IS INTRA-LIST LENGTH
	DCA XRT2
	TAD I XRT2
	SPA		/**LISTS ENDED BY NEGATIVE NUMBERS**
	JMP SEX		/READ EXIT
	TAD T2		/FIND ADDRESS
	SZA CLA
	JMP .-5
	TAD XRT2	/MATCH FOUND.
	TAD I SORTB
	DCA SORTB	/SETUP RETURN
	TAD I SORTB
	DCA SORTB
	SKP
SEX,	ISZ SORTB	/MATCH NOT FOUND.
	CLA CLL
	JMP I SORTB	/RETURN TO CALLING SEQUENCE.

TAB,	PUSHJ		/TABULATE TO A PARTICULAR COLUMN
		EVAL-1
	FIX		/GET COLUMN NUMBER
	CLL CIA
	IAC
	TAD TABCTR
	SZL CLA
	JMP TASK	/ALREADY THERE OR PAST IT
	TAD C240
	PRINTC
	TAD FLAC2	/TEST AGAIN
	JMP TAB+3
SRNLST=.	/'MODIFY' CONTROL CHARACTER TABLE
	SBAR	/B.A. = RESTART
	SCHAR	/F.F. = CONTINUE
	SCONT	/BELL = CHANGE SEARCH CHARACTER
	SCONT+1	/L.F. = FINISH THE LINE AS BEFORE.
/////
LISTGO,	INPUTX-11	/C.R. - END THE MODIFIED LINE HERE
	SGOT		/FOUND SEARCH CHARACTER
/FIND OR ENTER A VARIABLE IN THE LIST.

GETARG,	TESTC		/FIRST LETTER OF ARG
TLIST2,	0242		/"
	0215		/C.R. - FUNCTION OR NUMBER IS NOT AN ARG.
	ERROR4		/BAD ARGUEMENT IN 'FOR' 'SET', OR 'ASK'
	CLA CMA		/"GETARG" CAN CREATE NEW VAR.
GETVAR,	PUSHA		/"GETVAR" WILL NOT
	DCA XCTIN	/PACK INTO ADD.
	PACKC
	GETC		/SECOND LETTER
	SORTC		/TERMINATOR?
		TERMS-1
	JMP .+3		/YES
	TAD CHAR	/NO
	AND P77		/SAVE 2AND LETTER OF NAME
	TAD ADD
	PUSHA
	SORTC		/IGNORE THE REST
		TERMS-1
	JMP .+3
	GETC
	JMP .-4
	TSTLPR		/LOOK FOR SUBSCRIPT VIA SORTCN
	JMP GS1		/NOT SUBSCRIPTED BY L-PAR.
	TAD LASTOP	/SAVE LAST OPERATION
	PUSHA
	PUSHJ		/MOVE PAST L-PAR AND
		EVAL-1	/EVALUATE THE SUBSCRIPT.
	GETC		/MOVE PAST R-PAR
	POPA
	DCA LASTOP	/RECALL LAST OPERATION
	FIX
GS1,	DCA SUBS	/SAVE SUBSCRIPT
	POPA
	DCA ADD		/RESTORE NAME
	TAD STARTV	/SEARCH FOR VARIABLE
GS3,	DCA PT1
	TAD PT1
	DCA XRT
	TAD PT1
	CIA
	TAD LASTV	/TEST FOR END OF LIST
	SPA SNA CLA
	JMP GS2		/END SEARCH
	TAD I PT1	/GET TABLE ENTRY
	CIA
	TAD ADD
	SNA CLA
	JMP GFND1	/FOUND XX

GS4,	TAD PT1		/TRY NEXT ONE
	TAD GINC
	JMP GS3
GS2,	ISZ I PDLXR	/VAR. NOT FOUND, CAN I MAKE ONE?
	ERROR		/UNDEFINED VAR. USED IN EXPRESSION
	TAD LASTV	/OK, ADD THE VARIABLE
	TAD P13		/TEST STORAGE LIMITS
	CIA CLL
	TAD PDLXR
	SNL CLA
	ERROR3
	TAD LASTV	/UPDATE THE LIST.
	TAD GINC
	DCA LASTV
	TAD ADD		/SAVE NAME
	DCA I PT1
	TAD SUBS	/SAVE SUBSCRIPT
	DCA I XRT
	DCA I XRT	/INITIALIZE VAR. TO ZERO
	DCA I XRT
	DCA I XRT
	JMP GS5		/EXIT
/////
GFND1,	TAD I XRT	/FOUND NAME, TEST SUBSCRIPT
	CIA
	TAD SUBS
	SZA CLA
	JMP GS4		/WRONG SUBSCRIPT
	ISZ PDLXR
GS5,	ISZ PT1		/SET POINTER TO DATA
	ISZ PT1
	POPJ
////
P0,	FLTZER

/IGNORE LEADING SPACES - "SPNOR"

SUBS=.
XSPNOR,	0
	TAD CHAR
	TAD M240
	SZA CLA
	JMP I XSPNOR
	GETC
	JMP XSPNOR+1
/////
/SEE IF NEXT CHARACTER IS A NUMBER
XTESTN,	0	/RETURNS: .; OTHER; NUMBER - "TESTN"
	TAD CHAR
	TAD MPER	/TEST FOR .
	SZA
	ISZ XTESTN	/NOT A .
	TAD NTST1	/COMPARE TO "9"
	SMA
	JMP NTEXIT	/TOO LARGE
	TAD NTST2	/COMPARE TO "0"
	SPA
	JMP NTEXIT	/TOO SMALL
	DCA SORTCN	/FOUND DIGIT, SAVE IT
	ISZ XTESTN
NTEXIT,	CLA CLL
	JMP I XTESTN
/////
NTST1,	256-272
NTST2,	272-260
/EXIT FROM A "DO" SUBROUTINE


RETRN,	TAD P0	/(PC) => 0
	DCA PC
XPOPJ,	TAD I PDLXR	/RECURSIVE EXIT - "POPJ"
	DCA T2
	JMP I T2


/ASK-TYPE CONTROL CHARACTER TABLE
ATLIST,	TAB	/& - TABULATION DELIMITER
	TINTR	/% - FORMAT DELIMITER
	TQUOT	/" - LITERAL DELIMITER
	TCRLF	/! - CARRIAGE RETURN AND LINE FEED
	TCRLF2	/# - CARRIAGE RETURN ONLY
	TDUMP	/$/- DUMP THE SYMBOL TABLE CONTENTS
	TASK4	/SP- TERMINATOR FOR NAMES
	TASK4	/, - TERMINATOR FOR EXPRESSIONS
	PROCESS	/; - TERMINATOR FOR COMMANDS
	PC1	/C.R. - TERMINATOR FOR STRINGS
/////
FLTONE,	0001
	2000
FLTZER,	0000
	0000
	0000
/EVALUATE AN EXPRESSION WHICH
/TERMINATES WITH AN R-PAR,; OR C.R. AND
/LEAVE THE RESULT IN FLAC AND IN FLARG.




	GETC		/MOVE PAST EXTRA CHARACTER
EVAL,	DCA LASTOP	/EVAUATION CONTROLLER (CHECKPOINT ?)
	TESTC		/TEST CHARACTER AND IGNORE SPACES
	JMP ETERM1	/TERMIOATION
	JMP ENUM	/NUMBER
	JMP EFUN	/FUNCTION
	PUSHJ		/LETTER OF VARIABLE
		GETVAR	/FIND OR CREATE VARIABLE;ALSO SET PT1.
OPNEXT,	TESTC		/PT1=>ARG
	JMP ETERMN	/T
ECHOLST,0212		/N-ERROR IN FORMAT
	0377		/F
	ERROR4		/L - MISSING OPERATOR
/////
ETERM1,	PUSHF		/INITIALIZE RESULT TO ZERO.
		FLTZER
	POPF
		FLARG
	TAD FLARGP	/SET PT1.
	DCA PT1
	TAD M2		/TEST FOR UNARY OPERATIONS
	TAD SORTCN
	SNA
	JMP ETERM	/CREATE DUMMY FOR UNARY MINUS
	IAC
	SNA CLA
	JMP ARGNXT	/IGNORE UNARY PLUS
	TAD SORTCN	/TEST FOR NULL PARENS.
	TAD M11
	SPA CLA
	JMP ELPAR	/MIGHT BE AN L-PAR.
ETERMN,	TSTLPR
	SKP
	ERROR4		/OPERATOR MISSING BEFORE PAREN
ETERM,	TAD SORTCN	/SET FROM "TESTC"-"SORTC"
	DCA THISOP
	TAD THISOP
	TAD M11
	SMA CLA		/END?
	DCA THISOP	/"THISOP" EQUIV. TO END OF EXP.

ETERM2,	CLA IAC		/COMPARE PRIORITIES
	AND THISOP	/PRIORITIES ARE: (^),(*/),(+-),PUT
	TAD THISOP
	CIA
	DCA FLOPR
	IAC
	AND LASTOP
	TAD LASTOP
	TAD FLOPR
	SPA CLA
	JMP EPAR	/CONTINUE
	TAD LASTOP	/FIND OPERATION FROM TABLE
	TAD OPTABL
	DCA FLOPR
	TAD I FLOPR
	DCA FLOPR
	TAD LASTOP
	SZA CLA		/TEST FOR END OF DATA INTO FLOATING AC.
	POPF		/GET LAST DATA
		FLAC
	FENT
FLOPR,	00		/(FLOPR I PT1) +-*/^
	FPT I FLARGP	/SAVE RESULT
	FEXT
	TAD FLARGP
	DCA PT1
	TAD THISOP
	TAD LASTOP	/=0?
	SNA CLA
	POPJ		/EXIT "EVAL"
	POPA		/GET PRIOR OP
	DCA LASTOP
	JMP ETERM2	/COMPARE THIS OP
/////
EPAR,	TSTLPR		/TEST FOR SUB-EXPRESSION
	SKP
	JMP EPAR2	/GO EVALUATE EXPRESSION
	TAD LASTOP	/CONTINUE READING THE EXPRESSION
	PUSHA		/SAVE "LASTOP".
	TAD PT1
	DCA .+2
	PUSHF		/SAVE LAST ARGUMENT
		00
	TAD THISOP	/MORE TO COME
	DCA LASTOP
ARGNXT,	GETC		/READ 1ST CHAR OF AN ARG.
	TESTC		/DO SPECIAL CHECK
	JMP ELPAR	/COULD BE LEFT PAREN
	JMP ENUM	/N
	JMP EFUN	/F
	JMP OPNEXT-2	/L
OPTABL,	OPTABS
/////

ENUM,	PUSHF		/TO PROCESS A NUMBER,SAVE AC
		FLAC
	TAD FLARGP	/SET POINTER AS FOR A VARIABLE.
	DCA PT1
	JMS I FINPUT	/READ TEXT NUMBER => (PT1)
	POPF		/RESTORE THE AC
		FLAC
	JMP OPNEXT	/CONTINUE
/////
EFUN,	DCA FLOPR	/SET CODE
	GETC		/READ FUNCTION NAME.(1,2,OR 3 LETTERS)
	SORTC		/LOOK FOR TERMINATION CHARACTER.
		TERMS-1
	JMP EFUN2	/YES
	TAD FLOPR	/NO
	CLL RAL		/MISH-MASH HASH CODE
	TAD CHAR
	JMP EFUN
ELPAR,	TSTLPR
	ERROR4		/DOUBLE OPERATORS
EPAR2,	TAD SORTCN	/LEFT PARENS FOUND.
	PUSHA
	TAD LASTOP	/SAVE DATA
	PUSHA
	PUSHJ		/EVALUATE THE EXPRESSION
		EVAL-1
	JMP I EFUN3I
///
EFUN2,	TAD SORTCN	/SAVE 'SORTCN','LASTOP',AND FUNC CODE
	PUSHA
	TAD LASTOP
	PUSHA
	TAD FLOPR	/SAVE FUNCTION CODE.
	PUSHA
	TSTLPR
	ERROR4		/MUST BE FOLLOWED BY PARENS TO SET ARGUMENT
	PUSHJ	 	/YES
		EVAL-1
	POPA		/BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I.
	SORTJ
		FNTABL-1
		FNTABF-FNTABL
	ERROR2		/ILLEGAL FUNCTION NAME.
/////

	241	/!
	242	/"
	256	/. -FOR INPUT NUMBERS
TERMS=.		/TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR'
	240		/SPACE	0
	253		/+	1
	255		/-	2
	257		//	3
	252		/*	4
	336		/UP ARR	5
	250		/(	6 L-PARS
	333		/[	7
	274		/<	10
	251		/)	11 R-PARS
	335		/]	12
	276		/>	13
	254		/,	14
	273		/;	15
	215		/C.R.	16
	275	/= TO END GETARG FROM 'SET'
OPTABS,	FGT I PT1
	FAD I PT1
	FSB I PT1
	FDV I PT1
	FMY I PT1
	FPW I PT1
/////
FLARG,	0	/DATA TEMPORARY STORAGE
	0
	0
/////
/FOCAL TEXT FOR "HELLO" COMMAND
HPT,	7056	/[T %] 8.4;
	6473
	1740	/OPTION K,T,I,E,:,S;
	1354
	2454
	1154
	0554
	7254
	2373
	0540	/ERASE ALL
	0177
	1500
/////
/ABSOLUTE VALUE FUNCTION
XABS,	TAD FLAC1
	SPA CLA
	NEGATE
/CONTINUATION OF FUNCTION CALLS.

EFUN3,	POPA		/RESTORE LAST OPERATION
	DCA LASTOP
	FENT
	FNR		/NORMALIZE FUNCTION RETURN
	FPT FLARG
	FEXT
	TAD FLARGP	/SET POINTER
	DCA PT1
	POPA		/GET LAST PAREN CODE.
	CIA		/CHECK FOR PAREN MATCH.
	TAD M3
	TAD SORTCN	/(STILL SET FROM THE LAST "EVAL")
	SZA CLA		/SKIP IF MATCH	
	ERROR4		/PAREN ERROR
	GETC		/MOVE PAST R-PAR, AND RETURN TO OPNEX.
	JMP I .+1	/FUNCTION RETURN IS OK
		OPNEXT
////

LPRTST,	0		/SKIP IF LEFT PAREN. - 'TSTLPR'
	TAD SORTCN
	TAD M11
	SMA CLA
	JMP I LPRTST
	TAD SORTCN
	TAD M5
	SMA SZA CLA
	ISZ LPRTST
	JMP I LPRTST

/THE DELETE A LINE ROUTINE

DELETE,	FINDLN	/SETS "THISLN" AND "LASTLN".
	POPJ		/ALREADY GONE
	ISZ DEBGSW	/DISABLE TRACE
	GETC		/MEASURE LENGTH
	TAD CHAR
	TAD MCR
	SZA CLA
	JMP .-4
	TAD AXOUT	/SAVE LAST ADDRESS
	CMA
	TAD THISLN
	DCA CNTR	/LENGTH < 0
	TAD I THISLN	/DISCONNECT
	DCA I LASTLN
	TAD CFRS	/START LIST AT TOP
DOK,	DCA T2		/EXAMINATION ADDRESS
	TAD I T2	/GET THE NEXT ADDR.
	SNA		/TEST FOR END
	JMP DONE	/YES-WRAP UP ALL.
	DCA T1		/SAVE NEXT ADDRESS.
	TAD THISLN	/COMPARE LINE POSITIONS
	CIA CLL
	TAD T1
	SZL CLA		/SKIP IF THISLN > X
	TAD CNTR	/CHANGE (X) TO ACCOUNT FOR
	TAD T1		/GARBAGE COLLECTION.
	DCA I T2
	TAD T1		/GET NEXT
	JMP DOK
/////
/GARBAGE COLLECTION

DONE,	CMA		/BACKUP L FOR XR
	TAD THISLN
	DCA XRT
	TAD CNTR	/SETUP END OF HOSE
	CMA
	TAD THISLN
	DCA XRT2
	TAD CNTR	/CORRECT END OF BUFFER POINTER.
	TAD BUFR
	DCA BUFR
	TAD AXIN	/COMPUTE COUNT
	CMA
	TAD	XRT2
	DCA T1
	TAD AXIN
	TAD CNTR
	DCA AXIN
	TAD I XRT2	/SIPHON LOWER PART.
	DCA I XRT
	ISZ T1
	JMP .-3
	JMP DELETE	/RESET 'LASTLN','THISLN', AND DATA`FIELD.
/////
/OPTION TABLE
OPTTBL,	OPTK	/SWITCH TO KEYBOARD INPUT
	OPTR	/READER INPUT
	OPTT	/TTY OUTPUT
	OPTP	/PUNCH OUTPUT
	OPTI	/INTERPRETIVE/NUMERIC I/O
	OPTC	/SINGLE CHARACTER I/O
	OPTCOL	/PRINT ":" AT "ASK"
	OPTX	/SUPPRESS ":"
	OPTE	/ECHO KEYBOARD INPUT
	OPTN	/NO ECHO
	OPTS	/SET VARIABLE TERMINATOR
	OPTM	/START DISK MONITOR

FNTABL=.
	2533	/ABS
	2650	/SGN
	2636	/ITR
	2565	/DIS
	2630	/RAN
	2623	/DXS
	2517	/ADC
	2572	/ATN
	2624	/EXP
	2625	/LOG
	2654	/SIN	/LIST OF CODED FUNCTION NAMES
	2575	/COS
	2702	/SQT
	2631	/NEW
/ERASE SINGLE LINES, GROUPS, OR VARIABLES
ERASE,	TAD CHAR	/SEE IF "ALL"
	TAD MINUSA
	SZA CLA
	JMP ERVX
	TAD ENDT	/YES, ERASE ALL TEXT
	DCA BUFR
	DCA I CFRS
ERV,	TAD STARTV	/ERASE VARIABLES
	DCA LASTV
	JMP START	/PROGRAM EXECUTION ENDS
/////
ERVX,	GETLN		/GET LINE NUMBER
	TAD LINENO	/SEE OF ZERO OR NONE
	SZA CLA
	JMP ERL		/NO, ERASE LINES
	TAD STARTV	/YES, ERASE VARIABLES
	DCA LASTV
	JMP I .+1	/CONTINUE PROCESSING
	PROC
/////
ERL,	TAD BUFR	/ERASE LINES
	DCA AXIN
ERG,	PUSHJ		/EXTRACT ONE LINE
	 DELETE
	ISZ THISLN
	TAD NAGSW
	SMA CLA
	TAD I THISLN
	TSTGRP		/IF GROUP, SEE IF END OF GROUP
	JMP ERV		/YES
	TAD I THISLN	/NO, CONTINUE ERASING GROUP
	DCA LINENO
	JMP ERG
/ROUTINE CALLED VIA "FINDLN":

/SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ]
/1ST RETURN IF NOT FOUND,
/2AND IF FOUND.
/"THISLN" = FOUND LINE OR NEXT LARGER.
/"LASTLN" = LESSER AND/OR LAST.
/"TEXTP" IS SET

XFIND,	0
	TAD CFRS	/INITIALIZE POINTERS TO FIRST LINE
	DCA LASTLN
	TAD CFRS
FINDN,	DCA THISLN	/SAVE THIS ONE
	TAD THISLN
	DCA XRT2
	TAD LINENO
	CIA
	TAD I XRT2	/LINENO=0 WILL ALSO BE FOUND
	SNA
	ISZ XFIND	/FOUND IT (2ND EXIT)
	SMA CLA
	JMP FEND3	/PAST IT.
	TAD THISLN	/MOVE POINTERS
	DCA LASTLN
	TAD I THISLN
	SZA		/SKIP IF END OF TEST
	JMP FINDN
FEND3,	TAD THISLN
	IAC
	DCA AXOUT	/SET "TEXTP".
	DCA XCT
	JMP I XFIND

UTRA,	0		/UNPACK CHARACTER. - "GETC"
	JMS GET1
UTE,	SPA CLA		/NORM & EXTEND
	TAD C100	/300-337 & 340-376
	TAD M137	/240-276 & 200-236
	TAD CHAR
	SNA
	JMP UTX		/"?" FOUND
	TAD P337
UTQ,	DCA CHAR
	TAD DEBGSW
	TAD DMPSW
	SNA CLA		/PRINT ONLY IF BOTH ARE ZERO.
	PRINTC
	JMP I UTRA
//////
EXTR,	JMS GET1
	CMA
	JMP UTE
///
UTX,	TAD DEBGSW	/TEST FOR TRACE-ENABLED
	SZA CLA
	JMP .+6
	TAD DMPSW	/FLIP THE TRACE FLOP
	SNA CLA
	IAC
	DCA DMPSW
	JMP UTRA+1	/GET NEXT CHARACTER INSTEAD.
	TAD P277	/TRACE DISABLED = RETURN "?"
	JMP UTQ

GET1,	0		/UNPACK 6-BITS
	ISZ XCT		/STARTS=0
	JMP GET3
	TAD GTEM
GEND,	AND P77
	DCA CHAR	/SAVE
	TAD CHAR
	TAD M77
	SNA CLA
	JMP EXTR	/EXTENDED
	TAD CHAR
	TAD M40
	JMP I GET1
/////

GET3,	TAD I AXOUT	/(X-MEM)
	DCA GTEM
	CMA
	DCA XCT
	TAD GTEM
	RTL6
	RAL
	JMP GEND
M40,	-40
M137,	-137
/////
/OPTION LIST
OPTLST,	"K
	"R
	"T
	"P
	"I
	"C
	":
	"X
	"E
	"N
	"S
	"M
/////
/ANALOG-DIGITAL CONVERSION
XADC,	6004
	DCA FLAC1	/ARG MUST BE 0
	RETURN

XENDLN,	0	/TERMINATE THE BUFFERED LINE - "ENDLN"
	TAD I LASTLN	/SAVE OLD POINTER
	DCA I BUFR
	TAD BUFR	/POINT TO NEW LAST LINE
	DCA I LASTLN
	TAD ADD		/CHECK FOR EXTRA INFO
	SZA 
	DCA I AXIN
	TAD AXIN	/COMPUTE NEW`END OF BUFFER
	IAC
	DCA BUFR
	TAD STARTV	/RESET VARIABLE LIST
	DCA LASTV
	JMP I XENDLN
/////
TXTSAV,	0		/SAVE CHAR AND TEXT POINTERS
	PUSHF
		TEXTP
	TAD CHAR
	PUSHA
	JMP I TXTSAV
/
TXTRES,	0		/RESTORE SAME
	POPA
	DCA CHAR
	POPF
		TEXTP
	JMP I TXTRES
/////
GRPTST,	0		/AC VS LINENO - "TSTGRP"
	AND P7600
	CIA
	DCA T2
	TAD LINENO
	AND P7600
	TAD T2
	SNA CLA
	ISZ GRPTST
	JMP I GRPTST
/I-O SUBROUTINES

VAL=.
CHIN,	0		/READ IN A CHARACTER SUBR. - "READC"
	JMS I INDEV
	DCA CHAR
	SORTC		/LINEFEED OR RUBOUT?
		ECHOLST-1
	JMP I CHIN	/YES
ECHO,	PRINTC
	TAD CHAR	/SEE IF 200 (L/T)
	TAD P7600
	SZA CLA
	JMP I CHIN	/NO, EXIT
	JMP CHIN+1	/YES, GET ANOTHER
/////
OUT,	0		/OUTPUT A CHARACTER - "PRINTC"
	SNA		/USE (AC) OR (CHAR)
	TAD CHAR
	TAD MCR
	SNA
	JMP OUTCR
	TAD CCR
	JMS I OUTDEV
OUTX,	JMP I OUT
/////
OUTCR,	TAD CCR
	JMS I OUTDEV
	TAD CLF
	JMP OUTX-1
/////
/TEST FOR A COMMA, SEMICOLON, OR CR - "TSTERM"
/RETURNS: OTHER, ; OR CR, COMMA
/GETS NEXT CHARACTER AFTER COMMA OR OTHER
XTSTER,	0
	SORTC		/LOOK FOR ,;CR
	 TLIST-1
	SKP
	JMP .+6		/OTHER, GO PAST IT
	TAD SORTCN	/FOUND ONE, SEE WHAT IT IS
	ISZ XTSTER
	SZA CLA
	JMP I XTSTER	/; OR CR: 2ND EXIT
	ISZ XTSTER	/COMMA, 3RD EXIT
	GETC
	JMP I XTSTER
/////

COMEIN=.-1	/COMMAND-INPUT BUFFER LIVES HERE.

COMOUT=2600
*COMOUT

/INTERRUPT PROCESSOR.

SAVAC,	0	/CONTENTS OF AC
SAVLK,	0	/CONTENTS OF LINK
MBREAK,	-203	/CONTROL-C
INTRPT,	DCA SAVAC	/SAVE WORKING DATA
	RAR
	DCA SAVLK
	KSF		/CHECK FOR KEYBOARD FIRST
	JMP TINT
	KRB		/READ BUFFER AND CLEAR FLAG TO FETCH NEXT
	AND P177	/IGNORE PARITY BIT
	TAD C200
	DCA SIN
	TAD SIN
	TAD MBREAK	/MANUAL STOP?
	SNA CLA
	JMP RECOVR
	TAD INBUF	/ANY SPACE?
	SZA CLA
	ERROR2		/WILL WAIT FOR OUTPUT BUFFER
	TAD SIN
	DCA INBUF	/SAVE INPUT
TINT,	TSF
	JMP EXIT
	TCF
	DCA TELSW	/TURN OFF THE IN-PROGRESS FLAG.
	TAD I OPTRI
	SNA
	JMP EXIT	/DONE
	TPC		/TYPE NEXT.
	DCA TELSW	/CLEAR AC AND TURN ON THE FLAG.
	DCA I OPTRI	/ZERO OUT THE DATA AREA
	TAD OPTRI
	IAC
	AND P17
	TAD OPTR0
	DCA OPTRI
EXIT,	6244		/RESTORE MEMORY FIELD
	6101		/SMP
	NOP		/(HLT)-IF YOU HAVE MEMORY PARITY
	RSF		/TEST H.S. READER FLAG
	JMP .+3
	RRB		/READ BUFFER AND CLEAR FLAG
	DCA HINBUF	/SAVE CHARACTER
	TAD SAVLK
	RAL CLL
	TAD SAVAC
	ION
EXITJ,	JMP I 0

TELSW,	1	/INPUT SWITCH
OPTR0,	IOBUF	/OUTPUT POINTERS
OPTRO,	IOBUF	/VARS
OPTRI,	IOBUF
INBUF,	0	/KEYBOARD BUFFER.
/////
XI33,	0		/VIA (INDEV)
	TAD INBUF	/ANY INPUT?
	SPA SNA
	JMP .-2		/NO = WAIT
	DCA XOUTL
	DCA INBUF	/CLEAR INPUT BUFFER
	TAD XOUTL
	JMP I XI33
/////
XOUTL,	0		/VIA (OUTDEV)
	DCA XI33	/SAVE CURRENT CHARACTER.
	TAD XI33	/IS IT A CR?
	TAD MCR
	SNA CLA
	DCA TABCTR	/YES, RESET CARRIAGE INDEX
	TAD XI33
	JMS I SKPNP	/SKIP IF A NON-PRINTING CHARACTER
	ISZ TABCTR	/PRINTING: INCREMENT INDEX
SIN,	0
	ION		/BE SURE INTERRUPT IS ON.
	TAD I OPTRO	/ANY ROOM?
	SZA CLA		/A CHARACTER IS NON-ZERO
	JMP .-2		/NO = WAIT.
	TAD TELSW	/IN PROGRESS?
	SZA CLA
	JMP .+5
	TAD XI33	/NO
	TLS		/TYPE CHARACTER.
	DCA TELSW	/SET IN-PROGRESS FLAG.
	JMP I XOUTL	/RETURN
	TAD XI33	/SEND DATA
	DCA I OPTRO
	TAD OPTRO	/SET POINTERS
	IAC
	AND P17
	TAD OPTR0
	DCA OPTRO
	JMP I XOUTL
///////
SKPNP,	SKIPNP
ERROR2=ERROR; ERROR3=ERROR; ERROR4=ERROR
WAITP,	OWAIT
OPTDOP,	OPTTDO
ERROR5,	DCA .+1		/ERROR CALLED FROM A TABLE
ERR2,	0		/LIMIT EXCEEDED
	CLA CMA		/COMPUTE CALLING ADDRESS (ALSO "SPACE")
	TAD ERR2	/AND USE IT AS ERROR NUMBER.
	DCA LINENO	/SAVE ERROR CODE.
	JMS I WAITP	/WAIT FOR OUTPUT TO FINISH
	IOF		/DISABLE INTERRUPT FOR INITIALIZATIONS
	JMP .+3
RECOVR,	TAD C200
	DCA LINENO	/SAVE ERROR NUMBER
	ISZ TELSW	/TURN ON IN-PROGRESS SWITCH
	TAD M20		/SETUP INIT COUNT
	DCA CNTR
	CMA
	TAD OPTR0
	DCA XRT		/INIT I/O BUFFERS.
	DCA I XRT
	ISZ CNTR
	JMP .-2
	DCA INBUF	/INIT KEY-BUFR.
	TAD OPTR0	/INIT TTY POINTERS.
	DCA OPTRI
	TAD OPTR0
	DCA OPTRO
	JMS I OPTDOP	/SET TO TTY OUTPUT
	TAD PTCH	/RESET "READC"
	DCA 113		/IF AN ERROR OCCURS.
	CMA		/PREPARE A STOP BIT FOR TTY
	TLS		/AND RAISE FLAG
	CLA
	TAD CCR		/PRINT A CR
	PRINTC
	TAD P277	/MAKE A ?
	PRINTC		/AND TURN ON THE INTERRUPT
	PRNTLN		/PRINT ERROR NUMBER AND,
	ISZ PC
	TAD I PC	/UNLESS IT IS ZERO, (X-MEM)
	SNA
	JMP .+6
	DCA LINENO
	TAD P7700
	PRINTC
	PRINTC		/PRINT SPACE AGAIN AND
	PRNTLN		/PRINT LINE OF ERROR.
	TAD CCR
	PRINTC
	JMP START	/INTERRUPT WILL BE RE-ENABLED SOON.
/////
/SKIP IF (AC) IS A NON-PRINTING CHARACTER
SKIPNP,	0
	RTL6		/PRINTING CHARACTERS ARE 240-337
	SPA CLA
	CML
	SNL
	ISZ SKIPNP
	JMP I SKIPNP
/////
/PACK A CHARACTER INTO THE BUFFER - "PACKC"
PACBUF,	0
	SORTJ		/LOOK FOR ? OR RUBOUT
	 PACLST-1
	 PACLS2-PACLST
	TAD CHAR
	JMS SKIPNP	/PRINTING CHARACTER?
	JMP .+3		/YES
	TAD P77		/NO, PACK 77 FIRST
	JMS PCK1
	TAD CHAR	/PACK 6-BIT CHARACTER
	AND P77
	JMS PCK1
	JMP I PACBUF
/////
PQUES,	TAD P337	/USE 337 FOR ?
	JMP .-4
/////
/PACK ONE 6-BIT WORD
PCK1,	0
	ISZ XCTIN
	JMP ROT		/PACK LEFT HALF
	TAD ADD		/PACK RIGHT HALF AND STORE
	DCA I AXIN
	TAD PDLXR	/CHECK FOR SPACE
	CLL CIA
	TAD P13
	TAD AXIN
	SZL CLA
	ERROR		/BUFFER OR STORAGE OVERFLOW
	JMP I PCK1
/////
PACLST,	277	/?
	377	/RUBOUT
/////
ROT,	RTL6	/SAVE LEFT HALF
	DCA ADD
	CMA
	DCA XCTIN
	JMP I PCK1
/RUBOUT ONE CHARACTER
RUB1,	TAD AXIN	/SAVE POINTER
	DCA PCK1
	TAD XCTIN	/CHARACTER IN ADD?
	SZA CLA
	JMP RUB2	/YES
	TAD AXIN	/NO, BEGINNING OF BUFFER?
	CIA
	TAD PACKST
	SMA CLA
	JMP PKZERO	/YES, IGNORE
RUB2,	TAD SPLAT	/ECHO A BACKSLASH
	PRINTC
	ISZ XCTIN
	JMP RUB3	/BACKUP STORAGE
	TAD I PCK1	/KILL ADD AND CHECK FOR 77
	AND P77		/IN 2ND HALF OF LAST STORED WORD
	TAD M77
	SZA CLA
	JMP PKZERO	/NO, DONE
RUB3,	TAD I PCK1	/KILL 2ND HALF OF LAST STORED WORD
	AND P7700
	DCA ADD
	CMA		/BACKUP POINTER
	TAD AXIN
	DCA AXIN
	TAD ADD		/TEST FOR 77 IN ADD
	TAD C100
	SZA CLA
	CMA
PKZERO,	DCA XCTIN
	JMP I PACBUF
SPLAT,	334
/DUMP THE SYMBOL TABLE CONTENTS
TDUMP,	PUSHF		/SAVE TEXT POINTERS
		TEXTP
	CMA
	TAD STARTV	/START VARIABLE LIST
TDLOOP,	DCA FLTXR
	TAD FLTXR	/TEST FOR END OF LIST
	CMA
	TAD LASTV
	SNA CLA
	JMP TDEND	/END FOUND
	TAD TDTEXT	/NO, SET UP POINTERS
	DCA AXOUT
	DCA XCT
	TAD I FLTXR	/2 LETTERS OF VAR. NAME
	DCA TDTEXT+1
	PUSHJ		/PRINT NAME AND "("
		TQUOT
	TAD I FLTXR	/GET AND PRINT SUBSCRIPT
	JMS I TDOUTP
	PUSHJ		/PRINT ")="
		TQUOT
	TAD P13		/SPACE TO 11TH COLUMN
	DCA FLAC2
	PUSHJ
		TAB+12
	ISZ FLTXR
	FENT		/PICK UP VALUE
	FGT I FLTXR	/(DOES NOT AUTOINDEX)
	FEXT
	JMS I FOUTPUT	/PRINT VALUE
	TAD CCR		/AND A C.R.
	PRINTC
	TAD FLTXR	/INCREMENT FOR NEXT VAR.
	TAD P2
	JMP TDLOOP
TDEND,	POPF		/RESTORE TEXT POINTERS
		TEXTP
	JMP I .+1
	TASK4
TDOUTP,	SIGOUT
TDTEXT,	.		/THE FOLLOWING IS FOCAL TEXT
	0	/VAR. NAME GOES HERE
	5077	/"(" AND C.R.
	1551	/")=" AND C.R.
	7577
	1500
/OPTION ROUTINES
/
/ROUTINE TO SET UP OUTPUT
OPTTDO,	0
	TAD CTSF
	DCA I OPTTL	/TSF
	TAD I OPTTL
	IAC
	DCA I OPTTL+1	/TCF
	TAD I OPTTL+1
	TAD P2
	DCA I OPTTL+2	/TPC
	TAD I OPTTL+2
	TAD P2
	DCA I OPTTL+3	/TLS
	JMP I OPTTDO
CTSF,	TSF
OPTTL,	TINT
	TINT+2
	TINT+7
	SIN+11
/////
/ROUTINE TO WAIT UNTIL OUTPUT FINISHES
OWAIT,	0
	ION		/(SWAP) - FOR 2-USER
	TAD I TSWP	/LOOK AT TELSW
	SZA CLA
	JMP .-3
	JMP I OWAIT
TSWP,	TELSW
/////
OPTP,	JMS OWAIT	/SET UP FOR PUNCH OUTPUT
	TAD M20		/CONVERT TO PSF, ETC.
	SKP
OPTT,	JMS OWAIT	/SET UP FOR TTY OUTPUT
	JMS OPTTDO
OPTXIT,	JMP I .+1	/EXIT OPTIONS
	OPTRET

OPTX,	TAD OPTC1	/SUPPRESS ":" ON ASK
OPTCOL,	TAD CPRINT	/RESTORE ":"
	DCA I COLP
	JMP OPTXIT
CPRINT,	PRINTC
OPTC1,	CLA-PRINTC
COLP,	TASKCL
/////
OPTE,	TAD CPRINT	/SET UP FOR KEYBOARD ECHO
OPTN,	DCA I ECHP	/SUPPRESS ECHO
	JMP OPTXIT
ECHP,	ECHO
/////
OPTS,	GETC		/SET UP USER TERMINATOR FOR "ASK"
	SORTC
		TERMS-3
	SKP
	JMP .-4
	PUSHJ		/GET CHARACTER
		EVAL
	FIX
	DCA I USERTP
	JMP OPTXIT
USERTP,	USERT
/////
OPTM,	JMS OWAIT	/EXIT TO DISK MONITOR
	IOF
	JMP I P7600
/////
/THIS IS THE INITIALIZATION COMMAND
HELLO,	TAD HP
	DCA AXOUT
	DCA XCT
	PUSHJ		/START BY SETTING FORMAT
		TINTR
/////
HP,	HPT-1	/FOCAL TEXT "%8.4;O K,T,I,E,:,S;E A"
/ I/O MODE OPTIONS
OPTC,	CLA CMA
OPTI,	DCA IOSW
	JMP OPTXIT
/////
IOSW,	0
/ I/O MODE:	"I" = 0000 = INTERPRETIVE INPUT, NUMERIC OUTPUT
/		"C" = 7777 = SINGLE CHARACTER I/O
/////
/"ASK" MASTER ROUTINE
INTASK,	0
	TAD PT1		/SAVE VAR. POINTER
	DCA OWAIT
	TAD IOSW	/WHAT MODE OF INPUT?
	SNA CLA
	JMP STRING	/INTERPRETIVE
	READC		/SINGLE CHARACTER
	TAD CHAR	/CONVERT CHARACTER CODE TO FLOATING
	FLOAT		/POINT NUMBER
ASKEND,	FENT		/SAVE VALUE
	FPT I OWAIT
	FEXT
	JMP I INTASK
/INTERPRETIVE BUFFERED INPUT
STRING,	TAD PDLXR	/SAVE PUSHDOWN LIST POINTER
	DCA OPTTDO
	TAD BUFTOP	/PROTECT TOP OF ASKBUF
	DCA PDLXR
	ISZ DEBGSW	/DISABLE TRACE
INBARR,	TAD BUFBOT	/INITIALIZE ASKBUF
	DCA AXIN
	DCA XCTIN
	TAD BUFBOT
	DCA PACKST
	READC		/IGNORE SPACES
	SORTC
		C240-1
	JMP .-3
	SORTJ		/SEARCH FOR TERMINATOR
		ASKLST-1
		ASKLS2-ASKLST
	PACKC		/PACK INTO BUFFER
INGT,	READC
	JMP .-5
/TERMINATOR FOUND, PROCESS INPUT
INTERM,	TAD CCR		/PACK A C.R.
	DCA CHAR
	PACKC
	PACKC
	TAD OPTTDO	/RESTORE PDLXR
	DCA PDLXR
	TAD BUFBOT	/INITIALIZE UNPACKING
	DCA AXOUT
	DCA XCT
	PUSHJ		/EVALUATE EXPRESSION
		EVAL-1
	JMP ASKEND
/////
BUFBOT,	ASKBUF		/BOTTOM OF BUFFER
BUFTOP,	ASKBND		/TOP+12 OF BUFFER
/////
/"TYPE" OUTPUT
OUTPT,	0
	TAD IOSW	/WHAT KIND OF OUTPUT
	SZA CLA
	JMP COUTPT	/SINGLE CHARACTER
	JMS I FOUTPUT	/NUMERIC OUTPUT, PRINT VALUE
	JMP I OUTPT
/////
COUTPT,	FIX		/GET CODE FOR CHARACTER
	SNA		/MODULO 256
	CLL CML RAR	/TO ALLOW ZERO CODE TO BE PRINTED
	JMS I OUTDEV
	JMP I OUTPT
/NOTE: "TDUMP" PRINTS ONLY IN NUMERIC MODE
IOBUF=3400
/
*IOBUF+20
FRST,	0	/TEXT POINTER
	0000	/DUMMY LINE NO
	0355	/ C-
	0617	/ FO
	0301	/ CA
	1454	/ L,
	4040
	6557	/ 5/
FRSTX,	6671	/ 69
	7715
BUFBEG=.
/////
LIBRARY=ERROR5	/COMMAND NOT AVAILABLE
/FOCAL INITIALIZATION ROUTINE
*BUFBEG
BEGIN,	CLA CLL
	TAD (RECOVR+1	/RESTORE RESTART
	DCA START-1
	IOF		/CLEAR FLAGS TO PREVENT INTERRUPT
	6022		/PCF
	6032		/KCC
	6203		/CDF CIF 00
	6402		/CLEAR PT08'S
	6412
	6422
	6432
	6442
	6452
	6462
	6472
	6764		/CLEAR DECTAPE
	6772
	CLA
	TLS		/START LOW SPEED OUTPUT
	DCA I FLTXR	/CLEAR OUTPUT BUFFER
	ISZ (-20
	JMP .-2
	TAD BOTTOM	/INITIALIZE PUSHDOWN LIST
	DCA PDLXR
	ION
	PRINTC		/CHAR IS A C.R
	PRINTC
	PRINTC
	PUSHJ		/TYPE FOCAL HEADING
		WRITE
	JMP I .+1
		ERV-3	/ERASE ALL
