; READIT - TABLE DRIVEN INPUT PARSER
; LAST EDIT:	14-AUG-81
;
.NLIST
.TITLE	READIT
.NLIST 	SEQ,LOC,BIN,BEX
.LIST	TTM
.LIST
;
.IDENT	/V002/
;
.PSECT	READIT
;	7-MAR-74  MOD WITH END OF MACRO AND TEXT WITH CR CORRECTED
; FREE FORMAT READING PACKAGE
;
;
;  A TODD-POKROPEK  29-SEP-73
;
; CALLING CONVENTION
; R0 IS ADDRESS OF BUFFER HEAD
;
; BUFFER CONTAINS:-
; . BYTE ICH,IST   EXTERNALLY SUPPLIED STATUS,  STATE VARIABLE NORMALLY ZERO
; .BYTE ITWAS, INWAS   WHERE ITWAS AND INWAS ARE EXPLANED BELOW
; .BYTE K,L WHERE K WAS LAST CHARACTER READ AND L ITS TYPE
; .BYTE ISIGN,IPOW  WHERE ISIGN IS THE SIGN OF THE NUMBER READ
;      AD IPOW IS USED INTERNALLY AS AN EXPONENT COUNTER
;      AND ASLO INTERNALLY IN THE DIRECTORY LOOKUP
; .WORD KPOINT  WHERE KPOINT IS THE POINTER IN THE BUFFER TO THE NEXT CHARACTER
;     AND SHOULD BE INITIALISED TO THE START OF THE BUFFER
; .WORD IA   THE ADDRESS OF THE INPUT BUFFER
; .WORD ISTR  THE ADDRESS OF THE STRING BUFFER
;. WORD BLEN  THE LENGTH IN CHARACTERS OF THE STRING BUFFER
; .WORD INT   THE INTEGER VALUE FOUND
; .WORD REA1,REA2   A TWO WORD SPACE FOR THE REAL NUMBER FOUND
;   .WORD VAL   ADDRESS OF WHERE VALUE READ IS TO BE PLACED
;		OR THE START ADDRESS OF AN ARRAY
;   .WORD OFF   OFFSET TO VALUE REQUIRED WITH AN ARRAY
;    .WORD WC   ITEM COUNT FOR AN ARRAY READ
;		.WORD	LIBC		ADDRESS OF LIBRARY LOOK UP TABLE AS:-
;		.ASCII	<0>,'STRING1',<0/1>,<N1>,'STRINGN',<0/1>,<N2>....<0>,<0>
;		WHERE <N1> IS THE INTEGER RETURNED WHEN THE PRECEEDING STRING HAS BEEN 
;		DETECTED,		  AND <0,1> IS A BYTE WITH 0 TO INDICATE THE END OF
;		THE STRING WITH FOLLOWING CHARACTERS IGNORRED,  OR A BYTE WITH -1
;		IF AN EXACT MATCH IS REQUIRED.
;   .WORD  DEFAULT  ADDRESS OF DEFAULT VALUE
;   .WORD  LOW,HIGH  ADDRESSES OF LOW AND HIGH LIMITS FOR ITEM
;
;
;
;
;    WHERE ITWAS, BEING THE TYPE OF ITEM FOUND, IS:-
;    -3  END OF MACRO
;    -2  ABORT
;    -1  ERROR	WHERE THE ERROR CODE IS GIVEN IN IST
;     0  INPUT REQUIRED
;     1 INTEGER READ
;     2  REAL READ
;     3  STRING READ
;     4 PART OF STRING  (NOTE THAT IST WILL BE EITHER 2 OR 8 AND NOT ZERO)
;     5 DEFAULT SUPPLIED
;     6 JOY STICK VALUE
;     7 LEAVE PREVIOUS VALUE '/'
;		AND INWAS SHOULD BE PRESET AS FOLLOWS:-
;     0 READ NEXT ITEM
;     1 READ NEXT NUMBER AS INTEGER
;     2 READ NEXT NUMBER AS REAL
;     3 SEEK AND READ STRING
;     4 SEEK AND READ NEXT INTEGER
;     5 READ NEXT ITEM AS STRING UP TO ANY DELIMATOR
;     6 READ STRING TEXT UP TO CARRIAGE RETURN
;
;     7 READ AN ARRAY AND RETURN RESULTS AS INTEGERS
;     8 READ AN ARRAY AND RETURN RESULTS AS REALS
;
;    9 READ NEXT ITEM AND EITHER RETURN INTEGER VALUE OR LOOKUP STRING
;      IN THE DIRECTORY SUPPLIED
;
;   10  READ JOYSTICK
;
;
;
;
;
;
;  TO USE ICH  THE LOGICAL UNIT NUMBER SHOULD BE POSITIVE
;
;
;
;
;
;	ERROR RETURNS
; IST=0  NORMAL RETURN
; IST=2	 INCOMPLETE STRING
; IST=8  INCOMPLETE STRING
;
; IST=11 FIRST WORD OF JOYSTICK READ
;
; IST NEGATIVE    ERROR
;
; IST=-1  INWAS INVALID BEING NEGATIVE
; IST=-2  INWAS GT 6  AND THEREFORE INVALID
; IST=-3  KPOINT BELOW BUFFER
; IST=-4  KPOINT ABOVE BUFFER
; IST=-5  IST WAS NEGATIVE ON ENTRY
; IST=-6  IST WAS GT 8 AND THEREFORE INVALID
; IST=-7  MAIN JUMP OUT OF RANGE (ONLY OCCURS WHEN ICH WAS -2)
; IST=-8  RETURN JUMP OUT OF RANGE ( ONLY OCCURS WHEN ICH WAS -2)
; IST=-9  INVALID INWAS,ITWAS COMBINATION (ONLY OCCURS WHEN ICH WAS -2)
; IST=-10 END OF FILE READ
; IST=-11 SPECIAL FUNCTION CALLED WITH ICH NEGATIVE OUT OF RANGE
;
; AFTER AN ERROR IST MUST BE RESET TO ZERO
;
;
;
; SPECIAL FUNCTIONS
;
; ICH=-3    SET NUMERIC BASE TO VALUE OF IST
; ICH=-2    BYPASS ALL INTERNAL INITIALISATION
;           THIS IS NORMAL RETURN AFTER AN ABORT
;	    IF IT IS DESIRED TO CONTINUE PROCESSING
;	    THE LAST NUMBER
; ICH=-1    INITIALISATION IF REQUIRED
; ICH=0   NORMAL FUNCTION
;
; ICH BIT 0 SET TO 1 IF STRINGS SUPPRESSED
; ICH BIT 1 SET TO 1 IF DEFAULTS NOT REQUIRED
; ICH BIT 2 SET TO 1 IF LIMIT CHECKING NOT REQUIRED
;
;
;
;  INTERNAL STATES
;
; IST=0  WAITING FOR AN ITEM
; IST=1  STRING PROCESSING
; IST=2  INTEGER NUMBER PROCESSING
; IST=3  REAL NUMBER PROCESSING
; IST=4  START EXPONENT
; IST=5  START INTEGER PART OF EXPONENT
; IST=6  CONTINUE INTEGER PART OF EXPONENT
; IST=7  PROCESSING OF STRING WITHIN QUOTES
; IST=8  PROCESSING OF ITEM WHICH IS REQUIRED AS A STRING
; IST=9 PROCESSING OF ITEM WHICH IS REQUIRED AS TEXT INITIAL PHASE
; IST=10 TEXT FINAL PHASE
; IST=11 JOYSTICK PROCESSING
;
;
; CHARACTER TYPES
; L=1  A NUMBER
; L=2  A LETTER
; L=3  EXPONENTIATION SIGN BEING 'E'
; L=4  DECIMAL POINT
; L=5  PLUS SIGN
; L=6  MINUS SIGN
; L=7  PARTIAL TERMINATOR BEING SPACE AND COMMA
; L=8  FULL TERMINATOR BEING ';'
; L=9  UNRECOGNISED CHARACTER
; L=10 APOSTROPHE  TO INDICATE STRING WITHIN QUOTES
; L=11 END OF BUFFER BEING CARRIAGE RETURN OR  A BYTE EQUAL TO ZERO
; L=12 ABORT BEING CTRL-A, CTRL-G OR CTRL-Z
; L=13 SPECIAL CHARACTER I.E. JOYSTICK
;
; A STRING MUST START WITH EITHER A 'LETTER' (INCLUDING E) OR AN APOSTROPHE
; A STRING SURROUNDED BY APOSTROPHES WITH BE RETURNED AS TYPED EXCLUDING
; EXCLUDING THE APOSTROPHES.
; AN EMBEDDED APOSTROPHE WILL BE TREATED AS A LETTER AN RETURNED IN THE STRING
; BUFFER.
; IF AN ITEM IS DEMANDED AS A STRING OR A STRING TEXT IT WILL BE RETURNED
; AS SUCH INCLUDING APOSTROPHES.
;
;
;
;
;
;
	.PAGE
	.NLIST
	.LIST	SEQ,LOC,BIN
	.LIST
