$LONGER=1
	.SBTTL	PDM70.001
	.TITLE	PDM70.MAC
;
;
; PDM70 ROUTINES FOR BASIC/PTS-11 AND BASIC/RT-11.
;
; COPYRIGHT:	DIGITAL EQUIPMENT CORPORATION, MAYNARD MASS.,  1974
;
; WRITTEN BY:	RICK HULLY		JANUARY 1974
;		STEPHEN R. ALPERT
;
	.SBTTL	CONTENTS OF PDM70
;
;
;	BUF  - DEFINE CIRCULAR BUFFER
;	GETS - GET STRING SEGMENT
;	PROG - SEND PROGRAM
;	DATA - SEND DATA
;	BCD  - CONVERT BCD TO BINARY
;
	.SBTTL	CONDITIONAL ASSEMBLY PARAMETERS
;
; TO ASSEMBLE WITH LONG ERROR MESSAGES, DEFINE $LONGER=1
;
	.SBTTL	PROGRAM GLOBALS
;
; GLOBALS REQUIRED FOR COMMUNICATION WITH THE BASIC
; INTERPRETER.
;
	.GLOBL	ERRSYN,ERRARG,.LPAR
	.GLOBL	EVAL,GETVAR,STOVAR
	.GLOBL	.COMMA,.RPAR,STOSVAR
	.GLOBL	MAKESTR,INT,.EOL
	.GLOBL	ERRBUF
;
; GLOBALS REQUIRED FOR DEVICE VECTOR DEFINITIONS
;
	.GLOBL	PDMICSR,PDMIBUF
	.GLOBL	PDMOCSR,PDMOBUF
	.GLOBL	PDMTRP,PDMIOA
;
; GLOBALS REQUIRED FOR COMMAND PROCESSORS
;
	.GLOBL	BUF,BCD,GETS
	.GLOBL	PROG,DATA,RLSE
;
	.SBTTL	REGISTER ASSIGNMENTS, EQUATES, AND VARIABLES
;
R0	=	%0
R1	=	%1
R2	=	%2
R3	=	%3
R4	=	%4
R5	=	%5
SP	=	%6
PC	=	%7
;
; GENERAL EQUATES
;
PS	=	-2		;PS = PROCESSOR STATUS WORD
RETURN	=	207		;207 = RTS PC
POLRET	=	134		;134 = JMP @(R4)+
ENTERP	=	134		;134 = JMP @(R4)+
;
; BASIC USER'S EQUATES
;
SS1SAV	=	24		;SS1 SAVE FOR ASSIGNMENT
SS2SAV	=	26		;SS2 SAVE FOR ASSIGNMENT
FAC1	=	40		;HIGH ORDER FLOATING VALUE
FAC2	=	42		;LOW  ORDER FLOATING VALUE
;
; PDM70 SPECIAL CHARACTER SET
;
DC1	=	021		;ALERT SOURCE ADDRESS
DC2	=	022		;ALERT DESTINATION ADDRESS
DC3	=	023		;INITIATE DATA TRANSFER
DC4	=	024		;SINGLE PROGRAM PASS OPERATION
STX	=	002		;ENTER PROGRAMMING MODE
ETX	=	003		;LEAVE PROGRAMMING MODE
SI	=	017		;TRANSFER LITERALS
EOT	=	004		;END DATA TRANSFER
SOH	=	001		;SOURCE MODE COMMAND
SYN	=	026		;TIME DELAY
;
; VARIABLES
;
TPOINT:	.WORD	0		;POINTER IN TBUFF
DATASW:	.WORD	0		;DATA/SI SWITCH (FOR SI, DATASW=0,
				;    FOR DATA, DATASW<>0).
OFLAG:	.WORD	0		;OVERFLOW FLAG FOR INPUT BUFFER
WFLAG:	.WORD	0		;WAIT FLAG FOR OUTPUT BUFFER
EOTF:	.BYTE	0		;INPUT EOT FLAG
NOFIT:	.BYTE	0		;NO FIT FLAG
;
; BUFFER DESCRIPTORS
;
BEGI:	.WORD	0		;POINTER TO BEGINNING OF INPUT BUFFER
ENDI:	.WORD	0		;POINTER TO END OF INPUT BUFFER
PUTI:	.WORD	0		;PUT DATA INPUT POINTER
GETI:	.WORD	0		;GET DATA INPUT POINTER
SS1ADI:	.WORD	0		;ADDRESS OF SUBSCRIPT ONE
SS1I:	.WORD	0		;VALUE OF SUBSCRIPT ONE
;
BEGO:	.WORD	0		;POINTER TO BEGINNING OF OUTPUT BUFFER
ENDO:	.WORD	0		;POINTER TO END OF OUTPUT BUFFER
PUTO:	.WORD	0		;PUT DATA OUTPUT POINTER
GETO:	.WORD	0		;GET DATA OUTPUT POINTER
SS1ADO:	.WORD	0		;ADDRESS OF SUBSCRIPT ONE
SS1O:	.WORD	0		;VALUE OF SUBSCRIPT ONE
;
; INTERNAL WORD AREA
;
TBUFF:	.=.+66.			;WORK AREA USED TO ASSEMBLE STRINGS
;
	.SBTTL	"BUF" COMMAND PROCESSOR
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; "BUF" COMMAND PROCESSOR
;
; BASIC FORM:   CALL "BUF"(X,Y)
;
; PURPOSE:  DEFINE BUFFER AREAS FOR USE AS INPUT AND OUTPUT
;		CIRCULAR BUFFERS.  X IS USED FOR INPUT, Y FOR
;		OUTPUT.
;
BUF:				;ENTRY POINT TO PROCESSOR
	JSR	PC,POLENT	;ENTRY POLISH MODE AND CHECK
				;    FOR ENOUGH AREA TO WORK
				;    WITH AND THAT FIRST TOKEN
				;    IS INDEED A LEFT PARENS.
	.+2			;EXIT POLISH MODE
	BIC	#100,@#PDMICSR	;TURN OFF PDM70
	BIC	#100,@#PDMOCSR
	JSR	PC,GETARY	;GET "X" ARRAY FROM INPUT LINE AND
				;    CALCULATE ITS ARRAY ADDRESS.
	ADD	#4,R2		;POINT TO FIRST SUBSCRIPT
	MOV	R2,SS1ADI
	MOV	(R2),SS1I	;SAVE SUBSCRIPT VALUE
	CLR	(R2)		;PROTECT ARRAY
	MOV	#BEGI,R2	;SAVE ITS CHARACTERISTICS AND
	JSR	PC,BUFINT	;    INITIALIZE BUFFER.
	CMPB	(R1)+,#.COMMA	;NEXT TOKEN MUST BE A COMMA
	BEQ	.+6
	JMP	@#ERRSYN	;NO:  SYNTAX ERROR
	JSR	PC,GETARY	;GET "Y" ARRAY NOW
	ADD	#4,R2		;POINT TO FIRST SUBSCRIPT
	MOV	R2,SS1ADO
	MOV	(R2),SS1O	;SAVE SUBSCRIPT VALUE
	CLR	(R2)		;PROTECT ARRAY
	MOV	#BEGO,R2	;SAVE ITS CHARACTERISTICS
	JSR	PC,BUFINT
	CLR	OFLAG		;CLEAR OVERFLOW FLAG
	MOV	#PDMTRP,R0	;SETUP INTERRUPT TRAP VECTORS
	MOV	#PDMINT,(R0)+
	MOV	#200,(R0)+
	MOV	#PDMONT,(R0)+
	MOV	#200,(R0)+
	BIS	#100,@#PDMICSR	;ENABLE PDM70 FOR INPUT
