.NLIST
	.IFNDF	$PAPER
	$RT11=0			;IF NOT PAPER TAPE VERSION, THEN MUST BE RT-11
	.ENDC
	.LIST
;
;	/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
;	\						   /
	.IFDF	$RT11
;	/	F  O  C  A  L    -    R  T  -  1  1        \
	.IFF
;	/	F  O  C  A  L    -    PAPER TAPE	   \
	.ENDC
;	\						   /
;	/						   \
	.IFDF	$PAPER
;	\		DEC-11-LFOCB-A-LA		   /
	.IFF
;	\		DEC-11-ORUMA-A-LA		   /
	.ENDC
;	/						   \
;	\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/
;
;			LISTING PART II. (MAINLINE)
;
;	 ORIGINAL CODING PERFORMED:	DECEMBER 8, 1972
;			        BY:	RICHARD MERRIL
;
	.IFDF	$PAPER
;	  PAPER TAPE VERSION CODED:	JUNE 9,1974
	.IFF
;	RT-11 VERSION CONVERTED ON:	JUNE 9,1974
	.ENDC
;			        BY:	GEORGE S. KACZOWKA (HIAS)
;
	.IFDF	$RT11
;	RT-11 V4.0 UPDATE ON:		8 SEPTEMBER 1982
;				BY:	ALAN R. BALDWIN
;					KENT STATE UNIVERSITY
;					KENT, OHIO  44242
	.ENDC