;
;UCH=0	; DEFINITION TO ENABLE UCH SPECIAL DEVICES
;
; DEFINITIONS
ICH=0
IST=1
ITWAS=2
INWAS=3
K=4
L=5
SIGN=6
POW=7
STLN=7
KPOINT=10
IA=12
ISTR=14
BLEN=16
INT=20
LIBV=20
LIBC=21
REA=22
REA2=24
VAL=26
OFF=30
WC=32
LIB=34
DEFLT=36
LOW=40
HIGH=42
R0=%0
R2=%2
R3=%3
SP=%6
PC=%7
A1=%1
A3=%3
;
.GLOBL	READIT
;
; ENTRY POINT
READIT:	MOV	R2,-(SP)	;STACK R2
	MOV	R3,-(SP)	;STACK R3
	STFPS	-(SP)		;SAVE FPP STATUS
	SETF			;AND SET FLOATING SINGLE MODE
	SETI			;AND SINGLE INTEGER
;
;  TEST ICH
;
;
	TSTB	ICH(R0)		;TEST LUN
	BPL	L9991		;NOT A SPECIAL FUNCTION
	JMP	L999		;YES IT WAS GO TO SPECIAL FUNCTION
;
;
; CHECK INWAS
;
;
L9991:	TSTB	INWAS(R0)	;CHECK INWAS
	BPL	L701		;BYPASS IF CORRECT
	MOV	#1,R3		;ERROR CODE = 1
	JMP	L700		;ERROR EXIT
L701:	CMPB	V6,INWAS(R0)	;IS INWAS GT 6
	BGE	L702		;SKIP IF VALID
	MOV	#2,R3		;ERROR CODE 2
	JMP	L700		;ERROR EXIT
;
;
; SET STRING FLAG
;
L702:	MOVB	INWAS(R0),R3
	BISB	STFLG(R3),ICH(R0);AND SET STRING FLAG
;
;
; CHECK KPOINT
;
;
	MOV	KPOINT(R0),R3	;CHECK KPOINT
	SUB	IA(R0),R3
	BPL	L703		;SKIP IF VALID
	MOV	#3,R3		;ERROR CODE 3
	JMP	L700		;ERROR EXIT
L703:	SUB	IOLEN,R3	;SUBTRACT IO BUFFER LENGTH
	BLE	L9981		;SKIP IF LESS THAN BUFFER LENGTH
	MOV	#4,R3		;ERROR CODE 4
	JMP	L700		;ERROR EXIT
;
;
; TEST IF RETURNING FROM AN INPUT REQUEST
;
L9981:	TSTB	ITWAS(R0)
	BGT	L9982		;IF ITWAS GREATER THAN ZERO CONTINUE
	JMP	L9983		;ELSE JUMPT TO INPUT RETURN
;
;
;
; TEST IST
;
L9982:	TSTB	IST(R0)		;TEST STATE VARIABLE
	BPL	L998		;SKIP IF POSITIVE
	MOV	#5,R3		;ERROR CODE 5
	JMP	L700		;ERROR EXIT
