Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-07 - 43,50462/focal.mac
There are 2 other files named focal.mac in the archive. Click here to see a list.
SUBTTL INTRODUCTION.
COMMENT \

		*************************************
		*				    *
		*   THIS IS THE STONE WHICH WAS     *
		* REJECTED BY  YOU BUILDERS WHICH   *
		* IS BECOME THE HEAD OF THE CORNER. *
		*			ACTS 4:11   *
		*			   RSV	    *
		*************************************


THE AUTHOR OF FOCAL-10, IAN PUGSLEY, IS VERY INTERESTED IN YOUR COMMENTS,
CRITICISMS AND SUGGESTIONS, EVEN THOUGH NO GUARANTEE CAN BE GIVEN TO
RESPOND OR TO ACCEPT THE SUGGESTIONS.

PLEASE DIRECT YOUR REPORTS TO HIM AT:

	DIGITAL EQUIPMENT AUSTRALIA
	60 PARK STREET,
	SOUTH MELBOURNE,
	VICTORIA 3205,
	AUSTRALIA.
\
IFDEF FNEW,<XLIST>
VWHO==1		;IAN D. PUGSLEY		DIGITAL EQUIPMENT AUSTRALIA.
VEDIT==127	;17-JUL-72
VEDIT==131	;11-SEP-72
VEDIT==132	;CHANGED UINCH5+1 FROM AUTIO3 TO AUTIO4
VEDIT==133	;ERROR MESSAGES IN UPPER AND LOWER CASE ETC.
VEDIT==134	;KI-10 TRAP HANDLER FIXED; ALSO IFSKIP.
VEDIT==135	;CATCH SUICIDE ON ERASE COMMAND CORRECTLY.
		;ALSO USE QUICK GETLN ROUTINE.