;
;
;	COPYRIGHT (C) 1974 BY DIGITAL EQUIPMENT CORPORATION
;				MAYNARD, MASSACHUSETTS 01754
;
;
; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO
; CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
; AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
; DEC ASSUMES NO RESPONSIBILITY FOR ANY ERRORS THAT
; MAY APPEAR IN THIS DOCUMENT.
;
; THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A
; LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND
; CAN BE COPIED (WITH INCLUSION OF DEC'S COPYRIGHT
; NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT AS MAY
; OTHERWISE BE PROVIDED IN WRITING BY DEC.
;
; DEC ASSUMES NO RESPONSIBILITY FOR THE USE 
; OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT
; WHICH IS NOT SUPPLIED BY DEC.
;
;
;---	IF "$PAPER" IS DEFINED, FOCAL WILL ASSEMBLE AS A PAPER-TAPE
;	VERSION. DEFAULT IS RT-11 VERSION.
;
;	IF "$TRAP" IS DEFINED, INTERNAL CALLS WILL BE VIA
;	A TRAP INSTRUCTION. THIS WILL TAKE LONGER, BUT CORE
;	SIZE WILL BE REDUCED BY APPROXIMATELY 350 WORDS.
;
;	IF "$SMALL" IS DEFINED, FOCAL-11 WILL ASSEMBLE MINUS
;	THE FOLLOWING FEATURES:
;
;		1. ERROR INTERCEPTION
;
;		2. EXTENDED VIRTUAL FILES
;
;		3. FLN,FLOG,FEXP ARE NOT AVAILABLE
;
;		4. SCHEDULING BY EITHER TIME OR INTERRUPT
;
;		5. USE OF QUOTES IN LIBRARY COMMAND
;
	.GLOBL	$DBL		;DOUBLE PRECISION SWITCH
;
;---	NOTE: THIS VARIABLE ($DBL) SHOULD NOT BE DEFINED IN THIS
;	MODULE. IT IS A RUN-TIME DOUBLE PRECISION SWITCH. FOR THIS
;	REASON, THIS VARIABLE SHOULD NEVER BE USED AS A BASIS
;	FOR CONDITIONAL ASSEMBLY.
;
	.IFDF	$PAPER
	.IFDF	$SMALL
	.TITLE	FOCAL - 4K PAPER-TAPE VERSION	
	.IFF
	.TITLE	FOCAL - 8K PAPER-TAPE VERSION
	.ENDC
;
;---	PAPER TAPE VERSION:
	.IFF
	.IFDF	$SMALL
	.TITLE	FOCAL - 8K RT-11 VERSION		
	.IFF
	.TITLE	FOCAL - 12K RT-11 VERSION		
	.ENDC
;
;---	RT-11 VERSION
	.ENDC
;
;		OPTIONS USED:
.IIF DF,$PAPER,;		$PAPER
.IIF DF,$TRAP,;			$TRAP
.IIF DF,$SMALL,;		$SMALL
;
;		SUPPORTS:
;			UP TO 28K CORE
	.IFDF	$TRAP
;			INTERNAL CALLS VIA TRAP INSTRUCTION
	.IFF
;			INTERNAL CALLS VIA JSR INSTRUCTION
	.ENDC
	.IFNDF	$SMALL
;			EITHER SINGLE OR DOUBLE PRECISION PACKAGE
;				(LINKAGE OPTION)
	.IFF
;			SINGLE PRECISION ARITMETIC ONLY
	.ENDC
	.IFDF	$RT11
;			DYNAMIC MEMORY ALLOCATION
;			FULL LIBRARY CAPABILITIES
;			VIRTUAL FILES
;			UP TO 8 USER FILES ACCESSED AT ONE TIME
	.ENDC
	.IFNDF	$SMALL
;			FOCAL INTERRUPT SCHEDULING PROVIDED
;			ASYNCHRONOUS TASK SCHEDULING BY TIME
	.ENDC

;DOCUMENTATION NOTES:
;DOUBLE QUOTE MARKS DENOTE TRAP-INSTRUCTION MODULES
;(X) MEANS THE CONTENT-OF-X.
;ASTERISKS DENOTE COMMAND MODULES.
;"C.R."MEANS "CARRIAGE RETURN".
;SINGLE QUOTE MARKS DENOTE A SUBROUTINE.

	.SBTTL	ASSIGNMENTS OF REGISTERS



;AS USED GENERALLY
	TEMP=%0			;SCRATCH
	AC=%1			;ACCUMULATOR
	PTR=%2			;VARIABLE POINTER
	AXOUT=%3		;TEXT READER
	CHAR=%4			;CHARACTER
	R5=%5			;EXCEPTIONAL USE REGISTER AND RUBOUT PROTECTION
	R4=%4
	R3=%3
	R2=%2
	R1=%1
	R0=%0			;TEMP REG USED BY RT-11 PATCH ROUTINES..
	SP=%6			;STACK POINTER
	PC=%7			;PROGRAM COUNTER PDP-11



	ONE=200			;SWITCH ASSIGNMENTS
	ALL=1
	NALPHA=20		;0=TERMINATE ON ASCII CODES
				;1=TERMINATE ON ;;C.R.ALSO

	CR=216			;INTERNAL CODE
	CRLF=05015		;FOR USE IN "PRINT2 <CRLF>"

	STATUS=177776
	PSW=STATUS		;PDP-11 PEOPLE ARE FAMILIAR WITH THIS...
	.IFDF	$RT11
	.SBTTL	RT-11 DEFINITIONS AND MACRO CALLS
;
	.MCALL	.TTYIN,.TTYOUT,..V2..
	.MCALL	.SRESET,.SETTOP,.RCTRLO,.HRESET,.DATE,.GTIM
	.MCALL	.LOOKUP,.ENTER,.FETCH,.RELEASE,.DSTATUS,.CLOSE
	.MCALL	.WRITW,.READW,.TRPSET,.CSISPC
	.MCALL	.MFPS
;
;---	FOLLOWING ARE MONITOR PARAMETER LOCATIONS FOR RT-11
;
.GLOBL	RESTRT			;START ADDRESS 
.GLOBL	STACKP			;STACK POINTER (INITIALLY 1000)
.GLOBL	JSW			;JOB STATUS WORD
.GLOBL		RESBIT		;RESTART BIT (SET=YES)
.GLOBL		TTYSPC		;TTY I/O MODE (SET=SPECIAL)
.GLOBL		IOHALT		;HALT ON I/O ERROR (SET=YES)
.GLOBL	USRADD			;ADDRESS FOR USR SWAPPING
.GLOBL	HICOR			;HIGH CORE ADDRESS
.GLOBL	EMTERR			;EMT ERROR CODE
.GLOBL	RMON			;RMON START ADDRESS
.GLOBL	FILCHR			;FILL CHARACTER
.GLOBL	FILCNT			;COUNT OF FILL CHARACTERS NEEDED (0=NONE)
;
;---	USRLD - RT-11 V2-01 OFFSET TO START OF NORMAL USR AREA. N.B. - IF
;		A NEW VERSION OF RT-11 IS USED, THIS MAY HAVE TO CHANGE!
;
.GLOBL	USRLD			;OFFSET INTO THE MONITOR FOR USR SWAP ADDR
;
.GLOBL	RMCNFG			;OFFSET INTO MONITOR FOR CONFIGURATION WORD
;
;---	USE RT-11 VERSION 2 MACRO CALLS
;
	..V2..			;USE V2-01
	.ENDC
	.SBTTL	FOCAL-11 FLOATING POINT DEFINITIONS


;
;---	ALL FOCAL FLOATING POINT OPERATIONS ARE PRECEDED BY A FPMP
;	TRAP CALL. THE FOCAL FLOATING POINT PACKAGE IS REENTRANT, AND
;	ACCEPTS WORDS AFTER THE CALL AS INSTRUCTIONS TO BE
;	INTERPRETED. RETURN IS TO THE FIRST WORD WHICH DOES NOT
;	HAVE A BASE OF "EMT". NOTE: OUR "EMT" IS NOT THE SAME AS
;	THE MACHINE'S, IT IS ACTUALLY AN ILLEGAL INSTRUCTION.
;



;FLOATING POINT HANDLER FOR FOCAL-11

;ARITHMETIC OPERATIONS ARE NUMBERED 0-7:
;THE ADDRESSING MODES ARE NUMBERED 0-7:

	EMT=007000

	FGET=EMT+00		;POSSIBLE ERRORS
	FADD=EMT+10		;OVERFLOW
	FSUB=EMT+20		;UNDERFLOW AND OVERFLOW
	FDIV=EMT+30		;DIVIDE BY ZERO ERROR
				;ALSO SIGNIFICANCE ERRORS
	FMUL=EMT+40		;AS FDIV ABOVE
	FPOW=EMT+50		;IF LOG AND EXP FUNCTIONS AVAILABLE,
				; NO ERROR IS GIVEN OTHER THAN OVERFLOW
				; AND UNDERFLOW. IF NOT AVAILABLE,
				; THEN ONLY INTEGER PORTION OF POWER WILL
				; BE USED.
	FPUT=EMT+60		;NO ERRORS (WORD TRANSFER)

	FINT=EMT+71		;OVERFLOW ERRORS
	FSGN=EMT+72		;NO ERRORS
	FABS=EMT+73		;NO ERRORS
	FNEG=EMT+74		;NO ERRORS
	FLOAT=EMT+75		;NO ERRORS
	FZER=EMT+77		;NO ERRORS
;
;---	100 TO 177 UNUSED
;

	FCODE=EMT+200		;COMPUTED OPERATION IN AC


;---	201 TO 377 UNUSED

;
;---	ADDRESSING MODES: CORRECT MODE IS TO BE ADDED TO THE CORRECT OPERATION
;	I.E.:	FPUT+INTO+STACK	;PLACE THE FLT. PT. ACCUM INTO THE STACK
;
;		FADD+REL,FONE-.	;ADD ONE (RELATIVE ADDRESSING MODE)
;
	DIRECT=0		;ABSOLUTE (FADD+DIRECT,ADDR) (NON-PIC)
	IPTR=1			;@PTR
	XPTR=2			;AUTO INDEX PTR BY APPROPRIATE VALUE.
				; FOR SINGLE PRECISION PACKAGE, THIS IS
				; TWO WORDS; IN DOUBLE PRECISION, FOUR.
				; INDEX IS PERFORMED AFTER USE!!!!!
	INTO=3			;STACK (USES FOUR WORDS ALREADY ALLOCATED)
	FROM=3			;STACK    "
	THROUGH=4		;STACK HOLDS THE ADDRESS OF THE AREA
	IMMED=5			;DATA FOLLOWS THE CALL (4 WORDS AT ALL TIMES)
	REL=6			;RELATIVE (ADDR-.) FOLLOWS CALL
;
	STACK=0			;PROVIDED FOR READABILITY
;"DIRECT" AND "INDEX" ARE FOLLOWED BY COMMA AND ADDRESS.


	.IFDF	$PAPER		;PAPER-TAPE VERSION ONLY...
	.SBTTL	ABSOLUTE VECTOR ADDRESS INITIALIZATION
;
	.ASECT			;ABSOLUTE SECTION

	.=0			;RESERVED FOR MANUAL RESTART VECTOR
	JMP	@#INIT2
	.=4			;ERROR TRAP VECTOR: STACK OVERFLOW TRAP
	STACKO
	340
	.=10			;RESERVED INST
	STACKO			;HANDLE THE SAME
	340
	.=14			;ODT
	STACKO
	340
	.=20			;IOT
	DELETE=IOT		;REMOVE A LINE OF TEXT
	XDELET
	340
	.=24			;PWR-FAIL/AUTO-RESTART
	PWRDWN
	340
	.=30			;EMT
	STACKO
	340
	.=34			;TRAP
	TRAPH
	340
	.=40			;SYSTEM VECTORS

	.=60
	KINT
	340
;HERE TO 'BEGIN' IS ZEROED BY 'INIT'.

				;OTHER VECTORS?

	.=100			;CLOCK OPTION
	CINT			;CLOCK INTERRUPT ROUTINE
	340			;HIGH PRIORITY

	.=200			;LINE PRINTER


				;PATCH AREA

	.=234			;UDC VECTOR

	.=300			;EXTRA TTY
	.ENDC			;PAPER-TAPE CONDITIONAL
	.SBTTL	TRAP MACRO DEFINITIONS

	.IFDF	$PAPER		;PAPER-TAPE VERION
	.CSECT
	.ENDC
	.GLOBL	BEGIN		;START OF CORE
;
;---	GLOBAL THE FUNCTION ROUTINES HERE
;
	.GLOBL	XFCLK,XITR,XEX,XRAN,XCHR,XFSBR,XSGN,XABS
	.GLOBL	FPRM
	.IF	NDF,$SMALL
	.GLOBL	XFQUE,XFERR
	.ENDC
;
;
	.BASE=.			;DEFINE THE BASE ADDRESS
;
;---	MACRO: DEFINE X,Y	;X=CALL NAME, Y=ADDRESS NAME
;
;				;DYNAMIC CALL VIA $TRAP DEFINITION.
;
;				;IF DEFINED, USE TRAP INSTRUCTION
;
;				;IF NOT, USE JSR R5,Y FOR DIRECT CALL
;
;				;BOTH TRAP VALUE AND ADDRESS FIELD
;
;				;ARE GLOBALIZED FOR LINKAGE PURPOSES
;
	.MACRO	DEFINE	.X,.Y
	'.X'=104600+.-.BASE
	.GLOBL	'.X','.Y'
	.MACRO	'.X',.A,.B
	GEN	'.X','.Y',<'.A'>,<'.B'>
	.ENDM	'.X'
	.WORD	.Y
	.ENDM	DEFINE
;
	.MACRO	GEN	.X,.Y,.A,.B
	.LIST	MEB
.IIF NDF	$TRAP,	JSR	R5,'.Y'
.IIF DF	$TRAP,	.WORD	'.X'
.IIF NB	<.A>,	.WORD	'.A'
.IIF NB	<.B>,	.WORD	'.B'
	.NLIST	MEB
	.ENDM	GEN
;
	.MACRO	ZERO	.NUMBR
	.REPT	<'.NUMBR'>
	.WORD	0
	.ENDR
	.ENDM	ZERO
;
;---	TO DEFINE A CALL TO A ROUTINE, SPECIFY:
;
;	DEFINE	(CALL NAME),(ROUTINE NAME)
;
	DEFINE	SORTJ,SORTB	;SORT AND BRANCH ON (CHAR) (TABLE VECTOR JUMP)
	DEFINE	SORTC,SORTD	;SORT CHARACTER (TRANSLATE)
	DEFINE	PRINTC,OUT	;PRINT CHAR-S
	DEFINE	READC,CHIN	;READ DATA INTO CHAR AND PRINT IT-S
	DEFINE	OUTCH,XOUT	;OUTPUT TO A DEVICE
	DEFINE	INCH,XI33	;INPUT FROM A DEVICE
	DEFINE	GETC,GETX	;UNPACK A CHAR-S
	DEFINE	PACKC,PACKX	;PACK A CHARACTER-S
	DEFINE	TESTC,TESTX	;RETURNS ON (CHAR)=
	DEFINE	GETLN,GETLNX	;UNPACK AND FORM A LINE NUMBER
	DEFINE	FINDLN,FINDX	;SEARCH FOR A GIVEN LINE
	DEFINE	PRNTLN,XPRNTL	;PRINT (LINENO)
	DEFINE	COPYLN,COPYLX	;READ NEXT LINE NUMBER
	DEFINE	START,STARTX	;RETURN TO COMMAND/INPUT MODE
	DEFINE	SPNOR,SPNORX	;IGNORE SPACE-S
	DEFINE	ERASEV,ERVX	;ERASE AND SET VARIABLES
	DEFINE	ERASET,ERTX	;ERASE TEXT
	DEFINE	PRINT2,PRIN2A	;PRINT 2 CHARACTERS
	DEFINE	DIGTST,DIGTSA	;TEST FOR DIGIT OF INDICATED PLACE VALUE
	DEFINE	PARTST,PARTSA	;CHECK FOR PARENTHESIS MATCH
	DEFINE	GROOVY,GROVX	;COMPARE GROUP NUMBERS
	DEFINE	SKPLPR,XTSTLP	;SKIP IF (CHAR) IS A LEFT PARNS.
	DEFINE	SKPNON,SKPNOX	;SKIP IF NOT A NUMBER
	DEFINE	TASK,TASKX	;DO FORMAT CONTROLS FOR *ASK*TYPE*
	DEFINE	EVAL.X,EVALUX	;"PUSHJ EVAL-2"
	DEFINE	FPMP,$FPMPX	;FPMP PRE-PROCESSOR
	DEFINE	FREAD,$READ	;FLOATING POINT READ ROUTINE
	DEFINE	FPRINT,$PRINT	;FLOATING POINT PRINT ROUTINE
	DEFINE	ITOA,ITOAX	;INTEGER TO ASCII CONVERSION
	DEFINE	OTOA,OTOAX	;OCTAL TO ASCII CONVERSION
	DEFINE	BTOA,BTOAX	;BINARY TO ASCII CONVERSION
	DEFINE	PATCH1,PATCH	;-- PATCH #1
	DEFINE	PATCH2,PATCHB	;-- PATCH #2
	.IFDF	$RT11		;IF RT-11 VERSION, HANDLE DELETE
	DEFINE	DELETE,DELIN	;DELETE ONE LINE ** PRI 4 CALL **
	DEFINE	GETHAN,$GETHN	;GET DEVICE HANDLER
	DEFINE	RELHAN,$RELHN	;RELEASE HANDLER FROM CORE
	DEFINE	DOEMT,$DOEMT	;EXECUTE A CONSTRUCTED EMT
	DEFINE	GCHAN,$GCHAN	;CONSTRUCT A CANNEL ENTRY POINTER
	DEFINE	DMPBLK,$DMPBL	;DUMP A BLOCK FROM A BUFFER
	DEFINE	NXTBLK,$NXTBL	;GET A NEXT BLOCK FOR A BUFFER
	DEFINE	CHKEOF,$CKEOF	;CHECK FOR EOF CONDITION
	DEFINE	CLRM,$CLRM	;CLEAR MEMORY ALLOCATION TABLES
	DEFINE	REQM,$REQM	;REQUEST MEMORY
	DEFINE	SCNM,$SCNM	;SCAN MEMORY TABLES AND ADJUST SYMBOL TABLE
	.ENDC








	ERROR=104400		;TRAP

;PUSHJ X=JSR PC,X





	.MACRO	OPEN		;OPEN THE STACK 4 WORDS
	.LIST	MEB
	SUB	#10,SP		;BACK OFF
	.NLIST	MEB
	.ENDM	OPEN
;
	.MACRO	CLOSE		;CLOSE THE HOLE
	.LIST	MEB
	ADD	#10,SP		;DO IT
	.NLIST	MEB
	.ENDM	CLOSE

;
;---	MACRO:	PRINT - USED TO OUTPUT ASCII CHARACTERS.
;
	.MACRO	PRINT	A
	.LIST	MEB
	.WORD	104400+'A'
	.NLIST	MEB
	.ENDM	PRINT
;
	POPJ=207		;RTS PC
	.SBTTL	FOCAL COMMAND LIST


	COMLST=.		;*FOCAL* COMMAND DECODING LIST

				;ENGLISH ;FRENCH    ;SPANISH	;GERMAN

	ASK			;ASK	 ;DEMANDE   ;INTERROGUE	;FRAGE
	ERRORC			;BEGIN	 ;LEVE	    ;XECUTE	;COMMENCE
	COMENT			;COMMENT ;COMMENTE  ;COMENTARIO	;KOMMENTAR
	DO			;DO	 ;FAIZ	    ;HAGA	;MACHE
	ERASE			;ERASE	 ;BIFFE	    ;BORRE	;LOSCHE
	FOR			;FOR	 ;QUAND	    ;PARA	;DAFOR
	GOTO			;GOTO	 ;VA	    ;ADELANTE	;GEHZU
	ERRORC			;H-	 ;K-	    ;G-		;U-
	IF			;IF	 ;SI	    ;SI		;WENN
	ERRORC			;J-	 ;J-	    ;J-		;I-
	STOP			;KILL	 ;HALTE	    ;HALTE	;HALT
	.IFDF	$PAPER
	ERRORC			;LIBRARY ;ENTERPOSE ;LAZO	;BILBLIOTHEK
	.IFF
	LIBR			;LIBRARY ;ENTERPOSE ;LAZO       ;BILBLIOTHEK
	.ENDC
	MODIFY			;MODIFY	 ;MODIFIE   ;MODIFIQUE	;ANDERE
	ERRORC			;N-	 ;G-	    ;V-		;J-
	PROGIO			;OPERATE ;PRATIQUE  ;OBRARE	;OBERATE
	ERRORC			;P-	 ;N-	    ;N-		;N-
	STARTX			;QUIT	 ;ARRETE    ;DETENGASE	;ENDE
	$RETUR			;RETURN	 ;RETOURNE  ;RETOURNE	;QUITTE
	SET			;SET	 ;ORGANIZE  ;UBIQUE	;SETZE
	TYPE			;TYPE	 ;TAPE	    ;TIPPEE	;RECHNE
	ERRORC			;U-	 ;U-	    ;W-		;P-
	ERRORC			;V-	 ;W-	    ;Q-		;V-
	WRITE			;WRITE	 ;INSCRIS   ;ESCRIBA	;TIPPE
	EVAL			;XECUTE	 ;XECUTE    ;FLUIR	;XECUTE
;OTHERS UNUSED:			;YZ	 ;YZ	    ;YZ		;YZ

;TO CHANGE LANGUAGE, ALPHABETIZE ON THE APPROPRIATE COLUMN.
	.SBTTL	LISTS TO BE TESTED BY SORTJ&SORTC




;LISTS TO BE TESTED BY
;"SORTJ" AND "SORTC"

FLIST2:	FLIMIT			;,=STANDARD  *FOR*
	FINFIN			;;=SHORT
	FINERR			;CR=DUMB

FLIST1:	FINCR			;,=STANDARD FORMAT  *FOR*
	TPR			;;=SET;PLUS...GO TO PROCESS
	TPR1			;C.R.=SET COMMAND---GO TO PC1
;
;---	ATLIST - *ASK*TYPE* CONTROL CHARACTER FUNCTION TABLE
;
ATLIST:	TINTR			;%-FORMAT DELIMITER
	TQUOT			;"-LITERAL DELIMITER
	TCRLF			;!-CARRIAGE RETURN AND LINE FEED
	TCRLF2			;#-CARRIAGE RETURN ONLY
	TDUMP			;$-DUMP THE SYMBOL TABLE CONTENTS
	TSPC			;^X-SPECIAL INTEGER OUTPUT
	TASK4			;SP-TERMINATOR FOR NAMES
	TASK4			;,-TERMINATOR FOR EXPRESSIONS
	TPR			;;-TERMINATOR FOR COMMANDS
	TPR1			;C.R.-TERMINATOR FOR STRINGS
;
;---	NOTE: $-FOR 'TDUMP' TERMINATES THE COMMAND!
;
;---	INLIST - INPUT DATA CONTROL CODES.
;
INLIST:	AGO			;ALTMODE=LEAVE RESULT
	AGO			;ESCAPE IS LIKE AN ALTMODE
	ASPACE			;SPACE=CHECK FOR TERMINATOR FUNCTION
	ATAKE			;IGNORE EQUALS SIGNS
	ARO			;RUB OUT
	AGO			;HANDLE LINE FEEDS AS ESC CHARS.
;
;---	SRNLST - *MODIFY* CONTROL CHARACTER TABLE
;
SRNLST:	SCHAR			;F.F.=CONTINUE(CNTRL L)
	SCONT			;BELL=CHANGE SEARCH CHARACTER (CNTRL G)
	SCONL			;L.F.=FINISH THE LINE AS BEFORE.
;
;---	LISTGO - SUBSET FOR *MODIFY* COMMAND
;
LISTGO:	SRETN			;C.R.=END THE LINE HERE AS IS.
	SFOUND			;CHAR=SEARCH CHARACTER
	.SBTTL	CHARACTER TRANSLATE TABLES

	.GLOBL	TERMS,TLIST	;EXTERNAL GLOBALS FOR USER ACCESS
;
;---	TERMS - TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR'
;
TERMS:	.BYTE	040		;SPACE  0 - (ASCII CODES) (INTERNAL CODES)
	.BYTE	053		;+	1
	.BYTE	055		;-	2
	.BYTE	057		;/	3
	.BYTE	052		;*	4
	.BYTE	136		;UP ARR 5
	.BYTE	050		;(	6 L-PARS
	.BYTE	133		;[	7
	.BYTE	074		;<	10
	.BYTE	051		;)	11 R-PARS
	.BYTE	135		;]	12
	.BYTE	076		;>	13
	.BYTE	054		;,	14
	.BYTE	073		;;	15
	.BYTE	015		;C.R.	16
	.BYTE	075		;=	17 TO END GETARG FROM 'SET'
	.BYTE	000
;
;---	ALIST - *ASK*TYPE* LIST OF CONTROLS (INTERNAL CODES)
;
ALIST:	.BYTE	045		;%
	.BYTE	042		;"
	.BYTE	041		;!
	.BYTE	043		;#
	.BYTE	044		;$
	.BYTE	205		;^
	.BYTE	200		;SPACE
;
;---	TLIST - TERMINATORS (INTERNAL CODES)
;
TLIST:	.BYTE	214		;,
	.BYTE	215		;;
	.BYTE	216		;CARRIAGE RETURN
	.BYTE	000		;END LIST
;
;---	SPECIAL - FOR INPUT DATA
;
SPECIAL:.BYTE	175		;ALTMODE
	.BYTE	33		;ESCAPE CHARACTER
	.BYTE	200		;SPACE
	.BYTE	217		;=
;
;---	ECHOLST - TERMINATORS (ASCII)
;
ECHOLST:.BYTE	177		;RUB-OUT (R.O.)
	.BYTE	012		;LINE FEED (L.F.)
	.BYTE	000		;END LIST
;
;---	LIST6 - *MODIFY*
;
LIST6:	.BYTE	014		;CONTROL-FORM
	.BYTE	007		;CONTROL-BELL
	.BYTE	012		;LINE FEED
;
;---	LIST3 - THIS IS WHERE THE SEARCH CHAR FROM THE *MODIFY* IS
;	 HELD. THE VARIOUS SORTS CAN THEN BE USED FOR STOPPING ON
;	 THE RIGHT PLACE!
;
LIST3:	.BYTE	216		;RETURN
;
;---	THIS IS THE VARIABLE STORAGE AREA:******
;
	.BYTE	-1		;SEARCH CHARACTER-** (MODIFIED BY COMMAND)
	.BYTE	000		;END OF LIST
	.EVEN			;*** END OF TRANSLATE AND SEARCH TABLES ***
	.SBTTL	FOCAL STORAGE AREA (IMPURE... ACTUALLY  DOWNRIGHT FILTHY!)

;
;---	GLOBALS FOR I/O DEVICES
;
	.GLOBL	IOLIST,IOGO,IPRS,ITKS,IPPS,ITPS,ILPS,IOPATC
	.IFDF	$RT11
	.GLOBL	IONAME,IOSW,L.CSIT
	.ENDC
	.GLOBL	TKS,TPS,PRS,PPS,LPS,INDEV,OUTDEV,LINENO,SWITCH,DO2
;
	.GLOBL	FLAC,FSW
;
;---	FOCAL STORAGE AREA
;
	.IFDF	$RT11
	.GLOBL	VIRTUL,VCNT,VCHAN,VINDEX,L.CHAN,$VGET,$VPUT
	.ENDC
;
;---	THESE VARIABLES DEFINE THE LIMITS OF VOLITILE STORAGE
;
	.GLOBL	PCF,FISW	;THESE VARIABLES DEFINE THE LIMITS
				; OF THE WORK AREA WHICH MUST BE
				; SAVED WHEN USING NON-SCHEDULED
				; FOCAL INTERRUPT ROUTINES.
;
	INLEN=1			;NUMBER OF WORDS FOR INPUT BUFFER
	OUTLEN=128.		;NUMBER OF WORDS FOR OUTPUT BUFFER
;
	.IFDF	$PAPER
COMBUF	=	INIT		;OVERLAY INITIALIZATION CODE
	.IFF
SWAPLC:	.WORD	0		;SWAP LOCATION FOR THE USR
	.ENDC
CCFLG:	.BYTE	0		;CONTROL-C SEEN!
RUBSW:	.BYTE	0		;RUBOUT SWITCH
NVSW:	.BYTE	0		;NEW VARIABLE SWITCH
LINMOD:	.BYTE	0		;USED FOR THROWING AWAY LINE-FEEDS
	.EVEN
LSPR:	107654			;RANDOM NUMBER.
PCF:	FLTZER-2		;PROGRAM COUNTER FOR FOCAL = (START SAVE AREA)
PCFN:	.WORD	0		;LINE NUMBER FOR CURRENT PC
THISLN:	0			;LINE POINTER FROM 'FINDLN'
DEBG:	1			;(ON-OFF, ENABLE) 0,0 = TRACE.
VIRTUL:				;VIRTUAL ELEMENT
FLARG:	0,0,0,0			;RESULT STORAGE
FLAC:	0,0,0,0			;FLOATING POINT ACCUMULATOR!!!!
FSW:	.BYTE	0		;FLOATING POINT ERROR SWITCH
SWITCH:	.BYTE	0		;GROUP/LINE SWITCH
				;
LINENO:	0			;LINE NUMBER READ BY GETLN
FISW:	04012			;OUTPUT FORMAT %8.04.
;
	.IFDF	$RT11
VCHAN:	.WORD	0		;CHANNEL NUMBER OF VIRTUAL FILE VARIABLE
VINDEX:	.WORD	0		;SUBSCRIPT FOR VIRTUAL FILE VARIABLE
	.ENDC
;
;	CONTINUE WITH OUR DIRTY LAUNDRY......
;
	.IF	NDF,$SMALL
	.GLOBL	PTR0,INTSW,INTCHN,INTPRI
;
PTR0:	.WORD	0		;TEMP SAVE AREA FOR INTERRUPTS
;
INTSW:	.WORD	0		;SWITCH FOR INTERRUPT SERVICE.
				; -1 - INTERRUPT UNDERWAY
				;  0 - NO INTERRUPT PENDING (NORMAL)
				;  1 - INTERRUPT PENDING SERVICE
;
INTCHN:	ZERO	8.		;CHAIN START FOR INTERRUPT QUEUES
;
INTPRI:	.WORD	-1		;SOFT PRIORITY OF SCHEDULED ROUTINES.
;
	.ENDC
W:	.WORD	8.		;FORMAT FIELD LENGTH
D:	.WORD	4.		;FOR PRINT PACKAGE (%W.D)
;
INDEV:	TKS			;POINTER TO INPUT DEV STATUS(DEFAULT)
	.IFDF	$RT11
;
	.WORD	0		;HOUSES RAD50 EXPANSION OF NAME FOR DEVICE
				; USED BY OPERATE COMMAND SO AS TO BE ABLE
				; TO RELEASE THE CURRENT DEVICE. THE TERMINAL
				; IS PROCESSED BY ".TTYIN" AND ".TTYOUT"
;
	.WORD	0		;BYTE OFFSET FROM CONTENTS OF NEXT
				; WORD TO NEXT CHARACTER TO BE USED.
;
	ZERO	INLEN		;INPUT BUFFER: *NOTE* UNUSED PORTION
				; OF DATA STORED IN INPUT BUFFER IS
				; LOST IF *OPERATE* IS GIVEN TO A
				; DIFFERENT DEVICE!
	.ENDC
;
OUTDEV:	TPS			;POINTER TO OUTPUT DEFAULT DEVICE
	.IFDF	$RT11
;
	.WORD	0		;HOLDS RAD50 NAME FOR DEVICE(SEE ABOVE)
;
	.WORD	0		;BYTE OFFSET INTO OUTPUT BUFFER
;
	ZERO	OUTLEN		;OUTPUT BUFFER FOR OPERATE INSTRUCTION
	.ENDC
;
KIN:	0			;(INTR DONE,TTY CHARACTER) [ONE CHAR
				; BUFFER FOR CONSOLE] ALSO USED TO HOLD
				; OLD PSW WHEN ENTERING HIGH PRIORITY
				; CODE (SUCH AS "DELETE").
;
	.IFDF	$PAPER
WHOOPS:	000			;POWER FAIL/AUTO-RESTART SWITCH
;
	.ENDC
STACKA:	.LIMIT			;THIS IS THE STACK BASE ADDRESS
;
TOP	=	STACKA+2	;END OF * F O C A L *
;
;---	NEXT TWO WORDS DEFINE THE TEXT BUFFER FOR THE USER'S PROGRAM
;
AXIN:	BUFBEG+80.		;STORAGE INDEX POINTER (STOPS 1ST "ERASEV"!)
BUFR:	BUFBEG			;NEXT LOCATION IN BUFFER = LAST LOCATION USED.
;
;---	BOTTOM - USED TO MAINTAIN THE END OF WORKING STORAGE
;
	.GLOBL	BOTTOM
;
BOTTOM:	.WORD	0		;END OF THE SYMBOL TABLE
				; THIS IS INITIALIZED AT LOAD TIME BY
				; THE ROUTINE "INIT" (AT END OF LISTING)
;
;---	THE NEXT WORDS DEFINE THE SYMBOL AREA LOCATIONS
;
STARTV:	.WORD	BUFBEG+80.	;POINTER TO THE START OF THE SYMBOL AREA
	.IFDF	$RT11
;
;---	DMA FEATURES REQUIRE SPECIAL SYMBOL TABLE
;
TRUEND:	.WORD	0		;THIS IS A POINTER TO THE TRUE END OF
				; PHYSICAL MEMORY
	.ENDC
	.IF	NDF,$SMALL
	.SBTTL	ERROR CONTINGENCY ROUTINE STORAGE AREA

;
;---	ERROR CONTINGENCY ROUTINE STORAGE AREA
;
ERRLIN:	.WORD	0		;THIS WORD HOLDS THE LINE OR GROUP NUMBER FOR 
				;ERROR CONDITIONS. A [0] WILL FORCE NORMAL
				;FOCAL ERROR HANDLING.
				;
ERRSW:	.WORD	0		;THIS WORD HOLDS THE LINE/GROUP SWITCH
				;FOR THE ERROR ROUTINE
				;
ERRCOD:	.WORD	0		;THIS WORD HOLDS THE ERROR CODE FOR THE
				;CURRENT ERROR
				;
ERRPOS:	.WORD	0		;THIS WORD HOLDS THE LOCATION OF THE
				;LINE IN ERROR. USED FOR RECONSTRUCTION OF
				;ERROR CONDITIONS IF WE ARE ASKED TO HANDLE
				;THE ERROR CONDITIONS.
				;
LINESP:	.WORD	0		;THIS WORD HAS THE CONTENTS OF THE SP
				;AT THE LAST ENTRANCE TO "PROC".
				;THIS ENABLES A FORM OF STACK CORRECTION
				;IF IT IS DESIRED TO RETURN TO THE
				;PROGRAM.
	.ENDC
	.IFDF	$RT11		;LIBRARY FUNCTION
	.SBTTL	LIBRARY FUNCTION DATA TABLES
;
;
;---	*LIBRARY* COMMAND DATA AREA - TABLES AND SWITCHES USED BY "LIBR"
;
	.GLOBL	LIBSW,GETSW
;
LIBSW:	.WORD	0		;THIS WORD IS SET TO NON-ZERO WHEN
				; IN A LIBRARY COMMAND. IT IS CAUGHT
				; BY VARIOUS ROUTINE FOR I/O DECISIONS
				; FOR LIBRARY FUNCTIONS. IT IS RESET
				; WHEN THE EXECUTING COMMAND RETURNS
				; BACK TO LIBRARY COMMAND FOR CLEANUP.
;
GETSW:	.WORD	0		;SWITCH FOR LIBRARY GET COMMAND

				; SEE STARTX AND PROC1 FOR LOGIC.
;

;---	LIBRARY FORMAT CODES (USED FOR VIRTUAL FILE CAPABILITY)
;
L.FORM:	.BYTE	' 		;DEFAULT
	.BYTE	'D		;DOUBLE PRECISION FORMAT
	.BYTE	'F		;SINGLE PRECISION
	.BYTE	'X		;16 BIT INTEGER (POSITIVE MAGNITUDE)
	.BYTE	'I		;SIGNED INTEGER (15 BITS+SIGN)
	.BYTE	'B		;BYTE (8 BITS UNSIGNED)
	.BYTE	'T		;TEXT (7 BITS UNSIGNED)
	.BYTE	'Z		;ZERO OUT FILE IF CREATING IT
	.BYTE	'V		;VIRTUAL FILE SPEC
	.BYTE	0		;SCAN DELIMITER
	.EVEN			;IN CASE AN ODD # BYTES
;
L.CHAN:	.WORD	0		;TEMP HOLD AREA FOR CHANNEL OF LIB CMD
				; "DOEMT" CALL USES THIS FOR MODIFICATION OF
				; EMT CALL FOLLOWING IT.
;
L.SIZE:	.WORD	0		;TEMP HOLD AREA FOR FILE SIZE BY LIB CMD
;
L.LINE:	.WORD	0		;SAVE AREA FOR LINE NUMBER ON LIB XFERS
;
;---	LIBRARY COMMAND TABLES:
;
;	THE LIBRARY COMMAND PROCESSOR IS A TABLE DRIVEN DECODER.
;
;	ALL LIBRARY COMMANDS MUST BE FOLLOWED BY THE COMMAND
;	CHARACTER (*L IS ILLEGAL). THE TABLE: LIBCMD IS SCANNED
;	FOR THE ASSOCIATED ENTRY. THE FORMAT OF THE TABLE IS:
;
;	15                      7 6                 0
;	+-------------------------------------------+
;	: SWITCHES               :  CHARACTER       :
;	+-------------------------------------------+
;	:      ROUTINE ADDRESS                      :
;	+-------------------------------------------+
;
;	THE ROUTINE IS INVOKED AFTER THE COMMON PROCESSOR HAS 
;	PROCESSED THE COMMAND LINE VIA A JSR PC,.
;
;	A ZERO COMMAND CHARACTER TERMINATES THE SEARCH
;
	.MACRO	L	.CH,.SW,.AD	;LIBRARY COMMAND MACRO
	.WORD	'.SW'+<''.CH'&177>
	.WORD	'.AD'
	.ENDM	L
;
;---	SWITCHES
;
	L.F=100000		;FILE# IS IN PARAMETER
	L.D=040000		;DATASET SPECIFICATION IS REQUIRED
	L.I=020000		;OPEN FILE FOR INPUT IF POSSIBLE, ELSE
	L.O=010000		; USE THIS FOR OUTPUT
	L.W=004000		;FILE MAY BE WRITTEN TO
	L.R=002000		;FILE MAY BE READ FROM
	L.T=001000		;FORMAT TYPE CODE IS IN LIST
	L.L=000400		;LINE NUMBER MAY BE SPECIFIED
;
;
;---	FOCAL LIBRARY COMMAND TABLE
;
LIBCMD:
;
;CMD	ARGUMENTS		ROUTINE		FUNCTION
;---	---------		-------		--------
;
 L O	L.F!L.T!L.D!L.I!L.O	L.OPN	;LIBRARY OPEN COMMAND (GEN I/O)
 L C	L.L			L.CLS2	;LIBRARY CLOSE COMMAND
 L M	L.F!L.T!L.D!L.O		L.OPN	;LIBRARY MAKE COMMAND
 L I	L.F!L.T!L.D!L.I		L.OPN	;LIBRARY INPUT COMMAND
 L S	L.D!L.O!L.W		L.SAV	;LIBRARY SAVE COMMAND
 L G	L.D!L.I!L.R		L.GET	;LIBRARY GET COMMAND
 L R	L.D!L.I!L.R!L.L		L.RUN	;LIBRARY RUN COMMAND
 L N	L.D!L.I!L.R!L.L		L.NXT	;LIBRARY NEXT COMMAND
 L T	L.F!L.W			TYPE	;LIBRARY TYPE COMMAND
 L A	L.F!L.R			ASK	;LIBRARY ASK COMMAND
 L W	L.F!L.W			WRITE	;LIBRARY WRITE COMMAND
 L D	L.D			L.DEL	;LIBRARY DELETE COMMAND
;
;---	END OF THE TABLE
;
	.WORD	0			;END OF THE COMMAND TABLE
;
;---	FOCAL DEFAULT EXTENSIONS
;
L.DFLT:	.RAD50	/FCL/		;FOCAL LIBRARY FILE DEFAULT EXTENSION
	.RAD50	/FCL/		;DITTO
	.RAD50	/FCL/		;  "
	.RAD50	/FCL/		;  "
;
;
	.ENDC			;END OF $LIB CONDITIONAL
	.SBTTL	FOCAL PARAMETER TABLES

	.GLOBL	PARAM
;
;---	FOLLOWING ARE THE PARAMETER TABLES FOR FOCAL "FPRM" FUNCTION
;
;	SEE THE CODING FOR "FPRM" FOR COMPLETE EXPLANATION OF THE
;	POSSIBLE FUNCTIONS
;
PARAM:				;PARAMETER TABLE
PRM0:	.BYTE	0		;SETTOP FUNCTION
PRM1:	.BYTE	0		;EXTENDED SYMBOL TABLE FUNCTION
PRM2:	.BYTE	255.		;TTY LINE WIDTH VALUE
PRM3:	.BYTE	3		;SWITCH FOR ":" AND "=" IN TYPE/ASK

PRM4:	.BYTE	60		;SWITCH FOR EXPRESSIONS IN INPUT.
PRM5:	.BYTE	0		;EXTENDED DEBUG (LINE NOS. & SET VALUES)
PRM6:	.BYTE	0		;FLOATING POINT OUTPUT ROUNDING SWITCH
PRM7:	.BYTE	0		;CURRENT LINE POSITION.
PRM8:	.BYTE	1		;LEADING 0 OUTPUT FOR ITOA AND OTOA
PRM9:	.BYTE	1		;FLT PT UNDERFLOW SWITCH
PRM10:	.BYTE	0		;SCIENTIFIC NOTATION SWITCH
PRM11:	.BYTE	0		;TIME SWITCH (TICKS/SECONDS)
PRM12:	.BYTE	0		;SPARE
PRM13:	.BYTE	0		;  "
PRM14:	.BYTE	0		;  "
PRM15:	.BYTE	0		;  "
;
	MAXPRM=.-PARAM-1
;
	.EVEN			;IN CASE AN ODD NUMBER PRESENT
;
LINCNT	=	PRM7		;PARAM 7 IS USED A LINE POSITION COUNTER
	.IFDF	$RT11		;RT-11 ONLY
	.SBTTL	DYNAMIC MEMORY ALLOCATION TABLES

;
;---	HIGH ADDRESS CORE IS MAPPED TO ALLOW FOR I/O HANDLERS AND
;	BUFFERS. THIS CAN ALSO DOUBLE AS A MEMORY MANAGEMENT FEATURE
;	FOR THE FOCAL USERS. 
;
;	HIGH MEMORY IS MAPPED IN 256. WORD BLOCKS. THIS NUMBER IS NEAT DUE
;	TO THE HARDWARE OF THE 11, AS WELL AS THE DEVICE SIZE MAKES
;	THIS FEASABLE. THE CONVENTION FOR ALLOCATION AREA
;	IS AS FOLLOWS:
;
;	CODE		OWNER
;	----		-----
;
;	 0		FREE SPACE (ABLE TO BE ALLOCATED)
;	-1...-128	SYSTEM CODES
;
;	1...127		USER AREA (USER ASSIGNED NUMBER)
;
;	THESE OWNER CODES PROVIDE FOR SELECTIVE RELEASE OF MEMORY WITHOUT
;	PRECISE INFORMATION ON THEIR LOCATION.
;
;	THE MANAGEMENT SYSTEM PROVIDES FOR ALLOCATION, STATUS,
;	AND DELETION OF MEMORY OWNERSHIP.
;
	.GLOBL	IDENT		;HOLDS ID CODE
;
	.GLOBL	MEMTAB,MEMSIZ,HICORE,SWAPLC,STARTX
	.GLOBL	TRUEND,BOTTOM,AXIN,STARTV,BUFR
;
;---	** INTERNALLY, THESE FUNCTIONS ARE AVAILABLE AS FOLLOWS: **
;
;	ROUTINE		DESCRIPTION
;	-------		-----------
;
;	$REQM		REQUEST MEMORY. THE NUMBER OF BLOCKS SHOULD BE
;			PUSHED ONTO THE STACK. ON RETURN, THE STACK HOLDS
;			THE ADDRESS IF SUCCESSFUL.
;
;	$RELM		RELEASE MEMORY. THE NUMBER OF BLOCKS SHOULD BE
;			PUSHED ONTO THE STACK.
;			THE START ADDRESS SHOULD THEN BE PUSHED ONTO THE STACK.
;
;	$SCNM		THIS ROUTINE SCANS THE MEMORY TABLES AND INSURES
;			THAT THE SYMBOL TABLE IS AGAINST THE HIGHEST
;			ADDRESS AVAILABLE.
;			(AUTOMATICALLY CALLED BY RELM AND CLRM)
;
;	$CLRM		CLEAR THE MEMORY TABLES OF ALL REFERENCE TO A
;			SPECIFIC IDENT. IF IDENT=0, THEN RESET THE TABLES.
;
;	** NOTE: THE MEMORY ALLOCATOR CAUSES THE SYMBOL TABLE TO BE SHUFFLED
;		WHENEVER NEEDED TO KEEP THE SYMBOL TABLE AS CLOSE TO THE
;		HIGH ADDRESS SIDE OF CORE AS POSSIBLE.
;
;
;---	HICORE HAS THE FINAL WORD ON TOP OF CORE (MONITOR LIMITS).
;	TOPCOR HAS THE TOP ADDRESS USED BY THE SYMBOL TABLES. THIS
;	DEFINES THE AREA ALLOCATED TO THE SYSTEM. ONCE MEMORY IS ALLOCATED,
;	IT CAN NOT BE MOVED, HENCE ALLOWING HOLES TO BE IN THE ALLOCATED AREA.
;	THESE ARE ATTEMPTED TO BE FILLED PRIOR TO RELOCATING THE SYMBOL
;	TABLE.
;
HICORE:	.WORD	0		;FINAL WORD IN HIGH CORE LIMITS....
;
;	IDENT HOLDS THE IDENTITY OF THE USER PERFORMING THE REQUEST.
;	THE HIGH BYTE IS FLAGGED (-1) IF OPERATION IS FOR A GROUP OF USERS.
;
IDENT:	.WORD	0		;MEMORY GROUP IDENTIFIER
;
	.ENDC
	.SBTTL	*KILL* - STOP ALL I/O (HARD RESET)

	.IFDF	$RT11
	.GLOBL	MAXCHN,GSCHAN,ICHAN,OCHAN,CHANTB,MAXHAN,HANDTB,V.NAME
	.GLOBL	SDSW,TODAY
	.ENDC
	.GLOBL	CFRS		;FOCAL COMMENT HEADER
;
;
;*KILL*
;

;STOP ALL I/O

	.IFDF	$PAPER		;PAPER TAPE MODE
STOP:	RESET			;HARD RESET FOR PAPER-TAPE
	.IFF			;RT-11 VERSION
STOP:	.HRESET			;PERFORM A HARD RESET (RT-11**)
;
;
	.ENDC
	.SBTTL	TRAP HANDLER ROUTINE


;STACK OVERFLOW HANDLER

STACKO:	MOV	STACKA,SP	;RESET STACK IMMEDIATELY!
	CLRB	FSW		;RESET SWITCH
	.IFDF	$RT11
	MOV	#STACKO,-(SP)	;SET ADDRESS
	CLR	-(SP)
	MOV	SP,R1
	.TRPSET	R1		;SET TRAP VECTOR
	.ENDC
	ERROR+201+9.+9.		;THEN PRODUCE DIAGNOSTIC
;
;STACKA IS PATCHED IF FUNCTION LIST IS CHANGED.
;


;TRAP HANDLER

;"PRINT"	0,1,177
;TRAP		200,2,376
;"ERROR"	201,2,377

TRAPH:	MOV	2(SP),-(SP)
	MOV	#1$,-(SP)
	RTI
1$:	MOV	R5,2(SP)	;SAVE R5
	MOV	@SP,R5		;GET PC
	MOV	-2(R5),@SP	;COPY CALL
;SP=	-CALL-
;	-OLD R5-
;	R5=OLD PC
;
	TSTB	FSW		;TRAP FROM FLOATING POINT ROUTINES?
	BNE	FLTER		;YES - HANDLE AS AN ERROR
	ASRB	@SP		;EXAMINE LOW ORDER BIT OF CALL
	BPL	PRX		;GO PRINT ASCII CODES.
	BCS	ERR2		;USE ODDS AS ERRORS
	ROLB	@SP		;RESTORE WORD ADDRESS
	ADD	#.BASE+073200,@SP ;OFFSET BY BASE ADDRESS-EMT CODE
	MOV	@(SP)+,PC	;GOTO THE PROCESS.

PRX:	JMP	PRINTA		;GO TO PRINT ASCII CODES
;
	.SBTTL	FLTER - CONVERT FORTRAN TO FOCAL ERRORS
;
;
FLTER:	BIC	#-100,@SP	;SET ERROR IN CORRECT PERSPECTIVE
	TSTB	PRM9		;IGNORE ERRORS?
	BNE	4$		;CHECK FOR FLOATING POINT UNDERFLOW.
;
;---	FLOATING POINT ERROR CONVERTER
;
1$:	CLRB	FSW		;RESET ERROR SWITCH
	MOV	R0,-(SP)	;SAVE R0
	MOV	#FCNVTB,R0	;POINT TO THE TABLE
2$:	CMPB	2(SP),(R0)+	;IS THIS IT?
	BEQ	3$		;YES - CONVERT THE ERROR CODE
	INC	R0		;POINT PAST IT
	TSTB	@R0		;IS THIS THE END?
	BNE	2$		;LOOP BACK
	ERROR+201+0+0		;RESTART ON A UNKNOWN ERROR
;
;---	HERE CHECK FOR FLOATING UNDERFLOW ERROR
;
4$:	CMPB	@SP,#11.	;WAS IT A FLOATING POINT UNDERFLOW?
	BNE	1$		;NO - CONVERT IT AND PROCESS IT
	TST	(SP)+		;POP THE STACK
	RTS	R5		;RETURN
;
;	RECOGNIZED ERROR - SWAP ERROR CODE AND PROCESS
;
3$:	MOVB	(R0),2(SP)	;SET NEW ERROR CODE
	MOV	(SP)+,R0	;RELOAD R0
	BR	ERR2		;GO TO ERR2
;
;
FCNVTB:	.BYTE	1,38.		;INTEGER OVERFLOW
	.BYTE	10.,12.		;FLOATING OVERFLOW
	.BYTE	11.,12.		;FLOATING UNDERFLOW
	.BYTE	12.,14.		;DIVIDE BY ZERO
	.BYTE	13.,17.		;SQRT OF A NEGATIVE NUMBER
	.BYTE	15.,17.		;LOG OF A NEGATIVE OR ZERO ARGUEMENT
	.BYTE	0,0		;END OF THE TABLE
	.IF	NDF,$SMALL
	.SBTTL	ERROR DIAGNOSTIC INTERCEPTOR


;
;---	THIS ROUTINE SENDS AN ERROR MESSAGE TO THE CONSOLE, AND
;	 RESETS ALL I/O IN PROGRESS. THIS INCLUDES CLEARING OUT
;	 ANY TABLES. IN ADDITION, IN RT-11 ALL MEMORY ALLOCATOR
;	 TABLES ARE ZEROED.
;
;ERROR DIAGNOSTIC GENERATOR:

ERR2:	BIC	#-100,@SP	;GET CORRECT ERROR CODE
	TST	ERRLIN		;ANY SPECIAL ROUTINE TO BE PERFORMED?
	BEQ	ERR3		;NO - CONTINUE AS NORMAL
	MOV	@SP,ERRCOD	;AND SAVE IT FOR POSSIBLE USE LATER
	MOV	(SP)+,AC	;SET HIGH ORDER INFO
2$:	MOV	LINESP,SP	;RESET THE STACK POSITION FOR THE LATEST LINE
	MOV	PCF,ERRPOS	;SET ERROR LINE POSITION FOR LATER
	.IFDF	$RT11
	CLR	GETSW		;ERRORS IMMEDIATELY CLEAR LIBRARY COMMANDS
	CLR	LIBSW		;ALL SWITCHES ARE RESET.....GOOD, NOW GO!
	.ENDC
	JSR	PC,WHIPV	;POINT AT THE "&" VARIABLE
	OPEN			;GET SPACE ON THE STACK
	FPMP	FGET+IPTR	;GET THE ANPERSAN
	.WORD	FPUT+INTO+STACK	;PLACE ON THE STACK
	.WORD	FLOAT		;FLOAT THE AC
	.WORD	FPUT+IPTR	;PLACE IN THE "&" VARIABLE
	MOV	ERRLIN,LINENO	;SET UP LINE NUMBER OF ERROR ROUTINE
	MOVB	ERRSW,SWITCH	;SET SWITCH FOR "DO" GROUP
	CLR	ERRLIN		;ROUTINE MAY NOT BE RE-ENTRANT!
	JSR	PC,DO2		;PERFORM THE CORRECT THINGIE
	JSR	PC,WHIPV	;GET POINTER TO "&" VARIABLE
	MOV	(SP)+,(PTR)+	;RESTORE IT
	MOV	(SP)+,(PTR)+	;AND AGAIN
	MOV	(SP)+,(PTR)+	;AND AGAIN....
	MOV	(SP)+,(PTR)+	;...AND AGAIN....
3$:	MOV	ERRPOS,PCF	;RESET PC FOR FOCAL
	TST	ERRLIN		;DOES HE WANT US TO CLEAN UP?
	BEQ	1$		;YES - FORCE THE CORRECT ERROR TO APPEAR
	POPJ			;PLOD ALONG IN OUR OWN SPECIAL WAY...
;
;---	RECONSTRUCT THE ERROR
;
1$:	MOV	ERRCOD,-(SP)	;STACK THE ERROR CODE
;
;---	DROP INTO ERR3....
;
	.ENDC
	.SBTTL	ERROR DIAGNOSTIC GENERATOR
;
;
	.IF	DF,$SMALL
;
ERR2:	BIC	#-100,@SP	;SET ERROR CORRECTLY
	.ENDC
	.IFDF	$PAPER
;
	.GLOBL	CONFIG		;CONFIGURATION WORD
;
	.MACRO	.RCTRLO
	.LIST	MEB
	CLRB	CONFIG+1
	.NLIST	MEB
	.ENDM	.RCTRLO
;
	.ENDC
;
ERR3:	MOV	ITKS,INDEV	;RESET DEVICE POINTERS
	MOV	ITPS,OUTDEV	;...
	.IFDF	$PAPER
	MOV	#-1,KIN		;RESET KBD DATA/FLAG
	.ENDC
	.IFDF	$RT11		;RT-11 ONLY
	.SRESET			;KILL ALL OPEN CHANNELS AND RELEASE
				;ALL "FETCH"ED DRIVERS.
	.TRPSET	#L.CSIT,#STACKO	;RESET TRAPS THROUGH 4
	MOV	#-1,IDENT	;SET FOR KILL ALL MEMORY
	CLRM			;CLEAR OUT ALL MEMORY
	BIS	#TTYSPC,@#JSW	;AND SET SPECIAL TTY MODE
	.IFTF
	.RCTRLO			;RESET ANY POSSIBLE ^O
	.IFT
	CLR	LIBSW		;RESET LIBRARY SWITCH
	CLR	GETSW		;AND GET SWITCH
	MOV	#CHANTB,TEMP	;POINT TO THE START OF THE TABLES
	MOV	#MAXCHN,-(SP)	;FIX POINTER FOR END OF THE TABLES
	ASL	@SP		;*2
	ASL	@SP		;*4
	ADD	#V.NAME,@SP	;TRUE POINTER
	SUB	TEMP,@SP	;GET LENGTH
	ASR	@SP		;DIVIDE BY 2 FOR WORD COUNT
1$:	CLR	(TEMP)+		;CLEAR OUT THE TABLES
	DEC	@SP		;COUNT OUT THE LENGTH
	BGT	1$		;CONTINUE UNTIL THROUGH
	TST	(SP)+		;POP THE STACK
	.IFF			;PAPER TAPE MODE
	BIS	#101,@ITKS	;START UP READER AGAIN
	.ENDC
	.IFNDF	$SMALL
	.GLOBL	QUESET		;ENTRY FOR SETUP OF QUEUES
	JSR	PC,QUESET	;SET UP FOR QUEUE ELEMENTS
	JSR	PC,ZAPINT	;CLEAR INTERRUPT LEVELS
	.ENDC
	CLR	-(SP)
	MOV		#2$,-(SP)
	RTI
;
;---	NOTE: SYMBOL TABLE IS STILL INTACT.. TTY IN I/O MODE
;
2$:	PRINT2	<37616>		;PRINTS AS "CR-LF"+"?"
	MOVB	(SP)+,PTR	;SAVE CODE NUMBER
	JSR	PC,ERRDMP	;OUTPUT ERROR CODE (2 DIGITS)
	PRINT2	<" A>		; "AT "
	PRINT	<'T>		;...
	MOV	PCF,AC		;WHAT TYPE LINE ARE WE POINTING TO?
	MOV	2(AC),AC	;RETRIEVE THAT LINE NUMBER.
	PRNTLN			;PRINT IT OUT.
	PRINT2	<CRLF>		;GO BACK TO COMMAND/INPUT MODE.
	.SBTTL	"START" - RESTART ROUTINE
;
;---	THIS SECTION OF CODE IS RESPONSIBLE FOR ACCEPTING
;	USER DIRECTIVES. TWO METHODS OF ENTRY ARE POSSIBLE:
;
;	1. - FOCAL IS READY TO ACCEPT USER DIRECTIVES WHENEVER THE
;	     PROGRAM IS NOT RUNNING.
;
;	2. - A LIBRARY GET OR RUN OR NEXT HAS BEEN EXECUTED. IN THIS
;	     CASE, "GETSW" IS SET TO A NON-ZERO VALUE. RETURN WILL BE
;	     VIA A "POPJ" INSTRUCTION.
;
;"START"


STARTX:	MOV	#PC1+2,PCF	;INITIALIZE PC FOR FOCAL
	CLR	PCFN		;INITIALLY SET LINE NUMBER TO 0.0
	CLR	NVSW		;CLEAR BOTH NVSW AND LINMOD
	CLRB	DEBG		;ENABLE TRACE
	.IFDF	$RT11
	TST	GETSW		;SEE IF IN A LIBRARY GET SWITCH
	BNE	1$		;YES - SKIP INITIALIZATION INFO

	.ENDC
	MOVB	#-1,DEBG+1	;SHUT OFF TRACE
	MOV	STACKA,SP	;INITIALIZE THE STACK POINTER
	.IF	DF,$PAPER
	CLR	WHOOPS		;UPDATE POWER FAIL SWITCH
	.ENDC
	.IF	NDF,$SMALL
	CLR	ERRLIN		;SHUT OFF ERROR TRAPPING
	.ENDC
	CLR	-(SP)
	MOV	#2$,-(SP)
	RTI
2$:
	.IFDF	$RT11
	BIS	#TTYSPC,@#JSW	;SET TTY TO SPECIAL MODE (RT-11**)
	.IFTF
	.RCTRLO			;RESET THE ^O MODE
	.IFT
	JSR	PC,FLUSH	;FORCE OUT PENDING OUTPUT FROM *OPERATE*
	.ENDC
	CLRB	LINCNT		;RESET LINE POSITION
	.IF	NDF,$SMALL
	.GLOBL	ZAPINT
	JSR	PC,ZAPINT	;SHUT DOWN ALL SCHEDULES AND INTERRUPTS
	.ENDC
	CMP	INDEV,IPRS	;DON'T ACKNOWLEDGE FOR H.S.R.
	BEQ	1$		;...
	CMP	OUTDEV,IPPS	;OR IF OUTPUT IS PAPER TAPE
	BEQ	1$		;ALSO SKIP THE LEADING *
	PRINT	<'*>		;PRINT THE "READY" CODE.
1$:	MOV	#COMBUF,R5	;INIT THE COMMAND BUFFER PROTECTION
	MOV	R5,AXIN		;FOR PACKING AND RUBOUT LIMIT.
IGNOR:	READC			;WAIT FOR KEYBOARD INPUT.
	.IFDF	$RT11		;RT-11 VERSION ONLY
	CHKEOF			;SEE IF EOF ENCOUNTERED
	BCC	1$		;IF OK, CONTINUE
	POPJ			;RETURN TO LIBRARY COMMAND
	.ENDC
1$:	CMPB	CHAR,#12	;CHECK FOR TERMINATORS

	BEQ	IGNOR		;IGNORE LINEFEED
	PACKC			;PACK THE COMMAND STRING
	CMP	AXIN,#COMBUF+80.-1 ;AT END?
	BHIS	BUFFUL		;YES!
	CMPB	CHAR,#CR	;TEST FOR C.R.
	BNE	IGNOR		;NO, REPEAT.
	MOV	R5,AXOUT	;SETUP FOR READING THE COMMAND/INPUT STRING
GONE:	GETC			;GET A CHARACTER
	SPNOR			;IGNORE SPACES BEFORE LINE NUMBERS.
	SKPNON			;BE SURE THAT IT IS A NUMBER
	INPUTN			;NOT A TERMINATOR, BEFORE STORING.
	JSR	PC,PROC1	;PROCESS IMMEDIATE COMMAND
	MOV	PCF,AXOUT	;COMPUTE ADDRESS OF NEXT
	ADD	(AXOUT)+,AXOUT	;LINE IN SEQUENCE.
	BEQ	STARTX		;END FORMAT=RETURN TO C/I MODE.
	MOV	AXOUT,PCF	;SAVE NEXT LINE ADDR.
	TST	(AXOUT)+	;SKIP PAST THE POINTER
	MOV	(AXOUT)+,AC	;GET THE LINE NUMBER
	MOV	AC,PCFN		;SAVE FOR COMMANDS WHICH ALTER TEXT
	JSR	PC,CHKEXT	;CHECK FOR EXTENDED DEBUG
	BCC	GONE		;NOT IN IT - EXIT
	PRNTLN			;PRINT THE LINE NUMBER OUT
	BR	GONE		;GO EXECUTE IT.
;
;
;---	CHKEXT - ROUTINE TO CHECK FOR EXTENDED DEBUG MODE
;
CHKEXT:	CLC			;START WITH A CLEAR CARRY
	TST	DEBG		;SEE IF IN DEBUG MODE
	BNE	1$		;NO - EXIT
	TSTB	PRM5		;SEE IF IT IS EXTENDED
	BEQ	1$		;NO - SKIP SETTING CARRY
	SEC			;NOTIFY USER OF EXTENDED MODE
1$:	POPJ			;RETURN TO THE CALLER
	.SBTTL	INPUTN - ROUTINE TO INPUT TEXT W/LINE#


INPUTN:	MOV	DEBG,-(SP)	;SAVE THE CURRENT DEBUG STATUS
	MOV	#-1,DEBG	;FORCE IT OFF!!!!
	FREAD			;NUMBER ONLY HERE!!
	JSR	R5,GTESTW	;CONVERT TO LINE FORMAT
	TSTB	AC		;SEE IF GROUP
	BEQ	LINERR		;HANDLE A LINE ERROR
	MOV	(SP)+,DEBG	;REINSTATE DEBUG MODE
	SPNOR			;IGNORE SPACES AFTER LINE NUMBER.
	JSR	PC,STLIN	;PREPARE POINTER TO INSERT NEW TEXT AND
	BR	SRETN		;SKIP TO THE TEST FOR END-OF- LINE.
SRETN2:	MOVB	(AXOUT)+,CHAR	;UNPACK A CHARACTER W/O TRACE.
SRETN:	PACKC			;SAVE THE BYTE ('TEMP' STILL CONTAINS (AXIN))
	CMPB	#CR,CHAR	;TEST FOR END OF LINE.
	BNE	SRETN2		;GO BACK FOR ANOTHER.
	INC	TEMP		;ROUND UP TO
	BIC	#1,TEMP		;EVEN ADDRESS.
	MOV	TEMP,AXIN	;('TEMP' IS LEFT BY "PACKC")
	CMP	TEMP,STARTV	;ANY INTERFERENCE WITH VARIABLE AREA?
	BLO	2$
	ERASEV			;(USES 'AC')
2$:	DELETE			;REMOVE THE OLD LINE, IF ANY. (NO BREAKS!)

;AT THIS JUNCTURE
;(PTR)=>LASTLN
;(AXIN)=(BUFR)+NEW.LENGTH
;(BUFR)=>THISLN

	MOV	PTR,AC		;COMPUTE THE NEXT
	ADD	@AC,AC		;LINE ADDRESS AS "C-2" THEN
	SUB	BUFR,AC		;FORM "C-NEW-2".
	MOV	AC,@BUFR	;SAVE NEW FORWARD LINKAGE.
	ADD	#2,AC		;"C-NEW"
	SUB	AC,@PTR		;UPDATE OLD LINKAGE "NEW-A"
	MOV	AXIN,BUFR	;POINT TO END OF LAST INSERTION.
	JMP	STARTX		;RETURN TO COMMAND/INPUT MODE.

LINERR:	ERROR+201+1.+1.		;ILLEGAL LINE NUMBER.
BUFFUL:	ERROR+201+10.+10.	;ROOM ONLY FOR IMMEDIATE COMMANDS.
	.SBTTL	ROUTINES: PRINTA,TESTX,SKPNOX


;"PRINT+'X"

;USE LOW BITS AS ASCII CODES.

PRINTA:	ROLB	@SP		;RESTORE CODES.
	MOVB	CHAR,1(SP)	;LEAVE OLD "CHAR" IN THE STACK FOR "OUTX-2"
	MOVB	@SP,CHAR	;(OLD, NEW)
	SWAB	@SP		;(NEW, OLD)
	JMP	OUTZ		;PRINT IT.



;"TESTC"

;CALLING SEQUENCE:
;TESTC	;CALL WITH (CHAR)=TEST DATA
;TADDR	;"TERMINATOR
;NADDR	;"NUMBER
;FADDR	;"FUNCTION
;	;RETURNS IF "ALPHA

TESTX:	JSR	R5,SPNORX	;TEST FOR SPACE AND IGNORE.
	BMI	TEX		;MUST BE TERMINATOR
	TST	(R5)+		;PREPARE SECOND RETURN
	SKPNON	TEX		;IF NUMBER,TAKE EXIT
	CMPB	#056,CHAR	;OR A POINT?
	BEQ	TEX		;YES, USE "NADDR."
	TST	(R5)+		;PREPARE FOR 3RD RETURN
	CMPB	#'F,CHAR	;TEST FOR FUNCTION DESIGNATION
	BNE	SOX		;RETURN,	 MUST BE "ALPHA
TEX:	MOV	@R5,R5		;GO BACK VIA POINTER
	RTS	R5		;IN ARGUMENT LIST.


;"SKPNON,YES-ADDR"

;SKIP IF NOT A NUMBER

SKPNOX:	CMPB	CHAR,#060	;TEST 0
	BLT	SOX		;TOO SMALL
	CMPB	CHAR,#072	;TEST 9
	BR	GROVZ		;NUMBER,USE YES-ADDRESS


	.EOT
	.SBTTL	ROUTINES: SORTB(SORTJ),SORTD(SORTC)


;"SORTJ"

;CHARACTER TEST AND BRANCH ROUTINES
;SORTJ,	 LISTCHAR, LISTADDR, RETURN-IF-NOT-THERE

SORTB:	MOV	(R5)+,AC	;PICKUP THE LIST POINTER AND
SORTB2:	CMPB	CHAR,@AC	;TEST WITH LIST CONTENTS.
	BEQ	SOUND		;MATCH FOUND!
	TSTB	(AC)+		;TEST FOR END OF LIST OR
	BNE	SORTB2		;REPEAT IF NOT AT END
SOX:	TST	(R5)+		;RETURN IF NO MATCH FOUND (SKIP OVER EXIT)
	RTS	R5		;GO BACK VIA R5.
				;
SOUND:	SUB	-2(R5),AC	;COMPUTE THE INDEX FIRST THEN
	ASL	AC		;MAKE EVEN AND
	ADD	@R5,AC		;GET TABLE OF ADDRESSES AND FINALLY
	MOV	@AC,R5		;SETUP ADDRESS FOR PC.
	RTS	R5		;GO BACK VIA NEW R5.



;"SORTC"

;SORTC,LISTCHAR,YESADDR,RETURN-IF-NOT-THERE

SORTD:	MOV	(R5)+,AC	;GET LIST ADDRESS
SORTD2:	CMPB	@AC,CHAR	;COMPARE WITH CONTENTS
	BEQ	TEX		;FOUND IT.
	TSTB	(AC)+		;TEST NEXT FOR END
	BNE	SORTD2		;REPEAT
	BR	SOX		;EXIT IF NOT THERE


	.SBTTL	GETLN - ROUTINE TO FORM A LINE NUMBER


;"GETLN"

;LINE NUMBER FORMATION ROUTINE

GETLNX:	CLRB	SWITCH		;SET TO TERMINATE UPON ALPHA
				;CODES (ENTRY POINT #1)
	CLR	AC		;FOR "ALL" USE ZERO.
	SPNOR			;IGNORE LEADING SPACES
	BMI	GALL1		;TERMINATOR=0="ALL"
	CMPB	#'A,CHAR	;TEST FOR "ALL
	BEQ	GALL1		;GO SET SWITCH AND RETURN OK
	MOV	R5,-(SP)	;SAVE LINK REGISTER
	MOV	PTR,-(SP)	;SAVE THE CONTENTS OF PTR
	JSR	PC,EVAL		;EVAL AS AN EXPRESSION
	MOV	(SP)+,PTR	;RESTORE IT
	MOV	(SP)+,R5	;RESTORE THE LINKAGE REGISTER
	CLRB	SWITCH		;REINSTATE CORRECT SWITCH SETTING
GTESTW:	FPMP	FMUL+IMMED	;MUL  BY 256
K256:	.FLT4	256.0		;FLOATING POINT 256
	.WORD	FINT		;FIX
	MOV	AC,LINENO	;SAVE THE ANSWER IN "AC" AND "LINENO"
	BMI	LINERR		;PREVENT USE OF BIT 15
	TSTB	AC		;TEST THE STEP-NO.
	BEQ	GGROUP		;MUST BE A GROUP.
	BISB	#ONE,SWITCH	;INDICATE A SINGLE LINE
	RTS	R5		;RETURN
				;
GALL1:	MOV	AC,LINENO	;SAVE THE ANSWER IN "AC" AND "LINENO"
GALL:	INCB	SWITCH		;SET BIT #0 FOR "ALL".
GGROUP:	RTS	R5		;RETURN TO PROCESS WITH STATUS BITS SETUP.
				;LINE NOS. >99.99 ARE NOT ERROR CHECKED.
				;
	.SBTTL	FINDX(FINDLN) - ROUTINE TO FIND A TEST LINE BY NUMBER


;"FINDLN"

;THIS ROUTINE LOOKS UP THE LINE WHOSE NUMBER
;MATCHES THE CONTENTS OF "LINENO"
;CALLING SEQUENCE: FINDLN,	NOTADDR,RETURN-IF-FOUND

;RESULTS IF FOUND:"THISLN"=FOUND LINE OR NEXT LARGER:
;"PTR" IS THE LAST LINE, I.E.PRECEEDING OR SAME LINE.
;"AXOUT"IS SET FOR USE BY "GETC".

;RESULTS IF-NOT-FOUND: "THISLN"=ADDRESS OF NEXT IN LINE
;			 "AXOUT"=NEXT OR ZERO
;			 "PTR"=PRIOR LINE


FINDX:	MOV	#CFRS,AXOUT	;LOAD STARTING ADDRESS OF TEXT
	MOV	AXOUT,PTR	;INIT FOLLOWING POINTER
FINDN:	MOV	AXOUT,THISLN	;SAVE CURRENT POINTER
	CMP	2(AXOUT),LINENO	;TEST FOR MATCH
	BHI	TEX		;PAST IT!=NOT FOUND
	BEQ	FINDO		;RIGHT ON!
	MOV	AXOUT,PTR	;COPY PRIOR POINTER.
	ADD	(AXOUT)+,AXOUT	;GET NEW POINTER
	BEQ	TEX		;END OF LIST=NOT FOUND
	BR	FINDN		;TRY THE NEXT ONE.
FINDO:	CMP	(AXOUT)+,(AXOUT)+ ;POINT AT TEXT
	BR	SOX		;RETURN TO SEQUENCE

;DATA STRUCTURE OF LINES:

;WORD #1 :	NEXT-.-2		;LAST IS 0-.-2
;WORD #2 :	LINE#			;GROUP. STEP
;WORDS #3-N:	7-BIT ASCII AND SPECIAL INTERNAL TEXT CODES
;LAST BYTE :	 216		;CARRIAGE RETURN
	.SBTTL	ROUTINES: PRINT2,SKPLPR,DIGTST,GROOVY






;"PRINT2,ARGARG"

PRIN2A:	MOVB	(R5)+,CHAR	;COPY FIRST TRAILING BYTE
	PRINTC			;AND PRINT
	MOVB	(R5)+,CHAR	;COPY SECOND TRAILING BYTE
	BR	OUT		;AND GO PRINT IT



;"SKPLPR,NOT-ADDR"

;BRANCH IF LEFT-PARENS. NOT FOUND.

XTSTLP:	CMPB	CHAR,#210	;TEST FOR (<[.
	BHI	TEX		;RIGHT TERMINATOR? - YES, USE "NOT-ADDR".
	CMPB	CHAR,#206	;OUT OF RANGE?
GROVZ:	BLO	TEX		;YES, USE "NOT-ADDR"
	BR	SOX		;OK, SKIP ONWARDS.



;"DIGTST,FIELD"

DIGTSA:	MOV	#60,CHAR	;INITIALIZE CHARACTER
DIGTS4:	CMP	PTR,@R5		;TEST FOR POSSIBILITY
	BLO	SOX		;LEAVE IF NO MORE POSSIBLE(UNSIGNED)
	SUB	@R5,PTR		;MAKE CHANGE AND
	INC	CHAR		;COUNT
	BR	DIGTS4		;REPEAT



;"GROOVY,NOT-ADDR"

GROVX:	CMPB	LINENO+1,3(AXOUT) ;TEST FOR SAME GROUP
	BNE	TEX		;GO BRANCH OR
	TST	AXOUT		;CHECK FOR END OF TEXT
	BEQ	TEX		;TAKE NOT-ADDR
	BR	SOX		;JUST RETURN


	.SBTTL	ROUTINES: READC AND PRINTC (NON-FILE STRUCUTED I/O)


;"READC" AND "PRINTC"

;I/O CONTROLS

CHIN:	INCH			;READC = INPUT
	.IFDF	$RT11		;RT-11 VERSION ONLY
	CHKEOF			;SEE IF EOF
	BCS	RUBX3		;RETURN PRONTO IF TRUE!
	.ENDC
	BIC	#-200,CHAR	;FORCE ANY HIGH BITS OFF
	BEQ	CHIN		;IGNORE NULLS
	CMP	#3,CHAR		;CONTROL-C?
	BEQ	INIT2		;YES=RESTART
	.IFDF	$RT11
	TST	LIBSW		;IF IN A LIBRARY COMMAND,
	BNE	2$		; WE MUST NOT ECHO!!
	.ENDC
;
;---	HANDLE RUBOUT PROCESSING
;
	CMPB	CHAR,#177	;IS THIS A RUBOUT?
	BNE	1$		;NO - SEE IF LAST ONE WAS
	TSTB	RUBSW		;SEE IF RUBOUT IN PROGRESS
	BNE	2$		;YES - PASS IT ON
	INCB	RUBSW		;NOTIFY THE SYSTEM
	PRINT	<'\>		;SEND BACK-SLASH
	BR	2$		;CONTINUE ALONG
;
1$:	TSTB	RUBSW		;RUBOUT?
	BEQ	2$		;NO - CONTINUE
	CLRB	RUBSW		;ELSE FLAG THAT RUBOUT SECTION IS OVER
	PRINT	<'\>		;PRINT ANOTHER BACK-SLASH
;
2$:	SORTC	ECHOLST,RUBX2	;TEST FOR NO-ECHO
	SORTC	TERMS,CHINX	;CONVERSION TEST.
	BR	OUTW		;GO ECHO
				;
CHINX:	SUB	#TERMS-200,AC	;FORM INTERNAL CODE
	MOVB	AC,CHAR		;AND SAVE IT
	.IFDF	$RT11
	TST	LIBSW		;IF IN A LIBRARY COMMAND,
	BNE	RUBX3		; NO ECO IS PERFORMED.
	.ENDC
OUTW:	CMP	#SCONL,R5	;DON'T
	BEQ	RUBX2		;ECHO SEARCH CHARACTER FROM *MODIFY*.
	CMP	INDEV,IPRS	;DON'T
	BEQ	RUBX2		;ECHO FOR H.S.R.
	.IFDF	$RT11		;RT-11 VERSION ONLY..
	BIT	#TTYSPC,JSW	;SPECIAL MODE OF TTY?
	BEQ	RUBX2		;NO - NO ECHO!!
	TST	GETSW		;SEE IF IN THE LIBRARY GET COMMAND

	BNE	RUBX2		;IF SO, NO ECHO IS TO BE PERFORMED!!!!!

	.ENDC
OUT:	CMPB	CHAR,#14	;FORM FEED CHAR?
	BEQ	RUBX2		;DON'T OUTPUT IT!
	MOVB	CHAR,-(SP)	;SAVE THIS FORM ON THE STACK.
	BPL	OUTZ		;IF SPECIAL TERM., REGENERATE BY
	MOVB	TERMS+200(CHAR),CHAR ;COMPUTING ASCII
OUTZ:	OUTCH			;OUTPUT TO ANY DEVICE.
	CMPB	#15,CHAR	;(CHANGED BY 'OUTCH')
	BNE	OUTY		;JUST GO COUNT IT.
	CLRB	LINCNT		;INITIALIZE LINE COUNT
	CMPB	@SP,CHAR	;WAS THIS AN INTERNAL CR?
	BEQ	OUTY		;IF NOT, JUST GO COUNT.
	PRINT	012		;ISSUE THAT EXTRA LINEFEED.
OUTY:	INCB	LINCNT		;UPDATE LINE POSITION
	CMP	OUTDEV,ITPS	;TEST FOR TTY OUTPUT.
	BNE	OUTX		;IF NOT, DON'T EDITORIALIZE.
	.IFDF	$RT11
	TST	LIBSW		;LIB CMD?
	BNE	OUTX		;YES - SKIP IT
	.ENDC
	CMPB	LINCNT,PRM2	;TIME FOR A <CR>?
	BNE	OUTX		;NO - SKIP IT
	CLRB	LINCNT		;RESET POSITION
	PRINT2	<CRLF>		;OUTPUT ONE OF EACH
OUTX:	MOVB	(SP)+,CHAR	;RESTORE ORIGINAL DATA
	RTS	R5		;RETURN FROM TRAP
	.SBTTL	ROUTINES: PRNTLN AND SPNOR



;"PRNTLN"

;PRINT A LINE NUMBER ROUTINE

XPRNTL:	MOV	#2005,PTR	;SET FORMAT TO %4.02
	MOVB	PRM6,TEMP	;SAVE ROUNDING MODE
	CLRB	PRM6		;FORCE TO ROUND FOR LINE NUMBER OUTPUT
	FPMP	FLOAT		;LOAD FLAC
	.WORD	FDIV+REL,K256-.	;DIVIDE BY 256.
	FPRINT			;PRINT RESULT
	MOVB	TEMP,PRM6	;RESTORE THE ROUNDING MODE
	PRINT	<' >		;PRINT TRAILING SPACE
	RTS	R5		;RETURN




;"SPNOR"

;IGNORE SPACES

SPNXT:	GETC			;MOVE ON TO NEXT CHARACTER CODE.
SPNORX:	CMPB	#200,CHAR	;CHECK FOR SPACE SYMBOL.
	BEQ	SPNXT		;TRY AGAIN.
RUBX3:	BR	RUBX2		;LEAVE "CHAR" IN "STATUS" AND EXIT.



INIT2:	MOV	STACKA,SP	;RESET STACK FOR MANUAL RESTART
2$:	CLR	FSW		;RESET THE SWITCH

	.IF	DF,$RT11
	.GLOBL	$ERFCL
	TST	#$ERFCL		;AVAILABLE ?
	BEQ	3$		;NO - SKIP
	JSR	PC,$ERFCL	;CALL SPECIAL SETUP FOR HARDWARE
3$:				;ERRORS WITH FIS OR FPU (ARB  8-SEP-82)
	.ENDC

	.IF	NDF,$SMALL
	CLR	ERRLIN		;RESET ERROR TRAP
	.ENDC
	ERROR+201+0.+0.
;
	.SBTTL	ROUTINES: PACKC AND GETC (I/O TO TEXT DATA STRUCTURE)


;"PACKC"

;TEXT BUFFER CONTROLS

PACKX:	MOV	AXIN,TEMP	;COPY INPUT TEXT POINTER.
	CMPB	#177,CHAR	;TEST FOR RUBOUT
	BEQ	RUBIT		;GO BACK UP ONE SPACE
	CMPB	#137,CHAR	;LEFT ARROW
	BEQ	PBAR		;GO RESET.
	CMPB	#'U-100,CHAR	;^U READ?
	BEQ	PBAR2		;CANCEL LINE ALSO
	MOVB	CHAR,(TEMP)+	;SAVE CHARACTER CODE AND MOVE POINTER.
	CMP	BOTTOM,TEMP	;TEST FOR END
	BHI	RUBX		;CONTINUE
	ERROR+201+10.+10.	;C.F. INPUT!
				;
PBAR2:	PRINT2	<"^U>		;PRINT THE ^U
PBAR:	MOV	@SP,TEMP	;RESET INPUT POINTER.
	PRINT2	<CRLF>		;RETURN THE CARRIAGE FOR LINE CANCEL
RUBIT:	CMP	TEMP,@SP	;TEST FOR NULL LINE(OLD R5 IS "PACKST")
	BEQ	RUBX		;IGNORE R.O. CODE COMPLETELY
	DEC	TEMP		;BACKUP ONE PLACE
	MOVB	@TEMP,CHAR	;GET CHAR
	BPL	2$
	MOVB	TERMS+200(CHAR),CHAR ;RECOVER ORIG CHAR
2$:	OUTCH			;OUTPUT IT
RUBX:	MOV	TEMP,AXIN	;SAVE POINTER
RUBX2:	MOVB	CHAR,CHAR	;SET CONDITION CODES BEFORE LEAVING.
	RTS	R5		;RETURN TO MAINLINE ROUTINES.


;"GETC"

;UNPACK A CHARACTER AND LEAVE IN 'STATUS'

UTX:	TSTB	DEBG		;TEST FOR TRACE ENABLED
	BNE	RUBX2		;RETURN IF NOT ENABLED.
	COMB	DEBG+1		;FLIP THE TRACE FLOP
GETX:	MOVB	(AXOUT)+,CHAR	;PICK OUT NEXT BYTE
	CMPB	#'?,CHAR	;CHECK FOR TRACE FLIP-FLOP CODE
	BEQ	UTX		;GO FLIP IT IF CODE FOUND PLUS ENABLED.
	TST	DEBG		;TEST FOR BOTH DEBG+DMPS=0.
	BNE	RUBX2		;NOT IN TRACE NOW.
	BR	OUT		;GO PLAY-BACK THE BYTE.
	.SBTTL	ROUTINE: DELETE (TEXT DELETION)

;"DELETE"

; A LINE AND
;GARBAGE COLLECTION IS DONE UP TO (STARTV);
;(BUFR) IS CORRECTED;
;(TEMP) IS AMOUNT OF CODE COLLECTED.

ECOLOGY:MOV	(AXOUT)+,(CHAR)+;STEP 3-COLLECT SPACE
	CMP	AXOUT,STARTV	;TEST FOR COMPLETION
	BLOS	ECOLOGY		;CONTINUE UNTIL FINISHED.
	SUB	TEMP,BUFR	;UPDATE END OF TEXT POINTER.
	SUB	TEMP,AXIN	;...
				;*** NO INTERRRUPTS!
XDELET:	FINDLN	DELOUT		;SETUP LINE POINTERS FOR EXIT
XD3:	MOVB	(AXOUT)+,CHAR	;READ THROUGH THE LINE
	CMPB	CHAR,#CR	;CARRIAGE RETURN MARKS END
	BNE	XD3		;REPEAT UNTIL END REACHED.
	INC	AXOUT		;ROUND OUT THE POINTER
	BIC	#1,AXOUT	;TO AN EVEN NUMBER.
	MOV	THISLN,CHAR	;COPY POINTER TO THIS LINE.
	ADD	@CHAR,@PTR	;STEP 1-CREATE NEW RELATIVE
	ADD	#2,@PTR		;POINTER TO NEXT LINE IN LIST.
	MOV	AXOUT,TEMP	;COMPUTE DELTA POSITION
	SUB	CHAR,TEMP	;AS A POSITIVE, EVEN NO. OF BYTES.
	MOV	#CFRS,AC	;BEGIN AT TOP TO GARBAGE COLLECT.
XDOX:	MOV	AC,PTR		;STEP 2-FOLLOW + UPDATE LINKS ("THIS")
	BEQ	ECOLOGY		;GO COLLECT ALL
	ADD	(AC)+,AC	;TEST FOR LAST OF KIND.
	CMP	PTR,AXOUT	;TEST FOR ABOVE OR BELOW CHANGE AND
	BLO	XDTHIS		;BRANCH TO FIXUP THIS ONE IF IT  IS  ABOVE
	CMP	AC,AXOUT	;TEST FOR NEXT-IS-BELOW AND
	BHIS	XDOX		;BRANCH TO NEXT ONE IF ALSO BELOW
	ADD	TEMP,@PTR	;ADD THE CHANGE AND
	BR	XDOX		;GO LOOK AT NEXT ITEM.
				;
XDTHIS:	CMP	AC,AXOUT	;IS NEXT ONE ABOVE THE CHANGE ALSO?
	BLO	XDOX		;YES, CONTINUE.
	SUB	TEMP,@PTR	; NO,CHANGE "LINE".
	BR	XDOX		;GO TO NEXT LINE

;	HERE-THERE=CHANGE HERE
;	A	A	0
;	B	B	0
;	A	B	-T
;	B	A	+T
;
;---	SPECIAL HANDLING!
;
	.IFDF	$PAPER
DELOUT:	RTI			;EXIT...
	.IFF
DELIN:	.MFPS	-(SP)
	MOV	#40,-(SP)
	MOV	#XDELET,-(SP)
	RTI
;	BR	XDELET		;NORMALLY VIA IOT INSTR..
DELOUT:MOV	#1$,-(SP)
	RTI
1$:	RTS	R5
	.ENDC
	.SBTTL	*IF* - CONDITIONAL TRANSFER



;*IF*

;CONDITIONAL TRANSFER PROCESS

;THE FLAVORS OF *IF*
;IF (EXP)-,0,+	[3-WAY]
;	 -,0;...[2-WAY OR...]
;	 -,0	[2-WAY OR NEXT LINE]
;	 -;...	[1-WAY OR...]
;	 -	[1-WAY OR NEXT LINE]

LOST:	GETC
	BR	LOSE2



IF:	SPNOR			;GOTO LPAR (ENTRY POINT)
	MOV	CHAR,-(SP)	;SAVE LPAR FOR "PARTST".
	EVAL.X			;EVALUATE THE EXPRESSION WITH PARENTHESES
	PARTST			;CHECK CLOSING PARENS AND DO 'GETC'.
	TST	FLAC		;TEST SIGN
	BEQ	LOSE1		;EQUAL TO ZERO
	BMI	GOTO		;READY FOR -
LOSE2:	CMPB	CHAR,#214	;TEST FOR END OF LINE NO
	BLO	LOST		;NOT YET
LOSE0:	BHI	PROC		;SEMI. OR C.R. (OR =!)
	GETC			;COMMA #1
LOSE1:	CMPB	CHAR,#214	;LOOK FOR COMMA
	BNE	LOSE0		;GO TEST OTHERS
	GETC			;SKIP THE COMMA

;FALL THROUGH INTO *GOTO*

	.SBTTL	*GO*GOTO*COMMENT*CONTINUE*RETURN*XECUTE*


;*GO*GOTO*COMMENT*CONTINUE*RETURN*XECUTE*

;PRIMARY CONTROL AND TRANSFER

;
;
GOTO:	TST	(SP)+		;POP RETURN ADDRESS AND TRY AGAIN
	GETLN			;READ THE ADDRESS AND
	FINDLN	GERR		;ATTACH TO NEW LINE.
PSCAN:	MOV	THISLN,PCF	;SET NEW LINE POINTER
	MOV	-2(AXOUT),PCFN	;REMEMBER THE LINE NUMBER
PROCESS:GETC			;READ A CHARACTER IN LINE
PROC1:
	.IF	NDF,$SMALL
	.GLOBL	QUECHK
	JSR	PC,QUECHK	;CHECK ON QUEUES
	.ENDC
	.GLOBL	PROC2
PROC2:	CMPB	CHAR,#CR	;TEST FOR END OF LINE
	BEQ	PC1		;GO-ON TO PROCESS NEXT LINE
	MOVB	CHAR,AC		;COPY DATA
	BMI	PROCESS		;IGNORE TERMINATORS
	CMPB	#'A,CHAR	;CHECK DATA
	BGT	ERRORC		;TOO LOW.
	CMPB	#'X,CHAR	;TOO HIGH?
	BGE	PC2		;OK
ERRORC:	ERROR+201+4.+4.		;ILLEGAL COMMAND CODE.
PC2:	GETC			;IGNORE REST OF THE COMMAND'S
	CMPB	CHAR,#'A	;SEE IF STILL AN ALPHABETIC CHARACTER
	BLT	2$		;NO - PROCESS COMMAND
	CMPB	CHAR,#'Z	;STILL WITHIN RANGE?
	BLE	PC2		;CONTINUE
2$:	ASL	AC		;MAKE BYTE COUNT INTO WORD COUNT.
	.IF	NDF,$SMALL
	MOV	SP,LINESP	;SAVE STACK ADDRESS IN CASE OF AN ERROR
	.ENDC
	JSR	PC,@COMLST-202(AC) ;BRANCH TO THE COMMAND PROCESS.
1$:	SORTC	TLIST+1,PROC1	;SCAN OFF THE END FOR TERMINATORS
	GETC			;GET ANOTHER CHARACTER
	BR	1$		;CONTINUE UNTIL A ";" OR "<CR>"
;
$RETUR:	MOV	#PC1+2,PCF	;RETURN FROM SUBROUTINE (?)
PC1:	POPJ			;EXIT FROM LINE
	-2			;DUMMY TERMINATOR
FLTZER:	0,0			;DUMMY LINE NUMBER ZERO
	0,0			;AND DUMMY VALUE OF FLOATING ZERO.
				;
TPR:
COMENT:
TPR1:	TST	(SP)+		;DUMP RETURN UPON C.R.
PROC:	POPJ			;GO EXIT FROM A LINE.
;
;---	GERR - HANDLE GROUP GO-TO'S
;
GERR:	TSTB	SWITCH		;WAS HE AFTER A SINGLE LINE NUMBER?
	BGT	1$		;YUP - AND HE MISSED IT!... 
	TST	AXOUT		;BEYOND THE POSSIBILITIES?
	BEQ	1$		;YUP...
	GROOVY	1$		;ERROR IF NOT IN THE SAME GROUP EITHER..
;
;---	HERE IT LOOKS LIKE THE FOOL LUCKED OUT! A GROUP GOTO OR IF XFER!
;
	CMP	(AXOUT)+,(AXOUT)+ ;SET UP FOR TEXT PROCESSING
	BR	PSCAN		;CONTINUE THE SCAN
;
;---	OOPS!! - ERROR.
;
1$:	ERROR+201+5+5		;ERROR 5 (SERR)
	.SBTTL	*MODIFY*

SERR:	ERROR+201+5.+5.		;NONEXISTANT LINE OR LINE ZERO

;*MODIFY*

;SEARCH FOR CHARACTER IN TEXT

MODIFY:	GETLN			;READ COMMAND ARGUMENT
	FINDLN	SERR		;LOOKUP THE INPUT DATA
	JSR	PC,STLIN
	.IFDF	$RT11		;RT-11 VERSION ONLY!!
	BIS	#TTYSPC,JSW	;SET SPECIAL MODE OF TTY INPUT
	.ENDC
SCONT:	READC			;READ SEARCH CHARACTER SILENTLY.
SCONL:	MOVB	CHAR,LIST3+1	;SAVE SEARCH CHARACTER
SCHAR:	MOVB	(AXOUT)+,CHAR	;UNPACK AND PRINTOUT
	PRINTC			;EXTRA OUTPUT FOR C.R.
	SORTJ	LIST3,LISTGO	;TEST FOR C.R. OR SEARCH CHARACTER
	PACKC			;SAVE OLD CHARACTER.
	BR	SCHAR		;REPEAT
				;
SFIND:	READC			;ABSORB AND ANALYSE
	SORTJ	LIST6,SRNLST	;THE INPUT TEXT
SFOUND:	PACKC			;PACK NEW CHARACTER
	BR	SFIND		;REPEAT
				;

;START-UP-A-LINE SUBROUTINE

STLIN:	MOV	BUFR,R5		;COMPUTE START OF NEW LINE
	CLR	(R5)+		;ZERO LIST LINK AND
	MOV	AC,(R5)+	;SAVE LINE NUMBER
	BEQ	SERR		;FLAG "M 0" ERROR IMMEDIATELY.
	MOV	R5,AXIN		;SETUP INPUT POINTER
	RTS	PC
;
FIXUP:	MOV	PCFN,LINENO	;SET CURRENT LINE NUMBER
	FINDLN	1$		;SEE IF IT CAN BE FOUND
	MOV	THISLN,PTR	;POINT TO THIS LINE
1$:	MOV	PTR,PCF		;RESET FOCAL PC
	MOV	#216,CHAR	;SET TERMINATING CHARACTER
	POPJ			;RETURN
	.SBTTL	*WRITE* - OUTPUT COMMAND TEXT


;*WRITE*

;OUTPUT COMMAND TEXT

WRITE:	GETLN			;READ THE ARGUMENT
	MOV	CHAR,-(SP)	;PERMIT FOLLOWING SEMICOLON.
	MOV	AXOUT,-(SP)	;
WRITE2:	FINDLN	WTESTG		;LOOKUP THE LINE
	MOV	-2(AXOUT),AC	;TEST FOR LINE ZERO
	BEQ	WRITEL		;BRANCH TO PRINT TITLE ONLY
	PRNTLN			;PRINT NON-ZERO LINE NOS. IN "AC"
WRITEL:	MOVB	(AXOUT)+,CHAR	;READ W/O TRACE
	PRINTC			;PRINT ONE CHARACTER
	CMPB	#CR,CHAR	;TEST FOR END
	BNE	WRITEL		;REPEAT
	MOV	THISLN,AXOUT	;COMPUTE NEXT LINE
	ADD	(AXOUT)+,AXOUT	;ADDRESS READY NOW.
	BEQ	WGO		;LEAVE IF LAST LINE.
WTESTG:	TSTB	SWITCH		;TEST FOR SINGLE LINE
	BMI	WGO		;YES=EXIT
	GROOVY	WRED		;SAME GROUP AS LAST LINE?
WRIG:	COPYLN			;COPY THIS NEXT LINE NUMBER.
	BR	WRITE2		;GO FIND IT.
				;
WRED:	PRINTC			;PRINT EXTRA CR AFTER GROUP.
	BITB	#ALL,SWITCH	;TEST FOR "ALL"?
	BNE	WRIG		;YES,KEEP IT UP.
WGO:	BR	DOXIT		;RETURN


	.SBTTL	*ERASE*ERASE ALL*ERASE TEXT*ERASE 'GROUP.LINE'*


;*ERASE*ERASE ALL*ERASE TEXT*ERASE 'GROUP.LINE'*

ERASE:	TESTC			;TEST THE ARGUMENT, IF ANY.
	ERVC			;ERASE "VARIABLES
	ERL			;ERASE LINE OR GROUP OF TEXT
	LINERR			;ERROR,
	CMPB	CHAR,#'T	;ERASE TEXT ONLY?
	BEQ	1$		;YES - GO DO IT
	CMPB	#'A,CHAR	;TEST FOR "ALL
	BNE	ERL		;WHY NOT USE A VARIABLE NAME ?
	ERASEV			;ERASE THE VARIABLES
1$:	ERASET			;OUT THE TEXT
ERS:	START			;RESTART IF TEXT IS GONE
				;
ERX:	JSR	PC,FIXUP	;GO BACK
	TST	PCFN		;SEE IF FROM CMD/INP MODE
	BEQ	ERS		;NO - RETURN CORRECTLY
	POPJ			;BYE....
				;
ERL:	GETLN			;READ LINE NUMBER.
	TST	AC		;DON'T ERASE LINE
	BEQ	SERR		;ZERO!
1$:	DELETE			;EXTRACT ONE LINE (NO BREAKS!)
	TSTB	SWITCH		;TEST FOR SINGLE OR GROUP
	BMI	ERX		;ONLY ONE
	TST	AXOUT		;CHECK FOR END OF LIST TO
	BEQ	ERX		;AVOID REALLY WILD LOOP!
	GROOVY	ERX		;TEST FOR SAME GROUP MEMBER
	COPYLN			;MOVE AHEAD
	BR	1$		;AND DO ANOTHER.
				;
ERVC:	ERASEV			;*E* COMMAND IN TEXT IS OK.
	POPJ			;GO TO NEXT COMMAND OF PROGRAM.



;"COPYLN"

;USED BY *WRITE*, *ERASE*, AND *DO*

COPYLX:	MOV	2(AXOUT),LINENO	;USE NEXT LINE NUMBER
	RTS	R5		;RETURN TO *WRITE*ERASE*DO*.


;"ERASET"

ERTX:	MOV	TOP,BUFR	;ERASE ALL TEXT
	MOV	#CFRS+2,CFRS	;INITIALIZE LINE ZERO POINTER DATA
	NEG	CFRS		;COMPLETE THE VALUE
	RTS	R5
	.SBTTL	*DO*


;*DO*

;RECURSIVE OPERATE

DO:	GETLN			;READ LINE # ARGUMENT
DO2:	MOV	CHAR,-(SP)	;SAVE THE NEXT CHARACTER.
	MOV	AXOUT,-(SP)	;CHARACTER POINTER OF CURRENT LOCATION
	MOV	PCF,-(SP)	;SAVE ADDRESS OF LINE AND
	MOV	PCFN,-(SP)	;AND THE CURRENT LINE NUMBER
	FINDLN	DOGR		;LOOKUP THE LINE
	BR	DOGRP1		;FOUND!
				;
DOGR:	TSTB	SWITCH		;TEST FOR SINGLETON
	BMI	DOER		;YES, OUGHT TO HAVE BEEN THERE.
				;C(THISLN)=C(AXOUT).
	GROOVY			;COMPARE GROUP NOS.
	DOER			;ERROR, NO SUCH GROUP
DOGRP2:	COPYLN			;COPY FIRST LINE NO. OF THE GROUP
	CMP	(AXOUT)+,(AXOUT)+ ;POINT FORWARD
DOGRP1:	MOVB	SWITCH,-(SP)	;SAVE FLAGS
	MOV	THISLN,-(SP)	;SAVE ADDRESS OF LINE BEING DONE
	MOV	-2(AXOUT),AC	;GET LINE NUMBER
	MOV	AC,PCFN		;SET FOR POSSIBLE ADJUSTMENT
	TST	DEBG		;SEE IF IN DEBUG MODE
	BNE	1$		;NO - SKIP IT
	TSTB	PRM5		;EXTENDED DEBUG?
	BEQ	1$		;NO - SKIP IT!
	PRNTLN			;PRINT IT
1$:	JSR	PC,PSCAN	;SCAN COMMANDS IN THAT LINE
	MOV	(SP)+,TEMP	;RESTORE LINE LAST DONE ADDRESS
	MOVB	(SP)+,SWITCH	;RESTORE CORRECT SCOPE OF "DO"
	BMI	DOCONT		;IF SINGLE LINE, WE ARE DONE NOW.
	MOV	PCF,AXOUT	;KEEP POINTER TO NEXT LINE TO BE DONE.
	ADD	(AXOUT)+,AXOUT	;COMPUTE NEXT ADDRESS IN GROUP.
	BEQ	DOCONT		;LEAVE IF OUT OF TEXT ALTOGETHER
	MOV	AXOUT,THISLN	;SAVE POINTER
	BITB	#ALL,SWITCH	;TEST FOR "DO" OR "DO ALL"
	BNE	DOGRP2		;...
	CMPB	3(TEMP),3(AXOUT);COMPARE GROUP NOS.
	BEQ	DOGRP2		;GO DO NEXT ONE.
DOCONT:	MOV	(SP)+,PCFN	;...
	MOV	(SP)+,PCF	;RESTORE FOCAL PC AND LINE NUMBER
DOXIT:	MOV	(SP)+,AXOUT	;...
	MOV	(SP)+,CHAR	;RESTORE THE LAST CHARACTER.
	POPJ			;CONTINUE THE STRING
				;
DOER:	ERROR+201+6.+6.		;NO SUCH GROUP TO BE DONE.

	.SBTTL	*SET*FOR*

;*SET*FOR*

;LOOP CONTROL STATEMENT

SET:
FOR:
	.IFDF	$RT11
	MOV	AXOUT,-(SP)	;SAVE LINE POSITION
	DEC	@SP		;SAVE "CHAR" ALSO
	TESTC
	FINERR
	VERR
	VERR
	CMP	CHAR,#'&	;SEE IF SPECIAL CHARACTER
	BNE	3$		;NO - CONTINUE AS NORMAL
	JSR	PC,WHIPV2	;GET "&" VARIABLE
	BR	4$		;SKIP NORMAL PROCESSING
3$:	JSR	PC,GETNAM	;GET SINGLE VARIABLE
	ADD	#4,SP		;POP THE TOP WORDS OFF
	.IFF
	JSR	PC,GETARG	;GET ARGUMENT
	MOV	PTR,-(SP)	;AND SAVE THE PTR
	.ENDC
4$:	SPNOR			;IGNORE TRAILING SPACES
	CMPB	#217,CHAR	;TEST FOR "="
	BNE	FINERR		;ERROR TO LEFT OF = SIGN
	EVAL.X			;EVALUATE RIGHT HAND EXP.
	.IFDF	$RT11
	MOV	AXOUT,-(SP)	;SAVE AXOUT
	DEC	@SP		;AND THE CONTENTS OF "CHAR"
	MOV	2(SP),AXOUT	;POINT AT LEFT PART
	MOVB	(AXOUT)+,CHAR	;EXTRACT CHARACTER
	OPEN			;OPEN THE AREA ON THE STACK
	FPMP	FPUT+INTO+STACK	;SAVE THE FLAC
	MOV	DEBG,-(SP)	;SAVE DEBUG SWITCH
	BNE	1$		;EXIT IF NOT IN DEBUG MODE
	TSTB	PRM5		;EXTENDED MODE?
	BEQ	2$		;NO - SHUT IT DOWN
	PRINT	<'[>		;SEND THE SEPARATOR
	BR	1$		;CONTINUE ALONG
2$:	MOV	#-1,DEBG	;SET IT OFF FOR NOW..
1$:	INCB	NVSW		;MARK FOR VARIABLE CREATION
	JSR	PC,GETARG	;GET THE ARG AGAIN
	CLRB	NVSW		;RESET THE SWITCH
	MOV	(SP)+,DEBG	;RECOVER CORRECT DEBUG
	FPMP	FGET+FROM+STACK
	CLOSE			;CLOSE THE SPACE ON THE STACK
	JSR	PC,VWRITE	;OUTPUT TO VARIABLE (FOR VIRTUAL FILES
				; SPECIAL CONVERSIONS ARE TO TAKE PLACE)
	JSR	PC,EXTDBG	;PERFORM EXTENDED DEBUG OUTPUT IF NEEDED
	MOV	(SP)+,AXOUT	;AND AXOUT
	MOVB	(AXOUT)+,CHAR	;RECOVER CHAR
	.IFF			;ELSE, FOR PAPER-TAPE
	FPMP	FPUT+THROUGH+STACK ;UPDATE+INDEX VALUE
	.ENDC
	SORTJ	TLIST,FLIST1	;TEST TERMINATOR
FINERR:	ERROR+201+7.+7.		;ILLEGAL FORMAT IN *SET* OR *FOR* COMMAND
FINCR:	EVAL.X			;EVALUATE EXPRESSION.
	SORTJ	TLIST,FLIST2	;TEST TERMINATOR
	BR	FINERR		;ERROR CALL
				;
FINFIN:	CLR	-(SP)		;CLEAR OUT 3 WORDS
	CLR	-(SP)		;ONLY ONE MORE TO GO...
	CLR	-(SP)		;LAST ONE!!!
	MOV	#^F1.0,-(SP)	;FLT. PT. 1.0
	BR	FCONT		;GO SAVE THE LIMIT.
				;
FLIMIT:	OPEN			;SAVE INCREMENT
	FPMP	FPUT+INTO+STACK	;...
	EVAL.X			;EVALUATE LIMIT
FCONT:	OPEN			;SAVE THE LIMIT.
	FPMP	FPUT+INTO+STACK	;...
FCONT2:	DEC	AXOUT		;BACK UP SO WE SAVE CHAR ALSO
	MOV	AXOUT,-(SP)	;SAVE TEXT POINTER ID AND
	MOV	PCF,-(SP)	;CURRENT LINE ADDR THEN
	JSR	PC,PROCESS	;GO EXECUTE THE REST OF THE LINE
	MOV	(SP)+,PCF	;RESTORE TEXT POINTERS
	.IFDF	$RT11
	MOV	22(SP),AXOUT	;RESTORE THE POINTER
	MOVB	(AXOUT)+,CHAR	;GET SET
	MOV	DEBG,-(SP)	;SAVE THE CURRENT DEBUG STATUS
	BNE	2$		;SKIP SHUTDOWN
	TSTB	PRM5		;SEE IF IN EXTENDED MODE
	BEQ	3$		;NO - SHUT DOWN THE DEBUG FEATURE
	PRINT	<'[>		;SET SEPARATOR
	BR	2$		;SKIP SHUTDOWN
3$:	MOV	#-1,DEBG	;STOP RE-ECHO OF VARIABLE
2$:	JSR	PC,GETARG	;HANDLE IT!
	MOV	(SP)+,DEBG	;RESET DEBUG MODE
;--	NOTE... PTR IS CORRECT NOW!!!
	.ENDC
	MOV	(SP)+,AXOUT	;...
	MOVB	(AXOUT)+,CHAR	;REINSTATE THE CHAR
	.IFDF	$PAPER
	MOV	20(SP),PTR	;GET VAR POINTER
	.ENDC
	TST	-(SP)
	MOV	SP,(SP)		;CREATE INDEXED ADDRESS OF INCREMENT
	ADD	#12,@SP		;...
	FPMP	FGET+IPTR	;LOAD FLAC WITH THE VARIABLE
	FPMP	FADD+THROUGH+STACK ;ADD THE INCREMENT AND
	.IFDF	$RT11
	JSR	PC,VWRITE	;OUTPUT TO THE VARIABLE. SPECIAL HANDLING
				; FOR VIRTUAL FILES.
	JSR	PC,EXTDBG	;PERFORM EXTENDED DEBUG FUNCTION
	.IFF
	FPMP	FPUT+IPTR	;OUTPUT IT
	.ENDC
	MOV	(SP)+,TEMP	;INDEX TO  THE LIMIT
	FPMP	FSUB+FROM+STACK	;COMPARE RESULT WITH LIMIT
	TST	(TEMP)		;CHECK THE DIRECTION OF THE FOR...
	BPL	1$		;IF POS. THEN CONTINUE
	NEG	FLAC		;CHANGE THE SIGN
1$:	TST	FLAC		;AND DROP INDEXED POINTER.
	BLE	FCONT2		;REPEAT. IF LIMIT NOT EXCEEDED
	ADD	#24,SP		;UNLOAD THE STACK.
	POPJ			;EXIT THE COMMAND.
	.IFDF	$RT11
	.SBTTL	EXTDBG - EXTENDED DEBUG ROUTINE

;
;---	EXTDBG - ROUTINE TO PERFORM EXTENDED DEBUG OUTPUT IF NEEDED
;
;
;	OUTPUT CONSISTS OF THE CONTENTS OF THE VARIABLE, ALONG
;	WITH ITS NAME EACH TIME IT IS CHANGED.
;
EXTDBG:	TST	DEBG		;IN DEBUG MODE?
	BNE	1$		;NO - SKIP THE FANCY STUFF
	MOV	PTR,-(SP)	;SAVE THE REGISTER
	TSTB	PRM5		;EXTENDED DEBUG?
	BEQ	2$		;NO - CONTINUE AS NORMAL
	BMI	3$		;IF NEG, USE %8.04 FORMAT
	MOV	FISW,PTR	;SET CURRENT FORMAT CODE
	BR	4$		;SKIP RESET
3$:	MOV	#4012,PTR	;SET FORMAT: %8.04
4$:	FPRINT			;PRINT THE VALUE
	PRINT	<']>		;PRINT THE SEPARATOR
	PRINT2	<CRLF>		;TERMINATE THE LINE
2$:	MOV	(SP)+,PTR	;RECOVER THE POINTER CONTENTS
1$:	POPJ			;RETURN TO THE CALLER
	.ENDC
	.SBTTL	ROUTINE: EVAL - EVALUATE AN EXPRESSION

;'EVAL'

	.GLOBL	FNTABL		;FUNCTION LIST
;
;EVALUATE AN EXPRESSION

ETERM:	MOVB	CHAR,R5		;COPY THIS OP.
	CMPB	CHAR,#211	;THISOP=RPAR?
	BLO	ETERM2		;NO
	CLR	R5		;YES, SET THISOP=ZERO
ETERM2:	CMPB	R5,@SP		;COMPARE TWO OPERATORS
	BHI	EPAR		;LAST>THIS?-YES STACK AND CONTINUE
	MOVB	(SP)+,TEMP	;SET LEFT HALF TO ONES OR STOP IF ZERO
	MOV	TEMP,AC		;COPY THE OP CODE.
	BEQ	EPURE		;END OF JOB?-YES, JUST GO LEAVE RESULTS
	FPMP	FGET+FROM+STACK	;NO, USE ITEM ON TOP OF STACK.
	CLOSE			;REMOVE THE ITEM
	ASLB	AC		;MOVE OPERATOR CODE INTO POSITION
	ASLB	AC		;...
	ASLB	AC		;...
	BIC	#-100,AC	;MAKE POSITIVE.
EPURE:	ADD	#FGET+IPTR,AC	;LOAD BASE BINARY PLUS ADDRESSING MODE.
	FPMP	FCODE		;EXECUTE THE AC!
	MOV	#FLARG,PTR	;POINT AT THE SAVE AREA
	FPMP	FPUT+IPTR	;PLACE IT THERE
	ADD	R5,TEMP		;CHECK THISOP-LASTOP
	BNE	ETERM2		;GO COMPARE PRIORITIES.
	POPJ			;EXIT
				;
EPAR:	CMPB	R5,#206		;CHECK FOR
	BGE	EPAR2		;LEFT PAREN.?-YES,
	MOV	6(PTR),-(SP)	;SAVE VALUE
	MOV	4(PTR),-(SP)	;ALL OF IT
	MOV	2(PTR),-(SP)	;4 WORDS IN CASE DOUBLE PRECISION NEEDED
	MOV	@PTR,-(SP)	;LAST OF THEM....
	MOV	R5,-(SP)	;UPDATE LASTOP
ARGNXT:	JSR	R5,SPNXT	;OUGHT TO BE AN ARGUMENT HERE
	BPL	EVALP2		;TEST FOR THE TYPE
ELPAR:	SKPLPR	OPERR		;ILLEGAL TO STAR AN EXPRESSION
				;WITH RIGHT PARENS.
EPAR2:	MOV	CHAR,-(SP)	;SAVE THE LP CODE AND COMPUTE THE
	MOV	#EFUN3,-(SP)	;LOAD TRANSFER FOR "POPJ" AT "EXIT"
EVALM2:	GETC			;MOVE ONTO NEXT CHARACTER (ENTRY POINT #2)
EVAL:	CLR	-(SP)		;SET LASTOP=0 (ENTRY POINT #1)
EVALP2:	TESTC			;TEST CHARACTER TYPE:
	ETERM1			;COULD BE A UNARY OPERATOR
	ENUM			;OR A NUMBER,
	EFUN			;OR A FUNCTION,
	CMPB	CHAR,#'@	;OCTAL CONSTANT? (** NEW **)
	BEQ	OCTVAL		;YES - HANDLE AS AN OCTAL VALUE
	JSR	PC,GETVAR	;OR A VARIABLE
OPNEXT:	SPNOR			;IGNORE SPACES AROUND OPERATORS (O'D)
	BMI	ETERMN		;IF NEGATIVE, THEN IT IS A LEGIT. TERM.
	BR	OPERR		;OTHERWISE IT IS ILLEGAL FORMAT.
				;

ETERM1:	MOV	#FLTZER,PTR	;ASSUME PRESENT VALUE OF ZERO.
	CMPB	CHAR,#202	;MINUS?
	BEQ	ETERM		;YES, GO PROCESS IT
	BLO	ARGNXT		;PLUS?-YES, IGNORE IT
	CMPB	CHAR,#211	;SOME TYPE OF RIGHT TERMINATOR?
	BLO	ELPAR		;NO, GO TEST FOR LEFT PARENTHESIS SPECIAL CASE
ETERMN:	SKPLPR	ETERM		;LEFT PAREN? - NO, CONTINUE TO PROCESS
OPERR:	ERROR+201+8.+8.		;MISSING OR DOUBLE OPERATOR ERROR
				;
OCTEND:	FPMP	FLOAT		;FLOAT THE VALUE
	BR	ENUM2		;NORMALIZE AND CONTINUE
;
ENUM:	MOVB	#NALPHA,SWITCH	;USE INTERNAL DATA AND ACCEPT ALPHA DATA
	FREAD			;READ IN A NUMBER.
ENUM2:	MOV	#FLARG,PTR	;POINT AT THE HOLDING AREA
	FPMP	FPUT+IPTR	;SAVE THE VALUE
	BR	OPNEXT		;GO GET OPERATOR
				;
EFUN:	CLR	R5		;OLD "EFOP"
EFUNP2:	ASL	R5		;HASH CODE
	ROL	R5		;...
	ADD	CHAR,R5		;...
	GETC			;READ THE MNEMONIC LETTERS
	BPL	EFUNP2		;REPEAT UNLESS TERMINATOR FOUND
	MOV	CHAR,-(SP)	;SAVE LAST CHARACTER:PAREN.
	MOV	R5,-(SP)	;SAVE HASH CODE
	EVAL.X			;PROCESS FIRST ARGUMENT
	MOV	(SP)+,R5	;GET BACK "EFOP"
	MOV	#FNTABL,AC	;INIT THE SEARCH.
1$:	TST	-(AC)		;TEST FOR END.
	BEQ	VERR		;NO SUCH FUNCTION
	CMP	-(AC),R5	;TEST FOR MATCH
	BNE	1$		;REPEAT IF NOT FOUND.
	JSR	PC,@-(AC)	;CALL THE FUNCTION.
EFUN3:	PARTST			;CHECK CLOSING PARENS
	BR	ENUM2		;GO SAVE RESULTS AND SET POINTER.

EVALUX:	MOV	R5,-(SP)	;SAVE R5 IN CASE IN A CALL
	JSR	PC,EVALM2	;CALL IT
	MOV	(SP)+,R5	;RESTORE THE RETURN ADDRESS
	RTS	R5		;RETURN


;
;---	OCTVAL - ROUTINE TO READ AN OCTAL CONSTANT
;
OCTVAL:	CLR	AC		;RESET ACCUMULATOR
1$:	GETC			;GET A CHARACTER
	TESTC			;VECTOR ON CHARACTER TYPE
	OCTEND			;TERMINATOR MEANS THE END
	2$			;CONTINUE IF NUMERIC
	OPERR			;ALPHA IS AN ERROR
	BR	OPERR		;EITHER F OR ANY OTHER ONE...
;
2$:	ASL	AC		;*2
	ASL	AC		;*4
	ASL	AC		;*8
	SUB	#'0,CHAR	;GET OFFSET FROM "0"
	CMP	CHAR,#7		;SEE IF WITHIN REASON
	BHI	OPERR		;8 AND 9 ARE ERRORS ALSO
	ADD	CHAR,AC		;CONSTRUCT THE VALUE
	BR	1$		;CONTINUE UNTIL WE RUN OUT OF NUMBERS
	.IFDF	$PAPER		;PAPER-TAPE VERSION ONLY!
	.SBTTL	GETVAR - SYMBOL TABLE ROUTINE
;'GETVAR'

;FIND OR CREATE A VARIABLE

VERR:	ERROR+201+2.+2.		;ILLEGAL VARIABLE OR FUNCTION NAME.
PERR:	ERROR+201+3.+3.		;PAREN MISMATCH ERROR
GETARG:	TESTC			;CHECK CAREFULLY
	FINERR			;TERMINATOR IS NOT A VARIABLE.
	VERR			;N
	VERR			;F=? PTR=HOLE
GETVAR:	CMPB	CHAR,#'&	;SPECIAL VARIABLE?
	BEQ	WHIPV2		;YES - CONTINUE
	MOV	#100000,-(SP)	;CLEAR NAME SPACE ON STACK TO "SPACE".
	MOVB	CHAR,@SP	;SAVE FIRST LETTER OF NAME IN STACK
	CLR	-(SP)		;CLEAR SUBSCRIPT SPACE ON STACK
	GETC			;READ AND TRACE NEXT CHARACTER
	BMI	GSERCH		;TEST FOR TERMINATOR
	MOVB	CHAR,3(SP)	;SAVE SECOND LETTER OF NAME
1$:	GETC			;IGNORE UNTIL TERMINATOR FOUND.
	BPL	1$		;---
GSERCH:	SKPLPR	GS1		;CHECK FOR SUBSCRIPT
	MOV	CHAR,-(SP)	;SAVE LEFT PARENS. CODE.
	EVAL.X			;EVALUATE THE SUBSCRIPT AND
	FPMP	FINT		;CORRECT IT TO AN INTEGER
	MOV	AC,2(SP)	;SAVE SUBSCRIPT ON STACK
	CMPB	CHAR,#214	;COMMA?
	BNE	GS0		;SKIP IF ONLY ONE SUBSCRIPT.
	EVAL.X			;GO READ THE SECOND SUBSCRIPT.
	FPMP	FINT		;CONVERT IT TO 0-256.
	MOVB	AC,3(SP)	;COPY 2AND INTO LEFT HALF.
GS0:	PARTST			;CHECK FOR CLOSING PARENS MATCH.
	BR	GS1

;WHIP UP A VARIABLE &
;
	.GLOBL	WHIPV
;
WHIPV2:	GETC			;FLUSH CHARACTERS
	BPL	WHIPV2		;CONTINUE UNTIL A TERMINATOR IS FOUND
;
WHIPV:	MOV	#ANPRSN,PTR	;POINT AT SPECIAL SYMBOL
	POPJ			;EXIT
;
ANPRSN:	.WORD	0,0,0,0		;"&" VARIABLE

;STACK NOW CONTAINS:
;*SUBS*   (SP)
;*NAME*   2(SP)

GS1:	MOV	STARTV,TEMP	;GET TEMPORARY POINTER (UPPER LIMIT)
	MOV	BOTTOM,R5	;GET END OF "AREA".
	MOV	TEMP,AC		;COPY THE STOP VALUE (LOWER LIMIT)
	CMP	-(R5),-(R5)	;BE SURE LAST ENTRY DOES NOT PASS (BOTTOM).
	SUB	R5,AC		;COMPUTE TABLE LENGTH NEGATED.
	MOV	@SP,PTR		;COPY SUBSCRIPT
	ADD	2(SP),PTR	;COMBINE LETTERS PLUS SUBSCRIPT
	SWAB	PTR		;MAKE LAST CODES FIRST!
				;TAKE RESULT MODULO THE SIZE OF
	BIC	AC,PTR		;THE SYMBOL TABLE
	BIC	#7,PTR		;MUST BE DIVISABLE BY EIGHT
	TST	#$DBL		;DOUBLE PRECISION?
	BEQ	1$		;NO - SKIP 3/4 CORRECTION
	ASR	PTR		;WE MUST MAKE PTR DIVISABLE
	BIC	#7,PTR		; BY 12 FOR DOUBLE PRECISION
	MOV	PTR,-(SP)	;SAVE CURRENT SETTING
	ASR	PTR		;DIVIDE AGAIN
	ADD	(SP)+,PTR	;RESULT IS 3/4 OF HASH CODE
1$:	TSTB	PRM1		;STANDARD?
	BEQ	2$		;YES - SKIP IT!
	CLR	PTR		;MAKE SEQUENTIAL
2$:
;CHANGE PRM1 FROM 0 TO 1 FOR A CHRONOLOGICAL TABLE.


;TEMP=START
;AC=LENGTH
;R5=LOWER LIMIT
;PTR=HASH CODE
;SEARCH VARIABLES FOR MATCH OR AN UNUSED SPACE

	ADD	TEMP,PTR	;INITIALIZE POINTER "PTR"
	MOV	PTR,AC		;SAVE THIS VALUE

;'TEMP'	 POINTS TO UPPER LIMIT
;'AC'	 HOLDS HASH-CODE ADDRESS
;'PTR'	 SCANS THE STORAGE
;'AXOUT' POINTS TO NEXT CHARACTER
;'CHAR'	 HOLDS LAST TERMINATOR
;'R5'	 HOLDS THE SCAN LOWER LIMIT

	JSR	R5,GTRY		;SEARCH LOWER HALF
	MOV	TEMP,PTR	;BEGIN AT THE TOP;
	MOV	AC,R5		;END VALUE RESTARTED.
	JSR	R5,GTRY		;SEARCH UPPER HALF

;SEARCH FOR A ZERO-VALUE VARIABLE AND SCRATCH IT

	MOV	BOTTOM,-(SP)	;END AT THE BOTTOM
	MOV	TEMP,PTR	;BEGIN AT THE TOP
GSWIP:	TST	4(PTR)		;ZERO?
	BEQ	GTAKE		;YES!
	TST	#$DBL		;DOUBLE PRECISION?
	BEQ	1$		;NO
	ADD	#4,PTR		;ADDITIONAL SIZE
1$:	ADD	#10,PTR		;BUMP.
	CMP	PTR,@SP		;END?
	BLO	GSWIP		;NOT YET!
	ERROR+201+11.+11.	;JUST NO ROOM AT ALL!


;VARIABLE STORAGE:

;NAME:		(B,A)
;SUBSCRIPT:	(16) OR (8,8) : (2,1)
;LORD,EXP:	(FINAL VALUE OF PTR POINTS TO THIS LOCATION.)
;HORD:		(IF ZERO THEN ALL THESE PARTS ARE ASSUMED ZERO)
	.SBTTL	ROUTINE: ERASEV - ERASE VARIABLES


;"ERASEV"

ERVX:	MOV	BOTTOM,AC	;CLEAR UP FROM THE BOTTOM
1$:	CLR	-(AC)		;CLEAR A WORD
	CMP	AC,BUFR		;TEST FOR END OF VARIABLE AREA
	BLOS	2$		;USE LARGER OF (AXIN) OR (BUFR)
	CMP	AC,AXIN
	BHI	1$
2$:	ADD	#80.,AC
	MOV	AC,STARTV
	RTS	R5

;GTRY

;SCAN FOR A MATCH OR A VOID.

;CALLED BY JSR	R5,GTRY
;STACK CONTAINS
;*LOWER LIMIT*	0(SP)
;*SUBS*  2(SP)
;*NAME*  4(SP)
;*OLD PC*6(SP)
;PTR CONTAINS START OF VARIABLE STORE

GTRY:	CMP	4(SP),@PTR	;COMPARE TRUE NAME.
	BEQ	GTEST		;GO TEST SUBSCRIPT
	TST	@PTR		;LOOK FOR NULL
GTRY2:	BEQ	GTAKE		;GO SWIPE IT!
	TST	#$DBL		;DOUBLE PRECISION?
	BEQ	1$		;NO - SKIP
	ADD	#4,PTR		;ADJUST BUMP FACTOR
1$:	ADD	#10,PTR		;MOVE POINTER
	CMP	PTR,@SP		;TEST LIMIT
	BLO	GTRY		;REPEAT!
	RTS	R5		;NOT IN THAT AREA, RETURN.
				;
GTEST:	CMP	2(SP),2(PTR)	;TEST SUBSCRIPT
	BR	GTRY2		;TRY AGAIN
				;
GTAKE:	MOV	4(SP),(PTR)+	;SAVE NAME
	MOV	2(SP),(PTR)+	;SAVE SUBSCRIPT
				;LEAVE PTR AS POINTER
	ADD	#6,SP		;FLUSH STACK DATA
	POPJ			;RETURN FROM THE "GETVAR" ROUTINE.



;"PARTST"

;BE SURE PRESENT CHARACTER IS MATE TO PARENS IN THE STACK

PARTSA:	TST	(SP)+		;DUMP OLD 'R5'
	ADD	#3,@SP		;COMPUTE MATCHING PARENS
	CMPB	CHAR,(SP)+	;COMPARE THE ACTUAL WITH COMPUTED.
	BNE	1$		;GO CALL "ERROR" IF THEY DON'T MATCH
	GETC			;MOVE ON TO THE NEXT CHARACTER
	JMP	@R5		;RETURN TO THE SEQUENCE
;
1$:	ERROR+3.+3.		;PARENTHESIS MIS-MATCH
	.ENDC
	.IFDF	$RT11
	.SBTTL	ROUTINE: GETVAR - FIND OR CREATE A VARIABLE
;
;---	RT-11 SYMBOL TABLE STRUCTURE IS VERY DIFFERENT FROM ITS PAPER-
;	TAPE COUNTERPART. THE PAPER-TAPE VERSION ASSUMES THAT MOST
;	OF THE REMAINING CORE AFTER THE TEXT HAS BEEN INSERTED
;	MAY BE USED FOR SYMBOL STORAGE.
;
;	IN RT-11 THOUGH, THE FREE CORE AREA IS VERY DYNAMIC IN NATURE,
;	AS DEVICE HANDLERS AND BUFFERS MUST BE USED DURING EXECUTION,
;	AS WELL AS THE FACT THAT THE TEXT MAY CHANGE DURING
;	EXECUTION VIA THE LIBRARY COMMAND AND THE OPERATE COMMAND.
;
;	FOR THESE REASONS, A HASHING TECHNIQUE IS DEFINITELY OUT.
;	FOR SPEED OF EXECUTION, IT WAS DECIDED TO MAINTAIN AN ALPHABETICALLY
;	SORTED VARIABLE TABLE PUSHED TO THE HIGH (ADDRESS WISE) END OF
;	CORE. AS THE SYMBOL TABLE EXPANDS AND CONTRACTS, IT DOES SO
;	ON THE LOW ADDRESS END. "STARTV" IS THEN THE ONLY REAL
;	CONSTANT IN THE SYSTEM WHICH MUST BE MODIFIED.
;
;	TO FACILITATE WITH SYMBOL SEARCHES, A TABLE CALLED "SINDEX"
;	HAS BEEN PROVIDED. THIS TABLE IS 26 WORDS LONG AND IS
;	USED AS AN INDEXED OFFSET TABLE TO THE FIRST SYMBOL IN THE
;	TABLE HAVING THE FIRST LETTER CORRESPONDING TO THE ENTRY (A-Z)
;
;	THE ENTIRE SYMBOL TABLE THEN CAN BE MOVED, WITH ONLY "STARTV" AND
;	"BOTTOM" BEING ALTERED, AS THE ENTRIES IN "SINDEX" ARE OF A
;	BYTE OFFSET FROM THE CONTENTS OF "STARTV" IN NATURE.
;
;	TO INSERT A SYMBOL, SIMPLY POINT TO THE START OF THE
;	GROUP OF VARIABLES STARTING WITH THE SAME LETTER. SEARCH
;	FROM THAT POINT ON UNTIL EITHER A MATCH OCCURS, OR THE
;	TABLE ENTRY IS HIGHER IN VALUE THAN THE VARIABLE CODE BEING
;	SEARCHED FOR. IF THE FIRST CASE IS ENCOUNTERED, WE ARE GOLDEN,
;	AS THE PROCESS IS AS BEFORE... (I.E. JUST USE IT)...
;	IF, HOWEVER, THE LATTER IS THE CASE, THEN WE MUST DO THREE 
;	DISTINCT STEPS.
;
;	1.	MOVE THE PORTION OF THE SYMBOL TABLE IN FRONT OF THE
;		VARIABLE UNDER SCAN LOWER IN CORE BY THE LENGTH OF
;		ONE ENTRY. UPDATE "STARTV" TO REFLECT THIS.
;
;	2.	INSERT THE VARIABLE ENTRY IN FRONT OF THE VARIABLE
;		UNDER SCAN.
;
;	3.	FOR ALL OF THE ENTRIES IN "SINDEX" BEYOND THE ENTRY USED
;		TO GET TO THE SYMBOL TABLE, ADD THE LENGTH OF THE SYMBOL
;		TABLE ENTRY JUST ADDED. THIS WILL CORRECT THE OFFSETS
;		FOR THE RESPECTIVE ENTRIES.
;
;	IN ORDER TO ERASE ALL OF THE VARIABLES, SIMPLY SET "STARTV"
;	EQUAL TO "BOTTOM" AND CLEAR THE 26 ENTRIES OF "SINDEX" TO 0.
;
;
;---	GETARG - FIND OR CREATE A VARIABLE
;
VERR:	ERROR+201+2.+2.
;
GETARG:	TESTC			;TRANSLATE ON FIRST CHARACTER
	FINERR			;TERMINATOR IS AN ERROR
	VERR			;NUMERI IS NOT WHAT WE WANT
	VERR			;FUNCTION CALL IS INCORRECT ALSO
;
;---	HERE WE ARE SURE WE HAVE A LETTER IN "CHAR"
;
GETVAR:	CMP	CHAR,#'&	;AN &????
	BEQ	WHIPV2		;HANDLE THE SPECIAL CHARACTER

	JSR	PC,GETNAM	;GET THE NAME
	JMP	GS1		;SCAN FOR IT AND SET UP
;
;---	GETNAM - ROUTINE TO CONSTRUCT NAME, SUBSCRIPT, ETC AND LEAVE IT ON STACK
;
GETNAM:	MOV	(SP)+,AC	;GET THE RETURN ADDRESS
	MOV	CHAR,PTR	;GET FIRST CHARACTER
	SWAB	CHAR		;MOVE TO HIGH BITS
	MOV	CHAR,-(SP)	;SAVE IT
	SUB	#'A,PTR		;GET DISTANCE FROM THE LETTER "A"
	BMI	VERR		;ERROR IF OUTSIDE OUR RANGE...
	CMP	PTR,#25.	;SEE IF OUTSIDE THE OTHER WAY..
	BGT	VERR		;YES - KILL HIM!
	ASL	PTR		;*2 FOR WORD IN SINDEX HOLDING OFFSET VALUE
	CLR	-(SP)		;SET UP DUMMY ARRAY SUBSCRIPT
	MOV	AC,-(SP)	;RESTORE THE RETURN ADDRESS FOR LATER
	MOV	PTR,-(SP)	;SAVE THE POINTER
;
;---	SUBSCRIPT ENHANCEMENT FEATURE
;
;	ENABLED BY:	"X FPRM(1,1)"	;SET PARAMETER 1
;	DISABLED BY:	"X FPRM(1,0)"	;RESET PARETER 1
;
;	NORMALLY, FOCAL HANDLES A SCALAR VARIABLE AS THE VARIABLE
;	WITH ARRAY SUBSCRIPT OF ZERO.  THIS WAS CONVENIENT, AS IN USING
;	A HASH CODE TO STORE THE VARIABLES, THE ENTRY SIZE HAD TO BE
;	THE SAME SIZE.
;
;	IN RT-11 FOCAL THOUGH, WE ARE ABLE TO SUPPORT EITHER THE OLD
;	PAPER-TAPE MODE, OR A MODE SIMILAR TO BASIC. WITH THIS NEW MODE,
;	THE VARIABLE: "A" IS DIFFERENT FROM THE VARIABLE "A(0)" AND
;	AGAIN DIFFERENT FROM "A(0,0)". IN THE PAPER-TAPE MODE, THE ABOVE
;	THREE VARIABLES ARE THE EQUIVALENT.
;
;	AFTER SETTING OR RESETTING THE MODE, AN "ERASE" MUST BE
;	PERFORMED. IF THIS IS NOT DONE,UNPREDICTABLE RESULTS
;	WILL BE OBTAINED.
;
	GETC			;EXTRACT THE NEXT CHARACTER
	BMI	2$		;IF A TERMINATOR, THE NAME PART IS DONE
	MOVB	CHAR,6(SP)	;SET SECOND CHARACTER INTO THE NAME
1$:	GETC			;NOW FLUSH ANY EXCESS NAME CHARACTERS
	BPL	1$		;A REAL HARD LOOP
;
;---	CHAR IS HOLDING THE TERMINATING CHARACTER
;
2$:	SKPLPR	7$		;IF NOT SUBSCRIPTED, SKIP TO GS1
	BIS	#100000,6(SP)	;SET SUBSCRIPTED VARIABLE
	MOV	CHAR,-(SP)	;SAVE THE CODE FOR L.P.
	EVAL.X			;GET SUBSCRIPT NUMBER
	FPMP	FINT		;MAKE IT AN INTEGER
	MOV	AC,6(SP)	;PASS ENTIRE WORD IN CASE SINGLE SUBSCRIPT
3$:	CMPB	CHAR,#214	;COMMA? (DOUBLE SUBSCRIPT)
	BNE	5$		;NO - VERIFY THAT IT IS A R.P.
	TSTB	PRM1		;IS THE PARAMETER FOR UNIQUE VARS SET?
	BEQ	4$		;NO -SKIP THE SYMBOL MODIFICATION
	BIS	#200,8.(SP)	;SET THE SYMBOL BIT
;
;---	IN ORDER TO CONSERVE SPACE, THE SYMBOL TABLE HAS BEEN ALTERED
;	IN ANOTHER WAY. IF THE VARIABLE IS NON-SUBSCRIPTED, AND, IF
;	IN NORMAL MODE THE SUBSCRIPT EXPRESSION IS ZERO, THEN NO WORD
;	IS ALLOCATED FOR A SUBSCRIPT BY THE SYMBOL TABLE ROUTINES.
;
;	THIS IS NOTED BY BIT 15 IN THE VARIABLE NAME WORD BEING CLEARED.
;
;	SINCE ONLY LETTERS AND NUMBERS ARE ALLOWED IN A VARIABLE NAME, NO
;	200 BIT FROM THE TERMINATOR SCAN CAN BE SET. THEREFORE, IF BIT
;	15 IS SET, THEN THE NEXT WORD IS A SUBSCRIPT EXPRESSION.
;	BIT 7 IS USED TO DISTINGUISH A SINGLE SUBSCRIPT FROM A DOUBLE
;	SUBSCRIPTED VARIABLE IN THE EXTENDED MODE (PRM1 SET).
;
4$:	EVAL.X			;GET THE SECOND SUBSCRIPT
	FPMP	FINT		;INTEGERIZE IT
	MOVB	AC,7(SP)	;SAVE THE OTHER PART OF IT
5$:	TST	6(SP)		;SEE IF SUBSCRIPT IS ZERO
	BNE	6$		;SKIP IF NOT...
	TSTB	PRM1		;EXTENDED SYMBOL TABLE MODE?
	BNE	6$		;YES - DON'T CONFUSE THE ISSUE
	BIC	#100200,8.(SP)	;FIX THE NAME TO REFLECT NO SUBSCRIPT
6$:	PARTST			;PERFORM A PARENTHESIS MATCH TEST
7$:	MOV	(SP)+,PTR	;RESTORE THE PTR VALUE
	POPJ			;CONTINUE NOW AND SCAN FOR SYMBOL
;
;---	WHIPV - ROUTINE TO FUDGE AN "&" VARIABLE
;
	.GLOBL	WHIPV
WHIPV2:	GETC			;GET CHARACTERS (SKIP UNTIL TERM.)

	BPL	WHIPV2		;LOOP BACK...

WHIPV:	MOV	#ANPRSN,PTR	;POINT AT AREA

	POPJ			;RETURN TO THE CALLER

;

;---	ANPRSN - THIS IS THE TEMP STORAGE FOR FSUBR FUNCTIONS

;

ANPRSN:	.WORD	0,0		;VALUE STORAGE

	.WORD	0,0		;AS DOUBLE PRECISION IF NEED BE
;

;
;---	GS1 - THIS IS WHERE THE SEARCH COMMENCES!!!!!
;
GS1:	JSR	PC,VCHECK	;CHECK ON VIRTUAL FILE INFO
	DEC	AXOUT		;SAVE CHAR
	MOV	PTR,TEMP	;SAVE POINTER INTO SINDEX
	MOV	SINDEX+2(PTR),AC ;GET NEXT POINTER
	ADD	STARTV,AC	;POINT AT THE END
	MOV	SINDEX(PTR),PTR	;GET OFFSET VALUE
	ADD	STARTV,PTR	;PTR NOW POINTS TO THE SYMBOL ENTRY
	MOV	2(SP),CHAR	;GET THE NAME NOW
	CMP	PTR,AC		;ANY IN THIS SECTION?
	BHIS	4$		;ADD TO THE LIST IF SO...
1$:	CMP	CHAR,@PTR	;SEE IF THE IS THE VARIABLE
	BNE	2$		;IF NOT THERE YET, ADVANCE ON THE CRITTER!
	TST	@PTR		;SUBSCRIPTED VARIABLE?
	BPL	11$		;NO - MATCH IS OK!
	CMP	@SP,2(PTR)	;SEE IF THE SAME SUBSCRIPT..
	BLO	4$		;INSERT IT
	BEQ	12$		;IF EQUAL, THEN USE IT... ELSE:
;
;---	CONTINUE THE SCAN...
;
2$:	CMP	PTR,AC		;END YET?
	BHIS	4$		;YES - INSERT IT HERE
	TST	(PTR)+		;SEE IF SUBSCRIPTED
	BPL	3$		;NO - SKIP THE POINTER UPDATE
	ADD	#2,PTR		;SKIP THE SUBSCRIPT
3$:	ADD	#4,PTR		;SKIP THE VALUE FOR NOW
	TST	#$DBL		;SEE IF IN DOUBLE PRECISION MODE
	BEQ	1$		;NO - SKIP OFFSET UPDATE
	ADD	#4,PTR		;OVER THE REST OF IT
	BR	1$		;CONTINUE... UNLESS OFF THE END OF THE TABLE..
;
;---	HERE WE EXTEND THE SYMBOL TABLE. PTR IS POINTING TO THE ENTRY
;	TO FOLLOW THE CREATED ONE..
;
4$:	TSTB	NVSW		;CREATE NEW VARIABLES?
	BEQ	13$		;NO - SIMPLY USE A VALUE OF ZERO
	MOV	#6,AC		;GET MIN (UNSUBSCRIPTED) LENGTH
	TST	#$DBL		;SEE IF DOUBLE PRECISION
	BEQ	14$		;NO - SKIP UPDATE
	MOV	#10.,AC		;GET MIN (UNSUBSCRIPTED) LENGTH
14$:	TST	CHAR		;SEE IF A SUBSCRIPTED VARIABLE
	BPL	5$		;NO - SKIP SIZE UPDATE
	TST	(AC)+		;ADD ANOTHER 2
5$:	ADD	#SINDEX+2,TEMP	;POINT AT OUR SLOT
	MOV	STARTV,-(SP)	;SEE IF WE ARE GOING TO INTERFERE WITH TEXT!
	SUB	AC,@SP		;BACK OFF WHERE WE WERE
	SUB	#4,@SP		;GIVE US SOME BREATHING ROOM
	CMP	@SP,BUFR	;SEE IF WE ARE AT AN END!
	BLOS	ENDMEM		;HANDLE END OF MEMORY
	CMP	(SP)+,AXIN	;OR HERE EITHER
	BLOS	ENDMEM
	MOV	#SINDEX+54.,CHAR ;SET LIMIT
	.MFPS	KIN		;SAVE PRIORITY
	MOV	#200,-(SP)	;SET PRIORITY 4 (NO ^C  !!)
	MOV	#6$,-(SP)
	RTI
6$:	ADD	AC,(TEMP)+	;UPDATE THE RELATIVE POSITION
	CMP	TEMP,CHAR	;SEE IF THROUGH...
	BLO	6$		;CONTINUE TO DO OUR DUTY
7$:	MOV	STARTV,TEMP	;POINT AT THE TRUE START
	NEG	AC		;FUNNY SUBTRACT
	ADD	TEMP,AC		;BECUSE WE HAVE TO ADD (COMMUTATIVE OPERATION)
	MOV	AC,STARTV	;SET INTO CORE
8$:	MOV	(TEMP)+,(AC)+	;MOVE THE SYMBOL TABLE IN FRONT LOWER IN CORE
	CMP	TEMP,PTR	;ARE WE AT THE END OF THE MOVE YET?
	BLO	8$		;PUSH IT...
	CLR	-(PTR)		;SET ZERO VARIABLE
	CLR	-(PTR)		;BOTH WORDS OF IT...
	TST	#$DBL		;SEE IF DOUBLE PRECISION
	BEQ	15$		;NO - SKIP POINTER MODIFICATION
	CLR	-(PTR)		;DOUBLE PRECISION NEEDS 4 WORDS...
	CLR	-(PTR)		;ALL THROUGH...
15$:	MOV	(SP),-(PTR)	;PASS THE SUBSCRIPT
	TST	2(SP)		;SEE IF MARKED WITH A SUBSCRIPT...
	BMI	10$		;NO - FORGET THIS ONE!
9$:	TST	(PTR)+		;RESET THE POINTER
10$:	MOV	2(SP),-(PTR)	;PASS THE VARIABLE NAME
	BPL	11$		;IF NO SUBSCRIPT, UPDATE BY 2 ONLY..
12$:	TST	(PTR)+		;POINT BEYOND SUBSCRIPT ALSO
11$:	TST	(PTR)+		;POINT AT VALUE
	MOV	KIN,-(SP)	;RESET THE PRIORITY
	MOV	#16$,-(SP)
	RTI
16$:	CMP	(SP)+,(SP)+	;POP 2 WORDS OFF THE STACK
	MOVB	(AXOUT)+,CHAR	;RECOVER CHAR
	POPJ			;RETURN TO CALLER
;
13$:	MOV	#FLTZER,PTR	;POINT AT A ZERO
	BR	16$		;EXIT
;
ENDMEM:	ERROR+201+11.+11.	;INSUFFICIENT ROOM FOR VARIABLES
	.SBTTL	ROUTINE: ERASEV - ERASE VARIABLES
;
;---	ERASE VARIABLES BY SETTING STARTV EQUAL TO BOTTOM AND CLEARING
;	THE SINDEX TABLE
;
ERVX:	.MFPS	KIN		;SET FOR PSW SAVE
	MOV	#200,-(SP)
	MOV	#2$,-(SP)
	RTI
2$:	MOV	BOTTOM,STARTV
	CLR	@STARTV		;FORCE IT TO BE NULL
	MOV	#SINDEX,TEMP	;POINT TO SINDEX TABLE
	MOV	#27.,AC		;CLEAR OUT 27 WORDS
1$:	CLR	(TEMP)+		;SET TO 0 THE OFFSET
	DEC	AC		;COUNT OUT THE WORDS
	BGT	1$		;CONTINUE
	MOV	KIN,-(SP)	;RESTORE PRIORITY LEVEL
	MOV	#3$,-(SP)
	RTI
3$:	RTS	R5		;RETURN TO THE CALLER
;
;---	PARTST - PARENTESIS TEST
;
;	BE SURE THAT PRESENT CHARACTER IS MATE TO THE PARENS IN THE STACK
;
PARTSA:	ADD	#3,2(SP)	;COMPUTE MATCHING PARENTHESES
	CMPB	CHAR,2(SP)	;SEE IF CORRECT
	BNE	PERR		;NO - ERROR
	MOV	@SP,2(SP)	;COPY OLD R5
	TST	(SP)+		;POP THE STACK
	GETC			;GET THE NEXT CHARACTER
	RTS	R5		;RETURN TO THE CALLER
;
PERR:	ERROR+201+3.+3.		;MISMATCHED PARENS...
;
	.ENDC
	.SBTTL	FPRM - FOCAL PARAMETER FUNCTION

;
;---	FUNCTION FPRM - FOCAL PARAMETER FUNCTION
;
;	THIS FUNCTION SETS FOCAL PARAMETER SWITCHES. THERE ARE TWO
;	FORMS OF CALLS TO THE PARAMETER FUNCTION. THE FIRST IS
;	WITH A SINGLE ELEMENT. THIS WILL RETURN THE VALUE OF THE
;	PARAMETER TO THE USER. THE PARAMETER WILL NOT BE ALTERED.
;
;	THE SECOND FORM OF CALL IS WITH TWO ARGUEMENTS. THE OLD VALUE
;	OF THE PARAMETER WILL BE RETURNED, AND THE SECOND
;	ARGUEMENT WILL BE PLACED INTO THE PARAMETER.
;
;	S A=FPRM(<PARAM#> [,<PARAM VALUE>])
;
;	FPRM PARAMETERS
;
;	PARAM #		DEFAULT		FUNCTION
;	-------		-------		--------
;
;	   0		   0		DETERMINS THE TOP OF FOCAL.(RT-11 ONLY)
;					 0 - FULL AREA (USR SWAPPING)
;					 1 - TOP IS BELOW USR AREA
;					 2 - TOP IS BELOW USR & KMON AREA
;
;	   1		   0		EXTENDED SYMBOL TABLE (RT-11 ONLY)
;					 0 - NORMAL FOCAL SYMBOLS
;					 1 - "BASIC" TYPE SYMBOLS
;
;	   2		  255		TTY WIDTH FOR OUTPUT
;
;	   3		   0		SWITCH FOR ":" AND "=" IN TYPE/ASK
;					 0 - CHARACTERS ARE PRINTED
;					 1 - ":" ARE NOT PRINTED
;					 2 - "=" ARE NOT PRINTED
;					 3 - NEITHER ":" OR "=" ARE PRINTED
;
;	   4		   60		FOCAL INPUT EXPRESSIONS
;					 0 - INPUT OF "YES" IS VARIABLE YES
;					60 - INPUT OF "YES" IS CONSTANT 0YES
;					XX - THIS CHARACTER IS PREFIXED TO
;					     *ASK* INPUT.
;
;	   5		   0		EXTENDED DEBUG MODE (RT-11 ONLY!)
;					 0 - NORMAL MODE
;					 1 - LINE NOS. ARE PRINTED AS
;					     WELL AS VARIABLE CONTENTS.
;					     (USING CURRENT FORMAT)
;					-1 - SAME AS ABOVE BUT FORMAT IS %8.04
;
;	   6		   0		OUTPUT ROUNDING SWITCH
;					 0 - ROUNDING IS PERFORMED
;					 1 - ROUNDING IS INHIBITED
;
;
;	   7		   X		HOLDS CURRENT TERMINAL POSITION
;
;	   8		   1		SWITCH FOR LEADING ZEROS ON ITOA&OTOA
;					 0 - ONLY SIGNIFICANT DIGITS ARE OUTPUT
;					 1 - LEADING 0'S ARE OUTPUT
;					     USES 6 COLUMNS (FORMAT)
;
;	   9		   1		FLOATING POINT UNDERFLOW
;					 0 - SEND ERROR MESSAGE (?12)
;					 1 - IGNORE ERROR
;
;	  10		   0		SCIENTIFIC NOTATION SWITCH
;					 0 - USE STANDARD FLOATING POINT
;					     FORMAT
;					 1 - USE SCIENTIFIC NOTATION
;
;	  11		   0		TIME UNIT SWITCH FOR FQUE FUNCTION
;					 0 - TIME IS IN SECONDS
;					 1 - TIME IS IN CLOCK TICKS
;						(50 THS OR 60 THS OF A SECOND)
;
FPRM:	FPMP	FINT		;TAKE INTEGER PART
	CMP	AC,#MAXPRM	;WITHIN RANGE?
	BHI	1$		;NO - ERROR
	ADD	#PARAM,AC	;POINT TO ENTRY
	MOV	AC,-(SP)	;STACK IT
	MOVB	(AC),AC		;RECOVER PARAM VALUE
	MOV	AC,-(SP)	;SAVE THE VALUE
	CMPB	CHAR,#214	;COMMA? - MUST HAVE 2 PARAMETERS
	BNE	2$		;ERROR
	EVAL.X			;EVALUATE THE NEXT VALUE
	FPMP	FINT		;MAKE AN INTEGER ALSO
2$:	MOV	AC,TEMP		;SAVE THE VALUE TO BE OUTPUT
	MOV	(SP)+,AC	;GET OLD VALUE
	FPMP	FLOAT		;SET OLD VALUE
	MOVB	TEMP,@(SP)+	;PLACE INTO PARAMETER SLOT
	.IFDF	$RT11
	SCNM			;RESCAN MEMORY
	.ENDC
	RTS	PC		;RETURN FOR PAREN CHECK
1$:	ERROR+201+20.+20.	;ERROR - PARAM OUT OF RANGE
	.IFDF	$RT11
	.SBTTL	LIBR - RT-11 LIBRARY PROCESSOR
;
;---	THIS COMMAND PROCESSOR PERFORMS THE SYNTAX SCAN ON THE COMMAND
;	FROM A SET OF DRIVER TABLES. THE COMMAND TABLE IS USED
;	TO DETERMINE IF A GIVEN LIBRARY COMMAND IS LEGAL, AND WHAT
;	SETUP PROCESSING, IF ANY, IS REQUIRED. ALSO, PARAMETER
;	SPECIFICATIONS ARE DEFINED.
;
	.GLOBL	C.BUF,C.OFF,C.BLK,C.FIL
;

LIBR:	.MFPS	AC		;SAVE THE PSW
	MOV	#340,-(SP)	;SET PRI 7
	MOV	#5$,-(SP)
	RTI
5$:	TST	LIBSW		;IN LIBRARY COMMAND ALREADY?
	BEQ	.+4		;NO - SKIP ERROR
	ERROR+201+35.+35.	;SET ERROR FOR LIBRARY COMMAND
	INC	LIBSW		;SET LIBRARY SWITCH
	MOV	AC,-(SP)	;SET UP....
	MOV	#6$,-(SP)
	RTI
6$:	TESTC			;GET NEXT CHARACTER
	FINERR			;TERMINATOR IS AN ERROR
	ERRORC			;NUMERIC MEANS COMMAND SYNTAX ERROR
	.+2			;AN "F" IS STILL LEGAL
;
;---	CHAR HOLDS THE SUB-COMMAND CHARACTER
;
	MOV	#GSCHAN,L.CHAN	;SET DEFAULT CHANNEL

	MOV	#LIBCMD,AC	;POINT TO THE COMMAND TABLE
1$:	MOVB	@AC,TEMP	;EXTRACT THE BYTE
	BIC	#-200,TEMP	;USE ONLY 7 BITS
	CMP	CHAR,TEMP	;IS THIS THE COMMAND?
	BEQ	2$		;YES - EXECUTE IT!
	ADD	#4,AC		;POINT AT THE NEXT ONE
	TST	@AC		;IS THIS THE END?
	BNE	1$		;NO - KEEP LOOKING
	JMP	ERRORC		;THE END IS NEAR!!!!!!!
;
2$:	MOV	(AC)+,TEMP	;HOLD THE FIRST WORD FOR SWITCHES
	MOV	(AC),-(SP)	;STACK THE ROUTINE ADDRESS FOR CALL
	MOV	TEMP,-(SP)	;SET SWITCHES
3$:	GETC			;FLUSH THE CHARACTERS
	BPL	3$		;KEEP FLUSHING.....
;
;---	SEE IF FILE NUMBER IS REQUIRED
;
	ROL	(SP)		;GET LEFT BIT...
	BCC	LIB.1		;NO - SKIP THE FILE NUMBER
	SORTC	TLIST+1,4$	;IF TERMINATOR, CONTINUE AND SKIP
	EVAL.X			;GET THE VALUE
	FPMP	FINT		;MAKE IT AN INTEGER
	CMP	AC,#MAXCHN	;SEE IF A LEGAL FILE NUMBER
	BLO	.+4		;YES - CONTINUE
4$:	ERROR+201+29.+29.	;FILE # OUT OF RANGE
	MOV	AC,L.CHAN	;SAVE THE CHANNEL NUMBER
	SORTC	TLIST+1,LIB.1	;SEE IF A TERMINATOR
	GETC			;SKIP COMMA IF NOT!
;
;---	SEE IF WE HAVE TOGET A DATASET SPEC
;
LIB.1:	ROL	(SP)		;IS A DATASET REQUIRED?
	BCC	LIB.2		;NO - SKIP  IT...
	SORTC	TLIST+1,5$	;IF A TERMINATOR (; OR CR) ERROR
	GCHAN			;POINT TO THE CHANNEL ENTRY
	TSTB	@TEMP		;OPENED?
	BNE	6$		;YES - ERROR
	MOV	#L.NAME,PTR	;POINT AT THE NAME FIELD
	TSTB	CHAR		;CHECK ON CURRENT CHARACTER
	BPL	2$		;USE IT IF OK...
1$:	GETC			;SEE WHAT WE HAVE HERE...
	BPL	2$
	SORTC	TLIST-1,4$	;SEE IF DONE
	CMPB	CHAR,#203	;A SLASH? (/)
	BEQ	4$		;HANDLE LIKE A TERMINATOR
	MOVB	TERMS+200(CHAR),CHAR ;GET THE CORRECT CHAR
2$:
	.IFNDF	$SMALL
	CMPB	CHAR,#''	;QUOTE IN FILE NAME?
	BEQ	3$		;YES - ENTER EXPRESION VALUE
	.ENDC
	MOVB	CHAR,(PTR)+	;OUTPUT THE CHARACTER
	BR	1$		;RETURN FOR ANOTHER CHARACTER
	.IFNDF	$SMALL
3$:	JSR	PC,L.QUOT	;HANDLE QUOTE DETERMINATION
	BR	1$		;CONTINUE ALONG LIKE NOTHING HAPPENED
	.ENDC
4$:	MOVB	#'=,(PTR)+	;SET FINAL DELIMITER
	CLRB	(PTR)		;END OF FILE SPEC
	SPNOR			;IGNORE TRAILING SPACES
	MOV	SP,AC		;POINT AT CORRECT STACK ADDRESS
	.CSISPC	#L.CSIT,#L.DFLT,#L.NAME ;DECODE THE NAME FIELD
	BCC	7$		;SKIP ERROR
5$:	ERROR+201+31.+31.	;FILE NAME IN ERROR FOR LIBRARY COMMAND.
6$:	ERROR+201+37.+37.	;FILE ALREADY OPENED
7$:	MOV	AC,SP		;POINT AT CORRECT STACK AREA
	MOV	#L.CSIT,PTR	;POINT AT THE NAME FOR THE DEVICE
	GETHAN			;GET THE HANDLER INTO CORE
 	MOV	L.CHAN,IDENT	;SET CHANNEL NUMBER
	ADD	#20,IDENT	;CHANNEL GROUP+20
	NEGB	IDENT		;MAKE NEGATIVE... GO!
	MOV	#1,-(SP)	;STACK THE NUMBER OF BLOCKS REQUIRED
	REQM			;GET A BUFFER
	MOV	(SP)+,AC	;GET ADDRESS
	GCHAN			;AND ADDRESS OF CHANNEL SLOT
	CLRB	(TEMP)		; RESET CHANNEL
	MOV	AC,2(TEMP)	;SET BUFFER ADDRESS
;
;---	CHANNEL TABLE ENTRY LOOKS LIKE:
;
;	+-------------------------+
;	: FMT CODE   : FLAG BYTE  :	CODE=BITS(15-9)  FLAG=BITS(8-0)
;	+-------------------------+
;	:     BUFFER ADDRESS      +
;	+-------------------------+
;	:  BYTE OFFSET            :
;	+-------------------------+
;	: RELATIVE BLOCK NUMBER   :
;	+-------------------------+
;	:  DEVICE NAME (RAD50)    :
;	+-------------------------+
;
	.GLOBL	L.WRT,L.EOF,L.IN,L.WRIT,L.READ,L.OPEN
;
	MOV	#L.CSIT,AC	;POINT AT FILE DESCRIPTION
	ADD	#4,TEMP		;POINT AT THE OFFSET
	CLR	(TEMP)+		;SET OFFSET TO ZERO
	CLR	(TEMP)+		;AND REL BLOCK TO 0 ALSO
	MOV	(AC)+,(TEMP)+	;SAVE DEV NAME
	GCHAN			;GET THE CHANNEL INFO
	MOV	TEMP,AC		;POINT AT THE CHANNEL SLOT WITH AC
	MOV	#L.CSIT,TEMP	;POINT AT THE DEVICE BLOCK
;
;---	SEE IF WE SHOULD OPEN THE FILE
;
LIB.2:	ROL	(SP)		;FILE TO BE OPENED?
	BCC	2$		;NO - EXIT
;
;---	HERE ATTEMPT TO OPEN THE FILE FOR INPUT
;
	BISB	#L.IN,@AC	;SET INPUT ALLOWED BIT AND OPEN
	BISB	#L.OPEN,@AC	;BOTH BITS (GLOBALED, SO CAN'T ADD THEM)
	MOV	TEMP,-(SP)	;HANG ON TO THE POINTER IN CASE
	DOEMT	104020,0	;PERFORM LOOKUP EMT
	MOV	TEMP,L.SIZE	;SAVE FILE SIZE
	MOV	(SP)+,TEMP	;RECOVER THE POINTER
	BCS	1$		;SKIP IF ERROR
	ROL	@SP		;REMOVE NEXT BIT FOR OUTPUT (NOT NEEDED)
	BR	3$		;CONTINUE
1$:	TST	(SP)		;SEE IF POSSIBLE FOR OUTPUT...
	BMI	2$		;YES - SAFE!
8$:	ERROR+201+34.+34.	;FILE NOT FOUND
;
;---	NEED TO TRY OUTPUT!
;
2$:	ROL	(SP)		;OPEN FOR OUTPUT?
	BCC	3$		;NO - EXIT WITH GRACE...
	BICB	#L.IN,@AC	;CLEAR OUT THE BIT FOR INPUT ALLOWED
	BISB	#L.OPEN,@AC	;AND FLAG AS OPENED
	MOV	L.CSIT+8.,-(SP)	;STACK THE LENGTH
	DOEMT	104040,0	;DO THE ENTER EMT
	BCS	8$		;FLAG ERROR
	MOV	TEMP,L.SIZE	;SAVE THE TRUE SIZE OF THE FILE
;
;---	DONE - REMOVE FLAG WORD FROM STACK AND DO ROUTINE
;
3$:	GCHAN			;GET THE CHANNEL POINTER
	BIT	#3,@SP		;DOES THE COMMAND REQUIRE AN OPEN FILE?
	BEQ	9$		;NO - SKIP IT
	BIT	#L.OPEN,@TEMP	;IS IT?
	BNE	9$		;YES - OK TO CONTINUE
	ERROR+201+29.+29.
9$:	ROL	@SP		;SEE IF FILE SHOULD BE FLAGGED FOR WRITE
	BCC	4$		;NO - SKIP SETTING THE FLAG
	BIS	#L.WRIT,@TEMP	;SET THE BIT
4$:	ROL	(SP)		;SEE IF READ BIT SHOULD BE SET
	BCC	5$		;NO - SKIP IT
	BIS	#L.READ,@TEMP	;SET...
5$:	ROL	@SP		;SEE IF SWITCHES EXPECTED...
	BCC	6$		;NO SKIP IT AND CONTINUE
	JSR	PC,L.SWIT	;PROCESS THE LIBRARY SWITCHES
6$:	ROL	@SP		;SEE IF LINE NUMBER POSSIBLE
	BCC	7$		;NO - SKIP IT
	SORTC	TLIST+1,10$
	GETC			;SKIP
10$:	GETLN			;GET THE LINE NUMBER
	MOV	LINENO,L.LINE	;SAVE IT
7$:	TST	(SP)+		;POP THE STACK
	JSR	PC,@(SP)+	;PERFORM ROUTINE
	CLR	LIBSW		;RESET LIBRARY SWITCH
	POPJ			;RETURN FOR NEXT COMMAND
	.SBTTL	LIBRARY SWITCH PROCESSOR
;
;---	L.SWIT - THIS ROUTINE PICKS UP THE SWITCHES, AND UPDATES THE
;	CORRECT CHANNEL ENTRY FIELD
;
;	ALSO VIRTUAL ARRAYS ARE PROCESSED HERE FOR INITIALIZATION.
;
L.SWIT:	CMPB	CHAR,#203	;SLASH CODE?
	BNE	9$		;NO - EXIT
;
;---	SWITCH IS HERE, LOOK FOR CORRECT ONE
;
	GETC			;RECOVER A CHARACTER
	BMI	7$		;ERROR
	SORTC	L.FORM,1$	;SEE IF LEGAL
	ERROR+201+30.+30.	;ILLEGAL FORMAT CODE
1$:	CMP	CHAR,#'Z	;ZERO?
	BEQ	3$		;ZERO OUT THE FILE
	CMP	CHAR,#'V	;VIRTUAL FILE DEFINITION?
	BEQ	5$		;YES - PROCESS IT
	SUB	#L.FORM,AC	;GET DISP
	GCHAN			;GET THE CORRECT CHANNEL
	MOVB	AC,1(TEMP)	;SET IT INTO THE RIGHT PLACE
2$:	GETC			;GET THE NEXT CHARACTER
	BPL	2$		;CONTINUE UNTIL A TERMINATOR
	BR	L.SWIT		;SEE IF ANOTHER SWITCH
;
;---	ZERO COMMAND GIVEN... VALIDATE IT AND THEN DO IT!
;
3$:	GCHAN			;POINT AT THE CHANNEL ENTRY
	BIT	#L.IN,@TEMP	;OPENED AS AN OLD FILE?
	BNE	2$		;YES - GET OUT OF HERE!
	MOV	@TEMP,-(SP)	;STACK THE CODE AND FLAGS
	CLR	C.BLK(TEMP)	;SET BLOCK TO 0
	MOV	#L.OPEN,@TEMP	;SET FLAGS TO 1
	NXTBLK			;ZERO OUT THE BUFFER
4$:	BIS	#L.WRT,@TEMP	;SET WRITTEN INTO
	DMPBLK			;OUTPUT THE FILE
	INC	C.BLK(TEMP)	;UPDATE THE BLOCK COUNT
	CMP	C.BLK(TEMP),L.SIZE ;SEE IF WE HAVE FINISHED
	BLO	4$		;NO - CONTINUE
	CLR	C.BLK(TEMP)	;PUT BACK IN RANGE
	MOV	(SP)+,@TEMP	;THAT DID IT!
	BIS	#L.IN,@TEMP	;SET READABLE BIT!
	BR	2$		;GET THE HECK OUT....
;
;---	VIRTUAL FILE SWITCH "/V:<VARIABLE NAME>"
;
;	THIS SWITCH ALLOWS THE USER TO SPECIFY THE NAME USED BY THE
;	PROGRAM FOR THIS FILE. 
;
5$:	GETC			;SEE IF COLON SPECIFIED
	BMI	7$		;ERROR
	CMP	CHAR,#':	;FOUND?
	BNE	5$		;KEEP TRYING
	GETC			;GET THE NEXT CHARACTER
	BMI	7$		;ERROR
	JSR	PC,GETNAM	;GET THE SYMBOL NAME
	MOV	L.CHAN,TEMP	;POINT AT THE CHANNEL SLOT IN V.NAME
	ASL	TEMP		;*2
	ASL	TEMP		;*4
	ADD	#V.NAME,TEMP	;POINT AT IT NOW
	TST	(SP)+		;POP THE SUBSCRIPT INFO
;
;---	HERE THE TOP OF THE STACK HOLDS THE VARIABLE NAME.
;
;	NOTE: SEE THE GETNAM ROUTINE FOR INFORMATION ABOUT
;		THE STRUCTURE OF THE NAME WORD. BITS 15 & 7 HAVE
;		SPECIAL SIGNIFICANCE...
;
	TSTB	PRM1		;* SPECIAL SYMBOL TABLE MODE? *
	BNE	6$		;YES - KEEP UNIQUENESS OF VARIABLES
	BIC	#100200,@SP	;HANDLE SCALAR,SINGLE SUB, DBL SUB ALIKE.
6$:	MOV	(SP)+,(TEMP)+	;PASS THE VARIABLE NAME
	MOV	L.SIZE,(TEMP)	;AND SET THE FILE SIZE
	INC	VCNT		;UPDATE THE NUMBER OF VIRTUAL FILES
	BR	L.SWIT		;RETURN FOR MORE, IF POSSIBLE...
7$:	ERROR+201+4+4		;COMMAND SYNTAX ERROR
;
;---	NO MORE SWITCHES - EXIT
;
9$:	POPJ			;RETURN TO CALLER
	.SBTTL	LIBRARY OPEN,GET, AND SAVE ROUTINES
;
;---	LIBRARY OPEN,GET, AND SAVE
;
L.OPN:	GCHAN			;GET POINTER FOR CHANNEL
	CLR	C.BLK(TEMP)	;RESET TO BLOCK 0
	BIT	#L.IN,@TEMP	;WAS FILE NEWLY CREATED?
	BEQ	1$		;YES - START WITH A ZERO BLOCK
	NXTBLK			;GET THE NEXT BLOCK
	POPJ			;RETURN
;
1$:	JSR	R5,$CLRBL	;ZERO THE BUFFER
	BIC	#L.WRT,@TEMP	;WE REALLY HAVENT WRITTEN TO IT YET.
	POPJ			;EXIT
;
L.SAV:	JSR	PC,L.OPN	;OPEN THE FILE
	MOV	#1$,-(SP)	;SET UP RETURN
	MOV	CHAR,-(SP)	;STACK THE POINTER
	MOV	AXOUT,-(SP)	;AND THE LINE POINTER
	CLR	AC		;SET ALL LINES
	CLR	LINENO		;AND SET LINE NO ALSO
	MOVB	#1,SWITCH	;SET "ALL" FOR WRITE OUTPUT
	JMP	WRITE2		;DO IT
;
1$:	BR	L.CLOS		;CLOSE THE FILE ANDEXIT
;
L.GET2:	JSR	PC,L.OPN	;INPUT FIRST BLOCK
	INC	GETSW		;SET A "GET" IN PROGRESS
	MOV	PCFN,-(SP)	;SAVE THE CURRENT FOCAL PC
	JSR	PC,STARTX	;READ IT!
	MOV	(SP)+,PCFN	;RESTORE THE PC
	CLR	GETSW		;RESET GET MODE
	JSR	PC,FIXUP	;FIX UP FOR CORRECT RETURN
	BR	L.CLOS		;CLOSE THE INPUT FILE
;
L.GET:	JSR	PC,L.GET2	;GET FILE
	TST	PCFN		;WAS IT FROM CMD/INP MODE?
	BNE	1$		;NO - PROCEDE
	CLR	LIBSW		;RESET LIB COMMAND SWITCH
	START			;RETURN TO C/I
1$:	POPJ			;GO TO NEXT LINE
;
;---	LIBRARY DELETE CODE
;
L.DEL:	MOV	#L.CSIT,TEMP	;POINT TO THE FILE BLOCK
	DOEMT	104000,0	;PERFORM DELETE OF FILE
	BCS	1$		;HANDLE ERROR CONDITION
	BR	L.CLOS		;RELEASE THE HANDLER
;
1$:	ERROR+201+34.+34.	;FILE NOT FOUND
	.SBTTL	LIBRARY CLOSE ROUTINES
;
;---	LIBRARY CLOSE IS USED BY SEVERAL ROUTINES TO
;	DISASSOCIATE ITSELF WITH A LIBRARY CHANNEL.
;	VIRTUAL FILE HOOKS ARE REMOVED HERE.
;
;---	L.CLOS - CLOSE OUT L.CHAN
;
L.CLSA:	CLR	L.CHAN		;START WITH CHANNEL 0
1$:	GCHAN			;POINT TO THE CHANNEL ENTRY
	JSR	PC,L.CLOS	;CLOSE THE CHANNEL
	INC	L.CHAN		;UPDATE THE CHANNEL NUMBER
	CMP	L.CHAN,#MAXCHN	;INSIDE THE LIMIT?
	BLO	1$		;YES - CONTINUE
	POPJ			;RETURN TO CALLER
;
L.CLS2:	TSTB	SWITCH		;ALL FILES?
	BGT	L.CLSA		;HANDLE IT
	MOVB	L.LINE+1,AC	;GET LINE NUMBER
	INCB	L.LINE		;SEE IF ROUNDING NEEDED
	ADC	AC		;UPDATE THE VALUE
	MOV	AC,L.CHAN	;SET THE CHANNEL
;
L.CLOS:	GCHAN			;MAKE SURE TEMP IS POINTING AT THE ENTRY
	DMPBLK			;OUTPUT IT IF IT NEEDS IT
1$:	DOEMT	104160,0	;PERFORM A CLOSE ON THE CHANNEL
	MOV	L.CHAN,TEMP	;POINT TO THE NUMBER
	CMP	TEMP,#MAXCHN	;SEE IF A USER CHANNEL
	BHIS	3$		;OURS - NO VIRTUAL FILE!
	ASL	TEMP		;*2 FOR WORD ENTRY TO V.NAME
	ASL	TEMP		;*4 TO CLEAR VIRTUAL FILE REFERENCE
	ADD	#V.NAME,TEMP	;POINT TO THE ENTRY
	TST	@TEMP		;WAS IT A VIRTUAL FILE?
	BEQ	3$		;NO - SKIP
	CLR	@TEMP		;FINISH IT BUT GOOD.....
	DEC	VCNT		;REMOVE ONE COUNT
	BPL	3$		;SKIP OUT IF OK
	ERROR+201+36.+36.	;SET ERROR (OURS FOR VIR FILE)
3$:	GCHAN			;GET THE POINTER FOR THE CHANNEL
	TST	@TEMP		;IS THE CHANNEL OPEN?
	BEQ	2$		;NO - SKIP IT
	CLR	(TEMP)		;FREE THE CHANNEL
	MOV	TEMP,PTR	;CONSTRUCT POINTER
	ADD	#C.FIL,PTR	;POINT AT THE DEVICE NAME
	RELHAN			;RELEASE THE HANDLER
	MOV	L.CHAN,IDENT	;SET UP FOR RELM
	ADD	#20,IDENT	;OFFSET FOR CHANNEL ID
	NEGB	IDENT		;SET FOR RELM OF ALL MEMORY
	CLRM			;RELEASE THE CHANNEL MEMORY
2$:	POPJ			;RETURN TO LIBRARY SECTION
	.SBTTL	LIBRARY RUN AND NEXT ROUTINES
;
;---	L.RUN - LIBRARY RUN COMMAND
;
L.RUN:	ERASEV			;AND VARIABLES
	BR	L.CALL		;HANDLE IT
L.NXT:	MOV	PCF,AC		;GET LINE POINTER
	ADD	(AC)+,AC	;POINT TO FOLLOWING LINE
	BEQ	1$		;HANDLE SPECIAL CASE
	MOV	2(AC),AC	;GET THE LINE NUMBER
1$:	FPMP	FLOAT		;FLOAT THE AC
	.WORD	FDIV+REL,K256-.	;DIVIDE BY 256.0
	.WORD	FPUT+REL,ANPRSN-. ;SAVE IN "&" VARIABLE
L.CALL:	ERASET			;ERASE THE TEXT
	MOVB	SWITCH,-(SP)	;SAVE IT
	JSR	PC,L.GET2	;GET THE FILE AND RESTART
	MOVB	(SP)+,SWITCH	;RESTORE IT
	MOV	L.LINE,PCFN	;SET PCOUNT LINE NUMBER
	MOV	L.LINE,LINENO	;RESTORE LINE NUMBER
	CMP	(SP)+,(SP)+	;POP RETURN TO THE LIBRARY ROUTINE
	CLR	LIBSW		;RESET LIBRARY SWITCH
	FINDLN	GERR		;FIND THE LINE NUMBER WE WANT
	JMP	PSCAN		;PROCESS POSSIBLE GOTO COMMAND
	.SBTTL	VWRITE - ROUTINE TO OUTPUT TO A VIRTUAL FILE ELEMENT
;
;---	WRITE TO A VIRTUAL FILE...
;
;	IF WE ARE ASKING TO WRITE TO A VIRTUAL FILE, PTR SHOULD
;	BE POINTING TO "VIRTUL". THIS IS BECAUSE VCHECK SHOULD
;	HAVE BEEN CALLED BY THE SYMBOL TABLE ROUTINE BEFORE US.
;
;	SEE VCHECK AND THE SYMBOL TABLE ROUTINES FOR MORE INFORMATION
;
VWRITE:	FPMP	FPUT+IPTR	;OUTPUT THE VALUE
	CMP	PTR,#VIRTUL	;PTR IN THE SYMBOL TABLE?
	BEQ	2$		;NO - SCAN CHANNELS FOR A FILE NAME
	POPJ			;RETURN TO THE CALLER
;
2$:	JMP	$VPUT		;OUTPUT TO THE VIRTUAL FILE...
	.SBTTL	VCHECK - ROUTINE TO SEE IF VIRTUAL FILE PROCESSING IS REQUIRED.
;
;---	VCHECK - THIS ROUTINE IS CALLED BY THE GETVAR ROUTINE TO
;	SEE IF A VARIABLE IS REALLY A VIRTUAL FILE.
;
;	ON CALL, STACK IS SET UP AS FOLLOWS:
;
;	+------------------------------+
;	: VARIABLE NAME IN OUR NOTATION:
;	+------------------------------+
;	: SUBSCRIPT VALUE IF ANY       :
;	+------------------------------+
;  SP:  :  RETURN ADDRESS TO GETVAR    :
;	+------------------------------+
;
;	WE ARE TO SCAN THE V.NAME TABLE FOR A MATCH ON THIS NAME.
;
;	IF WE CAN'T FIND IT, RETURN TO GETVAR AND LET HIM WORK HIS
;	HEART OUT FOR US.....
;
;	HOWEVER, IF WE FIND IT, IT IS UP TO US TO HAVE THE NECESSARY
;	SMARTS TO GET THE DATA FROM THE DISK (OR TAPE FOR THAT MATTER)
;	FILE AND LEAVE PTR POINTING TO IT.. THEN POP THE
;	STACK AND RETURN BACK ONE LEVEL BEYOND THE CALL.
;
VCHECK:	TST	VCNT		;ANY VIRTUAL FILES ACTIVE?
	BEQ	6$		;NO - GET OUT!
	MOV	#V.NAME,TEMP	;POINT AT THE VIRTUAL NAME TABLE
	MOV	4(SP),AC	;GET THE VARIABLE NAME
	TSTB	PRM1		;SUPER SYMBOL TABLE MODE?
	BNE	5$		;YES - KEEP SYMBOL UNIQUENESS!!!!
	BIC	#100200,AC	;MAKE ARRAYS AND SCALARS LOOK ALIKE!!
5$:	MOV	#MAXCHN,-(SP)	;CONSTRUCT POINTER AT THE END
	ASL	@SP		;*2 FOR BYTE -> WORD CONVERSION
	ASL	@SP		;*2 FOR 2 WORDS / ENTRY
	ADD	#V.NAME,@SP	;ADD START ADDRESS
1$:	CMP	AC,@TEMP	;IS THIS IT?
	BEQ	3$		;YES - HANDLE IT ACCORDINGLY
	CMP	(TEMP)+,(TEMP)+	;POINT AT THE NEXT ENTRY
	CMP	TEMP,@SP	;SEE IF AT THE END
	BLO	1$		;CONTINUE TO SCAN
	TST	(SP)+		;POP THE STACK
6$:	POPJ			;NOT A VIRTUAL FILE SPEC - RETURN
;
3$:	CMP	(SP)+,(SP)+	;POP THE STACK
	SUB	#V.NAME,TEMP	;GET OFFSET
	ASR	TEMP		;/2
	ASR	TEMP		;/4
	MOV	TEMP,VCHAN	;SET VIRTUAL CHANNEL
	MOV	(SP)+,VINDEX	;SET SUBSCRIPT VALUE
	TST	(SP)+		;POP RETURN VALUE
	JMP	$VGET		;GET THE VIRTUAL VARIABLE
	.SBTTL	LIBRARY UTILITY ROUTINES
;
;---	DMPBLK - DUMPS OUT THE OLD BLOCK
;
$DMPBL:	BIT	#L.WRT,(TEMP)	;SEE IF BLOCK WRITTEN INTO
	BEQ	2$		;NO - EXIT FAST!
	CLR	-(SP)		;SET UP FOR WRITE OUT
	MOV	#256.,-(SP)	;NUMBER OF WORDS A CONSTANT
	MOV	C.BUF(TEMP),-(SP) ;SEND BUFFER ADDRESS
	MOV	C.BLK(TEMP),TEMP ;GET THE BLOCK NUMBER
	DOEMT	104220,0	;WRITE AND WAIT
	BCC	1$		;SKIP IF NO ERROR
	ERROR+201+32.+32.	;** FATAL WRITE ERROR **
1$:	GCHAN			;GET THE CHANNEL
	BIC	#L.WRT,(TEMP)	;MARK THE BLOCK AS NOT WRITTEN INTO
2$:	RTS	R5		;RETURN TO THE CALLER
;
;---	DOEMT - ROUTINE TO DO A VARIABLE EMT CALL
;
$DOEMT:	MOV	(R5)+,(R5)	;COPY THE BASE EMT VALUE
	ADD	L.CHAN,(R5)	;ADJUST BY THE CHANNEL NUMBER
	RTS	R5		;RETURN AND EXECUTE IT!
;
;---	GCHAN - ROUTINE TO CONSTRUCT CHANNEL ENTRY ADDRESS IN TEMP
;
$GCHAN:	MOV	L.CHAN,TEMP	;GET THE CHANNEL NUMBER
	ASL	TEMP		;*2
	ASL	TEMP		;*4
	ADD	L.CHAN,TEMP	;+1=*5
	ASL	TEMP		;*2=*10. FOR TRUE BYTE OFFSET
	ADD	#CHANTB,TEMP	;NOW POINTING WHERE WE WANT
	RTS	R5		;RETURN TO THE CALLER
;
;---	$CKEOF - ROUTINE TO CHECK ON EOF AND SET CARRY IF SO
;
$CKEOF:	MOV	TEMP,-(SP)	;SAVE TEMP
	TST	LIBSW		;IN A LIBRARY COMMAND?
	BEQ	1$		;NO - EXIT
	GCHAN			;GET CHANNEL POINTER
	BIT	#L.EOF,@TEMP	;SEE IF EOF EXISTS
	BEQ	1$		;NO
	SEC			;SET CARRY BIT
1$:	MOV	(SP)+,TEMP	;RESTORE REG SETTING
	RTS	R5		;RETURN TO THE USER
	.IF	NDF,$SMALL
;---	L.QUOT - ROUTINE TO INSERT ASCII EVALUATION OF AN EXPRESSION
;		 INTO A STRING POINTED TO BY PTR.
;
L.QUOT:	MOV	PTR,-(SP)	;SAVE THE CURRENT POINTER
	SUB	#STRING,SP	;LEAVE ROOM FOR 30 CHARACTERS
	MOV	SP,PTR		;REMEMBER THE STRING
1$:	GETC			;COPY THE STRING BETWEEN THE QUOTES
	BPL	2$		;IF POS, NOT ADELIM OR SPECIAL CHAR
	SORTC	TLIST,8$	;CHECK ON A TERMINATOR...
2$:	CMP	CHAR,#''	;THISTHE END QUOTE?
	BEQ	3$		;YES - SKIP OUT OF HERE!
	MOVB	CHAR,(PTR)+	;DROP THE CHARACTER AND RUN!
	BR	1$		;START THIS MESS ALL OVER AGAIN!
3$:	MOVB	#214,(PTR)	;SET A SEPARATOR FOR THE EVAL ROUTINE
	MOV	SP,PTR		;POINT BACK AT THE START OF THINGS
	MOV	AXOUT,-(SP)	;SAVE WHERE WE WERE
	MOV	PTR,AXOUT	;AND WHERE WE ARE...
	EVAL.X			;EVALUATE THE EXPRESSION
	FPMP	FINT		;MAKE IT AN INTEGER
	TST	AC		;SEE IF NEGATIVE
	BPL	.+4		;SKIP IF SO
	NEG	AC		;MAKE IT POSITIVE
	MOV	(SP)+,AXOUT	;RECOVER THE ORIGINAL INPUT STRING
	ADD	#STRING,SP	;RELEASE THE MEMORY FOR THE STRING
	MOV	(SP)+,PTR	;AND POINT WHERE WE LEFT THE FILE NAME STRING
;
;---	NOW OUTPUT THE ASCII DECIMAL VALUE FOR THE NUMBER
;
	MOV	#DECTAB,TEMP	;POINT AT A DECIMAL POWER TABLE
	MOV	AC,-(SP)	;SAVE THE TRUE VALUE
4$:	MOV	#'0,CHAR	;SET FOR START
5$:	CMP	AC,@TEMP	;SEE IF IN THIS POWER ANY MORE
	BLO	6$		;NO - EXIT
	SUB	@TEMP,AC	;REMOVE ONE UNIT
	INC	CHAR		;AND MARK WE DID!
	BR	5$		;CONTINUE TO CONSTRUCT THE DIGIT
6$:	CMP	AC,@SP		;DID WE CHANGE YET? (SIGNIFICANCE OF 0)
	BEQ	7$		;NO - SKIP THE OUTPUT
	MOVB	CHAR,(PTR)+	;DROP THE CHARACTER
7$:	TST	(TEMP)+		;UPDATE THE POINTER
	TST	@TEMP		;DONE?
	BNE	4$		;NO - RESTART THIS UNIT
;---	FINAL APPROACH!!!!!!!!
	ADD	#'0,AC		;THIS TAKES CARE OF AT LEAST ONE DIGIT
	MOVB	AC,(PTR)+	;SEND IT
	TST	(SP)+		;POP THE STACK
	POPJ			;RETURN TO CALLER
8$:	ERROR+201+31.+31.	;QUOTE CONSTRUCT WAS ILLEGAL IN FORMAT
	.ENDC
	.SBTTL	CHANI - ROUTINE TO INPUT A CHARACTER FROM CHANNEL
;
;---	$CHANI - INPUT A CHARACTER FROM CHANNEL L.CHAN INTO REG CHAR.
;
$CHANI:	MOV	AC,-(SP)	;SAVE AC
	MOV	TEMP,-(SP)	;AND TEMP
	GCHAN			;GET THE CHANNEL POINTER
	BIT	#L.READ,@TEMP	;READ FROM THIS FILE?
	BEQ	2$		;NO - SET CARRY AND EXIT
	BIT	#L.EOF,@TEMP	;SEE IF EOF DETECTED BEFORE
	BPL	1$		;NO - CONTINUE
	ERROR+201+33.+33.	;ATTEMPT TO READ PAST EOF
1$:	MOV	C.OFF(TEMP),AC	;GET THE BYTE OFFSET
	CMP	AC,#512.	;SEE IF TOO FAR
	BLT	4$		;NO - CONTINUE AS NORMAL
	DMPBLK			;DUMP THE CURRENT BLOCK
	INC	C.BLK(TEMP)	;POINT AT THE NEXT BLOCK
	NXTBLK			;GET THE NEXT BLOCK
4$:	MOV	C.BUF(TEMP),CHAR ;POINT A THE BUFFER
	ADD	AC,CHAR		;POINT AT THE CHARACTER
	INC	AC		;RESET THE NEW OFFSET
	MOV	AC,C.OFF(TEMP)	;REPLACE IT
	MOV	(SP)+,TEMP	;RECOVER THE SAVED REGISTERS
	MOV	(SP)+,AC	;ALL OF THEM
	MOVB	@CHAR,CHAR	;GET CHARACTER AND CONDITION CODES
	RTS	R5		;RETURN WITH THE CHARACTER INTACT
;
2$:	SEC			;SET CARRY FOR ERROR
	BR	$XOUT		;EXIT BACK
	.SBTTL	CHANO - ROUTINE TO OUTPUT A CHRACTER TO A CHANNEL
;
;---	$CHANO - ROUTINE TO OUTPUT CHAR INTO BUFFER FOR CHANNEL L.CHAN
;
$CHANO:	MOV	AC,-(SP)	;SAVE IT
	MOV	TEMP,-(SP)	;AND THIS ALSO
	GCHAN			;GET CHANNEL
	BIT	#L.WRIT,@TEMP	;WRITE TO THIS CHANNEL?
	BEQ	3$		;NO - EXIT
	BIT	#L.EOF,@TEMP	;EOF ENCOUNTERED?
	BEQ	1$		;NO - SKIP ERROR
	ERROR+201+33.+33.	;ATTEMPT TO WRITE PAST EOF
;
3$:	SEC			;SET CARRY FLAG
	BR	$XOUT		;EXIT
1$:	MOV	C.OFF(TEMP),AC	;GET BYTE OFFSET
	CMP	AC,#512.	;WITHIN THE BUFFER STILL?
	BLT	2$		;YES - CONTINUE
	DMPBLK			;DUMP THIS BLOCK OUT
	INC	C.BLK(TEMP)	;UPDATE BLOCK COUNTER
	JSR	R5,$CLRBL	;INITIALIZE OUTPUT BLOCK TO ZERO
2$:	INC	AC		;SET FOR NEXT CHARACTER
	MOV	AC,C.OFF(TEMP)	;SET NEW OFFSET
	ADD	C.BUF(TEMP),AC	;POINT BEYOND CURRENT POSITION
	MOVB	CHAR,-(AC)	;SEND IT
	BIS	#L.WRT,@TEMP	;FLAG THE BUFFER WRITTEN INTO
$XOUT:	MOV	(SP)+,TEMP	;RESTORE THE USER REGISTERS
	MOV	(SP)+,AC	;ALL OF THEM...
	RTS	R5		;RETURN TO THE USER
	.SBTTL	NXTBLK - ROUTINE TO FETCH THE NEXT BLOCK OF THE FILE
;
;---	$NXTBL - ROUTINE TO GET THE NEXT BLOCK
;
$NXTBL:	CLR	AC		;RESET OFFSET POINTER
	CLR	-(SP)		;SET FOR A READ/WAIT OPERATION
	MOV	#256.,-(SP)	;BUFFER SIZE IS A CINSTANT
	MOV	C.BUF(TEMP),-(SP) ;SET THE BLOCK
	MOV	C.BLK(TEMP),TEMP ;POINT AT THE BUFFER AREA
	DOEMT	104200,0	;PERFORM THE READ/WAIT
	BCC	3$		;NO ERROR
	MOVB	@#52,TEMP	;RECOVER THE ERROR CODE
	BEQ	2$		;SKIP IF EOF
	ERROR+201+27.+27.	;I/O ERROR
2$:	GCHAN			;GET THE CHANNEL NUMBER
	BIS	#L.EOF,@TEMP	;SET THE EOF FLAG
	MOV	#511.,AC	;SET FOR EOB NEXT CALL
	MOV	AC,-(SP)	;STACK IT
	ADD	C.BUF(TEMP),(SP) ;POINT AT LAST POINT
	CLRB	@(SP)+		;RESET THAT BYTE
3$:	GCHAN			;MAKE SURE TEMP IS POINTING CORRECTLY
	RTS	R5		;RETURN TO THE USER
;
$CLRBL:	MOV	C.BUF(TEMP),AC	;POINT AT THE BUFFER AREA
	MOV	#256.,-(SP)	;STACK THE BUFFER SIZE
5$:	CLR	(AC)+		;CLEAR OUT THE ACCUM
	DEC	@SP		;COUNT OUT THE NUMBER OF WORDS IN THE BUFFER
	BNE	5$		;CONTINUE UNTIL ZERO
	MOV	(SP)+,AC	;POP STACK AND ZERO AC
	BIS	#L.WRT,@TEMP	;SET WRITTEN INTO BIT
	RTS	R5		;RETURN TO THE CALLER
	.ENDC
	.SBTTL	*TYPE*ASK*


;*TYPE*ASK*

;INPUT-OUTPUT STATEMENTS

TYPE:	TASK			;CHECK FOR SPECIAL CODES
	JSR	PC,EVAL		;EVALUATE EXPRESSION
	BITB	#2,PRM3		;USE "="?
	BNE	1$		;NO - SKIP IT!
	PRINT	<'=>		;MAKE LEADIN SIGNAL.
1$:	MOV	FISW,PTR	;LOAD FORMAT DATA
	FPRINT			;PRINT SAME
	BR	TYPE		;REPEAT

	STRING=32.		;NUMBER OF CHARACTERS ALLOWED ON INPUT.
ASK:	.RCTRLO			;RESET CONTROL O FUNCTION
	.IFDF	$RT11
	JSR	PC,FLUSH	;FORCE OUTPUT OUT
	.ENDC
	TASK			;CHECK FOR SPECIAL CODES
	INCB	NVSW		;SET NEW VARIABLE SWITCH
	JSR	PC,GETARG	;READ NAME AND SETUP PTR
	CLRB	NVSW		;RESET THE SWITCH
	.IFDF	$RT11
	TST	LIBSW		;*LIBRARY* COMMAND?
	BNE	1$		;YES - NO COLON OUTPUT HERE...
	.ENDC
	BITB	#1,PRM3		;SEE IF ":" SHOULD BE OUTPUT
	BNE	1$		;NO - SKIP IT
	PRINT	<':>		;INDICATE READY FOR INPUT DATA.
1$:	MOV	AXOUT,-(SP)	;SAVE TEXT POINTER
	MOVB	CHAR,-(SP)	;SAVE VARIABLE POINTER
	MOV	#STRING,AXOUT	;MAKE COUNTER
	SUB	AXOUT,SP	;OPEN AREA ON THE STACK
	MOV	SP,R5		;SET RUBOUT STOP
	MOV	PTR,-(SP)	;STACK THE DATA POINTER
	TSTB	PRM4		;CHECK ON SWITCH
	BEQ	2$		;SKIP IF RESET
	MOVB	PRM4,(R5)+	;SET LEADING CHARACTER
2$:	MOV	R5,AXIN		;USE FOR PACKING
	CLR	PTR		;SET SPACE - FLOP
ATAKE:	READC			;ACCEPT CHARACTER
	SORTC	TLIST+1,AFIX	;TEST FOR PRIME TERMINATORS
	DEC	AXOUT		;COUNT CHARACTERS
	BGT	.+4		;SKIP IF OK.
	ERROR+201+16.+16.	;TOO LARGE AN INPUT STREAM.
	SORTJ	SPECIAL,INLIST	;TEST FOR ALTMODE, SPACE, R.O., L.F.
ARO:	PACKC			;PACK INPUT AND EDIT.
	BMI	ATAKE		;IF TERMINATOR, CONTINUE
	MOV	@PC,PTR		;SET SWITCH SO THAT SPACE CODE
	BR	ATAKE		;WILL TERMINATE AND ALPHA IS ACCEPTED.
				;
ASPACE:	TST	PTR		;CHECK STATUS OF SPACE.
	BEQ	ATAKE		;IGNORE.
AFIX:	MOVB	#214,CHAR	;PACK AN EXTRA COMMA
	PACKC			;...
	DECB	DEBG		;DISABLE TRACE
	MOV	R5,AXOUT	;PICKUP DATA
	TSTB	-(AXOUT)	;BACKUP TO LEAD ZERO.
	EVAL.X			;GO READ THE NUMBER OR EXPRESSION!
	FPMP	FPUT+THROUGH+STACK ;SAVE THE RESULT
	CLRB	DEBG		;RE-ENABLE TRACE
AGO1:	ADD	#STRING+2,SP	;CORRECT THE STACK
	MOVB	(SP)+,CHAR	;RESTORE TEXT SEQUENCE
	MOV	(SP)+,AXOUT	;...
	BR	ASK		;CONTINUE *ASK* COMMAND.
;
AGO:	CMPB	CHAR,#12	;RETURN?
	BNE	AGO1		;NO - EXIT
	PRINT2	<CRLF>		;RETURN THE CARRIAGE
	BR	AGO1		;EXIT



;"TASK"

;AUXILLIARY PROCESSOR FOR INPUT-OUTPUT COMMANDS

TCRLF:	PRINT2	<CRLF>		;PRINT THIS CODE FOR CR+LF.
TASK4:	GETC			;MOVE TO NEXT CHARACTER
TASKX:	SORTJ	ALIST,ATLIST	;TEST FOR SPECIAL CODES (ENTRY POINT)
	CMPB	#210,CHAR	;R-PARS AND = NOT VALID HERE ; IGNORE
	BLOS	TASK4		;COMMA, SEMI, AND CR WERE TESTED ABOVE
	RTS	R5		;RETURN
				;
TINTR:	GETC			;PASS PRECENT SIGN
	GETLN			;READ FORMAT CONTROL NUMBER
	MOV	AC,FISW		;SAVE CODE
	BR	TASKX		;CONTINUE
				;
TQUOT:	MOVB	(AXOUT)+,CHAR	;BYPASS TRACE
	CMPB	#CR,CHAR	;READ AND PRINT WITHIN QUOTES
	BEQ	TASKX		;C.R.=NORMAL RETURN FROM 'TASK'
	CMPB	#'",CHAR	;QUOTE=CANONICAL RETURN
	BEQ	TASK4		;GO SEE WHETHER THERE IS MORE
	PRINTC			;PRINT MATERIAL.
	BR	TQUOT		;REPEAT
				;
TCRLF2:	PRINT2	<00015>		;#=CR ONLY
	BR	TASK4		;BUT EXTRA RUB OUT.

TOCT:	JSR	PC,TGET		;GET SET FOR IT
	OTOA			;PERFORM OCTAL TO ASCII CONVERSION
	BR	TASK4		;RETURN FOR MORE
;
;---	TSPC - SPECIAL ^X HANDLER
;
TSPC:	GETC			;CODE MUST IMMEDIATELY FOLLOW IT
	SORTJ	1$,2$		;HANDLE IT
	ERROR+201+8.+8.		;OP ERROR
1$:	.ASCII	/O/		;OCTAL
	.ASCII	/B/		;BINARY
	.ASCII	/I/		;INTEGER
	.IF	DF,$RT11
	.ASCII	/D/		;AND DATE
	.ENDC
	.ASCII	/T/		;TAB FUNCTION
	.BYTE	0		;TERMINATOR
	.EVEN
2$:	TOCT			;GO TO OCTAL PROCESSOR
	TBIN			;BINARY PROCESSOR
	TINT			;FUNNY INTEGER PROCESSOR
	.IF	DF,$RT11
	TDAT			;CURRENT DATE
	.ENDC
	TTAB			;OUTPUT TAB FUNCTION
;
;
TTAB:	JSR	PC,TGET		;GET ARGUMENT
1$:	PRINT	<' >		;PRINT A SPACE
	CMPB	AC,LINCNT	;SEE WHERE WE STAND
	BHIS	1$		;CONTINUE
	BR	TASK4		;RETURN
;
;---	TBIN - BINARY PROCESSOR
;
TBIN:	JSR	PC,TGET		;GET SET
	BTOA			;PRINT IT OUT
	BR	TASK4		;CONTINUE
;
TINT:	JSR	PC,TGET		;GET  PARAMS
	ITOA			;PRINT INTEGER
	BR	TASK4		;RETURN
;
TGET:	EVAL.X			;EVAL THE EXPRESSION
	FPMP	FINT		;INTEGER IT
	DEC	AXOUT		;BACK UP A CHARACTER
	MOV	AC,PTR		;SET UP FOR OUTPUT
	POPJ			;RETURN
;
	.IF	DF,$RT11
TDAT:	MOV	#9.,AC		;SET COUNT
	MOV	#TODAY,PTR	;POINT AT THE DATE FIELD
1$:	MOVB	(PTR)+,CHAR	;GET THE CHAR
	PRINTC			;PRINT IT
	DEC	AC		;COUNT IT OUT
	BGT	1$		;KEEP IT UP
	BR	TASK4		;RETURN
	.ENDC
	.IFDF	$PAPER


;POWER-FAIL

PWRDWN:	TST	WHOOPS		;CHECK FOR POWER-FAIL OR AUTO-RESTART.
	BNE	PWRUP		;IF NON-ZERO, THEN IT IS POWER-UP.
	MOV	%5,-(SP)	;
	MOV	%4,-(SP)	;SAVE 0-5.
	MOV	%3,-(SP)	;
	MOV	%2,-(SP)	;
	MOV	%1,-(SP)	;
	MOV	%0,-(SP)	;
	MOV	SP,WHOOPS	;FINALLY SAVE THE STACK POINTER HIMSELF.**
NOP:	HALT			;STOP THE PROCESS; FALL-THROUGH FOR FAILSAFE.


;AUTO-RESTART

PWRUP:	MOV	WHOOPS,SP	;RELOAD THE STACK POINTER
	CLR	WHOOPS		;RESET THE SWITCH
	BIS	#101,@ITKS	;RESTORE INTERRUPT ENABLE AND SET READER RUN!
PWREGS:	MOV	(SP)+,%0	;
	MOV	(SP)+,%1	;
	MOV	(SP)+,%2	;
	MOV	(SP)+,%3	;
	MOV	(SP)+,%4	;
	MOV	(SP)+,%5	;RESUME PROCESS AND RESTORE THE STATUS.
PWRON:	RTI			;...

;FOR DEBUGGING WITH SINGLE STEP. (NOT REENTRANT)
;	TST	(SP)+			;MOVE POINTER
;	MOV	(SP)+,	STATUS		;RESTORE STATUS
;	MOV	-6(SP),	PC		;LET THIS INST BE EXECUTED, THEN TRAP.
	.ENDC
	.SBTTL	INCH AND OUTCH ROUTINES
	.IFDF	$PAPER		;PAPER-TAPE I/O

;"INCH" AND "OUTCH"

;USING 'INDEV' AND OUTDEV' FOR 8-BIT I/O.

XI33:	MOV	INDEV,CHAR	;END BUFFER TO POINTER
	CMP	ITKS,CHAR	;TEST FOR DEVICE
	BEQ	KITH		;LOW SPEED
	TSTB	@CHAR		;WAIT FOR FLAG
	BPL	.-2		;WAIT FOR KEYBOARD DONE FLAG
	MOVB	2(CHAR),CHAR	;SAVE INPUT BUFFER
	TSTB	LINMOD		;LINE MODE?
	BNE	XI33X		;NO - PASS ANY CHARACTER
	CMPB	CHAR,#12	;LINE FEED?
	BNE	XI33X		;NO - SKIP IT
	INC	@INDEV		;RE-READ
	BR	XI33		;GO GET IT
XI33X:	INC	@INDEV		;REQUEST NEXT
	RTS	R5		;RETURN FROM I/O DEVICE ROUTINE.

XOUT:	CMP	ITPS,OUTDEV	;(TO TERMINAL?)
	BNE	1$		;NO - FORGET IT
	TSTB	CONFIG+1	;^O IN PROGRESS?
	BNE	2$		;YES - SKIP THE OUTPUT
1$:	MOV	CHAR,-(SP)	;SAVE DATA
	MOV	OUTDEV,CHAR	;LOAD POINTER
	TSTB	@CHAR		;TEST FLAG
	BPL	.-2		;WAIT
	MOVB	@SP,2(CHAR)	;OUTPUT DATA
	MOV	(SP)+,CHAR	;RESET CHARACTER
2$:	RTS	R5		;RETURN


;THIS KEYBOARD CONTROL IS ASYNCHRONOUS

KITH:	MOV	KIN,CHAR	;TEST FOR DATA READY.
	BMI	KITH		;WAIT FOR INTERRUPT DONE
	COM	KIN		;RESET
	BR	XI33X		;RETURN

;KEYBOARD INTERRUPT HANDLER

KINT:	MOV	ITKS,-(SP)
	ADD	#2,@SP		;POINT AT BUFFER REG
	MOV	@(SP),@SP	;RECOVER DATA
	BIC	#-200,@SP	;REMOVE PARITY BITS
	CMPB	@SP,#3		;TEST FOR CONTROL-C
	BNE	KINT1		;NO
	COMB	CCFLG		;YES, CHANGE DATA
	BNE	KINT2		;TWO?
	ERROR+201+0.+0.		;YES
KINT1:	CLRB	CCFLG
	CMPB	@SP,#'O-100	;^O?
	BNE	KINT2
	COMB	CONFIG+1	;REVERSE THE SWITCH
	TST	(SP)+		;IGNORE THE CHARACTER
	RTI			;EXIT
KINT2:	TST	KIN		;ANY ROOM?
	BMI	.+4		;YES
	ERROR+201+18.+18.	;INPUT BUFFER OVERFLOW.
	MOV	(SP)+,KIN	;READ DATA; CLEAR INTERRUPT DONE
	RTI			;CONTINUE
	.IFF
;
XI33:	TST	LIBSW		;IN A LIBRARY COMMAND?
	BEQ	4$		;NO - HANDLE NORMAL INPUT
5$:	JSR	R5,$CHANI	;GET A CHARACTER FROM THE LIB CHANNEL
	BCS	4$		;NOT INPUT FROM LIBRARY NOW.. TRY ORIGINAL
	TSTB	LINMOD		;IGNORE LINE FEEDS?
	BNE	6$		;NO - SKIP IT
	CMPB	CHAR,#12	;A LINE FEED?
	BEQ	5$		;YES - IGNORE IT
6$:	RTS	R5		;RETURN WITH THE CHARACTER IN "CHAR"
4$:	MOV	R0,-(SP)	;SAVE R0
	TST	INDEV		;TERMINAL?
	BNE	2$		;NO - HANDLE IT
50$:	.TTYIN			;GET CHARACTER
	BIC	#-200,R0	;CLEAR BIT 200 IN CASE OF PARITY
	MOV	R0,CHAR		;PASS CHARACTER
	CMPB	CHAR,#3		;A ^C ?		ARB  15-NOV-85
	BEQ	50$		;IGNORE ^C'S	ARB  15-NOV-85
	CMPB	CHAR,#15	;RETURN?
	BNE	1$		;NO - SKIP IT...
	.TTYIN			;IGNORE TRUE L-F!!!
1$:	MOV	(SP)+,R0	;RECOVER R0
	RTS	R5		;RETURN TO USER
;
;---	NON-TERMINAL DEVICE
;
2$:	MOV	INDEV+4,CHAR	;GET OFFSET
	CMP	CHAR,#INLEN*2	;SEE IF ANYMORE
	BLO	3$		;YES - KEEP GOING
	CLR	CHAR
	.READW	#L.CSIT,#ICHAN,#INDEV+6,#INLEN	;READ A BUFFER FULL
	BCC	.+4		;SKIP ERROR IF OK
	ERROR+201+0.+0.		;RESTART IF READ ERROR
	MOV	CHAR,INDEV+4
3$:	ADD	#INDEV+6,CHAR	;POINT TO LOCATION
	MOVB	(CHAR),CHAR	;GET THE CHARACTER
	INC	INDEV+4		;UPDATE THE POINTER
	TSTB	LINMOD		;SEE IF WE SHOULD CHECK THE LINE-FEEDS
	BEQ	1$		;NO - SKIP IT
	CMPB	CHAR,#12	;IS IT A LINE FEED?
	BEQ	2$		;YES - IGNORE IT
	BR	1$
XOUT:	TST	LIBSW		;LIBRARY COMMAND IN PROGRESS?
	BEQ	5$		;NO - USE STANDARD OUTPUT
	MOV	CHAR,-(SP)	;STACK THE CHARACTER
	JSR	R5,$CHANO	;OUTPUT THE CHARACTER
	MOV	(SP)+,CHAR	;REINSTATE THE CHARACTER
	BCS	5$		;LIB COMMAND WAS NOT FOR OUTPUT, TRY ORIGINAL DEV.
	RTS	R5		;RETURN WITH OUR WORK DONE
5$:	MOV	R0,-(SP)	;SAVE R0
	TST	OUTDEV		;TELETYPE?
	BNE	3$		;NO - HANDLE IT
	MOV	CHAR,R0		;GET OUTPUT CHARACTER
	BIC	#-200,R0	;STRIP OUT HIGH BIT
	.TTYOUT			;OUTPUT THE CHARACTER
1$:	MOV	(SP)+,R0	;RECOVER THE REG 0
	RTS	R5		;RETURN TO THE CALLER
;
;---	NON-TERMINAL ROUTINE
;
3$:	MOV	OUTDEV+4,TEMP	;POINT TO OFFSET
	ADD	#OUTDEV+6,TEMP	;NOW AT CORRECT LOCATION
	MOVB	CHAR,(TEMP)+	;PLACE IT INTO THE BUFFER
	SUB	#OUTDEV+6,TEMP	;GET OFFSET
	CMP	TEMP,#OUTLEN*2	;SEE IF FULL YET
	BLO	4$		;NO - SKIP OUTPUT
	.WRITW	#L.CSIT,#OCHAN,#OUTDEV+6,#OUTLEN
	BCC	.+4
	ERROR+201+27.+27.	;I/O ERROR
	CLR	TEMP		;RESET OFFSET
4$:	MOV	TEMP,OUTDEV+4	;RESTORE POINTER FOR LATER
	BR	1$		;EXIT
	.ENDC
	.SBTTL	$PRINT - FLOATING POINT OUTPUT ROUTINE
;
;
;
;
$PRINT:	MOV	TEMP,-(SP)	;SAVE WORK REGS
	MOV	AC,-(SP)
	MOV	PTR,-(SP)	;ALL SAVED
	MOV	CHAR,-(SP)	;SAVE IT
	OPEN			;OPEN A POSITION ON THE STACK
	FPMP	FPUT+INTO+STACK	;SAVE THE FLAC FOR LATER IF NEEDED
	MOV	PTR,AC		;DECODE THE FORMAT
	BIC	#377,PTR	;REMOVE LOW BYTE FROM FORMAT
	BIC	PTR,AC		;REMOVE HIGH BYTE FROM AC
	SWAB	PTR		;GET INTEGER PART IN LOW BYTE
	MOV	PTR,W		;SAVE THE FIELD WIDTH
	FPMP			;ENTER THE FLOATING POINT ROUTINES
	.WORD	FLOAT		;FLOAT THE AC
	.WORD	FDIV+REL,K256-.	;DIVIDE BY 256.... AND THEN
	.WORD	FMUL+IMMED	;MULT BY 100 AND GET OTHER DIGIT
K100:	.FLT4	100.0
	.WORD	FADD+IMMED	;ROUND THE LAST DIGIT
K.5:	.FLT4	0.5
	.WORD	FINT		;AND FINALLY TAKE THE INTEGER PART
	MOV	AC,D		;SAVE THE NUMBER OF DECIMAL PLACES
	FPMP	FGET+FROM+STACK	;RESTORE VALUE TO BE PRINTED
	MOV	#' ,CHAR	;INITIALIZE CHAR FOR LEADING SIGN
	TST	FLAC		;NEG?
	BPL	1$		;NO - SKIP ABS VAL
	BIC	#100000,FLAC	;CLEAR OUT THE FLAC
	MOV	#'-,CHAR	;SET A LEADING MINUS CHARACTER
1$:	TST	W		;EXP?
	BEQ	2$		;YES - GET OUT
	JSR	PC,$ROUND	;ROUND THE VALUE (AC HOLDS # PLACES)
2$:	MOV	CHAR,-(SP)	;SAVE THE SIGN
;
;
;---	SET UP FORMAT AND ALIGN FLAC ACCORDINGLY
;
;	1.0 < =  FLAC  <  10.0
;
;
	JSR	PC,$NORM	;NORMALIZE THE NUMBER
	TST	W		;E FORMAT?
	BEQ	EFORM		;YES - HANDLE IT
	CMP	D,W		;SEE IF TOO BIG
	BHIS	EFORM1		;ERROR - SET E FORMAT
	MOV	W,PTR		;SET FIELD WIDTH
	SUB	D,PTR		;PTR HOLDS # DIGITS TO LEFT OF THE DEC. 
	CMP	TEMP,PTR	;SEE IF WITHIN THE BOUNDS
	BGE	EFORM1		;ENTER E FORMAT
	SUB	PTR,TEMP	;GET NUMBER OF SPACES TO BE OUTPUT
	NEG	TEMP		;MAKE POSITIVE
	DEC	TEMP		;-1 FOR THE FIRST DIGIT
	BNE	3$		;SKIP IF NOT 0
	BR	6$		;SKIP BLANK OUTPUT
;
;
;---	SET UP FOR LEADING ZERO PRINT. ON LEFT OF "." WE OUTPUT
;	BLANKS INSTEAD OF ZEROS. PTR HOLDS THE NUMBER OF POSITIONS
;	TO BE PRINTED BEFORE THE "." - SEE HOW EASY?
;	TEMP HOLDS THE NUMBER OF POSITIONS UNTIL SIGNIFICANCE
;	OCCURRS...... AND AWAY WE GO!...
;
;
3$:	MOV	#' ,CHAR	;SET FOR BLANK OUTPUT
	DEC	PTR		;SEE HOW WE ARE DOING
	BGT	5$		;STILL ON LEFT OF DECIMAL PLACE
	BNE	4$		;SKIP IF DECIMAL PLACE ALREADY OUTPUT
	MOV	(SP)+,CHAR	;RECOVER THE SIGN!!
	PRINTC			;AND PRINT IT
4$:	MOV	#'0,CHAR	;CHANGE SPACE TO "0"
5$:	PRINTC			;PRINT OUT THE CHARACTER
	DEC	TEMP		;SEE IF SIGNIFICANCE HERE YET
	BLE	6$		;YES - START OUTPUTTING GOOD STUFF
	JSR	PC,CPER		;CHECK FOR DEC PT
	BR	3$		;YES - CONTINUE
;
;
;---	TRUE DIGIT OUTPUT STARTS HERE 
;
;
6$:	MOV	PTR,TEMP	;THIS IS CURRENT POSITION REL TO DEC PT
	BLE	7$		;SKIP IF SIGN ALREADY OUTPUT
	MOV	(SP)+,CHAR	;OBTAIN SIGN CHARACTER ( ) OR (-)
	PRINTC			;OUTPUT IT
7$:	ADD	D,TEMP		;SEE HOW MANY DIGITS LEFT TO PRINT
	BEQ	PEXIT		;ALL DONE - EXIT
	JSR	PC,CPER		;CHECK FOR POSSIBLE PERIOD
	JSR	PC,XPRNT	;PRINT IT OUT
;
;
;---	ALL OUTPUT HAS CEASED. - RESTORE DATA AND VAMOOSE
;
;
PEXIT:	FPMP	FGET+FROM+STACK	;GET FLAC RELOADED
	CLOSE			;REPAIR THE HOLE IN THE STACK
	MOV	(SP)+,CHAR	;GET CHARACTER VALUE BACK
	MOV	(SP)+,PTR	;RESTORE USED REGS
	MOV	(SP)+,AC
	MOV	(SP)+,TEMP	;ALL DONE - BYE NOW!!
	RTS	R5		;RETURN TO CALLER
;
;
;---	CONSTANTS
;
;
PTEN:	.FLT4	1E10		;10^10
FTEN:	.FLT4	10.0		;FLOATING POINT 10.0
FONE:	.FLT4	1.0		;FLOAT POINT 1.0
;
;
;---	EFORM1 - ENTRY FOR E FORMAT IF FLAC HAS ALREADY BEEN ROUNDED
;	FOR ANOTHER FORMAT. WE MUST RELOAD ORIGINAL VALUE AND
;	ROUND THE FLAC CORRECTLY
;
EFORM1:	MOV	(SP)+,CHAR	;GET SIGN
	FPMP	FGET+FROM+STACK	;GET THE ORIGINAL VALUE
	.WORD	FABS		;TAKE THE ABS VALUE
	MOV	CHAR,-(SP)	;PLACE IT BACK
	JSR	PC,$NORM	;NORMALIZE IT
;
;---	EFORM - HERE THE FLAC IS NORMALIZED, BUT NOT YET ROUNDED.
;
EFORM:	MOV	(SP)+,CHAR	;OBTAIN SIGN OF NUMBER
	PRINTC			;OUTPUT THE SIGN
	TST	FLAC		;SEE IF ZERO
	BEQ	1$		;SKIP IF TRUE
	TSTB	PRM10		;FLOATING POINT NOTATION OR
				; SCIENTIFIC NOTATION?
	BNE	1$		;USE SCIENTIFIC NOTATION
	FPMP	FDIV+REL,FTEN-.	;DIVIDE BY ONE PLACE
	INC	TEMP		;ADJUST THE EXP
1$:	MOV	TEMP,-(SP)	;ADJUSTMENT EXPONENT
	MOV	#1,PTR		;ONE PLACE IN FRONT OF THE DECIMAL POINT
	TST	W		;INTENSIONAL E FORMAT?
	BNE	2$		;NO - USE DEFAULT
	MOV	D,AC		;GET THE SPECIAL FIELD
	BNE	3$		;OK - EXIT WITH IT
2$:	MOV	#6,AC		;GET DEFAULT OF 6 SIGNIFICANT DIGITS
	TST	#$DBL		;DOUBLE PRECISION?
	BEQ	3$		;NO - FORGET IT
	ASL	AC		;DOUBLE IT
3$:	MOV	AC,-(SP)	;SAVE IT FOR LATER
	JSR	PC,$ROUND	;ROUND THE NUMBER
	MOV	(SP)+,AC	;GET IT BACK
	TSTB	PRM10		;SCIENTIFIC NOTATION?
	BEQ	7$		;NO - USE OTHER CRITERIOR
	CMP	FLAC,FTEN	;SEE IF GREATER THAN 10.0
	BLO	6$		;NO - SKIP IT
7$:	CMP	FLAC,FONE	;SEE IF STILL NORMALIZED CORRECTLY
	BLO	6$		;SKIP IF NOT
	INC	@SP		;MARK THE EXPONENT CORRECTLY
	FPMP	FDIV+REL,FTEN-.	;DIVIDE BY TEN
6$:	ADD	PTR,AC		;TRUE NUMBER
	MOV	AC,TEMP		;ALL SET NOW
	JSR	PC,XPRNT
	PRINT	<'E>
	MOV	(SP)+,PTR	;GET EXPONENT
	BMI	4$		;PRINT MINUS SIGN
	PRINT	<'+>		;PRINT PLUS SIGN
	BR	5$		;CONTINUE
4$:	PRINT	<'->		;OUTPUT A MINUS SIGN
	NEG	PTR		;MAKE A POSITIVE EXPONENT
5$:	JSR	PC,ERRDMP	;OUTPUT THE 2 DIGIT VALUE
	BR	PEXIT		;EXIT
;
;
;	ERRDMP - 2 DIGIT OUTPUT ROUTINE
;
ERRDMP:	DIGTST	10.		;GET FIRST DIGIT
	PRINTC			;PRINT IT
	MOV	PTR,CHAR	;RECOVER LAST DIGIT
	ADD	#'0,CHAR	;MAKE IT PRINTABLE
	PRINTC			;AND PRINT IT
	POPJ			;RETURN
;
;
;
;---	PRINT ROUTINE
;
XPRNT:	FPMP	FINT		;GET INTEGER PORTION
	MOV	AC,CHAR		;GET THE CHARACTER
	ADD	#'0,CHAR	;MAKE IT PRINTABLE
	DEC	PTR		;COUNT OUT IN CASE DECIMAL POINT HASN'T 
	PRINTC			;PRINT OUT THE DIGIT
	DEC	TEMP		;COUNT OUT
	BLE	2$		;SKIP IF NEED BE
	JSR	PC,CPER		;CHECK FOR DEC PT
	OPEN			;OPEN A TEMP AREA ON THE STACK
	FPMP			;ENTER FLT PT MODE
	.WORD	FPUT+INTO+STACK	;SAVE THE FLAC
	.WORD	FINT,FLOAT,FNEG	;FLOAT THE AC AND NEGATE IT
	.WORD	FADD+FROM+STACK	;ADJUST FLAC ACCORDINGLY
	.WORD	FMUL+REL,FTEN-.	; SHIFT OVER ONE DIGIT
	CLOSE			;REPAIR THE HOLE IN THE STACK
	BR	XPRNT		;CONTINUE
2$:	POPJ			;RETURN TO CALLER
;
;---	ROUTINE TO CHECK FOR DEC PT
;
CPER:	TST	PTR		;END?
	BNE	1$
	PRINT	<'.>		;PRINT IT
1$:	POPJ			;RETURN
;
;
$ROUND:	OPEN			;GET SAVE AREA
	FPMP	FPUT+INTO+STACK	;SAVE THE VALUE
	.WORD	FZER		;ZERO THE FLAC
	TSTB	PRM6		;ROUND?
	BNE	2$		;NO - EXIT
	FPMP	FGET+REL,K.5-.	;GET 0.5 INTO THE FLAC
	TST	AC		;D=0?
	BEQ	2$		;YES - ENOUGH!!
1$:	FPMP	FDIV+REL,FTEN-.	;DIVIDE BY TEN FOR EACH PLACE
	DEC	AC		;COUNT IT OUT
	BGT	1$		;KEEP IT UP
2$:	FPMP	FADD+FROM+STACK	;ROUND THE VALUE
	CLOSE			;REMOVE THE SAVE AREA
	POPJ			;RETURN TO CALLER
;
;
$NORM:	CLR	TEMP		;INIT TO ZERO
	TST	FLAC		;LEADING ZERO?
	BEQ	3$
1$:	CMP	FLAC,FONE	;SEE WHAT THE RANGE IS
	BGE	2$		;NOTE: SINCE FLAC IS POS, INTEGER COMPARISONS
				; ON THE FIRST WORD OF A FLOATING
				; POINT NUMBER WORK AS WELL AS A FLOATING
				; POINT COMPARISON!..NEAT!
	FPMP	FMUL+REL,FTEN-.	;MULTIPLY BY TEN
	DEC	TEMP		;ADJUST POSITION COUNTER
	BR	1$		;CONTINUE UNTIL FINISHED
2$:	CMP	FLAC,FTEN	;SEE IF OK THE OTHER WAY
	BLT	3$		;SKIP OUT IF OK
	FPMP	FDIV+REL,FTEN-.	;DIVIDE BY TEN
	INC	TEMP		;ADJUST SHIFT POINTER
	BR	2$		;CONTINUE UNTIL STABLE
3$:	POPJ			;RETURN
	.SBTTL	$READ - FLOATING POINT INPUT ROUTINE
;
;
$READ:	FPMP	FZER		;START WITH A CLEAR FLAC
	MOV	TEMP,-(SP)	;SAVE REGS
	MOV	AC,-(SP)	;0,1,AND 2
	MOV	PTR,-(SP)	;FINISH THE REG SAVE
	CLR	-(SP)		;SET SWITCH FOR POSITIVE DEFAULT VALUE
	OPEN			;OPEN A SAVE AREA ON THE STACK
	CLR	TEMP		;NO DECIMAL POINT HAS BEEN SEEN YET!
	CLR	AC		;IN CASE OF A TERMINATOR
	CLR	PTR		;SET COUNTER FOR REL POS TO "."
;
1$:	TSTB	CHAR		;LOOK AT FIRST CHARACTER
	BPL	3$		;IF NOT A TERMINATOR, CONTINUE
	CMPB	CHAR,#201	;A + ?
	BEQ	2$		;IF SO, SKIP OUT
	CMPB	CHAR,#202	;A - CHAR?
	BNE	8$		;NO - TERMINATORS NOW TERMINATE THE FIELD
	INC	10(SP)		;SET SWITCH FOR NEGATIVE RESULT
;
2$:	GETC			;GET ANOTHER CHARACTER
	BMI	8$		;ANOTHER TERMINATOR FINISHES THIS FIELD
;
3$:	CMPB	CHAR,#'.	;DECIMAL POINT?
	BEQ	5$		;IF SO, HANDLE IT SPECIALLY
	SKPNON	6$		;JUMP TO 6$ IF NUMERIC
;
;---	ALPHA CHARACTER ENCOUNTERED
;
	BITB	#NALPHA,SWITCH	;ALPHA ALLOWED?
	BEQ	8$		;NO - EXIT
	CMPB	CHAR,#'E	;IS IT EXP TIME?
	BEQ	7$		;YES - HANDLE IT
	BIC	#-40,CHAR	;GET VALUE 1-26 FOR A-Z
;
4$:	MOV	CHAR,AC		;SET VALUE
	FPMP			;ENTER FLOATING POINT MODE
	.WORD	FMUL+REL,FTEN-.	;MULTIPLY FLAC BY 10.0
	.WORD	FPUT+INTO+STACK	;SAVE IT ON THE STACK
	.WORD	FLOAT		;FLOAT THE AC
	.WORD	FADD+FROM+STACK	;ADD THE SCALED FLAC 
	CLR	AC		;RESET THE AC
	TST	TEMP		;A PERIOD ENCOUNTERED?
	BEQ	2$		;NO - NO YET - RETURN FOR MORE
	DEC	PTR		;KEEP TRACK OF OUR MULTIPLY
;
5$:	INC	TEMP		;FLAG THAT DEC. PT. HAS BEEN SEEN
	BR	2$		;EXIT FOR MORE CHARACTERS
;
;---	HERE A DIGIT WAS SEEN
;
6$:	BIC	#-20,CHAR	;MAKE A BCD CODE
	BR	4$		;ENTER INTO THE FLAC
;
;---	E FOUND IN FLOATING POINT NUMBER
;
7$:	FPMP	FPUT+INTO+STACK	;SAVE THE FLAC
	GETC			;GET THE NEXT CHARACTER
	FREAD			;READ THE NEXT NUMBER (RE-ENTRANT!!)
	FPMP	FINT		;GET AS AN INTEGER PORTION
	.WORD	FGET+FROM+STACK	;RECOVER ORIGINAL FLAC
;
;
;---	HERE WE ARE OUT OF NUMBERS. PTR HOLDS THE NUMBER OF MULTIPLICATIONS
;	REMAINING DUE TO SHIFTS (ALWAYS NEG AS WE MUST DIVIDE)
;
;	AC HOLDS THE EXTERNAL E FIELD VALUE IF ANY.
;
;	SUM OF THESE IS THE NET SHIFTING WHICH MUST BE DONE
;
8$:	ADD	PTR,AC		;GET NET SHIFT
	MOV	AC,TEMP		;MOVE TO A SAFE REGISTER
	BEQ	12$		;IF NONE, GET OUT!
	BMI	9$		;JUMP IF WE MUST DIVIDE
	MOV	#FMUL+REL,AC	;SET CODE FOR FLOATING POINT ROUTINES
	BR	10$		;CONTINUE
;
9$:	MOV	#FDIV+REL,AC	;GET CODE FOR DIVISION
	NEG	TEMP		;GET ABS VALUE OF THE EXPONENT
;
10$:	CMP	TEMP,#10.	;SEE IF GREATER THAN 10
	BLT	11$		;NO - USE UNARY SHIFT
	FPMP	FCODE,PTEN-.	;MULT/DIVIDE BY 1E10
	SUB	#10.,TEMP	;REMOVE IT
	BGT	10$		;KEEP IT UP IF MORE TO GO
	BEQ	12$		;EXIT IF THAT DID IT
11$:	FPMP	FCODE,FTEN-.	;MULT/DIVIDE BY 10.0
	DEC	TEMP		;COUNT IT OUT
	BGT	11$		;KEEP IT UP
;
;---	HERE ALL IS FINISHED. CLEAN UP AND GO!!!!
;
12$:	CLOSE			;REPAIR THE HOLE IN THE STACK
	TST	(SP)+		;CHECK THE SIGN TO BE IMPOSED
	BEQ	13$		;POSITIVE MEANS GET OUT
	FPMP	FNEG		;NEGATE THE FLAC
;
13$:	MOV	(SP)+,PTR	;RECOVER THE REGISTERS
	MOV	(SP)+,AC	;0,1,AND 2
	MOV	(SP)+,TEMP	;LEAVING THE ANSWER IN THE FLAC
	RTS	R5		;AND RETURN TO THE CALLER

	.SBTTL	FABS,FSGN, AND FCLK FUNCTIONS

XABS:	BIC	#100000,FLAC
	POPJ
;
XSGN:	FPMP	FSGN		;GET THE SIGN
	POPJ

;
;---	XFCLK - CLOCK FUNCTION
;
	.GLOBL	CLKT
;
XFCLK:	OPEN			;GET STACK SPACE
	FPMP	FPUT+INTO+STACK	;SAVE THE PASSED VALUE
	.IF	DF,$RT11
	.GTIM	#L.CSIT,#CLKT	;GET THE CLOCK VALUE
	.ENDC
XFLT:	MOV	CLKT+2,AC	;GET THE VALUE
	ROL	AC		;MAKE 2 15 BIT NUMBERS
	ASL	CLKT		;UPDATE THE HIGH WORD
	ROR	AC		;CORRECT THE AC
	OPEN			;GET A SECOND SAVE AREA
	FPMP	FLOAT		;FLOAT THE VALUE
	.WORD	FPUT+INTO+STACK	;SAVE IT
	MOV	CLKT,AC		;GET THE HIGH WORD
	FPMP	FLOAT		;GET IT IN FLOATING POINT
	.WORD	FMUL+REL,KMAX-.	;SET INTO HIGH WORD
	.WORD	FADD+FROM+STACK	;TRUE TIME OF DAY IN CLOCK TICKS
	CLOSE			;REPAIR THE LATEST HOLE
	FPMP	FSUB+FROM+STACK	;SUB OFFSET ARGUEMENT
	CLOSE			;REPAIR THE HOLE
	POPJ			;RETURN TO THE CALLER
;
CLKT:	0,0			;SAVE AREA FOR THE TIME OF DAY
;
	.IF	DF,$PAPER
CINT:	INC	CLKT+2
	ADC	CLKT
	RTI
	.ENDC
	.SBTTL	IOFIX - OPERATE COMMAND PROCESSOR
	.IFDF	$PAPER		;PAPER TAPE VERSION...

; *OPERATE*=PROGRAMMABLE I/O COMMAND. <OPTIONAL>


IOFIX:	SUB	#IOLIST,AC	;GET OFFSET
	ASL	AC		;MAKE WORD OFFSET
	MOV	IOPATCH(AC),PTR	;GET PATCH ADDRESS
	MOV	IOGO(AC),@PTR	;STORE THE PATCH
	CMP	IPRS,@PTR	;H.S.?
	BNE	IOQ		;NO
	BIT	#4200,@(PTR)+	;YES, 'BUSY' OR 'DONE'?
	BNE	IOQ		;YES
	INC	@-(PTR)		;NO, SET READER ENABLE.
	.IFF
;
IOFIX:	SUB	#IOLIST,AC	;GET OFFSET
	ASL	AC		;BYTE TO WORD INDEX
	MOV	AC,-(SP)	;SAVE FOR LATER
	MOV	IOPATCH(AC),PTR	;POINT TO THE SLOT (IN OR OUT)
	CMP	IOGO(AC),@PTR	;SEE IF A NO-OP (SAME)
	BEQ	5$		;YES - IGNORE THE REQUEST
	CMP	AC,#IOSW	;SEE IF INPUT OR OUTPUT
	BLO	3$		;GO TO HANDLE THE INPUT DEVICES
;
;---	THIS IS AN OUTPUT OPERATE REQUEST - SEE IF TTY WAS OLD MODE
;
	TST	(PTR)+		;WAS IT A TTY?
	BEQ	1$		;YES - NO CLEAN-UP REQUIRED
	JSR	PC,FLUSH	;FLUSH OUT THE OUTPUT CHARACTERS
	.CLOSE	#OCHAN		;CLOSE THE OUTPUT CHANNEL
	TST	-(PTR)		;POINT AT THE DEVICE MNEUMONIC..
	RELHAN			;RELEASE THE HANDLER IF OTHERWISE NOT IN USE
1$:	MOV	(SP)+,AC	;RECOVER AC
	MOV	IOGO(AC),-(PTR)	;SET NEW CODE
	BEQ	IOQ		;EXIT NOW IF TTY
	TST	(PTR)+		;UPDATE THE POINTER
	MOV	IONAME(AC),@PTR	;SET THE RAD50 NAME FOR THE DEVICE
	GETHAN			;GET THE HANDLER IN CORE IF NOT HERE!
	CLR	2(PTR)		;RESET THE BYTE POINTER OFSET
	.ENTER	#L.CSIT,#OCHAN,PTR,#0	;OPEN THE FILE FOR OUTPUT
	BCC	IOQ		;OK - NO ERROR
	ERROR+201+27.+27.	;I/O ERROR
;
;---	INPUT DEVICE IS CHANGING... HANDLE ACCORDINGLY!
;
3$:	TST	(PTR)+		;SEE IF TTY WAS OLD DEVICE
	BEQ	4$		;IF SO - SKIP CLOSE ON CHAN
	.CLOSE	#ICHAN		;CLOSE THE INPUT DEVICE
	RELHAN			;RELEASE THE HANDLER
4$:	MOV	(SP),AC		;GET WORD INDEX FOR NEW DEVICE
	MOV	IONAME(AC),@PTR	;SET IN THE NEW NAME
	MOV	IOGO(AC),-(PTR)	;SET THE NEW DEVICE CODE
	BEQ	5$		;IF IT IS THE TTY, EXIT
	TST	(PTR)+		;POINT AT THE RAD50 CODE
	GETHAN			;GET THE DEVICE HANDLER
	.LOOKUP	#L.CSIT,#ICHAN,PTR ;OPEN THE DEVICE ON THE INPUT CHANNEL
	BCC	.+4		;SKIP IF OK... ELSE
	ERROR+201+27.+27.	;I/O ERROR
	MOV	#INLEN*2,2(PTR)	;SET THE OFFSET FOR A FRESH READ
5$:	TST	(SP)+		;POP THESTACK

	.ENDC
IOQ:	GETC			;LOOK AT NEXT TEXT CHAR.
PROGIO:	SPNOR			;GOTO NEXT LETTER
	SORTC	IOLIST,IOFIX	;TEST
;
	.IFDF	$PAPER
FLUSH:	POPJ
	.IFF
;---	FLUSH - ROUTINE TO OUTPUT STRAGLING OUTPUT CHARACTERS
;
FLUSH:	MOV	#OUTDEV,PTR	;POINT AT THE OUTPUT AREA
	CMP	(PTR)+,ITPS	;TERMINAL?
	BNE	1$		;NO - FORCE ALL OUTPUT OUT NOW
	POPJ			;RETURN NOW

1$:	TST	(PTR)+		;SKIP THE DEVICE MNEUMONIC FOR NOW
	MOV	(PTR)+,TEMP	;GET OFFSET
	ADD	PTR,TEMP	;POINT AT NEXT LOCATION TO BE OUTPUT
	CLRB	(TEMP)+		;FORCE A POSSIBLE PAD NULL...
	SUB	PTR,TEMP	;GET LENGTH
	ASR	TEMP		;GET NUMBER OF WORDS
	BEQ	2$		;SKIP LAST WRITE
	MOV	TEMP,AC		;SET NUMBER OF WORDS
	.WRITW	#L.CSIT,#OCHAN,PTR,AC ;WRITE OUT THE LAST PART
2$:	CLR	-(PTR)		;RESET THE BYTE POINTER FOR CLEAR BUFFER
	POPJ			;RETURN
	.ENDC
	.IFDF	$RT11
	.SBTTL	$GETHN - GETHAN ROUTINE TO LOAD A DEVICE HANDLER
;
;---	THIS ROUTINE SEES IS A PARTICULAR DEVICE HANDLER IS IN CORE.
;	IF IT IS, THEN ALL IS WELL, AND THE USER IS HANDED CONTROL.
;	IF IT IS NOT, THEN THE SYMBOL TABLE MUST BE SHUFFLED
;	AWAY FROM THE HIGH END, AND THE HANDLER LOADED IN THE
;	FIRST FREE SLOT ALLOCATED BY THE DMA ROUTINES
;
$GETHN:	SUB	#10,SP		;OBTAIN 4 FREE WORDS
	MOV	SP,AC		;SAVE
	.DSTAT	AC,PTR		;GET A STATUS BLOCK ON THE DEVICCE
	BCC	1$		;SKIP IF OK
	ERROR+201+27.+27.	;I/O ERROR
1$:	TST	(SP)+		;POP OFF THE STATUS BITS
;
;---	GET THE LENGTH INTO CORRECT FORM
;
	ADD	#511.,(SP)	;SET FOR ROUNDING
	ASR	(SP)		;DIVIDE BY 2 FOR WORD COUNT
	CLRB	(SP)		;THIS DOES IT
	MOV	2(SP),AC	;GET THE ADDRESS
	BIC	#377,AC		;CLEAR THE LOW ORDER BYTE
	BNE	4$		;IT IS IN CORE SOMEWHERE
	MOV	#HANDTB,TEMP	;IF NOT, THEN FIND A SLOT FOR IT
	MOV	#MAXHAN,-(SP)	;STACK THE COUNT
2$:	TST	(TEMP)+		;SCAN FOR A FREE SPACE
	BEQ	3$		;EXIT IF WE FIND ONE
	DEC	(SP)		;OR IF WE
	BGT	2$		;EXHAUST OUR SPACE
	ERROR+201+28.+28.	;INSUFFISCIENT RESOURCES
3$:	MOV	2(SP),(SP)	;COPY THE LENGTH
	MOV	TEMP,IDENT	;CONSTRUCT THE IDENT BYTE CODE
	SUB	#HANDTB,IDENT	;GET OFFSET
	NEGB	IDENT		;LEAVES [0,CODE] IN IDENT
	MOV	TEMP,4(SP)	;STACK THE ADDRESS FOR LATER
	SWAB	(SP)		;CONVERT LENGTH FOR REQM
	REQM			;GET MEMORY FROM FOCAL DMA
	MOV	(SP)+,AC	;GET ADDRESS
	.FETCH	AC,PTR		;GET THE HANDLER INTO CORE
	BCC	.+4		;SKIP ERROR IF CORRECT
	ERROR+201+27.+27.	;I/O  ERROR
	BIC	#377,AC		;ZAP THE LOW ORDER BYTE
	ASR	(SP)		;SET LENGTH CODE
	ASR	(SP)		;INTO BITS 6,7
	BISB	(SP)+,AC	;CODE ALMOST COMPLETE
	MOV	(SP)+,TEMP	;RECOVER ADDRESS OF SLOT+2
	INC	AC		;MARK ONE USER IN CORE
	MOV	AC,-(TEMP)	;ALL IS COMPLETED...
	TST	(SP)+		;FINAL POP
	RTS	R5		;RETURN FROM SUBROUTINE
;
;---	DRIVER WAS ALREADY IN CORE.. SEE IF OURS AND MARK ANOTHER USER
;
4$:	CMP	AC,HICORE	;SEE IF ON A 256 WORD BOUNDARY..
	BHIS	8$		;NO - NOT OURS.. EXIT
	SWAB	AC		;PLACE INTO LOW BYTE
	MOV	#HANDTB,TEMP	;POINT TO TABLE OF HANDLERS WE OWN
	MOV	#MAXHAN,-(SP)	;STACK THE NUMBER OF SLOTS TO HECK
5$:	CMPB	AC,1(TEMP)	;SEE IF THIS IS THE DRIVER
	BEQ	6$		;YES - MARK ANOTHER USER
	TST	(TEMP)+		;BUMP THE POINTER
	DEC	(SP)		;EXHAUST THE COUNT
	BGT	5$		;KEEP PLUGGING AWAY...
	BR	7$		;SKIP COUNT
6$:	INC	(TEMP)		;UPDATE IN-USE COUNTER
7$:	TST	(SP)+		;POP THE STACK
8$:	ADD	#6,SP		;POP 3 WORDS
	RTS	R5		;RETURN TO CALLER
	.SBTTL	$RELHN - RELHAN ROUTINE TO RELEASE DEVICE HANDLERS
;
;---	THIS ROUTINE DECREMENTS THE COUNT ON A DRIVER, AND IF THE
;	LAST ONE USING THE ROUTINE, THE HANDLER IS RELEASED
;
$RELHN:	SUB	#10,SP		;GET 4 FREE WORDS
	MOV	SP,AC		;SAVE POINTER
	.DSTAT	AC,PTR		;GET STATUS ON DEVICE
	BCC	1$		;SKIP IF NO ERROR
	ERROR+201+27.+27.	;I/O ERROR
1$:	TST	(SP)+		;POP THE STATUS
	ADD	#511.,(SP)	;ROUND THE SIZE FOR 256 WORD BLOCKS
	ASR	(SP)		;DIVIDE BY 2 FOR WORD COUNT...
	CLRB	(SP)		;THIS DOES THAT!
	MOV	2(SP),AC	;RECOVER THE ADDRESS
	BIC	#377,AC		;CLEAR OUT THE LOW BYTE
	BEQ	4$		;EXIT IF GONE ALREADY...
	CMP	AC,HICORE	;WITHIN OUR AREA?
	BHIS	4$		;NO - EXIT...
	SWAB	AC		;GET ADDRESS/256
	MOV	#HANDTB,TEMP	;POINT TO HANDLER INDEX
	MOV	#MAXHAN,-(SP)	;STACK THE COUNT
2$:	CMPB	AC,1(TEMP)	;SEE IF THIS IS THE ONE
	BEQ	3$		;YES - REMOVE IT?
	TST	(TEMP)+		;INDEX
	DEC	(SP)		;COUNT IT OUT
	BGT	2$		;KEEP IT UP..
	TST	(SP)+		;NOT OURS - GET OUT!!
	BR	4$
3$:	DEC	(TEMP)		;REMOVE A USER
	TST	(SP)+		;POP THE OLLD COUNT
	BIT	#77,(TEMP)	;SEE IF THIS IS ALL!
	BNE	4$		;NO - EXIT NOW
	CLR	(TEMP)		;RELEASE FROM OUR SLOT
	SUB	#HANDTB,TEMP	;GET OFFSET
	COMB	TEMP		;GET IDENT CODE
	MOV	TEMP,IDENT	;SET ID
	CLRM			;RELEASE ALL MEMORY FOR THAT GUY
	.RELEAS	PTR		;RELEASE THE HANDLER
	BCC	4$		;SKIP IF OK
	ERROR+201+27.+27.	;I/O ERROR
4$:	ADD	#6,SP		;POP 3 WORDS
	RTS	R5		;EXIT..................^
	.ENDC
	.SBTTL	TDUMP - THE "TYPE $" OUTPUT ROUTINE




;SYMBOL TABLE TYPEOUT ROUTINE <OPTIONAL>

;USED BY *TYPE*ASK*
;VIA 'ATLIST'

	.IFDF	$PAPER		;PAPER-TAPE VERSION ONLY
TDUMP:	MOV	R5,-(SP)	;SAVE THE POINTER
	MOV	STARTV,R5	;INIT POINTER
TDUMP1:	TST	@R5		;TEST FOR NULL ENTRY
	BNE	TDUMP2		;GO TYPE NAME, ETC.
	TST	#$DBL		;DOUBLE PRECISION VERSION?
	BEQ	1$		;NO - NORMAL BUMP
	ADD	#4,R5		;ADDITIONAL BUMP REQUIRED
1$:	ADD	#10,R5		;MOVE POINTER
TDUMP3:	CMP	R5,BOTTOM	;TEST LIMITS
	BLO	TDUMP1		;TRY AGAIN
	BR	TDUMP5		;OUTPUT IT
				;
TDUMP2:	PRINT2	<"S >		;MAKE COMMANDS!
	MOVB	(R5)+,CHAR	;READ FIRST LETTER OF NAME N
	PRINTC			;AND PRINT SAME
	MOVB	(R5)+,CHAR	;READ SECOND LETTER
	BMI	1$		;IGNORE SPACE
	PRINTC			;AND PRINT
1$:	PRINT	<'(>		;OPEN PARENTHESIS
	TST	(R5)+		;ALL ZEROS?
	BEQ	TDUMP4		;YES
	TST	-(R5)
	MOVB	(R5)+,PTR	;COPY SUBSCRIPT #1 AND TEST SIGN.
	ITOA
	PRINT	<',>		;COMMA
	MOVB	(R5)+,PTR	;COPY LEFT-HAND BITS AND
	ITOA
TDUMP4:	PRINT2	<")=>		;CLOSE PARE
	MOV	R5,PTR		;COPY POINTER.
	FPMP	FGET+IPTR	;LOAD THE VALUE OF THE VARIABLE
	MOV	FISW,PTR	;LOAD FORMAT DATA
	FPRINT			;PRINT CONTENT OF FLAC
	PRINT2	<CRLF>		;PRINT CRLF AT END OF LINE
	TST	#$DBL		;DOUBLE PRECISION?
	BEQ	1$		;NO - SKIP IT
	CMP	(R5)+,(R5)+	;SKIP TWO EXTRA WORDS
1$:	CMP	(R5)+,(R5)+	;MOVE POINTER TO NEXT ENTRY
	BR	TDUMP3		;CONTINUE THE SCAN
	.IFF
TDUMP:	MOV	R5,-(SP)	;SAVE THE RETURN ADDRESS
	MOV	STARTV,R5	;POINT AT THE SYMBOL TABLE
	CMP	R5,BOTTOM	;NULL TABLE?
	BHIS	TDUMP5		;YES - FAST EXIT..
1$:	PRINT2	<"S >		;FUDGE A SET
	MOVB	1(R5),CHAR	;GET A CHARACTER
	BIC	#-200,CHAR	;FORCE SIGN BIT OFF
	PRINTC			;PRINT IT
	MOVB	(R5),CHAR	;GET OTHER CHARACTER
	BIC	#-200,CHAR	;REMOVE SIGN HERE ALSO
	BEQ	2$		;SKIP OUTPUT IF BLANK
	PRINTC			;OUTPUT THE CHARACTER
2$:	TST	@R5		;SEE IF SUBSCRIPTED.
	BPL	5$		;NO - OUTPUT THE VALUE ONLY
	PRINT	<'(>		;OUTPUT THE PARENS...
	BIT	#200,(R5)+	;DOUBLE SUBSCRIPT?
	BNE	4$
;
;---	SINGLE SUBSCRIPT.
;
	MOV	(R5)+,PTR	;EXTRACT THE VALUE
11$:	ITOA			;PERFORM INTEGER TO ASCII CONVERSIONS
	PRINT2	<")=>		;SET CODE
9$:	MOV	R5,PTR		;COPY THE POINTER
	FPMP	FGET+IPTR	;GET THE VALUE
	MOV	FISW,PTR	;LOAD THE FORMAT DATA
	FPRINT			;OUTPUT THE VALUE
	PRINT2	<CRLF>		;RETURN THE CARRIAGE
	CMP	(R5)+,(R5)+	;MOVE TO THE NEXT ENTRY
	TST	#$DBL		;DOUBLE PRECISION?
	BEQ	3$		;NO - SKIP IT
	CMP	(R5)+,(R5)+
3$:	CMP	R5,BOTTOM	;DONE YET?
	BLO	1$		;CONTINUE
	BR	TDUMP5		;EXIT
;
;---	DOUBLE SUBSCRIPT
;
4$:	MOVB	(R5)+,PTR	;GET PTR
	ITOA			;OUTPUT THE SUBSCRIPT VALUE
	PRINT	<',>		;OUTPUT A COMMA
	MOVB	(R5)+,PTR	;GET OTHER SUBSCRIPT
	BR	11$		;HANDLE IT
;
;---	NON-SUBSCRIPTED..
;
5$:	TST	(R5)+		;POINT AT THE VALUE
	PRINT <'=>		;SEND OUT THE EQUAL SIGN
	BR	9$		;HANDLE THE OUTPUT
	.ENDC
;
;---	OUTPUT THE "&" VARIABLE
;
TDUMP5:	PRINT2	<"S >		;FINAL SET
	PRINT2	<"&=>		;TEMP VARIABLE
	JSR	PC,WHIPV	;POINT AT THE VARIABLE
	FPMP	FGET+IPTR	;LOAD IT
	MOV	FISW,PTR	;LOAD THE FORMAT CODE
	FPRINT			;PRINT IT OUT
	MOV	(SP)+,R5	;RESTORE THE RETURN ADDRESS
	PRINT2	<CRLF>
	JMP	TASK4		;RE-ENTER THE TYPE COMMAND
	.SBTTL	ITOA,OTOA,BTOA OUTPUT CONVERSION ROUTINES
;
;---	ITOAX - INTEGER TO ASCII CONVERSION AND OUTPUT
;
ITOAX:	TST	PTR
	BPL	1$
	NEG	PTR		;FORCE ABS VALUE
	PRINT	<'->		;OUTPUT THE MINUS SIGN
1$:	MOV	#DECTAB,TEMP	;POINT AT DECIMAL TABLE
XTOA:	MOV	PTR,-(SP)	;STACK THE ORIG PTR
1$:	MOV	(TEMP)+,2$	;SET THE VALUE
	BEQ	4$		;HANDLE THE LAST CHARACTER
	DIGTST			;TEST THE DIGITS
2$:	0			;*** FILLED IN BY ABOVE CODING ***
	TSTB	PRM8		;FILL IN LEADING ZEROS?
	BNE	3$		;YES - SKIP EXIT
	CMP	PTR,(SP)	;SEE IF SIGNIFICANT YET
	BEQ	1$		;NO - PTR HASN'T CHANGED YET...
3$:	PRINTC			;OUTPUT THE CHARACTER
	BR	1$		;CONTINUE...
4$:	TST	(SP)+		;POP OFF THE OLD VALUE
	MOV	PTR,CHAR	;SET FOR FINAL OUTPUT
	ADD	#'0,CHAR	;SET IT
	PRINTC			;PRINT IT
	RTS	R5		;RETURN TO USER
;
;---	DECTAB - DECIMAL TABLE FOR OUTPUT CONVERSION
;
DECTAB:	10000.
	1000.
	100.
	10.
	0			;TABLE TERMINATOR
;
;---	OCTTAB - OCTAL CONVERSION TABLE
;
OCTTAB:	100000
	10000
	1000
	100
	10
	0
;
;---	OTOAX - CONVERSION ENTRY POINT
;
OTOAX:	MOV	#OCTTAB,TEMP	;POINT AT THE CONVERSION TABLE
	BR	XTOA		;ENTER THE CONVERSION TABLE
;
	.GLOBL	XTOA		;GENERAL ENTRY POINT
;
;
;---	BTOA - BINARY TO ASCII
;
BTOAX:	MOV	OCTTAB,2$	;SET FIRST ONE
	MOV	PTR,-(SP)	;SAVE IT
1$:	DIGTST			;SET UP FOR DIGIT
2$:	.WORD	0		;FILLED IN BY ABOVE!!!
	TSTB	PRM8		;ZERO FILL?
	BNE	3$		;YES - PRINT IT
	CMP	PTR,@SP		;SIGNIFICANT?
	BEQ	4$		;NO - SKIP OUTPUT
3$:	PRINTC			;PRINT THE CHARACTER
4$:	CLC			;FORCE CARRY OFF
	ROR	2$		;SHIFT DOWN ONE
	BNE	1$		;CONTINUE UNTIL ALL GONE
	MOV	(SP)+,PTR	;RESTORE THE PTR
	RTS	R5		;RETURN TO THE CALLER
	.SBTTL	FRAN - RANDOM NUMBER GENERATOR

;RANDOM NUMBER GENERATOR <OPTIONAL>

;FRAN() - A STATISTICALLY RANDOM, PSEUDO-NOISE SHIFT REGISTER

;WITH PERIODICITY = 32767(10).

;AVERAGE = .00060

;RANGE = +1 TO -1

XRAN:	FPMP	FINT		;GET INTEGER PART
	MOV	#LSPR,PTR
	MOV	#14,R5
	TST	AC		;NON-ZERO ARGUMENT INITIALIZES
	BEQ	XROL
	MOV	#107654,@PTR
XROL:	MOV	@PTR,AC
	ROL	AC
	BMI	.+4
	COM	AC		;XOR BITS 13+14
	ROL	AC
	ROL	AC
	ROL	@PTR		;(THANKS JOHN LARKIN!)
	DEC	R5
	BGT	XROL
	MOV	@PTR,AC		;RANGE IS +1-1
	FPMP	FLOAT		;FLOAT THE AC
	.WORD	FDIV+IMMED	;DIVIDE BY MAX VALUE
KMAX:	.FLT4	32767.0		;LARGEST POSITIVE NUMBER
	POPJ
	.IF	NDF,$SMALL
;
;---	FERR FUNCTION - X FERR(RTN#)
;
XFERR:	MOVB	SWITCH,-(SP)	;SAVE CURRENT SWITCH INFO
	JSR	R5,GTESTW	;LOAD "LINENO"
	MOVB	SWITCH,ERRSW	;SET UP ERROR SWITCH FOR ROUTINE
	MOVB	(SP)+,SWITCH	;REPLACE THE CURRENT SWITCH SETTING
	MOV	ERRLIN,AC	;RETURN THE OLD ERROR ROUTINE LOCATION
	FPMP	FLOAT
	.WORD	FDIV+REL,K256-.	;PLACE IN PROPER PERSPECTIVE
	MOV	LINENO,ERRLIN	;SET NEW ERROR ROUTINE LOCATION
	POPJ			;RETURN TO THE USER....
	.ENDC
	.SBTTL	FCHR FUNCTION - CHARACTER I/O

;CHARACTER I/O FUNCTION <OPTIONAL>

;FCHR(-1):INPUT ASCII
;FCHR(FOO):OUTPUT ASCII
;FCHR(213,64+0A,64+0B,-1): 3 OUT AND 1 IN.

XCHMO:	EVAL.X
XCHR:	INCB	LINMOD		;FORCE ACCEPTANCE OF LINE-FEEDS
	FPMP	FINT		;FORM  INT OF ARG. (ENTRY POINT)
	MOV	CHAR,-(SP)	;SAVE NEXT CHARACTER.
	MOV	AC,CHAR		;PREPARE TO PRINT
	BMI	XCHR1		;BUT PERHAPS GO READ.
	OUTCH			;OUTPUT
XCHARG:	MOV	(SP)+,CHAR	;RESTORE NEXT CHARACTER
	CMPB	CHAR,#214	;ANY MORE? (I.E. COMMA?)
	BEQ	XCHMO		;YES!
	CLRB	LINMOD		;RESET SWITCH FOR LINE-FEEDS
	POPJ			;RETURN
				;
XCHR1:
	.IFDF	$RT11
	.ENDC
	INCH			;LOOK FOR INPUT
	.IFDF	$RT11
	.ENDC
	MOV	CHAR,AC		;SAVE RESULT
	FPMP	FLOAT		;FLOAT IT
	BR	XCHARG		;...




	.SBTTL	FSBR FUNCTION - USER SUBROUTINE CALL

;EXECUTE USER FUNCTIONS!!  <OPTIONAL>

;SET Z=FSBR(GROUPNO,ARG)

XFSBR:	JSR	R5,GTESTW	;LOAD 'LINENO'
	JSR	PC,WHIPV	;PREPARE AMPERSAND
	.IF	DF,$RT11
	OPEN
	FPMP	FGET+IPTR	;GET ANPERSN
	.WORD	FPUT+INTO+STACK	;PLACE IT ON THE STACK
	.ENDC
	MOV	PTR,-(SP)	;SAVE POINTER.
	EVAL.X			;SAVE ARG.
	FPMP	FPUT+THROUGH+STACK ;LOAD ARGUMENT
	MOV	CHAR,-(SP)	;SAVE LAST CHARACTER
	MOVB	#CR,CHAR	;LOAD NEW TERMINATOR (C.R.).
	JSR	PC,DO2		;DO THE SUBROUTINE
	MOV	(SP)+,CHAR	;RESTORE LAST R-PAR.
	MOV	(SP)+,PTR	;DIG UP POINTER.
	FPMP	FGET+IPTR	;RETRIEVE RESULT.
	.IF	DF,$RT11
	.REPT	4
	MOV	(SP)+,(PTR)+	;RESTORE THE VARIABLE
	.ENDR
	.ENDC
	POPJ			;RETURN.
	.SBTTL	FX - EXPERIMENTAL FUNCTION
;EXPERIMENTAL FUNCTION <OPTIONAL>

;MODIFIED UNIBUS FUNCTION

;	OLD STANDARD FX:
;FX( 1,BUSS ADDR)		--READ SIGNED BYTE
;FX(-1,BUSS ADDR,DATA)		--WRITE BYTE
;FX( 0,BUSS ADDR,MASK)		--RETURN WORD AFTER LOGICAL AND WITH MASK
;
;	NEW MODES:
;FX( 2,BUSS ADDR)		--READ SIGNED WORD
;FX(-2,BUSS ADDR,DATA)		--WRITE WORD
;FX(-1,BUSS ADDR)		--READ UNSIGNED BYTE
;FX(-2,BUSS ADDR)		--READ UNSIGNED WORD

;ADDRESS ARG ACCEPTABLE AS FOLLOWS:
; 12345		;TREATED AS AN OCTAL ADDRESS
; +3459		;TREATED AS A DECIMAL ADDRESS
; 1234+X*Y+Z	;OCTAL ADDRESS +VALUE OF EXPRESSION (OCTAL NUM MUST BE FIRST)
; X+Y*Z		;VALUE OF EXPRESSION IS ADDRESS

XEX:
	FPMP	FINT
	MOV	AC,-(SP)	;SAVE FUNCTION CODE
	CLR	-(SP)
XEX2:
	GETC
	CMPB	CHAR,#213	;IS THIS A  COMMA,SEMICOLIN,OR CR ?
	BHI	XEX3		;YES: GET NEXT ARG
	CMPB	CHAR,#60	;TEST FOR ALPHA
	BLO	XEX2A
	CMPB	CHAR,#67
	BHI	XEX2A
	BIC	#-10,CHAR
	ASL	(SP)
	ASL	(SP)
	ASL	(SP)
	BIS	CHAR,(SP)
	BR	XEX2
XEX2A:
	JSR	PC,EVAL
	FPMP	FINT
	ADD	AC,(SP)
XEX3:
	SPNOR
	CMPB	#214,CHAR
	BNE	XEX4
	EVAL.X
	FPMP	FINT
	MOV	(SP)+,R5	;GET ADDRESS
	ASR	(SP)+		;UNSTACK AND OBSERVE MODE
	BCS	XE.WB		; 1 OR -1  WRITE BYTE
	BNE	XE.WW		; 2 OR -2  WRITE WORD
	MOV	AC,TEMP		;    0     READ AND MASK WORD
	MOV	(R5),AC
	COM	TEMP
	BIC	TEMP,AC		;COMPLETES MASKING WORK
	BR	STWORD
XE.WW:
	MOV	AC,(R5)		;WRITE WORD
	RTS	PC
XE.WB:
	MOVB	AC,(R5)		;WRITE BYTE
	RTS	PC

XEX4:
	MOV	(SP)+,R5	;COMES HERE IF THERE IS NO THIRD ARG
	ASR	(SP)+		;UNSTACK AND OBSERVE MODE
	BCC	XE.RW		; 2, -2, OR 0  READ WORD
	BMI	.+6		;READ BYTE, BUT SIGNED OR UNSIGNED ?
	MOVB	(R5),AC		; 1  READ SIGNED BYTE
	BR	STWORD
	CLR	AC		;-1  READ UNSIGNED BYTE
	BISB	(R5),AC
	BR	STWORD
XE.RW:
	BMI	XE.USN		;READ WORD, BUT SIGNED OR UNSIGNED ?
	MOV	(R5),AC		; 2  READ SIGNED WORD
STWORD:
	FPMP	FLOAT
	RTS	PC
XE.USN:	MOV	(R5),AC  	;-2  READ UNSIGNED WORD
	FPMP	FLOAT
	TST	FLAC		;+ ?
	BPL	1$		;OK
	FPMP	FADD+IMMED
	.FLT4	65536.
1$:	RTS	PC
	.SBTTL	INIT - FOCAL STARTUP AND INITIALIZATION SECTION
	.IFDF	$RT11
;
;---	FOR RE-ENTER
;
FINI:	ERASEV			;REMOVE VARIABLES
FINI2:	CLR	IDENT		;RELEASE ALL MEMORY
	CLRM			;DO IT
	JMP	INIT2		;RE-ENTER FOCAL
REENT:	BR	.-4		;GO TO JUMP INSTRUCTION
	.ENDC


	BUFBEG=0		;BEGINNING OF TEXT BUFFER.


				;ONCE ONLY CODE.
INIT:	MOV	#340,-(SP)
	MOV	#4$,-(SP)
	RTI
4$:	ADD	#40,SP		;PAPER TAPE LOADER LEAVES STACK IN WEIRD POS.
	BIC	#277,SP		;SET TO XX7500
	MOV	SP,BOTTOM	;COPY
	MOV	STACKA,SP	;START STACK
	CLR	-(SP)
	MOV	#5$,-(SP)
	RTI
5$:
	.IFDF	$PAPER
	MOV	#64,AC		;ZERO VECTORS
1$:	CLR	(AC)+
	CMP	AC,STACKA	;AND STACK
	BLO	1$
	MOV	#100,R0
	MOV	#CINT,(R0)+
	MOV	#300,(R0)+
	MOV	#CINT,(R0)+
	MOV	#300,(R0)+
	.ENDC
	.IFDF	$PAPER		;FOR PAPER TAPE USERS
	MOV	@#4,TEMP	;SAVE VECTOR ADDRESS
	MOV	#2$,@#4		;SET NEW TRAP RETURN
	MOV	#100,@#177546	;ATTEMPT TO START KW11L
	BR	3$		;SKIP
2$:	MOV	#3$,@#4		;SET NEW VECTOR
	MOV	#172546,AC	;GET KW11-P ADDRESSES
	CLR	-(AC)		;CLEAR REG A
	CLR	-(AC)		;AND B
	MOV	#115,-(AC)	;START CLOCK
3$:	MOV	TEMP,@#4	;RESTORE VECTOR
	MOV	STACKA,SP	;RESTORE THE STACK
	CLR	-(SP)
	MOV	#6$,-(SP)
	RTI
6$:
	.ENDC
	ADD	TOP,AXIN	;SET THE PARAM
	ADD	TOP,BUFR
	ADD	TOP,STARTV	;HANDLE IT
	MOV	#RELTAB,TEMP
RELOOP:	MOV	@TEMP,-(SP)	;POINT TO AREA
	SUB	(TEMP)+,@(SP)+	;NEG RELOCATE
	TST	@TEMP		;END OF LIST?
	BNE	RELOOP		;NO - CONTINUE ALONG...
	.IFDF	$RT11		;RT-11 VERSION ONLY!
	MOV	#TRAPH,@#34	;SET TRAP VECTOR
	MOV	@#RMON,TEMP	;POINT AT THE MONITOR
	ADD	#USRLD,TEMP	;POINT AT THE USR SWAP ADDRESS
	MOV	@TEMP,SWAPLC	;SAVE OLD SWAP LOCATION
	.SETTOP	#-2		;FORCE MAX ALLOCATION OF MEMORY
	MOV	@#HICOR,TEMP	;POINT TO MONITOR ADDRESS
	TST	-(TEMP)		;BACK OFF ONE
	MOV	TEMP,BOTTOM	;SET NEW BOTTOM
	MOV	TEMP,TRUEND	;SET TRU END OF USEABLE CORE
	.SETTOP			;LET MONITOR KNOW ABOUT IT
	BIS	#RESBIT,@#JSW	;SET FOR RE-STARTABLE
	.TRPSET	#CLKT,#STACKO	;SET ERROR TRAP
	MOV	#STARTX,@#USRADD ;SET USR SWAP ADDRESS
	.ENDC
	.IF	DF,$PAPER
	ERASEV			;REMOVE VARIABLES
	.ENDC
	ERASET			;ERASE THE TEXT AREA
	.IFDF	$RT11
	MOV	TRUEND,HICORE	;SET ABS HIGH CORE
	.DATE			;GET THE DATE
	MOV	#TODAY+9.,R5	;POINT AT THE DATE FIELD
	MOV	TEMP,PTR	;PASS THE VALUE
	BEQ	1$		;REENTER IF NO DATE GIVEN
	BIC	#177740,PTR	;GET YEAR
	ADD	#72.,PTR	;SET UP
	DIGTST	10.		;GET CHARACTERS
	ADD	#'0,PTR		;SET UP
	MOVB	PTR,-(R5)	;SET LOW CHAR
	MOVB	CHAR,-(R5)	;AND HIGH CHAR
	MOVB	#'-,-(R5)	;SET SEPERATOR
	MOV	TEMP,PTR	;GET DATE AGAIN
	BIC	#141777,PTR	;LEAVE MONTH INFO
	SWAB	PTR		;PLACE IN THE LOW BYTE
	ADD	#MONTAB-1,PTR	;POINT AT THE MONTH
	MOVB	-(PTR),-(R5)	;COPY IT
	MOVB	-(PTR),-(R5)
	MOVB	-(PTR),-(R5)	;END OF THE MONTH
	MOVB	#'-,-(R5)	;SEPARATOR
	MOV	TEMP,PTR	;GET DATE
	BIC	#176037,PTR	;LEAVE THE DAY OF THE MONTH
	ASR	PTR		;SHIFT OVER
	ASR	PTR
	ASR	PTR
	ASR	PTR
	ASR	PTR		;WE ARE THERE
	DIGTST	10.		;GET CHARACTERS
	ADD	#'0,PTR		;LEAST SIGNIFICANT
	MOVB	PTR,-(R5)	;PASS IT
	MOVB	CHAR,-(R5)	;SEND IT
1$:	TST	#$DBL		;DOUBLE PRECISION?
	BEQ	2$		;NO SKIP IT
	MOVB	#'D,SDSW	;SET SWITCH
2$:	FPMP	FZER		;ZERO FLAC
	JSR	PC,XFCLK	;GET TIME OF DAY
	MOV	CLKT+2,LSPR	;PASS LOW WORD
	JMP	FINI		;FINISH UP
	.ENDC
	.IFDF	$PAPER
	JMP	INIT2		;START UP...
	.ENDC


RELTAB:	.WORD	CFRS		;LOCATIONS TO BE NGATIVELY RELOCATED
	.WORD	FLTZER-2	;HERE ALSO...
	.WORD	0		;TERMINATOR...
;
	.IFDF	$RT11
MONTAB:	.ASCII	/JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC/
	.EVEN
	.ENDC
;
	.IFDF	$RT11
	.SBTTL	WORK AREA TO BE OVERLAYED BY INITIALIZATION CODING
;
;
;
;---	THE NEXT 27 WORDS ARE USED TO FIND VARIABLES IN THE SYMBOL TABLE.
;
;		EACH WORD HOLDS AN OFFSET FROM THE CONTENTS OF "STARTV"
;	TO THE FIRST VARIABLE FOR THE CORRESPONDING FIRST LETTER.
;
;	THESE CORRESPOND TO THE LETTERS "A" - "Z". CURRENTLY THE WORD FOR
;	THE LETTER "F" IS NOT USED, AS F IS RESERVED FOR FUNCTIONS.
;
SINDEX	=	INIT		;OVERLAY INITIALIZATION CODE
;
;
;	MEMSIZ IS THE NUMBER OF 256 WORD BLOCKS ABLE TO BE ALLOCATED.
;
	MEMSIZ	=	20.*4	;ROOM FOR 20K CORE MAPPING
;
COMBUF	=	SINDEX+<27.*2>	;COMMAND INPUT BUFFER
;
;
L.CSIT	=	COMBUF+80.	;AREA FOR CSI WORK - ASSUMES THAT ONLY
				; ONE FILE SPECIFIED TO LIB CMD.
				; ALL OTHERS WILL BE IGNORED!
;
L.NAME	=	L.CSIT+40.	;AREA FOR FILE CONSTRUCTION (38 CHAR MAX!)
;
MEMTAB	=	L.NAME+38.	;MEMORY ALLOCATION TABLE
;
ENDJNK	=	MEMTAB+MEMSIZ	;END OF JUNK AREA
	.IF	GE,<ENDJNK-.>
	.REPT	<ENDJNK-./2>
	.WORD	-1
	.ENDR
	.ENDC
	.ENDC
	.END	INIT		;END OF THE MAINLINE CODE