L998:	CLRB	SIGN(R0)	;SET SIGN TO 0 I.E. POSITIVE
	CMPB	IST11,IST(R0)	; IS IT EQUAL TO NINE
	BGT	L706		;SKIP IF LESS THAN OR EQUAL
	BGE	L501
	MOV	#6,R3		;ERROR CODE 6
	JMP	L700		;ERROR EXIT
;
; RETURN LOOP FOR  INCORRECT ITEM
;
;
; SET STATE VARIABLE
;
L706:	CLR	R2		;CLEAR REGISTER 2
	MOVB	INWAS(R0),R2	;FETCH INWAS
	MOVB	ISTAB(R2),IST(R0)  ; AND SET STATE APPROPRIATELY
	BR	L501		;SKIP INCRMENTING POINTER
;
; RETURN FOR NEXT CHARACTER
;
L51:	INC	KPOINT(R0)	; INCREMENT POINTER
;
; CALCULATE ACTION DEPENDING ON CHARACTER TYPE AND STATE
;
L501:	MOVB	@KPOINT(R0),R2	; PLACE CHARACTER IN R2
	BIC	#177600,R2	;MASK CHARACTER TO BOTTOM 7 BITS
	MOVB	R2,K(R0)	;PLACE IN K
	MOVB	ITYPE(R2),L(R0)	;PICK UP L=ITYPE(K) CHARACTER TYPE
	CLR	R3		;CLEAR REG 3
	MOVB	IST(R0),R3	;PLACE STATE IN R3
	CLR	R2
	MUL	V12,R3		;MULPIPLY BY IRT DIMESNION=12
	MOVB	L(R0),R2	;FETCH L
	ADD	R2,R3		;AND ADD IT TO REG 3
	CMP	V96,R3		; CHECK LIMITS
	BGE	L52		;SKIP IF VALID
	MOV	#7,R3		;ERROR CODE 7
	JMP	L700		;ERROR EXIT
L52:	MOVB	IRT(R3),R3	;PICK UP JUMP CODE
	ASL	R3		;AND CONVERT INTO BYTES
	MOV	IT(R3),PC	;AND JUMP
;
;
;;
;
; END OF ENTRY CODE
;
;
;
;;
; CHANGE SIGN
L901:	MOVB	VM1,SIGN(R0)	;SIGN =-1
	JMP	L51		;CONTINUE
;
;
; START STRING
L902:	MOVB	IST1,IST(R0)	;IST=1
	JMP	L906		;CONTINUE STRING
;
;
;
;
; START INTEGER
L903:	MOVB	IST2,IST(R0)	;IST=2
L9031:	CLR	INT(R0)		;CLEAR INT
	MOVB	K(R0),INT(R0)	;STORE CHARACTER IN INT
	SUB	V48,INT(R0)	;REMOVE 48 BEING ASCII PART
	JMP	L51
;
;
;
;
; START EXPONENT
L904:	CLR	INT(R0)		;RESET INT
	MOV	VZERO,REA(R0)	;RESET REA
	MOV	VZERO2,REA2(R0)	;RESET REA
	CLRB	POW(R0)		;RESET POWER
	MOVB	IST3,IST(R0)	;IST=3
	JMP	L51		;CONTINUE
;
;
;
;
; CONVERT INTEGER TO REAL
L905:	LDCIF	INT(R0),A1
	STF	A1,REA(R0)
	CLR	INT(R0)		;RESET INT
	CLRB	POW(R0)		;RESET POWER
	MOVB	IST3,IST(R0)	;IST=3
	JMP	L51		;CONTINUE
;
;
;
;
; CONTINUE STRING
L906:	BITB	NOSTR,ICH(R0)	;TEST  STRING SUPPRESS BIT
	BNE	L9061		;AND SKIP IF SET
	MOVB	SIGN(R0),R2	;TEST NO OF CHARACTERS SO FAR
	CMP	BLEN(R0),R2	;AGAINST BUFFER LENGTH
	BLE	L9092		;END STRING IF GREATER
	ADD	ISTR(R0),R2	;ADD START ADDRESS OF BUFFER
	MOVB	K(R0),@R2	;STORE CHARACTER
	INCB	SIGN(R0)	;INCREMENT STRING POINTER
L9061:	JMP	L51		;CONTINUE
L9092:	MOVB	ITW4,ITWAS(R0)	;ITWAS=4
	JMP	L900		;GOTO EXIT ROUTINE
;
;
;
;
; CONTINUE INTEGER OR EXPONENT
L908:	INCB	POW(R0)		;INCREMENT POWER COUNTER
L907:	MOV	INT(R0),R3	;FETCH INT
	MUL	BASE,R3		;MULTIPLY BY 10
	CLR	R2		;CLEAR R2
	MOVB	K(R0),R2	;FETCH CHARACTER
	SUB	V48,R2		;REMOVE ASCII
	ADD	R2,R3		;ADD TO INT*10
	BVS	L905		;IF OVERFLOW CONVERT TO REAL
	MOV	R3,INT(R0)	;SAVE INT
	JMP	L51		;CONTINUE
;
;
;
;
; FINISH STRING
L909:	MOVB	ITW3,ITWAS(R0)	;ITWAS=3
	JMP	L900		;GOTO EXIT ROUTINE
;
;
;
;
; FINISH INTEGER
L910:	TSTB	SIGN(R0)	;IS SIGN NEGATIVE
	BPL	L9101		;NO ITS PLUS
	NEG	INT(R0)		;NEGATE IF IT WAS MINUS
L9101:	MOVB	ITW1,ITWAS(R0)	;ITWAS=1
	JMP	L900		;GOTO EXIT ROUTINE
;
;
;
;
; CONVERT REAL TO EXPONENT FORM
L911:	MOVB	IST4,IST(R0)	;IST=4
	JSR	PC,REAP		;CALL REAP
	MOVB	VP1,SIGN(R0)	;SIGN=+1
	JMP	L51		;CONTINUE
;
;
;
;
; SUBROUTINE REAP
REAP:	LDCIF	INT(R0),A3	;ACC3=FLOAT(INT)
	MOVB	POW(R0),R3	;R3=LOOP COUNTER BEING POWER
	BEQ	REAP3		;SKIP IF POW=0
	LDCIF	BASE,A1		;ACC1=FLOAT(BASE)