VEDIT==136	;CORRECT CODE AT AUTIO5+10,14.
VEDIT==137	;INSERT AND USE VERSTR MACRO.
VEDIT==140	;CORRECT # OF ITERATIONS IN ATAN (AT ATAN4).
VEDIT==141	;FIX HANDLING OF EXTRA SPACES, ALSO WIDE FORMATS.
VEDIT==142	;ALLOW DEVICE TTY IN I/O STATEMENTS; MORE OF #141
VEDIT==143	;CORRECT TITLE; MORE OF #142.
VEDIT==144	;STANDARDIZE USAGE OF <>
VEDIT==145	;MINOR CLEAN-UPS;INTERP TO BIT 0;XECUTE COMMAND;WIDE FORMATS
VEDIT==146	;CORRECT MODIFY ECHOING FOR FILE INPUT UNDER HALF DUPLEX
VEDIT==147	;MODIFY SYMBOL-TABLE TYPE-OUT FORMAT; FIX ERROR PRINT AFTER DO.
VEDIT==150	;FORCE ALL TEXT  LINES TO BEGIN AT A WORD BOUNDARY.
VEDIT==151	;ALLOW LINE NUMBERS UP 99.99.
VEDIT==152	;DELETE ALL CCL CODE; CLEAN UP OTHER PLACES.
VEDIT==153	;ALLOW NEGATIVE 'FOR' INDEX INCREMENTS; 'OPERATE' COMMAND IMPLEMENTED.
VEDIT==154	;ALLOW MULTI-SUBSCRIPTED ARRAYS; INCLUDE FCHR FUNCTION.
VEDIT==155	;VMAJOR 3.
VMAJOR==3	;6-APR-73
VEDIT==156	;CORRECT OCCURRENCES OF THE FORM OUTCH @ACCUM.
VEDIT==157	;MAKE GETTAB COLLECT ALL 36 BITS.
VEDIT==160	;SAVE ONE WORD AT UFSB:
VEDIT==161	;CORRECT LOOP WHICH OCCURS ON ASK +X.
VEDIT==162	;REMOVE CONTROL-C INTERCEPT FOR ASK DATA (NOW MUST USE CTRL-P)
VEDIT==163	;ALLOW LEADING SPACES IN ASK DATA.
VEDIT==164	;IMPROVE EXP. ROUTINE TIMING AND SIZE.
VEDIT==165	;IMPROVE GETNM ROUTINE TIMING AND SIZE.
VEDIT==166	;CORRECT DFLOAT TO MAKE  FLOAT A SIGNED 36-BIT NUMBER.
VEDIT==167	;PREFACE ODD FUNCTIONS WITH A CALL TO ODDFNC INSTEAD OF SPECIAL CODE
VEDIT==170	;INCLUDE FUNCTION FOCAL(Q) TO RETRIEVE DATA FROM WITHIN FOCAL.
VEDIT==171	;MOVED SOME ITEMS IN LOW SEGMENT TO MAKE ADDRESSES MORE PERMANENT
VEDIT==172	;USED PDP-6 MACRO DEFINITION FOR FSBRI INSTEAD OF SPECIAL CASES.
VEDIT==173	;ADDED EXTRA ERROR FLAG "Y" TO INDICATE TYPING " error".
VEDIT==174	;ALLOWED CORE-EXPANSION IN HALF K PAGES IF MONITOR GIVES IT.
VEDIT==175	;CLEANED UP THE GETNM ROUTINE A BIT.
VEDIT==176	;ADDED "Device not correctly INITted" MESSAGE.
VEDIT==177	;CHANGED INPUT/OUTPUT DEVICE ERROR MESSAGES.
VEDIT==200	;CORRECT SO LOWER CASE LIBRA MODIFIER IS ACCEPTED.
VEDIT==201	;CORRECT SO UNSUBSCRIPTED VARIABLE NAME PROPERLY TRUNCATED
VEDIT==202	;CORRECT PFLOAT SO IS WORKS FOR SINGLE-PRECISION VERSION.
VEDIT==203	;ELIMINATE DCAMGE UUO.
VEDIT==204	;CORRECT PDP-6 VERSION OF NEGANS.
VEDIT==205	;SAVE ONE WORD AT EACH OF RET:+2, FIX:+2 AND UINCH4:.
VEDIT==206	;CLEAR BIT 0 OF LOW ORDER WORD OF ALL DATA MACRO ARGUMENTS.
VEDIT==207	;IMPROVE PDP-6 DOUBLE PRECISION NEGANS ROUTINE AGAIN.
VEDIT==210	;CORRECT FIT:+6 SO CORE EXPANSION WORKS FOR BUFFER SET-UP.
VMINOR==1	;1-JUN-73.
VEDIT==211	;ALLOW DELETION/MODIFICATION OF ACTIVE LINES.
VEDIT==212	;SAVE ONE WORD AT NEGANS FOR PDP-6 VERSION.
VEDIT==213	;CORRECT LOW ORDER BITS OF PIO180 CONSTANT.
VEDIT==214	;RE-STRUCTURE SOURCE FILE SO PDP-6 FOCAL(CONST) WORKS.
VEDIT==215	;MAKE MINOR ADJUSTMENTS TO LOGARITHM SERIES COMPUTATION
VEDIT==216	;CORRECT LOW ORDER BITS OF ROOT8 CONSTANT.
VEDIT==217	;MAKE RETURN WORK FOR LINES NUMBERS ABOVE 31.99
VEDIT==220	;CORRECT NEWLIN ROUTINE FOR MODIFICATIONS OF A LINE.
VEDIT==221	;CORRECT PDP-6 DOUBLE FLOATING DIVIDE ROUTINE.
VEDIT==222	;MAKE DLOG REDUCTION IN FLOATING DIVIDE INSTEAD OF FIXED POINT
VEDIT==223	;ADJUST SOME DOUBLE-PRECISION CONSTANTS FOR GREATER ACCURACY.
VEDIT==224	;MAKE PDP-6 VERSION AUTOMATICALLY ONE-SEGMENT.
VEDIT==225	;REMOVE PDP-6 AUTO-DEFAULT-3.27-MONITOR.
VEDIT==226	;IMPROVE ACCURACY FOR SIND/COSD INTEGER ARGUMENTS.
VEDIT==227	;RE-WRITE GETLN TO PREVENT LOOP IF GO TO .. OCCURS.
VEDIT==230	;INCLUDE CODE TO DO A CLOSE ON DECTAPE AS PER THE MANUAL.
VEDIT==231	;ADD HALF A BIT OF PRECISION TO PDP-6 DFDV.
VEDIT==232	;DELETE SQRT,ATAN,ABS,SIGN;ADD FSIND,FCOSD,FLOG10 FUNCTIONS.
VEDIT==233	;MAKE ASK,TYPE/0 OPERATE/0 WORK,MAKE CHANNEL NUMBER DECIMAL.
VEDIT==234	;SAVE ACC. PC IN TRAP HANDLER FOR FXU/FOV ERROR MESSAGES.
VMINOR==2	;14-NOV-73
VEDIT==235	;ADD 1 BIT OF PRECISION TO PDP-6 DFMP.
VEDIT==236	;LET GETBUF/GETASK USE A BUFFER ON THE STACK.
VEDIT==237	;ADJUST .JBDDT/.JBCOR SO MONITOR 'SAVE' WORKS BETTER.
VEDIT==240	;SAVE T2 SO TYPE %EMM.NN /CHN (NO COMMA) WORKS.
VEDIT==241	;MAKE TYPE%10.5 ILLEGAL; MAKE FIX: WORK FOR NEGATIVE NUMBERS
VEDIT==242	;ALLOW ** FOR EXPONENTIATION WITH SPACE BETWEEN.
VEDIT==243	;CATCH ILLEGAL EXPRESSIONS ENDING IN AN OPERATOR.
VEDIT==244	;ADD CODE FOR "TYPE $$" - OCTAL COMMENTS.
VEDIT==245	;CORRECT TYPN7 SO NUMBER TYPES AS 0.000, NOT  .000
VMINOR==3	;14-FEB-74.
VEDIT==246	;IMPROVE ACCURACY OF TYPE-OUT ROUTINE.
VEDIT==247	;ADJUST TYPE-OUT ROUTINE SO LOG10 ERRORS DON'T MATTER.
VEDIT==250	;MAKE DEFAULT %E FORMAT %E5.04.
VEDIT==251	;SUPPRESS INDEX FIELD IN SYMBOL-TABLE PRINTOUT IF INDEX ZERO.
VEDIT==252	;CORRECT BUG WHEREBY COULD NOT MODIFY A LINE BEGINNING WITH "?".
VEDIT==253	;MAKE NAMES IN MONTHS TABLE BOTH UPPER AND LOWER CASE.
VEDIT==254	;USE .JBSA/L INSTEAD OF .JBDDT FOR CORE STABILIZATION.
VMAJOR==4	;26-JUN-74.
VEDIT==255	;MAKE LIBRA SAVE WRITE THE SYMBOL TABLE TOO.
VEDIT==256	;ENLARGE CORE CHUNK QUANTA TO SPEED UP LIBRA CALL.
VEDIT==257	;IMPROVE NUMERIC INPUT ACCURACY BEYOND THE 11TH DECIMAL PLACE.
VEDIT==260	;CORRECT BUG APPLYING TO LIBRARY FILES COMMENCING WITH CRLF.
VEDIT==261	;SQUEEZ WAS CLEARING CORE TOO LATE, AND BEING DECEIVED BY GARBAGE.
VEDIT==262	;IMPROVE SINE/COSINE  - VARIABLE NUMBER OF TERMS IN POWER-SERIES.
VEDIT==263	;CORRECT BUG IN SINGLE PRECISION FATN FOR VERY SMALL ARGUMENTS
VEDIT==264	;FIX KA-10 DOUBLE PRECISION FEXP TO GIVE A NORMALIZED ANSWER.
VEDIT==265	;MAKE EXP FUNCTION USE CONTINUED FRACTION METHOD.
VEDIT==266	;ELIMINATE ?FOV ERROR DURING TYPEOUT OF SMALL NUMBERS UNDER %E25.20.
VEDIT==267	;FORCE RE-USE OF CORE STORAGE FOR LIBRA-CALL OF SAME FILE TWICE
VEDIT==270	;IMPROVE END-OF-FILE HANDLING.	ALSO INVENT & USE RECIPR ROUTINE.
VEDIT==271	;USE NEW FIXOAT ROUTINE SO 2^(-1)=.5 EXACTLY.
VEDIT==272	;MORE OF EDIT #267.
VEDIT==273	;IF ENOUGH CORE OUTLAW THE FORMS: ASK % AND ASK $.
VEDIT==274	;WRITE A SMALL CORE LOGARITHM FUNCTION FOR KA DOUBLE PRECISION.
VEDIT==275	;CHANGE ACCUMULATOR VALUE INCL. CA=13, TO ALLOW STD. CALLING SEQ
VEDIT==276	;NEW FEATURE: STRING VARIABLES FUNCTIONS AND EXPRESSIONS
VEDIT==277	;NORMALIZE AFTER DFN TO ALLOW SPECIAL CASE 576400000000,146001000000
VEDIT==300	;DELETE BEMER'S FLOG METHOD. NEW RECURSIVE METHOD IS MORE ACCURATE
VEDIT==301	;SAVE INSTRUCTIONS: TWO IN UERROR, ONE AT GO, ONE AT TYPINT-1.
VEDIT==302	;OUTLAW THE FORMS X$= AND X$=() : FORCE THE FORMS X$="" OR X$=("").
VEDIT==303	;DELETE SIN,COS,SIND,COSD,LOG,LOG10,EXP; ADD FHIBER.
VMAJOR==5	;6-FEB-75.
VEDIT==304	;GENERATE TITLE (FOR LISTING) WITH VERSION # DETAILS.
VEDIT==305	;DON'T SAVE SYMBOL TABLE ON LIBRA SAVE IF A LIST EXISTS.
VEDIT==306	;COMPLY WITH SUBROUTINE CALLING CONVENTIONS.
VMINOR==1	;1-MAR-75.
VEDIT==307	;REPAIR EDIT #305 TO SAVE INCHN, OUTCHN CORRECTLY.
VEDIT==310	;.JBERR IS NOW INCREMENTED ON ERRORS AND GETTAB, FHIBER FAILURES.
VEDIT==311	;GIVE ERROR MESSAGE ON TOO-WIDE FORMAT.
VMINOR==2	;11-MAR-75.
VEDIT==312	;ASK DATA INITIAL CHAR RUBBED OUT CLOBBERRED LEADING SPACE FLAG.
VEDIT==313	;FOR INPUT AND ASK DATA, EMBED RUBBED OUT CHARACTERS IN "\".
VEDIT==314	;IMPLEMENT CONTROL-R.	ALSO CONTROL-P FOR ABORTING MODIFY.
VMINOR==3	;5-APR-75.
VEDIT==315	;MAKE OPERATE ON ILLEGAL DEVICE GIVE ERROR MESSAGE.
VMINOR==4	;26-APR-75.
VEDIT==316	;MAKE NON-FATAL ERROR MESSAGES COME OUT ALWAYS ON TTY.
VEDIT==317	;ALLOW MODIFY COMMAND TO INSERT & SCAN FOR QUESTION MARK.
VMINOR==5	;20-SEP-75.
VEDIT==320	;ASK COMMAND NOW OUTPUTS ONLY TO TTY AND ONLY IF INCHN IS TTY.
VEDIT==321	;SAME FOR MODIFY.
VEDIT==322	;DEBUG OUTPUT ALWAYS HAS TO GO TO TTY. (IT'S HOPELESS TO DEBUG OTHERWISE.)
VEDIT==323	;INPUT/OUTPUT DEVICE ERROR NOW GIVES MONITOR CODE
VMINOR==6	;4-OCT-75.
VEDIT==324	;MAKE ECHOES FOR RUBOUT, CONTROL-U ETC. APPLY ONLY FOR TTY INPUT.
VEDIT==325	;IMPLEMENT LOGICAL IF FOR = AND # OPERATIONS.
VMINOR==7	;10-OCT-75.
VEDIT==326	;IMPLEMENT LOGICAL IF FOR .NE. AND .EQ. TOO.
VMINOR==10	;13-OCT-75.
VEDIT==327	;CHANGE ERROR MESSAGE FORMAT FROM ERROR-## TO ERROR  #.
VMINOR==11	;21-OCT-75.
VEDIT==330	;ALLOW BACKSPACE FOR TELETYPE RUBOUT CHARACTER.
VMINOR==12	;8-FEB-76.
VEDIT==331	;SAVE SPACE AT LIMNXT:.
VEDIT==332	;CHANGE GL.HDP TO GL.LCP; DELETE DPOP UUO; ABBREVIATE TRAP HANDLER.
VEDIT==333	;SET X=0 CREATES NO NEW SYMBOL-TABLE ENTRY;REMOVE EXCESS CODE IN SQUEAZ.
VEDIT==334	;ALLOW ONLY ALPHABETICS IN COMMANDS; CHANGE INCREM,DECREM MACROS.
VEDIT==335	;ADD .LT.,.LE.,.GT.,.GE.; CHANGE MOST PRINTX TO PX.
VEDIT==336	;IMPROVE DEXCH UUO FOR KI-10 D PREC; REMOVE INCREM, DECREM MACROS.
VEDIT==337	;REARRANGE ERROR PRINTOUT AND WRITE CODE FOR MORE EFFICIENCY.
VEDIT==340	;SPEED UP EVAL AND ALLOW -1#-1.
VEDIT==341	;BETTER TRY.
VEDIT==342	;SCAN NEW: AND OLD: AT FNEWGO:.
VEDIT==343	;MAKE SYMBOL-TABLE SCAN METHOD BINARY SEARCH.
VEDIT==344	;RESTRICT ASK STRING DELIMITERS TO LINE-FEED, ALT-MODE.
VEDIT==345	;LIBRARY SAVE GENERATES BACKUP; LOOKUP ERRORS ARE NON-FATAL.
SUBTTL FEATURE-TEST SWITCHES.

;PROCESSOR TYPE.
IFNDEF .CPU,<.CPU==3>	;KI-10 DEFAULT.
IF1 <
IFDEF PDP,IFDEF DECsystem,IFN PDP-DECsystem,.CPU=-1	;ERRONEOUS CONFLICT.
IFDEF DECsystem,SYN DECsystem,PDP
IFNDEF PDP,<PDP=0>
IFNDEF KA,<KA=0>
IFNDEF KI,<KI=0>
IFNDEF KL,<KL=0>
IFN PDP!KA!KI!KL,<.CPU=0>
IFLE .CPU*<5-.CPU>,<
PRINTX <
?TO CHOOSE THE PROCESSOR OPTION, YOU SHOULD MERELY SET
	.CPU=1 FOR PDP-6
OR	.CPU=2 FOR KA-10
OR	.CPU=3 FOR KI-10
OR	.CPU=4 FOR KL-10
>;END PRINTX
PASS2
END
>;END IFLE .CPU*<5-.CPU>
>;END IF1
IFE .CPU-1,	PDP==6
IFG .CPU-1,	PDP==10
IFE .CPU-2,	KA==10
IFE .CPU-3,	KI==10
IFE .CPU-4,	KL==10

IFNDEF MONITOR,	MONITOR==5.06	;NUMBER OF EARLIEST MONITOR TO BE USED.

;ARITHMETIC PRECISION.	WPV.	NUMBER OF WORDS PER VALUE
	IFNDEF WPV,<WPV==2>		;=2	DOUBLE PRECISION.

	DECsystem==PDP
	KA==KA
	KI==KI
	KL==KL
	MONITOR==MONITOR
	WPV==WPV
	XPV==WPV-1			;EXTRA WORDS PER VALUE.

SIZE==0					;EXCESS SPACE AVAILABLE.
IFE KA-10,<IFG XPV,<SIZE==-1>>		;SOME VERSIONS ARE OVER QUOTA.
SUBTTL ACCUMULATOR ASSIGNMENTS

;EXCEPT FOR ACCUMULATOR ZERO, THE HIGHER THE ACCUMULATOR, THE MORE GLOBAL,
;AND THE LOWER THE ACCUMULATOR, THE MORE TEMPORARY AND UNPRESERVED IT IS.
	F0=0		;FLAGS.
	UA=1		;UUO SCRATCH ACCUMULATOR NUMBER 1.
	PC=2		;USED FOR SAVE/RESTORE AND TRAP HANDLER.
	AC=3		;FLOATING ACCUMULATOR HIGH PART   /   TEMPORARY ACCUMULATOR.
	MQ=AC+1		;FLOATING ACCUMULATOR LOW PART   /   OTHERWISE UNUSED.
	AA=MQ+1		;AUXILIARY ACCUMULATOR.   (ALSO AS UUO SCRATCH #2)
	T2=6		;TEMPORARY ACCUMULATOR.
	T3=T2+1		;TEMPORARY ACCUMULATOR.
	T4=T3+1		;TEMPORARY ACCUMULATOR.
	T5=T4+1		;TEMPORARY ACCUMULATOR.
	T6=T5+1		;TEMPORARY ACCUMULATOR.
	CA=13		;CUSTOMER ACCUMULATOR; NOT USED BY FOCAL.
	RL=14		;SYMBOL-TABLE RELOC REGISTER. NORMALLY C(RL)=C(.JBREL)+1
	CH=15		;CHARACTER JUST ABOVE PNTR POINTER.
	CC=CH+1		;NATURE OF "CH".
	PP=17		;PROGRAM PUSH-DOWN POINTER.	FORTRAN-COMPATIBLE.

COMMENT \
	USAGE OF AC,MQ,AA.

1.	AS FLOATING-POINT ACCUMULATOR.
		AC	HIGH ORDER PART.
		MQ	LOW ORDER PART IF DOUBLE PRECISION.
		AA	GENERALLY UNUSED EXCEPT BY FIXOAT ROUTINE (Q.V.)

2.	AS INTEGER.	(ALWAYS TWO WORDS, EVEN IN SINGLE-PRECISION VERSION)
		AC	HIGH ORDER.
		MQ	LOW ORDER.
		AA	UNUSED.

3.	AS FOCAL LOGIC POINTER.
		AC	LINE NUMBER.
		MQ	BYTE POINTER.
		AA	INDEX ENTRY.

4.	AS SIXBIT VARIABLE NAME.
		AC	BIT 0: =1 NUMERIC VARIABLE, =0 STRING VARIABLE.
			BITS 1-17: SIXBIT
			BITS 18-35: SIXBIT OR INDEX.
		MQ	UNUSED.
		AA	UNUSED.
\
SUBTTL PARAMETER ASSIGNMENTS.
IFDEF FNEW,<.XCREF>
	MLON
IFN PDP-6,<IFNDEF FNEW,<TWOSEG>>	;PDP-6 UUO HANDLER IS NON-REENTRANT

;MISCELLANEOUS MONITOR AND HARDWARE BITS.
	EOF==20000			;END-OF-FILE ON INPUT.
	DV.IN==2			;DEVICE CAN DO INPUT
	DV.OUT==1			;DEVICE CAN DO OUTPUT
	DV.DTA==1B11			;THE DEVICE IS A DECTAPE
	ASCII==1			;MODE ZERO IS LEGAL
	AP.FOV==100			;FLOATING OVERFLOW FLAG
	FXU==1B11			;FLOATING UNDERFLOW FLAG
	FOV==1B3			;FLOATING OVERFLOW FLAG.
	AP.REN==400000			;REPETITIVE ENABLE
	NOECHO==200			;TTY NO-ECHO STATUS BIT.
	.RBDEV==16			;LOGICAL UNIT NAME ON WHICH FILE IS LOCATED

;TELETYPE LINE CHARACTERISTICS.
	GL.LCP==1B15			;LINE IS LOCAL-COPY.

;PROGRAM PARAMETERS
	TTYCHN==0			;TELETYPE I/O CHANNEL.
	LIBCHN==1			;LIBRARY CALL/SAVE CHANNEL NUMBER.
	DOUCHN==2			;DEFAULT OUTPUT CHANNEL NUMBER.
	DINCHN==3			;DEFAULT INPUT CHANNEL NUMBER.
	EOL==0				;DELIMITER FOR FOCAL TEXT LINES.
IFN EOL,PRINTX EOL MUST BE ZERO
	PDC==400			;SIZE OF PROGRAM PUSH-DOWN LIST.
DEFINE MCALL (NAME) <
DEFINE PCALL (PREC) <
DEFINE VCALL (MAJOR,MINOR,EDIT,WHO) <
DEFINE VFIG (AMIN) <
X=0
IRPC AMIN <
IFE X-MINOR,<
DEFINE NCALL (PROC) <
DEFINE TITEL <
TITLE 'NAME ('PROC') 'PREC'-PRECISION V'MAJOR''AMIN'('EDIT')-'WHO
>;END DEFINE TITEL
IFE VWHO,<
DEFINE TITEL <
TITLE 'NAME ('PROC') 'PREC'-PRECISION V'MAJOR''AMIN'('EDIT')
>;END DEFINE TITEL
>;END IFE VWHO
>;END DEFINE NCALL (PROC)
STOPI
>;END IFE X-MINOR
X=X+1
>;END IRPC AMIN
>;END DEFINE VFIG (AMIN)
VFIG ( ABCDEFGHIJKLMNOPQRSTUVWXYZ)
>;END DEFINE VCALL (MAJOR,MINOR,EDIT,WHO)
>;END DEFINE PCALL (PREC)
>;END DEFINE MCALL (NAME)
MCALL FOCAL FOR DECsystem-10
IFN PDP-6,<IFDEF FNEW,<MCALL FOCALL FNEW LOW SEGMENT JACKET>>
IFE XPV,<PCALL SINGLE>
IFG XPV,<PCALL DOUBLE>
VCALL (\VMAJOR,\VMINOR,\VEDIT,\VWHO)
IFE KA-10,<NCALL KA-10>
IFE KI-10,<NCALL KI-10>
IFE KL-10,<NCALL KL-10>
IFE PDP-6,<NCALL PDP-6>
TITEL
PURGE MCALL,NCALL,VFIG,VCALL,PCALL,X,TITEL
SUBTTL MACRO DEFINITIONS
OPDEF	JSPPC [PUSHJ PP,]		;DISGUISE THE FACT THAT THIS IS A PUSHJ
					;AND MAKE READER REALIZE THE STACK IS CHANGED.
IFE XPV*<KI-10>*<KL-10>*<PDP-6>,<DEFINE HALVE (A)<	FSC	AC,-1>>
IFN XPV*<KI-10>*<KL-10>*<PDP-6>,<DEFINE HALVE (A)<	DFMP	AC,HALF>>
IFN <KI-10>*<KL-10>,<	DEFINE NEGATE (A) <	PUSHJ	PP,NEGANS>>
IFE <KI-10>*<KL-10>,<	DEFINE NEGATE (A) <	DMOVN AC,AC>>
IFE XPV,<	DEFINE NEGATE (A) <	MOVNS	AC>>
DEFINE DATA (A,B)<
A
B
>;END DEFINE DATA (A,B)
IFE KA-10,<
DEFINE DATA (A,B)<
A
IFN <<<B+200>&<-1B36>>_<-8>>,<
IFGE A,<A&<777B8>-33B8+<<B+200>&<-1B36>>_<-8>>
IFL A,<<-A&<777B8>>-33B8+<<B+200>&<-1B36>>_<-8>>
>;END IFN <<<B+200>&<-1B36>>_<-8>>
IFE <<<B+200>&<-1B36>>_<-8>>,<0>
>;END DEFINE DATA (A,B)
>;END IFE KA-10
IFE XPV,<DEFINE DATA (A,B)<A+<<B&1B1>_-^D34>>>

;ITERATION COUNT FOR DATAN POWER SERIES.
DATANCOUNT=<<12+33*WPV+KI*XPV+KL*XPV>/4*2>&-2	;COMPUTE ITERATION COUNT.
DEFINE GETT5 (A) <
	RADIX 10
	DEFINE GETTT5 (B) <MOVSI T5,('B'.)>
	GETTT5 \A
	RADIX 8
>;END DEFINE GETT5 (A)

;LOGARITHM OF (MANTISSA SIZE/10.)
	LGMNSZ=7.12780988293		;B*LOG10(2)-1;B= # OF BITS.;27-BIT FRACTION
IFG XPV,<LGMNSZ=17.66385973117>		;62-BIT FRACTION.
IFG XPV,<IFE KA-10,<LGMNSZ=15.2556197658>>	;54-BIT FRACTION.

DEFINE ENDSEG <
	IFDEF FNEW,IF2,END FNEWGO
	IFDEF FNEW,LOC 400010
	IFNDEF FNEW,RELOC 400000
	DEFINE ENDSEG <>
>;END DEFINE ENDSEG
IFE PDP-6,DEFINE ENDSEG <>
DEFINE	.ADCHR	(CHR),<
.STRG==.STRG+<<CHR>_.SHFT>
.SHFT==.SHFT-7
IFL .SHFT,<
	EXP	.STRG
.STRG==0
.SHFT==^D29
>;END IFL .SHFT
>;END DEFINE	.ADCHR	(CHR)

DEFINE	.ADSTR	(STR),<
IRPC	STR,<
	.ADCHR	("STR")
>;END IRPC	STR
>;END DEFINE	.ADSTR	(STR)

DEFINE	VERSTR	(NAME,MAJOR,MINOR,EDIT,WHO),<
.STRG==0
.SHFT==^D29

	.ADSTR	(NAME)
	.ADSTR	(\MAJOR)
IFN MINOR,<
	.ADCHR	(MINOR+"A"-1)
>;END IFN MINOR
IFN EDIT,<
	.ADCHR	"("
	.ADSTR	(\EDIT)
	.ADCHR	")"
>;END IFN EDIT
IFN WHO,<
	.ADCHR	("-")
	.ADSTR	(\WHO)
>;END IFN WHO
	.ADCHR	("	")
	EXP	.STRG
>;END DEFINE	VERSTR	(NAME,MAJOR,MINOR,EDIT,WHO)
SUBTTL UUO ASSIGNMENTS AND OPDEFS
;UUOLIST CONTAINS TRIPLETS OF ARGUMENTS FOR THE X MACRO.
;THE FIRST ARGUMENT IS THE SIMPLE NAME
;THE SECOND ARGUMENT IS THE TYPE OF THE UUO ....
;	0	MEANS NOT DATA
;	1	MEANS DATA OPERATION
;	2	MEANS DATA ARITHMETIC OPERATION
;THE THIRD ARGUMENT INDICATES WHETHER THE OP IS DONE
;	BY HARDWARE (IF ZERO), OR
;	BY UUO (IF POSITIVE).
;	BY OTHER SOFTWARE (IF NEGATIVE).
DEFINE UUOLIST <
X ERROR,0,1
X GLIDE,0,PDP-7
X HOP,0,PDP-7
X INCHR,0,PDP-7
X OUTCH,0,PDP-7
X OUTST,0,PDP-7
X PUSH,1,XPV
X EXCH,1,XPV*<1-KI-KL>
X MOVE,1,<-XPV*<KI+KL-10>>
X MOVEM,1,<-XPV*<KI+KL-10>>
X FAD,2,<-XPV*<KI+KL-10>>
X FSB,2,<-XPV*<KI+KL-10>>
X FMP,2,<-XPV*<KI+KL-10>>
X FDV,2,<-XPV*<KI+KL-10>>
>;END DEFINE UUOLIST

DEFINE X (A,B,C) <
IFE C,<
IFE XPV,<
   IFE B-1,<OPDEF D'A [A]>
   IFE B-2,<OPDEF D'A [A'R]>

>;END IFE XPV
>;END IFE C
IFG C,<
   XXX=XXX+1
   IFG B,<OPDEF D'A [XXX_33]>
   IFE B,<OPDEF A   [XXX_33]>

>;END IFG C
>;END DEFINE X (A,B,C)
XXX=0
UUOLIST

OPDEF ERRORR [Y!<ERROR>]

DEFINE PX (A),<
PRINTX <
?A
>;END PRINTX
>;END DEFINE PX (A)
IFN PDP-6,<
;	OPDEF GLIDE [GLIDE 0,]		;SET UP CH & CC THEN JRST ADR
	OPDEF GLIDEP[GLIDE 1,]		;SET UP CH & CC THEN PUSHJ PP,ADR
	OPDEF STEP  [GLIDE 2,]		;STEP OVER SPACES THEN GLIDE  ADR
	OPDEF STEPP [GLIDE 3,]		;STEP OVER SPACES THEN GLIDEP ADR
;	OPDEF HOP   [HOP 0,]		;HOP OVER 1 CHARAC, THEN GLIDE  ADR
	OPDEF HOPP  [HOP 1,]		;HOP OVER 1 CHARAC, THEN GLIDEP ADR
	OPDEF HPSTP [HOP 2,]		;HOP OVER 1 CHARAC, THEN STEP   ADR
	OPDEF HPSTPP[HOP 3,]		;HOP OVER 1 CHARAC, THEN STEPP  ADR
>;END IFN PDP-6
IFE PDP-6,<
;ON THE PDP-6 ALL UUO'S TRAP TO THE MONITOR WHICH SHUNTS UUO'S BACK
;TO THE USER.   THIS PROCESS IS RATHER INEFFICIENT, SO ON THE PDP-6
;WE SHALL DEFINE THE MOST COMMONLY-USED UUO'S AS MACROS, WHICH ONLY
;ASSEMBLE ONE INSTRUCTION IN THE IN-LINE SEQUENCE, AND WHICH GO TO
;A MULTI-LINE LITERAL TO SET UP THE ARGUMENTS AND CALL THE APPROPRIATE
;"UUO" ROUTINE.
DEFINE UUOMAC (LIST)<
IRP LIST,<
DEFINE LIST(A)<
	JRST [	MOVEI	UA,A
		JRST	U'LIST]
>;END DEFINE LIST(A)
DEFINE LIST'P(A)<
	PUSHJ PP,[MOVEI	UA,A
		JRST	U'LIST]
>;END DEFINE LIST'P(A)
>;END IRP LIST
>;END DEFINE UUOMAC (LIST)
UUOMAC <GLIDE,HOP,STEP,HPSTP>
DEFINE INCHR (A)<
PUSHJ	PP,[MOVEI	UA,A
	JRST	UINCHR]
>;END DEFINE INCHR (A)
DEFINE OUTCH (A)<
PUSHJ	PP,[MOVEI	UA,A
	JRST	UOUTCH]
>;END DEFINE OUTCH (A)
DEFINE OUTST (A)<
PUSHJ	PP,[MOVEI	UA,A
	JRST	UOUTST]
>;END DEFINE OUTST (A)
DEFINE FADRI (A,B) <FADR	A,[EXP	<B>_^D18]>
DEFINE FSBRI (A,B) <FSBR	A,[EXP	<B>_^D18]>
DEFINE FMPRI (A,B) <FMPR	A,[EXP	<B>_^D18]>
>;END IFE PDP-6
IFN XPV,<
IFE KI+KL-10,<
DEFINE DEXCH (A,B),<
IFDIF <B> <-XPV(PP)		>,PX DEXCH ERRONEOUS USE
	PUSHJ PP,[EXCH	AC,-WPV(PP)
		EXCH	MQ,-XPV(PP)
		POPJ	PP,]
>;END DEFINE DEXCH (A,B)
>;END IFE KI+KL-10
>;END IFN XPV

IFE XPV,<OPDEF DLSH [LSH]>
IFE XPV,<OPDEF DASH [ASH]>
IFG XPV,<OPDEF DLSH [LSHC]>
IFG XPV,<OPDEF DASH [ASHC]>

IFN KL-10,<
DEFINE ADJSP(A,B),<
IFL B+1,SUB	A,[XWD	-<B>,-<B>]
IFE B+1,POP	A,(A)
IFG B,	ADD	A,[XWD	B,B]
>;END DEFINE ADJSP(A,B)
>;END IFL KL-10
SUBTTL LIST OF FUNCTION NAMES AND ENTRY POINTS.

;NAMES OF THE FORM FABC$ (I.E. STRING FUNCTIONS) MUST BE WRITTEN AS &ABC

DEFINE FNCLIST <
X FSIN,SIN
X FSIND,SIND
X FCOS,COS
X FCOSD,COSD
X FLOG10,LOG10
X FLOG,LOG
X FEXP,EXP
X FSQT,SQRT
X FATN,ATAN
X FABS,ABS
X FSGN,SIGN
X FRAN,FRAN
X FITR,FITR
X FOCAL,FOCALF
X GETTAB,GETAB
X FNEW,FNEWH
X FCHR,FCHR
X &CHR,FCHR$
X FHIBER,FHIBER
>;END DEFINE FNCLIST
SUBTTL ERROR CODES.
;ERROR CODE FIELDS.
;BITS 18-22,30-35	MONITOR CODE.
;BITS 23-27		SERIAL #.
;BITS 9,28-29		FLAGS.

Y=1B9	;TYPE " error" AFTER MESSAGE.
F=1B28	;FATAL ERROR FLAG.
M=1B29	;MONITOR ERROR FLAG.

DEFINE ERRLIST <
X NULL,F,<Program re-started>
X BADLIN,F,<Illegal number>
X NOLINE,F,<Nonexistent line>
X ILLCOM,F,<Illegal command>
X SETERR,F,<Illegal variable>
X MISMAT,F,<Mismatched parentheses>
X NOCOR,F,<Insufficient core>
X ILSQRT,0,<Imaginary roots required>
X SYNTAX,F,<Unexpected character>
X INPERR,F!M,<Input device>
X OUTERR,F!M,<Output device>
X INIERR,F,<INIT>
X ENTERR,F!M,<ENTER>
X LUKERR,F!M,<LOOKUP>
X RENERR,F!M,<RENAME>
X FRMERR,0,<Illegal format (ignored)>
X FOVERR,0,<Floating-point overflow>
X FXUERR,0,<Floating-point underflow>
X CHNERR,0,<Channel not correctly INITted>
>;END DEFINE ERRLIST
DEFINE X(ERNAME,FLAGS,TEXT),<
ERNAME=<XXX_10>!FLAGS
XXX=XXX+1
>;END DEFINE X(ERNAME,FLAGS,TEXT)
XXX=0
ERRLIST
SUBTTL STATUS FLAG BITS (F0).
;RIGHT HALF.	(EXTERNAL USE)
;CUSTOMER PLEASE USE BITS 18,19,20,...
;I WILL USE BITS 35,34,33,...

	COLSUP==1B35		;SUPPRESS COLON CUE IN ASK COMMAND.
	EQUSUP==1B34		;SUPPRESS EQUALS PRIOR TO VALUE TYPE-OUT.
	ERRSUP==1B33		;SUPPRESS NON-FATAL ERROR MESSAGES.



;LEFT HALF.   (INTERNAL USE)

	STRING==1B17		;WE WERE, ARE OR WILL BE EVALUATING A STRING.
	NUMBER==1B16		;WE WERE, ARE OR WILL BE EVALUATING A NUMBER.
	LOGICL==1B15		;WE WERE, ARE OR WILL BE EVALUATING A LOGICAL EXPRE.
	EXTGIV==1B11		;=1 SPECIFIC FILE EXTENSION GIVEN.
	CUETTY==1B10		;OUTPUT ONLY TO TTY AND ONLY IF TTY INPUT.
	IFCMD==1B9		;WE ARE EXECUTING AN IF COMMAND.
	ACCSGN==1B5		;PDP-6 ARITHMETIC ACC SIGN.
	MEMSGN==1B4		;PDP-6 ARITHMETIC MEM SIGN.
	BTHSGN==1B3		;PDP-6 ARITHMETIC RESULT SIGN.
	MODRUB==1B2		;DURING 'MODIFY',RUBOUT WAS LAST CHARACTER TYPED
	DEBFLG==1B1		;=1 DEBUG IS "ACTIVE". - PRINT EACH CHARACTER
	NO.INT==1B0		;=0 MEANS PNTR POINTS TO A STRING BEING INTERPRETED.
				;=1 MEANS PNTR POINTS TO DATA.
				;NO.INT FLAG OFF MAKES THE INTERPRETER
				;LISTEN TO QUESTION MARKS, AND
				;TYPE EACH CHARACTER IF DEBFLG=1
				;THIS FLAG MUST BE SET/CLEARED
				;EVERY TIME PNTR IS MOVED TO ANOTHER STRING
SUBTTL CHARACTER CHARACTERISTICS (CC).
	;LEFT HALF.	NATURE OF NEXT CHARACTER FROM ILDB PNTR.
	;AN MUST BE THE SIGN BIT.
	LP==1B5				;LEFT PARENS (,<, OR [
	RP==1B4				;RIGHT PARENS ),>, OR ]
	E==1B3				;E (THE LETTER)
	N==1B2				;NUMERIC 0-9 INCLUSIVE OR POINT (.).
	A==1B1				;ALPHABETIC A-Z INCLUSIVE.
	AN==1B0				;ALPHANUMERIC 0-9 OR A-Z BUT NOT E.

	NBITS==6			;NUMBER OF BITS OF CC USED.
SUBTTL INTERNAL PROGRAMMING STANDARDS.
COMMENT \

1.0	GENERAL PROGRAMMING STANDARDS.

1.1	ACCUMULATOR USAGE SHALL BE STRICTLY ADHERED TO.

1.2	LINE LAYOUT IS:

	LABEL:(TAB)OP(TAB)ACCUMULATOR,ADR(TABS);COMMENT

	WHERE COMMENTS ARE AS FAR AS POSSIBLE RESTRICTED TO ONE LINE.
		; IS IN COLUMN 40 OR 5TH TAB POSITION.

	1.2.1	MULTILINE LITERALS
		INSIDE MULTILINE LITERALS THE OP,ACCUMULATOR AND ADR ARE SHIFTED
		RIGHT ONE TAB SPACE.	COMMENTS ARE NOT SHIFTED.
		IF THE CALLING INSTRUCTION HAS AN ACCUMULATOR FIELD, THE MULTILINE
		LITERAL MUST START ON THE NEXT LINE.
		IF THE CALLING INSTRUCTION HAS NO ACCUMULATOR FIELD, WRITE
		OP-SPACE-[-TAB THEN START THE LITERAL.

	1.2.2	SINGLE-LINE-LITERALS
		THE LITERAL IS WRITTEN WITHOUT SPACES OR TABS EITHER
		BEFORE OR AFTER THE "[".

1.3	SUBROUTINES ARE CALLED WITH A PUSHJ AS A GENERAL RULE,
		AND RETURN WITH A POPJ AT THE SAME LEVEL.
		THE MAIN ARGUMENT(S) IS (ARE) CARRIED TO AND FROM
		THE SUBROUTINE IN AC,MQ,AA.
		ACCUMULATORS T2-T6 ARE ALWAYS PRESERVED.
		VARIATIONS FROM THE ABOVE MUST BE STATED IN WRITING
		AT THE HEAD OF THE SUBROUTINE, WHEN DESCRIBING THE
		CALLING SEQUENCE.
		UNLESS OTHERWISE STATED, AC,MQ,AA ARE NOT PRESERVED.
\
COMMENT \
2.0	SPECIAL RULES.

2.1	CC,CH ARE IMMEDIATELY UPDATED WHENEVER C(PNTR) IS CHANGED.

2.2	THE FLOATING POINT TRAP ROUTINE ASSUMES THE FOLLOWING ...
	1. UFA MAY ONLY BE USED IN DOUBLE PRECISION KA-10
	   UUO ARITHMETIC ROUTINE DELIMITED BY DFABEG & DFAEND.
	2. ACCUMULATOR "PC" IS AVAILABLE FOR TRAPPING.
	3. THE XCT AND JRSTF INSTRUCTIONS DO NOT CAUSE A TRAP.
	4. NO FLOATING-POINT INSTRUCTION IN FOCAL STORES A RESULT IN
	   "MEMORY" MODE OR "BOTH" MODE.
	5. THE RESULT MAY BE STORED IN THE ACCUMULATOR AND, IF FOCAL IS
	   DOUBLE-PRECISION, ACCUMULATOR+1, EVEN IF THE INSTRUCTION WOULD
	   NORMALLY STORE ONLY IN THE ACCUMULATOR (SUCH AS FSC).
	   THIS TURNS OUT TO BE THE CORRECT PROCEDURE FOR FOCAL ANYWAY.

2.3	THE UUO HANDLER CAN BE CALLED RECURSIVELY (FROM WITHIN ITSELF).
	THE UUO SCRATCH ACCUMULATOR MUST THEREFORE BE USED WITH
	CONSIDERABLE DISCRETION.

2.4	THE DOUBLE PRECISION UUO'S MAY ONLY BE USED WITH CERTAIN SPECIFIC
	ACCUMULATORS:
		   UUO		ALLOWABLE ACCUMULATORS
		----------	----------------------
		DPUSH		PP ONLY.
		ALL OTHERS	AC ONLY (MEANING THE AC,MQ PAIR.)

2.5	THE EFFECTIVE ADDRESS USED WITH THE DOUBLE PRECISION UUO'S ALWAYS
	REFERS TO THE PAIR OF WORDS AT THAT ADDRESS

2.6	THE DOUBLE PRECISION UUO'S MAY BE USED WITH ANY EFFECTIVE ADDRESS
	BUT IF THE EFFECTIVE ADDRESS IS AN ACCUMULATOR PAIR, IT MUST BE
	ONE OF  -  AC,MQ  OR  T2,T3  OR  T3,T4  OR  T4,T5  OR  T5,T6
\
COMMENT \
3.0	DATA HANDLING.

3.1	FLOATING-POINT DATA.
	DATA IS HELD IN STANDARD DECsystem-10 FORMAT
	ACCORDING TO THE HARDWARE IT IS ASSEMBLED FOR.
	FLOATING-POINT DATA MAY BE HELD IN ONE OF THREE PLACES:
	3.1.1	IN ACCUMULATOR:		AC ALONE OR AC,MQ.
	3.1.2	ON THE STACK:		ONE OR TWO WORDS, HIGH ORDER PUSHED FIRST.
	3.1.3	IN THE SYMBOL TABLE:	ONE OR TWO WORDS, IN ORDER: HIGH, LOW, NAME.

3.2	FIXED-POINT DATA IS HELD IN AC AND MQ.
	THE DATA TAKES THE FORM OF A 71-BIT TWO'S COMPLEMENT
	NUMBER, IN AC BITS 0-35, MQ BITS 1-35.
	THE SIGN BIT, AC(0) IS DUPLICATED IN MQ(0) FOR CONVENIENCE.

3.3	STRING DATA.
	STRING DATA MAY BE HELD IN THE FOLLOWING FORMS:
	3.3.1	IN "ACCUMULATOR":	AC POINTS TO THE STRING,
					AND MQ POINTS TO THE LAST CHARACTER.
					THE ACTUAL STRING IS AT BUFH.
	3.3.2	ON THE STACK:		TO PUT DATA ON THE STACK, USE:
						PUSH	PP,AC
						PUSH	PP,MQ
						MOVEM	MQ,BUFH
					TO REMOVE DATA FROM THE STACK, USE:
						POP	PP,MQ
						POP	PP,AC
						MOVEM	AC,BUFH
	3.3.3	IN THE SYMBOL TABLE:	THE STRING IS STORED IN CORE ABOVE THE SYMBOL TABLE.
					THE SYMBOL TABLE ENTRY IS OF THE FORM:
					1. POINTER TO THE DATA (INDEX FIELD REFERENCING RL).
					2. UNUSED WORD (DOUBLE PRECISION FOCAL-10).
					3. NAME.
\
COMMENT \
4.0	DESIGN CRITERIA

	THE ALGORITHMS AND METHODS USED IN THIS PROGRAM SHALL BE
	DECIDED BY THE FOLLOWING CRITERIA IN THIS ORDER ...

4.1	CORE SIZE

	UNDER NO CIRCUMSTANCES WILL THE HIGH SEGMENT EXCEED 2K.

4.2	ACCURACY

	ALL ARITHMETIC WILL GIVE EXACT ANSWERS WHERE POSSIBLE EXCEPT
	THAT IN THE CASE OF OVERFLOW OR UNDERFLOW THE CLOSEST REPRESENTATION
	OF THE NUMBER WILL BE USED

4.3	MAINTAINABILITY

	IN ORDER TO CONCURRENTLY MAINTAIN THIS SOFTWARE FOR BOTH
	SINGLE AND DOUBLE PRECISION AND FOR PDP-6, KA-10, KI-10 AND KL-10,
	SIMPLER AND MORE GENERAL CODING IS PREFERRED, EVEN THOUGH
	IT MIGHT NOT BE AS TIGHT OR FAST AS POSSIBLE.

4.4	SPEED

	AFTER ALL THE ABOVE CONSIDERATIONS HAVE BEEN TAKEN INTO ACCOUNT,
	EXTRA CODE MAY BE INTRODUCED TO IMPROVE SPEED.

\
	SUBTTL ABSOLUTE LOCATIONS
	INTERNAL .JB41,.JBVER	;CONSISTENCY CHECK.
	.JB41=41
	LOC	.JB41
	IFE PDP-6,<	JSR	UUOH.>
	IFN PDP-6,<	PUSHJ	PP,UUOH>
	.JBVER=137
	LOC	.JBVER
	BYTE	(3)VWHO	(9)VMAJOR	(6)VMINOR	(18)VEDIT
SUBTTL LOW SEGMENT DATA
	RELOC	0
;********     DATA-BLOCK POINTERS     ********
BUFH:	BLOCK	1		;POINTER TO LAST CHAR IN LIBRA CALL TEXT AREA.
DBP:				;THIS GROUP IS CHECKED BY THE SQUEEZ ROUTINE.
INDEX:	BLOCK	1		;LEFT HALF - UNUSED.	(CONTAINS -1)
				;RIGHT HALF - ADDRESS OF INDEX DATA BLOCK.
TEXTL:	BLOCK	1		;RIGHT HALF POINTS JUST BELOW FOCAL PROGRAM TEXT.
				;LEFT HALF CONTAINS -1.
PNTR:	BLOCK	1		;CURRENT BYTE POINTER TO FOCAL TEXT.
THISPT:	BLOCK	1		;POINTER TO BEGINNING OF EXECUTION OF CURRENT LINE.
BUFL:	BLOCK	1		;POINTER TO JUST BELOW LIBRA CALL TEXT AREA.
				;LEFT HALF CONTAINS 010700.
DBPEND=+.			;END OF DATA-BLOCK POINTERS.
;********	PROGRAM STATUS DATA WORDS	********
OUTCHN:	BLOCK	1		;CURRENT-OUTPUT-CHANNEL.
INCHN:	BLOCK	1		;CURRENT-INPUT-CHANNEL.
	WPC==3			;THREE WORDS PER CHANNEL.
HEDTAB:	BLOCK	20*WPC		;BUFFER HEADERS.
BUFTAB:	BLOCK	20		;TABLE OF POINTERS TO BUFFER SPACE
				;ALLOCATED TO EACH CHANNEL.
				;IF ENTRY IS ZERO, THEN NO BUFFERS ARE ALLOCATED.
				;IF THE WORD IS NEGATIVE, IT MEANS THE CHANNEL IS
				;INITTED FOR OUTPUT.    FOLLOWING DATA IS GOTTEN
				;BY NEGATING THE WHOLE WORD FIRST....
				;LEFT HALF - SIZE OF BUFFER SPACE.
				;RIGHT HALF - ADDRESS OF BUFFER SPACE.
FORFLA:	BLOCK	1		;CONTAINS ZERO IF NO 'FOR' IN EXECUTION.
				;OTHERWISE XWD -1,LINNUM-OF-FOR.
FOVSUP:	BLOCK	1		;IF THIS WORD IS NON-ZERO (SET TO -1),
				;THEN SUPPRESS FLOATING-POINT TRAP ERROR MESSAGES.
LUPARG:	BLOCK	2		;MOST RECENT ARGUMENT OF REPETITIVE LOOP.
				;(2 LOCATIONS TO PRESERVE HISTORICAL MAP.)
THISLN:	BLOCK	1		;# OF THE LINE BEING EXECUTED.
LINNUM:	BLOCK	1		;RIGHT-HALF - LINE NUMBER OF CURRENT INTEREST
				;(ALWAYS POSITIVE).
				;LEFT HALF IF NEGATIVE IS A LINK
				;TO NESTED LINES AND POINTERS.
				;PREVIOUS LINNUM IS AT PDLEND-2+LH(LINNUM).
				;PREVIOUS PNTR IS AT PDLEND-1+LH(LINNUM).
;********     SYMBOL TABLE POINTERS     ********
SYMTBL:	BLOCK 1 		;Address just below bottom of symbol-table.
				;Left half contains index RL.
SYMTBC:	BLOCK 1 		;Address of first name in symbol table.
				;Left half contains index RL.
SYMTBH:	BLOCK 1 		;Highest location of symbol table.
				;Normally contains same as .JBREL.
FORMAT:	BLOCK	1		;FORMAT CONTROL FOR TYPING NUMBERS.
				;BITS 0-28:	TOTAL # DIGITS.
				;BITS 29-35:	# DIGITS RIGHT OF POINT.
EORMAT:	BLOCK	1		;FORMAT CONTROL FOR E-FORMAT OUTPUT
IFN <FORMAT+1-EORMAT>,PX <FORMAT,EORMAT OUT OF SEQUENCE>
OLDRAN:	BLOCK	WPV		;SAVE LAST RANDOM NUMBER.
FORMAX:	BLOCK	WPV		;LOGARITHM OF UPPER SIZE LIMIT FOR F-FORMAT
				;OUTPUT BEFORE ROUNDING.
EORMAX:	BLOCK	WPV		;LOGARITHM OF UPPER SIZE-LIMIT
				;OF F-PART OF E-FORMAT TYPE-OUT.
IFN <FORMAX+WPV-EORMAX>,PX <FORMAX,EORMAX OUT OF SEQUENCE>
;********     TEMPORARY STORAGE     ********
TEMP1:	BLOCK	WPV		;THIS STORAGE IS NOT ...
TEMP2:	BLOCK	WPV		;...GUARANTEED PRESERVED BY SUBROUTINES ...
TEMP3:	BLOCK	WPV		;...THEREFORE ONLY USE IT ON THE ONE PAGE.
TEMP4:	BLOCK	WPV
TEMPE:	BLOCK	WPV		;TEMPORARY STORAGE FOR EXP. ROUTINE.
TEMPR:	BLOCK	WPV		;TEMPORARY STORAGE FOR RECIPR ROUTINE.
TEMPT:	BLOCK	WPV		;TEMPORARY STORAGE FOR TYPE-OUT ROUTINE.
LUKENT:	BLOCK	.RBDEV+2+AA	;LOOKUP/ENTER BLOCK.
IFLE MONITOR-4.72,<
	WPD=4			;WORDS PER DIRECTORY ENTRY.
FILTAB:	BLOCK	20*WPD		;SPACE FOR FILE NAME ETC.
>;END IFLE MONITOR-4.72
BUFBOT:	BLOCK	1		;SAVE .JBFF HERE.

;********     PUSH-DOWN LIST     ********
PDL:	BLOCK	PDC		;PROGRAM PUSH-DOWN LIST.
PDLEND:	BLOCK	2		;TWO SPARE FOR OVERFLOW.
IFG XPV,<
IFE PDP-6,<
;PDP-6 DOUBLE FLOATING ARITHMETIC SUBROUTINES.

;INITIALIZATION.
;	1.	PLACE ACC SIGN IN ACCSGN BIT.
;	2.	PLACE MEM SIGN IN MEMSGN BIT.
;	3.	PLACE XOR OF THESE IN BTHSGN BIT.
;	4.	PUT FRACTION MAGNITUDES IN AC,MQ AND A1,A2 BITS 9-71
;	5.	PUT EXPONENT MAGNITUDES IN AA,A3 WITHOUT EXCESS 200.

;CALL -	PUSHJ	PP,AINI		;ENTER WITH NORMALIZED ARGUMENTS.
;	RETURN IF ACC ZERO	;WITH MEM UNTOUCHED.
;	RETURN IF MEM ZERO	;WITH ACC UNTOUCHED.
;	NORMAL RETURN.

AINI:	MOVEM	AC,A1			;SET UP IN CASE EFFECTIVE ADDRESS
	MOVEM	MQ,A2			;IS "AC".
	TDNN	MQ,[377777777777]	;CHECK FOR ZERO ACCUMULATOR.
	JUMPE	AC,AINI0		;INCLUDING UNNORMALIZED CHECK.
	AOS	(PP)			;TAKE SECOND OR THIRD RETURN.
	SKIPN	(UA)			;MEM ZERO?
	SKIPE	1(UA)			;(ALSO CHECK UNNORMALIZED)
	AOS	(PP)			;NORMAL RETURN NOW.
AINI0:	TLZ	F0,(ACCSGN!MEMSGN!BTHSGN);CLEAR BITS.
	PUSHJ	PP,AINI1		;FIX ACC ARGUMENT.
	PUSHJ	PP,UMOVE		;GET MEM ARGUMENT.
AINI1:	JUMPGE	AC,AINI2		;POSITIVE ALREADY?
	TLC	F0,(ACCSGN!BTHSGN)	;NO.	MARK NEGATIVE
	PUSHJ	PP,NEGANS		;AND MAKE NEGATIVE.
AINI2:	LDB	AA,[POINT 8,AC,8]	;PICK EXPONENT.
	SUBI	AA,200			;REMOVE THE EXCESS 200.
	TLZ	AC,777000		;MAKE FRACTION PURE.
AEXCH:	TLNE	F0,(BTHSGN)		;ACCSGN SAME AS MEMSGN?
	TLC	F0,(ACCSGN!MEMSGN)	;NO.	SWAP THEM.
AEXCH0:	EXCH	AA,A3			;EXCHANGE ALL.
AEXCH1:	EXCH	MQ,A2			;
	EXCH	AC,A1
	POPJ	PP,
A1:	Z				;SPACE TO STORE MEM HI ORDER.
A2:	Z				;SPACE TO STORE MEM LOW ORDER.
A3:	Z				;SPACE TO STORE MEM EXPONENT.
>;END IFE PDP-6
>;END IFG XPV
IFN <KI+KL-10>*<XPV>,<
DFABEG:	;DOUBLE-FLOATING ARITHMETIC.
IFE PDP-6,<
UFMP:	PUSHJ	PP,AINI			;ARITHMETIC INITIALIZATION.
	JRST	ZERANS			;ACC ZERO.
	JRST	ZERANS			;MEM ZERO.
	ADDB	AA,A3			;MAKE NEW EXPONENT.
	ASHC	AC,8			;ADJUST FOR MULTIPLY.
	SUBI	AA,2			;MAKE SPACE FOR TWO BITS OF MOVEMENT
	PUSHJ	PP,AEXCH0		;INTERCHANGE MULTIPLIER & MULTIPLICAND
	ASHC	AC,2			;MAKE SPACE FOR TWO BITS OF MOVEMENT
	MUL	MQ,A1			;FIRST CROSS-PRODUCT.
	MULM	AC,A2			;SECOND CROSS-PRODUCT.
	JCRY1	.+1			;CLEAR CRY1 FLAG.
	ADDM	MQ,A2			;ADD CROSS-PRODUCTS.
	MUL	AC,A1			;MULTIPLY HI ORDERS.
	JCRY1 [	AOJA	AC,.+1]		;ADD CARRY FROM XPROD-ADD.
	AOJA	MQ,UFAD2		;ADD ROUNDING, THEN COMBINE AND GOTO NR.
UFDV:	PUSHJ	PP,AINI			;ARITHMETIC INITIALIZATION.
	JRST	ZERANS			;ACC ZERO.
	JRST	FOVANS			;MEM ZERO.
	PUSHJ	PP,AEXCH1		;MEM TO ACC TEMPORARILY.
	ASHC	AC,8			;ADJUST FOR DIVIDE.
	PUSHJ	PP,AEXCH1		;RESTORE ACC TO MEM.
	SUBB	AA,A3			;MAKE NEW EXPONENT.
	DIV	AC,A1			;FIRST DIVISION.
;OLD V.	MULM	AC,A2			;GET QUOTIENT TIMES HI MEM.
;OLD V.	SUB	MQ,A2			;
	EXCH	MQ,A2			;NEW V. I SUSPECT THAT THESE FOUR LINES
	MOVNS	MQ			;NEW V. OF CODE ARE MORE ACCURATE THAN
	MUL	MQ,AC			;NEW V. THE PREVIOUS TWO, ALTHOUGH
	ADD	MQ,A2			;NEW V. I HAVE NO FIRM BASIS FOR THIS.
	DIV	MQ,A1			;SECOND DIVISION.
	JUMPGE	MQ,NR1			;NORMALIZED RETURN.
	SOJA	AC,NR1			;NORMALIZED RETURN.
>;END IFE PDP-6
IFE KA-10,<
UFMP:	MOVEM	AC,AA			;COPY HIGH ACCUMULATOR OPERAND TO AA.
	FMPR	AA,1(UA)		;FIRST CROSS PRODUCT TO AA
	FMPR	MQ,(UA)			;SECOND CROSS PRODUCT TO MQ
	UFA	MQ,AA			;STORE SUM OF CROSS PRODUCTS IN AA
	FMPL	AC,(UA)			;STORE PRODUCT OF HIGH PARTS IN AC,MQ
	JRST	UFAD1			;COMBINE AC,MQ AND AA INTO AC,MQ THEN RETURN
UFDV:	FDVL	AC,(UA)			;HIGH ORDER DIVISION
	MOVN	AA,AC			;COPY NEGATIVE OF THE QUOTIENT INTO AA
	FMPR	AA,1(UA)		;MULTIPLY LOW PART OF DIVISOR
	UFA	MQ,AA			;ADD REMAINDER & STORE IN AA
	FDVR	AA,(UA)			;DIVIDE SUM BY HIGH PART OF DIVISOR
	JRST	UFAD2			;ADD RESULT TO ORIGINAL QUOTIENT & RETURN
>;END IFE KA-10
UFSB:	NEGATE	ACCUM			;NEGATIVE ADD
	PUSH	PP,JNEG			;SIGNAL TO NEGATE AFTER ADDING.;FALL INTO UFAD
>;END IFN <KI+KL-10>*<XPV>
IFG XPV,<
IFE PDP-6,<
UFAD:	PUSHJ	PP,AINI			;ARITHMETIC INITIALIZATION.
	SKIPA				;ACC ZERO.
	JFCL				;MEM ZERO.
	CAMLE	AA,A3			;FIND SMALLER EXPONENT.
	PUSHJ	PP,AEXCH		;AND PUT IT IN ACC.
	SUB	AA,A3			;GET EXPONENT DIFFERENCE.
	CAMG	AA,[-76]		;GUARD AGAINST EXCESS SHIFTS.
	SETZB	AC,MQ			;WHICH MIGHT BE OMITTED.
	ASHC	AC,(AA)			;ALIGN BOTH OPERANDS.
	TLZE	F0,(BTHSGN)		;ACC,MEM OPPOSITE SIGNS?
	PUSHJ	PP,NEGANS		;YES.	MAKE SIGN FOR AN ADD.
	TLZE	F0,(MEMSGN)		;THEN TRANSFER RESULT SIGN ...
	TLO	F0,(BTHSGN)		;... TO BTHSGN BIT.
	ADD	AC,A1			;ADD HI ORDERS.
	JCRY1	.+1			;CLEAR CRY1 FLAG.
UFAD2:	ADD	MQ,A2			;ADD LO ORDERS.
	JCRY1 [	AOJA	AC,.+1]		;ADD IN POSSIBLE CARRY.
	JUMPGE	AC,NR1			;CHECK FOR NEGATIVE RESULT.
	TLC	F0,(BTHSGN)		;ADJUST SIGN.
	PUSHJ	PP,NEGANS		;AND DATA.
;HERE WITH FRACTION RESULT IN AC,MQ,
;	EXPONENT RESULT IN A3, SIGN RESULT IN BTHSGN BIT OF F0.
NR1:	TDNN	MQ,[377777777777]	;DOUBLE-CHECK FOR ZERO.
	JUMPE	AC,ZERANS		;WHICH IS NORMALIZED BY DEFINITION.
	AOSA	AA,A3			;EXPONENT INTO AA.
NR2:	ASHC	AC,1			;ONE LOOP.
	TLNN	AC,2000			;DONE?
	SOJA	AA,NR2			;NO.
	ASHC	AC,-2			;YES.	PUT TO FINAL POSITION.
	ADDI	AA,201			;GET FINAL EXPONENT.
	JUMPL	AA,FXUANS		;UNDERFLOW?
	CAILE	AA,377			;OVERFLOW?
	JRST	FOVANS			;TOO BAD!
	DPB	AA,[POINT 8,AC,8]	;DEPOSIT EXPONENT IN ITS FIELD.
	TLZE	F0,(BTHSGN)		;SIGN OF RESULT.
	JRST	NEGANS			;NEGATIVE.
	POPJ	PP,			;POSITIVE.
>;END IFE PDP-6
IFE KA-10,<
UFAD:	UFA	MQ,1(UA)		;PUT SUM OF LOW PARTS IN AA
	FADL	AC,(UA)			;ADD HIGH ORDER PARTS INTO AC,MQ
UFAD1:	UFA	MQ,AA			;SET AA=MQ+AA
UFAD2:	FADL	AC,AA			;SET AC,MQ=AC+(AA=MQ+AA)
	POPJ	PP,			;NO.	RETURN.
DFAEND:
>;END IFE KA-10
>;END IFG XPV
SUBTTL FNEW HANDLER
IFNDEF FNEW,<FNEWH:	BLOCK 1>	;FLAG THAT NO FNEW HANDLER IS LOADED.
IFDEF FNEW,<
IFN PDP-6,<ASUPPRESS>			;REMOVE PROPRIETARY SYMBOLS FROM REL FILE.
.CREF
LIST
FNEWH:	JSPPC	PROT26			;SAVE SOME TEMPORARY ACCUMULATORS
	MOVE	T4,T2-T6-2(PP)		;GET LAST ITEM ON STACK.
	MOVE	T2,PP			;REMEMBER WHERE THE STACK WAS.
	TDZA	T3,T3			;CLEAR ARGUMENT COUNTER.
FNEWH1:	HPSTPP	EVAL			;GET NEXT ARGUMENT.
	HRRZI	T5,3(PP)		;POINT TO THE ARGUMENT.
	HRLI	T5,(<1B10>_XPV)		;SET UP ARG-TYPE IN AC FIELD.
	TLZN	F0,(NUMBER)		;WAS IT A STRING ARGUMENT?
	TLO	T5,(17,)		;YES.
	PUSH	PP,T5			;SAVE THE POINTER.
	MOVEI	AA,WPV+2		;NUMBER OF WORDS ON PDL.
	PUSH	PP,AA			;SAVE THE COUNTER.
	TLZN	F0,(STRING)		;WAS IT A STRING ARGUMENT?
	JRST	FNEWH4			;NO.
	MOVEI	T5,(PP)			;POINT TO THE COUNTER.
	MOVE	AC,BUFH			;MAKE A LOADING POINTER.
	HRLZI	UA,(POINT 7,(T5),34)	;MAKE A DEPOSITING POINTER.
FNEWH2:	TLNN	UA,760000		;IS THERE ROOM FOR ANOTHER CHARACTER?
	AOSA	(T5)			;NO. INCREMENT THE COUNT....
	SKIPA				;(YES.)
	PUSH	PP,ZERO			;.... AND MAKE ROOM FOR 5 MORE.
	CAMN	AC,MQ			;DONE?
	SETZB	AC,MQ			;FLAG END OF STRING.
	ILDB	AA,AC			;PICK UP CHARACTER.
	IDPB	AA,UA			;DEPOSIT IT IN THE STACK.
	JUMPN	AC,FNEWH2		;LOOP.
FNEWH4:	DPUSH	PP,AC			;HERE TO STORE NUMERIC VALUE.
	CAIE	T4,EVALY		;WERE THERE ANY ARGUMENTS?
	JRST	FNEWH5			;NO.
	CAIN	CH,","			;ARE THERE ANY MORE ARGUMENTS?
	SOJA	T3,FNEWH1		;YES.
FNEWH5:	HRLZI	T3,-1(T3)		;GET ARGUMENT COUNT.
	PUSH	PP,T3			;SAVE ARGUMENT COUNT WORD
	HRRZI	16,1(PP)		;SET UP AC16 TO POINT TO ARG LIST.
	HRRZI	T4,1(T2)		;POINT TO NEXT ARGUMENT.
FNEWH6:	PUSH	PP,(T4)			;ENTER ARG ENTRY INTO LIST.
	ADD	T4,1(T4)		;POINT TO NEXT ARGUMENT
	AOBJN	T3,FNEWH6		;PUT ALL ENTRIES IN LIST.
	MOVEM	0,AC			;SAVE AC0.
	PUSHJ	PP,FNEW			;PERFORM FUNCTION.
	EXCH	0,AC			;RESTORE AC0, GET ANSWER.
IFG XPV,<MOVEM	1,AC+1>			;AND LOW ORDER.
	MOVE	PP,T2			;RESTORE PP.
	TLO	F0,(NUMBER)		;INDICATE NUMERIC ANSWER.
	GLIDE	CPOPJ			;RESTORE CH (16).
IFN <F0-0>!<UA-1>!<CC-16>!<PP-17>,PX AC CONFLICT AT FNEWGO:
>;END IFDEF FNEW
IFDEF FNEW,<
IFN PDP-6,<
FNEWGO::JFCL				;ALLOW A START AT FNEWGO+1
	SKIPE	T2,.JBHRL##		;.JBHRL SHOULD CONTAIN ZERO.
	OUTSTR	FNEWM1			;PRINT ERROR MESSAGE.
	JUMPN	T2,FNEWER		;AND IDENTIFY IT.
	IORI	T2,BUFH-140		;LOW SEGMENT MUST START AT 140.
	SKIPE	T2			;O.K. IF T2 CONTAINS ZERO.
	OUTSTR	FNEWM2			;OTHERWISE NOT O.K.
	JUMPN	T2,FNEWER		;ERROR EXIT.
	MOVEI	AC,2			;INITIAL TARGET IS TWO DIRECT HITS.
FNEWG1:	MOVEM	AC,TARGET		;STORE A TARGET WHICH, IF HIT, WILL EXIT.
	SETOM	SCORE			;INITIALIZE SCORE CARD.
	SKIPA	AC,.+1			;POINT TO LIST OF DEVICES TO SCAN.
	POINT	36,DEVLST		;POINT TO LIST OF DEVICES TO SCAN.
	MOVEM	AC,PNTR			;POINT TO THE LIST.
FNEWG3:	ILDB	AA,PNTR			;GET NEXT DEVICE NAME.
	JUMPE	AA,FNEWG9		;END OF LIST.
	SKIPA	AA+1,.+1		;FILE NAME
	SIXBIT	"FOCAL"			;FILE NAME.
	SETZB	AA+2,AA+3		;EXTENSION.
	SETZB	AA+4,AA+5		;PPN, OPTIONAL CORE ASSIGNMENT.
	MOVEI	AC,AA			;POINT TO GETSEG ARGUMENTS.
	GETSEG	AC,			;TRY TO FIND FOCAL.SHR.
	JRST	FNEWG3			;ERROR!	NOT FOUND.
	SETZM	AC			;PRE-SET TO COUNT THE SCORE FOR THIS HIT.
	MOVE	MQ,.JBHVR##+400000	;GET VERSION # OF HIGH SEGMENT.
	CAMN	MQ,FCLLVN		;INSTRUCTION TO GO INTO FNEWG3.
	AOS	AC			;VERSION NUMBER OK:	SCORE 1.
	MOVS	MQ,NINETY		;GET A VALUE FROM THE END OF THE HI SEG.
	CAIN	MQ,(90.0)		;COMPARE FEATURES.
	SOJE	AC,FNEWEX		;SCORE TWO!	A WINNER!
	MOVMS	AC			;NON-ZERO HERE MEANS WE HIT ONE OF THEM.
	CAMLE	AC,SCORE		;ZERO MEANS THAT AT LEAST WE FOUND .SHR.
	MOVEM	AC,SCORE		;MARK BEST SCORE SO FAR.
	CAME	AC,TARGET		;DID WE REACH TARGET YET?
	JRST	FNEWG3			;NO. TRY AGAIN.
	OUTSTR	FNEWM5			;COMPLAIN IF DIFFERENT.
FNEWEX::JRST	ONCE			;THEN GO ANYWAY.
FNEWG9:	SKIPL	AC,SCORE		;HERE WHEN DONE SCANNING DEVLST.
	JRST	FNEWG1			;TRY ANOTHER SCAN WITH LOWER TARGET.
	OUTSTR	FNEWM3			;ERROR MESSAGE.
FNEWER:	OUTSTR	FNEWM4			;TYPE IDENTIFICATION MESSAGE.
	EXIT

FCLLVN:	BYTE (3)VWHO (9)VMAJOR (6)VMINOR (18)VEDIT;MUST BE HERE 'COS 137 HAS FORTRAN'S
TARGET:	EXP	1			;IF SCORE REACHES TARGET WE WIN.
SCORE:	EXP	-1			;SCORE 1 IF VERSION # OK, +1 IF NINETY OK.
DEVLST:	SIXBIT	"DSK"
	SIXBIT	"SYS"
	SIXBIT	"NEW"
	SIXBIT	"OLD"
	Z
FNEWM1:	ASCIZ "?Loading error: High segment is forbidden.
"
FNEWM2:	ASCIZ "?Loading error: FOCALL.REL must be loaded first.
"
FNEWM3:	ASCIZ "?Cannot find FOCAL.SHR on DSK: or SYS: or NEW: or OLD:.
"
FNEWM4:	ASCIZ "?Error detected by FNEWGO routine in FOCALL.REL.
"
FNEWM5:	ASCIZ "%
%FOCALL.REL and FOCAL.SHR are different versions.
"
>;END IFN PDP-6
>;END IFDEF FNEW
SUBTTL	INITIALIZATION
IFE <KI+KL-10>*<<KA-10>!XPV>,ENDSEG
FOCAL:	
;THIS ROUTINE INITIALIZES THE WHOLE OF THE LOW SEGMENT
ONCE:	SETZB	F0,T2			;CLEAR ALL FLAGS. ; SET INDEX TO FORMAT.
	MOVE	PP,PDS			;ENSURE PDL SET UP.
	HLRZ	AC,.JBSA##		;FIND PLACE FOR INDEX DATA BLOCK.
	MOVEM	AC,BUFBOT		;REMEMBER WHERE FREE CORE STARTS.
	HRROM	AC,TEXTL		;SET UP TEXTL.
	HRROM	AC,INDEX		;POINT TO INDEX DATA BLOCK.
	PUSHJ	PP,CLRVA1		;ENSURE CORE, SETUP SYMBOL-TABLE POINTERS
	AOS	AC,TEXTL		;MAKE SPACE FOR INDEX DATA BLOCK; RESTORE AC.
	HRLI	AC,(POINT 7,,34)	;MAKE UP POINTER.
	MOVEM	AC,BUFL			;MARK TOP OF TEXT.
	SETOM	-1(AC)			;SET ONES IN FIRST WORD OF INDEX TABLE
	SETOM	(AC)			;AND LAST WORD OF INDEX TABLE
	MOVEI	AC,8B28+4		;LOAD A PRE-SET FORMAT %8.04
	PUSHJ	PP,SETMAX		;AND COMPUTE NUMBER-LIMITS.
	MOVEI	AC,5B28+4		;PRESET E-FORMAT
	MOVEI	T2,1			;SET UP ...
	PUSHJ	PP,SETMAX		;... THE EORMAX VALUE.
	HRRZI	AC,RESTART		;GET NEW START ADDRESS.
	HRRM	AC,.JBSA##		;AND SET SO AS NOT TO WIPE OUT DATA BASE.
	HRRZI	AC,REENTER		;SET UP RE-ENTRY ADDRESS
	HRRM	AC,.JBREN##		;ONLY WHEN DATA BASE IS READY.
IFG XPV,<IFE KA-10,<	JRST	UERR7>>	;GO TO HIGH SEGMENT.
ENDSEG
UERR7:	TLZ	F0,777777		;CLEAR INTERNAL FOCAL FLAGS.
START:	MOVEI	AC,17			;CLEAR OUT ALL BUFFER-SPACE POINTERS
START1:	SETZB	T2,INCHN		;CLEAR CURRENT INPUT CHANNEL SELECTION
	SETZB	AA,OUTCHN		;AND CURRENT OUTPUT CHANNEL SELECTION.
	PUSHJ	PP,LIBIN1		;RELEASE THIS CHANNEL.
	SOJGE	AC,START1		;ONE WORD FOR EACH CHANNEL.
	RESET				;CLEAR ALL PC FLAGS
IFN PDP-6,<
	MOVEI	AC,TRAP.H		;ADDRESS OF TRAP HANDLER
	HRRZM	AC,.JBAPR##		;SET UP TRAP INTERRUPT POINTER.
	MOVEI	AC,AP.FOV+AP.REN	;ENABLE FOR FLOATING POINT OVERFLOW
	APRENB	AC,			;FOR MULTIPLE CALLS.
>;END IFN PDP-6
SUBTTL MAIN CONTROL ROUTINE
QUIT:	SETZB	T2,FORFLAG		;SAY "WE ARE NOT IN A 'FOR'".
	SETZB	T4,LINNUM		;CLEAR LINE NUMBER
	SETZM	FOVSUP			;ALLOW FLOATING-POINT TRAP ERROR MESSAGES
	MOVE	RL,SYMTBH		;SET UP ACCUM RL IN CASE OF ^C^C START.
	AOS	RL			;POINT JUST ABOVE SYMBOL-TABLE.
	MOVE	AC,BUFL			;FIND OLD LIBRA CALL BUFFER START.
	MOVEM	AC,BUFH			;CLEAR THE LIBRA CALL BUFFER AREA.
	MOVSI	T3,(SIXBIT "TTY")	;PREPARE TO INIT TTY.
	OPEN	TTYCHN,T2		;INIT TTY IN ASCII MODE.
PDS:	IOWD	PDC,PDL			;WE HOPE "OPEN" ALWAYS SKIPS THIS.
	MOVE	PP,PDS			;SET UP PUSH-DOWN POINTER.
	MOVEI	UA,"*"			;SET CUE CHARACTER.
	JSP	PC,GETBUF		;ACCEPT AN INPUT BUFFER.
	MOVEM	AC,PNTR			;POINT TO THE INPUT BUFFER.
	JUMPGE	T4,EXECLQ		;IF NOT NEAR END-OF-FILE, EXECUTE THEN QUIT.
	PUSHJ	PP,EXECLN		;EXECUTE A SINGLE LINE.
STOP:
IFLE MONITOR-4.72,<
	MOVEI	AC,17			;CLOSE ALL I/O CHANNELS.
STOP1:	SETZB	AA,T2			;SET FOR RELEASE.
	PUSHJ	PP,AUTIO4		;RELEASE THIS CHANNEL.
	SOJGE	AC,STOP1		;CONTINUE UNTIL ALL FILES PROTECTED.
>;END IFLE MONITOR-4.72
	EXIT


REENTE:IFGE MONITOR-5.04,<
	MOVEI	AC,TTYCHN		;CHECK WHETHER THE TELETYPE IS INITTED.
	DEVCHR	AC,			;TO SEE WHETHER IT'S A TRUE REENTER.
>;END REENTE:IFGE MONITOR-5.04
IFL MONITOR-5.04,<
.JBJDA=75				;ADDRESS OF JOB DATA AREA.
	SETZB	AC,.JBJDA+TTYCHN	;CLEAR LOCATION OF JDA TABLE.
	SLEEP	AC,			;FORCE MONITOR TO REFRESH TABLE.
	MOVE	AC,.JBJDA+TTYCHN	;SEE IF TTY CHANNEL WAS INITTED.
>;END IFL MONITOR-5.04
QUITT:	JUMPN	AC,QUIT			;YES.   IT'S O.K.
RESTAR:	SETZ	F0,			;CLEAR ALL FLAGS.
	MOVEI	PP,PDL+36		;PRESERVE PREVIOUS INITIAL COMMAND
	ERROR	NULL			;ENTER FOCAL WITH AN ERROR MESSAGE.
;THE INTENTION HERE IS THAT WE SET UP A TEMPORARY PUSH-DOWN POINTER SO WE CAN
;TYPE OUT AN ERROR MESSAGE.   THE CORRECT PUSH-DOWN POINTER WILL BE SET UP AFTER
;WE COME TO THE QUIT ROUTINE AFTER THE ERROR MESSAGE HAS BEEN OUTPUT.
;THE REASON THAT WE START THE POINTER PART-WAY UP THE STACK IS THAT MAYBE
;THISPT POINTS TO THE STACK, AND WE DON'T WANT TO CLOBBER IT IF WE CAN HELP IT.
;THE INITIAL COMMAND IS ON THE STACK BECAUSE WE CAN'T GUARANTEE ANY OTHER SPACE.
;FOR EXAMPLE A PROGRAM RUNS OUT OF CORE; WE WANT TO ALLOW ONE LAST COMMAND
IFL PDC-77,PX INSUFFICIENT PUSH-DOWN LIST SPACE.
;ERROR HANDLING REQUIRES 26 OCTAL LOCATIONS IN THE WORST CASE.
	SUBTTL	COMMAND DE-CODER
;ROUTINE TO EXECUTE A LINE
EXECLQ:	PUSH	PP,QUITT		;RETURN TO QUIT AFTER EXECUTING ONE LINE.
EXECLN:	HRRZ	AC,LINNUM		;GET NUMBER OF LINE TO BE EXECUTED.
	SKIPA	MQ,PNTR			;GET POINTER TO BEGINNING OF LINE
EXECL.:	MOVEM	MQ,PNTR			;ENTER HERE WITH AC,MQ & LINNUM SET UP.
EXECL1:	PUSH	PP,LINNUM		;CREATE LINKAGE...
	PUSH	PP,THISPT		;SAVE BEGINNING-OF-LINE POINTER.
	HLLM	PP,LINNUM		;...SEAL THE LINKAGE.
	PUSH	PP,THISLN		;SAVE PREVIOUS LINE NUMBER.
EXECL2:	HRRZM	AC,THISLN		;SAVE FOR ERROR MESSAGES.
	MOVEM	MQ,THISPT		;TO SAVE FOR ERROR MESSAGES.
EXECL3:	STEPP	EXECL6			;GO TO SCAN FOR A COMMAND.
EXECL4:	CAIN	CH,";"			;SEMICOLON?
	HPSTP	EXECL3			;YES.	CONTINUE ALWAYS.
	JUMPN	CH,SYNERR		;MUST BE END-OF-LINE NOW!
	POP	PP,THISLN		;RESTORE PREVIOUS LINE NUMBER.
	POP	PP,THISPT		;RESTORE POINTER FOR ERROR MESSAGES
	POP	PP,AC			;RESTORE LINNUM LINKAGES.
	HLLM	AC,LINNUM		;WITHOUT RUINING THE RETURN COMMAND
	TLNE	F0,(DEBFLG)		;WERE WE DEBUGGING?
	OUTSTR	CRLF			;YES.	FOLLOW LINE WITH CRLF.
CPOPJ:	POPJ	PP,			;RETURN.

EXECL6:	TLNE	CC,(N)			;NUMERIC (OR PERIOD)?
	JRST	NEWLIN			;YES.	INSERT IT.
	TLNN	CC,(A)			;IS IT A VALID COMMAND?
	POPJ	PP,			;NO.
	ANDI	CH,37			;GET THE OFFSET FROM "A" OR "a".
	ROT	CH,-1			;GET TABLE OFFSET.
	SKIPL	CH			;ODD LETTER OF THE ALPHABET?
	SKIPA	AC,COMTAB-1(CH)		;NO.   USE RIGHT-HALF OF TABLE ENTRY.
	HLRZ	AC,COMTAB-0(CH)		;YES.  USE LEFT-HALF OF ENTRY.
	HRRZM	AC,(PP)			;SAVE COMMAND DISPATCH.
	NOCOM==0			;ILLEGAL COMMANDS TRAP HERE...
	TRNN	AC,777777		;VALID COMMAND?
NOCOM1:	ERROR	ILLCOM			;NO.
	HOPP	SWALLOW			;SWALLOW THE REST OF THE COMMAND.
EXECL7:	TLZ	F0,(NUMBER!STRING!LOGICL!NO.INT!CUETTY!IFCMD);CLEAR SOME FLAGS.
	PUSHJ	PP,@(PP)		;DISPATCH.
	CAIN	CH,","			;STOPPED ON A COMMA?
	HPSTP	EXECL7			;YES.   REPEAT THE COMMAND.
	POP	PP,AC			;RESTORE PREVIOUS COMMAND NAME.
	JRST	EXECL4			;CHECK FOR ERRONEOUS LINE TERMINATION.

SWALLO:	TLNE	CC,(A)			;HAVE WE FOUND A NON-LETTER YET?
	HOP	SWALLOW			;NOT YET.
	STEP	CPOPJ			;YES!	SWALLOW THE DELIMITER TOO.
COMTAB:	XWD	ASK,	NOCOM		;AB
	XWD	ENDLN,	DO		;CD
	XWD	ERASE,	FOR		;EF
	XWD	GO,	NOCOM		;GH
	XWD	IF,	NOCOM		;IJ
	XWD	NOCOM,	LIBRA		;KL
	XWD	MOD,	NOCOM		;MN
	XWD	OPERAT,	NOCOM		;OP
	XWD	QUIT,	RET		;QR
	XWD	SET,	TYPE		;ST
	XWD	NOCOM,	NOCOM		;UV
	XWD	WRITE,	EVAL		;WX
	XWD	NOCOM,	NOCOM		;YZ
	SUBTTL UUO HANDLER.

IFE PDP-6,<
UUOH.:	Z				;JSR HERE FROM .JB41
	PUSH	PP,UUOH.		;SAVE RETURN.
>;END IFE PDP-6
UUOH:	MOVE	UA,40			;PRESET CONTENTS OF UA.
	LDB	AA,[POINT 9,UA,8]	;INDEX DISPATCH TABLE ENTRY.
	JRSTF	@UUOTAB-1(AA)		;CLEAR FLAGS AND DISPATCH.
DEFINE X(A,B,C) <
IFG C,<XWD 0,U'A>
>;END DEFINE X(A,B,C)
UUOTAB:	UUOLIST
IFE UUOTAB+1-.,<
;E.G. PDP-6 SINGLE PRECISION VERSION.
	RELOC	UUOH+1			;SAVE TIME AND SPACE.
	JRST	UERROR			;IF ONLY ONE UUO.
>;END IFE UUOTAB+1-.
;UUO'S - GLIDE, HOP, STEP, HPSTP, GLIDEP, HOPP, STEPP, HPSTPP
IFE PDP-6,<
UHPSTP:	TLO	UA,(2,)			;PDP-6 HPSTP & HPSTPP ENTER HERE.
>;END IFE PDP-6
UHOP:	ILDB	CH,PNTR			;HOP OVER THIS CHARACTER.
	JUMPL	F0,UGLIDE		;CAN WE EXAMINE ?'S OR DEBFLG?
	CAIN	CH,"?"			;YES.	IS THIS A "?"?
	TLCA	F0,(DEBFLG)		;	YES.	DON'T PRINT THE "?".
	TLNN	F0,(DEBFLG)		;	NO.	ARE WE PRINTING?
	JRST	UGLIDE			;		NO.
	OUTCHR	CH			;PRINT THE CHARACTER.
IFE PDP-6,<
	SKIPA
USTEP:	TLO	UA,(2,)			;PRESET STEP SECTION.
>;END IFE PDP-6
UGLIDE:	MOVE	AA,PNTR			;DO THIS SO DON'T INCREMENT.
	ILDB	CH,AA			;GET ANSWER.
	CAIN	CH,"?"			;NO.	IS IT A Q.M.?
	JUMPGE	F0,UHOP			;YES. DON'T EXIT WITH ? UNLESS IT'S DATA
	TLNN	UA,(2,)			;STEP SECTION?
	JRST	UGLID1			;NO.	GO SET UP CC AND RETURN
	CAIG	CH," "			;CONTROL CHAR OR SPACE?
	JUMPN	CH,UHOP			;YES.	LOOK FOR ANOTHER.
;HERE TO SET UP CC.
UGLID1:	SETZM	CC			;CLEAR CC IN CASE NO TABLE ENTRY.
	SUBI	CH,"("			;IS THERE A TABLE ENTRY?
	JUMPL	CH,UGLID2		;NO.
	IDIVI	CH,NBYTES		;GET INDEX + REMAINDER.
	MOVE	CH,BYTAB(CH)		;GET ENTRY FROM INDEX.
	IMULI	CC,NBITS		;GET POSITION OF BITS IN WORD.
	LSHC	CH,-44(CC)		;PUT BITS INTO CC.
UGLID2:	LDB	CH,AA			;RESTORE CH.
IFN PDP-6,<
	TLNN	UA,(1,)			;GLIDEP, HOPP, STEPP OR HPSTPP?
	ADJSP	PP,-1			;NO.	DON'T RETURN.
>;END IFN PDP-6
	JRST	(UA)			;RETURN.
	NBYTES==^D36/NBITS		;BYTES OF BITS PER TABLE WORD.

DEFINE BYTES (VALUE,FLAGS,NUMBER)<
IFL VALUE-XX,PX BYTAB ERROR VALUE
REPEAT VALUE-XX,<X 0>
REPEAT NUMBER,<X FLAGS>
>;END DEFINE BYTES (VALUE,FLAGS,NUMBER)
DEFINE X(FLAGS)<
XXX=XXX!<<FLAGS>_<-NBITS*XXXX>>
XXXX==XXXX+1
IFE XXXX-NBYTES,<
EXP XXX
XXX==0
XXXX==0
>;END IFE XXXX-NBYTES
XX==XX+1
>;END DEFINE X(FLAGS)
XXX==0
XXXX==0
XX==<"(">
BYTAB:	BYTES	<"(">,LP,1
	BYTES	<")">,RP,1
	BYTES	<".">,N,1
	BYTES	<"0">,AN!N,^D10
	BYTES	74,LP,1;"<"
	BYTES	76,RP,1;">"
	BYTES	<"A">,AN!A,4
	BYTES	<"E">,A!E,1
	BYTES	<"F">,AN!A,^D21
	BYTES	<"[">,LP,1
	BYTES	<"]">,RP,1
	BYTES	<"a">,AN!A,4
	BYTES	<"e">,A!E,1
	BYTES	<"f">,AN!A,^D21
	BYTES	177,0,1
IFN XXXX-NBYTES,<EXP XXX>
IFG XPV,<
;DOUBLE-PRECISION UUO HANDLER.
IFN KI+KL-10,<
UMOVE:	MOVE	AC,(UA)			;HIGH ORDER PART
	MOVE	MQ,1(UA)		;LOW ORDER PART
	POPJ	PP,			;RETURN

UMOVEM:	MOVEM	AC,(UA)			;HIGH ORDER PART
	MOVEM	MQ,1(UA)		;LOW ORDER PART
	POPJ	PP,			;RESTORE & RETURN.

UEXCH:	EXCH	AC,(UA)			;HIGH ORDER PART.
	EXCH	MQ,1(UA)		;LOW ORDER PART.
	POPJ	PP,			;RESTORE AND RETURN.
>;END IFN KI+KL-10

UPUSH:	POP	PP,AA			;SAVE RETURN ADDRESS
	PUSH	PP,(UA)			;NO.	MUST BE DPUSH
	PUSH	PP,1(UA)		;LOW ORDER
	JRST	@AA			;RETURN
>;END IFG XPV

;CHARACTER-INPUT ROUTINE.
UINCHR:	SKIPN	AA,INCHN		;TELETYPE INPUT?
	JRST	UINCH2			;YES.
	IMULI	AA,WPC			;GET INDEX TO BUFFER HEADER.
	SOSG	HEDTAB+2(AA)		;BUFFER EMPTY?
	JRST	UINCH3			;YES.
UINCH:	ILDB	AA,HEDTAB+1(AA)		;GET CHARACTER.
UINCH0:	JUMPE	AA,UINCHR		;IGNORE NULL CHARACTERS.
	MOVEM	AA,(UA)			;STORE WHERE REQUESTED.
	POPJ	PP,			;RETURN.

;HERE IF TELETYPE INPUT.
UINCH2:	INCHRW	AA			;ACCEPT A KEYBOARD CHARACTER.
	CAIE	AA,32			;WAS IT A CONTROL-Z?
	JRST	UINCH0			;NO.	RETURN.
	JRST	STOP			;YES.   RELEASE AND EXIT.

;HERE TO RE-FILL AN INPUT BUFFER.
UINCH3:	MOVE	PC,INCHN		;GET CHANNEL NUMBER
	LSH	PC,27			;IN ACCUMULATOR FIELD,
	TLO	PC,(IN)			;TO MAKE AN 'IN' INSTRUCTION,
	XCT	PC			;WHICH WE CAN THEN EXECUTE.
	JRST	UINCH			;FILLED OK.
	HRRI	PC,PC			;RESULTS OF GETSTS IN PC.
	TLC	PC,(<GETSTS>^!<IN>)	;GETSTS.XOR.IN
	XCT	PC			;EXECUTE GETSTS UUO.
	TRZN	PC,EOF			;END OF FILE?
	ERRORR	INPERR(PC)		;NO. MUST HAVE BEEN ERRORS.
	SETOM	(UA)			;YES. END-OF-FILE.
	POPJ	PP,			;RETURN FROM UUO.
;OUTPUT ROUTINES.
;SUBROUTINE TO OUTPUT A CHARACTER TO THE OUTPUT FILE OR LIBRARY SAVE FILE.
;THE CHARACTER MUST BE IN UA, THEN COME HERE WITH A PUSHJ.
UOUTCH:	JSP	PC,UOUTI		;TELETYPE OUTPUT?
	 OUTCHR	UA			;YES.
UOUTC1:	SOSG	HEDTAB+2(AA)		;NO.   BUFFER FULL?
	PUSHJ	PP,UOUTC2		;YES.
	IDPB	UA,HEDTAB+1(AA)		;DEPOSIT CHARACTER.
	POPJ	PP,			;RETURN.

;HERE TO EMPTY A BUFFER.
UOUTC2:	MOVE	PC,OUTCHN		;GET CHANNEL NUMBER
	LSH	PC,27			;IN ACCUMULATOR FIELD,
	TLO	PC,(OUT)		;TO MAKE AN 'OUT' INSTRUCTION,
	XCT	PC			;WHICH WE CAN THEN EXECUTE.
	POPJ	PP,			;FILLED OK.
	HRRI	PC,PC			;GETSTS WILL PUT STATUS IN PC.
	TLC	PC,(<GETSTS>^!<OUT>)	;GETSTS.XOR.OUT
	XCT	PC			;EXECUTE GETSTS UUO.
	ERRORR	OUTERR(PC)		;ERROR ON OUTPUT.

;HERE TO OUTPUT A STRING TO THE OUTPUT FILE OR LIBRA SAVE FILE.
UOUTST:	JSP	PC,UOUTI		;TELETYPE OUTPUT?
	 OUTSTR	(UA)			;YES.
	HRLI	UA,(POINT 7,,)		;NO.   MAKE A POINTER WORD
	MOVEM	UA,40			;WHERE IT CAN BE USED.
OUTST1:	ILDB	UA,40			;GET NEXT CHARACTER OF STRING.
	JUMPE	UA,CPOPJ		;TERMINATING NULL?	YES.
	PUSHJ	PP,UOUTC1		;OUTPUT A CHARACTER.
	JRST	OUTST1			;LOOP TO COMPLETE.

;HERE TO SET BUFFER HEADER INDEX INTO AA UNLESS ASK COMMAND OR TTY OUTPUT.
;IN WHICH CASE EXECUTE TTCALL UUO OR MERELY POPJ.
UOUTI:	TLNE	F0,(CUETTY)		;ASK MODIFY OR LINE-INPUT?
	SKIPA	AA,INCHN		;YES. ONLY OUTPUT IF TTY IS INPUT.
	SKIPA	AA,OUTCHN		;NO. GET OUTPUT CHANNEL NUMBER.
	JUMPN	AA,CPOPJ		;ASK MODIFY OR LINE-INPUT - DONE IF INPUT NOT TTY.
	IMULI	AA,WPC			;GET INDEX TO BUFFER HEADER.
	JUMPN	AA,1(PC)		;NOT ASK COMMAND - NORMAL OUTPUT IF NOT TTY.
	XCT	0(PC)			;EXECUTE TTCALL UUO.
	POPJ	PP,
;ERROR UUO
UERROR:	PUSH	PP,AC			;SAVE AC.
	PUSH	PP,MQ			;SAVE MQ.
	PUSH	PP,OUTCHN		;SAVE IN CASE NON-FATAL.
	SETZB	MQ,OUTCHN		;FLAG FATAL ("?") & PUT ERROR MESSAGES ON TTY.
	HRRZI	AA,UERR7		;GET FATAL RETURN-ADDRESS.
	TRZN	UA,F			;FATAL ERROR?
	AOSA	MQ			;NO.
	HRRM	AA,-3(PP)		;YES.   MAKE IT RETURN TO START.
	TRNE	F0,ERRSUP		;SUPPRESS MESSAGE?
	JUMPN	MQ,UERR6		;YES.
	SKPINC				;AWAKEN TELETYPE OUTPUT IF ASLEEP.
	JFCL				;AND IGNORE THE NON-SKIP RETURN.
	OUTSTR	UERR9(MQ)		;TYPE CARRIAGE-RETURN-LINE-FEED AND ? OR %
	LDB	MQ,[POINT 4,UA,26]	;GET MESSAGE NUMBER TIMES TWO.
	MOVE	MQ,ERRTAB(MQ)		;ASSUME IT WAS AN ODD NUMBERED MESSAGE
	TRZN	UA,1B27			;WAS IT?
	MOVSS	MQ			;NO.   GET MESSAGE ADDRESS.
	OUTSTR	0(MQ)			;PRINT ERROR MESSAGE.
	TLZE	UA,(Y)			;WANT " error  " TYPED?
	OUTSTR	UERR8			;YES.
	TRZN	UA,M			;IS A MONITOR CODE VALID?
	JRST	UERR1			;NO.
	HRRZM	UA,AC			;SAVE ERROR CODE.
	ANDI	AC,760077		;RESTRICT TYPE-OUT IN SIZE.
	MOVEI	AA,8			;OCTAL
	PUSHJ	PP,TYPIN1		;PRINT A TWO-FIGURE NUMBER.
UERR1:	MOVE	AC,THISLN		;GET LINE OF EXECUTION.
	SKIPN	MQ,THISPT		;IN WHICH CASE USE THISPT.
	JRST	UERR6			;AVOID THE CASE WHERE NO THISPT IS SET UP.
	PUSHJ	PP,TYPLIN		;TYPE LINE NUMBER AND CONTENTS.
	SETZM	AC			;INITIALIZE COUNTER.
UERR2:	CAMN	MQ,PNTR			;POINTER-MATCH YET?
	JRST	UERR3			;YES.   MARK IT.
	ILDB	AA,MQ			;FOLLOWED BY CHARACTERS
	CAIN	AA,"	"		;TAB?
	TROA	AC,7			;YES. COUNT TO TAB POSITION.
	CAIL	AA,40			;NO.   PRINTING CHAR?
	AOS	AC			;YES.
	JUMPN	AA,UERR2		;UNTIL END OF LINE
	JRST	UERR6			;AVOID CASE WHERE NO MATCH WAS FOUND
UERR3:	SKIPE	THISLN			;LINE NUMBER TYPED OUT ABOVE?
	OUTCH	"	"		;YES.   ALIGN OURSELVES UNDERNEATH.
	JUMPE	AC,UERR5		;POINTER AT BEGINNING OF LINE?
UERR4:	OUTCH	" "			;NO. SPACE ACROSS TO IT.
	SOJG	AC,UERR4		;COUNT UNTIL TIME TO DO "^".
UERR5:	OUTCH	"^"			;PRINT "^" BELOW ERROR.
	OUTST	CRLF			;THEN END OF LINE.
UERR6:	AOS	.JBERR##		;INCREMENT ERROR COUNT.
	POP	PP,OUTCHN		;RESTORE OUTPUT CHANNEL.
	POP	PP,MQ			;RESTORE MQ.
	JRST	TPOPJ			;RETURN IF NON-FATAL.

UERR8:	ASCIZ " error  "
UERR9:	ASCIZ "?
?"
	ASCIZ "%
%"
DEFINE X(ERNAME,FLAGS,TEXT) <
IFE XXX&1,<
DEFINE XX(XXX) <
XWD [ASCIZ "TEXT"],XXX
>;END DEFINE XX(XXX)
>;END IFE XXX&1
IFN XXX&1,<
XX [ASCIZ "TEXT"]
>;END IFN XXX&1
XXX=XXX+1
>;END DEFINE X(ERNAME,FLAGS,TEXT)
XXX=0
ERRTAB:	ERRLIST
IFN XXX&1,<XX 0>
SUBTTL TRAP HANDLER FOR FLOATING OVERFLOW, UNDERFLOW OR DIVIDE CHECK
FOVANS:	TLZA	PC,(FXU)		;HERE TO GIVE FOV ANSWER.
FXUANS:	TLO	PC,(FXU!FOV)		;HERE TO GIVE FXU ANSWER.
IFE KI-10,<IFL MONITOR-5.06,<TLO PC,(FOV)>>;SATISFY KI-10 THAT IT'S TRUE.
	HRRI	PC,ABS+1		;POINT TO AN INSTRUCTION LIKE FADL
	MOVEM	PC,.JBTPC##		;PRETEND WE CAME FROM THERE.
TRAP.H:IFG XPV,<
IFE KA-10,<
	HRRZ	PC,.JBTPC##		;GET TRAP ADDRESS
	CAIG	PC,DFAEND		;INSIDE UUO HANDLER?
	CAIG	PC,DFABEG		;INSIDE UUO HANDLER?
	JRST	TRAP01			;NO.
	HRRI	PC,ABS+1		;YES.   PRETEND LIKE FADL.
	HRRM	PC,.JBTPC##		;AND POPJ.
TRAP01:
>;END IFE KA-10
>;END TRAP.H:IFG XPV
	HLLZ	PC,.JBTPC##		;GET TRAP FLAGS.
IFE KI-10,<
IFL MONITOR-5.06,<
	TLNN	PC,(FOV)		;ARITHMETIC OVERFLOW FROM KI-10?
	JRST	TRPXIT			;YES. ONLY COME HERE FOR KI-10.
>;END IFL MONITOR-5.06
>;END IFE KI-10
	PUSH	PP,UA			;SAVE UA FOR ERROR UUO.
	PUSH	PP,AA			;SAVE AA FOR ERROR UUO.
	TLNN	PC,(FXU)		;OVERFLOW?
	MOVEI	PC,FOVERR-FXUERR	;YES!
	SKIPN	FOVSUP			;ARE ERROR MESSAGES SUPPRESSED?
	ERROR	FXUERR(PC)		;NO.   UNDERFLOW.
	MOVE	PC,.JBTPC##		;RESTORE PC.
	HRLOI	AA,377777		;STORE INFINITY FOR OVERFLOW.
	TLNE	PC,(FXU)		;UNDERFLOW?
	SETZM	AA			;YES.	CLEAR ANSWER.
	LDB	PC,[POINT 4,-1(PC),12]	;PICK THE INSTRUCTION'S ACCUMULATOR.
	MOVEM	AA,(PC)			;STORE TO ACCUMULATOR.
IFG XPV,<
IFE KA-10,TLZ	AA,033000		;FIDDLE LOW ORDER KA-10 WORD.
	MOVEM	AA,1(PC)		;STORE TO ACCUM+1.
>;END IFG XPV
	POP	PP,AA			;RESTORE AA.
	POP	PP,UA			;AND UA.
TRPXIT:	HRRZ	PC,.JBTPC##		;CLEAR FLAGS.
	JRSTF	@PC			;RETURN. --  PDP-6 REQUIRES @ NOT ().
	SUBTTL	GUTS
COMMENT \
	THE FOLLOWING RULES WILL APPLY TO EACH ROUTINE IN THE GUTS SECTION:
ON ENTRY, THE EXECUTION POINTERS F0,CH,PNTR ARE SET UP FOR
THE FIRST NON-BLANK AFTER THE COMMAND NAME.

ALL ACCUMULATORS MAY BE USED WITHOUT RESTORING THEM.
ON EXIT, THE EXECUTION POINTERS MUST POINT TO THE FIRST NON-BLANK NOT
YET EXECUTED (NORMALLY CR OR SC).	THIS CAN USUALLY BE ACCOMPLISHED
BY USING STEP CPOPJ.
\

;RETURN STATEMENT.
RET:	MOVEI	AC,777776		;PICK HIGHEST POSSIBLE LINE NUMBER
	HRRM	AC,LINNUM		;AND PRETEND THAT'S WHERE WE'VE BEEN.

IFLOG:	JUMPL	AC,CPOPJ		;COME HERE AFTER A LOGICAL IF.

;COMMENT OR CONTINUE STATEMENT.
ENDLN:	JUMPE	CH,CPOPJ		;WAIT FOR END OF LINE.
	HPSTP	ENDLN			;KEEP LOOKING.


;GO STATEMENT.
GO:	CAIE	CH,";"			;GO WITH NULL ARGUMENT?
	JUMPN	CH,GO1			;(OTHERWISE IT'S "DO ALL")
	PUSHJ	PP,ENDLN		;IGNORE COMMENTS AFTER COMMAND.

;DO STATEMENT.
DO:	JSPPC	LIMSET			;READ ARGUMENT, SET LUPARG,LINNUM
					;DO NOT RETURN HERE IF NOTHING TO DO.
	JRST	EXECL.			;EXECUTE ONE LINE - RETURN TO LIMNXT.

;ERASE STATEMENT.
ERASE:	JUMPGE	CC,CLRVAR		;ERASE VALUES IF NO ARGUMENT.
	JSPPC	LIMSET			;READ ARGUMENT, SET LUPARG,LINNUM
	JRST	DELINE			;ERASE ONE LINE - RETURN TO LIMNXT.
;FOR STATEMENT.
FOR:	TLO	F0,(NUMBER)		;FORCE A NUMERIC-ONLY SET.
	PUSHJ	PP,SET			;HANDLE UP TO FIRST ARGUMENT.
					;RETURN WITH T3/ SYMBOL TABLE INDEX.
	CAIE	CH,","			;ANY MORE ARGUMENTS?
	POPJ	PP,			;NO.	HANDLE AS SPECIFIED.
	PUSH	PP,FORFLAG		;SAVE STATUS.
	HRRO	AC,LINNUM		;GET CURRENT LINE NUMBER.
	MOVEM	AC,FORFLAG		;SAY "WE ARE IN A 'FOR'."
	PUSH	PP,T2			;SAVE SYMBOL.
	DPUSH	PP,ONE			;SAVE DEFAULT INCREMENT.
	HPSTPP	EVALN			;GET NEXT NUMERIC ARGUMENT.
	CAIE	CH,","			;THIRD ARGUMENT?
	JRST	FOR1			;NO.
	DMOVEM	AC,-XPV(PP)		;YES.	LAST MUST HAVE BEEN SECOND.
	HPSTPP	EVALN			;GET REAL THIRD.
FOR1:	DPUSH	PP,AC			;SAVE FINAL VALUE.
FOR2:	JSP	PC,DUPLIC		;REPLICATE CURRENT LINNUM & PNTR.
	HRRZ	AC,LINNUM		;SET UP AC TO SAVE LINNUM.
	MOVE	MQ,THISPT		;SET UP MQ TO SAVE THISPT.
	PUSHJ	PP,EXECL1		;EXECUTE REMAINDER OF LINE.
	POP	PP,PNTR			;RESTORE POINTER TO MID-LINE.
	POP	PP,LINNUM		;RESTORE PP STACK.
	MOVE	T2,-<WPV*2>(PP)		;RETRIEVE SYMBOL.
	DMOVE	AC,-2*WPV+1(PP)		;RETRIEVE INCREMENT.
	JSP	PC,FINDSYMBOL		;SEARCH SYMBOL TABLE.
	  JRST	FOR3			;ABORT FOR IF SYMBOLS DESTROYED.
	DFAD	AC,@T3			;UPDATE.
	DMOVEM	AC,@T3			;UPDATE.
	DFSB	AC,-XPV(PP)		;COMPARE VARIABLE WITH 3RD ARG
	SKIPGE	-2*WPV+1(PP)		;NEGATIVE INCREMENT?
	MOVNS	AC			;YES. REVERSE COMPARISON.
	JUMPLE	AC,FOR2			;RE-CYCLE TO MORE EXECUTION.
FOR3:	ADJSP	PP,-WPV*2-1		;RESTORE PP.
	POP	PP,FORFLAG		;RESTORE 'FOR' STATUS.
	POPJ	PP,			;RETURN.

;NOTE:	WE EXIT WITH PNTR IN MIDDLE OF LINE BUT CC,CH AT AN EOL.
;THIS SHOULD NOT CAUSE SERIOUS PROBLEMS EXCEPT AT LIBCL2:.
;DIRECT TRANSFER.

GO1:	CAIE	CH,"T"			;"GO TO" - CHECK SPELLING, AT LEAST FIRST CH
	CAIN	CH,"t"			;OR LOWER CASE T.
	PUSHJ	PP,SYMB			;READ IT IN WHATEVER IT IS.
GO2:	PUSHJ	PP,GETLN		;PICK UP ARGUMENT.
	PUSHJ	PP,FINDLN		;FIND THE LINE IN THE TEXT.
	ERROR	NOLINE			;NOT FOUND.
	ADJSP	PP,-2			;REMOVE ITEMS PUSHED BY EXECLN ROUTINE.
	HRRO	T4,LINNUM		;GET CURRENT LINE
	TRNE	T4,777777		;IMMEDIATE MODE OR LIBRA CALL?
	JRST	GO4			;NO.
	PUSHJ	PP,ENDLN		;MOVE PNTR TO END OF LINE.
	POP	PP,THISLN		;RESTORE PREVIOUS LINE NUMBER
	POP	PP,THISPT		;RESTORE PREVIOUS POINTER
	POP	PP,LINNUM		;RESTORE LINKAGE.
	DMOVEM	AC,T2			;SAVE OBJECT LINE NUMBER.
IFE XPV,<MOVEM	MQ,T3>			;SAVE OBJECT LINE POINTER.
	CAME	T4,FORFLAG		;FOR...GOTO ON SAME LINE?
	SETZM	AC			;NO. MAKE IT "DO ALL".
	JSPPC	LIMSE2			;YES. DUMMY UP PRIOR "DO ALL".
	MOVE	MQ,T3			;RESTORE OBJECT LINE POINTER.
	HRRM	T2,LINNUM		;OVERWRITE OLD NUMBER.
	MOVE	PC,GO3			;PREPARE FOR A DO LOOP.
	MOVEM	PC,-1(PP)		;PUT THE REPEAT SPOT ON THE STACK.
GO3:	JRST	EXECL.			;EXECUTE LINE.

GO4:	HRRM	AC,LINNUM		;OVERWRITE OLD NUMBER.
	MOVEM	MQ,PNTR			;SET FOR EXECUTION.
	JRST	EXECL2			;GO DO IT.
;IF COMMAND.
IF:	TLO	F0,(IFCMD)		;FLAG THAT IT'S AN IF COMMAND.
	PUSHJ	PP,EVAL			;GET NUMERIC OR LOGICAL VALUE.
	TLNE	F0,(STRING)		;STRING?
	ERROR	SYNTAX			;THAT'S ILLEGAL.
	TLNE	F0,(LOGICL)		;WAS IT A LOGICAL-IF?
	JRST	IFLOG			;YES.
	JUMPL	AC,GO2			;IF LESS, GOTO.
	PUSHJ	PP,IFSKIP		;SKIP OVER LINE NUMBER.
	JUMPE	AC,GO2			;IF EQUAL, GOTO.
	PUSHJ	PP,IFSKIP		;SKIP OVER LINE NUMBER.
	JRST	GO2			;MUST BE GREATER.

IFSKIP:	TLNE	CC,(N)			;PASS OVER LINE NUMBER, EVEN IF IT IS ILLEGAL
	HOP	IFSKIP			;MOVE OVER ONE CHAR.
	STEP	.+1			;PASS TRAILING SPACES.
	CAIN	CH,","			;COMMA?
	HPSTP	CPOPJ			;YES.   SKIP IT AND CONTINUE.
	JRST	APOPJ			;RETURN TWO LEVELS.
;SET STATEMENT.
;THIS ROUTINE IS ALSO CALLED BY THE 'FOR' ROUTINE, FOR WHICH AN ARGUMENT
;IS RETURNED IN T2, NAMELY THE SYMBOL NAME.
SET:	PUSHJ	PP,SYMBOL		;GET SYMBOL & SUBSCRIPT INTO T2.
	CAIE	CH,"="			;CHECK.
SYNERR:	ERROR	SYNTAX			;UH!
	HPSTPP	EVAL			;GET VALUE INTO AC,MQ.
SET1:	JSP	PC,FINDSYMBOL		;SCAN THE SYMBOL TABLE TO MATCH THE NAME.
	  SKIPA				;NO MATCH.
	JRST	SET4			;FOUND A MATCH.
	TLNN	F0,(IFCMD)		;AN IF COMMAND?
	JUMPE	AC,CPOPJ		;NO. PRESUMABLY SET. DON'T STORE A NEW NULL VALUE.
	PUSHJ	PP,FIT			;WILL A NEW SYMBOL FIT IN CORE?
	MOVNI	AA,WPV*2		;GET MODIFICATION.
	ADDM	AA,SYMTBL		;MODIFY IT BACK.
	HRRI	PC,@SYMTBL		;GET BOTTOM OF SYMBOL TABLE.
	HRLI	PC,WPV*2(PC)		;FIND LOWEST USEFUL WORD.
	HRRI	UA,@T3			;FIND HIGHEST WORD TO SHIFT.
	BLT	PC,-WPV*2(UA)		;SHIFT PART OF SYMBOL TABLE.
	MOVEM	T2,@T3			;STORE THE NAME.
	SUBI	T3,WPV			;POINT TO THE DATA.
SET4:	JUMPL	T2,SET6			;ARE WE STORING A STRING VALUE?
	PUSH	PP,BUFH			;YES. MAKE SPACE.
	MOVEI	AC,1(MQ)		;FIRST FIND THE LENGTH OF THE STRING.
	SUBI	AC,@BUFH		;WHICH STARTS AT WHERE BUFH POINTS.
	ADDM	AC,BUFH			;COVER THE SOURCE DATA.
	ADDM	AC,BUFH			;COVER THE NEW SPACE NEEDED.
	PUSHJ	PP,FIT			;ENSURE THERE IS SPACE AVAILABLE.
	POP	PP,BUFH			;RESTORE BUFH.
	MOVNS	AC			;GET NUMBER OF WORDS TO MOVE IN NEG. FORM.
	HRLI	AA,@SYMTBL		;SOURCE FOR BLOCK TRANSFER.
	ADDM	AC,SYMTBL		;MAKE NEW LOW LIMIT.
	ADDM	AC,T3			;THE SLOT WILL MOVE TOO.
	HRRI	AA,@SYMTBL		;DESTINATION FOR BLOCK TRANSFER.
	ADDB	AC,SYMTBC		;AND NEW HIGH LIMIT.
	BLT	AA,@AC			;MOVE SYMBOL TABLE TO MAKE SPACE FOR STRING
	MOVE	PC,BUFH			;GET SOURCE POINTER.
	MOVE	UA,AC			;GET DESTINATION POINTER.
SET5:	CAMN	PC,MQ			;LAST CHARACTER YET?
	TDZA	AA,AA			;YES.  DEPOSIT A NULL.
	ILDB	AA,PC			;NO.   PICK UP A BYTE.
	IDPB	AA,UA			;DEPOSIT IT.
	JUMPN	AA,SET5			;CONTINUE UNTIL A NULL IS FOUND.
SET6:	DMOVEM	AC,@T3			;DEPOSIT NEW VALUE IN TABLE.
	POPJ	PP,			;RETURN.
;ASK STATEMENT.
ASK:	TLOA	F0,(CUETTY)		;FLAG FOR DIRECTING OUTPUT.
;TYPE STATEMENT.
TYPE:	TDZA	T2,T2			;INDEX TO OUTCHN.
	MOVEI	T2,1			;INDEX TO INCHN.
	TLZ	F0,(NUMBER!STRING)	;ALLOW CASES LIKE TYPE FOO"HELLO"
	JUMPE	CH,CPOPJ		;PREVENT INDEXING TYPDSP BY ZERO.
	PUSH	PP,-1(PP)		;SET TO LOOP FOR CASES LIKE TYPE !!!
IFGE SIZE,<				;IF ENOUGH CORE ...
	CAILE	CH,43			;AVOID DISPATCH FOR ASK %, ASK $.
	JUMPN	T2,TYP1			;(ASK WILL JUMP)
>;END IFGE SIZE
	CAIG	CH,45			;SELECT !"#$%
	XCT	TYPDSP-41(CH)		;FOR A DIRECT DISPATCH.
TYP1:	CAIN	CH,"'"			;FIRST SINGLE QUOTE?
	HOP	TYPE1S			;YES.
	CAIE	CH,"/"			;CHANNEL SELECTION?
	JRST	TYPE4			;NO.
	HPSTPP	GETLN			;GET CHANNEL NUMBER.
	LSH	AC,-7			;MAKE IT AN INTEGER.
	CAIG	AC,17			;CHECK CHANNEL BUT REMEMBER MQ IS ZERO.
	MOVE	MQ,BUFTAB(AC)		;GET I/O INDICATOR WORD.
	SKIPN	T2			;TYPE?
	MOVNS	MQ			;YES. SHOULD MAKE IT POSITIVE.
	SKIPE	AC			;CHANNEL ZERO IS TTY:.
	JUMPLE	MQ,TYPERR		;WRONG IF NO CHANNEL SELECTED.
					;OR WRONG MODE SELECTED.
	MOVEM	AC,OUTCHN(T2)		;SAVE NEW SELECTION OF CHANNEL.
	STEP	CPOPJ			;RETURN.
TYPERR:	ERROR	CHNERR			;WRONG SELECTION.
	STEP	CPOPJ			;(WARNING MESSAGE ONLY.)

TYPDSP:	HPSTP	TLFPPJ			;! PRINT CRLF.
	JUMPG	T2,TYPE1A		;" ASK: PRINT TEXT. TYPE: PRINT STRING EXP.
	HPSTP	TYPE3			;# PRINT CR ONLY.
	HPSTP	TYPE6			;$ PRINT SYMBOL TABLE.
	HOP	TYPE2			;% CHANGE FORMAT.
;'
TYPE1S:	OUTCH	42			;PRINT A DOUBLE QUOTE.
;"
TYPE1:	TLZ	F0,(NO.INT)		;ENABLE DEBUG SENSOR.
	JUMPE	CH,TPOPJ		;END OF LINE?
	CAIN	CH,42			;NO.	CLOSING DOUBLE QUOTE?
	HPSTP	CPOPJ			;YES.
	OUTCH	0(CH)			;NO.	TYPE THE CHARACTER.
TYPE1A:	TLO	F0,(NO.INT)		;SUPPRESS DEBUG TYPEOUT.
	HOP	TYPE1			;CONTINUE.
;%
TYPE2:	TLNE	CC,(E)			;%E OR %?
	AOJA	T2,[HOP	.+1
			]		;%E.   HOP OVER THE "E".
	PUSHJ	PP,GETLN		;READ SPECIFIED VALUE
SETMAX:	MOVEM	AC,T3			;SAVE NEW FIELD WIDTHS.
	IDIVI	AC,200			;PUT TOTAL DIGITS IN AC
	CAIL	AC,^D100		;LIMIT WIDTH TO 99
	JRST	TYPE2E			;SO AVOID PDL OV ON TYPE-OUT.
IFL PDC-100,PRINTX %MAY HAVE PROBLEMS TYPING WIDE FORMATS.
	MOVE	T4,AC			;SAVE # DIGITS TOTAL.
	SUB	AC,MQ			;SUBTRACT DIGITS RIGHT
	JUMPL	AC,TYPE2E		;LEGAL SPECIFIER?
	JUMPE	T2,TYPE2B		;YES.   %E?
	JUMPE	AC,TYPE2E		;YES.
	MOVEI	T4,1(MQ)		;LEGAL %E - SET F-PART WIDTH.
	MOVEI	AC,1			;AND MAX SIZE OF F-PART TYPEOUT.
TYPE2B:	MOVEM	T3,FORMAT(T2)		;STORE FORMAT OR EORMAT.
	IMULI	T2,WPV			;MAKE AN INDEX TO FORMAX/EORMAX.
	PUSHJ	PP,DFLOAT		;COMPUTE APPROXIMATE LOG
	DMOVEM	AC,FORMAX(T2)		;TO COMPARE WITH VALUES FOR TYPING.
	CAIL	T4,^D20			;PREVENT ERROR MESSAGE ...
	STEP	CPOPJ			;... FOR WIDE FORMATS.
	MOVN	AC,T4			;RESTORE DIGITS TOTAL
	PUSHJ	PP,ANTILI		;GET 10**<-#DIGITS TOTAL>
	HALVE	ACCUM			;GET ROUNDING FACTOR
	NEGATE	ACCUM			;TO COMPARE
	DFAD	AC,ONE			;WITH TOTAL # DIGITS
	PUSHJ	PP,LOG10		;FORMAX IS A LOGARITHM
	DFAD	AC,FORMAX(T2)		;ADD ROUNDING IN.
	DMOVEM	AC,FORMAX(T2)		;ADD ROUNDING IN.
	STEP	CPOPJ

TYPE2E:	ERROR	FRMERR			;NO.
	STEP	CPOPJ			;IGNORE AN ILLEGAL %E.
TYPE3:	OUTCH	15			;CR.
IFLE MONITOR-3.27,<OUTCH 15>		;ADD FILLER FOR OLD MONITORS.
	POPJ	PP,

ASK4:	TLNN	CC,(A)			;VALID SYMBOL FOLLOWING?
	JRST	TPOPJ			;NO. RETURN.
	PUSHJ	PP,SYMBOL		;COLLECT SYMBOL & SUBSCRIPT IN T2.
	MOVEI	UA,":"			;SET CUE CHARACTER.
	TRNE	F0,COLSUP		;SHOULD IT BE SUPPRESSED?
	SETZM	UA			;YES.
	JSP	PC,GETBUF		;READ IN THE NUMBER.
ASK2:	CAIN	T4,33			;WAS THE DELIMITER AN ESCAPE?
	POPJ	PP,			;YES.	DO NOT MODIFY VALUE.
	JSP	PC,NEWTXT		;SET TO POINT TO
	XWD	LINNUM,AC		;... INPUT DATA.
	SKIPGE	T2			;STRING VALUE BEING INPUT?
	STEPP	GETNM			;NO.  COLLECT NUMERIC VALUE.
	PUSHJ	PP,GETVL2		;IF IT'S A STRING, COLLECT IT.
	JSP	PC,OLDTXT		;RESTORE POINTERS.
	JRST	SET1			;SET IN VALUE AND RETURN
;TYPE ALL VARIABLES IN ALPHABETICAL ORDER.
TYPE6O:	MOVSI	T2,(1B0)		;FLAG THAT OCTAL IS REQUIRED.
TYPE6:	CAIN	CH,"$"			;DOUBLE DOLLAR?
	HPSTP	TYPE6O			;YES.	INCLUDE OCTAL IN COMMENT
	MOVEI	T3,@SYMTBL		;SET TO BOTTOM OF TABLE.
TYPE60:	OUTST	CRLF
	MOVEI	T3,WPV*2(T3)		;MOVE TO NEXT ENTRY.
	CAILE	T3,@SYMTBC		;ARE THERE MORE ENTRIES?
	POPJ	PP,			;NO.
	OUTST [	ASCIZ "S "]		;FORMAT SO YOU CAN READ IT BACK.
	HLLZ	AC,@T3			;SIXBIT SECTION TO LEFT/AC.
	TLO	AC,(1B0)		;REMOVE THE FLAG BIT.
TYPE61:	ROT	AC,6			;GET SIX BITS.
	OUTCH	40(AC)			;TYPE IT IN ASCII.
	HLLZS	AC			;CLEAR RIGHT HALF.
	JUMPN	AC,TYPE61		;LOOP UNTIL SYMBOL IS TYPED OUT
	SKIPL	T4,@T3			;GET INDEX.
	OUTCH	"$"			;GET CORRECT NAME IF A STRING NAME.
	HRRZ	AC,T4			;GET THE INDEX.
	JUMPE	AC,TYPE62		;DON'T PRINT A ZERO INDEX.
	OUTCH	"("			;TYPE "(".
	PUSHJ	PP,TYPINT		;TYPE IT.
	OUTCH	")"			;CLOSE OFF THE INDEX FIELD.
TYPE62:	OUTCH	"	"		;SEPARATE SYMBOL FROM VALUE
	DMOVE	AC,-WPV(T3)		;GET VALUE.
	JUMPL	T4,TYPE65		;NUMBER?
	OUTST [	ASCIZ /=	"/]	;NO.	TYPE A STRING EXPRESSION.
	SKIPA	T5,AC			;SAVE ADDRESS OF STRING.
TYPE63:	OUTCH	0(AC)			;OUTPUT A CHARACTER.
TYPE64:	ILDB	AC,T5			;GET NEXT CHARACTER OF THE STRING.
	JUMPE	AC,TYPE68		;DONE IF WE REACH A NULL.
	CAIE	AC,42			;SPECIAL TREATMENT FOR A DOUBLE-QUOTE.
IFL MONITOR-5.05,<CAIL	AC,175>		;SPECIAL TREATMENT FOR ALTMODE OR RUBOUT.
IFGE MONITOR-5.05,<CAIL	AC,177>		;SPECIAL TREATMENT FOR RUBOUT.
	JRST	TYPE69			;SPECIAL TREATMENT.
	CAIL	AC,40			;SPECIAL TREATMENT FOR CONTROL CHARACTERS
	JRST	TYPE63			;OTHERWISE ITS STRING CHARACTER EQUIVALENT
TYPE69:	OUTST [	ASCIZ /"+FCHR$(/]	;TERMINATE THE CONSTANT.
	PUSHJ	PP,TYPINT		;TYPE ITS VALUE.
	OUTST [	ASCIZ /)+"/]		;TERMINATE THE FUNCTION.
	JRST	TYPE64			;CONTINUE THE STRING CONSTANT.
TYPE65:	PUSHJ	PP,TYPNUM		;TYPE IT.
	JUMPGE	T2,TYPE60		;OCTAL COMMENTS?	NO.
	DMOVE	AC,-WPV(T3)		;YES. TYPE OCTAL AS WELL.
	OUTST <[ASCIZ "	;C "]>		;APPEND OCTAL TO THE LINE.
	MOVE	T4,[POINT 3,AC]		;SET UP PICKING POINTER.
TYPE66:	MOVEI	T6,^D12			;12 OCTAL DIGITS PER WORD.
TYPE67:	ILDB	T5,T4			;PICK ONE OCTAL DIGIT.
	OUTCH	"0"(T5)			;PRINT IT.
	SOJG	T6,TYPE67		;FINISH THE WORD.
IFE XPV<JRST	TYPE60>			;THEN WE ARE DONE IF SINGLE PRECISION
IFG XPV,<
	HRRZI	T6,-AC-XPV(T4)		;LOOK AT THE POINTER.
	JUMPE	T6,TYPE60		;FINISHED ALL WORDS?
	OUTCH	" "			;NO. SPACE ACROSS.
	JRST	TYPE66			;AND DO ANOTHER WORD.
>;END IFG XPV

TYPE68:	OUTCH	42			;TYPE CLOSING DOUBLE-QUOTE.
	JRST	TYPE60			;CONTINUE SYMBOL-TABLE TYPE-OUT.
TYPE4:	JUMPN	T2,ASK4			;ASK?   YES.
	MOVE	T3,PNTR			;SAVE THE PLACE.
	PUSHJ	PP,EVAL			;EVALUATE EXPRESSION.
	CAMN	T3,PNTR			;DID WE EVALUATE ANYTHING?
	JUMPE	AC,TPOPJ		;ANYTHING OF VALUE?
	TLZN	F0,(STRING)		;DID WE EVALUATE A STRING?
	JRST	TYPE42			;NO. A NUMBER.
	MOVE	AC,BUFH			;GET BEGINNING.
TYPE41:	CAMN	AC,MQ			;LAST CHARACTER?
	POPJ	PP,			;YES.
	ILDB	T3,AC			;NO. GET NEXT CHARACTER.
	OUTCH	0(T3)			;OUTPUT IT.
	JRST	TYPE41			;CONTINUE.
TYPE42:	TRNN	F0,EQUSUP		;PROVIDED IT IS NOT BEING SUPPRESSED.
TYPNUM:	OUTCH	"="			;TYPE "=".
	JSPPC	PROT26			;PROTECT T2-T6
	MOVNI	T5,1			;SET OUR MINDS THAT IT WILL BE F-FORMAT.
	DMOVEM	AC,TEMPT		;SAVE THE VALUE.
	SKIPE	AC			;DON'T GET LOG IF ZERO
	PUSHJ	PP,LOG10		;GET LOG TO BASE TEN.
	DFMP	AC,TYPN1D		;ENSURE ROUNDING ERRORS ARE ALL +VE
IFG XPV,<CAMN	AC,FORMAX>		;WILL NUMBER FIT THE SPACE?
IFG XPV,<CAML	MQ,FORMAX+1>		;IF A NEAR GO, COMPARE LOW ORDER WORDS
	CAMGE	AC,FORMAX		;WILL THE NUMBER FIT THE SPACE?
	SKIPN	FORMAT			;YES.   IS F-FORMAT REQUESTED?
	SETZM	T5			;NO.   SET INDEX AND FLAG FOR E-FORMAT.
	MOVE	T3,EORMAT(T5)		;GET FORMAT SPECS.
	IDIVI	T3,200			;SEPARATE THESE SPECS.
	JUMPL	T5,TYPN3		;E-FORMAT?
	PUSH	PP,AC			;SAVE LOG10 OF THE VALUE.
	DFSB	AC,EORMAX		;YES.   FIND THE EXPONENT.
	PUSHJ	PP,FIX			;AS INTEGER.   (EORMAX IS BETWEEN 0 AND 1)
	POP	PP,AC			;RESTORE LOG10 OF THE VALUE.
	AOS	T6,MQ			;(IN FACT EORMAX IS NEARLY =1).
	SUBM	T4,T6			;GET DECIMAL PLACE OF F-PART.
	TROA	T5,(MQ)			;SAVE EXPONENT IN CASE E-FORMAT
TYPN3:	MOVE	T6,T4			;GET # DIGITS RIGHT.
	FSBR	AC,[EXP	LGMNSZ]		;GET LOG10(VALUE) - LOG10(MANTISSA-SIZE)
	PUSHJ	PP,FIX			;AS AN INTEGER TRUNCATED.
	ADD	MQ,T6			;ADD THE SCALING FACTOR # OF DIGITS
	MOVE	T2,T6			;GET THE SCALING FACTOR # OF DIGITS
	SKIPLE	T6,MQ			;GET SIZE OF ADJUSTED VALUE
	SUB	T2,T6			;OR MAXIMUM IF LOW-ORDER-ZEROES.
	DMOVE	AC,TEMPT		;GET ORIGINAL NUMBER TO BE TYPED.
	PUSHJ	PP,[DPUSH PP,TEN	;MULTIPLY IT BY 10**(T2).
		JRST	EXP.1]		;RETURN WITH T2 ZERO.
	JUMPGE	AC,TYPN1		;POSITIVE?
	MOVEI	T2,"-" - " "		;NO.	TYPE SIGN.
	NEGATE	ACCUM			;MAKE POSITIVE
TYPN1:	PUSHJ	PP,RFIX			;AS A DOUBLE-WORD INTEGER.
	JUMPL	T5,TYPN4		;AND GO TYPE IT IF IT'S F-FORMAT.
	PUSHJ	PP,TYPN4		;OTHERWISE TYPE OUT THE FRACTION, THEN
	OUTCH	"E"			;TYPE "E"
	MOVEI	AC,"-"			;SET OUR HEARTS ON NEGATIVE EXPONENT.
	TRNN	T5,400000		;IS IT REALLY NEGATIVE?
	TRCA	AC,6			;NO.   GET "+".
	MOVNI	T5,(T5)			;YES.  GET POSITIVE #.
	OUTCH	0(AC)			;TYPE SIGN.
	HRRZ	AC,T5			;EXPONENT TO TYPE.
;SUBROUTINE TO TYPE AN INTEGER.
;ARGUMENTS ARE:
;AC/	NUMBER TO BE TYPED.
;AA/	LEFT HALF - MINIMUM # OF DIGITS TYPED OUT -1 - TO GIVE LEADING ZEROES.
;		(NOT REQUIRED IF ENTERED AT TYPINT  -  1 ASSUMED.)
;	RIGHT HALF - RADIX.	(NOT REQUIRED IF ENTERED AT TYPINT - DECIMAL ASSUMED.)

TYPINT:	SETZM	AA			;ENTER HERE TO MAKE MINIMUM ONE DIGIT
TYPIN0:	HRRI	AA,^D10			;SET DECIMAL RADIX.
TYPIN1:	MOVE	UA,AC			;PRESERVE AC.
TYPIN2:	IDIVI	UA,(AA)			;GET NEXT REMAINDER INTO PC.
	TRO	PC,"0"			;ENSURE ASCII FIGURES
	HRLM	PC,(PP)			;SAVE IN LEFT HALF-WORD IN STACK.
	SUBI	AA,777777		;SUBTRACT ONE FROM LEFT HALF.
	SOSG	AA			;DECREMENT COUNT OF LEADING ZEROES.
	SKIPE	UA			;ANY MORE TO DIVIDE?
	PUSHJ	PP,TYPIN2		;YES.	CONTINUE.
TYPBAK:	HLRZ	PC,(PP)			;UNLOAD LEFT HALF FROM STACK.
	OUTCH	0(PC)			;TYPE IT.
	POPJ	PP,			;GET NEXT TO TYPE OR ELSE RETURN.
IFN UA-PC+1,PX ACCUMULATOR VALUE CONFLICT AT TYPINT:.

TYPN1D:IFN KA-10,<DATA <<1.0+1-XPV>>,2>
IFE KA-10,<DATA <<1.0+1-XPV>>,1400>

;ROUTINE TO TYPE A FLOATING-POINT NUMBER.
;ENTER AT TYPN4 WITH THE NUMBER IN AC,MQ
;		T2/	ASCII SIGN LESS "SPACE".
;		T3/	# OF PLACES TOTAL (EXCLUDING DECIMAL POINT AND SIGN)
;		T4/	# OF PLACES RIGHT
;		T6/	# OF INSIGNIFICANT LOW-ORDER PLACES ("0"-FILL).
TYPN4:	SETZM	AA			;CLEAR IN CASE "0"-FILL.
	SOJGE	T6,TYPN6		;"0"-FILL ON LOW-ORDER PLACES?
	MOVEM	MQ,AA			;NO. SAVE LOW ORDER PART.
	IDIVI	AC,^D10			;DIVIDE HIGH ORDER PART
	DIVI	MQ,^D10			;DIVIDE LOW ORDER PART.
	JUMPG	T4,TYPN6		;LEFT OF DECIMAL POINT YET?
	JUMPG	AC,TYPN6		;YES. HIGH ORDER FINISHED YET?
	JUMPG	MQ,TYPN6		;YES. LOW ORDER FINISHED YET?
	JUMPG	AA,TYPN6		;YES. LAST DIGIT FINISHED YET?
	SKIPE	T3			;YES. LAST FORMAT SPACE?
	JUMPE	T4,TYPN6		;NO. BEYOND JUST-LEFT-OF-DECIMAL-POINT?
	TRO	AA," "(T2)		;YES.  PUT SIGN IN IF T2 NON-ZERO.
	TDZA	T2,T2			;CLEAR SIGN.
TYPN6:	TRO	AA,"0"			;ASSURE CHARACTER IS A DIGIT.
	HRLM	AA,(PP)			;STACK IT UP.
	SOSN	T4			;DECREMENT COUNT OF # DIGITS RIGHT
	PUSH	PP,[XWD ".",TYPBAK]	;INSERT DECIMAL POINT.
	SOJL	T3,TYPBAK		;DECREMENT COUNT OF # DIGITS TOTAL + SIGN
	PUSHJ	PP,TYPN4		;CYCLE FOR MORE
	JRST	TYPBAK			;TYPE FROM PP LIST THEN RETURN
LIBRA:	TRZA	CH,40			;FORCE UPPER CASE TO DISTINGUISH COMMANDS
OPERAT:	TRO	CH,40			;FORCE LOWER CASE TO DISTINGUISH COMMANDS
	SETZM	T2			;CLEAR A VALIDITY FLAG.
	CAIN	CH,"C"			;LIBRA CALL?
	HRLOI	T2,LIBCAL		;YES.
	CAIN	CH,"S"			;LIBRA SAVE?
	HRLZI	T2,LIBSAV		;YES.
	CAIN	CH,"D"			;LIBRA DELETE?
	HRLZI	T2,LIBDEL		;YES.
	CAIN	CH,"o"			;OPERATE OUTPUT?
	HRLZI	T2,OPER.O		;YES.
	CAIN	CH,"i"			;OPERATE INPUT?
	HRLOI	T2,OPER.I		;YES.
	JUMPE	T2,NOCOM1		;VALID COMMAND?
	PUSHJ	PP,SWALLOW		;YES.  SKIP OVER COMMAND MODIFIER
	PUSHJ	PP,RCM			;READ A COMMAND STRING
	HLRZ	PC,T2			;GET ADDRESS TO GO TO.
	ANDI	T2,1			;GET I/O DIRECTION.
	JRST	0(PC)			;GO TO ROUTINE.

LIBDEL:	MOVE	T2,AA			;SAVE DEVICE-CHARACTERISTICS WORD
	SETZB	AC,AA			;CLEAR I/O MODE; SPEC NO BUFFERS.
	OPEN	LIBCHN,AC		;TRY TO INIT.
	TROA	T4,INIERR-LUKERR	;SAY INIT ERROR.
	LOOKUP	LIBCHN,T3		;FIND FILE.
	MOVEI	AA,LUKERR-RENERR(T4)	;SET AA NON-ZERO IF NO FILE FOUND.
IFG MONITOR-3.27,< TLNE	T2,(DV.DTA)>	;DECTAPE SPECIFICATION REQUIRES A CLOSE.
	CLOSE LIBCHN,			;BUT FOR DISK, DON'T LOSE FILE TO ANOTHER JOB
	SKIPN	MQ,AA			;THEN SEE IF WE WANT TO RENAME.
	RENAME	LIBCHN,MQ		;RENAME TO ZERO.
	ERRORR	RENERR-F(AA)		;CAN'T DELETE FILE.
	RELEASE	LIBCHN,
	POPJ	PP,
LIBSAV:	PUSH	PP,OUTCHN		;SAVE CURRENT OUTCHN.
	PUSHJ	PP,LIBINI		;INITIALIZE LIBRARY CHANNEL.
	MOVE	T3,PNTR			;REMEMBER WHERE WE'RE UP TO.
LIBSV0:	PUSHJ	PP,WRITE		;PRETEND IT WAS A 'WRITE' COMMAND.
	CAIN	CH,","			;MORE IN LIST?
	HPSTP	LIBSV0			;YES.
	CAMN	T3,PNTR			;WAS THERE A LIST FOR LIBRA SAVE?
	PUSHJ	PP,TYPE6O		;NO.	WRITE OUT THE SYMBOL TABLE.
	SETZM	T2			;RESTORE THE I/O-DIRECTION FLAG.
	PUSHJ	PP,LIBREL		;RELEASE THE LIBRARY CHANNEL.
	POP	PP,OUTCHN		;RESTORE OUTCHN.
	POPJ	PP,			;RETURN.

LIBREL:	SETZM	AA			;HERE TO RELEASE LIBRARY CHANNEL.
LIBINI:					;HERE TO INIT. LIBRARY CHANNEL.
	MOVEI	AC,LIBCHN		;SPECIFY LIBRARY CHANNEL.
LIBIN1:	SOJA	AA,AUTIO4		;INITIALIZE.
LIBCAL:	JSP	PC,NEWTXT		;SET UP LINNUM & PNTR
	XWD	ZERO,BUFH		;TO EXECUTE THIS LINE.
	JSP	PC,DUPLICATE		;SAVE OLD BUFH.
	PUSH	PP,INCHN		;SAVE CURRENT INCHN.
	PUSHJ	PP,LIBINI		;INITIALIZE LIBRARY CHANNEL.
					;BEWARE OF THE SKIP RETURN ON ERROR.
LIBCL0:	INCHR	AC			;READ A CHARACTER FROM THE FILE.
	CAIE	AC,15			;IGNORE CARRIAGE-RETURNS.
	CAIN	AC,177			;IGNORING ILLEGAL RUBOUTS
	JRST	LIBCL0			;(WHICH ARE IN THERE FROM LIBRA SAVE)
	CAIN	AC,12			;LINE-FEED?
	MOVEI	AC,EOL			;YES.	CHANGE TO EOL.
	PUSHJ	PP,FIT			;MAKE ROOM.
	IDPB	AC,BUFH			;SAVE CHARS IN INPUT BUFFER.
	AOJG	AC,LIBCL0		;UNTIL BUFFER COMPLETE.
	DPB	AC,BUFH			;SO BUFFER IS TOPPED OFF OK.
	MOVEI	AC,177			;INSERT RUBOUT AT END OF THIS LIB FILE.
	IDPB	AC,BUFH			;SO WE KNOW WHEN TO STOP EXECUTING IT.
	PUSHJ	PP,LIBREL		;RELEASE THE LIBRARY CHANNEL.
	POP	PP,INCHN		;RESTORE CURRENT INPUT CHANNEL.
LIBCL1:
IFGE VMAJOR-60,<JSP PC,DUPLICATE>	;SAVE POINTERS.
	PUSHJ	PP,EXECLN		;EXECUTE OR STORE ONE LIBRA INPUT LINE.
IFGE VMAJOR-60,<
	JSP	PC,RETRACE		;GO BACK AND RELEASE THE CORE
LIBCL2:	ILDB	AC,PNTR			;SCAN UNTIL END OF LINE.
	SETZM	CH			;CREATE A NULL.
	DPB	CH,PNTR			;CLEAR SOME OF WHAT WE JUST EXECUTED
	JUMPE	AC,LIBCL1		;HAVE WE REACHED END OF LINE?
	CAIE	CH,177			;END OF FILE?
	JRST	LIBCL2			;NO.
PX NOTE! LIBCL2 CODE WON'T WORK BECAUSE THE CODE AT FOR2 LEAVES THE POINTERS IN THE MIDDLE OF THE LINE.
>;END IFGE VMAJOR-60
IFL VMAJOR-60,<
	HOP	.+1			;OVER THE EOL.
	CAIE	CH,177			;END OF FILE?
	JRST	LIBCL1			;NO.
>;END IFL VMAJOR-60
	POP	PP,BUFH			;YES.
	ADJSP	PP,-1			;ADJUST STACK FOR UNWANTED LINNUM
	JRST	RETRCE			;UNSTACK PNTR, LINNUM, & RETURN.

OPER.O:	TLNN	F0,(EXTGIV)		;SPECIFIC EXTENSION GIVEN?
	MOVSI	T4,(SIXBIT "LST")	;NO.  USE "LST".
OPER.I:	CAIG	AC,LIBCHN		;CHANNEL SPECIFIED?
	MOVEI	AC,DOUCHN(T2)		;NO.   USE DEFAULT.
IFN DOUCHN+1-DINCHN,PX BUG AT OPER.I+1
;HERE TO INIT OR RELEASE AN I/O CHANNEL.
;CALL - MOVE	AA,[-1]	IF RELEASE ONLY
;	MOVE	AA,	OTHER VALUES TAKEN AS DEVCHR WORD.
AUTIO4:IFLE MONITOR-4.72,<
	SKIPL	BUFTAB(AC)		;IS THERE AN OUTPUT FILE?
	JRST	AUTIO5			;RETURN IF NONE WAS ACTIVE.
	MOVE	PC,AC			;GET CHANNEL NUMBER.
	IMULI	PC,WPD			;MAKE INDEX FOR DIRECTORY BLOCK
IFLE MONITOR-3.27,<
	MOVSI	UA,(CLOSE)		;MAKE CLOSE OPERATION.
	DPB	AC,[POINT 4,UA,12]	;INSERT CHANNEL NUMBER.
	XCT	UA			;DO THE CLOSE.
>;END IFLE MONITOR-3.27
	MOVSI	UA,(RENAME)		;MAKE RENAME OPERATION.
	DPB	AC,[POINT 4,UA,12]	;INSERT CHANNEL NUMBER.
	ADDI	UA,FILTAB(PC)		;GET INDEX TO DIRECTORY DATA BLOCK.
	XCT	UA			;RENAME FOR THE <PRT>
	SKIPA	UA,FILTAB+1(PC)		;ERROR.
AUTIO5:	SKIPA	UA,AC			;CHANNEL NUMBER.
	ERRORR	RENERR(UA)		;PRINT MESSAGE.
	IMULI	UA,WPD			;INDEX TO FILTAB.
	MOVEI	PC,FILTAB(UA)		;ADDRESS OF DIRECTORY DATA BLOCK.
	HRLI	PC,T3			;SOURCE TO MOVE.
	BLT	PC,FILTAB+3(UA)		;SAVE DIRECTORY DATA.
>;END IFLE MONITOR-4.72
	MOVE	UA,AC			;GET CHANNEL NUMBER.
	LSH	UA,27			;MOVE TO ACCUMULATOR FIELD
	TLO	UA,(RELEASE)		;CREATE RELEASE OPERATION.
	XCT	UA			;RELEASE IN CASE NO CAN DO.
	SETZM	OUTCHN(T2)		;CLEAR CURRENT-I/O-CHANNEL
	SETZM	BUFTAB(AC)		;AND BUFFER-IN-USE FLAG.
	MOVN	PC,T2			;LOOK AT I/O IN OPPOSITE DIRECTION.
	CAMN	AC,INCHN(PC)		;ACTIVE ON THIS CHANNEL?
	SETZM	INCHN(PC)		;YES. CLEAR IT.
	TLC	AA,(1B4+1B5+1B12+1B14)	;TEST FOR THIS JOB'S CONSOLE.
	TLCN	AA,(1B4+1B5+1B12+1B14)	;AND IF IT IS, THEN
	POPJ	PP,			;JUST RELEASE THE CHANNEL.

	MOVEM	AC,OUTCHN(T2)		;STORE CURRENT-I/O-CHANNEL.
	IMULI	AC,WPC			;GET INDEX TO BUFFER-HEADER TABLE.
	MOVEI	AA,HEDTAB(AC)		;POINT TO BUFFER HEADER.
	SKIPN	AC,T2			;OUTPUT?
	MOVSS	AA			;YES. MOVE TO LEFT HALF.
	TLC	UA,(<OPEN>^!<RELEASE>)	;CREATE OPEN OPERATION; OPEN.XOR.RELEASE
	HRRI	UA,AC			;POINT TO OPEN DATA BLOCK
	XCT	UA			;OPEN I/O CHANNEL.
	ERRORR	INIERR			;CAN'T INIT.
IFE XPV*KA-10,MOVEI AA,4		;LENGTH OF ENTER BLOCK
IFN XPV*KA-10,<
	MOVEM	AA,LUKENT+AA+.RBDEV+1	;SAVE BUFFER HEADER POINTER
	SKIPA	AC,OUTCHN(T2)		;GET CURRENT CHANNEL.
AUTIOZ:	HLLZ	T4,LUKENT+T4		;SET UP ORIGINAL EXTENSION.
	AND	T5,[-1B8]		;CLEAR CREATION DATE.
	MOVEI	AA,4+1B18		;LENGTH OF ENTER BLOCK+NON-SUPERCEDE
	SKIPN	T2			;ENTER?
	CAIE	AC,LIBCHN		;YES.	IF THIS NOT IS LIBRA SAVE, THEN...
	TRZ	AA,1B18			;DON'T MAKE IT A NON-SUPERCEDING ENTER
>;END IFN XPV*KA-10
	MOVEI	PC,LUKENT		;POINT TO LOOKUP/ENTER BLOCK.
	BLT	PC,LUKENT+T6		;MOVE ARGUMENTS TO LOOKUP/ENTER BLOCK.
	MOVNI	PC,-077(T2)		;"ENTER" OR "LOOKUP" OP CODE
	DPB	PC,[POINT 9,UA,8]	;CREATE ENTER OR LOOKUP OPERATION
	HRRI	UA,LUKENT+AA		;POINT TO DIRECTORY DATA BLOCK.
	MOVEM	T6,LUKENT+T2		;PUT PPN IN PLACE FOR EXTENDED ENTER.
	XCT	UA			;ENTER OR LOOKUP.
	JSP	PC,AUTIO9		;FAILURE.
	MOVE	T5,OUTCHN(T2)		;GET CHANNEL NUMBER
	TLC	UA,(<OUTBUF>^!<ENTER>)	;CREATE OUTBUF OR INBUF OPERATION
IFN <OUTBUF>^!<ENTER>-<INBUF>^!<LOOKUP>,PX OUTBUF.XOR.ENTER .NE. LOOKUP.XOR.INBUF
	MOVE	T6,UA			;SAVE FOR LATER AS WELL.
	PUSHJ	PP,FIT			;USE @BUFH UPWARDS AS SCRATCH SPACE.
	HRRI	T6,1			;OUTBUF OR INBUF 1 BUFFER.
	XCT	T6			;DO OUTBUF/INBUF.
	SUB	AA,.JBFF##		;GET SIZE OF ONE BUFFER.
	IMULI	AA,-2			;GET SIZE OF TWO BUFFERS IN RIGHT HALF.
	HRRZ	AC,BUFBOT		;INITIALLY LOOK AT BOTTOM OF BUFFER SPACE
	AOSA	T6			;MAKE OUTBUF/INBUF 2.
AUTIO6:	MOVE	AC,MQ			;LOOP FOR ANOTHER TRY
	MOVNI	UA,17			;LOOK AT ALL I/O CHANNELS.
	HRRZS	T3,AC			;ADDRESS OF PROSPECTIVE BUFFERS.
	ADDI	T3,(AA)			;ADDRESS ABOVE PROSPECTIVE BUFFERS.
AUTIO7:	MOVM	T4,BUFTAB+17(UA)	;GET BUFFER ADDRESS
	CAIG	T3,(T4)			;THIS CHANNEL CLEAR ABOVE?
	JRST	AUTIO8			;YES.   TRY NEXT CHANNEL.
	HLRZ	MQ,T4			;SIZE OF THIS CHANNEL'S BUFFERS.
	ADDI	MQ,(T4)			;FIND FIRST ADDRESS ABOVE THIS CHANNEL.
	CAIGE	AC,(MQ)			;THIS CHANNEL CLEAR BELOW?
	JRST	AUTIO6			;NO! CLASH. TRY HIGHER UP.
AUTIO8:	AOJLE	UA,AUTIO7		;AOK SO FAR.   CHECK ALL CHANNELS
	HRL	AC,AA			;MAKE BUFTAB WORD.
	MOVEM	AC,BUFTAB(T5)		;SAVE POINTER WORD.
	SKIPN	T2			;OUTPUT?
	MOVNS	BUFTAB(T5)		;YES.  FLAG IT IN TABLE.
	HRROS	T4,AC			;ENSURE FOR SQUEZ.
	HRROI	MQ,(T3)			;GET HIGHEST ADDRESS REQUIRED.
	SUB	MQ,INDEX		;SUBTRACT WHAT WE HAVE ALREADY.
	SKIPLE	MQ			;NEED SPACE?
	PUSHJ	PP,SQUEZ		;YES.
	HRRZM	T4,.JBFF##		;TELL MONITOR WHERE TO PUT BUFFERS.
	XCT	T6			;SET TWO BUFFERS.
	POPJ	PP,			;RETURN.

AUTIO9:	JUMPE	T2,AUTIO1		;GO HANDLE ENTER FAILURE.
	HRRZS	T4,LUKENT+T4		;TRY NULL EXTENSION NEXT TIME.
	TLON	F0,(EXTGIV)		;SPECIFIC EXTENSION?
	JRST	-2(PC)			;NO.	HAVE ANOTHER GO.
	ERRORR	LUKERR-F+F*XPV*KA/10(T4);YES, OR CAN'T EVEN FIND BLANK DEFAULT
IFN XPV*KA-10,<
	SETOM	AA			;PREPARE FOR RELEASE.
	SOSE	AC			;LIBRA CALL?
	AOJA	AC,AUTIO4		;NO.	OPERATE INPUT.	RELEASE & RETURN.
	AOS	(PP)			;SKIP RETURN FROM LIBINI CALL,...
	SOJA	AC,CPOPJ		;WITH SIMULATED EOF.
>;END IFN XPV*KA-10

AUTIO1:
IFN XPV*KA-10,HRRZ T4,LUKENT+T4		;GET ERROR CODE.
IFN XPV*KA-10,CAIN AC,LIBCHN		;LIBRA SAVE?
IFN XPV*KA-10,CAIE T4,4			;YES.	FILE ALREADY EXISTS?
AUTIO2:	ERRORR	ENTERR(T4)		;NO. CAN'T ENTER.
IFN XPV*KA-10,<
	MOVEI	AA,.RBDEV		;NUMBER OF LOOKUP ARGUMENTS.
	MOVEM	AA,LUKENT+AA		;STORE IN EXTENDED LOOKUP BLOCK.
	LOOKUP	LIBCHN,LUKENT+AA	;LOOKUP THE ORIGINAL FILE.
	JRST	AUTIO2			;"CAN NEVER HAPPEN"!
	HRLZI	T4,'BAK'		;PREPARE TO RENAME IT TO BAK.
	RENAME	LIBCHN,T3		;TRY TO CHANGE IT.
	SKIPA	AA,T4			;CAN'T REMOVE .OLD
	JRST	AUTIOZ			;TRY AGAIN.
	SETZM	LUKENT+AA+.RBDEV-1	;SET I/O MODE TO ASCII.
	OPEN	LIBCHN,LUKENT+AA+.RBDEV-1;OPEN THE EXACT STRUCTURE.
	SKIPA	AA,INIERR-ENTERR	;"CAN NEVER HAPPEN"!
	LOOKUP	LIBCHN,T3		;LOOKUP .BAK FILE.
	ERRORR	ENTERR(AA)		;PREVIOUS RENAME MUST HAVE BEEN PROT FAIL.
	RENAME	LIBCHN,T2		;DELETE IT.
	ERRORR	ENTERR(T2+1)		;NO. CAN'T ENTER.
	JRST	AUTIOZ			;TRY AGAIN.
>;END IFN XPV*KA-10
;MODIFY STATEMENT
MOD:	PUSHJ	PP,GETLN		;GET LINE NUMBER.
	PUSHJ	PP,FINDLN		;FIND THE LINE...
	ERROR	NOLINE			;...WHICH MUST BE EXACT.
	MOVEM	AA,T2			;SAVE THE POINTER IN INDEX TABLE.
	SETSTS	TTYCHN,NOECHO		;SUPPRESS ECHOING.
	SETZB	UA,T6			;CLEAR CUE AND SEARCH CHARACTER.
	JSP	PC,GETBUF		;INPUT THE NEW LINE.
MOD2:	SETSTS	TTYCHN,0		;RESTORE ECHOING.
	JSP	PC,NEWTXT		;SET TO LOOK AT OUTPUT
	XWD	ZERO,AC			;FROM THE BUFFER.
	MOVE	AA,T2			;RESTORE AA,
	HLRZ	AC,(T2)			;RESTORE AC,
	HLLZ	T4,(T2)			;SET UP T4 FOR NEWLIN,
	HRR	MQ,(T2)			;... AND ...
	HRLI	MQ,(POINT 7,,34)	;RESTORE MQ.
	PUSHJ	PP,NEWLI6		;INSERT THE NEW DATA.
	JSP	PC,OLDTXT		;THEN RETURN TO THIS LINE,
TLFPPJ:	OUTST	CRLF			;AND RETURN THE BUFFER SPACE.
	POPJ	PP,
;FUNDAMENTAL KEYBOARD INPUT ROUTINE.

;THIS ROUTINE MAKES PROVISION FOR SPECIFIC CALLERS:
;			 QUIT+14, ASK2-1, & MOD2-1.
;THIS ROUTINE PLACES INPUT CHARACTERS ON TO THE STACK.
;WHEN INPUT IS COMPLETE, AN EOL IS PLACED ON THE STACK.
;THEN IN THE NEXT WORD PP IS PUSHED AS IT WAS ON ENTRY TO GETBUF.
;FINALLY WE PUSH THE ADDRESS OF A ROUTINE TO RESTORE THE STACK.
;FOR ALL EXCEPT MODIFY, CR IS IGNORED, AND DELIMITERS RECOGNIZED ARE:
;	INPUT BUFFER:	LINE-FEED AND ESCAPE
;	ASK NUMBER:	SPACE, COMMA, LINE-FEED, ESCAPE
;	ASK STRING:	LINE-FEED, ESCAPE
;CALL:	MOVE	T2,ASK-DATA-NAME	(ASK ONLY)
;	MOVEI	T6,0			(MODIFY ONLY)
;	MOVE	MQ,PICK-UP POINTER	(MODIFY ONLY)
;	MOVEI	UA,CUE CHARACTER
;	JSP	PC,GETBUF
;	RETURN WITH	AC/	INITIAL BYTE POINTER (READY FOR ILDB).
;			MQ/	BYTE POINTER JUST BELOW THE FINAL NULL.
;			T3/	CHARACTER COUNT.
;			T4/	DELIMITER CHARACTER
;USED BUT NOT PRESERVED:
;	T5	CALLER'S ADDRESS RELATIVE TO MOD2.
;	T6	SEARCH CHAR FOR MODIFY:	ZERO IF NONE, LH ZERO IF SEARCHING,
;			LH -1 IF FOUND AND WAITING.

GETBUF:	TLO	F0,(CUETTY)		;FLAG THE COMMAND FOR OUTPUT GUIDANCE.
	PUSH	PP,PP			;SAVE INITIAL PP
	PUSH	PP,UA			;SAVE THE CUE CHARACTER.
	PUSH	PP,MQ			;SAVE MODIFY'S POINTER.
	PUSH	PP,ZERO			;PLACE NULLS UNDER THE STRING.
	SUBI	PC,MOD2			;MAKE CALLER'S ADDRESS RELATIVE TO MOD2.
	HRRZ	T5,PC			;GET CALLER'S ADDRESS.
	MOVEI	AC,0(PP)		;FIND PLACE TO PUT FIRST CHARACTER.
	TLOA	AC,(POINT 7,,35)	;MAKE A POINTER.
GET0:	OUTST	CONUCR			;TYPE "^U",CR,LF
	MOVE	PP,-3(AC)		;RESTORE PP.
	ADJSP	PP,4			;ADJUST.
	SKIPN	UA,INCHN		;TELETYPE INPUT?
	SKPINC				;YES.   AWAKEN ITS PRINTER IF ASLEEP.
	SKIPN	UA			;BEWARE!  TWO RETURNS!!
	OUTCHR	-2(AC)			;YES.	TYPE THE CUE
	MOVE	MQ,AC			;CREATE A BYTE POINT TO THE STACK.
	TDZA	T3,T3			;CLEAR THE COUNT
GET1:	IDPB	T4,MQ			;STORE CHARACTER IN INPUT BUFFER.
	TLNN	MQ,760000		;IS THE STRING AT END OF WORD?
	PUSH	PP,ZERO			;YES. PUSH 5 NULLS ON.
GET2:	JUMPN	T5,GET3			;IS THIS A MODIFY COMMAND?
	JUMPG	T6,GETY			;YES. ARE WE SEARCHING?
	JUMPN	T6,GET3			;AWAITING A SEARCH CHARACTER?
	OUTCH	7			;YES. MAKE A NOISE.
GET3:	INCHR	T4			;NO.  INPUT A CHARACTER.
IFL MONITOR-5.05,<
	CAIE	T4,176			;OLD-STYLE ALT-MODE?
	CAIN	T4,175			;ALT-MODE?
	MOVEI	T4,33			;YES.	CHANGE TO ESCAPE.
>;END IFL MONITOR-5.05
IFL <<ASK2-QUIT>!<MOD2-ASK2-200>>,PX PROBLEMS WITH BACKSPACE.
	CAIN	T4,10(T5)		;BACKSPACE DURING MODIFY?
	SOJGE	T3,GET7			;YES.
	CAIN	T4,10			;BACKSPACE?
	SOJGE	T3,GET8			;YES.
	CAIN	T4,177			;RUBOUT?
	SOJGE	T3,GETRUB		;YES.
	TLZN	F0,(MODRUB)		;WERE WE RUBBING OUT?
	JRST	GET4			;NO.
	OUTCH	"\"			;YES.
	JUMPE	T5,GET4			;IS IT A MODIFY COMMAND?
	OUTCH	0(T4)			;NO. ECHO THE CHARACTER.	************
	SETSTS	TTYCHN,0		;RESTORE ECHOING.
GET4:	CAIN	T4,"R"-100		;CONTROL-R?
	JRST	GET9			;YES.
	CAIN	T4,"P"-100		;CTRL-P?
	JRST	QUIT			;YES.
	JUMPN	T5,GET5			;MODIFY COMMAND?
	SKIPN	T6			;YES. ARE WE AWAITING A SEARCH CHARACTER?
	HRRZ	T6,T4			;YES.
	CAIN	T4,14			;FORM FEED?
	HRRZS	T6			;YES. SCAN FOR NEXT SEARCH CHAR.
	CAIN	T4,7			;BELL?
	SETZB	T4,T6			;FLAG TO AWAIT NEW SEARCH CHAR.
	SKIPL	T4			;END OF FILE?
	CAIN	T4,12			;OR LINE FEED?
	HRRZ	T6,T4			;SCAN TO END OF LINE.
	CAIN	T4,15			;CARRIAGE-RETURN?
	INCHR	AA			;YES. IGNORE LINE-FEED.
	CAIN	T4,15			;CARRIAGE-RETURN?
	JRST	GETRET			;YES.
	JUMPGE	T6,GET2			;NOW GO FIND IT!
	OUTCH	0(T4)			;ECHO THE CHARACTER.		************
GET5:	CAIN	T4,15			;CR?
	JRST	GET2			;IGNORE CARRIAGE-RETURNS.
	JUMPL	T3,GET0			;NEW LINE IF RUBBED IT ALL OUT.
	CAIN	T4,"U"-100		;NO.  COMPLETE LINE RE-START ON ^U?
	JRST	GET0			;YES.
	CAIE	T4,12			;LINE-FEED?
	CAIN	T4,33			;NO.	ESCAPE?
	JRST	GETRET			;YES.	EXIT.
	JUMPGE	T2,GET6			;IF ASK STRING DON'T LOOK FOR COMMA, SPACE.
	LDB	UA,MQ			;GET PREVIOUS CHARACTER.
	CAILE	UA," "			;WOULD A SPACE BE "LEADING"?
	CAILE	T4," "			;NO.	IS THIS THEREFORE A DELIMITING SPACE?
	CAIN	T4,","			;NO.	COMMA?
	CAIE	T5,ASK2-MOD2		;YES.	IS THIS ASK DATA?
GET6:	JUMPG	T4,GETZ			;NO.	CONTINUE TO FILL BUFFER.
GETRET:	PUSH	PP,-3(AC)		;PUT THE OLD POINTER ON THE NEW STACK
	PUSHJ	PP,MOD2(T5)		;RETURN.
	MOVE	PP,(PP)			;RESTORE STACK WHEN CONVENIENT.
	POPJ	PP,

GETRUB:	SETOM	T4			;POINT TO CONTROLLING TTY.
	GETLCH	T4			;GET LINE CHARACTERISTICS.
	TLNN	T4,(GL.LCP)		;LOCAL-COPY?
	TLON	F0,(MODRUB)		;NO. WERE WE RUBBING OUT?
	OUTCH	"\"			;NO. BUT WE ARE NOW.
	TLNE	T4,(GL.LCP)		;LOCAL-COPY?
	JRST	GET8			;YES.
	SETSTS	TTYCHN,NOECHO		;PREVENT IMMEDIATE ECHO.
	LDB	T4,MQ			;GET PREVIOUS CHARACTER.
GET7:	OUTCH	0(T4)			;ECHO THE RUBBED-OUT CHARACTER.	************
GET8:	MOVSI	UA,-4			;CLEAR A CHARACTER.
	DPB	UA,MQ			;RUB OUT THE PREVIOUS CHARACTER.
	TLNN	MQ,760000		;WAS IT LAST IN A WORD.
	ADJSP	PP,-1			;YES.
	IBP	MQ			;INCREMENT.
	AOBJN	UA,.-1			;CONTINUE FOUR INCREMENTS.
	SOJA	MQ,GET2			;CONTINUE ACCEPTING CHARS.

GET9:	OUTST	CRLF			;NEW LINE.
	OUTCH	@-2(AC)			;TYPE THE CUE.
	OUTST	1(AC)			;PRINT IT.
	JRST	GET2

GETY:	ILDB	T4,-1(AC)		;HERE TO PICK UP CHAR FOR MODIFY SEARCH.
	OUTCH	0(T4)			;ECHO IT.
	CAMN	T4,T6			;IS THIS WHAT WE ARE SEARCHING FOR?
	HRROS	T6			;YES.  FOUND IT!
	JUMPLE	T4,GETRET		;TERMINATE AT END OF LINE.
GETZ:	AOJA	T3,GET1			;COUNT AND STORE.

;NOTE: ************ MEANS BE CAREFUL NOT TO ECHO ESCAPE HERE.
;	WE MUST THINK MORE ABOUT THIS.
;WRITE STATEMENT.
WRITE:	JSPPC	PROT26			;SAVE ACCUMULATORS (FOR LIBRA SAVE CODE).
	TLNE	CC,(N)			;WRITING ONLY PART OF TEXT?
	JRST	WRITE0			;YES.
	OUTST	HEADER			;PRINT HEADER.
	MSTIME	AC,			;GET TIME OF DAY.
	IDIVI	AC,^D60000		;IN MINUTES.
	IDIVI	AC,^D60			;SEPARATE HOURS AND MINUTES.
	IMULI	AC,^D100		;PRE-FORMAT TO COMBINE.
	ADD	AC,AC+1			;COMBINED HOUR-MINUTE NUMBER.
	HRLI	AA,3			;SET MINIMUM OF 4 DIGITS FOR TIME
	PUSHJ	PP,TYPIN0		;OUTPUT THE TIME.
	OUTCH	"	"		;OUTPUT A TAB.
	DATE	T2,			;GET DATE.
	IDIVI	T2,^D31			;SEPARATE DAYS AND MONTHS.
	AOS	AC,T3			;DAY OF MONTH TO AC.
	PUSHJ	PP,TYPINT		;OUTPUT DAY.
	OUTCH	"-"			;HYPHENATE.
	IDIVI	T2,^D12			;SEPARATE MONTHS AND YEARS.
	OUTST	MONTHS(T3)		;GET NAME OF MONTH.
	MOVE	AC,T2			;RELATIVE YEAR TO AC.
	ADDI	AC,^D64			;MAKE ABSOLUTE.
	PUSHJ	PP,TYPINT		;OUTPUT YEAR.
	OUTST	CRLF
;END OF HEADER-WRITING SECTION.
WRITE0:	JSPPC	LIMSET			;DO NOT RETURN IF NOTHING TO WRITE.
	MOVEM	T2,PC			;SAVE PREVIOUS LINE NUMBER.
	MOVEM	AC,T2			;SAVE THIS LINE NUMBER.
	XOR	PC,AC			;COMPARE THIS WITH PREVIOUS.
	TRNE	PC,7600			;SAME GROUP?

;SUBROUTINE TO TYPE LINE NUMBER AND TEXT.
TYPLIN:	OUTST	CRLF			;NO.	INSERT CRLF.
	JUMPE	AC,WRITE4		;DON'T TYPE LINE NUMBER IF IT'S ZERO.
	PUSHJ	PP,TYPELN		;TYPE LINE NUMBER
	OUTCH	"	"		;SEPARATE LINE NUMBER FROM TEXT.
WRITE4:	OUTST	1(MQ)			;PRINT THE LINE.
	JRST	TLFPPJ			;TYPE CRLF AND RETURN.

HEADER:	VERSTR	(C-FOCAL	v,VMAJOR,VMINOR,VEDIT,VWHO)
	SUBTTL	ARITHMETIC EVALUATION.
;(EXPRESSION TERMINATED BY EXCESS RP, COMMA,CR, SEMICOLON OR ILLEGALITY.)
DEFINE OPERATOR<
;;FIRST ARGUMENT IS THE OPERATOR ITSELF.
;;SECOND ARGUMENT IS ITS PRIORITY FOR HIERARCHICAL EVALUATION.
;;THIRD ARGUMENT IS FLAGS - IFCMD IF OPERATOR PRODUCES LOGICAL RESULT.
;;			    NUMBER, STRING, LOGICL IF THEY ARE LEGAL OPERANDS.
;;FOURTH ARGUMENT IS ADDRESS OF EVALUATION ROUTINE.
;;SEQUENCE MUST BE LONGER OPERATORS FIRST AND IN COLLATING-SEQUENCE ORDER.
X #,1,IFCMD!NUMBER!STRING,<COMP.+<CAMN>-<CAM>>
X **,6,NUMBER,EXP.
X *,4,NUMBER,MUL.
X +,3,NUMBER,ADD.
X +,3,STRING,ADD.S
X -,3,NUMBER,SUB.
X .EQ.,1,IFCMD!NUMBER!STRING,<COMP.+<CAME>-<CAM>>
X .GE.,1,IFCMD!NUMBER!STRING,<COMP.+<CAMGE>-<CAM>>
X .GT.,1,IFCMD!NUMBER!STRING,<COMP.+<CAMG>-<CAM>>
X .LE.,1,IFCMD!NUMBER!STRING,<COMP.+<CAMLE>-<CAM>>
X .LT.,1,IFCMD!NUMBER!STRING,<COMP.+<CAML>-<CAM>>
X .NE.,1,IFCMD!NUMBER!STRING,<COMP.+<CAMN>-<CAM>>
X /,5,NUMBER,DIV.
X =,1,IFCMD!NUMBER!STRING,<COMP.+<CAME>-<CAM>>
X ^,6,NUMBER,EXP.
>;END DEFINE OPERATOR

;HIERARCHICAL ASSIGNMENTS.
HIER:
DEFINE X (A,B,C,D) <EXP D+<C!<B_^D30>>>
OPERATOR
NOPS=.-HIER
EVALN:	TLO	F0,(NUMBER)		;FORCE NUMERIC-ONLY EVALUATION.
EVAL:	JSPPC	PROT23			;PROTECT T2,T3
EVAL00:	HRRZS	T3,(PP)			;SIMULATE NULL OPERATOR.
	JRST	EVAL02			;GO SCAN.
;HERE WITH HIERARCHY WORD IN T3	;READY FOR LETTER, NUMBER, OR SUB-EXPRESSION.
EVAL01:	HLLZ	T2,(PP)			;ENSURE WE IGNORE ADDRESS FIELD.
	HLLZ	AA,T3			;GET CURRENT HIERARCHY.
	TLZ	AA,707777		;CLEAR ALL BUT HIERARCHY.
	CAMG	AA,T2			;LOOK AT OPERATOR'S HIERARCHY
	POPJ	PP,			;LAST WAS HIGHER: COMBINE
IFN PDP-6,<PUSH	PP,EVAL08>		;SET RETURN-ADDRESS ON STACK.
IFE PDP-6,<PUSH	PP,@EVAL08>		;ALLOW FOR GLIDE MACRO.
	DPUSH	PP,AC			;SAVE THE VALUE.
	TLNE	F0,(STRING)		;STRING VALUE?
	MOVEM	MQ,BUFH			;YES.  PROTECT THE STRING.
IFE XPV,<TLNE	F0,(STRING)>		;STRING VALUE?
IFE XPV,<PUSH	PP,MQ>			;MUST SAVE END OF STRING REGARDLESS.
	PUSH	PP,T3			;PUSH OPR.H
EVAL02:	PUSHJ	PP,EVALEX		;GO GET NUMBER,VALUE, OR EXPRESSION.
	MOVE	T2,[XWD -NOPS,HIER]
	MOVE	T3,[POINT 7,OPS]	;POINT TO TABLE OF OPERATORS.
	MOVEM	T3,TEMP4		;SAVE IT FOR INCREMENTING.
EVAL04:	MOVE	T3,PNTR			;SAVE INTERPRETATION SPOT.
EVAL05:	ILDB	AA,TEMP4		;GET FIRST CHARACTER OF NEXT OPERATOR.
	JUMPE	AA,EVAL07		;NO MORE.	WE HAVE A MATCH.
EVAL5B:	ILDB	UA,T3			;GET NEXT CHARACTER OF INPUT STRING.
	CAIN	UA,"?"			;DEBUG?
	JRST	EVAL5B			;YES.	JUST IGNORE IT FOR NOW.
	SUB	UA,AA			;COMPARE INTERP CHAR WITH OPERATOR CHAR.
	JUMPE	UA,EVAL05		;EQUIVALENT SO FAR.
IFGE SIZE,CAIE	AA,"*"			;SPECIAL CASE FOR * AND **.
IFGE SIZE,JUMPL	UA,EVAL6B		;NO OPERATOR WILL EVER MATCH!
EVAL06:	ILDB	AA,TEMP4		;SKIP REST OF THIS OPERATOR.
EVAL6A:	JUMPN	AA,EVAL06		;SKIP REST OF THIS OPERATOR.
	AOBJN	T2,EVAL04		;TRY THE NEXT OPERATOR.
EVAL6B:	SETZM	T3			;DID NOT FIND AN OPERATOR.
	JRST	EVAL01			;SET UP T2 AND RETURN.

;HERE HAVING FOUND AN OPERATOR.	NOW TEST ITS LEGALITY.
EVAL07:	MOVE	PC,F0			;GET TYPE OF OPERAND.
	TLC	PC,(IFCMD)		;COMPLEMENT THE IF COMMAND FLAG.
	AND	PC,(T2)			;COMPARE LEGAL OPERANDS WITH OPERAND STATUS.
	TLNN	PC,(IFCMD)		;LOGICAL OPERATOR ILLEGAL EXCEPT IN IF.
	TLNN	PC,(STRING!NUMBER!LOGICL);THERE MUST BE AT LEAST ONE AGREEMENT.
	JRST	EVAL6A			;OTHERWISE THE OPERATOR IS INVALID.
	CAME	T3,PNTR			;HAS FOCAL CAUGHT UP YET?
	HOP	.-1			;WAIT FOR THE DEBUG TO PRINT OUT.
	MOVE	T3,(T2)			;PICK UP HIERARCHY WORD.
EVAL08:	STEP	EVAL01			;EXIT.

EVALEX:	CAIN	CH,"-"			;UNARY -?
	PUSH	PP,JNEG			;YES.	NEGATE AFTER GETTING ANSWER.
	CAIE	CH,"-"			;UNARY -?
	CAIN	CH,"+"			;UNARY +?
	HPSTPP	SETNUM			;YES.	SKIP IT.
	TLNE	CC,(A)			;NEXT CHARACTER ALPHABETIC?
	JRST	GETVAL			;YES.	EVALUATE
	CAIN	CH,42			;DOUBLE-QUOTE?
	JRST	GETSTR			;YES.
	TLNE	CC,(LP)			;IS THE NEXT ITEM PARENTHETIC?
	JRST	EVALX1			;YES.
	TLNN	CC,(N)			;NUMERIC OR STARTS WITH "."?
	TLNN	T3,-1			;A BLANK EXPRESSION?
	JRST	GETNM			;NO.	COPE WITH ABSENCE OF ARGUMENT.
	ERROR	SYNTAX			;OTHERWISE TRAP BAD CONDITION.
EVALX1:	HPSTPP	EVAL00			;EVALUATE SUB-EXPRESSION.
EVALY:	TLNN	CC,(RP)			;CHECK END OF SUBEXPRESSION.
	ERROR	MISMATCH		;BAD
	HPSTP	CPOPJ			;GOOD.

;BYTE TABLE OF OPERATORS.
DEFINE X (A,B,C,D) <
.ADSTR (A)
.ADCHR 0
>;END DEFINE X (A,B,C,D)
OPS:
.STRG==0
.SHFT==^D29
	OPERATOR
IFN .SHFT-^D29,EXP .STRG
;HERE WHEN LOGICAL OPERATOR FOUND.
COMP.:	TLZ	T2,770777		;T2 IS SET UP AT EVAL01.
	TLO	T2,(CAM	AA,)		;MAKE A COMPARE INSTRUCTION.
	HRRI	T2,PC			;PREPARE TO COMPARE AA,PC.
	TLZE	F0,(STRING)		;COMPARING STRINGS?
	JRST	COMP.S			;YES.
IFG XPV,<
	CAME	AC,-XPV(PP)		;NUMERIC COMPARE - CHECK HIGH ORDERS.
	SKIPA	PC,AC			;HIGH ORDERS DIFFERENT.
	SKIPA	PC,MQ			;HIGH ORDERS SAME.
	SKIPA	AA,-XPV(PP)		;HIGH ORDERS DIFFERENT.
>;END IFG XPV
IFE XPV,<MOVE	PC,AC>			;SINGLE PRECISION IS SIMPLE.
	MOVE	AA,0(PP)		;HIGH ORDERS SAME.
	JRST	DOCOMP			;INEQUALITY AT LAST!
COMP.S:	MOVE	UA,-1(PP)		;GET POINTERS INTO UA,PC.
	MOVEM	UA,BUFH			;RESTORE BUFH.
EQU.S:	CAMN	UA,(PP)			;AT END OF PUSHED STRING?
	TDZA	AA,AA			;YES.   FLAG IT SO.
	ILDB	AA,UA			;GET CHARACTER FROM ONE STRING.
	CAMN	AC,MQ			;AT END OF OTHER STRING?
	TDZA	PC,PC			;YES.
	ILDB	PC,AC			;GET CHARACTER FROM OTHER STRING.
	CAMN	AA,PC			;EQUAL SO FAR?
	JUMPN	AA,EQU.S		;CONTINUE TO SCAN STRINGS.
IFE XPV,<ADJSP	PP,-1>			;EXTRA INSTRUCTION NEEDED HERE.
DOCOMP:	XCT	T2			;DO THE COMPARE.
	TDZA	AC,AC			;SET FALSE.
	SETOB	AC,MQ			;SET TRUE.
	TLO	F0,(LOGICL)		;FLAG RESULT.
	TLZ	F0,(NUMBER!STRING)	;FLAG RESULT.
	JRST	OPRXIT
;EVALUATION SUBROUTINES.
;WE COME HERE WITH TWO VALUES, THE FIRST IS IN -XPV(PP), AND SECOND IS IN AC.
;WE MUST PERFORM THE COMBINING OPERATION,  N1.OPR.N2   OR   -XPV(PP).OPR.AC
;AND PUT THE RESULT IN AC, THEN GO TO OPRXIT.

SUB.:	NEGATE	ACCUM			;SUBTRACT IS JUST NEGATIVE ADD
ADD.:	DFAD	AC,-XPV(PP)		;RESULT TO TOP OF STACK
	JRST	OPRXIT			;RETURN.
DIV.:	DEXCH	AC,-XPV(PP)		;ARGUMENT IS DIVIDEND
	DFDV	AC,-XPV(PP)		;RESULT TO TOP OF STACK
OPRXIT:	ADJSP	PP,-WPV			;REDUCE STACK.
	POPJ	PP,

ADD.S:	MOVE	AC,-1(PP)		;RESTORE BEGINNING OF STRING.
	MOVEM	AC,BUFH			;RESTORE BUFH.
IFE XPV,<ADJSP	PP,-1>			;RESTORE STACK
	JRST	OPRXIT			;RESTORE STACK.

ANTILI:	PUSHJ	PP,DFLOAT		;ENTER HERE WITH INTEGER FOR 10**(INTEGER)
ANTILG:	JSPPC	PROT23			;SAVE T2 AND T3.
	DPUSH	PP,TEN			;ENTER HERE TO FIND 10**AC
EXP.:	PUSHJ	PP,FIXOAT		;SEPARATE INTEGER & FRACTION OF THE POWER
	MOVE	T2,AA			;SAVE INTEGER PART IN T2.
	DMOVEM	AC,TEMPE		;SAVE FRACTION PART IN TEMPE.
	DMOVE	AC,-XPV(PP)		;GET BASE.
	JUMPE	AC,OPRXIT		;GIVE ANY POWER OF ZERO IS ZERO.
	PUSHJ	PP,LOG			;GET LOG(BASE).
	DFMP	AC,TEMPE		;GET POWER*(LOG(BASE)).
	PUSHJ	PP,EXP			;GET EXP(POWER*(LOG(BASE))).
EXP.1:	JUMPGE	T2,EXP3C		;ALLOW FOR NEGATIVE POWER.
	MOVMS	T2			;TREAT IT AS A POSITIVE POWER
	DEXCH	AC,-XPV(PP)		;WITH THE BASE BEING
	PUSHJ	PP,RECIPROCAL		;INVERTED.
	DEXCH	AC,-XPV(PP)		;RESTORE BASE TO THE STACK.
EXP3C:	TRZE	T2,1			;NO.	MULTIPLY NEXT POWER?
	DFMP	AC,-XPV(PP)		;YES.
	JUMPE	T2,OPRXIT		;DONE INTEGER POWER?
	DEXCH	AC,-XPV(PP)		;GET BASE.
	DFMP	AC,AC			;GET BASE*BASE.
	DEXCH	AC,-XPV(PP)		;RESTORE TO TEMPORARY STORE.
	LSH	T2,-1			;LOOP.
	JRST	EXP3C			;UNTIL DONE.
	SUBTTL SUBROUTINES
;ROUTINES TO PROTECT ACCUMULATORS T2-TN.
;CALL:	JSPPC	PROT2N
;	ROUTINE
;	POPJ PP,

PROT23:	EXCH	T2,(PP)			;SAVE T2 AND GET ROUTINE ADDRESS
	PUSH	PP,T3			;SAVE T3.
	PUSHJ	PP,(T2)			;GO TO ROUTINE.
	POP	PP,T3			;RESTORE T3.
	POP	PP,T2			;RESTORE T2.
	POPJ	PP,			;RETURN TO ROUTINE'S CALLER.

PROT26:	EXCH	T2,(PP)			;SAVE T2, GET ROUTINE ADDRESS.
	MOVNI	PC,4			;SET COUNTER.
	PUSH	PP,T6+1(PC)		;SAVE T2 - T6.
	AOJL	PC,.-1			;
	PUSHJ	PP,(T2)			;GO TO ROUTINE.
	MOVEI	PC,5			;SET COUNTER.
	POP	PP,T2-1(PC)		;RESTORE T6 - T2.
	SOJG	PC,.-1			;
	POPJ	PP,			;RETURN TO ROUTINE'S CALLER.
;ROUTINE TO READ IN A COMMAND STRING OF THE FORM -
;	DEV:FILE.EXT[PRJ,PRG]<PRT>/CHN
;ABSENT FIELDS ALWAYS YIELD DEFAULT ANSWERS; ANSWERS ARE RETURNED THUS:
; F0	EXTGIV BIT ALWAYS SET OR CLEARED.	; T3	FILE	IN SIXBIT
; AC	CHANNEL NUMBER (NEGATIVE IF NONE).	; T4	EXT	IN SIXBIT (R.H. ZERO)
; MQ	DEV	IN SIXBIT			; T5	FILE PROTECTION IN BITS 0-8
; AA	DEVICE CHARACTERISTICS WORD		; T6	PRJ,PRG
RCM:	MOVSI	MQ,(SIXBIT "DSK")	;DEFAULT DEVICE NAME.
	MOVSI	T4,(SIXBIT "FCL")	;DEFAULT FILE EXTENSION.
	TLZ	F0,(EXTGIV)		;MARK EXTENSION AS ONLY BE DEFAULT.
	SETZB	T5,T6			;CLEAR PROT,PROJ,PROG.
	PUSH	PP,.-1			;CLEAR CHANNEL NUMBER.
	PUSHJ	PP,SYMB			;COLLECT CONTENT OF FIRST FIELD.
	CAIN	CH,":"			;WAS IT A DEVICE NAME?
	HOPP	SYMB0			;YES. SAVE & GET NEXT FIELD.
	SKIPN	T3,AC			;FILE NAME GIVEN?
	MOVE	T3,[SIXBIT "FOCAL"]	;NO.	SUPPLY DEFAULT FILE NAME.
	CAIE	CH,"."			;SPECIFIC FILE EXTENSION?
	JRST	RCM1			;NO.
	TLO	F0,(EXTGIV)		;YES.
	HOPP	SYMB			;IF YES, COLLECT EXTENSION.
	HLLZM	AC,T4			;AND SAVE THE ANSWER.
RCM1:	CAIE	CH,"["			;PROJECT,PROGRAMMER PAIR?
	JRST	RCM2			;NO.	CHECK FOR PROTECTION
	HPSTPP	GETOCT			;YES.	GET PROJECT NUMBER
	CAIE	CH,","			;AND CHECK CORRECT SYNTAX
	ERROR	SYNTAX			;MUST ALWAYS BE A PAIR.
	HRLZM	AC,T6			;STORE PROJECT NUMBER
	HPSTPP	GETOCT			;GET PROGRAMMER NUMBER.
	CAIE	CH,"]"			;CHECK CLOSING BRACKETS.
	ERROR	MISMATCH		;BAD STRING.
	HRRM	AC,T6			;SAVE PROGRAMMER NUMBER.
	HPSTP	RCM2			;HURDLE THE "]".
RCM2:	CAIE	CH,"<"			;PROTECTION SPECIFIED?
	JRST	RCM3			;NO.   CHECK FOR CHANNEL SPEC.
	HPSTPP	GETOCT			;READ IN THE PROTECTION BITS.
	LSH	AC,^D35-8		;MOVE TO CORRECT FIELD, BITS 0-8.
	MOVEM	AC,T5			;SAVE THE ANSWER.
	CAIE	CH,">"			;CHECK SYNTAX.
	ERROR	MISMATCH
	HPSTP	RCM1			;GO CHECK IF ANY MORE DESCRIPTORS.
RCM3:	SKIPE	AA,MQ			;DEVICE NAME INTO AA.
	DEVCHR	AA,			;DEVICE CHARACTERISTICS WORD.
	CAIE	CH,"/"			;CHANNEL SPECIFIER?
	JRST	TPOPJ			;NO.	THAT'S ALL FOLKS.
	PUSH	PP,MQ			;YES.   SAVE DEVICE NAME.
	HPSTPP	GETLN			;GET CHANNEL NUMBER.
	POP	PP,MQ			;RESTORE DEVICE NAME.
	LSH	AC,-7			;AS AN INTEGER.
	HRRZM	AC,(PP)			;SAVE IT.
	CAIG	AC,17			;CHECK VALIDITY.
	SOJG	AC,RCM1			;O.K. IF 2 OR MORE.
	ERROR	BADLIN			;OTHERWISE ERROR.
;SUBROUTINE TO CLEAR VARIABLES DATA AREA AND PRESET SYMBOL TABLE POINTERS.
CLRVAR:	MOVEI	AC,@BUFH		;ADDRESS OF BOTTOM OF UNUSED CORE
CLRVA1:	HRLOI	UA,(POINT 7,(RL),34)	;CREATE AN INDEX FIELD ALONE, TO
	MOVEM	UA,SYMTBL		;INDICATE EMPTY VARIABLES AREA.
	MOVEM	UA,SYMTBC		;EMPTY VARIABLE AREA AND EMPTY STRING AREA.
;ROUTINE TO SET THE LOW SEGMENT SIZE.
;COME HERE WITH AC(RIGHT) CONTAINING THE AMOUNT TO BE COVERED
SETCOR:	HRRZI	RL,2(AC)		;GET MAXIMUM LOCATION DESIRED.
	CORE	RL,			;ASK FOR LOW SEGMENT CORE.
	ERROR	NOCOR			;CORE NOT AVAILABLE.
IFL MONITOR-5.03,<
	SETZM	RL			;UPDATE .JBREL
	SLEEP	RL,			;BY FORCING A RE-SCHEDULE.
>;END IFL MONITOR-5.03
	HRRZ	RL,.JBREL##		;GET NEW LOW SEGMENT SIZE.
	MOVEM	RL,SYMTBH		;INITIALIZE SYMTBH.
	AOS	RL			;POINT TO THE WORD ABOVE THE TOP.
	HRLM	RL,.JBCOR##		;ENSURE THE SAVE COMMAND SAVES A LOW SEGMENT
	HRLM	RL,.JBSA##		;ENSURE THE SAVE COMMAND SAVES ALL CORE
	POPJ	PP,


;SUBROUTINE TO CONVERT ASCII TO OCTAL.
;ALWAYS RETURN WITH AC CONTAINING THE ANSWER.

GETOCT:	SETZM	AC			;INITIAL VALUE ZERO
GETINT:	CAIGE	CH,"8"			;CHECK LEGALITY
	CAIGE	CH,"0"			;AND CHECK IT'S NUMERIC.
	POPJ	PP,			;RETURN WHEN ILLEGAL CHARACTER.
	IMULI	AC,8			;UP PREVIOUS ANSWER.
	ADDI	AC,-"0"(CH)		;ACCUMULATE.
	HOP	GETINT			;CONTINUE.

NEWLIN:	TLO	F0,(NO.INT)		;DISABLE DEBUG.
	PUSHJ	PP,GETLN		;GET LINE NUMBER FOR INSERTION.
	CAILE	AC,200			;GROUP NUMBER GIVEN?
	TRNN	AC,177			;YES.	LINE NUMBER?
	ERROR	BADLIN			;NO.	INVALID LINE #
	CAIL	AC,^D100_7		;CHECK VALIDITY
	ERROR	BADLIN			;CANNOT ALLOW ILLEGAL LINES HERE
	HRLZ	T4,AC			;SAVE LINE NUMBER.
	STEPP	FINDLN			;FIND POINTER TO THIS LINE IN TEXT.
	JRST	NEWLI0			;CAN'T FIND - JUST INSERT.
NEWLI6:	PUSH	PP,AA			;FOUND THE LINE. - SAVE THE INDEX SLOT.
	PUSHJ	PP,DELINE		;DELETE THE LINE.
	POP	PP,AA			;RESTORE THE INDEX SLOT.
NEWLI0:	JUMPE	CH,CPOPJ		;NO INSERTIONS TO DO.
	SKIPN	-1(AA)			;PREVIOUS INDEX SLOT NULL?
	SOJA	AA,.-1			;YES.   GET LOWEST SLOT.
	HRRO	AC,AA			;POINT TO SPACE IF SQUEEZ NEEDED.
	SKIPE	(AA)			;NEED SPACE?
	PUSHJ	PP,SQUEEZ		;YES.
;NOW INDEX DATA BLOCK HAS AN EMPTY SLOT WITH AC POINTING TO IT.
	MOVE	T5,AC			;SAVE THE SLOT POINTER IN T5.
	MOVE	AC,TEXTL		;SET UP TO SCAN FOR SOME FREE CORE
	HLL	AC,BUFL			;EQUATE LEFT HALVES & MAKE IT A POINTER.
	TDZA	T3,T3			;FLAG THAT INITIAL WORD IS O.K.
NEWLI1:	MOVE	T3,(AC)			;PICK UP THE DATA WORD JUST BELOW.
	CAML	AC,BUFL			;ARE WE STILL WITHIN LIMITS?
	JRST	NEWLI2			;NO.   PLACE THE NEXT TEXT AT THE TOP.
	TRZN	T3,376			;IS THERE STILL AN EOL TERMINATING?
	SKIPE	1(AC)			;IS THE NEXT WORD FREE?
	AOJA	AC,NEWLI1		;NO.   LOOK MORE.
NEWLI2:	HRRM	AC,T4			;CREATE THE WORD FOR THE INDEX TABLE
NEWLI3:	PUSHJ	PP,SQUEAZ		;GET ONE FREE BYTE.
	DPB	CH,AC			;STORE TEXT.
	MOVEM	T4,(T5)			;STORE THE WORD IN THE INDEX TABLE.
	JUMPE	CH,CPOPJ		;STORED EOL YET?
	HOP	NEWLI3			;NO.

DELINE:	PUSHJ	PP,KNOCK		;DELETE ACTIVE REFERENCES
	SETZB	UA,(AA)			;DELETE INDEX ENTRY.
DELIN0:	ILDB	AC,MQ			;MOVE ALONG TEXT.
	DPB	UA,MQ			;CLEARING IT OUT.
	JUMPN	AC,DELIN0		;UNTIL WE REACH END-OF-LINE.
	GLIDE	CPOPJ			;IN CASE WE ERASED WHAT PNTR WAS POINTING TO
;SUBROUTINE TO DELETE REFERENCES TO ACTIVE LINES,
;TO COVER FOR CASES OF ERASING OR MODIFYING ACTIVE LINES.
;(ALLOW ERASING/MODIFYING, BUT USER CANNOT COMMIT SUICIDE.)
;CHECK CONTENTS OF AC AGAINST LINNUM CHAIN.
KNOCK:	ANDI	AC,777777		;COMPARE ONLY THE VALID PART.
	MOVE	UA,LINNUM		;BEGINNING OF CHAIN.

;NOW WE DON'T NEED TO CHECK THE FIRST ITEM OF THE CHAIN, NAMELY LINNUM,
;BECAUSE IN THE CASE OF 
;	MODIFY		LINNUM CONTAINS CURRENT EXECUTING LINE
;			WHICH WAS DUPLICATED AT EXECL..
;	ERASE		LINNUM CONTAINS THE OBJECT LINE,
;			WHICH WE DON'T WANT TO CHECK.
;	NEWLIN		LINNUM CONTAINS CURRENT EXECUTING LINE
;			WHICH WAS DUPLICATED AT EXECL..
KNOCK1:	HLRE	PC,UA			;GET NEXT LINK OF CHAIN.
	JUMPGE	PC,CPOPJ		;NO MORE LINKS - EXIT.
	MOVE	UA,PDLEND-2(PC)		;PICK UP XWD LINK,LINE #.
	CAIN	AC,(UA)			;IS THIS LINE BEING EXECUTED?
	SETZM	PDLEND-1(PC)		;YES.
	JRST	KNOCK1			;LOOP.
;SUBROUTINE TO SET EXECUTION LIMITS INTO LUPARG.
;PRESENT SETTINGS OF LINNUM,PNTR,LUPARG ARE SAVED.
;ALSO SET RIGHT HALF OF LINNUM TO FIRST LINE IN RANGE.
;CALL - JSPPC	LIMSET			;THIS IS A DISGUISED PUSHJ PP,.
;DO NOT RETURN IF NO LINE FOUND.
;AC,MQ,AA SET UP AS FROM FINDLN
LIMSET:	TLNE	CC,(N)			;PNTR IS POINTING TO THE ARGUMENT.
	JRST	LIMSE1			;PICK UP THAT ARGUMENT IF IT'S NUMERIC.
	CAIE	CH,"A"			;IS THE ARGUMENT "ALL"?
	CAIN	CH,"a"			;(LOWER OR UPPER CASE)
	PUSHJ	PP,SYMB			;YES.   READ IN THE ARGUMENT.
	TDZA	AC,AC			;ENTER HERE TO DUMMY UP ZERO ARGUMENT
LIMSE1:	PUSHJ	PP,GETLN		;READ IN NUMERIC ARGUMENT.
LIMSE2:	POP	PP,UA			;GET ADDRESS OF CALL INTO PC.
	JSP	PC,DUPLIC		;SAVE LINNUM,PNTR, SET LINNUM CHAIN.
	PUSH	PP,LUPARG		;SAVE LUPARG.
	PUSH	PP,UA			;MAKE SO WE CAN POPJ BACK IF NECESSARY
	HRRM	AC,LINNUM		;STORE AS FIRST LINE TO GET.
	HRRZM	AC,LUPARG		;SAVE THE LOOP ARGUMENT.
LIMNX1:	SKIPA	LIMNXT			;GET LINE NUMBER INTO AC.

;ROUTINE TO ADVANCE RIGHT HALF OF LINNUM TO THE NEXT EXISTING
;LINE NUMBER, AND TEST WHETHER IT IS WITHIN THE LUPARG RANGE.
;CALL - PUSHJ	PP,LIMNXT
;	RETURN INSIDE RANGE.	AC,MQ,AA SET UP AS FROM FINDLN.
;	DO NOT RETURN IF OUTSIDE RANGE.
LIMNXT:	AOS	AC,LINNUM		;SET UP AC FOR FINDING A LINE.
	PUSHJ	PP,FINDLN		;ENTER HERE FROM LIMSET ROUTINE.
	HRRM	AC,LINNUM		;MODIFY LINNUM IF CAN'T FIND EXACT MATCH.
	PUSH	PP,LIMNX1		;PLACE A RETURN ADDRESS ON THE STACK.
	MOVE	PC,AC			;GET THE LATEST LINE NUMBER.
	SKIPN	UA,LUPARG		;IS IT A WHOLE-PROGRAM LOOP?
	SETZM	PC			;YES.
	TRNN	UA,177			;IS IT A GROUP-ONLY LOOP?
	TRZ	PC,177			;YES.
	CAMN	PC,UA			;SHOULD BE EXACT MATCH TO CONTINUE.
	JUMPG	MQ,@-1(PP)		;INSIDE RANGE - CONTINUE PROGRAM.
	ADJSP	PP,-2			;REMOVE RETURN ADDRESS.
	POP	PP,LUPARG
RETRCE:	JSP	PC,RETRACE		;REMOVE PNTR,LINNUM.
	POPJ	PP,			;DO NOT RETURN TO CALLING PROG.
;ROUTINES TO NEST AND UN-NEST TEXT POINTER/LINE-NUMBER PAIRS.
;	ROUTINE TO SAVE CURRENT POINTERS AND SET UP NEW ONES.
;	CALL -	JSP	PC,NEWTXT
;		XWD	NEWLIN,NEWTEXT
;	WHERE NEWLIN IS AN ADDRESS CONTAINING THE NEW LINE NUMBER
;	AND NEWTEXT IS AN ADDRESS CONTAINING A NEW BYTE POINTER.

NEWTXT:	TLO	F0,(NO.INT)		;START ANALYSING DATA.
	PUSH	PP,LINNUM		;SAVE CURRENT LINE NUMBER.
	PUSH	PP,PNTR			;SAVE CURRENT BYTE POINTER.
	HLLM	PP,LINNUM		;CHAIN.
	PUSH	PP,PC			;SAVE PC FOR RETURN.
	MOVE	PC,(PC)			;GET XWD ARGUMENT.
	PUSH	PP,(PC)			;GET NEW BYTE POINTER.
	POP	PP,PNTR			;SAVE IT.
	HLRZ	PC,PC			;GET LINE NUMBER ADDRESS.
	MOVE	PC,(PC)			;GET LINE NUMBER.
	HRRM	PC,LINNUM		;SAVE IT.
	AOS	(PP)			;SKIP OVER ARGUMENT.
	GLIDE	CPOPJ			;SET UP CH AND CC.

;ROUTINE TO DUPLICATE POINTERS.
;CALL ... JSP PC,DUPLICATE
DUPLIC:	PUSH	PP,LINNUM		;SAVE LINNUM
	PUSH	PP,PNTR			;AND PNTR ACCORDING TO CONVENTIONS.
	HLLM	PP,LINNUM		;CHAIN.
	JRST	(PC)			;RETURN.

;ROUTINE TO RESTORE LINNUM AND PNTR FROM THE STACK.
;THEN IGNORE SPACES.
;	CALL -	JSP	PC,RETRACE OR OLDTXT

OLDTXT:	TLZ	F0,(NO.INT)		;FINISHED ANALYSING DATA.
RETRAC:	POP	PP,PNTR			;RESTORE PNTR
	POP	PP,LINNUM		;RESTORE LINE NUMBER.
	STEP	@PC			;RESTORE CC AND CH.
;SUBROUTINE TO INCREMENT BYTE POINTER IN AC AND
;INSERT A NULL WORD THERE IF THE NEW BYTE IS NOT NULL.
;(MQ IS DESTROYED BY THIS SUBROUTINE).
;NOTE:	THIS SUBROUTINE IS INTENDED ONLY FOR INSERTIONS INTO THE TEXT AREA TEXTL-BUFL
SQUEAZ:	MOVE	AA,AC			;GET POINTER PRIOR TO INCREMENT.
	ILDB	MQ,AC			;INCREMENT AC BYTE POINTER.
	TLNN	AA,760000		;WAS PREVIOUS POINTER LAST IN A WORD?
	MOVE	MQ,(AC)			;YES.	IN THAT CASE, ENSURE WHOLE WORD ZERO.
	HRRZI	PC,@BUFH		;GET ADDRESS OF TOP OF USED-CORE
	CAIL	PC,(AC)			;ENSURE THE INSERTION IS IN BOUNDS.
	JUMPE	MQ,CPOPJ		;EXIT IF THIS NEXT BYTE IS NULL.
;FALL INTO SQUEEZ IF IT'S NOT.


;SUBROUTINE TO INTERPOSE A GROUP OF NULL WORDS IN THE DATA STORAGE AREA.
;CALL -	HRRI	AC,ADDRESS OF FIRST NULL WORD
;	MOVEI	MQ,# OF NULL WORDS TO BE INSERTED.
;	PUSHJ	PP,SQUEEZ
;	RETURN WITH AA RIGHT HALF POINTING TO LAST NULL WORD
;			AC PRESERVED.

;ROUTINE WILL INSERT NULLS JUST ABOVE WHERE AC POINTS.
;ROUTINE WILL ADJUST ALL BYTE POINTERS GREATER OR EQUAL TO AC.

IFNDEF SPEED,<SPEED==20>	;INCREASE THIS NUMBER FOR FASTER LIBRA CALL
;TIME OF LIBRA CALL GOES AS 1 + 11.41/SPEED + SPEED/752
;WHERE MIDDLE TERM IS DUE TO REDUCED BLT TIMES,
;AND LAST TERM IS DUE TO INCREASED FINDLN TIME.

SQUEEZ:	MOVEI	MQ,SPEED		;ENTER HERE TO GET AN OPTIMUM CHUNK
SQUEZ:	JSPPC	PROT23			;PROTECT T2,T3.
	HRROI	T3,@BUFH		;MAKE TRANSFER PUSH-DOWN POINTER.
	ADDM	MQ,BUFH			;ADJUST BUFH.
	PUSHJ	PP,FIT			;MAKE SPACE.
	MOVNI	T2,-1(AC)		;MAKE COUNT: -BOTTOM.
	ADDI	T2,(T3)			;MAKE COUNT: +TOP
	HRR	PC,MQ			;SET UP THE ...
	HRLI	PC,T3			;...DESTINATION POINTER.
	POP	T3,@PC			;MOVE A WORD AS BACKWARDS BLT.
	SOJG	T2,.-1			;CONTINUE UNTIL DONE.
	HRRZ	AA,AC			;POINT TO POSITION OF FIRST NULL
SQUEZ0:	SETZM	@PC			;CLEAR NEW CORE
	CAIGE	AA,@PC			;UNTIL WE REACH THE BOTTOM.
	SOJA	PC,SQUEZ0		;CONTINUE.
;ADJUST BYTE POINTERS AFTER TEXT BLOCK TRANSFER.
	MOVEI	T2,DBP			;POINT TO DATA POINTERS
SQUEZ1:	PUSHJ	PP,SQUEZ5		;ADJUST POINTERS
	CAIGE	T2,DBPEND-1		;END OF DATA POINTERS?
	AOJA	T2,SQUEZ1		;NO
	HLRE	T3,LINNUM		;PRESET FOR CHAINED POINTERS
	HRRZ	T2,INDEX		;LOOK AT TEXT POINTERS
	AOS	T2			;SKIP FIRST WORD (CONTAINS -1)
SQUEZ2:	SKIPGE	PC,(T2)			;END OF TEXT POINTERS?
	JRST	SQUEZ4			;YES.
	PUSHJ	PP,SQUEZ6		;NO.  FIX UP THIS POINTER.
	AOJA	T2,SQUEZ2		;...AND CONTINUE.
SQUEZ3:	MOVEI	T2,PDLEND-1(T3)		;POINT TO CHAINED POINTER.
	PUSHJ	PP,SQUEZ5		;CHECK IT.
	HLRE	T3,PDLEND-2(T3)		;NEXT LINK IN CHAIN.
SQUEZ4:	JUMPL	T3,SQUEZ3
	POPJ	PP,

;SUBROUTINE TO ADJUST ONE BYTE POINTER IF NECESSARY.
;T2 CONTAINS THE ADDRESS OF THE POINTER.
;AA IS THE BASE FOR COMPARISON.
;MQ IS THE OFFSET TO BE APPLIED IF NECESSARY.
SQUEZ5:	MOVE	PC,(T2)			;GET POINTER.
	TLNN	PC,767077		;BYTE POINTER JUST BELOW FIRST CHAR?
SQUEZ6:	CAILE	AA,1(PC)		;SEE IF RIGHT HALF JUST BELOW TOO.
	CAIG	AA,(PC)			;COMPARE NULL POSITION WITH BYTE POINTER
	ADDM	MQ,(T2)			;ABOVE. - ADJUST POINTER.
	POPJ	PP,
;SUBROUTINE TO SEE IF CORE NEEDS TO EXPAND.
;CALL:	PUSHJ	PP,FIT	- FIRST SET C(.JBFF) JUST ABOVE @BUFH.
;CORE WILL NOT BE DECREASED.
;AA IS SET TO C(.JBFF) ON RETURN.
FIT:	MOVEI	AA,@BUFH		;ENTER HERE TO USE @BUFH.
	AOS	AA			;SET AA JUST ABOVE @BUFH.
	MOVEM	AA,.JBFF##		;STORE .JBFF IF CHANGED.
	PUSH	PP,AC			;SAVE AC
	MOVEI	AC,WPV*2+1(AA)		;GET TOP OF CONTIGUOUS LOW SEGMENT,
	SUBI	AC,@SYMTBL		;ADD SIZE OF SYMBOL TABLE
	JUMPLE	AC,TPOPJ		;DON'T NEED MORE CORE.
	ADD	AC,SYMTBH		;GET HOW MUCH CORE WE WANT.
	PUSH	PP,SYMTBH		;SAVE OLD TOP OF SYMBOLS.
	PUSHJ	PP,SETCOR		;NO. GET MORE CORE.
	POP	PP,AC			;RESTORE OLD TOP OF SYMBOLS
	MOVN	UA,SYMTBL		;GET # OF WORDS TO MOVE.
	HRLI	AC,377776(UA)		;SET COUNTER IN LH(AC)
	MOVNI	UA,(AC)			;CONSTRUCT DISTANCE TO MOVE,
	ADD	UA,SYMTBH		;IN UA.
	HRLI	UA,(POP AC,(AC))	;CREATE AN INSTRUCTION
	XCT	UA			;EXECUTE IT TO MOVE A WORD.
	JUMPL	AC,.-1			;REPEAT TILL ALL SYMBOLS MOVED.
TPOPJ:	POP	PP,AC			;THEN RESTORE AC AND RETURN.
	POPJ	PP,
;SUBROUTINE TO DECODE NEXT STRING AS A LINE NUMBER.
;RETURN WITH AC/ LINE NO.=LINE # + GROUP NO.*128.
;ALWAYS RETURN WITH C(AC) ZERO OR POSITIVE
;ABSENCE OF A LINE NUMBER IS INDICATED BY ZERO RETURNED IN AC.

;THIS VERSION TRUNCATES DECIMAL PLACES BEYOND TWO.
;THIS VERSION TRUNCATES HIGH ORDER INTEGER PART ABOVE ABOUT A MILLION.
GETLN:	SETZB	AC,MQ			;CLEAR ANSWER AND PLACE-COUNTER.
	PUSHJ	PP,GETLNS		;GET A DIGIT
	SKIPA				;WAS NOT A DIGIT
	JUMPL	CC,.-2			;GET NEXT DIGIT
	CAIN	CH,"."			;DECIMAL POINT?
	HOPP	GETLNS			;YES.   GET NEXT DIGIT.
	JRST	GETLNZ			;NONE.   DONE.
	PUSHJ	PP,GETLNS		;GET SECOND DIGIT
	IMULI	AC,^D10			;NONE
	IDIVI	AC,^D100		;SEPARATE INTEGER AND FRACTION.
	ASH	MQ,34			;PLACE FRACTION BITS NEXT TO AC
GETLNZ:	ASHC	AC,7			;COMBINE INTO ONE NUMBER.
	POPJ	PP,			;RETURN.

GETLNS:	CAIL	CH,"0"			;DIGIT ABOVE OR EQUAL ZERO?
	CAILE	CH,"9"			;YES.   BELOW OR EQUAL NINE?
	POPJ	PP,			;NO. STRAIGHT RETURN.
	AOS	(PP)			;OTHERWISE SKIP-RETURN.
	IMULI	AC,^D10			;MULTIPLY NUMBER SO FAR.
	ADDI	AC,-"0"(CH)		;ADD IN NEW DIGIT.
	HOP	CPOPJ			;SKIP OVER THE DIGIT ON THE WAY BACK.
;SUBROUTINE TO READ A SYMBOL INTO AC AS SIXBIT LEFT-JUSTIFIED.
;SKIP OVER LETTERS PAST THE SIXTH.
SYMB0:	MOVEM	AC,MQ			;SAVE AC FIRST.
SYMB:	PUSHJ	PP,SYMB1		;COLLECT A SYMBOLIC NAME.
	STEP	CPOPJ			;IGNORE TRAILING SPACES.
SYMB1:	PUSH	PP,ZERO			;CLEAR THE RETURN ARGUMENT.
	MOVSI	AC,(POINT 6,(PP),)	;MAKE POINTER.
SYMB2:	TLNN	CC,(AN!E)		;RETURN WHEN NEITHER ALPHANUMERIC NOR "E".
	JRST	TPOPJ			;RETURN.
	CAIGE	CH,140			;ALLOW FOR LOWER CASE.
	SUBI	CH,40			;MAKE SIXBIT.
	TLNE	AC,770000		;PAST SIXTH DON'T ASSEMBLE
	IDPB	CH,AC			;BUILD ANSWER.
	HOP	SYMB2			;CONTINUE

SYMB$:	PUSHJ	PP,SYMB1		;COLLECT A SYMBOL INTO AC.
	CAIE	CH,"$"			;IS IT DELIMITED BY A DOLLAR SIGN?
	STEP	SETNUM			;NO.	IT IS A NUMERIC NAME.
	TLZ	AC,(1B0)		;YES.	IT IS A STRING NAME.
	HPSTP	SETSTR			;SKIP THE "$" AND TRAILING SPACES.

;SUBROUTINE TO READ A VARIABLE NAME AND ITS SUBSCRIPT INTO AC AND T2.
;F0 FLAGS STRING AND NUMBER ARE SET/CLEARED.
SYMBOL:	TLNN	CC,(A)			;ENSURE A SYMBOL FOLLOWS.
	ERROR	SETERR			;UH!
	PUSHJ	PP,SYMB$		;GET LABEL INTO AC; SET FLAGS IN F0.
	MOVEI	AA,NFUNCS-1		;COUNT FUNCTION TABLE.
SYMBL0:	CAMN	AC,FNCLST(AA)		;FOUND EXACT MATCH?
	ERROR	SETERR			;YES.	CAN'T HAVE FSIN(X)=XXX
	SOJGE	AA,SYMBL0		;CONTINUE TO END OF TABLE.
SYMBL1:	HLLZS	T2,AC			;TRUNCATE TO 3 CHARS IN CASE NO SUBSCRIPT.
	TLNN	CC,(LP)			;IS IT DIMENSIONED?
	POPJ	PP,			;NO.
	HPSTPP	SYMBL2			;GET THE COMBINED SUBSCRIPT.
	HLL	AC,T2			;COMBINE LABEL & INDEX.
	SKIPL	T2,AC			;STRING?
	TLC	F0,(STRING!NUMBER)	;YES.
JEVALY:	JRST	EVALY			;CHECK CLOSING PARENTHESIS.

SYMBL2:	TLZ	F0,(STRING)		;FORGET IF WE ARE EVALUATING A STRING.
	AOS	T2			;COUNT A SUBSCRIPT.
	PUSHJ	PP,EVALN		;EVALUATE A NUMERIC SUBSCRIPT.
	PUSHJ	PP,RFIX			;GET SUBSCRIPT IN FIXED POINT IN MQ
	HRLM	MQ,(PP)			;SAVE THAT SUBSCRIPT.
	CAIN	CH,","			;ANY MORE SUBSCRIPTS?
	HPSTPP	SYMBL2			;YES.
;RIGHT HALF OF T2 NOW CONTAINS THE NUMBER OF SUBSCRIPTS.
	MOVEI	UA,22			;FIELD WIDTH FOR ALL SUBSCRIPTS IS 18 BITS
	IDIVI	UA,(T2)			;DIVIDE 18 BITS FAIRLY FOR ALL SUBSCRIPTS
	MOVN	PC,UA			;GET NEGATIVE BIT SHARE.
	HLR	MQ,(PP)			;GET THE MOST RECENT SUBSCRIPT.
	ROT	MQ,(PC)			;PUT ALLOWABLE BITS NEXT TO AC.
	LSHC	AC,(UA)			;SHIFT THEM INTO AC.
	POPJ	PP,			;RETURN FOR MORE SUBSCRIPTS.
IFN UA-PC+1,PX PC=UA+1 IS REQUIRED BY IDIVI IN SYMBOL:
;SUBROUTINE TO COLLECT EITHER SYMBOL VALUE OR FUNCTION VALUE.
GETVAL:	PUSHJ	PP,SYMB$		;GET LABEL.
	MOVEI	AA,NFUNCS-1		;COUNT FUNCTION TABLE.
GETVL0:	CAME	AC,FNCLST(AA)		;EXACT MATCH?
	SOJGE	AA,GETVL0		;NO.	CONTINUE TO END OF LIST.
	JUMPL	AA,GETVL1		;NOT FOUND	MUST BE VARIABLE.
	LSHC	AC,-107			;SET MQ=0 IF STRING, MQ=+1 IF NUMBER.
	ROT	AA,-1			;TWO ENTRIES PER WORD
	SKIPGE	AA			;WHICH HALF?
	SKIPA	AC,FNCTAB(AA)		;RIGHT
	HLRZ	AC,FNCTAB(AA)		;LEFT
	MOVEI	MQ,SETSTR(MQ)		;GET ADDRESS OF EITHER SETNUM OR SETSTR
	PUSH	PP,MQ			;SO WE WILL SET FLAGS AFTER FUNCTION EXIT.
	TLNE	CC,(LP)			;IS THERE AN ARGUMENT?
	PUSH	PP,JEVALY		;YES.   HANDLE RIGHT-PARENTHESIS.
	SKIPE	(AC)			;NEVER EXECUTE A NON-EXISTENT FNEW.
	PUSH	PP,AC			;GO TO FUNCTION AFTER GETTING ARGUMENT.
	TLZ	F0,(NUMBER!STRING)	;ALLOW EITHER KIND OF ARGUMENT.
	TLNE	CC,(LP)			;IS THERE AN ARGUMENT IN PARENS?
	HPSTP	EVAL			;YES.   GO GET IT.
	JRST	ZERANS			;NO.   GO TO FUNCTION WITH ZERO ARGUMENT.

GETVL1:	PUSHJ	PP,SYMBL1		;INSERT INDEX INTO T2 IF ANY.
	JSP	PC,FINDSYMBOL		;SCAN THE SYMBOL TABLE.
	  MOVEI	T3,ZERO			;DID NOT FIND A MATCH.
	DMOVE	AC,@T3			;COLLECT THE ANSWER.
GETVL2:	JUMPL	T2,CPOPJ		;STRING VALUE?
	SKIPA	MQ,BUFH			;YES.
GETVL3:	IDPB	AA,BUFH			;PLACE NEXT CHARACTER ON THE STRING.
	PUSHJ	PP,FIT			;ENSURE MORE SPACE AVAILABLE.
	ILDB	AA,AC			;GET NEXT CHARACTER.
	JUMPN	AA,GETVL3		;STORE IF NOT THE END.
	JRST	GETST3			;RESTORE BUFH; POINT MQ AT STRING.

;SUBROUTINE TO READ A STRING CONSTANT ON TO THE BUFH AREA.
GETSTR:	MOVE	MQ,BUFH			;PRESERVE BUFH.
	JRST	GETST2			;LEAP OVER THE INITIAL DOUBLE-QUOTE.
GETST1:	PUSHJ	PP,FIT			;SEE IF IT WILL FIT AN EXTRA CHARACTER.
	TLZ	F0,(NO.INT)		;TURN ON FLAG IN CASE OF EXIT.
	JUMPE	CH,GETST3		;DONE IF EOL.
	CAIN	CH,42			;ALSO DONE IF CLOSING DOUBLE-QUOTE.
	HPSTP	GETST3			;DONE.
	IDPB	CH,BUFH			;STORE THE NEXT CHARACTER.
GETST2:	TLO	F0,(NO.INT)		;TURN OFF FLAG IN CASE "?" IN TEXT.
	HOP	GETST1			;GET NEXT CHARACTER.
GETST3:	EXCH	MQ,BUFH			;POINT TO THE LAST CHARACTER.
	MOVE	AC,BUFH			;POINT TO FIRST CHARACTER.
SETSTR:	TLOA	F0,(STRING)		;FLAG THIS AS A STRING.
SETNUM:	TLO	F0,(NUMBER)		;FLAG IT AS A NUMBER.
	TLC	F0,(NUMBER!STRING)	;CHANGE BOTH BITS,
	TLCN	F0,(NUMBER!STRING)	;AND BACK TO ENSURE WE HAVE ONLY ONE ON.
	ERROR	SYNTAX
	POPJ	PP,
IF2,<IFN SETSTR+1-SETNUM,PX ERROR AT GETVAL PAGE.>
;ROUTINE TO FIND A LINE.
;CALL:	MOVEI	AC, LINE REQUIRED.
;	PUSHJ	PP,FINDLN
;	RETURN.	NOT FOUND.
;	RETURN	FOUND.
;	WITH AC CONTAINING LINE NUMBER FOUND (LEFT-HALF ZERO).
;	(NEXT-HIGHEST IF CAN'T FIND EXACT)
;	(777777 IF NO NEXT-HIGHEST)
;	AND LINNUM UNCHANGED
;	AND MQ POINTING TO THE TEXT OF THE LINE, EXCEPT -1 IF NO LINE FOUND AT ALL.
;	AND AA POINTING TO THE INDEX ENTRY.
FINDLN:	HRRZ	MQ,AC			;RESTRICT TO 18 BITS.
	HRRZ	AA,INDEX		;MAKE AA POINT TO INDEX TABLE.
FINDL1:	HLRZ	AC,1(AA)		;PICK OUT LINE NUMBER FROM INDEX TABLE.
	CAML	AC,MQ			;FOUND THE PLACE YET OR ARE WE PAST IT?
	SKIPN	1(AA)			;YES, BUT IGNORE ZERO WORDS IN INDEX...
	AOJA	AA,FINDL1		;WHICH REPRESENT DELETED LINES.
	CAMN	AC,MQ
	AOS	(PP)			;FOUND.   GIVE SKIP RETURN.
	SKIPL	MQ,1(AA)		;GET POINTER WORD. (WAS IT -1?)
	HRLI	MQ,(POINT 7,,34)	;SET UP MQ AS A POINTER-WORD.
	AOJA	AA,CPOPJ



;ROUTINE TO FIND A SYMBOL IN THE SYMBOL TABLE.
;CALL:	MOVE	T2,[XWD 'NAM',SUBSCRIPT]
;	JSP	PC,FINDSYMBOL
;	  ERROR RETURN  --  COULD NOT FIND THE SYMBOL.  T3 POINTS WHERE NAME SHOULD BE.
;	O.K. RETURN  --  T3 POINTS TO THE DATA OF THE MATCHING ENTRY.
FINDSY:	SETZM	@SYMTBL			;PREVENT FALSE FIND IF NULL S.T.
	MOVE	AA,SYMTBC		;POINT TO TOP OF NAME TABLE.
	MOVE	UA,SYMTBL		;POINT TO BOTTOM OF NAME TABLE.
	SKIPA	T3,SYMTBC		;BEGIN LOOKING AT TOP.
FINDS0:	ADD	T3,UA			;POINT TO NEW PLACE TO TRY.
	CAMN	T2,@T3			;MATCH FOUND?
	AOJA	PC,FINDS9		;YES.
	CAML	T2,@T3			;HAVE WE PASSED THE ENTRY?
	SKIPA	UA,T3			;NO.
	SKIPA	AA,T3			;YES.
	MOVE	T3,AA			;PREPARE TO MAKE T3 = AA - UA.
	SUB	T3,UA			;GET DIFFERENCE.
	ASH	T3,-1			;HALVE THE DIFFERENCE.
	TRZ	T3,WPV*2-1		;ROUND TO MULTIPLE OF 2 OR 4.
	JUMPN	T3,FINDS0		;NO.  TRY AGAIN.
	SKIPA	T3,UA			;SYMBOL NOT FOUND.   POINT TO EXPECTED SLOT.
FINDS9:	SUBI	T3,WPV			;POINT TO THE DATA ENTRY.
	JRST	0(PC)			;YES.
;SUBROUTINE TO CONVERT ASCII TO FLOATING POINT.

GETNM:	JSPPC	PROT26			;SAVE T2-T6
GETNM0:	CAIN	CH,"-"			;NEGATIVE SIGN?
	PUSH	PP,JNEG			;YES. NEGATE IT AFTER WE'VE GOT IT.
	CAIE	CH,"-"			;ANY SIGN?
	CAIN	CH,"+"			;ANY SIGN?
	HPSTP	.+1			;YES. SKIP IT.
	SETZB	T2,T3			;CLEAR LOW ORDER OF RADIX.
	SETZB	AC,MQ			;CLEAR ANSWER
	SOJA	T2,GETNM4		;FLAG "NO DECIMAL POINT SEEN YET"
GETNM1:	DMOVEM	AC,T4			;SAVE NUMBER SO FAR
	TRZ	CH,"a"-"A"		;TRANSLATE LOWER TO UPPER CASE FIRST.
	TLNE	CC,(N)			;DID WE CLEAR A BIT OF A NUMBER?
	ADDI	CH,"A"-21		;YES. FIX AND ADJUST LETTER=NUMBER EQUIV.
	MOVEI	AC,1-"A"(CH)		;GET NEW DIGIT
	HOPP	DFLOAT			;MAKE FLOATING POINT
	JUMPL	T2,GETNM2		;JUMP IF NO DECIMAL POINT SEEN YET.
IFE <KI+KL-10>*XPV,<DFDV T2,TEN>	;COUNT THE DECIMAL PLACES.
IFN <KI+KL-10>*XPV,<
	DEXCH	AC,T2			;GET DECIMAL-PLACE COUNTER,
	DFDV	AC,TEN			;COUNT IT,
	DEXCH	AC,T2			;AND RESTORE IT TO ITS PLACE.
>;END IFN <KI+KL-10>*XPV
	DFMP	AC,T2			;GIVE SIGNIFICANCE TO THE NEW DIGIT.
	JRST	GETNM3			;GO TO COMBINE THE NEW DIGIT WITH THE NUMBER
GETNM2:
IFE <KI+KL-10>*XPV,<DFMP T4,TEN>	;MULTIPLY THE NUMBER-SO-FAR BY TEN.
IFN <KI+KL-10>*XPV,<
	DEXCH	AC,T4			;RESTORE NUMBER SO FAR.
	DFMP	AC,TEN			;ADJUST THE NUMBER SO FAR.
>;END IFE <KI+KL-10>*XPV
GETNM3:	DFAD	AC,T4			;COMBINE.
GETNM4:	JUMPL	CC,GETNM1		;CONTINUE IF NEXT CHAR IS ALPHANUMERIC.
	CAIN	CH,"."			;DECIMAL POINT?
	JUMPL	T2,[	MOVSI	T2,(1.0);SET DECIMAL-POINT-INDICATOR
			HOP	GETNM4
			]		;YES.	SET THE "FLAG" IN T2.
	TLNN	CC,(E)			;EXPONENT INDICATOR?
	STEP	SETNUM			;NO.	MUST BE END OF THE NUMBER.
	DPUSH	PP,AC			;SAVE THE NUMBER SO FAR.
	HOPP	GETNM0			;COLLECT EXPONENT.
	PUSHJ	PP,ANTILG		;GET 10**EXPONENT.
MUL.:	DFMP	AC,-XPV(PP)		;RESULT TO TOP OF STACK
	JRST	OPRXIT			;RETURN.
;SUBROUTINE TO CONVERT FLOATING POINT TO FIXED POINT.
;CALL:	PUSHJ	PP,FIX	WITH ARGUMENT IN AC.
;	ANSWER IS RETURNED RIGHT-JUSTIFIED IN AC,MQ.

RFIX:	
IFG XPV,< DFAD	AC,HALF>		;ROUND UP.
IFLE XPV,< FAD	AC,HALF>		;ADD .5 WITHOUT ROUNDING.
FIX:	IFE XPV,<MOVM	AA,AC>		;GET EXPONENT ...
IFG XPV,<
	HLLE	AA,AC			;GET EXPONENT ...
	TLC	AA,(AA)			;...IN POSITIVE FORM...
>;END IFG XPV
	ASH	AA,-33			;... INTO AA BITS 28-35
IFG XPV,<IFE KA-10,<ASH	MQ,8>>		;REMOVE LOW ORDER EXPONENT.
	ASHC	AC,8			;REMOVE HIGH ORDER EXPONENT.
	ASHC	AC,-306(AA)		;SHIFT TO FIX.
	POPJ	PP,			;RETURN.

;FUNCTION TO GIVE THE STRING VALUE OF A NUMERIC ARGUMENT.
FCHR$:	PUSHJ	PP,RFIX			;GET AN INTEGER.
	PUSHJ	PP,FIT			;ENSURE SPACE FOR THE RESULT.
	MOVE	AC,BUFH			;GET POINTER TO THE DATA AREA.
	EXCH	AC,MQ			;PUT POINTER IN MQ.
	IDPB	AC,MQ			;STORE IT IN DATA AREA.
	TLZ	F0,(STRING!NUMBER)	;CLEAR FLAGS.
	POPJ	PP,			;FUNCTION DISPATCHER WILL FIX IT UP FREE.

;FUNCTION TO INPUT OR OUTPUT A SINGLE CHARACTER.
FCHR:	JUMPL	AC,FCHR1		;NEGATIVE ARGUMENT MEANS INPUT.
	PUSHJ	PP,RFIX			;GET ARGUMENT INTO MQ.
	OUTCH	0(MQ)			;PRINT A CHARACTER.
	JRST	PFLOAT			;RETURN WITH AC,MQ UNCHANGED.
FCHR1:	INCHR	AC			;OTHERWISE INPUT.
;SUBROUTINE TO CONVERT A FIXED POINT NUMBER TO FLOATING POINT.
DFLOAT:	ASHC	AC,-43			;MOVE TO STANDARD INTEGER FORMAT.
	JRST	PFLOAT			;FLOAT A STANDARD WORD.
;SUBROUTINE TO SEPARATE INTEGER INTO AA AND FRACTION INTO AC,MQ.
;DO NOT SEPARATE IF MAGNITUDE IS GREATER THAN 2**35.
;FRACTION IS ALWAYS ZERO OR POSITIVE LESS THAN +1.

FIXOAT:	PUSH	PP,ZERO			;CLEAR INTEGER RESULT IN CASE SMALL NUMBER.
IFE XPV,<MOVM	PC,AC>			;GET MAGNITUDE OF EXPONENT.
IFG XPV,<HLLE	PC,AC>			;IN CASE OF DOUBLE-PRECISION,
IFG XPV,<TLC	PC,(PC)>		;WE MUST ALLOW FOR -0.500000000000001
	ASH	PC,-33			;GET AN EXPONENT FOR RIGHT SHIFTING.
	CAIG	PC,243			;WILL THE INTEGER PART FIT 1 WORD?
	CAIG	PC,200			;YES.  WOULD SMALL # ACCURACY REMAIN?
	JRST	APOPJ			;NO.  DON'T DO THE SEPARATION.
	DMOVEM	AC,TEMP4		;SAVE ORIGINAL ARGUMENT.
	PUSHJ	PP,FIX			;GET INTEGER PART.
	MOVEM	MQ,(PP)			;SAVE INTEGER PART.
	PUSHJ	PP,PFLOAT		;PUT INTEGER PART IN FLOATING-POINT FORMAT.
	DFSB	AC,TEMP4		;OBTAIN FRACTION PART
	NEGATE	ACCUM			;	IN POSITIVE FORM.
APOPJ:	POP	PP,AA			;RESTORE AA.
	POPJ	PP,
;SUBROUTINE TO TYPE LINE NUMBER AS MM.NN
;CALL:	MOVE	AC,LN
;	PUSHJ	PP,TYPELN

TYPELN:	PUSH	PP,AC			;SAVE AC - LINE NUMBER.
	LSH	AC,-7			;GET HIGH ORDER PART.
	PUSHJ	PP,TWOFIG		;TYPE AS TWO FIGURES.
	OUTCH	"."			;TYPE ".".
	POP	PP,AC			;RESTORE FOR LOW ORDER PART.
;FALL INTO TWOFIG TO TYPE TWO FIGURES AND RETURN.
;SUBROUTINE TO TYPE C(AC) AS TWO-DIGIT NUMBER.
TWOFIG:	ANDI	AC,177			;LIMIT TO TWO DIGITS.
	HRLI	AA,1			;SPECIFY TWO DIGITS.
	JRST	TYPIN0			;TYPE IN DECIMAL.
SUBTTL FUNCTIONS
DEFINE X(A,B) <
SIXBIT "A"
>;END DEFINE X(A,B)

FNCLST:	FNCLIST
;GENERATE HALF WORD DISPATCH TABLE.
	XXX=0
	DEFINE X (A,B) <
	IF2 <IFNDEF B,<EXTERNAL B>>
	IFE XXX&1,<DEFINE XX (XXX) <	XWD B,XXX>>
	IFN XXX&1,<XX B>
	XXX=XXX+1
>;END 	DEFINE X (A,B)
FNCTAB:	FNCLIST
	IFN XXX&1,<XX 0>		;GENERATE LAST ADDRESS IF ODD NUMBER.
NFUNCS=XXX
	SUBTTL FUNCTIONS SINE AND COSINE
COMMENT \
IF THE ARGUMENT IS IN DEGREES, THE PROPER ENTRY POINTS ARE
SIND AND COSD, WHILE IF THE ARGUMENT IS IN RADIANS, THE
PROPER ENTRY POINTS ARE SIN AND COS.
COSD CALLS SIND TO CALCULATE SIND(PI/2+X)
COS CALLS SIN TO CALCULATE SIN (PI/2+X)
SIND CALLS SIN AFTER A CONVERSION FROM DEGREES TO RADIANS.



	SINGLE PRECISION SINE AND COSINE

THIS ROUTINE CALCULATES SINES AFTER REDUCING THE ARGUMENT TO
THE FIRST QUADRANT AND CHECKING THE OVERFLOW BITS TO DETERMINE
THE QUADRANT OF THE ORIGINAL ARGUMENT.
000 - 1ST QUADRANT
001 - 2ND QUADRANT
010 - 3RD QUADRANT
011 - 4TH QUADRANT
THE ALGORITHM USES A MODIFIED TAYLOR SERIES TO CALCULATE 
THE SINE OF THE NORMALIZED ARGUMENT.



	DOUBLE PRECISION SINE AND COSINE

	REDUCTION FORMULAE:
1.	SIN(X+2N*PI)	=SIN(X)
2.	SIN(X+PI)	=-SIN(X)
3.	SIN(PI/2-X)	=SIN(PI/2+X)
4.	SIN(PI-X)	=SIN(X)
\
COSD:	DFAD	AC,NINETY		;ADD 90 DEGREES.
SIND:	DFDV	AC,FORTYFIVE		;CONVERT TO OCTANTS.
	JRST	SIN0			;ENTER SINE ROUTINE.
COS:	DFAD	AC,PIOT			;ADD PI/2.
SIN:	DFDV	AC,PION4		;COMPUTE X/(PI/4)
SIN0:	JSP	PC,ODDFNC		;SINE IS AN ODD FUNCTION.
	SETOM	FOVSUP			;SUPPRESS FLOATING-POINT TRAP MESSAGES.
IFE XPV,<
	FSC	AC,-1			;CONVERT TO QUADRANTS.
	CAMG	AC,ONE			;IS X/(PI/2) .LT. 1.0 ?
	JRST	SIN2			;YES,ARG IN 1ST QUADRANT ALREADY.
	MULI	AC,400			;NO,SEPARATE FRACTION AND EXP.
	ASH	MQ,-202(AC)		;GET X MODULO 2PI.
	MOVEI	AC,200			;PREPARE FLOATING FRACTION.
	ROT	MQ,3			;MOVE QUADRANT BITS FROM 1,2 TO 34,35
	LSHC	AC,33			;ARGUMENT NOW IN THE RANGE (-1,1).
	DFAD	AC,ZERO			;NORMALIZE THE ARGUMENT.
	TLCE	MQ,5000			;SUBTRACT 1.0 FROM ARG IF BITS ARE
	FSB	AC,ONE			;001 OR 011.
	TLCE	MQ,3000			;CHECK FOR SECOND QUADRANT, 001.
	TLNN	MQ,3000			;CHECK FOR THIRD QUADRANT, 010.
	MOVNS	AC			;001,010.
SIN2:	PUSH	PP,AC			;STORE REDUCED ARG.
	FMPR	AC,AC			;CALCULATE X^2
	MOVE	MQ,[164475536722]	;GET 1ST CONSTANT.
	FMP	MQ,AC			;MULTIPLY BY X^2
	FAD	MQ,[606315546346]	;ADD IN NEXT CONSTANT.
	FMP	MQ,AC			;MULTIPLY BY X^2.
	FAD	MQ,[175506321276]	;ADD IN NEXT CONSTANT.
	FMP	MQ,AC			;MULTIPLY BY X^2.
	FADR	MQ,[577265210372]	;ADD IN NEXT CONSTANT.
	FMPR	AC,MQ			;MULTIPLY BY X^2.
	FADR	AC,PIOT			;ADD IN LAST CONSTANT, PI/2
	FMPR	AC,0(PP)		;MULTIPLY BY X.
	SETZM	FOVSUP			;ALLOW ERROR MESSAGES AGAIN.
	JRST	OPRXIT			;RETURN WITH ANSWER IN AC.
>;END IFE XPV
IFG XPV,<
	JSPPC	PROT26			;PROTECT T2-T6
;HERE WITH ARGUMENT POSITIVE IN UNITS OF PI/4.
SIN1:	CAMGE	AC,[8.0]		;LESS THAN 2*PI?
	JRST	SIN2			;YES.
	TLZ	AC,400			;NO.SUBTRACT A MULTIPLE OF 2*PI.
	DFAD	AC,ZERO			;NORMALIZE
	JRST	SIN1			;THEN CHECK AGAIN.
;HERE WITH ARGUMENT REDUCED TO RANGE 0 TO 2*PI IN UNITS OF PI/4.
SIN2:	PUSHJ	PP,FIXOAT		;SEPARATE INTEGER AND FRACTION
	HRRZM	AA,T2			;SAVE NUMBER OF OCTANTS IN T2 BITS 33,34,35,
	TRZE	T2,4			;QUADRANTS 3 OR 4?
	TLC	T2,(T2B0)		;YES.	USE SIN(X+PI)=-SIN(X)
	TRZN	T2,1			;ODD OCTANT?
	JRST	SIN3			;NO.
	TRC	T2,2			;YES.	CHANGE 1 TO 2 AND 3 TO 0
	NEGATE	ACCUM			;THEN USE THE FORMULA ...
	DFAD	AC,ONE			;... SIN(PI/2+X)=SIN(PI/2-X)
SIN3:	DFMP	AC,PION4		;CHANGE TO MAKE MODULO PI/2
	SETZB	T5,T6			;CLEAR THE TERM-COUNTER FOR COSINE-SERIES
	TRNN	T2,2			;IS IT A SINE-SERIES?
	MOVSI	T5,(1.0)		;YES. START TERM-COUNTER AT ONE.
	DMOVEM	AC,T3			;FIRST TERM IS X, FOR SINE-SERIES.
	DFMP	AC,AC			;MAKE X*X
	DMOVEM	AC,TEMP3		;STORE X*X
	TRNE	T2,2			;IS IT A COSINE SERIES?
IFE XPV*<KI+KL-10>,DMOVE T3,ONE		;YES.
IFN XPV*<KI+KL-10>,<
	TDZA	T4,T4			;YES.
	SKIPA				;ARE YOU SURE?
	MOVSI	T3,(1.0)		;YES.
>;END IFN XPV*<KI+KL-10>
	DMOVE	AC,T3			;INITIAL TERM EQUALS INITIAL SUM.
SIN4:
IFN XPV*<KI+KL-10>,DEXCH AC,T3		;RESTORE TERM TO AC,MQ ; SUM TO T3,T4
	DFMP	AC,TEMP3		;MULTIPLY LAST TERM BY X*X
	FADRI	T5,201400		;INCREMENT TERM-COUNTER.
	DFDV	AC,T5			;MAKE TERM WITH FACTORIAL DENOMINATOR.
	FADRI	T5,201400		;INCREMENT TERM-COUNTER.
	DFDV	AC,T5			;A REAL FACTORIAL.
	NEGATE	ACCUM			;SUCCESSIVE TERMS HAVE DIFFERENT SIGN.
IFE XPV*<KI+KL-10>,DFAD	T3,AC		;ADD TERM TO SUM.
IFE XPV*<KI+KL-10>,MOVM	UA,AC		;GET SIZE OF LAST TERM.
IFN XPV*<KI+KL-10>,<
	DEXCH	AC,T3			;IF UUO, IT CAN ONLY USE AC,MQ.
	DFAD	AC,T3			;ADD TERM TO SUM.
	MOVM	UA,T3			;GET SIZE OF LAST TERM.
>;END IFN XPV*<KI+KL-10>
	CAML	UA,SIN5			;ENOUGH ITERATIONS?
	JRST	SIN4			;NO, LOOP BACK FOR MORE OF SERIES
IFE XPV*<KI+KL-10>,DMOVE AC,T3		;YES. GET THE SUM.
	SETZM	FOVSUP			;ALLOW ERROR MESSAGES AGAIN.
	JRST	ATAN6			;ADJUST IF NEGATIVE ARGUMENT.
SIN5:	;SIZE OF THE LAST TERM THAT NEED BE ADDED.
IFE XPV,<EXP 186.7 -33B8>		;MAXIMUM 10 TERMS.
IFN XPV,<
IFN KA-10,<EXP 537.4 -76B8>		;MAXIMUM 18 TERMS.
IFE KA-10,<EXP 432.7 -66B8>		;MAXIMUM 16 TERMS.
>;END IFN XPV
>;END IFG XPV
SUBTTL MINOR FUNCTIONS
FHIBER:	PUSHJ	PP,RFIX			;OBTAIN "SIGNED 36-BIT INTEGER".
	CALLI	MQ,72			;HIBERNATE.
	CALLI	MQ,31			;SLEEP IF HIBERNATE FAILS.
	DMOVE	AC,ONE			;SET VALUE FOR NON-EMPTY TTY BUFFER
	MOVEI	UA,1			;TRMOP. FUNCTION CODE 0001: SKIP ON BUFFER
	MOVE	AA,[XWD 2,UA]		;POINT TO ARGUMENT BLOCK.
IFN UA+1-PC,PX INVALID ACCUMULATOR ASSIGNMENTS AT FHIBER:
	CALLI	PC,30			;GET JOB NUMBER OF THIS JOB.
	CALLI	PC,115			;GET UNIVERSAL I/O INDEX OF THIS JOB'S TTY.
	AOSA	.JBERR##		;HERE IF JOB IS DETACHED OR TRMNO. NOT LEGAL
	CALLI	AA,116			;TRMOP. UUO.: SKIP IF BUFFER NON-EMPTY.
ZERANS:	SETZB	AC,MQ			;CLEAR BOTH PARTS OF ACCUMULATOR.
ABS:	JUMPL	AC,NEGANS		;GET MAGNITUDE;THIS OP-CODE USED BY FXUANS.
	POPJ	PP,			;RETURN

GETAB:	PUSHJ	PP,RFIX			;GET TABLE NUMBER IN AC,MQ.
	PUSH	PP,MQ			;SAVE TABLE NUMBER.
	PUSHJ	PP,SECARG		;GET SECOND ARGUMENT IF ANY.
	PUSHJ	PP,RFIX			;2ND ARG AS INTEGER.
	HRLM	MQ,(PP)			;MAKE ARGUMENT FOR GETTAB UUO.
	POP	PP,AC			;SET ACCUM FOR UUO.
	GETTAB	AC,			;CALL MONITOR.
	AOS	.JBERR##		;IGNORE ERROR RETURN.
	JRST	DFLOAT			;RETURN.
;SUBROUTINE TO READ A SECOND NUMERIC ARGUMENT IF ANY.
SECARG:	CAIE	CH,","			;IS THERE A SECOND ARGUMENT?
	JRST	ZERANS			;NO.	RETURN ZERO.
	HPSTP	EVALN			;YES. GO GET IT & RETURN.

FOCALF:	CAMGE	AC,CON.23		;IS ARGUMENT GREATER OR EQUAL 23.?
	JRST	FOCAL1			;NO.
	PUSHJ	PP,RFIX			;YES. CONVERT TO FIXED POINT.
	CAMG	MQ,.JBREL##		;MEMORY SIZE CHECK.
	MOVE	AC,(MQ)			;COLLECT A WORD FROM MEMORY.
	JRST	DFLOAT			;RETURN TO USER.
FOCAL1:	DFSB	AC,ONE			;MAKE ZERO ARGUMENT GIVE BIT 35.
	PUSHJ	PP,ANTIL2		;GET 2**X.
	PUSHJ	PP,RFIX			;GET A BIT MASK.
	PUSH	PP,MQ			;SAVE IT.
	PUSHJ	PP,SECARG		;SECOND ARGUMENT.
	POP	PP,MQ			;RESTORE BIT MASK.
	HRLZI	AA,(TRZN	F0,(MQ));CREATE AN INSTRUCTION.
	SKIPLE	AC			;WILL WE SET OR CLEAR THE BIT?
	HRLZI	AA,(TRON	F0,(MQ));SET IT.
	MOVEI	AC,1			;ASSUME IT WAS SET ALREADY.
	XCT	AA			;TEST WITH TRZN OR TRON.
	MOVNI	AC,1			;IT WAS PREVIOUSLY CLEAR.
;FALL INTO A RETURN SUBROUTINE.
;	SUBTTL FUNCTION SIGN
;OBTAINS +1 IF ARGUMENT IS POSITIVE OR ZERO, -1 IF ARGUMENT IS NEGATIVE
SIGN:	JSP	PC,ODDFNC		;SIGN IS AN ODD FUNCTION.
	DMOVE	AC,ONE			;WITH VALUE UNITY.
	POPJ	PP,
;ROUTINE TO CALL PRIOR TO EVALUATING AN ODD FUNCTION.
;THIS ROUTINE MAKES THE ARGUMENT POSITIVE, AND
;IF IT WAS NEGATIVE IT PUTS A CALL TO NEGANS ON THE STACK FOR LATER.
;COME HERE WITH JSP	PC,ODDFNC.
ODDFNC:	JUMPGE	AC,(PC)			;DO NOTHING IF ARGUMENT WAS POSITIVE.
	PUSH	PP,JNEG			;MAKE FUNCTION RETURN VIA NEGANS.
	PUSH	PP,PC			;NEGATE THE ARGUMENT BEFORE RETURNING.
NEGANS:
IFE XPV*<KI+KL-10>,NEGATE	ACCUM
IFN XPV*KA,<DFN	AC,MQ>			;KA-10 NEGATE.
IFN XPV*KA,<FADL AC,MQ>			;ENSURE NORMALIZED.[EG 576400..,146100..]
IFE XPV*<PDP-10>,<POPJ	PP,>		;AND RETURN.
IFN XPV*<PDP-10>,<
	SETCMM	AC			;NEGATE HIGH ORDER PART
	MOVNS	MQ			;NEGATE LOW ORDER PART
	TLZ	MQ,400000		;CLEAR LOW ORDER BIT 0.
	JUMPN	MQ,CPOPJ		;IF LOW ORDER WAS ZERO,
	AOJA	AC,CPOPJ		;THEN MAKE HIGH ORDER TWO'S-COMPLEMENT.
>;END IFN XPV*<PDP-10>

FITR:	JSP	PC,ODDFNC		;FITR IS AN ODD FUNCTION.
	CAML	AC,[1.0+<33B8*WPV-<<<KA-10>*XPV>_^D27>>]	;OUT OF RANGE?
	POPJ	PP,			;YES.	'TIS INTEGER ALREADY.
	PUSHJ	PP,FIX			;MAKE INTEGER
PFLOAT:	;HERE TO FLOAT AN INTEGER IN AC,MQ
IFE <KA-10>*XPV,<
	ASHC	AC,8
	ASH	MQ,-8
	FSC	MQ,233
IFE PDP-6,<
	TDNN	MQ,[EXP 777777777]	;I'M NOT SURE IF HARDWARE ALWAYS DOES THIS.
	SETZM	MQ			;SO BEST TO PLAY SAFE.
>;END IFE PDP-6
	SKIPGE	MQ			;WAS THE NUMBER NEGATIVE?
	AOSE	AC			;YES. ADJUST FOR ONES COMPLEMENT IN AC.
>;END IFE <KA-10>*XPV
	TLC	AC,(<<266-<<KA-10>*XPV>>_^D27>);SIMULATE DOUBLE-PRECISION FSC
IFE XPV,<FADR	AC,MQ>			;NORMALIZE THE RESULT
IFN XPV,<DFAD	AC,ZERO>		;NORMALIZE THE RESULT.
	POPJ	PP,

;SUBROUTINE TO GET RECIPROCAL OF A NUMBER.
RECIPR:	DMOVEM	AC,TEMPR		;SAVE ARGUMENT.
	DMOVE	AC,ONE			;GET UNITY.
	DFDV	AC,TEMPR		;CREATE RECIPROCAL.
	POPJ	PP,			;RETURN.
	SUBTTL FUNCTION FRAN
;GENERATES A RANDOM NUMBER BETWEEN 0.5 AND 1.
;THE ARGUMENT IS USED TO DETERMINE THE TYPE OF RANDOM NUMBER...
;	NEGATIVE - TRUE RANDOM.
;	POSITIVE - INITIALIZE THE PSEUDO-RANDOM GENERATOR.
;	ZERO - NEXT PSEUDO-RANDOM NUMBER.

FRAN:	JUMPG	AC,FRAN2		;POSITIVE - INIT PSEUDO-#.
	JUMPE	AC,FRAN1		;ZERO	  - NEXT #.
;HERE FOR TRUE RANDOMNESS!
	MSTIME	AC,			;TIME-OF-DAY RANDOMIZER.
	TSC	AC,AC			;EXPAND TO BOTH HALVES.
	ROT	AC,(AC)			;STIR WELL.
IFN XPV*KA,<
	TLZ	MQ,777000		;FIX EXPONENT
	TLO	MQ,145000		;TO MAKE DOUBLE PRECISION NORMALIZED
>;END IFN XPV*KA
	TLZ	AC,577000		;FIX EXPONENT
	TLO	AC,200400		;TO BE IN RANGE 0.5 TO 1.0.
FRAN1:	DFAD	AC,OLDRAN		;ADD REST OF INGREDIENTS.
	SKIPN	AC			;SKIP EXCEPT FIRST TIME.
FRAN2:	DMOVE	AC,FSTRAN		;INIT PSEUDO-#.
	DFMP	AC,FACTOR		;MOVE ALONG THE SERIES.
	PUSHJ	PP,FIXOAT
	CAMGE	AC,HALF			;CHECK TO ENSURE
	DFAD	AC,HALF			;ANSWER IS IN RANGE 0.5 TO 1.0
	DMOVEM	AC,OLDRAN		;LEAVE TRAIL FOR NEXT #.
	POPJ	PP,

FACTOR:
CON.23:	DATA 23.0,0
SUBTTL FUNCTION ATAN
COMMENT \
THE REDUCTION FORMULAE ARE:

FOR X LESS THAN ZERO, WE USE THE IDENTITY
	ATAN(X) = -ATAN(-X)
FOR X GREATER THAN 1.0, WE USE THE IDENTITY
	ATAN(X) = PI/2 - ATAN(1/X)
FOR X BETWEEN (2-(3^.5)) AND 1.0, WE USE THE IDENTITY
	ATAN(X) = PI/6 + ATAN((X*(3^.5)-1)/(X+(3^.5)))
FOR X LESS THAN SQRT(3)*2**-27, ATAN(X)=X IS USED

THE POWER SERIES IS:
	Z=X*X/(1+X*X)
ATAN(X)=Z/X * (1+(2/3)*Z * (1+(4/5)*Z * (1+(6/7)*Z * (.....))))

WHERE THE INNERMOST FACTOR IS 1+N/(N+1)*X, AND
	N IS ROUGHLY 3+B/2, WHERE
	B IS THE NUMBER OF BITS IN THE MANTISSA OF A NUMBER.
\
ATAN:	JSPPC	PROT26			;PROTECT T2-T6
	T2B0==1B0			;BIT 0 OF ACCUMULATOR T2.
	T2B1==1B1			;BIT 1 OF ACCUMULATOR T2.
	T2B2==1B2			;BIT 2 OF ACCUMULATOR T2.
	JSP	PC,ODDFNC		;ATAN IS AN ODD FUNCTION.
	HRLI	T2,(T2B0!T2B1)		;SET TWO FLAG BITS IN CASE ARG.GE.1.
	CAMGE	AC,ONE			;ARGUMENT LESS THAN UNITY?
	TLZA	T2,(T2B0!T2B1)		;NO.   CLEAR THE FLAGS.
	PUSHJ	PP,RECIPROCAL		;YES.  LEAVE THE FLAGS AND INVERT ARGUMENT
	DMOVEM	AC,TEMP1		;SAVE THE REDUCED ARGUMENT.
	CAMGE	AC,[0.2679491924311]	;IS ARG .GE. (2-(3^.5))?
	JRST	ATAN2			;NO, PROCEED WITH ALGORITHM
	TLO	T2,(T2B2)		;SET FLAG TO LATER ADD ATAN(1/(3^.5))
	DFAD	AC,ROOT3		;COMPUTE X+(3^.5)
IFN <XPV-1>!<KI+KL-10>,DEXCH AC,TEMP1	;GET X, SAVE X+(3^.5)
IFE <XPV-1>!<KI+KL-10>,EXCH AC,TEMP1	;GET X, SAVE X+(3^.5)
IFE <XPV-1>!<KI+KL-10>,EXCH MQ,TEMP1+1	;GET X, SAVE X+(3^.5)
	DFMP	AC,ROOT3		;COMPUTE (3^.5)*X
	DFSB	AC,ONE			;COMPUTE (3^.5)X-1
	DFDV	AC,TEMP1		;COMPUTE ((3^.5)X-1)/(X+(3^.5))
	DMOVEM	AC,TEMP1		;AND SAVE.
ATAN2:	MOVM	AA,AC			;ALLOW NEGATIVE ARGUMENT AT THIS STAGE
	CAMGE	AA,SMALL		;CAN ATAN(X)=X?
	JRST	ATAN5			;YES
	DFMP	AC,AC			;COMPUTE X*X
	DMOVEM	AC,T3			;SAVE X*X IN T3
	DFAD	AC,ONE			;COMPUTE 1+X*X
IFN XPV*<KI+KL-10>,<
	DEXCH	AC,T3			;GET X*X
	DFDV	AC,T3			;GET X*X/(1+X*X)
	DMOVEM	AC,T3			;SAVE X*X/(1+X*X) IN T3
>;END IFN XPV*<KI+KL-10>
IFE XPV*<KI+KL-10>,<
	DFDV	T3,AC			;GET X*X/(1+X*X) IN T3
	DMOVE	AC,T3			;GET X*X/(1+X*X)
>;END IFE XPV*<KI+KL-10>
	GETT5	DATANCOUNT
IFG XPV,<SETZM	T6>			;CREATE DOUBLE PRECISION #.
ATAN4:	FSBRI	T5,201400		;DECREMENT NUMERATOR.
	DFDV	AC,T5			;CREATE FACTOR...
	FSBRI	T5,201400		;DECREMENT NUMERATOR.
	JUMPLE	T5,ATAN4A		;EXIT IF DONE.
	DFMP	AC,T5			;...
	DFAD	AC,ONE			;TO MAKE 1+N/(N+1)*(...)
	DFMP	AC,T3			;...  Z*(1+N/(N+1)*(...)
	JRST	ATAN4			;LOOP UNTIL DONE.
ATAN4A:	DFDV	AC,TEMP1		;FINALLY DIVIDE BY X.
ATAN5:	TLNE	T2,(T2B2)		;ADD ATAN(1/(3^.5))?
	DFAD	AC,PION6		;YES.
	TLNE	T2,(T2B1)		;ADD -PI/2?
	DFSB	AC,PIOT			;YES.
ATAN6:	JUMPGE	T2,CPOPJ		;NEGATE RESULT?
JNEG:	JRST	NEGANS			;YES.
	SUBTTL FUNCTION SQRT
COMMENT \
	THE SQUARE-ROOT FUNCTION IS COMPUTED AS THE ANTILOG OF HALF
THE LOGARITHM OF THE ARGUMENT.   IF THE ARGUMENT IS ZERO, HOWEVER,
IT MUST BE TREATED AS A SPECIAL CASE BECAUSE IT IS ILLEGAL TO TAKE
THE LOGARITHM OF ZERO.
\

SQRT:	SKIPGE	AC			;NEGATIVE ARGUMENT?
	ERROR	ILSQRT			;YES.	ERROR.
	JUMPE	AC,CPOPJ		;STRAIGHT RETURN ON ZERO ARGUMENT
	PUSHJ	PP,LOG			;GET LOG(X)
	HALVE	ACCUM			;GET 0.5*LOG(X)
;	JRST	EXP			;GET EXP(0.5*LOG(X)) AND RETURN.

IF2 < IFN EXP-.,PX ERROR IN SQRT EXIT>
	SUBTTL FUNCTION EXP
COMMENT \
THE REDUCTION FORMULAE ARE:
IF X IS LESS THAN -89.415...,THE PROGRAM RETURNS ZERO AS THE ANSWER
IF X IS GREATER THAN 88.029...,THE PROGRAM RETURNS 377777777777 AS THE ANSWER

THENCE:
EXP(X)	= 2**(X*LOG2(E))
	= 2**(M+F) WHERE M IS AN INTEGER AND F LIES BETWEEN 0 AND 1.
	= 2**M * EXP(F*LOGE(2))
2**M IS CALCULATED EASILY WITH THE FLOATING SCALE INSTRUCTION.

FINALLY, EXP(F*LOG(2)) IS CALCULATED BY A CONTINUED FRACTION

Z=F*LOGE(2)
EXP(Z)=1+Z/((1-Z/2)+Z*Z/4/3/(1+(Z*Z/4/15/(1+Z*Z/4/35/(1+.....Z*Z/4/(4*N*N-1)/(1+.....))))))
\
EXP:	DFMP	AC,DLOG2E		;ENTER HERE TO FIND E**AC.
;HERE TO CHECK ARGUMENT RANGE		;ENTER HERE TO FIND 2**AC.
ANTIL2:	CAMGE	AC,[-129.0]		;CHECK LIMITS.
	JRST	FXUANS			;VERY SMALL - SAY ZERO
	CAML	AC,[127.0]		;CHECK.
	JRST	FOVANS			;VERY LARGE - SAY INFINITY.
;HERE TO SEPARATE INTEGER PART FROM FRACTION PART.
	PUSHJ	PP,FIXOAT		;SEPARATE INTEGER FROM FRACTION
	HRRZM	AA,TEMP3		;STORE INTEGER PART
;HERE WITH F IN AC
	SETOM	FOVSUP			;SUPPRESS FLOATING-POINT TRAP.
	DFDV	AC,DLOG2E		;MULTIPLY BY LOGE(2) TO GET Z.
	DMOVEM	AC,TEMP1		;SAVE Z IN TEMP1
	HALVE	ACCUM			;MAKE Z/2
	DMOVEM	AC,TEMP2		;SAVE Z/2
	DFMP	AC,AC			;MAKE Z^2/4.
	DMOVEM	AC,TEMPE		;SAVE Z^2/4.
	JSPPC	PROT26			;PROTECT T2 THRU T6.
IFG XPV,<SETZB	T3,T6>			;CLEAR HIGH ORDER PARTS.
	MOVEI	T4,3+XPV*<4-KA/10>	;GET ITERATION COUNTER, N.
	MOVSI	T2,(1.0)		;GET ONE INTO T2,T3.
EXP1:	MOVE	T5,T4			;GET N INTO T5.
	ADD	T5,T5			;GET N*2.
	IMUL	T5,T5			;GET 4*N*N.
	SOS	T5			;GET 4*N*N-1
	FSC	T5,233			;GET IT IN FLOATING-POINT IN T5,T6.
	DMOVE	AC,TEMPE		;GET Z^2/4.
	DFDV	AC,T5			;GET Z^2/4/(4*N*N-1).
	DFDV	AC,T2			;GET Z^2/4/(4*N*N-1)/(1+...)
	DFAD	AC,ONE			;GET (1+Z^2/4/(4*N*N-1)/(1+...))
	DMOVEM	AC,T2			;SAVE FOR NEXT ITERATION.
	SOJG	T4,EXP1			;CONTINUE UNTIL DONE.
IFE XPV*<KI+KL-10>,DFSB	T2,TEMP2	;SUBTRACT Z/2.
IFN XPV*<KI+KL-10>,<
	DFSB	AC,TEMP2		;SUBTRACT Z/2.
	DMOVEM	AC,T2			;SAVE IN TEMPORARY STORAGE.
>;END IFN XPV*<KI+KL-10>
	DMOVE	AC,TEMP1		;GET Z.
	DFDV	AC,T2			;GET Z/(1-Z/2+Z^2/4/3...)
	DFAD	AC,ONE			;GET EXP(Z).
	FSC	AC,@TEMP3		;SCALE RESULTS
IFN KA*XPV,<FSC	MQ,@TEMP3>		;SCALE LOW ORDER.
IFN KA*XPV,<FADL AC,MQ>			;ENSURE THE ANSWER IS NORMALIZED.
	SETZM	FOVSUP			;ALLOW FLOATING POINT TRAP.
	POPJ	PP,
	SUBTTL FUNCTIONS LOG,LOG10
COMMENT \
LOG   IS THE ENTRY POINT FOR LOGE(X),AND
LOG10 IS THE ENTRY POINT FOR LOG10(X).

LOG10(X) IS COMPUTED BY MULTIPLYING LOGE(X) BY LOG(10) TO BASE E.

NEGATIVE ARGUMENTS ARE (TO HELP THE USERS) TREATED AS POSITIVE.
A ZERO ARGUMENT GIVES A FLOATING-OVERFLOW ERROR MESSAGE.

METHOD.
LOGE(X) IS TREATED BY FIRST COMPUTING LOG2(X) THEN MULTIPLYING BY LOG(2) TO BASE E.

LOG2(X) IS COMPUTED IN THE FOLLOWING STEPS:
1.	EXTRACT THE EXPONENT OF X.   IT WILL BE THE INTEGER PART OF THE RESULT.
2.	OBTAIN SUCCESSIVE BITS OF THE FRACTION-PART OF THE RESULT BY
	SUCCESSIVELY MULTIPLYING X BY X AND EXTRACTING THE EXPONENT.
3.	COMBINE THE INTEGER AND FRACTION BITS OF THE RESULT.
\
LOG10:	PUSHJ	PP,LOG			;FIND LOG TO BASE E.
	DFMP	AC,LOG10E		;CONVERT TO BASE 10.
	POPJ	PP,			;RETURN

LOG:	JUMPE	AC,FOVANS		;LOG OF ZERO IS INFINITY.
	PUSHJ	PP,ABS			;AS A SOP TO THE USERS: MAKE IT POSITIVE.
	JSPPC	PROT23			;PRESERVE T2,T3.
	LDB	<T2+XPV>,[POINT 8,AC,8]	;PICK UP EXPONENT FROM HIGH ORDER
IFG XPV,<SETZM	T2>			;CLEAR THE RESULT POSITION HIGH PART.
	TRO	<T2+XPV>,400_<KA*XPV>	;SET A FLAG BIT TO STOP THE ITERATION.
	TLZ	AC,576000		;CLEAR EXPONENT TO 201.
IFN XPV*KA,<TLO	MQ,146000>		;SET EXPONENT LOW ORDER TO 146.
DLOG2:
IFN XPV*KA,<TLZ	MQ,631000>		;CLEAR EXPONENT LOW ORDER TO 146.
	TLO	AC,201000		;SET EXPONENT TO 201.
	DFMP	AC,AC			;MULTIPLY X BY X.
	DLSH	T2,1			;MAKE SPACE FOR ONE BIT IN RESULT.
	TLZE	AC,002000		;IS X*X GREATER THAN 2.0?
	TRO	<T2+XPV>,1		;YES.  ADD A BIT TO THE RESULT.
	JUMPGE	T2,DLOG2		;LOOP TO COMPLETE THE RESULT.
	DLSH	T2,1+<KA*XPV>		;CLEAR ITERATION FLAG.
	TLC	T2,(1B0)		;EFFECTIVELY SUBTRACT 200 FROM EXPONENT.
IFG XPV,<LSH	T3,-1>			;CLEAR BIT ZERO OF LOW ORDER WORD.
	DMOVE	AC,T2			;GET INTEGER FORM OF RESULT IN AC,MQ.
	SKIPGE	T2			;PREPARE FOR JFFO.
	SETCMM	T2			;IN CASE OF NEGATIVE RESULT, COUNT LEADING 1'S
IFE PDP-10,<JFFO T2,DLOG3>		;COUNT LEADING ZEROES.
IFN PDP-10,<
	SETZM	T3			;PDP-6 DOESN'T HAVE JFFO.
	JUMPN	T2,[	AOS	T3	;COUNT THE LEADING ZEROES SLOWLY
			LSH	T2,1	;AND CAREFULLY.
			JUMPG	T2,@.	;UNTIL NONE LEFT.
			JRST	DLOG3]	;THEN CONTINUE.
>;END IFN PDP-10
	MOVEI	T3,44			;ASSUME AT LEAST 36 DECIMAL LEADING ZEROES.
DLOG3:	DASH	AC,-9(T3)		;BRING MOST SIGNIFICANT BIT TO BIT 9 POSN.
	IMULI	T3,777000		;NEGATE AND SHIFT THE #-ZEROES ADJUSTMENT.
	TLC	AC,210000(T3)		;DO FSC WITHOUT NORMALIZE.
IFN XPV*KA,<LSH	MQ,-8>			;CLEAR LOW ORDER EXPONENT.
IFN XPV*KA,<TLZ MQ,777000>		;CLEAR LOW ORDER EXPONENT.
IFN XPV*KA,<TLO	MQ,155000(T3)>		;DO SAME ON LOW ORDER FOR KA-10.
IFN XPV*KA,<FADL AC,MQ>			;NORMALIZE.
	DFSB	AC,ONE			;COMPLETE THE SUBTRACTION OF EXPONENT 201
	DFDV	AC,DLOG2E		;COMPUTE N*LOGE(2)
	POPJ	PP,
	SUBTTL DATA AREA
MONTHS:	ASCIZ	"Jan-"
	ASCIZ	"Feb-"
	ASCIZ	"Mar-"
	ASCIZ	"Apr-"
	ASCIZ	"May-"
	ASCIZ	"Jun-"
	ASCIZ	"Jul-"
	ASCIZ	"Aug-"
	ASCIZ	"Sep-"
	ASCIZ	"Oct-"
	ASCIZ	"Nov-"
	ASCIZ	"Dec-"
CRLF:	IFG MONITOR-3.27,<
ASCIZ "
"
>;END IFG MONITOR-3.27
IFLE MONITOR-3.27,<
ASCIZ "
"
>;END IFLE MONITOR-3.27	;OLD MONITORS DO NOT PROVIDE FILLERS FOR CR.
CONUCR:IFG MONITOR-3.27,<
ASCIZ "^U
"
>;END CONUCR:IFG MONITOR-3.27
IFLE MONITOR-3.27,<
ASCIZ "^U
"
>;END IFLE MONITOR-3.27
FSTRAN:				;FIRST RANDOM NUMBER.
LOG10E:	DATA 177674557305,111562416145	;LOG E, BASE 10 =.43429448190325182765
DLOG2E:	DATA 201561250731,112701376057	;LOG E, BASE 2 = 1.44269 50408 88963 40740
PIOT:	DATA 201622077325,021026430215	;PI/2 = 1.57079 63267 94896 61923
PION4:	DATA 200622077325,021026430215	;PI/4
SMALL:	EXP 1.73205080756887-33B8+<KA-10>_^D27	;SO THAT Z^2/3 IS INSIGNIFICANT.
PION6:	DATA 200414052216,013271545411	;PI/6
NINETY:	DATA 90.0,0
FORTYF:	DATA 45.0,0.0			;FORTY-FIVE DEGREES = ONE OCTANT.
ROOT3:	DATA 201673317272,026046252347	;SQRT(3)=1.73205 08075 68877 2935
TEN:	DATA 10.0,0
ONE:	DATA 1.0,0
HALF:	0.5
ZERO:	DATA 0,0
CODEND:
	END	ONCE