/FOCL12.37
/COPYRIGHT 1970, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754
PMODE			/********
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=0
FXIT=0
FINT=JMS I 7
SMP=6101
/MISCELLANEOUS ITEMS
*1
	JMP I .+2	/INTERRUPT PROCESSOR ENTRY
LWETMP,	0		/********
	INTRPT
DDTJR,	DDTJR		/USED FOR DEBUGGING
P13,	13		/CONSTANT
C100,	100		/CONSTANT
T=00			/TEXT FIELD NO.
P=00			/DATA 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 LOSS
TEXTP=.			/TEXT POINTER (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,	FEXP-1		/******** LAST LOCATION CURRENTLY AVAILABLE
INSUB,	0		/0 = GETC; #0 = READC
HINBUF,	0		/HIGH SPEED INPUT BUFFER
/PAGE ZERO OF THE
/FLOATING POINT ARITHMETIC INTERPRETER FOR FOCAL
*40
EX1,	0		/OPERAND STORAGE
AC1H,	0
AC1L,	0
OVER1,	0
FLAC=.	/FLOATING ACCUMULATOR
EXP,	0		/F.A.
HORD,	0
LORD,	0
OVER2,	0
SIGNF,	0		/FLOATING SIGN
MINSKI,	ACMINS		/NEGATE FLAC SUBROUTINE
FISW,	2004		/OUTPUT FORMAT
INTEGER,FIX		/FIX FLAC
GETSGN=TAD FLAC+1
RETURN=JMP I EFUN3I
*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.
QADD,	0		/********
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 LOSS(4000=ONE;1=ALL;0=GROUP);(0000)-FOR TSS-8
CHAR,	215		/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 TO OUTDEV AND INDEV;
/ALSO PATCH THE ERROR ROUTINE - FOUR
/PATCHES PLUS TWO FOR THE HIGH SPEED READER.
LIST6=.		/INPUT LIST FOR "SFOUND".
	214		/F.F.
	207		/BELL
LIST7=.
	203		/CONTROL-C FOR DEBUGGING AND TSS-8
P337,	337		/LEFT ARR
CLF,	212		/L.F.
LIST3=.		/EXCRETION LIST
CCR,	215		/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,	256		/PERIOD
M77,	-77		/EXTEND CODE TEST
P7600,	7600		/GROUP MASK
M20,	-20		/CONSTANT
P177,	177		/STEP MASK
P17,	17		/BCD MASK
P277,	277		/"?"
M2,	-2		/CONSTANT
MINUSA,	-301		/CONSTANT
C260,	260		/ASCII FOR ZERO
M240,	-240		/SPACE TEST
MPER,	-256		/PERIOD TEST
MCR,	-215		/C.R. TEST
MFLT,	-WORDS		/= -4 FOR 4-WORD
M5,	-5		/PAREN TEST
M11,	-11		/PAREN TEST
P77,	77		/RIGHT MASK
C200,	200		/CONSTANT
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 .		/RECURSIVE SUBROUTINE CALL
	XPUSHJ
POPA=TAD I PDLXR	/RESTORE AC
POPJ=JMP I .		/SUBROUTINE ERETURN
	XPOPJ
PUSHA=JMS I .		/SAVE AC
	XPUSHA
PUSHF=JMS I .		/SAVE GROUP OF DATA
	PD2
POPF=JMS I .		/SAVE 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 DATA INTO CHAR AND PRINT IT
RDIV,	CHIN
PRNTLN=JMS I .		/PRINT C(LINENO)
	XPRNT
GETLN=JMS I .		/UNPACK AND FORM A LINE NUMBER
	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 - AND IGNORE SPACES
	XTESTC
DELETE=JMS I .		/REMOVE OLD TEXT LINE
PSIN,	XDELET
ERROR2=JMS I .		/EXCESS SOMETHING ERROR
ERROR3=JMS I .		/MISCELLANEOUS ERROR
ERROR4=JMS I .		/FORMAT ERROR
	ERR2
/USED BY 8K
/FOCAL'S COMMAND/INPUT DRIVER
*167
SUBS2,	0		/********
LESUB2,	0		/********
SUBS,	0		/********
LEFPUT,	LEPUT		/********
LESUBS,	0		/********
PWAIT,	WAIT		/********
PCLEAR,	CLEAR		/********
	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 PSUBS	/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,	252		/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 STARTV	/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 FOR A LINE NUMBER.
GEXIT,	CLL		/CLEAR LINK BIT
	TAD LINENO	/TEST FOR GROUP NUMBER
	AND P7600
	SZA CLA 
	CML 
	TAD LINENO
	AND P177	/PREPARE "NAGSW"
	SZA SNL 
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 ACCEPTABLE 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	/INT	-INTEGER PART
	XDISP	/DIS	/********
	XRAN	/RAN	-RANDOM NUMBER
	XADC	/ADC	-READ ANALOG TO DIGITAL CONVERTER
	ARTN	/ATN	-ARCTANGENT
	FEXP	/EXP	-EXPONENTIAL
	FLOG	/LOG	-LOGARITHM
	FSIN	/SIN	-TRIG FUNCTIONS
	FCOS	/COS	-
	XSQRT	/SQT	-SQUARE ROOT
PFNEW,	ERROR5	/NEW	-USER DEFINED FUNCTIONS
PFX,	ERROR5	/FX	/********
PFZ,	ERROR5	/FZ	/********
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	/CONTINUE PROCESSING THIS LINE.
	PROC
/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 SUBROUTINE 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 PD2
	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,	-306		/USED BY TESTC
/PRINARY 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
PROCES,	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 PROCES
	TAD CHAR	/SAVE COMMAND CHARACTER
	AND P337	/EXECUTE LOWER CASE ALSO
	PUSHA
	GETC		/GO TO GERMINATOR
	SORTC
	GLIST-1
	SKP 
	JMP .-4
	POPA
	SORTJ		/GO DO COMMAND
	COMLST-1
	COMGO-COMLST
	ERROR2		/ILLEGAL COMMAND
COMMENTS=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 IF 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,	FINCR
	SNA SPA 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 - SORTC 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	/2ND 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 		/!ST 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
	JMS I RDIV
	SORTJ
	SPECIAL-1
	INFIX-SPECIAL
	JMP I INPUT
ILIST,	IF1		/,
	PROCESS		/;
	PC1		/CR
		/ENGLISH-FRENCH
COMLST=.	/COMMAND DECODING LIST
	323	/SET	- ORGANIZE
	306	/FOR	- QUAND
	311	/IF	- SI
	304	/DO	- FAIZ
	307	/GOTO	- VA
	303	/COMMENT- COMMENTE
	301	/ASK	- DEMANDE
	324	/TYPE	- TAPE
	317	/OUTPUT	/********
	305	/ERASE	- BIFFE
	327	/WRITE	- INSCRIS
	315	/MODIFY	- MODIFIE
	321	/QUIT	- ARRETE
	322	/RETURN	- RETOURNE
	314	/LIBR	/********
/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
SETT=.			/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
	FEXT
	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 THE 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
	FEXT
	GETSGN
	SMA SZA CLA
	POPJ		/END OF LOOP
	TAD PT1
	PUSHA		/SAVE ADDRESS *
	PUSHF		/SAVE INCREMENT AGAIN *
FINKP,	ITER1
	JMP FCONT
MEQ,	-275
MCOM,	-254
FINFIN,	PUSHF		/SET INCREMENT TO ONE.
	FLTONE
	JMP FCONT
/
/SAME FRAN - JUST MOVED
/
RANO,	0000		/********
	2000		/********
	0000		/********
XRAN,	FINT		/********
	FADD RANO	/********
	FMUL I CRUDDY	/********
	FPUT RANO	/********
	FEXT		/********
	DCA RANO	/********
	DCA FLAC	/********
	JMP I EFUN3I	/********
CRUDDY,	RANMUL		/********
/TAKE THE INTEGER PART
XINT,	JMS I INTEGER	/(FIX)
	CLA
	JMP I EFUN3I
COMGO=.	/COMMAND ROUTINE ADDRESSES
	SETT
	FOR
	IF
	DO
	GOTO		/(REFERENCED)
	COMMENT
	ASK/TAD GETRHS
	TYPE
	OUTPUT		/********
	ERASE
	WRITE
	MODIFY
	START		/RETURN TO COMMAND MODE VIA 'QUIT'
	RETRN
	LTAPE		/********
/INPUT-OUTPUT STATEMENTS
ASK,	CLA CMA		/REMEMBER WHICH CALL.
TYPE,	DCA ATSW
TASK,	DCA DEBGSW
	SORTJ		/SPECIAL CHARD *****
	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
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 C.R. *
TCRLF,	TAD CCR		/EXCLAMATION POINT=CR, LF.
	PRINTC
TASK4,	GETC		/*
	JMP TASK
COL,	272		/":"
/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	/CORT 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	/2ND 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	/RETURN TO CALLING SEQUENCE.
/ANALOGUE TO DIGITAL CONVERSION FOR PDP-12
XADC,	JMS I INTEGER
	AND O37		/********
	TAD OSAMP	/********
	DCA .+3		/********
	IOF		/********
	6141	/LINC	/********
	0100	/SAM ?	/********
	0002	/PDP	/********
	ION		/********
	DCA FLAC+1	/********
	DCA FLAC+2	/********
	CLA CLL CML RTL	/********
	DCA FLAC	/********
	JMP I EFUN3I	/********
OSAMP,	0100	/SAM 0	/********
O37,	37		/********
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.
	245	/%
	242	/"
	241	/!
	243	/#
	244	/$///
GLIST=.
	240	/SPACE
TLIST=.
	254	/,
	273	/;
	215	/C.R.
/THIS LIST IS ENDED BY 'TESTC'.
/FIND OR ENTHER A VARIABLE IN THE LIST.
GETARG,	TESTC		/FIRST LETTER OF ARG
P7200,	7200	/CLA	/******** LETS F THRU
	ERROR4		/********
	NOP		/********
GETVAR,	DCA XCTIN	/PACK INTO ADD.
	PACKC
	GETC		/SECOND LETTER
	SORTC		/TERMINATOR?
	TERMS-1
	JMP GSERCH	/YES
	TAD CHAR	/NO
	AND P77		/SAVE 2ND LETTER OF NAME
	TAD QADD
	DCA QADD
	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 QADD	/SAVE NAME
	DCA EFOP	/FOR RECURSIVE AND ERROR CHECK
	JMS I GECALL	/TO EVAL
	POPA
	DCA QADD	/RESTORE NAME
	JMS I PTEST	/TEST PAREN MATCH
	JMS I INTEGER	/CONVERT TO 12 BIT NUMBER.
GS1,	DCA SUBS	/SAVE SUBSCRIPT
	TAD QADD	/******** LETS F THRU
	AND P7700	/********
	TAD P7200	/********
	SNA CLA 	/********
	JMP FFF		/********
	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 QADD
	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 QADD	/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
	FEXT
	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
FFF,	DCA PT1		/******** SAVES SUBSCRIPT ON F
	TAD QADD	/********
	DCA LWETMP	/********
	TAD HORD	/********
	DCA LESUB2	/********
	TAD SUBS	/********
	DCA SUBS2	/********
	POPJ		/********
TLIST2,	242		/********
	215		/********
M260,	-260		/********
			/********
XSPNOR,	0		/IGNORE LEADING SPACES - "SPNOR"
	TAD CHAR
	TAD M240
	SZA CLA 
	JMP I XSPNOR
	GETC
	JMP XSPNOR+1
			/******** RECODING FOR SPACE
M272,	-272		/********
O12,	12		/********
			/********
			/********
XTESTN,	0		/RETURNS .; OTHER; NUMBER - "TESTN"
	TAD CHAR
	TAD MPER
	SZA CLA
	ISZ XTESTN
	TAD CHAR	/******** RECODING FOR SPACE
	TAD M272	/********
	CLL 		/********
	TAD O12		/********
	DCA SORTCN	/********
	SZL		/********
	ISZ XTESTN	/********
	JMP I XTESTN	/********
			/********
/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,0212		/N - ERROR IN FORMAT
	0377		/F
	ERROR4
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. END OF EXP.
ETERM2,	TAD THISOP	/COMPARE PRIORITIES
	CIA
	1055
	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
	AND FLAC
	FINT
FLOP,	00		/(FLOPR I PT1)***/
	FPUT 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 CHAAR 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)
	TESTC		/******** SEPARATES FILE BECAUSE F DIGIT
	JMP EFUN2	/********
	JMP I PFNUM	/********
	NOP		/********
	TAD EFOP	/********
	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 NEEDED EXPRESSION
	ISZ PDLXR	/DUMP EXTRA ARG.
	JMP I EFUN3I
PFNUM,	FNUM		/********
TERMS=.		/TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR'
	240	/SPACE	0
	253	/+	1
	255	/-	2
	257	//	3
	252	/*	4
	336	/UP ARR	5
	250	/(	6
	333	/[	7
	274	/<	10
	251	/)	11
	335	/]	12
	276	/>	13
	254	/,	14
	273	/;	15
	215	/C.R.	16
	275	/=	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 
	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	/FUNCTION RETURN IS OK
	OPNEXT

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
	SZA SMA 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	/(STIL 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 XDELET	/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
	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 VAL
	JMP .-3
	JMP XDELETE+1	/RESET 'LASTN', '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=.
	2533	/ABS
	2650	/SGN
	2636	/ITR
	2565	/DIS
	2630	/RAN
	2517	/ADC
	2572	/ATN
	2624	/EXP
	2625	/LOG
	2654	/SIN	/LIST OF CODED FUNCTION NAMES
	2575	/COS
	2702	/SQT
	2631	/NEW
	0330	/FX	/********
	0332	/FZ	/********
/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
	DCA LASTV
	POPJ
/ROUTINE CALLED VIA "FINDLN":
/SEARCH FOR A GIVEN LINE I.D. = [ "LINENO" ]
/1ST RETURN IF NOT FOUND.
/2ND RETURN 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 
	ISZ XFIND	/********
	SZL CLA 
	JMP FEND3	/PAST IT.
	TAD THISLN	/MOVE POINTERS
	DCA LASTLN
	TAD I THISLN	/END OF TEST? (X-MEM)
	SZA 
	JMP FINDN	/NOT YET
			/********
			/********
FEND3,	TAD THISLN	/1ST RETURN = NOT FOUND
	IAC
	DCA TEXTP	/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
UTO,	DCA CHAR
	TAD DEBGSW
	TAD DMPSW
	SNA CLA 
	PRINTC		/PRINT ONLY IF BOTH ARE ZERO.
	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 UTO
GET1,	0		/UNPACK 6-BIT
	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 QADD	/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 PLESUB
	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 QADD
	DCA I AXIN	/(X-MEM)
	DCA QADD	/CLEAR PACKING WORD
	TAD PDLXR	/CHECK FOR OVERFLOW
	CMA IAC CLL
	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 QADD
	CMA 
	DCA XCTIN
	JMP I PCK1
/
/PART OF INTERFACE TO FLD1 TO ALLOW
/GETTING OF CHARS FROM TEXT
/
CGETX,	GETC		/********
	TAD CHAR	/********
	6213/CIF CDF 10	/********
	JMP I .+1	/********
	CGETRET		/********
ERRFIL,	ERROR4		/********
/USED BY 8K
*2600
/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 OF IN-PROGRESS FLAG.
	TAD I OPTRI
	SNA 
	JMP KINT	/DONE
	TPC		/TYPE NEXT.
	DCA TELSW	/CLEAR AC, SET IN-PROGRESS.
	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,	CLSK		/********
	JMP NOCLK	/********
	CLSA		/********
	CLA 		/********
	DCA CLKFLG	/********
/
/KW12 CLOCK INTERRUPT ROUTINE
/
NOCLK,	RMF
	TAD SAVLK
	CLL RAL 
	TAD SAVAC
	ION
EXITJ,	JMP I 0		/MODIFIED FOR PDP-5
CLKFLG,	0		/******** SET TO 0 EVERY CLOCK INTERRUPT
SIN,	0
OPTR0,	IOBUF	/OUTPUT POINTERS
OPTRO,	IOBUF	/VARS
OPTRI,	IOBUF
XI33,	0		/VIA (INDEV)
	TAD INBUF	/ANY INPUT?
	SNA 		/********* REFRESH SCOPE WHILE WAITING
	JMS I PWAIT	/********* FOR INPUT
	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
	JMS I PWAIT	/******** REFRESH SCOPE
	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 PROCEDURE
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	/*
	TAD M20		/SETUP INIT COUNT
	DCA CNTR
	CMA 
	TAD OPTR0
	DCA AXIN	/INIT I/O BUFFERS.
/****
	CDF		/(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 SPACE
	ISZ PC
	TAD I PC	/UNLESS IT IS ZERO. (X-MEM)
	SNA 
	JMP .+6
	DCA LINENO
	TAD P7700	/PRINT ATSIGN
	PRINTC
	PRINTC		/PRINT SPACE ?IN 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.
/CHARACTER 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 QADD
	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
	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 POINTER
	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 VARIABLE
	FGET I PT1
	FXIT
	JMS I FOUTPUT	/PRINT VALUE
	TAD Y
	PRINTC
	TAD GINC
	TAD M2
	TAD PT1
	JMP TDUMP+1
PRNT2,	PRNT
OP,	.		/ (X-MEM)
	0000		/ (X-MEM)
	5051		/(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 NUMBER
	0340	/"C "	/********
	0617	/"FO"
	0301	/"CA"
	1455	/"L-"	/********
FRSTX,	6162	/"12"	/********
	7715	/C.R.
/TO SAVE TEXT, SAVE C(BUFR), C(LASTV), AND (C(FRST) TO C(BUFR))
/WITH ODT-JR.  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.
/*3600
*4400
O1,	RECOVR+1/STARTING ADDRESS
BEGIN,	TAD O1		/INITIALIZE ANY 8-FAMILY COMPUTER.
	DCA START-1
	NOP/(IOPRESET)	/********
	JMS I PCLEAR	/******** INITIALIZE THE POINT DISPLAY
	CLA CLL 
	DCA I FLTXR
	ISZ CNTR/INITIALIZED BY LOAD.
	JMP .-2	/CLEAR INPUT BUFFER
T12,	CLA		/******** FIX UP DIAL I/O ROUTINES
	6213/CIF CDF 10	/********
	DCA I G7775	/********
	TAD G5772	/********
	DCA I G7776	/********
	TAD G5773	/********
	DCA I G7777	/********
	6201		/********
	JMS I G7774	/********
	GBLOK		/********
	6212/CIF 10	/********
	JMS I G7200	/********
	6211		/********
	2400		/********
	6211		/********
	7400		/********
	400		/********
	6212/CIF 10	/********
	JMS I G7775	/******** WRITE MILDRED INTO UPPER
	RITEOU		/******** SOURCE WORKING AREA
	CLLR		/******** INITIALIZE CLOCK
	CLEN		/********
	CLA CMA 	/********
	CLAB		/********
	TAD G101	/********
	CLLR		/********
	CLSA		/********
	CLA 		/********
	TLS		/********
	ION		/********
	JMP I .+1	/******** ERASE ALL
	ERT		/********
RITEOU,	110		/********
	30		/********
	76		/********
	2		/********
GBLOK,	100		/********
	25		/********
	23		/********
	1		/********
G101,	101		/********
G5772,	5772		/********
G5773,	5773		/********
G7200,	7200		/********
G7773,	7773		/********
G7774,	7774		/********
G7775,	7775		/********
G7776,	7776		/********
G7777,	7777		/********
*4600+20
FEXP,	GETSGN		/TAKE ABSOLUTE VALUE
	SPA CLA 
	JMS I NEGP
	DCA T3		/C(SIGN)=-1 IF X2 < 0
	FINT
	FMUL LG2E
	FPUT I X2
	FEXT
	JMS I INTEGER	/TAKE INTEGER PART
	DCA FLAG2	/SAVE LOW ORDER DATA
	FINT
	FNOR
	FPUT I XSQ2
	0675
	FSUB I XSQ2
	FPUT I X2
	FMUL I X2
	6676
	FADD DF
	FPUT TEMP
	FGET CF
	FDIV TEMP
	FSUB I X2
	FADD AF
	FPUT TEMP
	FGET BF
	FMUL I XSQ2
	FADD TEMP
	FPUT TEMP
	FGET I X2
	FDIV TEMP
	FMUL TWO
	FADD ONE
	FEXT
	TAD FLAG2
	TAD FLAC
	DCA FLAC
	ISZ T3
	RETURN
	FINT
	FPUT I X2
	0316
	FDIV I X2
	FEXT
	RETURN
/CONSTANTS FOR FEXP
X2,	X
XSQ2,	XSQR
AF,	0004
	2372
	1402
BF,	7774
	2157
	5157
CF,	0012
	5454
	0343
DF,	0007
	2566
	5341
LG2E,	0001
	2705
	2435
ONE,	0001
	2000
	0000
TWO,	0002
	2000
	0000
NEGP,	FNEG
FLAG2,	0
TEMP,	0
	0
	0
	0
/MAIN ALGORITHM FOR ARCTANGENT
ARCALG,	FINT
	FGET I X2
	FMUL I X2
	FPUT I XSQ2
	FMUL BET2
	FADD BET1
	FMUL I XSQ2
	FADD BETZ
	FPUT TEMP
	FGET ALF2
	FMUL I XSQ2
	FADD ALF1
	FMUL I XSQ2
	FADD ALFZ
	FMUL I X2
	FDIV TEMP
	FEXT
	JMP I .+1
	ARCRTN
/CONSTANTS - FLOATING ARC TANGENT
ALFZ,	0
	2437
	1643
ALF1,	7777
	3304
	4434
ALF2,	7773
	3306
	5454
BETZ,	0000
	2437
	1646
BET1,	0000
	2427
	2323
BET2,	7775
	3427
	7052
/FLOATING POINT ARC TANGENT
*5000
ARTN,	GETSGN		/TAKE ABSOLUTE VALUE
	SPA CLA
	FMUL FNEG
	FDIV T3
	FMUL I O360
	FPUT I X1
	FSUB I CON1
	FEXT
	TAD HORD
	SPA CLA 
	JMP GO		/LESS THAN ONE
	FINT
	FGET I CON1
	FDIV I X1
	FPUT I X1
	FEXT
	CLA CMA 
GO,	DCA FLAG1	/SIGN FLAG OF RESULT
	JMP I .+1	/CALL ALGORITHM
	ARCALG
ARCRTN,	ISZ FLAG1	/RETURN HERE
	JMP I EXIT1
	FINT
	FPUT I X1
	FGET I PI2
	FSUB I X1
	FEXT
	JMP I .+1
EXIT1,	EXIT2
/CONSTANTS FOR ARCTANGENT
X1,	X
PI2,	PIOT
CON1,	ONE
FLOG,	GETSGN	/FLOATING LOGARITHM
	SNA 
	ERROR3		/ZERO ARGUMENT FOR LOG
	SPA CLA 
	JMS I MINSKI
	FINT
	FPUT I TEM
	FSUB I CON1
	FEXT
	GETSGN
	SNA 
	RETURN
	SMA CLA 
	JMP STARTL
	FINT
	FGET I CON1
	FDIV I TEM
	FPUT I TEM
	FEXT
	CLA CMA 
STARTL,	DCA T3
	TAD P13
	DCA FLAC
	CMA 
	TAD I TEM
	DCA FLAC+1
	DCA FLAC+2
	DCA FLAC+3
	IAC
	DCA I TEM
	FINT
	FMUL LOG2
	FPUT I X1
	FGET I TEM
	FSUB I CON1
	FPUT I TEM
	FMUL LOG8
	FADD LOG7
	FMUL I TEM
	FADD LOG6
	FMUL I TEM
	FADD LOG5
	FMUL I TEM
	FADD L4
	FMUL I TEM
	FADD L3
	FMUL I TEM
	FADD L2
	FMUL I TEM
	FADD L1
	FMUL I TEM
	FADD I X1
	FEXT
	JMP I EXIT1
L1,	0
	3777
	7742
L2,	7777
	4000
	4100
L3,	7777
	2517
	0307
L4,	7776
	4113
	7211
/LOGARITHM CONSTANTS
LOG5,	7776
	2535
	3301
LOG6,	7775
	4746
	0771
LOG7,	7774
	2236
	4304
LOG8,	7771
	4544
	1735
TEM,	TEMP
LOG2,	0
	2613
	4414
FLAG1,	0
FNEG,	0
	JMS I MINSKI
	CLA CMA 
	JMP I FNEG
LO,	6213/CIF CDF 10	/********
	JMP XLO		/********
LC,	6213/CIF CDF 10	/********
	JMP XLC		/********
LM,	6213/CIF CDF 10	/********
	JMP XLM		/********
LL,	6213/CIF CDF 10	/********
	JMP XLL		/********
/FLOATING POINT SINE AND COSINE



*5177
FCOS,	FINT		/COS(X)=SIN(/PI/2-X)
	FPUT X
	FGET PIOT
	FSUB X
	FEXT
FSIN,	GETSGN
	SMA SZA CLA 
	JMP MOD
	GETSGN
	SMA CLA 
	RETURN		/YES SIN(0) = 0
	JMS I MINSKI
	CMA 		/NO: SIN(-X)=-SIN(X)
MOD,	DCA T3
	/REDUCE X MODULO 2 PI
	FINT
	FDIV TWOPI
	FPUT XSQR
	FEXT
	JMS I INTEGER
	FINT
	FNOR
	FPUT X
	FGET XSQR
	FSUB X
	FMUL TWOPI
	FPUT X
	FSUB PI		/X < PI ?
	FEXT
	GETSGN
	SPA CLA 
	JMP PCHECK	/YES
	FINT		/NO, SIN(X-PI) = -SIN(X)
	FPUT X
	FEXT
	TAD T3		/INVERT THE SIGN
	CMA 
	DCA T3
PCHECK,	FINT		/X < PI/2 ?
	FGET X
	FSUB PIOT
	FEXT
	GETSGN
	SPA CLA 
	JMP PALG	/YES
	FINT		/NO
	FGET PI		/SIN(X) = SIN(PI-X)
	FSUB X
	FPUT X
	FEXT
PALG,	FINT
	FGET X
	FDIV PIOT
	FPUT X
	FMUL X
	FPUT XSQR
	FGET C9
	FMUL XSQR
	FADD C7
	FMUL XSQR
	FADD C5
	FMUL XSQR
	FADD C3
	FMUL XSQR
	FADD PIOT
	FMUL X
	FEXT
EXIT2,	ISZ T3
	RETURN
	JMS I MINSKI
	RETURN
/CONSTANTS AND POINTERS
TWOPI,	0003
	3110
	3756
	3235
PI,	0002
	3110
	3756
	3235
PIOT,	0001
	3110
	3756
	3235
X,	0000
	0000
	0000
	0000
XSQR,	0000
	0000
	0000
	0000
/SINE CONSTANTS
C9,	7764
	2401
	7015
	1042
C7,	7771
	5464
	5514
	6150
C5,	7775
	2431
	5361
	4736
C3,	0000
	5325
	0414
	3167
/END OF EXTENDED FUNCTIONS
/
/HANDLES O I, EXPRESSION
/SETS CLOCK ACCORDING TO EXPRESSION
/
SETCLK,	PUSHJ		/********
	EVAL-1		/********
	FINT		/********
	FMUL MHUNDRD	/********
	FEXT		/********
	CLLR		/********
	CLEN		/********
	JMS I INTEGER	/********
	CLAB		/********
	CLA 		/********
	TAD C100	/********
	CLLR		/********
	TAD C200	/********
	CLEN		/********
	TAD O4600	/********
	CLLR		/********
	CLA 		/********
	JMP I .+1	/********
	PROC		/********
O4600,	4600		/********
MHUNDRD,7;4700;0	/********
/PAGE 1 - INPUT/OUTPUT ROUTINES FOR THE FOCAL
/FLOATING POINT PACKAGE.
/IN THE COMMENTS BELOW:
/ F = NUMBER OF DIGITS TO BE OUTPUT	= FISW
/ D = NUMBER OF DECIMAL PLACES		= DECP
/ E = DECIMAL EXPONENT			= BEXP
/ P = NUMBER OF PLACES REMAINING TO BE
/     PRINTED BEFORE DECIMAL POINT
*5400
DIGITS=6	/NUMBER OF DECIMAL DIGITS OUT
TGO,	0
	DCA SCOUNT	/SAVE MAX. NUMBER OF DIGITS AVAILABLE - *SET COUNTS*
	TAD FISW
	RTL6
	AND P77
	DCA T1
	TAD T1
	CIA		/NO, COMPUTE FIELD SIZES
	SNA 
	TAD MD
	DCA FCOUNT
	TAD FISW	/(JMP FPRNT) = FOR NO ROUNDING.
	SNA 		/FLOATING OUTPUT?
	JMP R6		/YES, ROUND OFF TO MAX. NO. OF PLACES
	AND P77
	DCA DECP
	TAD FCOUNT
	TAD DECP
	SPA 		/ F-D > 0 ?
	JMP .+5		/YES
	CLA CMA 	/NO.
	TAD T1
	DCA DECP	/MAKE D = F-1
	CMA 
	TAD T3		/COMPARE DECIMAL EXPONENT
	SMA 		/ F-D > E ?
	CLA 		/NO, ROUND OFF TO .F PLACES
	TAD T1		/YES
	SPA 		/ D+E < 0 ?
	JMP FPRNT-2	/YES, NO ROUNDING NEEDED. GO TO PRINT
	TAD MD		/NO, ROUND TO D+E PLACES,
	SMA 		/TO A MAXIMUM OF D PLACES
	CLA 
R6,	TAD RND2	/ *ROUND UP*
	DCA T2		/SAVE NUMBER+1 OF PLACES TO ROUND TO.
	TAD I BUFST
	TAD T2		/SET UP BUFFER ADDRESS AT WHICH
	DCA PLCE	/ROUNDING SHOULD START
	TAD T2
	CIA		/SET UP COUNT OF MAXIMUM NUMBER
	DCA T2		/OF CARRIES ALLOWABLE
	TAD K5		/LITTLE EXTRA ON FIRST DIGIT.
RET,	ISZ I PLCE	/ADD ONE TO DIGIT AT CURRENT POSITION
	TAD I PLCE
	TAD OM12
	SPA CLA 	/CARRY REQUIRED?
	JMP FPRNT	/NO, GO TO OUTPUT
	DCA I PLCE	/YES, MAKE CURRENT DIGIT ZERO
	ISZ T2		/BEGINNING OF BUFFER REACHED?
	JMP DECR	/NO, DECREMENT BUFFER ADDRESS AND REPEAT
	ISZ I PLCE	/YES, SET MANTISSA TO 0.1
	ISZ T3		/COMPENSATE BY INCREMENTING EXPONENT
	CLA 
FPRNT,	TAD FISW	/AUTO-INDEX REGISTER ALREADY SET. - *PRINT*
	SNA CLA 	/ F = 0 ?
	JMP FLOUT	/YES, OUTPUT AS FLOATING NUMBER
	TAD FCOUNT
	TAD T3
	SMA SZA 	/ E > F ?
	JMP FLOUT-1	/YES, CONVERT TO E FORMAT
	TAD DECP
	SMA 		/ E < F-D ?
	CLA 		/NO, TAKE P = E
	CIA		/YES, TAKE P = F-D
	TAD T3
	CIA
	DCA T1		/SET UP MINUS P
BACK,	TAD T3		/PRINT DD.DDD
	TAD T1
	SNA CLA 	/ P = E ?
	JMP DIG		/YES, PRINT DIGIT
	TAD T1		/NO.
	IAC
	SPA CLA 	/ P > 1 ?
	TAD M20		/YES, TAKE SPACE (240-260); OTHERWIZE ZERO
IN,	JMS OUTA	/PRINT CHARACTER
	ISZ T1		/P CHARACTERS PRINTED?
	JMP BACK	/NO
	TAD PER		/YES.
	PRINTC		/PRINT DECIMAL POINT
	JMP BACK
DECR,	CMA		/BACKUP TO TOP OF BUFFER.
	TAD PLCE
	DCA PLCE
	JMP RET
K5,	5
MD,	-DIGITS
RND2,	DIGITS+1
OM12,	-12
BUFST,	SADR
OPUT,	OUTDG
DECP,	0		/MODIFIABLE LOCATIONS
SCOUNT,	0
FCOUNT,	0
PLCE=.
OUTA,	0		/MODIFIED REGISTERS.
	JMS I OPUT	/PRINT CHARACTER
	ISZ FCOUNT	/F CHARACTERS PRINTED?
	JMP I OUTA	/NO, RETURN
	JMP I TGO	/YES, NUMBER FINISHED
DIG,	CMA
	TAD T3		/REDUCE E, BY 1
	DCA T3
	ISZ SCOUNT	/ARE ALL SIG. FIGS. USED?
	JMP .+4		/NO
	CMA 		/YES.
	DCA SCOUNT	/RESET COUNT TO -1
	JMP IN		/AND LEAVE C(AC) = 0
	TAD I FLTXR	/TAKE NEXT DIGIT FROM BUFFER
	JMP IN
/DO FLOATING OUTPUT
	CLA 		/IF OUTPUT TOO LARGE.
FLOUT,	JMS I OPUT	/PRINT "0"
	TAD PER
	PRINTC		/PRINT "."
	ISZ TGO		/SECOND RETURN
	TAD I FLTXR	/TAKE NEXT DIGIT FROM BUFFER
	JMS OUTA	/PRINT IT
	ISZ SCOUNT	/TEST FOR END OF INPUT
	JMP .-3		/AND REPEAT
	CMA 
	DCA SCOUNT	/OUTPUT EXTRA ZEROS.
	JMP .-5
ABSOLV,	0
	TAD HORD
	DCA SIGNF
	TAD HORD
	SPA CLA 
	JMS I MINSKI
	JMP I ABSOLV
/DOUBLE PRECISION DECIMAL-BINARY
/INPUT AND CONVERSION FOR + OR - XXX...
*5600
DECONV,	0
	DCA LORD
	DCA EXP		/ZERO THE EXPONENT AND
	DCA HORD	/INITIALIZE FLOATING AC.
	DCA OVER2
	DCA DNUMBR
	DCA SIGNF
	TAD CHAR	/ALLOW KEYBOARD SIGN CHECKS.
	TAD MPLUS
	SNA 
	JMP .+6		/+SIGN; GET NEXT
	TAD M2		/CHECK - SIGN
	SZA CLA 
	JMP .+4
	CMA 		/INIT SIGN CHECK TO POS.
	DCA SIGNF
	JMS I XINPUT	/GET NEXT
	TAD CHAR	/A SPACE PERHAPS?
	TAD MSPACE
	SNA CLA 
	JMP .-4
	JMS DECON
	JMP I DECONV
DECON,	0
	TAD CHAR	/TEST LEAD CHARACTER FOR TERMINATOR
	TAD MINE
	SNA CLA 
	JMP I DECON	/E
	TESTN
	JMP I DECON	/.
	JMP DTST	/OTHER
	TAD SORTCN	/N
DSAVE,	DCA DIGIT	/YES
	JMS MULT10	/REMAIN MUST =0 SINCE OVERFLOW IS CHECKED
	ISZ DNUMBR	/COUNT DIGITS
	SZA CLA 
	ERROR2		/INPUT-OVERFLOW ERROR
	JMS I XINPUT
	JMP DECON+1	/CONTINUE
DTST,	TAD CHAR	/ALLOW A-Z
	TAD MINUSA
	SPA CLA 
	JMP I DECON
	TAD CHAR
	TAD MINUSZ
	SZA SMA CLA 
	JMP I DECON	/USE SIX BITS OF ASCII
	TAD CHAR
	AND P77
	JMP DSAVE
MINE,	-305	/(7532) - FOR AMPERSAND
MINUSZ,	-332
MPLUS,	-253
MSPACE,	-240
XINPUT,	INPUT
MULT10,	0	/ROUTINE TO MULTIPLY FLAC BY TEN (10)
	TAD OVER2
	DCA OVER1
	TAD LORD	/DOUBLE PRECISION WORD
	DCA AC1L	/BY TEN (DECIMAL)
	TAD HORD	/REMAIN=REMAINDER
	DCA AC1H
	DCA REMAIN	/CLEAR OVERFLOW WORD
	JMS MULT2	/CALL SUBROUTINE TO
	JMS MULT2	/MULTIPLY BY TWO
	JMS DUBLAD	/CALL DOUBLE ADD
	JMS MULT2
	TAD DIGIT	/ADD LAST DIGIT RECEIVED
	DCA OVER1
	DCA AC1L
	DCA AC1H
	JMS DUBLAD
	TAD REMAIN	/EXIT WITH REMAINDER
	JMP I MULT10	/IN AC
REMAIN,	0
DIGIT,	0	/STORAGE FOR DIGIT
DNUMBR,	0	/=NUMBER OF DIGITS
MULT2,	0	/MULTIPLY OVER2, LORD, HORD BY 2
	TAD OVER2
	CLL RAL 	/CARRY INSERT BIT IS IN LINK
	DCA OVER2
	TAD LORD
	RAL 
	DCA LORD
	TAD HORD
	RAL 
	DCA HORD
	TAD REMAIN
	RAL 
	DCA REMAIN
	JMP I MULT2
DUBLAD,	0	/TRIPLE PRECISION ADDITION
	CLA CLL 
	TAD OVER2
	TAD OVER1
	DCA OVER2
	RAL 
	TAD LORD
	TAD AC1L
	DCA LORD
	RAL 
	TAD HORD
	TAD AC1H
	DCA HORD
	RAL 
	TAD REMAIN	/WITH OVERFLOW
	DCA REMAIN
	JMP I DUBLAD
DIV1,	0	/SHIFT OPERAND RIGHT
	CLA CLL 	/TRIPLE PRECISION
	TAD AC1H
	SPA 
	CLL CML 
	RAR 
	DCA AC1H
	TAD AC1L
	RAR 
	DCA AC1L
	TAD OVER1
	RAR 
	DCA OVER1
	ISZ EX1
	JMP I DIV1
	JMP I DIV1
FSSERR,	ERROR4	/********( SUBSCRIPT ERROR FOR FILE VARIABLE-OR NOT DEFINED)
*6000
/FLOATING OUTPUT CONVERSION ROUTINE
FLOUTP,	0
	SKP CLA 	/******** GETS RID OF = IN PRINTOUT
LMODE
OPTR,	6377		/********
PMODE
	TAD HORD	/NUMBER > 0 ?
	SMA CLA 
	TAD SMSP	/PRINT "-" OR A SPACE
	TAD SMIN
	PRINTC
	JMS I ABSOL2
FGO2,	DCA T3		/INITIALIZE DECIMAL EXPONENT
	TAD EXP		/IS EXP 0 TO 4?
	SPA 
	JMP FGO3	/TOO LARGE; MULTIPLY BY 1/10
	SZA 
	TAD M4
	SNA SPA CLA 
	JMP FGO4
	FINT
	FMUL I PPTEN
	FEXT
	IAC
	TAD T3
	JMP FGO2
FGO3,	FINT
	FMUL I TENPT
	FEXT
	CMA 
	JMP .-6
FGO4,	DCA I DPT	/MULTIPLY BY TWO TO POSITION BIT 0
	DCA I REPT	/CLEAR OVERFLOW WORD
	TAD SADR	/INIT BUFFER POINTER
	DCA FLTXR
	TAD EXP		/COMPUT BITS IN 1ST DIGIT
	CMA CLL
	DCA OUTDG	/TEMP COUNT
	TAD DCOUNT	/SETUP COUNT OF TOTAL OUTPUT
	DCA EXP
	JMS I DOUBLE	/ROTATE OUT THE 1ST 4 BITS
	ISZ OUTDG
	JMP .-2
	TAD I REPT	/TEST FOR 10-15, 0, 1-9
	SNA 
	JMP FGO5	/IGNORE FIRST ZERO
	TAD FM12
	SPA CLA 
	JMP .+7		/0-9
	IAC
	DCA I FLTXR	/OUTPUT A 1
	ISZ EXP		/COUNT THE DIGIT
	TAD FM12	/CORRECT REMAINDER
	ISZ T3		/BUMP DECIMAL EXPONENT
	NOP
	TAD I REPT	/COMPUT RESULTANT OR SECOND DIGIT
	ISZ T3
	NOP
	SKP
FGO5,	JMS I M10PT	/IE. .672X10 = 6 + .72, ETC.
	DCA I FLTXR
	ISZ EXP		/ALL DIGITS OUTPUT?
	JMP .-3		/NO; CONTINUE
	TAD SADR	/INIT BUFFER POINTER
	DCA FLTXR
	TAD DCOUNT
	JMS I ROUND	/OUTPUT MANTISSA
	JMP I FLOUTP	/FIXED POINT DONE
	TAD CHRT	/PRINT "E"
	PRINTC
/OUTPUT THE EXPONENT
	TAD T3		/TAKE ABSOLUTE VALUE OF EXPONENT
	SPA 
	CIA
	DCA HORD	/SAVE * POWER
	TAD T3		/PRINT SIGN
	SMA CLA 
	TAD M2
	TAD SMIN
	PRINTC
	TAD HORD
	ISZ EXP
	TAD M144
	SMA 
	JMP .-3
	TAD C144
	DCA HORD	/SAVE TENS AND UNITS
	CMA 		/OUTPUT HUNDREDS
	TAD EXP
	SZA 		/UNLESS ZERO
	JMS OUTDG
	TAD HORD	/PRINT TWO DIGITS
	JMS I PRNTI
	JMP I FLOUTP
PRNTI,	PRNT
CHRT,	305	/E (0246) - FOR AMPERSAND
SMSP,	240-255	/
PEQ,	275
SMIN,	255
M144,	-144	/-100
C144,	0144	/+100
M4,	-4
FM12,	-12
DCOUNT,	-DIGITS-1	/NUMBER OF DIGITS OUTPUT
PPTEN,	PTEN	/1E1
DPT,	DIGIT
REPT,	REMAIN	/OVERFLOW FROM INTEGER MULTIPLY
M10PT,	MULT10
SADR,	BUFFER-1
ROUND,	TGO	/ACTUAL OUTPUT ROUTINE
TENPT,	TEN
ABSOL2,	ABSOLV
OUTDG,	0	/OUTPUT ONE DIGIT
	TAD C260
	PRINTC
	JMP I OUTDG
RANMUL,	7750;2333;5733	/********
LEPUT,	TAD SUBS2	/******** CALLS STORING ROUTINE FOR
	DCA SUBS	/******** S FN(X)=
	TAD LESUB2	/********
	DCA LESUBS	/********
	TAD LWETMP	/********
	6212/CIF 10	/********
	JMS I STORIT	/********
	ISZ I 7		/********
	JMP I .+1	/********
	FPNT+1		/********
STORIT,	ITSTOR		/********
LS,	6213/CIF CDF 10	/******** LIBRARY SAVE
	JMP XLS		/********
/USED BY 8K
/FLOATING POINT INPUT
*6200
FLINTP,	0		/IF C(AC) = 0, USE CHAR
	SZA CLA		/IF C(AC) NON-ZERO, GET NEXT
	JMS I XIN	/GET FIRST CHAR
	TAD CHAR	/IGNORE LEADING SPACES
	TAD M240
	SNA CLA 
	JMP .-4
	JMS I DPCVPT	/READ FIRST DIGIT GROUP
	TAD CHAR	/AND SET "SIGNF"
	TAD MPER
	SZA CLA 	/ENDED BY PERIOD?
	JMP FIG01
	JMS I XIN	/READ 2ND GROUP
	DCA I DPN
	JMS I DCONP
	TAD I DPN	/SAVE NUMBER OF DIGITS IN T3
	CMA IAC
FIG01,	DCA T3		/NO.
	TAD P43
	DCA FLAC
	JMS I RESOL5
	JMS I INORM	/NORMALIZE FIRST. THEN
	FINT
	FPUT I PT1	/SAVE NUMBER
	FEXT
	TAD CHAR
	TAD MINUSE
	SZA CLA 	/"E" READ IN?
	JMP ENDFI+3	/NO
	JMS I XIN	/YES. READ 3RD DIGIT GROUP
	JMS I DPCVPT	/I.E. CONVERT DECIMAL EXPONENT
	JMS I RESOL5
	TAD OVER2
	TAD T3		/C(SEXP) PLACES TO RIGHT
	DCA T3
/COMPENSATE FOR DECIMAL EXPONENTS
ENDFI,	FINT		/RESTORE MANTISSA
	FGET I PT1
	FEXT
	TAD T3		/TEST DECIMAL EXPONENT
	SNA 
	JMP I FLINTP	/FINISHED
	SMA CLA 
	JMP FIG04
	FINT		/. IS TO THE LEFT
	FMUL PTEN	/TIMES .1000
	FPUT I PT1
	FEXT
	IAC
	JMP .+6
FIG04,	FINT		/. IS TO THE RIGHT
	FMUL TEN	/MULTIPLY BY 10
	FPUT I PT1
	FEXT
	CMA 
	TAD T3
	DCA T3
	JMP ENDFI+3
TEN,	0004
	2400
	0000
	0000
PTEN,	7775
	3146
	3147	/(3146) - FOR 4-WORD
	3150
MINUSE,	-305	/(7532) - FOR AMPERSAND
DPCVPT,	DECONV
DCONP,	DECON
RESOL5,	RESOLV
DPN,	DNUMBR
XIN,	INPUT
INORM,	DNORM
P43,	43
/END OF FLOATING POINT INPUT
/7 FREE
/USED BY H.S. READER



/
/CALLS LOADING ROUTINE FOR FILE
/VARIABLES IN EXPRESSIONS; CALLED BY EFUN3I
/
*6311			/********
FNUM,	TAD CHAR	/********
	DCA EFOP	/********
	GETC		/********
	SORTC		/********
	TERMS-1		/********
	SKP 		/********
	JMP .-4		/********
	TSTLPR		/********
	ERROR4		/********
	JMS I PECALL	/********
	JMS I INTEGER	/********
	DCA SUBS	/********
	TAD HORD	/********
	DCA LESUBS	/********
	POPA		/********
	6212/CIF 10	/******** FILE NO.
	JMS I LOADIT	/********
	JMP I EFUN3I	/********
LOADIT,	ITLOAD		/********
PECALL,	ECALL		/********
PASS,	0
	GETC
	TAD CHAR
	PUSHA
	GETC
	SORTC
	GLIST-1
	JMP I PASS
	JMP .-4
LTAPE,	JMS PASS
	TAD CHAR	/********
	TAD MINCOM	/********
	SZA CLA 	/********
	JMP LERR	/********
	POPA		/********
	SORTJ		/******** JMPS ON SUBCOMMAND OF LIBR XXXX
	LLIST-1		/********
	LGO-LLIST	/********
LERR,	ERROR4		/********
LGO,	LO		/********
	LC		/********
	LM		/********
	LL		/********
	LS		/********
	LG		/********
LLIST,	317		/********
	303		/********
	315		/********
	314		/********
	323		/********
	307		/********
MINCOM,	-254		/********
LG,	6213		/********
	JMP XLG
*6400
/ FLOATING POINT INTERPRETER FOR FOCAL.
FPNT,	0
	CLA CLL 
	DCA OVER2	/(NOP) - FOR 4-WORD
	DCA OVER1	/(NOP) - FOR 4-WORD
	TAD I FPNT	/GET NEXT INSTRUCTION
	SNA 
	JMP I FPNT	/FAST EXIT
	DCA JUMP
	TAD JUMP
	AND C200	/GET PAGE BIT
	SNA CLA 	/PAGE ZERO?
	JMP .+3		/YES
	TAD P7600	/NO
	AND FPNT	/C(FPNT)0-4 CONTAINS PAGE BITS
	DCA ADDR
	TAD P177	/GET 7 BIT ADDRESS
	AND JUMP
	TAD ADDR
	DCA ADDR
	TAD INDRCT	/INDIRECT BIT=1?
	AND JUMP
	SNA CLA 
	JMP LOOP01	/NO - GO ON
	TAD I ADDR	/YES; DEFER, W/O AUTO-INDEX
	SNA 		/******** IF PT1 WAS ZERO, IT IS A
	JMP I LEFPUT	/******** FILE VARIABLE
	DCA ADDR
LOOP01,	ISZ FPNT
	CMA 
	TAD ADDR
	DCA FLTXR2
	TAD JUMP	/GET COMMAND
	CLL RTL 
	RTL 
	AND P17		/GET BITS 0-2: IE OPCODE
	SNA 
	JMP FLGT
	TAD TABLE	/LOOKUP IN TABLE
	DCA JUMP
	TAD I JUMP
	SNA 
	JMP FLPT
	DCA JUMP
	TAD CEX1	/SAVE FLOATING ARGUMENT, UNLESS 'GET' OR 'PUT'
	DCA FLTXR
	TAD MFLT
	DCA CNTR
	TAD I FLTXR2
	DCA I FLTXR
	ISZ CNTR
	JMP .-3
	JMP I JUMP	/GO THERE
JUMP,	0
ADDR=EX1
INDRCT,	0400
TABLE,	ITABLE
FLPT,	TAD CEXP	/EXP TO (ADDR)
	JMP .+5
FLGT,	TAD CEXP	/(ADDR) TO EXP
	DCA FLTXR2
	CMA 
	TAD ADDR
	DCA FLTXR	/SAVE 'FROM' ADDRESS
	TAD MFLT	/3 OR 4 WORDS
	DCA CNTR
	TAD I FLTXR
	DCA I FLTXR2
	ISZ CNTR
	JMP .-3
	JMP FPNT+1
CEXP,	EXP-1
CEX1,	EX1-1
FLSU,	JMS I OPMINS	/FSUB=2 - NEGATE THE OPERAND
FLAD,	JMS I ALGN	/FADD=1 - FIRST ALIGN EXPONENTS
	JMP FPNT+1	/RETURN IF NO ALIGNMENT IS POSSIBLE
	JMS I RAR2	/TRIPLE PRECISION ADDITION
	JMS I RAR1	/SINCE BITS ARE SHIFTED
	JMS I TRAD	/RIGHT
NORF,	JMS I NORM	/NORMALIZE THE RESULT
	JMP FPNT+1	/HINT; USE 700X FOR FUNCTIONS.
/INTERPRETIVE POWER
FLEX,	TAD HORD	/ZERO?
	SZA CLA
	JMP .+6
ZERO,	DCA EXP		/YES
	DCA HORD
	DCA LORD
	DCA OVER2
	JMP FPNT+1
	PUSHF		/AC TO A + POWER
	FLAC
	PUSHF		/SETUP ARGUMENT (THE EXPONENT)
	EX1
	POPF
	FLAC
	JMS I INTEGER	/ONLY POSITIVE INTEGER EXPONENTS
	SPA 
	JMP .+5		/(COULD DIVIDE)
	CMA 
	DCA JUMP	/TEMP STORAGE
	DCA OVER1	/(NOP) FOR 4-WORD
	TAD HORD
	SZA CLA 
	ERROR2		/TOO LARGE OR NEGATIVE EXPONENT
	PUSHF		/INITIALIZE TO ONE.
	FLTONE
	POPF
	FLAC
	POPF
	ITER1
	JMP .+6
	PUSHF
	ITER1
	POPF
	EX1
	JMS I MULT	/"MULT"
	ISZ JUMP
	JMP .-6
	JMP FPNT+1
FLMY,	JMS I MULT	/"MULTIPLY"
	JMP FPNT+1
OPMINS,	MINUS2
MULT,	DMULT
NORM,	DNORM
ALGN,	ALIGN
RAR1,	DIV1
RAR2,	DIV2
TRAD,	DUBLAD
ITABLE=.-1
	FLAD
	FLSU
	FLDV
	FLMY
	FLEX
	0000
	NORF
ACMINS,	0	/ROUTINE TO COMPLEMENT FLAC - VIA "MINSKI"
	CLA 		/********(IS THIS CLA NECESSARY?)
	TAD OVER2	/******** RECODING FOR SPACE
	CLL CML CIA	/********
	DCA OVER2	/********
	RAL 		/********
	TAD LORD	/********
	CML CIA		/********
	DCA LORD	/********
	RAL 		/********
	TAD HORD	/********
	CML CIA		/********
	DCA HORD	/********
	JMP I ACMINS
ALIGN,	0	/SUBROUTINE TO ALIGN
	TAD HORD	/BINARY POINTS
	SNA 
	TAD LORD	/IS MANTISSA ZERO?
	SNA CLA 
	JMP NOX1	/YES. RESULT=OPERAND
	TAD AC1H	/NO, IS OPERAND ZERO?
	SNA 
	TAD AC1L
	SNA 
	TAD OVER1
	SNA CLA 
	JMP I ALIGN	/YES. EXIT.
	TAD EX1
	CMA IAC
	TAD EXP
	SNA 		/ARE EXPONENTS EQUAL?
	JMP ADONE	/YES
	DCA ACMINS
	TAD ACMINS
	SMA 		/NO
	CIA		/NEGATE AND
	DCA AMOUNT	/SAVE THE DIFFERENCE
	TAD AMOUNT
	TAD TEST2
	SPA CLA 	/CAN EXPONENTS BE ALIGNED?
	JMP NOX		/NO. USE LARGER OF THE TWO.
	TAD ACMINS	/YES, SHIFT THE SMALLER
	SMA CLA 
	JMP ASHFT
	JMS DIV2
	ISZ AMOUNT
	JMP .-2
	JMP ADONE
ASHFT,	CMA
	TAD EX1
	DCA EX1
	JMS I TAG1
	ISZ AMOUNT
	JMP .-2
ADONE,	ISZ ALIGN
	JMP I ALIGN
NOX,	TAD EX1		/MISSION IMPOSSIBLE!
	SMA CLA 	/CHECK FOR SIGN DIFFERENCE
	JMP NOX2
	TAD EXP
	SMA CLA 
	JMP I ALIGN	/-+
	JMP .+3		/--
NOX2,	TAD EXP
	SMA CLA 
	TAD ACMINS	/TEMP STORAGE OF DIFFERENCE. BOTH POS EXP OR BOTH NEG.
	SMA SZA CLA 
	JMP I ALIGN	/OK (+-)
NOX1,	TAD EX1		/USE LARGER
	DCA EXP
	TAD AC1H
	DCA HORD
	TAD AC1L
	DCA LORD
	TAD OVER1
	DCA OVER2
	JMP I ALIGN
AMOUNT,	0
TAG1,	DIV1
/LEAVE 12 BIT ANSWER IN AC UPON RETURN
/LEAVE FLAC AS AN INTEGER.
FIX,	0		/VIA (INTEGER)
	JMS I ABSOL
	TAD EXP		/TEST FOR FRACTION
	SPA SNA CLA 
	JMP FIXM	/DOUBLE CHECK FOR MINUS ONE.
	IAC
	DCA OVER1
	TAD P27		/INIT ALIGNMENT
	DCA EX1
	JMS ALIGN	/DO THE ALIGNMENT TO AN INTEGER
TEST2,	0027		/ALREAD DONE; (43) - FOR 4-WORD
	ISZ OVER2
	JMP .+4
	ISZ LORD
	SKP 
	ISZ HORD
	DCA OVER2	/CLEAR THE FRACTION
	JMS I RESOL
	TAD LORD	/EXIT WITH LOW ORDER RESULT IN AC
	JMP I FIX
P27,	27
ABSOL,	ABSOLV
RESOL,	RESOLV
FIXM,	DCA EXP		/CLEAR EXPONENT
	DCA HORD
	DCA LORD
	JMP TEST2+6
DIV2,	0	/SHIFT FLAC RIGHT
	CLA CLL 
	TAD HORD
	SPA 
	CML 
	RAR 
	DCA HORD
	TAD LORD
	RAR 
	DCA LORD
	TAD OVER2
	RAR 
	DCA OVER2
	ISZ EXP
	JMP I DIV2
	JMP I DIV2
SPECIAL=.	/INPUT CHARACTERS
	337	/LEFT ARROW
	377	/RUBOUT
	212	/L.F.
	375	/ALT MODE
	-1
/(A+B+C)*(D+E+F) = A*D, A*E, B*D, E*E
DMULT,	0	/N-PRECISION MULTIPLY WITH
	IAC	/PRODUCT IN TRIPLE PRECISION
	TAD EX1		/ADD EXPONENTS+1
	JMS SIGN	/AND DETERMINE SIGN OF RESULT
	SPA CLA 
	JMS MINUS2
	DCA DATUM-1	/INITIALIZE RESULT
	DCA DATUM-2
	DCA DATUM-3
	DCA DATUM-4
	TAD A		/A*D
	SAVE		/STORE IN MP2
	TAD D		/SIGNLE PRECISION MULTIPLY
	MULTY
	2		/ACCUMULATE STARTING IN #2 DATA WORD
	TAD E		/A*E
	MULTY
	3
	TAD B		/B*D
	SAVE
	TAD D
	MULTY
	3
	TAD E		/B*E
	MULTY
	4
DMULT4,	JMP DMDONE	/(DCA DATUM+5) FOR 4-WORD
	DCA DATUM-6
	TAD F		/A*F
	SAVE
	TAD A
	MULTY
	4
	TAD B		/B*F
	MULTY
	5
	TAD C		/C*D
	SAVE
	TAD D
	MULTY
	4
	TAD E		/C*E
	MULTY
	5
	TAD F		/C*F
	MULTY
	6
DMDONE,	TAD DATUM-1	/COPY RESULT
	DCA HORD
	TAD DATUM-2
	DCA LORD
	TAD DATUM-3
	DCA OVER2
	JMS MULDIV
	DCA OVER2	/(NOP) FOR 4-WORD
	JMP I DMULT
DATUM=.+6	/INTERMEDIATE STORAGE
	0/#6 - LOW ORDER RESULT
	0/#5
	0/#4
	0/#3
	0/#2
	 /#1 - HIGH ORDER RESULT
MULDIV,	0	/TERMINATE MULTIPLY AND DIVIDE.
	ISZ SIGNF	/CORRECT FOR SIGN
	JMS I MINSKI
	JMS I NORMF	/SHIFT LEFT
	ISZ OVER2/NOP		/*
	JMP I MULDIV
FLDV,	TAD AC1H	/4:DIVIDE
	SNA CLA 
	ERROR2		/DIVISION BY ZERO
	TAD EX1		/SUBTRACT EXPONENTS+1
	CMA IAC
	IAC
	JMS SIGN	/SET UP SIGNS
	SMA CLA 
	JMS MINUS2	/NEGATE DIVISOR
	JMS I DIVIDE	/DIVIDE
	JMS MULDIV
	JMP I .+1
	FPNT+1
/THIS SUBROUTINE PREPARES MULTIPLY AND DIVIDE
/FOR ANY COMBINATION OF SIGNED ARGUMENTS AND FOR ZERO.
/THE RESULT OF EITHER IS ZERO IF FLAC = 0.
/RESULT OF MULTIPLY IS ZERO IF EITHER IS ZERO;
/DIVISION BY ZERO IS CHECKED BEFORE THIS
/ROUTINE IS CALLED.
/THE CALLING AC CONTAINS AN UPDATE VALUE FOR THE
/EXPONENT. THE RETURNING AC CONTAINS THE SIGN OF
/THE ARGUMENT FOR FURTHER TESTING BY EACH ROUTINE.
SIGN,	0		/TEST AND SAVE SIGN OF RESULT
	TAD EXP		/COMPUT NEW EXPONENT FOR MUL-DIV.
	DCA EXP
	TAD P4000	/LOAD 4000 TO XOR THE SIGN BITS
	AND HORD
	TAD AC1H
	SMA CLA 	/RESULT MAY BE ZERO
	CMA 
	DCA SIGNF
	TAD HORD
	SNA 
	JMP I REVIT	/ANSWER IS ZERO.
	SPA CLA 	/TAKE ABSOLUTE VALUE OF FLAC
	JMS I MINSKI
	TAD AC1H
	SNA 		/RESULT EITHER WAY MAY BE ZERO
	JMP I REVIT
	JMP I SIGN
/SIGN OF RESULT - SIGNF
/+=-1
/-=0
REVIT,	ZERO
NORMF,	DNORM
DIVIDE,	DUBDIV
SAVE=DCA I .
	MP2
MULTY=JMS I .
	MP4
A=FLAC+1
B=FLAC+2
C=FLAC+3
D=AC1H
E=AC1L
F=OVER1
MINUS2,	0	/NEGATE OPERAND
	CLA CLL 	/TRIPLE PRECISION
	TAD OVER1
	CMA IAC
	DCA OVER1
	TAD AC1L
	CMA 
	SZL 
	IAC CLL
	DCA AC1L
	TAD AC1H
	CMA 
	SZL 
	IAC CLL 
	DCA AC1H
	JMP I MINUS2
RESOLV,	0
	TAD SIGNF
	SPA CLA
	JMS I MINSKI
	JMP I RESOLV
*7200
MP4,	0	/SINGLE PRECISION. UNSIGNED MULTIPLY - "MULTY"
	SNA 		/NO RESULT ADDED IF ZERO
	JMP I MP4
/FOR EAE INSERT THE FOLLOWING:
/7203	3206	DCA .*3
/7204	1256	TAD MP2
/7205	7425	MQL MUY
/7206	0000	0
/7207	3253	DCA MP5
/7210	7501	MOA
/7211	3255	DCA MP3
/7212	5227	JMP ,*15
	DCA MP1		/12 BITS BY 12 BITS
	DCA MP5
	TAD THIR
	DCA MP3
	CLL 
MP6,	TAD MP1
	RAR 
	DCA MP1
	TAD MP5
	SNL 
	JMP .+3
	CLL 
	TAD MP2
	RAR 
	DCA MP5		/SAVE HIGH ORDER RESULT
	ISZ MP3
	JMP MP6
	TAD MP1		/CORRECT LOW ORDER RESULT
	RAR 
	DCA MP3
	TAD I MP4	/PICK UP SCALE FACTOR
	CIA
	TAD DATUMA	/COMPUTE ADDRESS
	DCA MP1		/TEMP
	TAD MP3		/LOW ORDER PART
	CLL 
	TAD I MP1	/ACCUMULATE
	DCA I MP1
	ISZ MP1
	RAL 
	TAD MP5
	TAD I MP1
	DCA I MP1
	SNL 
	JMP I MP4	/NO CARRY
	ISZ MP1
	ISZ I MP1
	JMP I MP4	/EXIT
	JMP .-3		/CARRY AGAIN
	/////
DATUMA,	DATUM
MP5,	0		/PRODUCT
MP1,	0		/MULTIPLIER
MP3,	0
MP2,	0		/MULTIPLICAND
THIR,	-14		/12 BITS
MIF,	-27		/(-43) FOR 4-WORD (=7735)
DUBDIV,	0	/2 OR 3 PRECISION DIVIDE
	DCA MP4
	DCA MP1
	TAD MIF		/INIT BIT COUNTER
	DCA MP3
	SKP 
DV3,	JMS I DOUBLE	/SHIFT FLAC LEFT
	CLL 
	TAD AC1L	/COMBINE ONE POSITION AND (4-WORD)
	TAD LORD
	DCA MP2		/SAVE RESULT
	RAL 
	TAD HORD	/ADD OVERFLOW
	TAD AC1H
	SNL 		/SKIP IFOVERFLOW
	JMP .+4
	DCA HORD	/UPDATE FLAC
	TAD MP2
	DCA LORD
	CLA 		/CLEAR ACCUMULATOR
	TAD MP1		/SAVE OVERFLOW BITS CIRCULARLY
	RAL 
	DCA MP1
	TAD MP4
	RAL 
	DCA MP4
	ISZ MP3		/TEST FOR END OF DIVIDE
	JMP DV3
	TAD MP1		/LOAD RESULTS
	DCA LORD
	TAD MP4
	DCA HORD
	JMP I DUBDIV	/(NOP) FOR 4-WORD
	RAL 		/EXTRA FOR 4-WORD
	DCA DNORM
	ISZ MP3		/TEST FOR END OF DIVIDE
	JMP DV3
	TAD DNORM
	DCA HORD
	TAD MP4
	DCA LORD
	TAD MP1
	DCA OVER2
	JMP I DUBDIV
DNORM,	0	/SUBROUTINE TO NORNALIZE FLAC
	JMS I ABSOL3
	JMS TEST4
	TAD HORD
	SNA 		/IS MANTISSA = 0?
	TAD OVER2
	SNA 
	TAD LORD
	SNA CLA 
	JMP EXIT3	/YES
	TAD HORD
	CLL RAL 
	SPA CLA 	/WILL SHIFT BE TOO FAR?
	JMP .+6
	JMS I DOUBLE
	CMA CLL
	TAD EXP
	DCA EXP
	JMP .-10
	JMS I RESOL3
	JMS TEST4	/DON'T LEAVE 4000
	JMP I DNORM
EXIT3,	DCA EXP		/SET TO ZERO
	JMP I DNORM
XRAR2,	DIV2
TEST4,	0
	TAD HORD	/TEST FOR 4000
	SPA 
	CIA
	SPA CLA 
	JMS I XRAR2	/SHIFT BACK
	JMP I TEST4
ABSOL3,	ABSOLV
RESOL3,	RESOLV
*7400
/PAGE 18
	/FLOATING SQUARE ROOT FUNCTION
XSQRT,	FINT
	FPUT FPAC1	/VALUE
	FEXT		/NEWTON'S METHOD IS USED
	GETSGN
	SPA CLA
	ERROR2		/NUMBER IS NEGATIVE=IMAGINARY ROOTS
	TAD EXP		/LINK IS =0 FROM FINT
	SPA		/MATCH THE SIGN WITH LINK BIT
	CML
	RAR
	DCA ITER1	/MAKE FIRST APPROXIMATION
	SZL		/TEST LSB OF EXP
	ISZ ITER1
O7000,	NOP		/********
	TAD SQCON1
	DCA ITER1+1
	DCA ITER1+2
	DCA ITER1+3
	TAD FPAC1+1
	SNA
	TAD FPAC1+2
	SNA CLA
	JMP SQEND	/NUMBER=0
CLCU,	FINT
	FGET FPAC1
	FDIV ITER1
	FADD ITER1
	FEXT
	CLA CMA 
	TAD EXP
	DCA EXP
	TAD EXP
	CMA IAC
	TAD ITER1
	SZA CLA 	/ARE EXPONENTS EQUAL?
	JMP ROOTGO	/NO
	TAD HORD	/ARE HIGH-ORDER MANTISSAS EQUAL?
	CMA IAC
	TAD ITER1+1
	SZA CLA 
	JMP ROOTGO	/NO
	TAD LORD
	CMA IAC
	TAD ITER1+2	/DO LOW-ORDER MANTISSAS AGREE
	SMA 
	CMA IAC		/WITHIN ONE BIT?
	IAC
	SMA CLA 
	RETURN
ROOTGO,	FINT
	FPUT ITER1
	FEXT
	JMP CLCU
SQEND,	DCA EXP
	RETURN
SQCON1,	3015
BUFFER=.
ITER1,	0
	0
	0
	0
FPAC1,	0
	0
	0
	BUFFER+13	/ADDRESS OF NEXT FREE LOCATION IN 10-DIGIT VERSION.
	/*7530	/********
SCOPOU,	0		/******** OUTPUT ROUTINE FOR SCOPE
	AND P177	/******** STORES CHARS IN FLD1, LOCS 400-777
	TAD O7763	/********
	SZA 		/********
	JMP NOCRLF	/********
CRLF,	DCA NCOLS	/********
	ISZ NFEEDS	/********
	JMP ITSOK	/********
NOCRLF,	TAD O7655	/********
	CLL 		/********
	TAD C100	/********
	SNL 		/********
	SKP CLA 	/********
	TAD NLINES	/********
	SNA 		/********
	JMP I SCOPOU	/********
	ISZ NCOLS	/********
ITSOK,	IOF		/********
	LINC		/********
LMODE			/********
	LDF 4		/********
	STH I OPTR	/********
	CLR		/********
	PDP		/********
PMODE			/********
	6201		/********
	ISZ NCHARS	/********
	TAD NCHARS	/********
	TAD O7000	/********
	SPA CLA 	/********
	TAD NLINES	/********
	TAD NFEEDS	/********
	SPA CLA 	/********
	JMP NOHANG	/********
	TAD NCHARS	/********
	6213		/******** TOO MANY LINES/CHARS DISPLAYED
	JMS WAITER	/******** HANG ON DISPLAY UNTIL SOMETHING IS TYPED
	KSF 		/********
	JMP .-4		/********
	KRS		/********
	TAD O7575	/********
	SZA CLA 	/********
	KCC		/******** IGNORE LINE FEED
	TAD O6377	/********
	DCA I PPTR	/******** CLEAR
	DCA NCHARS	/******** THE
	DCA NFEEDS	/******** CHARACTER
	DCA NCOLS	/******** DISPLAY
NOHANG,	ION		/********
	TAD NCOLS	/********
	TAD O7716	/********
NLINES,	SMA SZA CLA	/********
	JMP CRLF	/********
	JMP I SCOPOU	/********
NCOLS,	0		/********
NFEEDS,	0		/********
NCHARS,	0		/********
O7763,	7763
O6377,	6377
O7655,	7655		/********
O7575,	7575		/********
O7716,	7716		/********
PPTR,	OPTR		/********
*7576			/********
/
/FDIS FUNCTION: STORES 2 WORDS
/PER CALL IN 2200 THRU 5777 IN FLD1
/
CALLIN,	JMS I INTEGER	/********
	6213		/********
	JMP I .+1	/********
	INCALL		/********
XDISP,	FINT		/********
	FMUL FORHUN	/********
	FEXT		/********
	JMS I INTEGER	/********
	SPA 		/********
	CIA		/********
	DCA STEMP	/********
	TAD CHAR	/********
	TAD MMCOM	/********
	SZA CLA 	/********
	ERROR3		/********
	PUSHJ		/********
	EVAL-1		/********
	FINT		/********
	FMUL FIVHUN	/********
	FEXT		/********
	JMS I INTEGER	/********
	DCA STEMP2	/********
	IOF		/********
	6211		/********
	TAD STEMP	/********
	DCA I SPTR	/********
	ISZ SPTR	/********
	TAD STEMP2	/********
	TAD O7400	/********
	DCA I SPTR	/********
	ISZ SPTR	/********
	TAD SPTR	/********
	TAD MLIMIT	/********
	SNA CLA		/********
	CLA CLL CMA RAL	/********
	TAD SPTR	/********
	DCA SPTR	/********
	CLA CMA 	/********
	DCA I SPTR	/********
	6201/CDF 0	/********
	ION		/********
	JMP I EFUN3I	/********
MLIMIT,	-6000		/******** LAST LOC OF DISP POINTS-1
O7400,	7400		/********
FORHUN,	11;2700		/********
FIVHUN,	11;3770;0	/********
MMCOM,	-254		/********
/
/JMS WAIT IS EQUIVALENT
/TO JMP .-2 WITH A REFRESH OF
/THE DISPLAY ON THE WAY
/
WAIT,	0		/********
	CLA CLL CMA RTL	/********
	TAD WAIT	/********
	DCA WAIT	/********
	IOF		/********
	TAD I PNCHARS	/********
	6213/CIF CDF 10	/********
	JMS WAITER	/********
	ION		/********
	JMP I WAIT	/********
SPTR,	1000		/********
CLEAR,	0		/******** CLEAR POINTS FROM THE SCOPE
	TAD ODISSP	/********
	DCA SPTR	/********
	IOF		/********
	6211/CDF 10	/********
	CLA CMA 	/********
	DCA I SPTR	/********
	6201/CDF 0	/********
	ION		/********
	JMP I CLEAR	/********
ODISSP,	2200		/******** FIRST LOC OF DISP POINTS
PPASS,	PASS		/********
OUTPUT,	JMS I PPASS	/********
	POPA		/******** JUMPS ON SUBCOMMAND OF OUTPUT XXX
	SORTJ		/********
	OLIST-1		/********
	OGO-OLIST	/********
OERROR,	ERROR3		/********
OGO,	OC		/********
	OD		/********
	OE		/********
	OS		/********
	OT		/********
	OI		/********
OLIST,	303		/********
	304		/********
	305		/********
	323		/********
	324		/********
	311		/********
OO6377,	6377		/********
OEXIT,	PROC		/********
PNCHARS,NCHARS		/********
POPTR,	OPTR		/********
OI,	TAD CHAR	/********
	TAD MMCOM	/********
	SNA CLA 	/********
	JMP I PSETCLK	/******** O I, EXPRESSION
	ISZ I PCLKFLG	/********
	TAD I PCLKFLG	/********
	SZA CLA 	/********
	JMS WAIT	/********
	JMP I OEXIT	/********
PCLKFLF,CLKFLG		/********
PSETCLK,SETCLK		/********
*7750			/********
STEMP,	0		/********
STEMP2,	0		/********
OC,	JMS I PCLEAR	/********
OE,	DCA I PNCHARS	/********
	TAD OO6377	/********
	DCA I POPTR	/********
	DCA I PNFEED	/********
	DCA I PNCOLS	/********
	JMP I OEXIT	/********
OD,	NOP		/********
	JMS WAIT	/********
OS,	IOF		/********
	6141/LINC	/********
	0004/ESF	/********
	0002/PDP	/********
	ION		/********
	TAD PSCOPOU	/******** SET OUTDEV TO SCOPOU
OT,	TAD PXOUTL	/******** SET OUTDEV TO XOUTL
	DCA OUTDEV	/********
	JMP I OEXIT	/********
PXOUTL,	XOUTL		/********
PSCOPO,	SCOPOU-XOUTL	/********
PNCOLS,	NCOLS		/********
PNFEED,	NFEEDS		/********
	FIELD	1	/********
*1			/********
XQ,	0		/********
D256,	400		/(REFERENCED AS LOC 2)
O200,	200		/(REFERENCED AS LOC 3)
D85,	125		/(REFERENCED AS LOC 4)
GAMMA,	0		/********
CHRCNT,	0		/********
O360,	360		/********
*10			/********
XR1,	0		/********
BLK2,	0		/UNIT
	0		/ADDRESS
	0		/BLOCK NUNBER
	1		/NUMBER OF BLOCKS
O760,	760		/********
ALPHA,	0		/********
BETA,	0		/********
*20			/********
/
/ENTERED WITH NO. CHARS IN AC; REFRESH
/FOR CHARS AND POINTS
/
WAITER,	0		/********
	SNA		/********
	JMP NOASCII	/********
	CMA 		/********
	DCA CHRCNT	/********
	TAD O4377	/********
	DCA GAMMA	/********
	TAD O360	/********
	DCA Y		/********
	DCA XQ		/********
	LINC		/********
LMODE			/********
CHRLUP,	LDH I GAMMA	/********
	AZE		/********
	JMP GOODY	/********
	ADD Y		/********
	ADD O760	/********
	BCL I		/********
	7000		/********
	STC Y		/********
	STC XQ		/********
	JMP CHREND	/********
GOODY,	ROL 1		/********
	ADD O200	/********
	STC ALPHA	/********
	ADD Y		/********
	DSC ALPHA	/********
	DSC I ALPHA	/********
	XSK I XQ	/********
	XSK I XQ	/********
	CLR		/********
CHREND,	XSK I CHRCNT	/********
	JMP CHRLUP	/******** ONE TIME PER CHAR
	SKP		/********
NOASCII,LINC		/********
	SET I BETA	/********
	2200		/********
	LDF 5		/********
	JMP SUBR	/********
	SET I BETA	/********
	2000		/********
	LDF 6		/********
	JMP SUBR	/********
WEXIT,	PDP		/********
PMODE			/********
	6203/CIF CDF 0	/********
	CLA 		/********
	JMP I WAITER	/********
O4377,	4377		/********
Y,	0		/********
PSUBS,	SUBS		/********
PLESUB,	LESUBS		/********
LMODE			/********
SUBR,	SET ALPHA	/******** DISPLAYS POINTS
	0000		/********
	KST		/********
	SKP		/********
	JMP WEXIT	/********
	IOB		/********
	TSF		/********
	SKP		/********
	JMP WEXIT	/********
	LDA BETA	/********
	SKP		/********
WAITLP,	LDA I BETA	/********
	APO		/********
	JMP WEXIT	/********
	STC GAMMA	/********
	LDA I BETA	/********
	DIS GAMMA	/********
	XSK BETA	/********
	JMP WAITLP	/********
	JMP ALPHA	/********
PMODE			/********
XLO,	JMP I .+1	/********
	LOPEN		/********
XLC,	JMP I .+1	/********
	LCLOSE		/********
XLM,	JMP I .+1	/********
	LMAKE		/********
XLL,	JMP I .+1	/********
	LLOAD		/********
XLS,	JMP I .+1	/********
	LSAVE		/********
XLG,	JMP I .+1	/********
	LCHAIN		/********
X7774,	7774
X7775,	7775
PLNUM,	LNUM
PGETRHS,GETRHS
PLDMILD,LDMILD
P5LNAM,	LNAME+5	
P6LNAM,	LNAME+6
CHFLAG,	0
HISS,	0
LOSS,	0
PFILTAB,FILTAB
PLOOKUP,LUKUP
PCOMMON,COMMON
PREPLAC,REPLACE
MYTEMP,	0
MYTMP2,	0
PFINISH,FINISH
SWITCH,	0
SWTMP,	0
PB1FLG,	B1FLG-1
MYAC1,	0
MYAC2,	0
MYAC3,	0
P1FLAC,	FLAC
P2FLAC,	FLAC+1
P3FLAC,	FLAC+2
O7764,	7764
O6000,	6000
	0
*177
FERROR,	6203
	JMP I .+1
	FSSERR
*202
CHARTAB=.-2
	4477;7744	/ A
	5177;2651	/ B
	4136;2241	/ C
	4177;3641	/ D
	4577;4145	/ E
	4477;4044	/ F
	4136;2645	/ G
	1077;7710	/ H
	7741;0041	/ I
	4142;4076	/ J
	1077;4324	/ K
	0177;0301	/ L
	3077;7730	/ M
	3077;7706	/ N
	4177;7741	/ O
	4477;3044	/ P
	4276;0376	/ Q
	4477;3146	/ R
	5121;4651	/ S
	4040;4077	/ T
	0177;7701	/ U
	0176;7402	/ V
	0677;7701	/ W
	1463;6314	/ X
	0770;7007	/ Y
	4543;6151	/ Z
	4177;0000	/ [
	1020;0204	/ \
	0000;7741	/ ]
	2000;2076	/ ^
	1604;0404	/ _
	0000;0000	/ SPACE
	7500;0000	/ !
	7000;0070	/ "
	7624;2476	/ #
	5721;4671	/ $
	6661;4333	/ % CR
	5166;0526	/ &
	7000;0000	/ '
	3600;0041	/ (
	4100;0036	/ )
	2050;0050	/ *
	0404;0437	/ +
	0500;0006	/ ,
	0404;0404	/ -
	0001;0000	/ .
	0601;4030	/ /
	4536;3651	/ 0
	2101;0177	/ 1
	4523;2151	/ 2
	4122;2651	/ 3
	2414;0477	/ 4
	5172;0651	/ 5
	1506;4225	/ 6
	4443;6050	/ 7
	5126;2651	/ 8
	5122;3651	/ 9
	2200;0000	/ :
	4601;0000	/ ;
	1000;4224	/ <
	1212;1212	/ =
	2442;0010	/ >
	4020;2055	/ ?
/403-777 ARE CHARACTER DISPLAY AREA
*1000
/
/GET RIGHT HAND SIDE - USED IN
/PROCESSING OF COMMANDS (LIBR) WHICH NEED
/A FILE NAME; EXPECTS THE FORM FILE, UNIT
/
GETRHS,	0
	DCA I PLEFLAG
	TAD PLNAME
	DCA BLK2
	TAD O7770
	DCA BLK2+1
PLLP1,	TAD O77
	DCA I BLK2
	ISZ BLK2+1
	JMP PLLP1
	TAD PLNAME
	DCA BLK2
	TAD O7770
	DCA BLK2+1
PLLP2,	JMS CGET
	JMP IGOTIT
	JMP RHSERR
	AND O77
	TAD M43
	SNA 
	JMP NUMSGN
	TAD PP43
	DCA I BLK2
	ISZ BLK2+1
	JMP PLLP2
	JMS CGET
	JMP IGOTIT
	JMP RHSERR
	CLA 
	JMP .-4
IGOTIT,	TAD PLNAME
	DCA BLK2
	TAD O7774
	DCA BLK2+1
	TAD PLNAME
	DCA BLK2+2
PLLP3,	TAD I BLK2
	CLL RTL 
	RTL 
	RTL 
	TAD I BLK2
	DCA I BLK2+2
	ISZ BLK2+1
	JMP PLLP3
	CLA CLL CML RTL 
	DCA LNAME+4
MORNUM,	JMS OCTNUM
	JMP I GETRHS
	JMP RHSERR
/
/SCAN OFF THE NUMBER - SET THE FLAG
/WHICH SAYS IT WAS A NUMBER
/
NUMSGN,	TAD BLK2+1
	TAD O10
	SNA CLA 
	JMS OCTNUM
	JMP RHSERR
	TAD LNUM
	DCA I P5LNAM
	TAD FLAGJ
	DCA I PLEFLAG
	CLA CMA 
	DCA I P6LNAM
	JMP MORNUM
PLEFLAG,LEFLAG
FLAGJ,	LEFLAG+3&177+5200
M43,	-43
PP43,	43
OCTNUM,	0
/
/SUBR TO GEN AN OCTAL NUMBER
/
PLLP4,	DCA LNUM
	JMS CGET
	ISZ OCTNUM
	JMP I OCTNUM
	AND O77
	TAD O7710
	CLL 
	TAD O10
	DCA CGET
	SNL 
	JMP RHSERR
	TAD LNUM
	CLL RTL 
	CLL RAL 
	TAD CGET
	JMP PLLP4
PLNAME,	LNAME-1
O10,	10
O77,	77
O7710,	7710
O7770,	7770
O7774,	7774
RHSERR,	6203		/RIGHT HAND SIDE ERROR
	JMP I .+1
	LERR
CGET,	0		/INTERFACE WITH FIELD 0
	6203		/	JMS CGET
	JMP I .+1	/	JMP <COMMA>
	CGETX		/	JMP <CARRET OR SEMICOLON>
CGETRET,TAD O7524	/	JMP <OTHER(CHAR IS IN AC)>
	SNA 
	JMP I CGET
	ISZ CGET
	TAD O7761
	SNA 
	JMP I CGET
	TAD O56
	SNA 
	JMP I CGET
	TAD O215
	ISZ CGET
	JMP I CGET
O7524,	7524
O7761,	7761
O56,	56
O215,	215
/
/BRING MILDRED INTO CORE
/
LDMILD,	0
	IOF
	JMS I X7774
	MLDBLK
	JMP I LDMILD
MLDBLK,	110
	30
	76
	2
*1171
LNUM,	0	/--------
LNAME,	0;0;0;0;0;0
MVCTR,	0
MVPTR,	0	/--------(REFERENCED AS A BLOCK)
LCHAIN,	CLA CMA 
/
/LIBRARY LOAD
/
LLOAD,	DCA CHFLAG
	JMS I PGETRHS
	JMS I PLDMILD
	JMS LUKUP
	TAD I P6LNAM
	CIA
	TAD LLENGTH
	SZA CLA 
	JMP FILERR+2
	TAD I PLNUM
	DCA LSBLK
	TAD I P5LNAM
	DCA FILSTRT
	JMS I X7774
	LSBLK
	TAD O3777
	DCA XR1
	TAD I XR1
	TAD M5252
	SZA CLA
	JMP FILERR+2
	TAD I XR1
	6201
	DCA I PBUFR
	6211
	TAD I XR1
	6201
	DCA I PLASTV
	TAD PLLIST
	DCA LLCNT
	TAD PFRST
	DCA LLPTR
	6211
	TAD I XR1
	6201
	DCA I LLPTR
	ISZ LLPTR
	ISZ LLCNT
	JMP .-6
LLEXIT,	6203
	ION
	ISZ CHFLAG
	JMP I LLPROC
	JMP I .+1
	GOTO
M5252,	-5252
O5252,	5252
PFRST,	FRST
LLPROC,	PROC
LLPTR,	0
LLCNT,	0
PLLIST,	LLIST
O3777,	3777
PBUFR,	BUFR
PLASTV,	LASTV
LSBLK,	0
	30
FILSTRT,0
LLENGTH,4
LSAVE,	DCA CHFLAG
	JMS I PGETRHS
	JMS I PLDMILD
	TAD LLENGTH
	DCA I P6LNAM
	JMS REPLACE
	TAD I PLNUM
	DCA LSBLK
	TAD I P5LNAM
	DCA FILSTRT
	TAD O3777
	DCA XR1
	TAD O5252
	DCA I XR1
	6201
	TAD I PBUFR
	6211
	DCA I XR1
	6201
	TAD I PLASTV
	6211
	DCA I XR1
	TAD PLLIST
	DCA LLCNT
	TAD PFRST
	DCA LLPTR
	6201
	TAD I LLPTR
	ISZ LLPTR
	6211
	DCA I XR1
	ISZ LLCNT
	JMP .-6
	JMS I X7775
	TAD LSBLK
	JMP LLEXIT
/
/USES MILDREDS LOOKUP
/
LUKUP,	0
	6141	/LINC
	0606	/LIF 6
	1020	/LDA I
	LNUM
	6020	/JMP 20
	FILERR&1777+6000
	0002	/PDP
	CLA 
	JMP I LUKUP
FILERR,	0002	/PDP
	CLA 
	6203/CIF CDF 0
	JMP I .+1
	ERRFIL
/
/USES MILDREDS REPLACE
/
REPLACE,0
	LINC
	LMODE
	LIF 6
	LDA I
	LNUM
	JMP 22
	JMP SAMEN	/ALREADY THERE
	JMP FILERR	/NOT ENUF ROOM
	JMP ENREPL
SAMEN,	LIF 6
	JMP 24
	JMP FILERR	/NOT ENUF ROOM; SHOULD NOT HAPPEN
ENREPL,	PDP
	PMODE
	CLA 
	JMP I REPLACE
*1400
LMAKE,	DCA MYTEMP	/LIBRARY MAKE
	JMS I PGETC
	JMP LMAKE1
	JMP I PRHSERR
	TAD C7506
	CLL
	TAD CSMCI
	DCA MYTMP2
	SNL
	JMP I PRHSERR
	TAD MYTEMP
	CLL RTL
	TAD MYTEMP
	CLL RAL
	TAD MYTMP2
	JMP LMAKE
LMAKE1,	JMS I PGETRHS
	TAD MYTEMP
	DCA I P6LNAM
	JMS I PLDMILD
	JMS I PREPLAC
LXIT,	6203
	ION
	JMP I PPROC
PPROC,	PROC
PGETC,	CGET
PRHSERR,RHSERR
O7510,	7510
OO10,	10
MCU,	-325
C7506,	7506
CSMCI,	323-311
/FILTAB ENTRY = TYPE
/		LENGTH
/		UNIT
/		FIRST BLOCK
/WHERE TYPE	0 = UNDEFINED
/		1 = UNSIGNED (1 WD)
/		2 = SIGNED (2 WD)
/		3 = FLOATING POINT (3 WD)
LOPEN,	JMS COMSUB
	JMS I PGETC
	JMP .+3
O15,	15
	JMP ERXIT
	JMS GETCX
	TAD MCU
	SNA 
	JMP ITSII
	TAD O2
	SNA 
	JMP ITSSS
	TAD O15
	SZA CLA 
	JMP I PRHSERR
ITSFF,	IAC
ITSSS,	IAC
ITSII,	IAC
	DCA MYTMP2
	JMS I PGETC
	JMP .+4
O2,	2
ERXIT,	CLA 
	JMP I PRHSERR
	JMS I PGETRHS
LEFLAG,	0	/(OR JMP .+3 IF GETRHS GOT A #)
	JMS I PLDMILD
	JMS I PLOOKUP
	TAD MYTMP2
	DCA I MYTEMP
	ISZ MYTEMP
	TAD I P6LNAM
	DCA I MYTEMP
	ISZ MYTEMP
	TAD I PLNUM
	DCA I MYTEMP
	ISZ MYTEMP
	TAD I P5LNAM
	DCA I MYTEMP
	JMP LXIT
O7472,	7472
/
/SCANS OFF FN AND LEAVES POINTER IN MYTEMP
/
COMSUB,	0
	JMS GETCX
	TAD O7472
	SNA CLA 	/F
	JMS GETCX
	TAD O7510
	CLL 
	TAD OO10
	SNL 
	JMP ERXIT
	CLL RTL 
	TAD PFILTAB
	DCA MYTEMP
	JMP I COMSUB
/
/LIBRARY CLOSE
/
LCLOSE,	JMS COMSUB
	JMS I PGETC
	JMP I PRHSERR
	SKP 
	JMP ERXIT
	DCA I MYTEMP
	IOF
	JMS I PFINISH
	CLA CLL IAC RTL 
	JMS I PFINISH
	JMP LXIT
/
/FILE VARIABLE LOADER
/
ITLOAD,	0
	JMS I PCOMMON
/
/VARIABLE IS NOW IN MEMORY; LOSS
/POINT AT IT; ONE OF THE FOLLOWING 3 CHOICES WILL BE TAKEN, ACCORDING
/TO TYPE
/
	JMP IRETLD
	JMP SRETLD
FRETLD,	TAD I LOSS
	ISZ LOSS
SRETLD,	DCA MYAC1
	TAD I LOSS
	DCA MYAC2
	ISZ LOSS
	JMP CRETLD
IRETLD,	TAD O27
	DCA MYAC1
	DCA MYAC2
CRETLD,	TAD I LOSS
	DCA MYAC3
	6203
	TAD MYAC1
	DCA I P1FLAC
	TAD MYAC2
	DCA I P2FLAC
	TAD MYAC3
	DCA I P3FLAC
	JMP I ITLOAD
GETCX,	0
	JMS I PGETC
O27,	27
	JMP I PRHSERR
	JMP I GETCX
*1600
/
/SUBSCRIPTING FOR FILE VARIABLES
/ENTER WITH A FILE NO. IN AC
COMMON,	0
	AND O7
	CLL RTL 
	TAD PFILTAB
	DCA MYTEMP
	TAD I PLESUB
	DCA HISS
	TAD I PSUBS	/SUBSCRIPTS
	DCA LOSS
	6211
	TAD I MYTEMP
	SNA CLA 
	JMP FERROR
	TAD I MYTEMP
	DCA BLK2
	TAD I BLK2	/(REFERENCES LOCS 2, 3, 4)
	DCA BLK2
	DCA BLK2+2
PREDIV,	TAD BLK2	/DIVIDES BY NO. ENTRIES/BLOCK
	CLL CIA
	TAD HISS
	SNL 
	JMP DIVDIV
	DCA HISS
	ISZ BLK2+2
	JMP PREDIV
DIVDIV,	CLA 
	TAD O7764
	DCA BLK2+1	/LOW ORDER SUBSCRIPT, THEN POINTER
DIVLUP,	TAD LOSS
	CLL RAL 
	DCA LOSS
	TAD HISS
	RAL 
	DCA HISS
	TAD BLK2
	CLL CIA
	TAD HISS
	SZL 
	DCA HISS
	CLA 
	TAD BLK2+2
	RAL 
	DCA BLK2+2
	SZL 
	JMP FERROR
	ISZ BLK2+1
	JMP DIVLUP
	TAD I MYTEMP
	ISZ MYTEMP
	CIA
	DCA BLK2+1
	SKP 
	ISZ COMMON	/SETS UP COMMON XIT ACCORDING TO FILE TYPE
	TAD HISS
	ISZ BLK2+1	/TBLK (RELATIVE) IS IN BLK2+2
	JMP .-3
	DCA LOSS
	TAD BLK2+2
	CLL CMA 
	TAD I MYTEMP	/(THE LENGTH)
	SNL CLA 	/SUBSCRIPT IS TOO LONG
	JMP FERROR
	ISZ MYTEMP
	TAD I MYTEMP
	DCA BLK2
	ISZ MYTEMP
	TAD I MYTEMP	/STARTING TBLK
	TAD BLK2+2
	DCA BLK2+2	/ABSOLUTE TBLK
	JMS CHECK
	CLA CLL RTL IAC
	JMS CHECK
	TAD SWITCH	/ALTERNATE THE BUFFERS
	SNA CLA 
	CLA CLL IAC RTL 
	DCA SWITCH
	IOF
	TAD SWITCH
	JMS I PFINISH
	TAD SWITCH
	TAD PB1FLG
	DCA XR1
	CLA IAC
	DCA I XR1
	TAD BLK2
	DCA I XR1
	TAD I XR1
	DCA BLK2+1
	TAD BLK2+2
	DCA I XR1
	JMS I X7774	/READ IT IN
	BLK2
	TAD SWITCH	/THE VARIABLE IS IN MEMORY
ITSAGO,	CLL RTL 
	RTL 
	RTL 
	TAD O6000
	TAD LOSS
	DCA LOSS
	CLA CLL CMA RTL 
	TAD XR1
	DCA HISS
	ION
	JMP I COMMON
CHECK,	0
	DCA SWTMP
	TAD SWTMP
	TAD PB1FLG
	DCA XR1
	TAD I XR1
	SNA CLA 
	JMP I CHECK
	TAD I XR1
	CIA
	TAD BLK2
	SZA CLA 
	JMP I CHECK
	ISZ XR1
	TAD I XR1
	CIA
	TAD BLK2+2
	SZA CLA 
	JMP I CHECK
	TAD SWTMP
	JMP ITSAGO	/BLK IS IN MEMORY ALREADY
O7,	7
*2000
/
/FILE VARIABLE STORER
/
ITSTOR,	0
	DCA XR1
	TAD I P1FLAC
	DCA MYAC1
	TAD I P2FLAC
	DCA MYAC2
	TAD I P3FLAC
	DCA MYAC3
	TAD XR1
	JMS I PCOMMON	/BLK IS IN MEMORY; LOSS POINTS AT IT
	JMP URETST
	JMP SRETST
FRETST,	TAD MYAC1
	DCA I LOSS
	ISZ LOSS
	TAD MYAC2
	DCA I LOSS
	ISZ LOSS
	TAD MYAC3
	JMP INCALL
SRETST,	TAD MYAC1
	SNA 
	JMP STOKOK
	SMA CLA 
	JMP STOOBG	/MUST BE LESS THAN MAGN. 1
NORMLE,	CLL 
	TAD MYAC2
	SPA 
	CML 
	RAR 
	DCA MYAC2
	TAD MYAC3
	RAR 
	DCA MYAC3
	ISZ MYAC1
	JMP NORMLE
STOKOK,	TAD MYAC2
	DCA I LOSS
	ISZ LOSS
	TAD MYAC3
	JMP INCALL
STOOBG,	TAD MYAC2
	CLL CML 
	SMA CLA 
	CMA CML 
	RAR 
	DCA I LOSS
	ISZ LOSS
	TAD MYAC2
	SMA CLA 
	CLA CLL CMA RAL 
	IAC
UZERST,	DCA I LOSS
	JMP CRETST
URETST,	6203
	JMP I .+1
	CALLIN
INCALL,	DCA I LOSS
CRETST,	CLA CMA 
	DCA I HISS
	6203
	JMP I ITSTOR
FINISH,	0
	TAD PB1FLG
	DCA XR1
	TAD I XR1
	SMA CLA 
	JMP I FINISH
	TAD XR1
	DCA BLOCK
	CLA IAC
	DCA I BLOCK
	TAD I XR1
	DCA BLOCK
	TAD I XR1
	DCA BLOCK+1
	TAD I XR1
	DCA BLOCK+2
	JMS I X7775
	BLOCK
	JMP I FINISH
BLOCK,	0		/UNIT
	0		/ADDRESS/256
	0		/BLOCKNUM
	1		/BLOCKCOUNT
/
/BXFLG=0 IF THE BUFFER IS FREE
/     =+ IF THE BUFFER IS OCCUPIED
/     =- IF OCCUPIED AND SOMETHING HAS
/	CHANGED; IE MUST BE WRITTEN OUT
/BXBLK CONTAINS THE TBLK WHICH IS IN THE BUFFER
/PB1FLG POINTS TO B1FLG; ADDING SWITCH MAKES
/IT POINT AT B2FLG
/
B1FLG,	0
B1UNIT,	0
	34
B1BLK,	0
B2FLG,	0
B2UNIT,	0
	35
B2BLK,	0
/
/FILE DEFINITIONS - 4 WORDS APIECE
/-TYPE (1,2,3=U,S,F) 0 FOR UNDEFINED
/-LENGTH (7777 IF #)
/-UNIT
/-FIRST BLOCK
/

FILTAB,	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
/$

CRUFT=1
IFDEF CRUFT <
/
/ THIS MATERIAL IS IN THE EXECUTABLE, BUT NOT IN THE LISTING.
/ SOME OF THAT IS BECAUSE OF THE SAVE COMMAND GRANULARITY, BUT
/ SOME OF IT IS NOT.
/
	FIELD 0
*0
0
*2572
	0;0;0;0;0;0
*IOBUF
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0
*3216
	0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0

	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
*4472
0000; 0000; 0000; 0000; 0000; 0000
0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000
0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000
0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000
0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000
0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000
0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000
0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000
0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000
0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000
0000; 0000; 0000; 0000; 0000; 0000; 0000; 0000
*4777
	0000
*5775
	0
	0
	0
*6377
	0
*7377
	0
*7575
	0
*7750
	FIELD 1
*0
	0
*1577
	0
*1777
	0
*2175
	0;0;0

/ NOTHING BELOW HERE IS IN THE LISTING!
*2200
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0

	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0

*4000
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	0
	DIGITS
	6030
	AND CHRCNT
	6265
	0006
	CIF 50
	AND CHRCNT
	6604
	AND 75
	7777
	AND CHREND
	0
	TAD I 4020
	4000
	AND 4062
	AND 4102
	1560
	4000
	4001
	4011
	AND I PSUBS
	6234
	TAD 60
	0000
	AND 4103
	TAD I 160
	SZA SMA CLA 
	TAD I 4020
	AND I 4000
	JMS 4021
	ISZ 47
	AND 4042
	TAD I 160
	SZA SMA CLA 
	1620
	AND I 4040
	JMS 4020
	AND I 52
	ISZ 4020
	AND I WEXIT
	ISZ 4021
	TAD I 4020
	AND I 4040
	JMS 4041
	TAD WAITER
	AND XQ
	AND I PSUBS
	6224
	AND 4041
	TAD 40
	0247
	0302
	TAD I 160
	SZA SMA CLA 
	TAD I 4020
	AND I 4040
	TAD 40
	AND 4043
	TAD I 160
	SNA SPA SZL CLA OSR 
	AND 4102
	ISZ 4045
	TAD 40
	JMS 0132
	JMS I 104
	6241
	TAD XQ
	TAD I 160
	SMA CLA 
	JMS 4046
	6243
	AND D256
	CIF 10
	JMS I 4154
	JMS 4046
	6141
	6241
	AND 64
	1000
	TAD D85
	TAD I 60
	JMP I 4157
	AND I CHREND
	6155
	TAD WAITER
	JMP I 4157
	TAD 44
	AND 4024
	6146
	AND 4021
	TAD 44
	6214
	PXOUTL
	TAD 0021
	JMS 170
	1020
	AND O360
	TAD 140
	AND D85
	AND 4004
	AND I CHREND
	6214
	TAD 24
	TAD I 60
	0
	6157
	AND GOODY
	AND D85
	AND 42
	AND XQ
	AND 67
	SNA SPA SZL CLA OSR 

	*4200
	1022
	1465
	6157
	IRETN
	6200
	TAD 22
	TAD I WAITER
	ISZ 4300
	6225
	1420
	AND 4200
	6223
	AND 4215
	6016
	AND 40
	AND ALPHA
	AND I 4240
	AND I 4200
	IOT
	AND 4225
	AND 4225
	0215
	AND 4236
	1025
	TAD 62
	TAD 25
	AND I 51
	6214
	AND 4215
	0456
	TAD XCTIN
	AND 4236
	6214
	AND I 4240
	IOT
	AND I 4240
	IOT
	AND 4246
	0000
	0
	AND 4346
	AND D256
	AND 55
	0
	231
	0
	AND 4211
	6255
	6241
	TAD WAITER
	JMP I 4357
	TAD GOODY
	6311
	AND 55
	0
	KCC
	6306
	6301
	TAD WAITER
	7775
	ISZ GAMMA
	JMS XR1
	AND 71
	TAD I 4376
	6506
	TAD WAITER
	7775
	ISZ GAMMA
	JMS XR1
	6310
	AND 70
	7777
	AND 4235
	TAD WAITER
	AND I 71
	JMS I 150
	TAD WAITER
	AND GAMMA
	ISZ XQ
	TAD 40
	AND CHRCNT
	JMS O360
	TAD 0027
	AND I 51
	6506
	AND I 70
	6506
	TAD 40
	AND I 4201
	AND BETA
	TAD 120
	AND 4270
	AND I 70
	AND BLK2
	AND I 51
	6350
	JMS I 4200
	6513
	6357
	1000
	AND I 4201
	AND BETA
	1104
	6334
	AND WEXIT
	0
	TAD WAITER
	6777
	ISZ I 4201
	JMS I 4203
	6371
	WEXIT
	7777
	1000
	AND I 4200
	TAD 40
	AND I 4202
	ISZ I 4201
	TAD 120
	CML CIA
	JMS I 4203
	TAD WAITER
	AND I 51
	JMS I 150
	TAD WAITER
	AND I 70
	IPART
	AND I 4200

	*4400
	INTRPT
	DCONT
	6410
	6513
	6415
	TAD D85
	TAD 105
	6376
	0212
	6506
	1000
	AND I 4402
	JMS I 4400
	AND 4410
	6471
	AND 70
	1000
	TAD WAITER
	AND O360
	TAD 140
	0010
	AND 4410
	AND I CHREND
	6506
	TAD 0030
	TAD I 60
	JMP I 4557
	6421
	TAD XQ
	1050
	1021
	TAD 70
	TAD 0021
	TAD 70
	TAD 0021
	TAD 70
	TAD 0021
	TAD I WAITER
	ISZ 4500
	6454
	TAD I WAITER
	AND 4400
	6465
	6506
	AND 47
	AND XR1
	AND 4427
	AND 4427
	TAD WAITER
	JMP I 4557
	TAD 67
	TAD 67
	6471
	TAD WAITER
	JMP I 4557
	TAD 70
	TAD 70
	1000
	AND I 4400
	TAD 70
	TAD 46
	TAD 26
	TAD 70
	AND 4435
	6243
	AND D256
	CIF 10
	JMS I 4512
	JMS 4446
	6141
	AND 40
	AND O760
	AND CHRCNT
	6220
	PSCOPO
	AND CHREND
	0
	AND 64
	TAD CHRCNT
	AND 4424
	AND I CHREND
	RRB RFC 
	AND 4424
	1000
	AND D85
	AND 4523
	AND I 52
	6545
	TAD D85
	TAD I 60
	JMP I 4557
	6541
	TAD WAITER
	AND CHRCNT
	TAD 140
	AND D85
	6517
	TAD WAITER
	AND D85
	TAD 140
	AND D85
	TAD D85
	TAD 120
	SZL 
	AND I 51
	6517
	AND GOODY
	AND D85
	TAD 25
	AND I 51
	6517
	1004
	TAD I 160
	NOP
	AND BETA
	ISZ I 4400
	AND I 51
	6573
	AND BETA
	TAD 105
	AND I 51
	6517
	6576
	ISZ I 4401
	AND I 51
	6517
	AND 4436
	RRB RFC 
*4600
	0;0;0;0;55;0;6032;6506
	6506
	1020
	7776
	1140
	0005
	1020
	5757
	1045
	1065
	1000
	0005
	1660
	0002
	4005
	1005
	0471
	6500
	1020
	5757
	1044
	1064
	1064
	1064
	0064
	0777
	1464
	6500
	0204
	6641
	0011
	0064
	0777
	1064
	0204
	6650
	6500
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0

	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
	0;0;0;0;0;0;0;0
>
$