REAP1:	DIVF	A1,A3		;DIVIDE INT BY BASE
	SOB	R3,REAP1	;REPEAT POWER TIMES
REAP3:	ADDF	REA(R0),A3	;ADD REA
	TSTB	SIGN(R0)	;CHECK SIGN
	BPL	REAP2		;SKIP IS PLUS
	NEGF	A3		;NEGATE IF MINUS
REAP2:	STF	A3,REA(R0)	;RESTORE TO REA
	RTS	PC		;RETURN
;
;
;
;
; END OF DEFAULT CODE
L912:	CMPB	LLVC,K(R0)	;TEST FOR LEAVE LAST VALUE
	BEQ	L9121		;AND SKIP IF IT WAS
	MOVB	ITW5,ITWAS(R0)	;ITWAS=5
	CLR	INT(R0)		;STORE ZERO IN INT
	LDCIF	INT(R0),A1	;LOAD INT=0 INTO FPU ACCUMULATOR
	STF	A1,REA(R0)	;AND STORE ZERO IN REA
	JMP	L900		;GOTO EXIT ROUTINE
L9121:	MOVB	ITW7,ITWAS(R0)	;ITWAS=7
	BITB	ARRY,ICH(R0)	;TEST FOR ARRAY TYPE
	BEQ	L9121A		;SKIP IF NOT AN ARRAY TYPE
	JMP	L99S5		;JUMP TO NEXT ITEM OF ARRAY
L9121A:	JMP	L991		;AND SKIP REST OF PROCESSING
;
;
;
;
; STATSE CHANGE FOR EXPONENT
L913:	MOVB	IST5,IST(R0)	;IST=5
	JMP 	L501		;CONTINUE
;
;
;
;
; START EXPONENT
L914:	MOVB	IST6,IST(R0)	;IST=6
	JMP	L9031		;GOTO INTEGER FORMATION ROUTINE
;
;
;
;
; CONTINUE EXPONENT
L915:	BR	L907		;IDENTICAL TO L907 ROUTINE
;
;
;
;
; END EXPONENT
L916:	MOV	INT(R0),R3	;LOAD LOOP PARAMETER BEING INT
	BEQ	L9164		;SKIP IF INT=0
	LDF	REA(R0),A3	;LOAD REA TO FPU
	LDCIF	BASE,A1		;LOAD BASE IS ACC1
L9161:	TSTB	SIGN(R0)	;CHECK SIGN
	BPL	L9162		;BRANCH IF PLUS
	DIVF	A1,A3		;DIVIDIE REA BY 10
	BR	L9163		;SKIP
L9162:	MULF	A1,A3		;MULTIPLY REA BY 10
L9163:	SOB	R3,L9161	;REPEAT INT TIMES
	STF	A3,REA(R0)	;SAVE AS REA
L9164:	MOVB	ITW2,ITWAS(R0)	;ITWAS=2
	JMP	L900		;GOTO EXIT ROUTINE
;

;
;
;
; SPARE
L917:	JMP	L51
;
;
;
;
; START QUOTES
L918:	MOVB	IST7,IST(R0)	;IST=7
	JMP	L51		;CONTINUE
;
;
;
;
; SKIP
L919:	JMP	L51		;SKIP
;
;
;
;
; END OF STRING AND SKIP
L920:	JMP	L909		;GOTO END OF STRING
;
;
;
;
; IMPROPER CHAR
L921:	JMP	L51		;SKIP
;
;
;
;
; CONVERT INTEGER TO EXPONENTIAL FORM
L922:	MOVB	IST4,IST(R0)	;IST=4
	LDCIF	INT(R0),A3	;LOAD FLOAT(INT) IN ACC3
	TSTB	SIGN(R0)	;IS SIGN MINUS
	BPL	L9221		;SKIP IF PLUS
	NEGF	A3		;IF MINUS THEN NEGATE
L9221:	STF	A3,REA(R0)	;SAVE AS REA
	MOVB	VP1,SIGN(R0)	;RESET SIGN
	JMP	L51		;CONTINUE
;
;
;
;
; END REAL
L923:	MOVB	ITW2,ITWAS(R0)	;ITWAS=2
	JSR	PC,REAP		;CALL REAP
	JMP	L900		;GOTO EXIT ROUTINE
;
;
;
;
; END OF BUFFER ROUTINE
L924:	CLRB	ITWAS(R0)	;SET ITWAS TO ZERO FOR INPUT REQUIRED
	JMP	L1000		;AND RETURN
L9983:	TSTB	ITWAS(R0)	;TEST ITWAS FOR END OF FILE
	BPL	L990		;SKIP IF DATA
	MOV	#12,R3		;ERROR CODE 12
	JMP	L700		;ERROR EXIT
L990:	MOV	IA(R0),KPOINT(R0) ; RESET POINTER
;**
;	TSTB	IST(R0)		;THIS CODE REMOVED TO CORRECT PROBLEM
;	BNE	L9901		;WITH DEFAULTS ON STRING SYMBOL READS
;**
	MOVB	@KPOINT(R0),R2
	BIC	#177600,R2
	MOVB	R2,K(R0)
	MOVB	ITYPE(R2),L(R0)
	CMPB	TYP11,L(R0)
	BNE	L9901
	JMP	L912
	
L9901:	JMP	L501		;CONTINUE
;
;
;  INPUT AND INITIALISATION ROUTINES
;
;
;

;
;
;
;
;  SPECIAL CHARACTERS INC ABORT
L925:	CMPB	EOMC,L(R0)	;CHECK FOR END OF MACRO CHAR
	BEQ	L9251		;AND SKIP IF TRUE
	MOVB	ITWM2,ITWAS(R0)	;ITWAS=-2
L9252:	INC	KPOINT(R0)	;INCREMENT POINTER
	JMP	L1000		;GOTO EXIT
L9251:	MOVB	ITWM3,ITWAS(R0)	;ITWAS=-3
	BR	L9252		;AND CONTINUE
;
;
;
;
;
;
; END QUOTES
L926:	MOVB	IST1,IST(R0)	;IST=1
	JMP	L51		;CONTIUE
;
;
L927:	MOVB	IST10,IST(R0)	;SET IST TO 10
	JMP	L906		;AND CONTINUE STRING
