/	FOCAL.ZZM





/				F  O  C  A  L












/		T H E	 F O R M U L A	  C A L C U L A T O R






/	FOR FORMULATING ON-LINE CALCULATIONS IN ALGEBRAIC LANGUAGE

/	ON THE FOLLOWING D.E.C. COMPUTERS:

/	5, 8, 8/I, 8/S, 8/L, LINC-8, LAB-8, TSS-8, PDP-12







/	SOURCE RECREATION, TIDYING UP BY:

/	CHARLES J. LASNER P?S NY

/	LAST EDIT:	08-APR-1987	23:00:00	CJL











/	  F O C A L     AND     F L O A T





/	COPYRIGHT@ 1969 BY

/	DIGITAL EQUIPMENT CORPORATION

/	FOCAL IS A REGISTERED
/	TRADEMARK OF
/	DIGITAL EQUIPMENT CORPORATION

/	ALL RIGHTS RESERVED

/	3RD REVISION
	FIXMRI	AND=	0000	/ACTUAL MEMORY REFERENCE INSTRUCTIONS
	FIXMRI	TAD=	1000
	FIXMRI	ISZ=	2000
	FIXMRI	DCA=	3000
	FIXMRI	JMS=	4000
	FIXMRI	JMP=	5000
	FIXMRI	FPOW=	5000	/PSEUDO-FLOATING POINT INSTRUCTIONS.
	FIXMRI	FADD=	1000
	FIXMRI	FSUB=	2000
	FIXMRI	FMUL=	4000
	FIXMRI	FDIV=	3000
	FIXMRI	FGET=	0000
	FIXMRI	FPUT=	6000

	FNOR=	7000
	FEXT=	0000
	FXIT=	0000
	FINT=	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
	HLT=	7402
	CIA=	7041
	ION=	6001
	IOF=	6002
	KSF=	6031
	KRB=	6036
	TSF=	6041
	TCF=	6042
	TPC=	6044
	TLS=	6046
	PLS=	6026
	RSF=	6011
	RRB=	6012
	RFC=	6014
	SMP=	6101
	RMF=	6244
/	* FOCAL * - BY RICK MERRILL - FOR THE FAMILY OF 8.

/	MISCELLANEOUS ITEMS

	*1

	JMP I	.+2		/INTERRUPT PROCESSOR ENTRY.
	JMP I	.+1		/(USED BY PDP-5)
	INTRPT

DDTJR,	DDTJR			/USED FOR DEBUGGING
P13,	13			/CONSTANT
C100,	100			/CONSTANT

	T=	00		/TEXT FIELD NO.
	P=	00		/PROGRAM FIELD NO.
	CDF=	7000		/(X-MEM) - OPR

	FPNT			/ADDRESS OF FLOATING POINT INTERPRETER (LOC *7)

/	AUTO-INDEX REGISTERS - (START OF SAVE BY QUAD)

AXIN,	0 			/STORAGE INDEX (LOC *10)
XRT,	0			/EXTRA XR
XRT2,	0			/EXTRA XR
PDLXR,	BEGIN-1			/PUSHDOWN LIST INDEX REGISTER.
FLTXR,	IOBUF-1			/XR FOR FLOATING POINT
FLTXR2,	0			/EXTRA FOR F.P.
TELSW,	HLT			/TELETYPE IN PROGRESS SWITCH

	TEXTP=.			/TEXT POINTERS (LOC *17)

AXOUT,	FRSTX			/OUTPUT INDEX
XCT,	0			/UNPACK SWITCH
GTEM,	0			/UNPACK STORAGE
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.
PACKST,	0			/RUBOUT PROTECTION
PT1,	0			/VARIABLE POINTER
LASTV,	BUFBEG			/ADDRESS OF LAST VARIABLE
T1,	0			/TEMPORARY REGISTER - MAIN
T3,	0			/TEMP REGISTER FOR OUTPUT
INBUF,	0			/KEYBOARD INPUT BUFFER
BOTTOM,	BEGIN-1			/LAST LOCATION CURRENTLY AVAILABLE IN FIELD ZERO **
INSUB,	0			/0= GETC; #0 = READC
HINBUF,	0			/HIGH SPEED INPUT BUFFER

/	*40 = FLOATING POINT
	*54

/	VARIABLES   -   INITIALIZED FOR THE DIALOGUE

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)

	STARTV=	.		/=END FOR 8K

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

ADD,	OUTL			/CHAR. BUF. IN.	 (DEBUG AIDS. SEE BELOW.)
XCTIN,	I33			/PACK SWITCH
OUTDEV,	XOUTL			/POINTER TO OUT. SUB.	(OUTL)-FOR DEBUGGING
INDEV,	XI33			/POINTER TO IN. SUB.	(I33)-FOR DEBUGGING

NAGSW,	0001			/NOT ALL AND/OR GROUP SWITCH (4000=ONE; 1=ALL;
				/0=GROUP); (0000)-FOR TSS-8
CHAR,	"M&237			/THE MOST IMPORTANT REGISTER
LINENO,	0000			/LINE NUMBER READ BY GETLN; (0400)-FOR TSS-8
GINC,	WORDS+2			/=6 FOR 4-WORD - CONSTANT

T2,	0			/TEMP REGISTER - FOR NEW INST. ROUTINES.



/	FOR DEBUGGING, SET OUTL AND I33 INTO OUTDEV AND INDEV;
/	ALSO PATCH THE ERROR ROUTINE = FOUR
/	PATCHES PLUS TWO FOR THE HIGH SPEED READER.


	LIST6=	.		/INPUT LIST FOR "SFOUND".

	"L&237			/F.F.
	"G&237			/BELL

	LIST7=	.

	"C&237			/CONTROL-C FOR DEBUGGING AND TSS8
P337,	"^+1			/LEFT ARR
CLF,	"J&237			/L.F.

	LIST3=	.		/EXCRETION LIST

CCR,	"M&237			/LIST BRANCHER.
DMPSW,	HLT			/(SEARCH CHARACTER)-VARIABLE; =0000 FOR TRACE ON.


/	THE REST OF PAGE ZERO IS PURE TO THE MULTI-USER SYSTEM
	M100=	.

P7700,	7700			/LEFT MASK
PER,	".			/PERIOD
M77,	-77			/EXTEND CODE TEST
P7600,	7600			/GROUP MASK
M20,	-20			/CONSTANT
P177,	177			/STEP MASK
P17,	17			/BCD MASK
P277,	"?			/"?"
M2,	-2			/CONSTANT
MINUSA,	-"A			/CONSTANT
C260,	"0			/ASCII FOR ZERO
M240,	-" 			/SPACE TEST
MPER,	-".			/PERIOD TEST
MCR,	-"M!100			/C.R. TEST
MFLT,	-WORDS			/= -4 FOR 4-WORD
M5,	-5			/PAREN TEST
M11,	-11			/PAREN TEST
P77,	77			/RIGHT MASK
C200,	200			/CONSTANTS
P4000,	4000			/NAGSW TEST CONSTANT (FOR PDP-5)

FLARGP,	FLARG			/DATA ADDRESS
PTCH,	CHIN			/GENERAL CHARACTER INPUT ROUTINE.
DOUBLE,	MULT2			/MULTIPLY FLAC BY 2
FOUTPUT,FLOUTP			/FLOATING OUTPUT
FINPUT,	FLINTP			/FLOATING INPUT
COMBUF,	COMEIN			/COMMAND BUFFER START
CFRS,	FRST			/ADDRESS OF DUMMY LINE.
END,	COMEIN 			/FIRST LOCATION USED IN 8K.
ENDT,	BUFBEG			/START OF STORAGE AREA **
EFUN3I,	EFUN3			/FUNCTION RETURN
CFRSX,	FLTZER			/POINTER TO ZERO DATA