CKEXIT:
	MOV	(SP)+,R4	;RESTORE R4
	JMP	CKRPAR		;ALL DONE, CHECK FOR RIGHT
				;    PARENS AND RETURN TO
				;    THE BASIC INTERPRETER.
;
BUFINT:				;INITIALIZE BUFFER
	MOV	R0,(R2)+	;SAVE BEGINNING ADDRESS OF
				;    ARRAY.
	MOV	R3,(R2)+	;SAVE ENDING ADDRESS OF ARRAY
	MOV	R0,(R2)+	;RESET GET AND PUT POINTERS
	MOV	R0,(R2)+
	CLR	-(R0)		;ZERO OUT THE SCALAR "A" (USED FOR
	CLR	-(R0)		;     COUNT OF LOST LINES) AND "A(0)"
	CLR	-(R0)		;     (COUNT OF UNPROCESSED LINES).
	CLR	-(R0)
	RETURN			;RETURN TO CALLER
;
	.SBTTL	"RLSE" COMMAND PROCESSOR
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; "RLSE" COMMAND PROCESSOR
;
; BASIC FORM:   CALL "RLSE"
;
; PURPOSE:	RELEASE PROTECTED BUFFERS DEFINED IN THE
;		LAST "BUF" STATEMENT.
;
RLSE:				;ENTRY POINT TO PROCESSOR
	CMP	SP,R4		;CHECK FOR ENOUGH ROOM
	BHI	.+6		;YES:  CONTINUE
	JMP	@#ERRBUF	;OUT OF ROOM
	MOV	SS1I,@SS1ADI	;RESET ARRAY DECLARATIONS
	MOV	SS1O,@SS1ADO
	CLR	BEGI		;DISALLOW USE OF THESE ARRAYS FOR
	CLR	@#PDMICSR	;TURN OFF INTERRUPT FROM PDM70
	CLR	@#PDMOCSR
				;    CIRCULAR BUFFERING NOW.
	CMPB	(R1),#.EOL	;NEXT TOKEN MUST BE AN EOL
	BNE	.+4		;NO:  ILLEGAL STATEMENT TERMINATION
	RETURN			;RETURN TO THE BASIC INTERPRETER.
	JMP	@#ERRSYN	;SYNTAX ERROR
;
	.SBTTL	"PROG" COMMAND PROCESSOR
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; "PROG" COMMAND PROCESSOR
;
; BASIC FORM:   CALL "PROG"(S$)
;
; PURPOSE:  SEND PROGRAM TO PDM70
;
PROG:				;ENTRY POINT TO PROCESSOR
	JSR	PC,POLENT	;ENTER POLISH MODE AND CHECK
				;    FOR ENOUGH AREA TO WORK
				;    WITH AND THAT FIRST TOKEN
				;    IS INDEED A LEFT PARENS.
	+CKBUF			;MAKE SURE 'BUF' HAS BEEN CALLED
	.+2			;EXIT POLISH MODE
	JSR	PC,GETSTR	;GET "S$"
	MOV	#TBUFF+1,TPOINT	;PUT ASSEMBLED STRING IN WORK
				;    BUFFER.
	MOV	#33.,R0		;CLEAR WORK AREA
	MOV	#TBUFF,R2
PROG00:	CLR	(R2)+
	DEC	R0
	BGT	PROG00
PROG0:	TST	R4		;ANY CHARS LEFT IN STRING?
	BNE	.+6		;YES:
	JMP	.ETX		;NO:  FINISH UP BY ADDING AN ETX THEN
	JSR	PC,IGNCOM	;IGNORE COMMAS
	BR	PROG0		;ONE WAS IGNORED, RECHECK CHARACTER
				;    COUNT.
	CMPB	(R3),#'^	;FIRST CHARACTER OF GROUP AN "^"?
	BEQ	PROG4		;YES:  GET NEXT ONE THEN
	MOVB	(R3)+,R2	;ASSEMBLE THE NEXT 2 CHARS TOGETHER
	SWAB	R2
	BISB	(R3)+,R2
	SWAB	R2
	SUB	#2,R4		;COUNT THE TWO CHARACTERS
	BLE	IST		;NONE LEFT, THIS IS AN ILLEGAL
				;    STATEMENT TERMINATION.
	MOV	#TCHARS,R0	;SEARCH TABLE FOR LEGAL COMMAND
PROG1:	CMP	R2,(R0)+	;MATCH ON 1ST 2 CHARS?
	BNE	PROG3		;NO:  LOOK AT NEXT ENTRY
	CMP	R2,#"SI		;WAS IT AN SI?
	BEQ	PROG2		;YES:  ASSUME A MATCH THEN
	CMPB	(R3),(R0)	;3RD CHAR MATCH?
	BNE	PROG3		;NO:  NO MATCH THEN
	INC	R3		;BUMP PAST 3RD CHARACTER
	DEC	R4		;COUNT CHARACTER