;
L928:	MOVB	IST10,IST(R0)	;SET IST TO 10
		JMP	L924	;AND GOTO INPUT
;
.IF	DF	UCH		;HERE ARE THE UCH SPECIAL DEVICES
;
;
; JOYSTICK X PROCESSING
;
;
L929:	MOVB	IST11,IST(R0)
	CLRB	POW(R0)
	CMPB	#DMACH,@KPOINT(R0)
	BEQ	L9291
	INC	KPOINT(R0)	;GOTO NEXT CHARACTER
	JSR	PC,JOYW		;AND INPUT WORD
	SUB	#160,INT(R0)
	JMP	L900
L9291:	MOVB	#1,POW(R0)
	INC	KPOINT(R0)
	JSR	PC,DMACW
	JMP	L900
;
; JOYSTICK SKIP IN ERROR
;
;
L930:	ADD	#5,KPOINT(R0)
	JMP	L501
;
; JOYSTICK  FORM WORD
;
;
;
JOYW:	CLR	INT(R0)		;CLEAR INT
	MOVB	@KPOINT(R0),R2	;FETCH HIGH ORDER
	ASH	#5,R2
	MOV	R2,INT(R0)	;AND STORE
	INC	KPOINT(R0)	;INC POINTER
	MOVB	@KPOINT(R0),R2	;FETCH  LOW ORDER BITS
	BIC	#177740,R2	;CLEAR HIGH BITS
	ADD	R2,INT(R0)	;AND ADD TO INT
	MOVB	ITW6,ITWAS(R0)	;SET ITWAS=6
	INC	KPOINT(R0)	;INCRMEMENT POINTER
	RTS	PC		;AND RETURN
;
;
DMACW:	CLR	INT(R0)		;CLEAR INT
	MOV	#4,R2		;SET UP FOR 4 CHARCATERS
DMCL1:	MOV	INT(R0),R3
	MUL	#10.,R3		;MULPIPLY INT BY 10
	MOV	R3,INT(R0)
	MOVB	@KPOINT(R0),R3	;FETCH BYTE
	INC	KPOINT(R0)	;AND POINT TO  NEXT BYTE
	BIC	#177760,R3	;CLEAR OUT ASCII
	ADD	R3,INT(R0)	;AND STORE
	SOB	R2,DMCL1
	MOVB	ITW6,ITWAS(R0)	;SET ITWAS TO 6
	RTS	PC		;AND RETURN
;
;
;
; JOYSTICK Y PROCESSING
L931:	TSTB	POW(R0)
	BGT	L9311		;IT WAS A DMAC MESSAGE
	JSR	PC,JOYW		;CALL IN JOYSTICK WORD
	SUB	#34,INT(R0)
L9312:	CLRB	IST(R0)		;CLEAR IST
	JMP	L900
L9311:	JSR	PC,DMACW
	BR	L9312
;
L932:	MOV	#-12.,R3
	JMP	L700
;
;
.IFF
L929:			;DUMMY LABELS
L930:
L931:
L932:	BR	L900
;
.ENDC
;
;
;
;
;
;
; EXIT ROUTINE
;
;  EXIT DEPENDING ON VALUES OF ITWAS AND INWAS
;
L900:	CLR	R3		;CLEAR REG 3
 	MOVB	INWAS(R0),R3	;PICK UP INWAS
	CLR	R2		;CLEAR REG 2
	MUL	V4,R3		;FIND MATRIX ADDRESS
	MOVB	ITWAS(R0),R2	;FETCH ITWAS
	ADD	R2,R3		;AND ADD IT TO REG 3
	DEC	R3		;AND SUBTRACT 1
	CMP	V24,R3		;CHECK LIMIT
	BGE	L708		;SKIP IF VALID
	MOV	#8.,R3		;ERROR CODE 8
	JMP	L700		;ERROR EXIT
L708:	MOVB	IRTEX(R3),R3	;PICK UP JUMP CODE
	ASL	R3		;CONNVERT TO BYTES
	MOV	IRTJ(R3),PC	;AND JUMP
;
;
;
; NORMAL EXIT
;
L991:	JSR	PC,EOC		;TESTFOR END OF BUFFER CHAR
L9001:	CMPB	IST11,IST(R0)	;TEST STATE
	BEQ	L9002		;AND SKIP IF SPECIAL
	CLRB	IST(R0)		;OTHERWISE CLEAR STATE
L9002:	BICB	NOSTRD,ICH(R0)	;AND CLEAR NO STRING BIT
	BICB	ARRY,ICH(R0)	;AND CLEAR ARRAY TYPE
	JMP	L1000		;EXIT
;
;
;
; REAL FOUND INTEGER REQUIRED
;
;
L992:	LDF	REA(R0),A1	;LOAD REA TO FPU
	STCFI	A1,INT(R0)	;CONVERT AND STORE IN INT
	CFCC			;COPY ERROR CODES
	BCC	L9921		;OK
	JMP	LIM1		;OUT OF RANDE
L9921:	JMP 	L99C1		;EXIT
;
;
;  REAL REQUIRED INTEGER FOUND
;
;
L993:	LDCIF	INT(R0),A1	;LOAD ACC1 WITH FLOAT(INT)
	STF	A1,REA(R0)	;AND STORE IN REA
	JMP	L99C2		;EXIT
;
;
;  ITEM NOT FOUND THEREFORE REPEAT
;
;
L994:	JMP	L998		;REPEAT FOR NEXT ITEM
;
;  DEFAULT EXIT ROUTINE
;
;
L995:	CLRB	SIGN(R0)	;SIGN=0
	JMP	L991		;EXIT
;
;
;  INCOMPLETE STRING EXIT ROUTINE
;
;
L996:	JMP	L1000		;EXIT FOR INCOMPLETE STRING
;
;
;  IMPOSSIBLE COMBINATION OF INWAS AND ITWAS 
;
;
L997:	MOV #11.,R3		;ERROR CODE 11
	JMP	L700		;ERROR EXIT