/	'FINPUT' USES CHAR AND GETC OR READC TO DEVELOP 
/	A NUMBER WHICH IS THEN STORED VIA PT1.

	WORDS=	3		/OR 4
/	NEW INSTRUCTIONS:

	PUSHJ=	JMS I	.;XPUSHJ/RECURSIVE SUBROUTINE CALL
	POPA=	TAD I	PDLXR	/RESTORE AC

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

	ERROR3=	JMS I	.;	/MISCELLANEOUS ERROR

	ERROR4=	JMS I	.;ERR2	/FORMAT ERROR
/	USED BY 8K
/	FOCAL'S COMMAND/INPUT DRIVER

	*176

	BEGIN			/BECOMES (RECOVR+1) **

START,	SKP CLA			/PROGRAM START FROM SELF
	JMP I	.-2		/CONSOLE START: SW=200
	TAD	CFRSX		/(PC) => 0
	DCA	PC		/FOR COMMAND MODE
	IAC			/USE ONE IN THE AC TO
	DCA	DMPSW		/INIT UNPACK AND TRACE SWITCH
	DCA	DEBGSW		/ENABLE TRACE FOR INPUT OF (?)
	TAD	COMBOT		/PROTECT COMMAND BUFFER
	DCA	PDLXR		/NO PATCH TEST
	TAD	CSTAR		/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
	LIST7-1
	INLIST-LIST7
	PACKC			/SAVE STRING CHARACTER.
	JMP	IGNOR

CSTAR,	"*			/ACKNOWLEDGE CHARACTER
COMBOT,	COMEOUT+12		/END OF COMMAND BUFFER, LESS PROTECTION COUNT.
/	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?
	JMP	GZERR		/PERIOD =ILLEGAL GROUP ZERO USAGE
	JMP	INPUTX		/NO
	ISZ	DEBGSW		/YES, DISABLE TRACE FOR REPACKING
	GETLN			/READ THIS LINE NUMBER
	TAD	P4000		/TEST FOR SINGLE LINE.
	TAD	NAGSW
	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.
SRETN,	PACKC			/SAVE TEXT AND RESTORE DATA FIELD
	TAD	CHAR		/TEST FOR END OF INPUT STRING
	TAD	MCR
	SZA CLA
	JMP	.-5
	DELETE			/REMOVE OLD LINE, IF ANY.
	ENDLN			/INSERT NEW LINE
	JMP	START		/POINTERS MUST BE REINITIALIZED

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.
/	LINE NUMBER FORMATION

XGETLN,	0			/DEVELOP I.D. - "GETLN"
	SPNOR			/IGNORE LEADING SPACES.
	TAD	CHAR		/"ALL" IS A SPECIAL ARGUMENT.
	TAD	MINUSA
	SNA CLA
	JMP	TESTA
	DCA	INSUB		/CALL 'GETC' FROM 'INPUT' VIA 'DECON'
	JMS I	LCON		/(DECONV - IN FLOAT.)
	TAD	FLAC+3		/GROUP TOO LARGE?
	AND	P7740
	TAD	FLAC+2
	SZA CLA
	ERROR2			/GROUP NUMBER TOO LARGE
	TAD	FLAC+3
	RTL6
	RAL
TESTA,	DCA	LINENO
	TESTN			/TEST3
	GETC			/READ STEP NUMBER.
	TESTN			/TEST4, OTHER
	JMP	GERR		/DOUBLE PERIODS
	JMP	GEXIT		/OTHER
	TAD	SORTCN		/NUMBER
	CLL RTL
	TAD	SORTCN
	RAL
	TAD	LINENO
	DCA	LINENO
	GETC			/READ SECOND STEP NUMBER.
	TESTN			/TEST4, OTHER
GERR,	ERROR4			/DOUBLE PERIODS
	JMP	GEXIT		/OTHER
	TAD	SORTCN		/NUMBER
	TAD	LINENO
	DCA	LINENO
	GETC			/TEST FOR CORRECT TERMINATOR
	TESTN			/CHECK SIZE
	JMP	GERR		/.
	SKP
	ERROR2			/TOO LARGE A LINE NUMBER.
GEXIT,	CLL			/CLEAR LINK BIT
	TAD	LINENO		/TEST FOR GROUP NUMBER.
	AND	P7600
	SZA CLA
	CML
	TAD	LINENO
	AND	P177		/REPARE "NAGSW"
	SNL SZA
GZERR,	ERROR2			/0.X = ERROR: ILLEGAL LINE NUMBER.
	SZA CLA
	TAD	P2000
	CML 
	RAL
	DCA	NAGSW
	JMP I	XGETLN

LCON,	DECONV
P7740,	7740
P2000,	2000

/	RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 31.99
/	NAGSW:

/	GROUP=0000
/	LINE=4000
/	ALL=0001

/	LIST OF FUNCTION ADDRESSES. (NAMES ARE IN "FNTABL")

	FNTABF=	.

	XABS			/ABS	-ABSOLUTE VALUE
	XSGN			/SGN	-SIGN PART
	XINT			/ITR	-INTEGER PART
	XDYS			/DIS	-DISPLAY AND INTENSIFY
	XRAN			/RAN	-RANDOM NUMBER
	XADC			/ADC	-READ ANALOG TO DIGITAL CONVERTER
	ARTN			/ATN	-
	FEXP			/EXP	-EXPONENTIAL FUNCTIONS
	FLOG			/LOG	-
	FSIN			/SIN	-TRIG FUNCTIONS
	FCOS			/COS	-
	XSQRT			/SQT	-SQUARE ROOT
	ERROR5			/NEW	-USER DEFINED FUNCTIONS
	ERROR5			/COM	-
	ERROR5			/X	-

XRTL6,	0			/ROTATE AC LEFT SIX - "RTL6"
	CLL RTL
	RTL
	RTL
	JMP I	XRTL6
/	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
	NOP
	TAD	THISLN		/TEST FOR GOOD GROUP NUMBER.
	DCA	XRT
	TAD I	XRT		/(X-MEM)
	TSTGRP
	ERROR2			/NO SUCH GROUP NUMBER
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
	JMP I	.+1;	PROC	/CONTINUE PROCESSING THIS LINE.
/	PUSHDOWN LIST CONTROLS

XPUSHA,	0			/PUSHDOWN THE AC - "PUSHA"
	DCA	T2		/BACKUP POINTER
	CMA			/AND THEN
	JMS	PCHK		/CHECK CORE USAGE
	TAD	T2		/OK
	DCA I	PDLXR		/PUSH DOWN LIST POINTER
	CMA			/BACKUP AGAIN
	JMS	PCHK
	JMP I	XPUSHA

PCHK,	0
	TAD	PDLXR		/INC IN AC
	DCA	PDLXR
	TAD	PDLXR
	CLL CIA
	TAD	LASTV
	SZL CLA 
	ERROR3			/STORAGE FILLED BY PUSH-DOWN LIST
	JMP I	PCHK

XPUSHJ,	0			/RECURSIVE SUBROUTINE CALL - "PUSHJ"
	TAD I	XPUSHJ
	DCA	T2		/SAVE SUBR. ADDR.
	CMA
	JMS	PCHK
	TAD	XPUSHJ
	IAC
	DCA I	PDLXR		/SAVE RETURN
	CMA
	JMS	PCHK
	JMP I	T2		/TRANSFER CONTROL