PROG2:	MOVB	1(R0),R2	;SAVE CONTROL CHARACTER IN OUTPUT BUFFER
	JSR	PC,STOUT
	TST	(R0)+		;PROCESS REQUEST
	JMP	@(R0)
PROG3:	CMP	(R0)+,(R0)+	;R0=R0+4 (LOOK AT NEXT ENTRY)
	CMP	R0,#ENDCH	;END OF TABLE?
	BLO	PROG1		;NO:  LOOK AT NEXT GROUP
PROERR:				;ILLEGAL PROGRAM COMMAND
	TRAP	0
	.IFNDF	$LONGER
	.ASCII	/IPC/
	.ENDC
	.IFDF	$LONGER
	.ASCII	/ILLEGAL PROGRAMMED COMMAND/
	.ENDC
	.BYTE	0
	.EVEN
;
PROG4:	TSTB	(R3)+		;GET PROGRAMMED COMMAND
	MOVB	(R3)+,R2
	SUB	#2,R4		;COUNT CHARACTERS
	BLT	IST		;ILLEGAL STATEMENT TERMINATORS
	BIT	#100,R2		;MUST BE AN ALPHABETIC CHAR
	BEQ	PROERR		;NO:  ILLEGAL COMMAND THEN
	BIC	#177700,R2	;MAKE IT A CONTROL CHAR
	MOV	#TCHARS+2,R0	;SEARCH TABLE FOR MATCH
PROG5:	CMPB	R2,1(R0)	;MATCH?
	BEQ	PROG2		;YES:  PROCESS IT
	CMP	(R0)+,(R0)+	;BUMP R0 BY 4
	CMP	R0,#ENDCH	;END OF TABLE?
	BLO	PROG5		;NO: LOOK AT NEXT ENTRY
	BR	PROERR		;YES:  ILLEGAL PROGRAM COMMAND
;
; STORE CHARACTER IN OUTPUT BUFFER
;
; CALLING SEQUENCE:
;
;	MOVB	CHAR,R2
;	JSR	PC,STOUT
;
STOUT:
	MOVB	R2,@TPOINT	;STORE CHAR IN OUTPUT BUFFER
	INC	TPOINT
	CMP	TPOINT,#TBUFF+57. ;MAKE SURE WE WON'T OVERFLOW THE BUFFER
	BHIS	.+4		;WE DID:  ERROR
	RETURN			;RETURN TO CALLER
MTLERR:	TRAP	0		;MESSAGE TOO LONG
	.IFNDF	$LONGER
	.ASCII	/MTL/
	.ENDC
	.IFDF	$LONGER
	.ASCII	/MESSAGE TOO LONG/
	.ENDC
	.BYTE	0
	.EVEN
;
;
; SOH PROCESSOR
;
.SOH:
	MOV	TPOINT,-(SP)	;MAKE SURE A DC1 WAS 2 CHARACTERS BACK
	SUB	#3,(SP)		;    OF THE SOH.
	CMPB	@(SP)+,#DC1
	BEQ	SOH0		;OK
	JMP	PSE		;NO:  PROGRAM SEQUENCE ERROR.
SOH0:	TST	R4		;END OF STRING?
	BLE	IST		;YES:  ILLEGAL HERE
	JSR	PC,IGNCOM	;IGNORE COMMAS
	BR	SOH0		;TRY AGAIN, A COMMA WAS REMOVED
	CMPB	(R3),#'<	;CHECK NUMERIC ARG FOLLOWING 'SOH'
				;    FOR '<', OR '0' THRU '9'.
	BEQ	SOH1		;OK:  SAVE IT
	CMPB	(R3),#60	;(CHECK >=0)
	BLT	PARER		;PROGRAM ARG ERROR (PAE)
	CMPB	(R3),#71	;(CHECK <=9).
	BGT	PARER		;PAE
SOH1:	MOVB	(R3)+,R2	;SAVE THE ARGUMENT
	JSR	PC,STOUT
	DEC	R4		;COUNT CHARACTER
	BR	PROG0		;GET NEXT COMMAND
;
; SI PROCESSOR
;
.SI:
	CLR	DATASW		;INDICATE THIS IS AN "SI DATA" COMMAND
SIP:
	TST	R4		;END OF STRING?
	BLE	SI4		;YES:  ILLEGAL HERE (UNLESS "DATA"
				;      STATEMENT IS BEING PROCESSED).
	CMPB	(R3),#'^	;ASSEMBLE ARGUMENT
	BEQ	SI1		;"^" FOUND
SI00:	MOVB	(R3)+,R2	;SAVE CHARACTER AS IS
SI0:	JSR	PC,STOUT
	DEC	R4		;COUNT CHARACTER
	BR	SIP		;DO NEXT ONE
SI1:	INC	R3		;GET NEXT CHAR FOR "^" CONSTRUCTION
	DEC	R4
	CMPB	(R3),#'^	;TWO UP ARROWS IN A ROW?
	BEQ	SI00		;YES:  SAVE AS A LITERAL THEN
	TST	R4		;STILL HAVE CHARACTERS LEFT?
	BGT	SI2		;YES
IST:				;ILLEGAL STRING TERMINATOR
	TRAP	0
	.IFNDF	$LONGER
	.ASCII	/IST/
	.ENDC
	.IFDF	$LONGER
	.ASCII	/ILLEGAL STRING TERMINATOR/
	.ENDC
	.BYTE	0
	.EVEN
;
SI2:	MOVB	(R3)+,R2	;GET CONTROL COMMAND
	BIC	#177700,R2	;TRIM OFF 100 BIT
	MOV	#TCHARS+3,R0	;SEE IF ITS ILLEGAL DATA CHAR
SI3:	CMPB	(R0),R2		;MATCH?
	BEQ	SI5		;YES:  COULD BE ILLEGAL PROGRAM ARGUMENT
	ADD	#6,R0		;LOOK AT NEXT ONE
	CMP	R0,#ENDCH	;END OF TABLE?
	BLO	SI3		;NO:  CONTINUE
	BR	SI0		;YES: KEEP IT THEN
;
SI5:	TST	DATASW		;IN DATA MODE?
	BEQ	SI11		;NO
	CMPB	R2,#STX		;PASS ALL BUT AN STX
	BEQ	PARER		;STX FOUND:  ILLEGAL PARAMETER
	BR	SI0		;SAVE CHARACTER