;
;
;
;  REAL DEFAULT
;
;
L99D1:	BITB	NODFL,ICH(R0)	;TEST SUPPRESS DEFAULT BIT
	BNE	L99S2		;AND SKIP IF SET
	TST	DEFLT(R0)	;DOES A DEFAULT ADDRESS EXIST
	BEQ	L99S2		;AND SKIP IF NOT
	MOV	DEFLT(R0),R3	;PICK UP DEFAULT ADDRESS
	MOV	(R3)+,REA(R0)	;ANS SET REA
	MOV	(R3),REA2(R0)
	LDF	REA(R0),A1	;AND STORE
	JMP	L99S2		;AND CONTINUE
;
;
;
; PICK UP INTEGER DEFAULT
L99D2:	BITB	NODFL,ICH(R0)	;TEST SUPRESS DEFAULT BIT
	BNE	L99S1
	TST	DEFLT(R0)	;DOES A DEFAULT ADDRESS EXIST
	BEQ	L99S1		;AND SKIP IF NOT
	MOV	@DEFLT(R0),INT(R0);PICK UP DEFAULT INTEGER
	JMP	L99S1		;AND CONTINUE
;
;
;
;
; RANGE CHECK FOR INTEGERS
;
L99C1:	BITB	NOLIM,ICH(R0)	;TEST SUPRESS RANGE CHECK BIT
	BNE	L99S1		;AND SKIP IF SET
	TST	LOW(R0)		;DOES A LOW LIMIT ADDRESS EXIST
		BEQ	L99S1	;AND SKIP IF NOT
	CMP	INT(R0),@LOW(R0);CHECK LOW LIMIT
	BLT	LIM1		;AND SKIP IF LESS
	CMP	INT(R0),@HIGH(R0);CHECK UPPER LIMIT
	BGT	LIM1		;AND SKIP IF GREATER
L99S1:	BITB	ARRY,ICH(R0)
	BNE		L99S3	;AND SKIP IF ARRAY TYPE
	MOV	INT(R0),@VAL(R0);AND RETURN VALUE TO USER
	JMP	L991		;AND CONTINUE
;
;
;
; RANGE CHECK FOR REALS
;
;
;
;
L99C2:	LDF	REA(R0),A1	;PICK UP VALUE
	BITB	NOLIM,ICH(R0)	;TEST SUPPRESS RANGE CHECK
	BNE	L99S2		;AND SKIP IF SET
	TST	LOW(R0)		;DOES A LOW LIMIT EXIST
	BEQ	L99S2		;AND SKIP IF NOT
	CMPF	@LOW(R0),A1	;COMPARE LOW WITH REAL NUMBER FOUND
	CFCC			;FETCH STATUS BITS
	BGT	LIM1		;AND JUMP IF LESS
	CMPF	@HIGH(R0),A1	;COMPARE WITH UPPER LIMIT
	CFCC		;FETCH STAUS BITS
	BLT	LIM1
L99S2:	BITB	ARRY,ICH(R0)	;TEST FOR ARRAY TYPE
	BNE	L99S4		;AND SKIP IF TRUE
;
	STF	A1,@VAL(R0)	;AND RETURN TO USER
	JMP	L991		;AND CONTINUE
;
;
;
; OUT OF RANGE ERROR RETRURN
;
LIM1:	MOV	#12.,R3
	JMP	L700	;ERROR RETURN FOR OUT OF RANGE
;
;
;
;
;
; INTEGER ARRAY ADDRESS CALCULATION
;
;
L99S3:	MOV	OFF(R0),R2	; FETCH OFFSET
	DEC	R2		;TO MAKE IT FORTRAN COMPATIBLE
	ASL	R2		;AND MULTIPLY OFFEST BY TWO
	ADD	VAL(R0),R2	;AND ADD START ADRESS
	MOV	INT(R0),(R2)	;AND STORE RESULT
	JMP	L99S5		;AND CONTINUE
;
;
;
;
; REAL ARRAY ADDRESS CALCULATION
;
;
L99S4:	MOV	OFF(R0),R2	;FETCH OFFSET
	DEC	R2		;TO MAKE IT FORTRAN COMPATIBLE
	ASL	R2
	ASL	R2		;AND MULTIPLY OFFSET BY 4
	ADD	VAL(R0),R2	;AND ADD START ADDRESS
	STF	A1,(R2)	;AND STORE RESULT
;
;
;
; END OF ARRAY TEST AND INDEX INCREMENT
;
;
L99S5:	JSR	PC,EOC		;TEST FOR END OF BUFFER CHAR
	DEC	WC(R0)		;DECRMENT WORD COUNT
	BLE	L900X		;AND EXIT IF END REACHED
	INC	OFF(R0)		;OTHERWISE INCREMENT INDEX
	JMP	L994		;AND CONTINUE WITH NEXT ITEM
L900X:	JMP	L9001		;EXIT
;
;
; END OF BUFFER CHECK SUBROUTINE
;
;
;
EOC:	CMPB	ITW6,ITWAS(R0)
	BEQ	EOC1		;DO NOT INCRMEMENT FOR JOYSTICK
	CMPB	TYP11,L(R0)	;IS IT AN END OF BUFFER CHAR
	BEQ	EOC1		;SKIP IF IT IS
	INC	KPOINT(R0)	;OTHERWISE INCREMENT POINTS
EOC1:	RTS	PC		;AND RETURN
;
;
;
;
; LIBRARY LOOKUP ROUTINE
;
LIB0:	MOV	LIB(R0),R2	;PICK UP LIBRARY ADDRESS
	CLR	LIBV(R0)	;AND CLEAR LIBV AND LINC
	CLRB	STLN(R0)	;AND CLEAR STRING LENGTH COUNTER
;
;
; RETURN POINT FOR NEXT ITEM
LIB1:	MOV	ISTR(R0),R3	;FETCH STATR OF STRING ADDRESS
	INC	R2
	TSTB	(R2)		;TEST FOR END OF DIRECTORY
	BEQ	LIB3		;AND EXIT IF TRUE
	CLRB	LIBC(R0)	;CLEAR CHAR COUNTER