PD2,	0			/SAVE A FLOATING POINT NUMBER - "PUSHF"
	CLA CMA			/COMPUTE VARIABLE ADDR
	TAD I	.-2
	DCA	XRT
	ISZ	PD2		/FIX RETURN
	TAD	MFLT		/COMPUTE PUSH. POINTER
	JMS	PCHK
	TAD	MFLT
	DCA	T2
	TAD I	XRT
	DCA I	PDLXR
	ISZ	T2
	JMP	.-3
	TAD	MFLT		/RESET POINTER
	JMS	PCHK
	JMP I	PD2
PD3,	0			/RESTORE A FLOATING POINT NUMBER - "POPF"
	CLA CMA			/GET VAR. ADDR.
	TAD I	PD3
	ISZ	PD3
	DCA	XRT
	TAD	MFLT
	DCA	T2
	TAD I	PDLXR		/MOVE
	DCA I	XRT
	ISZ	T2
	JMP	.-3
	JMP I	PD3		/EXIT

	INLIST=	.		/INPUT CONTROL CHARACTERS

	RECOVR			/C.C. = BREAK
	IBAR			/B.A. = RESTART
	IGNOR			/L.F. = IGNORE
	IRETN			/C.R. = TERMINATE STRING

FLIST2,	FLIMIT			/,=STANDARD
	FINFIN			/;=SHORT
	ERROR5			/CR=DUMB

FLIST1,	FINCR			/,=STANDARD FORMAT
	PROCESS			/;=SET; PLUS ,..
	PC1			/C.R.=SET COMMAND.

MF,	-"F			/USED BY TESTC
/	PRIMARY CONTROL AND TRANSFER

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

	COMMENT=PC1		/ALSO IS CONTINUE

/	OUTPUT COMMAND TEXT

WRITE,	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	WX-2		/EXIT; DO NEXT INDIRECT LINE.
	IAC
	DCA	PT1		/SAVE POINTER TO LINENO OF NEXT
	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+2

WTESTG,	TAD	THISLN		/INIT GROUP PRINTOUT
	JMP	WTEST2

	DCA	DEBGSW
	POPJ

WX,	TAD	NAGSW
	SPA SNA CLA		/SKIP IF ALL
	JMP	WX-2
	PRINTC			/PRINT C.R. AGAIN
	JMP	WALL
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
	TAD	CHAR		/NO
	ISZ	XTESTC
	TAD	MF
	SNA CLA			/TEST FOR "F"
	JMP	XT3
	TESTN
	JMP I	XTESTC		/.
	SKP			/OTHER
	JMP I	XTESTC		/NUMBER
	ISZ	XTESTC
XT3,	ISZ	XTESTC		/RETURNS:T; N; F; A
	JMP I	XTESTC

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
GRPTST,	0			/AC VS LINENO - "TSTGRP"
	AND	P7600
	CIA
	DCA	T2
	TAD	LINENO
	AND	P7600
	TAD	T2
	SNA CLA
	ISZ	GRPTST
	JMP I	GRPTST

/	INPUT FROM TEXT OR KEYBOARD;
/	IF BACK-ARROW, RESTART INPUT

INPUT,	0			/INPUT A CHARACTER
	TAD	INSUB		/NON-ZERO FOR KEYBOARD
	SZA CLA
	JMP	.+3
	GETC
	JMP I	INPUT
	READC
	SORTJ
	SPECIAL-1
	INFIX-SPECIAL
	JMP I	INPUT

ILIST,	IF1			/,
	PROCESS			/;
	PC1			/CR

/				 ENGLISH-FRENCH
	COMLST=	.		/COMMAND DECODING LIST

	"S			/SET 	- ORGANIZE
	"F			/FOR 	- QUAND
	"I			/IF 	- SI
	"D			/DO 	- FAIZ
	"G			/GOTO 	- VA
	"C			/COMMENT- COMMENTE
	"A			/ASK 	- DEMANDE
	"T			/TYPE 	- TAPE
	"L			/LIBRARY- ENTREPOSE
	"E			/ERASE 	- BIFFE
	"W			/WRITE 	- INSCRIS
	"M			/MODIFY	- MODIFIE
	"Q			/QUIT 	- ARRETE
	"R			/RETURN	- RETOURNE
	"*-40			/(ASTERISK)=EXPANDABLE COMMAND

/	THIS COMMAND LIST IS SPEED OPTIMIZED.
/	CONDITIONAL TRANSFER PROCESS.

IF,	TESTC			/IGNORE SPACES AND TEST
	JMS I	IECALL		/T
	ISZ	PDLXR		/N-DUMP THE (EFOP)
	JMS I	IPART		/F-CHECK FOR PAREN MATCH
	TAD	M2		/A
	DCA	T1
	TAD	FLAC+1		/TEST -, 0, +
	SPA
	ISZ	T1		/N-TO 	-1, -2, -3
	SPA SNA CLA
IF3,	ISZ	T1		/COUNT COMMAS
	SKP
	JMP I	COMGO+4		/TRANSFER
	SORTJ			/SEARCH TEXT UNTIL ,;C.R.
	TLIST-1
	ILIST-TLIST
	GETC
	JMP	.-4
IF1,	GETC			/MOVE PAST COMMA 
	JMP	IF3

IECALL,	ECALL
IPART,	PARTEST
/	LOOP CONTROL STATEMENT

	SET=	.		/SUBSET OF "FOR".

FOR,	PUSHJ			/LOOPS, ETC.
	GETARG			/LOOK FOR "=" NEXT
	SPNOR			/IGNORE SPACES
	TAD	CHAR
	TAD	MEQ
	SZA
	ERROR4			/LEFT OF "=" IN ERROR: 'FOR' OR 'SET'
	TAD	PT1
	PUSHA			/SAVE POINTER TO VARIABLE
	PUSHJ
	EVAL-1			/GET INITIAL VALUE EXPRESSION
	POPA
	DCA	PT1
	FINT			/INITIALIZE NOW.
	FPUT I	PT1
	FXIT
	SORTJ			/TEST LAST CHAR FROM "EVAL"
	TLIST-1
	FLIST1-TLIST
	ERROR4			/EXCESS R-PAR

FINCR,	TAD	PT1		/SAVE VARIABLE ADDRESS *
	PUSHA
	PUSHJ			/EVALUATE THE INCREMENT,IF ANY.
	EVAL-1
	SORTJ			/TEST TERMINATORS
	TLIST-1
	FLIST2-TLIST
	ERROR4			/ILLEGAL TERMINATOR IN 'FOR'

FLIMIT,	PUSHF			/SAVE THE INCREMENT.	*
	FLARG
	PUSHJ			/GET THE LIMIT (NO ERROR DETECTION AFTER LIMIT)
	EVAL-1
FCONT,	PUSHF			/SAVE THE LIMIT *
	FLARG
	PUSHF			/SAVE TEXT OF OBJECT STATEMENTS
	TEXTP
	PUSHJ			/DO THE OBJECT STATEMENTS
	PROCESS
	POPF			/RESTORE REMAINING TEXT.
	TEXTP
	POPF			/GET LIMIT
	FLARG
	POPF			/GET INCREMENT
	ITER1
	POPA			/GET VARIABLE ADDRESS
	DCA	PT1
	FINT			/INCREMENT AND TEST
	FGET I	PT1		/LOAD THE VARIABLE
	FADD I	FINKP		/INCREMENT IT
	FPUT I	PT1		/CHANGE IT
	FSUB I	FLARGP		/TEST IT
	FXIT
	TAD	FLAC+1
	SMA SZA CLA
	POPJ			/END OF LOOP
	TAD	PT1
	PUSHA			/SAVE ADDRESS *
	PUSHF			/SAVE INCREMENT AGAIN *