SI11:	CMPB	R2,#SYN		;CAN ONLY BE A DC3 OR SYN IF IN "SI"
	BNE	SI10		;NOT A SYN
	JSR	PC,STOUT	;SAVE 'SYN'
	JSR	PC,SYNCOM	;PROCESS SYN ARG
	BR	SIP		;GET NEXT CHARACTER
SI10:	CMPB	R2,#DC3		;CAN ONLY BE A DC3 TO BE LEGAL (SI)
	BNE	PARER		;NO:  ILLEGAL ARGUMENT
	JSR	PC,STOUT	;INSERT DC3 INTO BUFFER
	DEC	R4
	BR	PROGR		;PROCESS NEXT COMMAND
SI4:	TST	DATASW		;WAS THIS A DATA STATEMENT?
	BEQ	IST		;NO:  ILLEGAL TERMINATOR THEN
	MOVB	#EOT,R2		;GENERATE AN EOT
	JSR	PC,STOUT
	MOV	#TBUFF,R2	;IN CASE 'END OF STRING' IS DETECTED
	DEC	R4		;THIS MUST BE THE LAST CHARACTER OF THE
				;    STRING NOW.
	BGT	PARER		;NO:  PARAMETER ERROR
	JMP	COUT		;OK:  SEND STRING NOW.
;
PARER:				;PROGRAM ARGUMENT ERROR
	TRAP	0
	.IFNDF	$LONGER
	.ASCII	/PAE/
	.ENDC
	.IFDF	$LONGER
	.ASCII	/PROGRAM ARG ERROR/
	.ENDC
	.BYTE	0
	.EVEN
;
; DC1 PROCESSOR
;
.DC1:
	JSR	PC,DCARG	;PROCESS ARG
	BR	PARER		;ILLEGAL ARG
	BR	PROGR		;GET NEXT PROGRAMMED COMMAND
;
; DC2 PROCESSOR
;
.DC2:
	JSR	PC,DCARG	;PROCESS ARG
	BR	PROGR		;ILLEGAL ARG:  MUST BE NEXT COMMAND
	BR	.DC2		;GET NEXT ARG IF ONE EXISTS
PROGR:	JMP	PROG0
;
DCARG:	TST	R4		;END OF STRING?
	BLE	IST		;YES:  ILLEGAL HERE
	JSR	PC,IGNCOM	;IGNORE ANY COMMAS
	BR	DCARG		;COMMA WAS REMOVED, TRY AGAIN
	CMPB	(R3),#60	;ARG MUST BE A NUMERIC OR :, ;, <, =,
				;    >, OR ? TO BE LEGAL.
	BLT	DCARG1		;NO:  USE ERROR EXIT
	CMPB	(R3),#77
	BGT	DCARG1
	ADD	#2,(SP)		;SHOW SUCCESS
	MOVB	(R3)+,R2	;SAVE CHAR IN OUTPUT BUFFER
	JSR	PC,STOUT
	DEC	R4		;COUNT CHARACTER
DCARG1:	RETURN			;RETURN TO CALLER
;
; IGNORE COMMAS
;
IGNCOM:
	TST	R4		;DON'T TEST IF A NULL STRING
	BEQ	IGN1		;YES:  EXIT IMMEDIATELY SHOWING SUCCESS
	CMPB	(R3),#',
	BEQ	IGN2		;COMMA FOUND
IGN1:	ADD	#2,(SP)		;SHOW NO COMMA DELETED
	RETURN
IGN2:	DEC	R4		;DELETE COMMA FROM CHARACTER COUNT
	INC	R3		;BUMP PAST IT IN ARG STRING
	RETURN			;RETURN TO CALLER
;
; SYN PROCESSOR
;
.SYN:
	JSR	PC,SYNCOM	;PROCESS 'SYN' ARGUMENT
	BR	PROGR		;PROCESS NEXT COMMAND
SYNCOM:
	TST	R4		;END OF STRING?
	BLE	IST		;YES:  ILLEGAL HERE
	JSR	PC,IGNCOM	;IGNORE ANY COMMAS
	BR	SYNCOM		;TRY AGAIN, (COMMA REMOVED)
	CMPB	(R3),#61	;ARG MUST BE BETWEEN 1 AND 9 INCLUSIVELY
	BLT	PARER		;ARG ERROR
	CMPB	(R3),#71
	BGT	PARER
	MOVB	(R3)+,R2	;SAVE THE ARGUMENT
	JSR	PC,STOUT
	DEC	R4		;COUNT THE CHARACTER
	RETURN			;RETURN TO CALLER
;
; ETX PROCESSOR
;
.ETX:
	TST	R4		;MUST BE AT END OF ARGUMENT STRING
	BNE	PARER		;NO:  ARGUMENT ERROR THEN
	MOV	TPOINT,R0	;POINTER TO END OF TEXT OUTPUT BUFFER +1
	MOV	#TBUFF+1,R2	;POINT TO START OF TEXT TO OUTPUT
	CMPB	(R2),#STX	;STX GIVEN?
	BEQ	ETX1		;YES
	MOVB	#STX,-(R2)	;NO:  INSERT ONE THEN
ETX1:	CMPB	-1(R0),#ETX	;ETX GIVEN EXPLICITLY?
	BNE	ETX2		;NO
	DEC	R0		;YES:  MOVE IT AFTER THE SERIAL LINE
				;    PROGRAM WHICH WE'RE TACKING ON
				;    THE END OF HIS.
ETX2:	MOV	#SERPGM,R3	;TACK ON PROGRAM TO READ THE
				;    SERIAL LINE.
ETX3:	MOVB	(R3)+,(R0)
	CMPB	(R0)+,#ETX	;ETX TERMINATES
	BNE	ETX3
	MOV	R2,R0		;POINTER TO STRING
	INC	R0		;BUMP PAST STX