LIB2:	TSTB	(R2)		;OTHERWISE TEST NEXT CHAR
	BLE	LIB5		;AND EXIT IF END OF STRING
	INCB	LIBC(R0)	;INREMENT COUNTER
	CMPB	LIBC(R0),SIGN(R0);CHECK STRING LENGTH
	BGT	LIB4		;SKIP IF TOO SHORT
	CMPB	(R2)+,(R3)+	;TEST FOR MATCH IN STRING
	BEQ	LIB2		;YES THEN REPEAT
;
;
; FAILURE TO MATCH 
;
LIB4:	TSTB	(R2)+		;LOOK FO END OF STRING
	BLE	LIB1		;JUMP IF END OF STRING
	BR	LIB4		;AND REPEAT
;
;
;
; SUCCESS
;
LIB5:	BEQ	LIB6		;SUCCESS BUT SKIP IF EXACT MATCH NOT REQUIRED
	INC	R2		;POINT AT NEXT CHAR
	CMPB	SIGN(R0),LIBC(R0);TEST LENGTH
	BNE	LIB1		;AND SKIP IF NOT THE SAME
	MOVB	LIBC(R0),STLN(R0);SAVE STIRNG LENGTH
	MOVB	(R2),LIBV(R0)	;SAVE VALUE
	BR	LIB8		;OTHERWISE EXIT IMMEDIATELY
LIB6:	INC	R2		;SET POINTER TO NEXT BYTE
	CMPB	STLN(R0),LIBC(R0);CHECK STRING LENGTH
	BGT	LIB1		;IF SHORTER THEN PREVIOUS THEN REJECT
	MOVB	LIBC(R0),STLN(R0);OTHERWISE SAVE LENGTH
	MOVB	(R2),LIBV(R0)	;AND SAVE VALUE
	BR	LIB1		;AND CONTINUE
;
;
; END OF LIBRARY ROUTINE
;
LIB3:
LIB8:	CLRB	LIBC(R0)
	TSTB	LIBV(R0)	;TEST SIGN OF LOW HALF
	BPL	LIB31		;AND SKIP IS POSITIVE
	MOVB	#-1,LIBC(R0)	;OTHERWISE EXTEND SIGN
LIB31:
	JMP	L99C1		;AND CONTINUE
;
;
LSTR:	CLR	R2
	MOVB	SIGN(R0),R2	;FETCH STRING LENGTH
	MOV	R2,R3		;AND COPY TO R3
	ADD	ISTR(R0),R2	;CALCULATE END OF STRING ADDRESS
	NEG	R3		;NEGATE R3
	ADD	BLEN(R0),R3	;AND CALCULATE NO OF PADDING CHARS
	BLE	LSTR2		;AND SKIP IF AT END OF BUFFER
LSTR1:	MOVB	SPC,(R2)+
	SOB	R3,LSTR1	;AND LOOP FOR NO. OF CHARS
LSTR2:	JMP	L991		;AND CONTINUE
;
;
;
;
;
;
;
;
;
;
;
; ERROR EXIT
;
;
;
;
L700:	NEG	R3		;NEGATE ERROR CORE
	MOVB	R3,IST(R0)	;STORE IT IN IST
	MOVB	ITWM1,ITWAS(R0)	;SET ERROR FLAG
	JMP	L1000		;EXIT
;
;   NORMAL EXIT
;
;
;
;
;
;
L1000:	LDFPS	(SP)+		;RESTORE FPP STATUS
	MOV	(SP)+,R3	;POP R3
	MOV	(SP)+,R2	;POP R2
	RTS	PC		;RETURN
;
;
;
;
;
;
;
;
;
;
;
; SPECIAL FUNCTIONS
;
;  JUMP ACCORDING TO -ICH
;
;
L999:	CLR	R3		;CLEAR R3
	MOVB	ICH(R0),R3	;FETCH ICH
	NEG	R3		;R3=-ICH
	CMP	V11,R3		;CHECK AGAINST 11
	BGE	L711		;SKIP IF VALID
	MOV	#11.,R3		;ERROR CODE 11
	JMP	L700		;ERROR EXIT
L711:	ASL	R3		;AND CONVERT TO BYTES
	MOV	IREATE(R3),PC	;JUMP
;
; INITIALISATION
L981:	MOV	IA(R0),KPOINT(R0);INITIALISE KPOINT
	CLR	@KPOINT(R0)	;AND LEAVE END OF BUUFER TO RESET
	JMP	L991		;EXIT
;
;  RETURN AFTER ABORT ROUTINE
;
;
;
L9810:	JMP	L501		;BYPASS INITIAL SETTING UP
;
;
L9811:	MOV	IST(R0),BASE	;CHANGE NUMERIC BASE
	JMP	L991
;
;
;
;
;
;
;
.NLIST
.NLIST	SEQ,LOC,BIN,BEX
.LIST
; TABLES
;
; TABLE WITH JUMP ADDRESS ROOT BASE ON CHARACTER TYPE ACROSS
; AND STATES DOWN
;
IRT:	.BYTE	0,3.,2.,2.,4.,19.,1.,19.,12.,21.,18.,24.,25.,29.
	.BYTE	6.,6.,6.,6.,6.,6.,9.,20.,21.,6.,9.,25.,30.
	.BYTE	7.,10.,22.,5.,10.,10.,10.,10.,21.,10.,10.,25.,30.
	.BYTE	8.,23.,11.,23.,23.,23.,23.,23.,21.,23.,23.,25.,30.
	.BYTE	13.,23.,23.,23.,13.,13.,13.,23.,21.,23.,23.,25.,30.
	.BYTE	14.,23.,23.,23.,19.,1.,19.,23.,21.,23.,23.,25.,30.
	.BYTE	15.,16.,16.,16.,16.,16.,16.,16.,21.,16.,16.,25.,30.
	.BYTE	6.,6.,6.,6.,6.,6.,6.,6.,21.,26.,24.,25.,30.
	.BYTE	2.,2.,2.,2.,2.,2.,19.,12.,21.,2.,24.,25.,30.
	.BYTE	27.,27.,27.,27.,27.,27.,27.,27.,21.,27.,28.,25.,30.
	.BYTE	6.,6.,6.,6.,6.,6.,6.,6.,21.,6.,20.,25.,30.
	.BYTE	31.,31.,31.,31.,31.,31.,31.,31.,31.,31.,31.,31.,32.