FINKP,	ITER1
	JMP	FCONT

MEQ,	-"=
MCOM,	-",

FINFIN,	PUSHF			/SET INCREMENT TO ONE.
	FLTONE
	JMP	FCONT

/	SET AND INTENSIFY THE POINT: FDIS(X,Y)

XDYS,	JMS I	INTEGER		/RETURN=INTEGER VALUE OF Y.
	PUSHA
	TAD	CHAR
	TAD	MCOM
	SZA CLA
	ERROR3			/ARG MISSING
	PUSHJ
	EVAL-1
	JMS I	INTEGER
	6063			/DYL
	CLA
	POPA
	6057			/DXL DIX
	SKP

/	TAKE THE INTEGER PART

XINT,	JMS I	INTEGER		/(FIX)
	CLA
	JMP I	EFUN3I
	COMGO=	.		/COMMAND ROUTINE ADDRESSES

	SET
	FOR
	IF
	DO
	GOTO			/(REFERENCED)
	COMMENT
	ASK
	TYPE
	LIBRARY
	ERASE
	WRITE
	MODIFY
	START			/RETURN TO COMMAND MODE VIA 'QUIT'
	RETRN
	HSPX			/ACTIVATE THE HIGH SPEED READER





/	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
	TAD	CHAR		/SAVE IN-LINE CHARACTER.
	PUSHA
	TAD	COL		/TYPE COLON
	PRINTC			/(CLA)- TO SUPRESS ":"
	ISZ	INSUB		/INDICATE 'READC'
	IAC			/POINT PAST CHAR
	JMS I	FINPUT		/READ DATA AND SAVE
	POPA			/RE-TEST LAST TERMINATOR
	DCA	CHAR
	JMP	ASK		/CONTINUE PROCESSING

TYPE2,	PUSHJ			/DO TYPE
	EVAL
	JMS I	FOUTPUT		/PRINT
	JMP	TYPE
TQUOT,	ISZ	DEBGSW		/DISABLE TRACE
	GETC			/TYPE LITERALS
	SORTJ
	TLIST2-1
	TLIST3-TLIST2
	PRINTC
	JMP	TQUOT+1

TINTR,	GETC			/PASS PERCENT SIGN
	GETLN			/READ FORMAT CONTROL: "%7.03"
	TAD	LINENO
	DCA	FISW		/SAVE FORMAT CODE
	JMP	TASK

TCRLF2,	TAD	CCR		/SPLAT=CR ALONE
	JMS I	OUTDEV
	CMA			/NON-PRINTING DELAY FOR CR
TCRLF,	TAD	CCR		/EXCLAMATION POINT=CR, LF.
	PRINTC
TASK4,	GETC			/MOVE TO NEXT CHARACTER
	JMP	TASK

COL,	":			/":"



/	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.
/	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.
	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			/PLAYBACK THE TEXT
	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	T2
	TAD I	T2
	DCA	T2		/DEBUG : AC = ADDRESS
	JMP I	T2

SEX,	ISZ	SORTB		/MATCH NOT FOUND.
	CLA CLL
	JMP I	SORTB



/	ANALOGUE TO DIGITAL CONVERSION FOR AX08

XADC,	JMS I	INTEGER
	NOP			/(IOF)-FOR OTHER BRANDS
	6375			/ACMX ADCV
	6332			/SKAD
	JMP	.-1
	6362			/RADC
	DCA	FLAC+2
	ION
	JMP I	EFUN3I
OUTL,	0			/SLOW OUTPUT FOR ODT SYNCRONIZATION
	TLS			/AND FOR H.S. PUNCH
	PLS
	TSF			/IOT FOR SLOWEST DEVICE
	JMP	.-1
	CLA
	JMP I	OUTL




	SRNLST=	.		/'MODIFY' CONTROL CHARACTER TABLE

	SCHAR			/F.F. = CONTINUE
	SCONT			/BELL = CHANGE SEARCH CHARACTER
	RECOVR			/C.C. = BREAK
	SBAR			/B.A. = RESTART
	SCONT+1			/L.F. = FINISH THE LINE AS BEFORE.

	LISTGO=	.

	SRETN			/C.R. = END THE LINE HERE AS IS.
	SGOT			/CHAR = SEARCH CHARACTER





	ALIST=	.		/ASK/TYPE LIST OF CONTROLS.

	"%			/%
	""			/"
	"!			/!
	"#			/#
	"$			/$

	GLIST=	.

	" 			/SPACE
	TLIST=	.

	",			/,
	";			/;
	"M&237			/C.R.

/	THIS LIST IS ENDED BY 'TESTC'.
/	FIND OR ENTER A VARIABLE IN THE LIST.

GETARG,	TESTC			/FIRST LETTER OF ARG
TLIST2,	""			/"
	"M&237			/C.R. - FUNCTION OR NUMBER IS NOT AN ARG.
	ERROR4			/BAD ARGUMENT IN 'FOR', 'SET', OR 'ASK'
GETVAR,	DCA	XCTIN		/PACK INTO ADD.
	PACKC
	GETC			/SECOND LETTER
	SORTC			/TERMINATOR?
	TERMS-1
	JMP	GSERCH		/YES
	TAD	CHAR		/NO
	AND	P77		/SAVE 2AND LETTER OF NAME
	TAD	ADD
	DCA	ADD
	GETC			/IGNORE THE REST
	SORTC
	TERMS-1
	JMP	GSERCH
	JMP	.-4

GSERCH,	TSTLPR			/LOOK FOR SUBSCRIPT VIA SORTCN
	JMP	GS1		/NOT SUBSCRIPTED BY L-PAR.
	TAD	ADD		/SAVE NAME
	DCA	EFOP		/FOR RECURSIVE AND ERROR CHECK
	JMS I	GECALL		/TO EVAL
	POPA
	DCA	ADD		/RESTORE NAME
	JMS I	PTEST		/TEST PAREN MATCH, ETC.
	JMS I	INTEGER		/CONVERT TO 12-BIT NUMBER.
GS1,	DCA	SUBS		/SAVE SUBSCRIPT
	TAD	STARTV		/SEARCH FOR VARIABLE(CHANGE FOR X-MEM)
GS3,	DCA	PT1
	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

PTEST,	PARTEST
GECALL,	ECALL
GS2,	TAD	LASTV		/ADD THE VARIABLE
	TAD	P13		/TEST STORAGE LIMITS
	CLL CIA
	TAD	PDLXR
	SNL CLA
	ERROR3
	TAD	LASTV		/UPDATE THE LIST.
	TAD	GINC
	DCA	LASTV
	TAD	ADD		/SAVE NAME
	DCA I	PT1
	ISZ	PT1		/SAVE SUBSCRIPT
	TAD	SUBS
	DCA I	PT1
	ISZ	PT1		/SET PT1
	FINT
	FGET I	CFRSX
	FPUT I	PT1
	FXIT
	POPJ			/EXIT

GFND1,	TAD	PT1		/FOUND SAME
	DCA	XRT		/TEST SUBSCRIPTS
	TAD I	XRT
	CIA
	TAD	SUBS
	SZA CLA
	JMP	GS4		/WRONG SUBSCRIPT
	ISZ	PT1		/SET POINTER TO DATA
	ISZ	PT1
	POPJ
	SUBS=	.

XSPNOR,	0			/IGNORE LEADING SPACES - "SPNOR"
	TAD	CHAR
	TAD	M240
	SZA CLA
	JMP I	XSPNOR
	GETC
	JMP	XSPNOR+1


M260,	-"0
M271,	-"9



RANO,	0000			/RANDOM NUMBER STORAGE!
	2000
	0000