PSELP:	MOV	#BYTTAB,R3	;POINTER TO SPECIAL CHARACTERS
	JSR	PC,MSTEQ	;DC4?
	DEC	R0		;NO
	JSR	PC,MSTEQ	;DC1?
	BR	PSE		;NO:  SEQUENCE ERROR
	JSR	PC,TSTIT	;SOH?
	INC	R3		;NO:  DON'T WORRY
	JSR	PC,TSTIT	;GO FOR DC2
	BR	PSE		;NO:  SEQUENCE ERROR
	JSR	PC,TSTIT	;AN SI?
	INC	R3		;NO:  DON'T WORRY
	JSR	PC,TSTIT	;A SYN?
	BR	.+4		;NO
	CMPB	(R0)+,-(R3)	;YES:  GO BY DIGIT
	INC	R3		;BUMP PAST SYN IN BYTTAB
	JSR	PC,MSTEQ	;DC3?
	BR	PSE		;NO:  SEQUENCE ERROR
	CMP	R0,TPOINT	;END OF USER'S PROGRAM?
	BLO	PSELP		;NO:  CONTINUE
	BR	COUT		;OUTPUT PROGRAM NOW
PSE:				;PROGRAM SEQUENCE ERROR
	TRAP	0
	.IFNDF	$LONGER
	.ASCII	/PSE/
	.ENDC
	.IFDF	$LONGER
	.ASCII	/PROGRAM SEQUENCE ERROR/
	.ENDC
	.BYTE	0
	.EVEN
;
; SUBROUTINES TO PROCESS COMPILED LINE SYNTACTICALLY
;
; CALLING SEQUENCE WITH R3 POINTING TO BYTTAB AND R0 IN STRING.
;
; 	JSR	PC,ROUTINE
;	RETURN IF NO MATCH (MSTEQ ALWAYS BUMPS R0 AND R3
;		TSTIT BUMPS ONLY IF A MATCH).
;	RETURN IF A MATCH
;
BYTTAB:	.BYTE	DC4,DC1,SOH,DC2,SI,SYN,DC3,0
;
MSTEQ:	CMPB	(R3)+,(R0)+	;MATCH?
	BNE	.+6		;NO:  RETURN=RETURN
MST0:	ADD	#2,(SP)		;YES:  RETURN=RETURN+2
	RETURN			;RETURN TO CALLER
;
TSTIT:	CMPB	(R3)+,(R0)+	;MATCH?
	BEQ	MST0		;YES:  RETURN=RETURN+2
	CMPB	-(R3),-(R0)	;NO:  POINT AT THEM THEN
	MOV	R3,-(SP)	;SAVE R3