;
; TABLE OF IST STATES ON ENTRY INDEXED BY INWAS
;
ISTAB:	.BYTE	0,0,0,0,0,8.,9.,0,0,0,0
;
.EVEN
;
; TABLE OF JUMP ADRESS AS GIVEN FROM IRT ABOVE
;
IT:	.WORD	0,L901,L902,L903,L904,L905,L906,L907,L908,L909
	.WORD	L910,L911,L912,L913,L914,L915,L916,L917,L918,L919
	.WORD	L920,L921,L922,L923,L924,L925,L926,L927,L928
	.WORD	L929,L930,L931,L932
;
; TABLE OF EXIT ROOTS GIVEN BY ITWAS ACROSS
; AND INWAS DOWN
;
IRTEX:	.BYTE	1,1,13.,6,5,1
	.BYTE	10.,2,4,4,9.,10.
	.BYTE	3,11.,4,4,8.,3
	.BYTE	4,4,13.,6,5,4
	.BYTE	10.,4,4,4,9.,4
	.BYTE	7,7,13.,6,5,4
	.BYTE	7,7,13.,6,5,4
	.BYTE	10.,2,4,4,9.,10.
	.BYTE	3,11.,4,4,8.,3
	.BYTE	10.,2,12.,12.,9.,4
	.BYTE	10.,2.,4.,4.,9.,10.
	.EVEN
;
; TABLE OF JUMP ADDRESSES GIVE BY IRTEX ABOVE
;
IRTJ:	.WORD	0,L991,L992,L993,L994,L995,L996,L997,L99D1,L99D2
	.WORD	L99C1,L99C2,LIB0,LSTR
;
; TABLE OF JUMP ADDRESS GIVEN WITH A NEGATIVE ICH ON ENTRY
;
IREATE:	.WORD	0,L981,L9810,L9811
;
; TABLE OF CHARACTER TYPES BEING A SEQUENTIAL LIST OF TYPE ACCORDING
; TO THE VALUE OF THE ASCII CHARACTER (STARTING WITH ZERO)
;
	.RADIX	10
;
ITYPE:	.BYTE	11,12,9,9,9,12,9,9,11,7,9,8,8,11,9,9	;0 - SI
20$:	.BYTE	9,9,9,9,9,9,9,9,9,9,12,9,9,9,9,9	;DLE - US
40$:	.BYTE	7,2,2,2,2,2,2,10,2,2,2,5,7,6,4,8	;SP - /
60$:	.BYTE	1,1,1,1,1,1,1,1,1,1,8,8,2,2,2,2		;0 - ?
100$:	.BYTE	2,2,2,2,2,3,2,2,2,2,2,2,2,2,2,2		;@ - O
120$:	.BYTE	2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2		;P - _
140$:	.BYTE	2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2		;<140> - o
160$:	.BYTE	2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,9		;p - DEL
;
	.RADIX
;
;
;
;
.NLIST
.LIST	SEQ,LOC,BIN
.LIST
;
; CONSTANTS
; IST(N) ARE THE STATE VALUES
IST0:	.BYTE	0
IST1:	.BYTE	1
IST2:	.BYTE	2
IST3:	.BYTE	3
IST4:	.BYTE	4
IST5:	.BYTE	5
IST6:	.BYTE	6
IST7:	.BYTE	7
IST8:	.BYTE	8.
IST9:	.BYTE	9.
IST10:	.BYTE	10.
IST11:	.BYTE	11.
;  ITW(N) ARE THE VALUES FOR ITWAS
ITWM3:	.BYTE	-3
ITWM2:	.BYTE	-2
ITWM1:	.BYTE	-1
ITW0:	.BYTE	0
ITW1:	.BYTE	1
ITW2:	.BYTE	2
ITW3:	.BYTE	3
ITW4:	.BYTE	4
ITW5:	.BYTE	5
ITW6:	.BYTE	6
ITW7:	.BYTE	7
NOSTR:	.BYTE	11
NOSTRD:	.BYTE	10
; STRING SUPPRESS BIT TABLE INDEXED BY INWAS
;
STFLG:	.BYTE	0,10,10,0,10,0,0,30,30,0,30
NODFL:	.BYTE	2
NOLIM:	.BYTE	4
ARRY:	.BYTE	20
VP1:	.BYTE 	1		;PLUS UNITY
VM1:	.BYTE 	-1		;MINUS UNITY
;
DMACH=176
;
.EVEN
BASE:	.WORD	10.		;NUMBER BASE
IRTEXR=11.	;IRTEX NUMBER OF ROWS
IRTEXC=6	;IRTEX NO. OF COLUMNS
IRTR=12.		;IRT NO. OF ROWS
IRTC=13.		;IRT NO. OF COLUMNS
V11:	.WORD	3		; RANGE OF JUMP FOR SPECIAL FUNCTIONS.
V96:	.WORD	IRTC*IRTR	; RANGE OF JUMP FOR IRT
V12:	.WORD	IRTC		; MULTIPLICAND FOR ADDRESS CALCULATION OF IRT
V4:	.WORD	IRTEXC	;MULTIPLICAND FOR ADDRESS CALCULATION OF IRTEX
V24:	.WORD	IRTEXR*IRTEXC	; JUMP ADDRESS LIMIT FOR IRTEX
V6:	.BYTE	IRTEXR-1	;LARGEST POSSIBLE VALUE OF INWAS
V5:	.BYTE	5		;INWAS=5 TEST VALUE
VZERO:	.FLT2	0.		;FLOATING POINT ZERO
VZERO2=VZERO+2
IOLEN:	.WORD	80.		;INPUT BUFFER LENGTH
V48:	.WORD	48.		;NUMBER TO CONVERT ASCII CHARACTER TO BINARY
TYP11:	.WORD	11.		;END OF BUFFER TYPE CODE
SPC:	.BYTE	040		;PADDING CHARACTER FOR STRINGS
EOMC:	.BYTE	176		;END OF MACRO CHARACTER
LLVC:	.BYTE	57		;CHARACTER TO INDICATE 'USE LAST VALUE'
;
	.EVEN
;
;
;
;
;
;
;
.END