XTESTN,	0			/RETURNS: .; OTHER; NUMBER - "TESTN"
	TAD	CHAR
	TAD	MPER
	SZA CLA
	ISZ	XTESTN
	TAD	CHAR
	TAD	M260
	DCA	SORTCN		/SAVE VALUE OF THE NUMBER
	TAD	SORTCN		/TEST IF REALLY A DIGIT.
	SPA CLA
	JMP I	XTESTN
	TAD	CHAR
	TAD	M271
	SPA SNA CLA
	ISZ	XTESTN		/IF A NUMBER
	JMP I	XTESTN

XRAN,	FINT			/PSEUDO-RANDOM NUMBER GENERATOR.
	FADD	RANO		/ADD RUNNING RESULT TO THE ARGUMENT, IF ANY.
	FMUL	.-5		/BLAST THE ARGUMENT
	FPUT	RANO
	FXIT
	DCA	RANO		/CONVERT TO .5 THROUGH .999
	DCA	FLAC		/SAME AS RETURN
	JMP I	EFUN3I
/	EXIT FROM A "DO" SUBROUTINE

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



	ATLIST=	.		/ASK-TYPE CONTROL CHARACTER TABLE

	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

/	$ - FOR 'TDUMP' TERMINATES THE COMMAND.
/	EVALUATE AN EXPRESSION WHICH
/	TERMINATES WITH AN R-PAR,; OR C.R. AND
/	LEAVE THE RESULT IN FLAC AND IN FLARG.

ECALL,	0			/RECURSIVE CALL TO "EVAL"
	TAD	SORTCN		/SAVE 'SORTCN','LASTOP',AND 'EFOP'
	PUSHA
	TAD	LASTOP
	PUSHA
	TAD	EFOP		/SAVE FUNCTION CODE.
	PUSHA
	TAD	ECALL		/RETURN TO CALLING
	PUSHA			/ADDRESS AFTER NEXT POPJ

	GETC			/MOVE PAST EXTRA CHARACTER
EVAL,	DCA	LASTOP		/EVALUATION CONTROLLER (CHECKPOINT?)
	TESTC			/TEST CHARACTER AND IGNORE SPACES
	JMP	ETERM1		/TERMINATOR
	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,"J&237			/N-ERROR IN FORMAT
	0377			/F
	ERROR4			/L - MISSING OPERATOR

ETERM1,	TAD	CFRSX		/SET PT1.
	DCA	PT1		/TO POINT TO ZERO
	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,	TAD	THISOP		/COMPARE PRIORITIES
	CIA
	TAD	LASTOP
	SPA CLA
	JMP	EPAR		/CONTINUE
	TAD	LASTOP		/FIND OPERATION
	CLL RTR
	RTR
	TAD	OPTABL
	DCA	FLOP
	TAD	LASTOP
	SZA CLA			/TEST FOR END OF DATA INTO FLOATING AC.
	POPF			/GET LAST DATA
	FLAC
	FINT
FLOP,	00			/(FLOPR I PT1)+-*/
	FPUT I	FLARGP		/SAVE RESULT
	FXIT
	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,	FGET I	PT1		/BASE FOR OPERATION COMPUTATION
ENUM,	PUSHF			/TO PROCESS A NUMBER, SAVE AC
	FLAC
	TAD	FLARGP		/SET POINTER AS FOR A VARIABLE.
	DCA	PT1
	DCA	INSUB		/POINT TO 'GETC' AND USE CHAR
	JMS I	FINPUT		/READ TEXT NUMBER => (PT1)
	POPF			/RESTORE THE AC
	FLAC
	JMP	OPNEXT		/CONTINUE

EFUN,	DCA	EFOP		/SET CODE
	GETC			/READ FUNCTION NAME.(1, 2, OR 3 LETTERS)
	SORTC			/LOOK FOR TERMINATION CHARACTER.
	TERMS-1
	JMP	EFUN2		/YES
	TAD	EFOP		/NO
	CLL RAL			/MISH-MASH HASH CODE
	TAD	CHAR
	JMP	EFUN

EFUN2,	TSTLPR
	ERROR4			/MUST BE FOLLOWED BY PARENS TO SET ARGUMENT
	JMS	ECALL		/CALL "EVAL" TO COMPUTE ARGUMENT
	POPA			/BRANCH ON FUNCTION CODE; RETURN VIA EFUN3I.
	SORTJ
	FNTABL-1
	FNTABF-FNTABL
ELPAR,	TSTLPR			/LEFT PAREN OR FELL THROUGH FUNCTION TABLE
	ERROR4			/DOUBLE OPERATORS OR ILLEGAL FUNCTION NAME.
EPAR2,	JMS	ECALL		/EVALUATE NESTED EXPRESSION
	ISZ	PDLXR		/DUMP EXTRA ARG.
	JMP I	EFUN3I
	TERMS=	.		/TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR'

	" 			/SPACE	0
	"+			/+	1
	"-			/-	2
	"/			//	3
	"*			/*	4
	"^			/UP ARR	5
	"(			/(	6 L-PARS
	"[			/[	7
	"<			/<	10
	")			/)	11 R-PARS
	"]			/]	12
	">			/>	13
	",			/,	14
	";			/;	15
	"M&237			/C.R.	16
	"=			/= TO END GETARG FROM 'SET'

/	TWO MINOR FUNCTIONS


XSGN,	PUSHF			/TAKE SIGN*1 OF FLARG
	FLTONE
	POPF
	FLAC
XABS,	TAD	FLARG+1		/TAKE ABSOLUTE VALUE OF FLAC
	SPA CLA			/SKIP TO CONTINUE
	JMS I	MINSKI		/NEGATE THE FLOATING AC

/	CONTINUATION OF FUNCTION CALLS.

EFUN3,	FINT
	FNOR			/NORMALIZE FUNCTION RETURN
	FPUT	FLARG		/SAVE FUNCTION VALUE
	FXIT
	TAD	FLARGP		/SET POINTER
	DCA	PT1
	JMS	PARTEST
	JMP I	.+1;	OPNEXT	/FUNCTION RETURN IS OK
FLARG,	0			/DATA TEMPORARY STORAGE
	0
	0
	0

P3,	3

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

PARTEST,0			/TEST THE PAREN MATCHINGS
	POPA			/RESTORE LAST OPERATION
	DCA	LASTOP
	TAD	P3		/+3 TO COMPARE CODES
	POPA			/GET LAST PAREN CODE.
	CIA			/CHECK FOR PAREN MATCH.
	TAD	SORTCN		/(STILL SET FROM THE LAST "EVAL")
	SZA CLA			/SKIP IF MATCH	
	ERROR4			/PAREN ERROR
	GETC			/MOVE PAST R-PAR
	JMP I	PARTEST
/	THE DELETE A LINE ROUTINE

XDELETE,0			/UNCHAIN A LINE AND RECOVER THE SPACE.
	IOF			/PROTECT POINTER CHANGES FROM INTERRUPTIONS
	FINDLN			/SETS "THISLN" AND "LASTLN".
	JMP I	XDELETE		/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	CFRS		/IT IS ILLEGAL TO DELETE THE FIRST LINE
	CIA
	TAD	THISLN
	SNA CLA
	JMP	START		/JUST IGNORE SUCH COMMANDS
	CDF	T	 	/CHANGE DATA FIELD TO TEXT.(X-MEM)
	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
	CLL CIA
	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	XDELETE+1	/RESET 'LASTLN', 'THISLN', AND DATA FIELD.