TSTLP:	MOV	#BYTTAB,R3	;POINT AT TABLE
TST0:	TSTB	(R3)		;END OF TABLE?
	BEQ	TST1		;YES:  NO MATCH THEN
	CMPB	(R3)+,(R0)	;NO:  A MATCH?
	BNE	TST0		;NO:  CHECK MORE
	MOV	(SP)+,R3	;YES:  RESTORE R3
	RETURN			;USE ERROR EXIT (RETURN=RETURN
TST1:	MOV	(SP)+,R3	;NO MATCH:  IGNORE
	INC	R0
	BR	TSTIT		;CHECK AGAIN
;
COUT:
	BIS	#200,PS		;PROTECT POINTERS WHILE OUTPUTTING DATA
				;    TO OUTPUT BUFFER.
COUT0:	MOV	PUTO,-(SP)	;UPDATE PUT POINTER
	MOVB	(R2),@PUTO	;SAVE CHARACTER
	INC	(SP)
	CMP	(SP),ENDO	;DID IT CAUSE WRAP AROUND?
	BLOS	COUT1		;NO
	MOV	BEGO,(SP)	;WRAP POINTER AROUND
COUT1:	CMP	(SP),GETO	;WILL WE OVERRUN THE GET POINTER
	BNE	COUT2		;NO:  SAVE CHAR THEN
	CLR	PS		;YES:  GUESS WE'LL HAVE TO WAIT
	MOV	(SP)+,WFLAG	;REMEMBER THAT WE'VE HAD TO WAIT
				;    (CLEAN UP STACK AT THE SAME TIME).
	BR	COUT
COUT2:	MOV	(SP)+,PUTO	;SAVE NEW CHAR POINTER
	CMPB	(R2)+,#EOT	;EOT OR ETX TERMINATES
	BEQ	COUT3		;YES:  EOT FOUND
	CMPB	-1(R2),#ETX
	BNE	COUT0		;NEITHER EOT OR ETX FOUND YET:  CONTINUE
COUT3:	MOV	BEGO,R0		;+1 TO COUNTER FOR NBR OF LINES
	INC	-(R0)		;    CURRENTLY IN BUFFER.
	TST	WFLAG		;DID WE HAVE TO WAIT ON ANY OF THEM?
	BEQ	COUT4		;NO:
	INC	-4(R0)		;YES:  +1 TO LINE WAIT COUNTER
COUT4:	CLR	WFLAG		;CLEAR WAIT FLAG
	CLR	PS		;ENABLE INTERRUPTS NOW
	BIS	#100,@#PDMOCSR	;GET OUTPUT GOING IF ITS NOT ALREADY
	JMP	CKEXIT		;CHECK NEXT TOKEN EQUAL TO A RIGHT
				;    PARENS AND RETURN TO THE
				;    BASIC INTERPRETER.
;
; TABLE OF PROGRAMMED CONTROL CHARACTERS
;
TCHARS:
	.ASCII	/SOH/
	.BYTE	SOH
	.WORD	.SOH
;
	.ASCII	/STX/
	.BYTE	STX
	.WORD	PROG0
;
	.ASCII	/ETX/
	.BYTE	ETX
	.WORD	.ETX
;
	.ASCII	/SI /
	.BYTE	SI
	.WORD	.SI
;
	.ASCII	/DC1/
	.BYTE	DC1
	.WORD	.DC1
;
	.ASCII	/DC2/
	.BYTE	DC2
	.WORD	.DC2
;
	.ASCII	/DC3/
	.BYTE	DC3
	.WORD	PROG0
;
	.ASCII	/DC4/
	.BYTE	DC4
	.WORD	PROG0
;
	.ASCII	/SYN/
	.BYTE	SYN
	.WORD	.SYN
ENDCH:				;END OF PROGRAMM CHARACTERS
;
; SERIAL PROGRAM WHICH FOLLOWS EACH "PROG"
;
SERPGM:	.BYTE	DC1		;DC1
	.BYTE	PDMIOA		;SERIAL INTERFACE ADDRESS
	.BYTE	SOH		;SOH
	.BYTE	'0		;MODE #0
	.BYTE	DC3		;DC3
	.BYTE	ETX		;ETX
	.EVEN
;
	.SBTTL	"DATA" COMMAND PROCESSOR
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; "DATA" COMMAND PROCESSOR
;
; BASIC FORM:	CALL "DATA"(D$)
;
; PURPOSE:	SEND DATA TO PDM70
;
DATA:				;ENTRY PINT TO PROCESSOR
	JSR	PC,POLENT	;ENTER POLISH MODE AND CHECK
				;    FOR ENOUGH AREA TO WORK
				;    WITH AND THA FIRST TOKEN
				;    IS INDEED A LEFT PARENS.
	+CKBUF			;MAKE SURE "BUF" HAS BEEN CALLED
	.+2			;LEAVE POLISH MODE
	JSR	PC,GETSTR	;GET D$
	MOV	#TBUFF,TPOINT	;PUT ASSEMBLED STRING IN WORD BUFFER
	MOV	SP,DATASW	;INDICATE THIS IS "DATA"
	JMP	SIP		;PROCESS DATA STRING
;
	.SBTTL	"GETS" COMMAND PROCESSOR
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; "GETS" COMMAND PROCESSOR
;
; BASIC FORM:   CALL "GETS"(R$)
;
; PURPOSE:	GET LINE OF INPUT FROM PDM70 AND PLACE IT
;		IN R$.
;
GETS:				;ENTRY POINT TO PROCESSOR
	JSR	PC,POLENT	;ENTER POLISH MODE AND CHECK
				;    FOR ENOUGH AREA TO WORK
				;    WITH AND THAT FIRST TOKEN
				;    IS INDEED A LEFT PARENS.
	+CKBUF			;MAKE SURE "BUF" HAS BEEN CALLED
	.+2			;EXIT POLISH MODE
	MOV	R1,-(SP)	;SAVE R1
	MOV	#TBUFF+3,TPOINT	;SETUP TO GENERATE A STRING
	MOV	BEGI,R0		;MAKE SURE THERE'S A LINE TO GET BEFORE
	TST	-(R0)		;    ATTEMPTING TO REMOVE ONE.
	BEQ	GETS4		;THERE NOT:  RETURN A NULL STRING THEN
	CLRB	NOFIT		;FLAG USED TO TEST IF STRING FITS
GETS0:	MOVB	@GETI,R2	;GET CHAR
	INC	GETI		;UPDATE POINTER
	CMP	GETI,ENDI	;DID IT CAUSE A WRAP AROUND?
	BLOS	GETS2		;NO
	MOV	BEGI,GETI	;YES:  WRAP POINTER AROUND
GETS2:	CMPB	R2,#EOT		;EOT?
	BEQ	GETS3		;YES:  ALL DONE
	MOVB	R2,@TPOINT	;SAVE CHARACTER
	INC	TPOINT
	CMP	TPOINT,#TBUFF+65. ;ARE WE EXCEEDING THE BUFFER?
	BLO	GETS0		;NO:  CONTINUE
	DEC	TPOINT		;YES:  BACKUP POINTER AND REMEMBER THE
	INCB	NOFIT		;    OVERFLOW.
	BR	GETS0		;GET NEXT ONE
GETS3:	MOV	BEGI,R2		;DECREMENT LINE COUNT
	DEC	-(R2)
GETS4:	MOV	TPOINT,-(SP)	;GENERATE STRING WITH THE PROPER LENGTH
	SUB	#TBUFF+3,(SP)
	MOV	#TBUFF,TPOINT
	MOV	#TPOINT,R2
	JSR	PC,@#MAKESTR
	MOV	(SP)+,R2	;GET INDIRECT POINT TO GENERATED STRING
	MOV	(SP)+,R1	;RESTORE R1
	MOV	R2,-(SP)	;PUT POINTER BACK ON STACK
	MOV	#GETS5,R4	;ENTER POLISH MODE
	ENTERP
GETS5:	+GETV			;GET ADDRESS OF S$
	.+2			;LEAVE POLISH MODE
	MOV	2(SP),R4	;RESTORE R4
	JSR	PC,@#STOSVAR	;STORE STRING IN S$ NOW
	TSTB	NOFIT		;DID THE ENTIRE STRING FIT?
	BNE	GETS6		;NO
	JMP	CKEXIT		;YES: ALL DONE:  CHECK FOR RIGHT PARENS
				;    AND RETURN TO THE BASIC INTERPRETER.
GETS6:	JMP	MTLERR		;MESSAGE DID NOT ENTIRELY FIT
;
	.SBTTL	"BCD" COMMAND PROCESSOR
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; "BCD" COMMAND PROCESSOR
;
; BASIC FORM:   CALL "BCD"(S$,N)
;
; PURPOSE:	CONVERT A ONE TO FOUR CHARACTER BCD STRING IN S$
;		TO BINARY AND STORE RESULTS IN "N".
;
BCD:				;ENTRY POINT TO PROCESSOR
	JSR	PC,POLENT	;ENTER POLISH MODE AND CHECK
				;    FOR ENOUGH AREA TO WORK
				;    WITH AND THAT FIRST TOKEN
				;    IS INDEED A LEFT PARENS.
	.+2			;EXIT POLISH MODE
	JSR	PC,GETSTR	;GET ADDRESS OF STRING
	CMPB	R4,#4		;STRING CANNOT BE LARGER THAN 4
	BLE	.+6
BCD3:	JMP	@#ERRARG	;NO:  ARG ERROR
	CLR	-(SP)		;ASSEMBLE BCD CHARS
BCD1:	MOVB	(R3)+,R2	;GET A BCD CHAR
	CMPB	R2,#60		;MUST BE LEGAL BCD DIGIT
	BLT	BCD3		;NO
	CMPB	R2,#77
	BGT	BCD3		;NO
	BIC	#177760,R2	;STRIP OFF GARBAGE
	ASL	(SP)		;SHIFT LEFT 4 BITS
	ASL	(SP)
	ASL	(SP)
	ASL	(SP)
	ADD	R2,(SP)		;ADD IN NEW DIGIT
	DEC	R4		;ALL 4 DIGITS DONE?
	BGT	BCD1		;NO:  CONTINUE
	MOV	#BCD2,R4	;ENTER POLISH MODE
	ENTERP
BCD2:	+CKCOMA			;CHECK NEXT TOKEN EQUAL TO A COMMA
	+GETV			;GET ADDRESS OF "N"
	.+2
	MOV	(SP)+,FAC2(R5)	;STORE RESULT IN FAC.
	CLR	FAC1(R5)
	JMP	STORXT		;STORE RESULT IN "N".
;
	.SBTTL	GETV AND CKBUF
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; POLISH ROUTINE TO CALCULATE ADDRESS OF VARIABLE
; SPECIFIED IN THE INPUT LINE.
;
; ROUTINE IS CALLED IN POLISH MODE
;
; REGISTERS USED:	EVAL USES R0, R2, AND R3
;			R1 IS BUMPED PAST VARIABLE
;			RESULT IS STORED IN VARSAV(R5)
;
GETV:
	MOVB	(R1)+,R2	;BUILD WORD OFFSET
	BMI	SYNER		;TOKEN ILLEGAL HERE
	SWAB	R2
	BISB	(R1)+,R2
	ADD	(R5),R2		;R2 NOW POINTS TO SYMBOL TABLE ENTRY
	JSR	PC,@#GETVAR	;GET NAME AND SUBSCRIPTS SET UP
	POLRET			;RETURN IN POLISH MODE
;
SYNER:	JMP	@#ERRSYN	;SYNTAX ERROR
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; POLISH ROUTINE TO CHECK IF "BUF" HAS BEEN CALLED PREVIOUSLY.
; ERROR IF NOT.
;
CKBUF:
	TST	BEGI		;HAS BUFFER BEEN SET UP?
	BEQ	.+4		;NO:  ISSUE ERROR MESSAGE
	POLRET			;RETURN IN POLISH MODE
;
	TRAP	0		;BUFFER NOT SETUP
	.IFNDF	$LONGER
	.ASCII	/BNS/
	.ENDC
	.IFDF	$LONGER
	.ASCII	/BUFFER NOT SETUP/
	.ENDC
	.BYTE	0
	.EVEN
;
	.SBTTL	PDM70 INPUT INTERRUPT ROUTINE
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; INPUT INTERRUPT ROUTINE TO STORE CHARACTERS INTO CIRCULAR
; BUFFER AND TEST FOR DATA OVERFLOW.
;
PDMINT:
	MOV	R0,-(SP)	;SAVE R0
	MOVB	@#PDMIBUF,R0	;GET CHARACTER FROM PDM70
	BIC	#177600,R0	;REMOVE PARITY BIT
	CMPB	R0,#EOT		;EOT?
	BNE	INT6		;NO:  CONTINUE
	TSTB	EOTF		;LAST BYTE RECEIVED AN EOT?
	BEQ	INT5		;YES:  IGNORE THIS ONE
INT6:	INCB	EOTF		;INDICATE LAST CHARACTER WAS NOT AN EOT
	TST	OFLAG		;ARE WE OVERFLOWING?
	BEQ	INT0		;NO:  CONTINUE
	CMPB	R0,#EOT		;WAS THIS AN EOT?
	BNE	INT5		;NO:  IGNORE IT THEN
	CLR	OFLAG		;YES:  CLEAR OVERFLOW FLAG
	MOV	BEGI,R0		;INCREMENT OVERFLOW LINE COUNT
	CMP	-(R0),-(R0)	;(R0=R0-4)
	BR	INT8
INT0:	MOV	PUTI,-(SP)	;UPDATE PUT POINTER
	MOVB	R0,@PUTI	;SAVE CHARACTER
	INC	(SP)
	CMP	(SP),ENDI	;DID IT CAUSE A WRAP AROUND?
	BLOS	INT1		;NO
	MOV	BEGI,(SP)	;WRAP POINTER AROUND
INT1:	CMP	(SP),GETI	;WILL WE OVERRUN THE GET POINTER?
	BNE	INT4		;NO: SAVE CHAR THEN
	MOV	(SP)+,OFLAG	;SET OVERFLOW FLAG
	BR	INT7
INT2:	CMPB	@PUTI,#EOT	;PREVIOUS CHAR INPUT AN EOT?
	BEQ	INT5		;YES:  EXIT
	CMP	PUTI,GETI	;ANYTHING LEFT?
	BEQ	INT5		;NO:  EXIT THEN
INT7:	CMP	PUTI,BEGI	;YES:  ARE WE AT THE BEGINNING OF
				;    THE BUFFER?
	BNE	INT3		;NO
	MOV	ENDI,PUTI	;YES:  BACK UP AND WRAP AROUND
	BR	INT2		;CONTINUE LOOKING FOR EOT
INT3:	DEC	PUTI		;LOOK AT PREVIOUS CHARACTER
	BR	INT2
INT4:	MOV	(SP)+,PUTI	;SAVE NEW CHARACTER POINTER
	CMPB	R0,#EOT		;WAS CHAR AN EOT?
	BNE	INT5		;NO
	MOV	BEGI,R0		;YES:  +1 TO LINE COUNT
INT8:	INC	-(R0)
	CLRB	EOTF		;CLEAR EOT FLAG
INT5:	MOV	(SP)+,R0	;RESTORE R0
	RTI			;RETURN
;
	.SBTTL	PDM70 OUTPUT INTERRUPT ROUTINE
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; OUTPUT INTERRUPT ROUTINE TO SEND CHAR FROM CIRCULAR
; BUFFER TO PDM70.
;
PDMONT:
	MOV	R0,-(SP)	;SAVE R0
	CMP	GETO,PUTO	;IS THERE ANY OUTPUT?
	BEQ	PUTS2		;NO:  TURN OFF INTERRUPT AND EXIT
	MOVB	@GETO,R0	;GET CHAR AND SEND IT
	MOVB	R0,@#PDMOBUF
	CMPB	R0,#ETX		;WAS AN ETX JUST SENT?
	BEQ	PUTS0		;YES:  DECREMENT LINE COUNT
	CMPB	R0,#EOT		;HOW ABOUT AN EOT?
	BNE	PUTS1		;NO
PUTS0:	MOV	BEGO,R0		;DECREMENT LINE COUNT
	DEC	-(R0)
PUTS1:	INC	GETO		;UPDATE GET POINTER
	CMP	GETO,ENDO	;DID IT CAUSE WRAP AROUND
	BLOS	PUTS3		;NO
	MOV	BEGO,GETO	;YES:  WRAP POINTER AROUND
	BR	PUTS3
PUTS2:	BIC	#100,@#PDMOCSR	;TURN OFF OUTPUT TO PDM70
PUTS3:	MOV	(SP)+,R0	;RESTORE R0
	RTI			;RETURN TO INTERRUPTED PROGRAM
;
	.SBTTL	GETARY
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; ROUTINE TO CALCULATE ARRAY ADDRESS FROM ARRAY NAME
; POINTED TO BY R1.
;
; CALLING SEQUENCE:
;	R1 POINTS TO ARRAY NAME OFFSET ON CALL
;	JSR	PC,GETARY
;
; REGISTERS ON RETURN:	R0 POINTS TO ARRAY BASE ADDRESS
; 			R1 IS UPDATED PAST ARRAY NAME
;			R2 POINTS TO SYMBOL TABLE ENTRY
;			R3 HAS ADDRESS OF END OF ARRAY
;
GETARY:
	MOVB	(R1)+,R2	;BUILD WORD OFFSET
	BMI	SYNERR		;TOKEN ILLEGAL HERE
	SWAB	R2
	BISB	(R1)+,R2
	ADD	(R5),R2		;R2 NOW POINTS TO SYMBOL TABLE
	CMP	#177776,(R2)	;VARIABLE MUST BE AN ARRAY
	BNE	SYNERR		;SYNTAX ERROR IF NOT
	MOV	R2,-(SP)	;SAVE R2 TEMP
	JSR	PC,@#GETVAR	;GET NAME AND SUBSCRIPTS SET UP
	MOV	(SP)+,R2	;RESTORE R2
	CMP	#-1,SS2SAV(R5)	;SINGLY SUBSCRIPTED ARRAYS ONLY.
	BNE	SYNERR
	MOV	2(R2),R0	;GET ADDRESS OF ARRAY
	ADD	#8.,R0
	TST	SS1SAV(R5)
	BPL	SYNERR		;SUBSCRIPTS NOT ALLOWED
	MOV	4(R2),R3	;ARRAY SIZE
	ASL	R3		;CALCULATE ADDRESS OF END OF BUFFER
	ASL	R3
	ADD	R0,R3
	RETURN			;RETURN TO CALLER
;
	.SBTTL	GETSTR
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; SUBROUTINE TO GET ADDRESS OF STRING VARIABLE
;
; CALLING SEQUENCE:
;	JSR	PC,GETSTR
;
; REGISTERS USED:  R0 THRU R4
;		   ON RETURN R3 HAS POINTER TO START OF STRING
;		             R4 HAS STRING LENGTH
;
GETSTR:
	JSR	PC,@#EVAL	;ARG MUST BE A STRING
	BCC	GETST1		;CARRY CLEAR INDICATES NO STRING
	MOV	(SP)+,R3	;GET STRING POINTER
	CMP	R3,#-1
	BEQ	GETST1		;NULL STRING ILLEGAL
	MOVB	(R3)+,R4	;GET STRING LENGTH
	BIC	#177400,R4	;SAVE ONLY 8 BITS OF STRING COUNT
	CMPB	(R3)+,(R3)+	;R3 NOW POINTS TO STRING ITSELF
	RETURN			;RETURN TO CALLER
GETST1:	JMP	@#ERRARG	;ILLEGAL ARG TYPE OR NULL STRING
;
	.SBTTL	POLENT AND CKCOMA
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; ENTER POLISH MODE OPERATION AND CHECK CHARACTER
; POINTED TO BY R1 EQUAL TO A LEFT PARENS.
;
; CALLING SEQUENCE:
;	JSR	PC,POLENT
;
; REGISTERS USED:	R4 BECOMES THE POLISH PC.
;			R1 GETS BUMPED BY 1
;
POLENT:
	CMP	SP,R4		;CHECK FOR ENOUGH ROOM
	BLO	ERBUF		;OUT OF ROOM, TELL USER
	MOV	R4,R0		;SAVE R4
	MOV	(SP)+,R4	;GET PC FROM CALLER AND SETUP
				;    THE POLISH PC.
	MOV	R0,-(SP)	;SAVE OLD R4 FOR LATER
;
	CMPB	(R1)+,#.LPAR	;FIRST CHAR MUST BE A LEFT
				;    PARENS.
	BNE	SYNERR		;NO:  SYNTAX ERROR
	ENTERP			;ENTER POLISH MODE
SYNERR:
	JMP	@#ERRSYN	;SYNTAX ERROR
ERBUF:
	JMP	@#ERRBUF	;OUT OF ROOM
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; POLISH ROUTINE TO CHECK CHARACTER POINTED TO BY R1
; EQUAL TO A .COMMA.
;
; ROUTINE IS CALLED IN POLISH MODE
;
; REGISTERS USED:  R1 GETS BUMPED BY ONE.
;
CKCOMA:
	CMPB	(R1)+,#.COMMA	;FIRST CHAR MUST BE A COMMA
	BNE	SYNERR		;NO: SYNTAX ERROR
	POLRET			;RETURN IN POLISH MODE
;
	.SBTTL	STORXT AND CKRPAR
;
;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
;
; COMMON EXIT ROUTINE TO STORE FAC IN VARIABLE SET UP
; IN VARSAV(R5), CHECK NEXT TOKEN EQUAL TO A RIGHT
; PARENS (ALTERNATE ENTRY POINT TO ROUTINE) FOLLOWED
; BY AN END OF LINE TOKEN, AND THEN
; RETURN TO THE BASIC INTERPRETER.
;
; CALLING SEQUENCE:
;	JMP	STORXT
;	    OR
;	JMP	CKRPAR
;
STORXT:
	MOV	(SP)+,R4	;RESTORE R4
	JSR	PC,@#STOVAR	;SAVE FAC
CKRPAR:
	CMPB	(R1)+,#.RPAR	;MAKE SURE NEXT TOKEN IS A
				;    RIGHT PARENS.
	BNE	SYNERR		;SYNTAX ERROR IF NOT
	CMPB	(R1)+,#.EOL	;.EOL MUST ALSO TERMINATE STATEMENT
	BNE	SYNERR
	RETURN			;RETURN TO THE BASIC INTERPRETER
;
	.END			;END OF PDM70 ROUTINES