CHIN,	0			/READ IN A CHARACTER SUBR. - "READC"
	JMS I	INDEV
	DCA	CHAR
	SORTC			/LINEFEED OR RUBOUT?
	ECHOLST-1
	JMP I	CHIN		/YES
	PRINTC			/ECHO THE INPUT
	JMP I	CHIN


	FNTABL=	.

	"A^2+"B^2+"S		/ABS
	"S^2+"G^2+"N		/SGN
	"I^2+"T^2+"R		/ITR
	"D^2+"I^2+"S		/DIS
	"R^2+"A^2+"N		/RAN
	"A^2+"D^2+"C		/ADC
	"A^2+"T^2+"N		/ATN
	"E^2+"X^2+"P		/EXP
	"L^2+"O^2+"G		/LOG
	"S^2+"I^2+"N		/SIN	LIST OF CODED FUNCTION NAMES
	"C^2+"O^2+"S		/COS
	"S^2+"Q^2+"T		/SQT
	"N^2+"E^2+"W		/NEW
	"C^2+"O^2+"M		/COM
	"X			/X
/	ERASE SINGLE LINES, GROUPS, OR VARIABLES

ERASE,	TESTC			/TEST THE SECOND WORD, IF ANY.
	JMP	ERVX		/ERASE VARIABLES
	JMP	ERL		/LINES OR GROUPS
	JMP	.+4		/ERROR
	TAD	CHAR		/ALL TEXT
	TAD	MINUSA
	SZA
	ERROR3			/BAD ARG FOR ERASE.
ERT,	TAD	ENDT		/ERASE ALL TEXT **
	DCA	BUFR
	DCA I	CFRS		/(X-MEM)
ERV,	TAD	STARTV		/ERASE VARIABLES **
	DCA	LASTV
	JMP	START		/POINTERS MAY BE DIFFERENT NOW.

ERL,	GETLN			/ERASE LINES.
	TAD	BUFR		/PROTECT REST OF TEXT.
	DCA	AXIN
ERG,	DELETE			/EXTRACT ONE LINE
	ISZ	THISLN
	TAD	NAGSW
	SMA CLA
	TAD I	THISLN		/(X-MEM)
	TSTGRP			/SKIP IF G(AC) = G(LINENO)
	JMP	ERV
	TAD I	THISLN		/(X-MEM)
	DCA	LINENO
	JMP	ERG

ERVX,	TAD	STARTV		/INIT VARIABLES MAY BE INDIRECT COMMAND
	DCA	LASTV
	POPJ
/	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	XRT
	TAD	LINENO
	CLL CMA IAC		/CLEAR LINK AND NEGATE LINENO.
	TAD I	XRT		/LINENO=0 WILL ALSO BE FOUND(X-MEM)
	SNA
	JMP	FEND3-1		/FOUND IT.
	SZL CLA
	JMP	FEND3		/PAST IT.
	TAD	THISLN		/MOVE POINTERS
	DCA	LASTLN
	TAD I	THISLN		/END OF TEXT? (X-MEM)
	SZA
	JMP	FINDN		/NOT YET
	SKP
	ISZ	XFIND		/2ND EXIT = FOUND
FEND3,	TAD	THISLN		/1ST RETURN = NOT FOUND
	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
	CLL RTR
	RTR
	RTR
	JMP	GEND

M40,	-40
M137,	-137
XENDLN,	0			/TERMINATE THE BUFFERED LINE - "ENDLN"
	CDF	T		/(X-MEM)
	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 (X-MEM)
	DCA	LASTV
	JMP I	XENDLN



	TLIST3=	.		/LITERAL TERMINATORS

	TASK4			/"
	PC1			/C.R. = AUTOMATIC QUOTE MATCH


	INFIX=	.		/DATA CONTROL CHARACTERS

	FLINTP+2		/LEFT ARROW	= KILL
	INPUT+1			/RUBOUT 	= IGNORE
	INPUT+1			/L.F.	 	= IGNORE
	ENDFI+5			/ALT MODE 	= EXIT

FLTONE,	0001			/(NO RELATIVE REFERENCES)
	2000
FLTZER,	0000
	0000
	0000
	0000
M12,	-12			/DECIMAL CONVERSION FACTOR FOR "PRNT"


I33,	0			/NO-INTERRUPT INPUT ROUTINE
	KSF
	JMP	.-1
	KRB
	AND	P177		/IGNORE PARITY BIT
	SNA
	JMP	.-5
	TAD	C200
	JMP I	I33
XPRNT,	0			/PRINT A LINE NUMBER - "PRNTLN"
	TAD	LINENO
	RTL6
	AND	P77
	JMS	PRNT		/TWO DIGIT "PART" NUMBER
	TAD	PER
	PRINTC			/PERIOD FOR SEPARATION
	TAD	LINENO
	JMS	PRNT		/TWO DIGIT "STEP" NUMBER.
	TAD	M140
	DCA	CHAR		/SAVE SPACE IN CHAR.
	PRINTC			/PRINT TRAILING SPACE
	JMP I	XPRNT

	VAL=	T1

PRNT,	0			/PRINT TWO DECIMAL DIGITS
	AND	P177
	DCA	VAL
	TAD	C260
	DCA	T3
	JMP	.+3
	ISZ	T3
XYZ,	DCA	VAL
	TAD	VAL
	TAD	M12
	SMA
	JMP	XYZ-1
	CLA
	TAD	T3
	PRINTC
	TAD	VAL
	TAD	C260
	PRINTC
	JMP I	PRNT

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
PACBUF,	0			/PACK A CHARACTER - "PACKC"
	TAD	P277
	CIA
	TAD	CHAR
	SNA			/CHANGE 277 TO 337
	TAD	P40
	TAD	M100
	SNA			/TEST FOR RUBOUT.
	JMP I	RUBIT
	TAD	P377
	DCA	T2		/SAVE INPUT ITEM
	TAD	T2		/SO THAT QUESTION DOESN'T MAKE
	AND	C140		/CHAR LOOK LIKE A LEFT-ARROW
	TAD	M140
	SZA			/DATA WORD.
	TAD	C140
	SNA CLA
	JMP	ESCA		/340-377 AND 200-237
PA1,	TAD	T2		/240-337
	AND	P77
	SZA	 		/IGNORE 300
	JMS	PCK1
PACX,	CDF	P		/(X-MEM)
	JMP I	PACBUF

ESCA,	TAD	P77
	JMS	PCK1
	JMP	PA1

PCK1,	0
	ISZ	XCTIN		/=0 TO START
	JMP	ROT
	TAD	ADD
	DCA I	AXIN		/(X-MEM)
	DCA	ADD		/CLEAR PACKING WORD
	TAD	PDLXR		/CHECK FOR OVERFLOW
	CLL CMA IAC
	TAD	P13		/RESERVATIONS FOR PUSH-DOWN LIST
	TAD	AXIN
	SNL CLA
	JMP I	PCK1
	ERROR2			/FULL BUFFER

P40,	40
P377,	377
C140,	140
RUBIT,	RUB1
M140,	-140

ROT,	RTL6			/(EAE)
	DCA	ADD
	CMA
	DCA	XCTIN
	JMP I	PCK1		/REST OF PAGE USED BY 8K
	PAGE

/	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
	TSF			/GIVE OUTPUT PRIORITY
	JMP	KINT
	TCF
	DCA	TELSW		/TURN OFF THE IN-PROGRESS FLAG.
	TAD I	OPTRI
	SNA
	JMP	KINT		/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
KINT,	KSF			/CHECK FOR KEYBOARD FIRST
	JMP	EXIT
	KRB			/READ BUFFER AND CLEAR FLAG TO FETCH NEXT
	AND	P177		/IGNORE BLANK AND L-T AND PARITY BIT.
	SNA
	JMP	EXIT
	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
EXIT,	RSF			/TEST H.S. READER FLAG
	JMP	.+3
	RRB			/READ BUFFER AND CLEAR FLAG
	DCA	HINBUF		/SAVE CHARACTER
	RMF			/RESTORE MEMORY FIELD.
	SMP			/(THESE TWO COULD PATCH TO OTHER PDP-8 DEVICES)
	NOP			/ONLY POSSIBLE HALT = PARITY ERROR IN 8/S ONLY.
	TAD	SAVLK
	CLL RAL
	TAD	SAVAC
	ION
EXITJ,	JMP I	0		/MODIFIED FOR PDP-5
SIN,	0
OPTR0,	IOBUF			/OUTPUT POINTERS
OPTRO,	IOBUF			/VARS
OPTRI,	IOBUF

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.
	ION			/BE SURE INTERRUPT IS ON.
	TAD I	OPTRO		/ANY ROOM?
	SZA CLA			/A CHARACTER IS NON-ZERO
	JMP	.-2		/NO = WAIT.
	IOF
	TAD	TELSW		/IN PROGRESS?
	SZA CLA
	JMP	.+5
	TAD	XI33		/NO
	TLS			/TYPE CHARACTER.
	DCA	TELSW		/SET IN-PROGRESS FLAG.
	JMP	.+10		/RETURN
	TAD	XI33		/SEND DATA
	DCA I	OPTRO
	TAD	OPTRO		/SET POINTERS
	IAC
	AND	P17
	TAD	OPTR0
	DCA	OPTRO
	ION
	JMP I	XOUTL
/	ERROR RECOVERY PROCEEDURE

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.
	ION			/(JMP .+4) - FOR DEBUGGING
	TAD	TELSW		/WAIT FOR OUTPUT TO FINISH
	SZA CLA
	JMP	.-2
	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	AXIN		/INIT I/O BUFFERS.
	CDF	P		/(X-MEM RESET)
	DCA I	AXIN
	ISZ	CNTR
	JMP	.-2
	DCA	INBUF		/INIT KEY-BUFR.
	TAD	OPTR0		/INIT TTY POINTERS.
	DCA	OPTRI
	TAD	OPTR0
	DCA	OPTRO
RECOVX,	CMA			/PREPARE A STOP BIT FOR TTY
	TLS			/AND RAISE FLAG. (NOP) - FOR DEBUGGING
	TAD	P7700		/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		/PRINT ATSIGN
	PRINTC
	PRINTC			/PRINT SPACE AGAIN AND
	PRNTLN			/PRINT LINE OF ERROR.
	TAD	CCR
	PRINTC
	TAD	PTCH		/RESET "READC"
	DCA	RDIV		/IF AN ERROR OCCURS.
	JMP	START		/INTERRUPT WILL BE RE-ENABLED SOON.
/	CHRACTER REMOVAL ROUTINE

RUB1,	TAD	XCTIN		/RUBOUT ONE LETTER
	SZA CLA
	JMP	.+6
	TAD	AXIN
	CIA
	TAD	PACKST
	SMA CLA			/TEST NULL LINE
	JMP I	RUB5
	TAD	SPLAT		/FOR A RUBOUT ACKNOWLEDGEMENT
	PRINTC
	TAD	AXIN
	DCA	T2
	CDF	T 		/(X-MEM)
	ISZ	XCTIN		/TEST HALF
	JMP	RUB2
	TAD I	T2		/"ADD" IS FULL.
	AND	P77
	TAD	M77
	SZA CLA			/TEST FOR EXTEND
	JMP	RUB4
RUB3,	CMA			/SET SWITCH
	DCA	XCTIN
	CMA			/BACKUP POINTER
	TAD	AXIN
	DCA	AXIN
	TAD I	T2		/RESET ADD
	AND	P7700
RUB4,	DCA	ADD
	JMP I	RUB5

RUB5,	PACX

RUB2,	TAD I	T2		/CHECK FOR EXTENDED
	AND	P7700
	TAD	C100
	SZA CLA
	JMP	RUB3
	DCA I	T2		/SAVE CORRECTION
	JMP	RUB3+1

SPLAT,	334
/	SYMBOL TABLE TYPEOUT ROUTINE

TDUMP,	TAD	STARTV		/INIT POINTER FOR SYMBOL DUMP.(X-MEM)
	DCA	PT1
	TAD	LASTV		/TEST FOR END OF LIST
	CIA
	TAD	PT1
	SNA CLA
	POPJ
	TAD I	PT1		/GET THE VARIABLE
	DCA	OP+1		/(DCA I (4)-FOR(X-MEM)):SAVE NAME
	TAD	OP		/SETUP UNPACK POINTERS
	DCA	AXOUT
	DCA	XCT
	GETC			/READ AND PRINT "XX("
	PRINTC
	GETC
	PRINTC
	GETC
	PRINTC
	ISZ	PT1
	TAD I	PT1		/PRINT SUBSCRIPT TO 99
	JMS I	PRNT2
	GETC			/PRINT ")"
	PRINTC
	ISZ	PT1
	FINT			/PICK UP VALUE
	FGET I	PT1
	FXIT
	JMS I	FOUTPUT		/PRINT VALUE
	TAD	CCR
	PRINTC
	TAD	GINC
	TAD	M2
	TAD	PT1
	JMP	TDUMP+1

PRNT2,	PRNT
OP,	.			/ (X-MEM)
	0000			/ (X-MEM)
	"(^100+")-200		/(THESE GO IN 10005 FOR X-MEM)
/	OUTPUT CHARACTER BUFFER (ADDRESS IS A MULTIPLE OF 20)

	IOBUF=	3120

	COMEIN=	IOBUF+20	/COMMAND - INPUT BUFFER

	COMEOUT=COMEIN+46


	*COMEOUT



FRST,	0			/TEXT POINTER
	0000			/DUMMY LINE NO.
	"C^100+"--200		/TITLE
	"F^100+"O-300		/FO
	"C^100+"A-300		/CA
	"L^100+",-200		/L,
	"1^100+"9-200		/19
FRSTX,	"6^100+"9-200		/69
	"?^100+"M-300		/DUMMY C.R.

/	TO SAVE TEXT, SAVE C(BUFR), C(LASTV), AND C(FRST TO C(BUFR))
/	WITH ODT-JR46.  THE TAPES MAY BE TOGETHER WITH
/	THE SYMBOLIC DUMP LAST : FOCAL + FLOAT + DIALOG .
/	LOADING THE LAST SECTION MAY BE CONSIDERED OPTIONAL.



	BUFBEG=	.		/TEXT BUFFER STARTS HERE.
	*4400-10

O1,	RECOVR+1		/STARTING ADDRESS

BEGIN,	TAD	O1		/INITIALIZE ANY 8-FAMILY COMPUTER.
	DCA	START-1
	6142			/CLEAR F.H.'S 8.((JMP ATES+1)-FOR TSS-8)
	6077			/SET INTENSITY LEVEL, 34D
	6152			/CLEAR LPT
	6762			/TC01	
	6012			/CLEAR PC02 FOR PDP-5
	6346			/CLEAR LAB-8
	6772			/CLEAR 552
	CLA CLL
	DCA I	FLTXR
	ISZ	CNTR		/INITIALIZED BY LOAD.
	JMP	.-2		/CLEAR INPUT BUFFER

/	TEST FOR COMPUTER TYPE

	TAD	PDP		/CREATE THE VARIABLE 'PDP'
	JMS	LOOKUP		/MUST RETURN ZERO
	TAD	PDP5		/TEST FOR PDP-5
	DCA	0000
O4,	CMA			/LINC-8 OR PDP-12?
	6167			/SET LINC AC- (INITS AND KILLS 338)
	CLA
	6171			/READ LINC AC
	SNA CLA
	JMP	T12
	TAD	P7		/CLEAR LINC-INTERRUPTS
	6141
	TAD	P2
	6141
	CLA
	JMP	ATES-3		/YES
T12,	6141			/BECOME A LINC
	0017			/COMPLEMENT AC
	0002			/BACK TO 8 MODE
	IAC			/SET TO ZERO IF PDP-12
	SNA CLA
	JMP	ATES-5

	CLL IAC			/LAB-8?
	6344			/"OTEN"
	6331			/"XRIN"
	SMA CLA
	JMP	.+6		/NO
	TAD	L8A		/YES
	DCA I	L8AY
	TAD	L8B		/SETUP SCOPE CONTROLS
	DCA I	L8AX
	JMP	ATES-4

	7354			/NL3776
	TAD	PDP8I		/IS THIS A PDP-8/I OR 8/L?
	SNA CLA
	JMP	ATEI
	7344			/NL7776
	TAD	P2
	SNA CLA
	JMP	ATES-1		/8
	TAD	CCR+1		/PDP-8/S
	DCA I	O6		/SETUP PARITY-ERROR HALT
	TAD	O4		/CORRECT READER WAIT
	DCA I	O5
	JMP	ATES

PDP5X,	ISZ I	O2		/INCREMENT INTERRUPT RETURN
	JMP	ATES+1
ATEI,	TLS
G8L,	6000
	6000
	6000
	6000
	6000
	6000
	6000
	6000
	ISZ	CNTR
	TSF
	JMP	G8L
	TAD	CNTR
	TAD	FOUTPUT
	SPA CLA
	JMP	ATES-2		/8/I
	ISZ I	PT1		/8/L	= 7/2^11
	ISZ I	PT1		/PDP-12	= 6/2^11
	ISZ I	PT1		/LAB-8	= 5/2^11
	ISZ I	PT1		/LINC-8	= 4/2^11
	ISZ I	PT1		/8/I 	= 3/2^11
	ISZ I	PT1		/8  	= 2/2^11
ATES,	ISZ I	PT1		/8/S 	= 1/2^11
				/5	= 0
/	INITIALIZE THE DIALOGUE

	TLS
	ION			/ENABLE INTERRUPT
	PUSHJ
	DO+1
	IOF

/	SHALL I KEEP EXP, LOG, ATN? (256)
/	SHALL I KEEP SIN, COS? (128)
/	XF =   +1(NO) -1(YES) 0(YES)

	TAD	XF
	JMS	LOOKUP
	SNA
	JMP	OOUT		/NO DIALOGUE EXECUTED
	SPA CLA
	TAD	P2
	TAD	M5		/DELETE X-FUNCTIONS
	DCA	CNTR
	TAD	FNPT
	DCA	XRT
	TAD	ER5
	DCA I	XRT		/SET THE TABLE
	ISZ	CNTR
	JMP	.-3
	TAD	XF		/CORRECT BUFFER PROTECT
	JMS	LOOKUP
	SPA CLA
	TAD	P7600		/(-200)
	TAD	BFXX
OOUT,	TAD	BFX
	DCA	BOTTOM
	JMP I	.+1;	ERT	/GOES TO START AFTER ERASING ALL
L8A,	6313
L8B,	6307
L8AY,	XDYS+11
L8AX,	XDYS+14
FNPT,	FNTABF+5
ER5,	ERROR5
BFXX,	TGO-FEXP			/WITHOUT
BFX,	FEXP-1				/WITH
XF,	"X^100+"F-300			/X, F
O2,	EXITJ				/INTERRUPT EXIT
PDP,	"P^100+"D-300			/P, D
O5,	HREAD+1
O6,	EXIT+6
P7,	7
P2,	2
PDP8I,	4002				/(-3776)
PDP5,	PDP5X-1

LOOKUP,	DDTJR+DMULT4+END+RECOVX+PSIN	/MAKE BELIEVE
	DCA	ADD
	PUSHJ				/CALL THE VARIABLE SEARCH ROUTINE.
	GS1
	ISZ	PT1
	TAD I	PT1
	JMP I	LOOKUP
	*6321			/STUCK INTO THE FLOATING POINT PACKAGE.

HREAD,	0			/HAMILTON STANDARD READER SUBROUTINE.
	TAD	M20		/(CMA)- FOR 8/S.
	DCA	HSWITC
HREAD2,	TAD	HINBUF		/(RSF) -WHEN DEBUGGING
	SMA CLA			/(SKP)
	JMP	HSGO
	ISZ	T1		/SKIP IF OUT OF TAPE
	JMP	HREAD2
	ISZ	HSWITC
	JMP	HREAD2
	JMS	HSWITC		/LEAVES LINK ZERO
	TAD	PDLXR		/ < FRST?
	TAD	HTST
	SNL CLA
	JMP I	.+3		/YES=DIRECT COMMAND
	ISZ	PDLXR		/NO=OK TO DUMP CALL
	POPJ

	IBAR

HSWITC,	0
	TAD	HSPSW		/INITIALIZE H.S. READER
	CMA
	DCA	HSPSW		/CHANGE STATUS
	CLL CMA			/CLEAR LINK
	DCA	HINBUF		/CLEAR BUFFER
	TAD	HSPSW
	SZA 
	RFC			/START HARDWARE
	SZA CLA
	TAD	RESTR		/(HREAD)
	TAD	PTCH
	DCA	RDIV		/"READC"
	JMP I	HSWITC

HSPX,	JMS	HSWITC		/COMMAND "*"  - SWAP
	JMP I	.+1;	PROC

HSGO,	CMA			/FETCH NEXT CHARACTER
	DCA	HINBUF
	RFC RRB			/PICK UP NEXT CHARACTER
	AND	P177		/CHECK FOR LEADER-TRAILER,ETC.
	SNA
	JMP	HREAD+1
	TAD	C200
	DCA	CHAR		/SAVE INPUT
	JMP I	HREAD

HSPSW,	0
HTST,	-COMEOUT-13
RESTR,	HREAD-CHIN
/	DISK MONITOR INTERACTIVE COMMAND OPERATES VIA THE KEYBOARD.
/	THIS FITS UNDER THE 10 DIGIT FLOATING POINT OUTPUT BUFFER.

	*7503

LIBRARY,TAD	CFRS
	JMS	PRNT8
	TAD	BUFR		/TYPE C(CFRS), C(BUFR), C(LASTV), C(BOTTOM)
	JMS	PRNT8		/OCTAL OUTPUT + COMMA
	TAD	LASTV
	JMS	PRNT8
	TAD	BOTTOM
	JMS	PRNT8
	JMP	.+3

	GETC
	PRINTC
	TAD	CHAR
	TAD	MCR
	SZA CLA
	JMP	.-5
	TAD	TELSW
	SZA CLA
	JMP	.-2		/(NOP) - WHEN DEBUGGING
	IOF
	JMP I	P7600		/(7600=DISK MONITOR)

PRNT8,	0
	DCA	T1
	TAD	T1
	RTL
	RTL
	JMS	PRINTD
	RTL6
	RAL
	JMS	PRINTD
	RTR
	RAR
	JMS	PRINTD
	JMS	PRINTD
	CLA
	TAD	CCR
	PRINTC
	JMP I	PRNT8

PRINTD,	0
	AND	LP7
	TAD	C260
	PRINTC
	TAD	T1
	JMP I	PRINTD

LP7,	7

/	USED BY 8K
