.TITLE	DATBAS.MAC	81A12C		12-OCT-78/20-DEC-78


;	AUTHOR: N. A. BOURGEOIS, JR.
;	        ADVANCED SYSTEMS DEVELOPMENT DIVISION 1736
;	        SANDIA LABORATORIES
;	        PO BOX 5800
;	        ALBUQUERQUE, NM 87185
;	        505-844-8088
;	        AV  244-8088
;	
;
;	THIS SOFTWARE IS ISSUED BY SANDIA LABORATORIES, OPERATED
;	FOR  THE  UNITED  STATES  DEPARTMENT OF ENERGY BY SANDIA
;	CORPORATION.
;	
;	                         NOTICE
;	
;	THIS  SOFTWARE  WAS  SPONSORED  BY  THE  UNITED   STATES
;	GOVERNMENT.   NEITHER  THE  UNITED STATES GOVERNMENT NOR
;	THE UNITED STATES DEPARTMENT OF ENERGY, NOR ANY OF THEIR
;	EMPLOYEES, NOR ANY OF THEIR CONTRACTORS, SUBCONTRACTORS,
;	OR  THEIR  EMPLOYEES  MAKES  ANY  WARRANTY,  EXPRESS  OR
;	IMPLIED,    OR    ASSUMES   ANY   LEGAL   LIABILITY   OR
;	RESPONSIBILITY  FOR  THE   ACCURACY,   COMPLETENESS   OR
;	USEFULNESS  OF  ANY  INFORMATION,  APPARATUS, PRODUCT OR
;	PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD  NOT
;	INFRINGE PRIVATELY OWNED RIGHTS.
;	
;	THIS WORK WAS SPONSORED AND FUNDED BY:
;	   BASE AND INSTALLATION SECURITY SYSTEMS PROGRAM OFFICE
;	   ELECTRONIC SYSTEMS DIVISION
;	   AIR FORCE SYSTEMS COMMAND
;	   HANSCOM AIR FORCE BASE, MA 01731 
;
.SBTTL                      ****************
.SBTTL                      *              *
.SBTTL                      * UNCLASSIFIED *
.SBTTL                      *              *
.SBTTL                      ****************
.SBTTL	DESCRPIPTION			09-OCT-78/12-JAN-81

;BASIC-11 allows the addition of assembly language routines to expand
;BASIC-11's capabilities.  Once added to BASIC-11, such routines can
;be executed in immediate mode or in programs, by means of the CALL
;statement.  The routines contained in this program permit access to
;any address on DEC's PDP-11 UNIBUS *.  This is useful for exercising
;any peripheral connected to the UNIBUS especially if a handler is not
;present in the operating system.  It is possible to write entire
;handlers for non-standard peripherals such as digital voltmeters and
;point plotters using BASIC-11 and the CALL statement with these
;routines.  The routines contained in this program are designed for use
;on any of the PDP-11 family of computers running the BASIC-11 V2 under
;the RT-11 V03 operating system.  [1,2,3,4,5]

;The extension routines provide the means for reading and writing words,
;bytes ;and bits at any implemented UNIBUS address, identifying the
;extended BASIC-11 interpreter, and zeroing or nulling arrays.  The
;values of the arguments may be expressed in either decimal or octal.
;The routines included are listed in Table I.

;The "BASIC-11 Language Reference Manual" [1] and the "BASIC-11/RT-11
;User's Guide" [2] describe the general use of BASIC-11 and the CALL
;statement.

;The arguments for GET, GETB, PUT, PUTB, SBIT and TBIT may be constants,
;expressions, variables and or array elements.  These arguments may also
;be either decimal or octal.  A decimal argument may be either numeric
;(real) or integer.  An octal argument must be a string.  A numeric is
;one or more decimal digits, either positive or negative, in which the
;decimal point is optional.  An integer is one or more decimal digits,
;either positive or negative, with no decimal point.  An octal string is
;one or more of the numeric characters excluding the "8" and "9".

;No arguments are required with the IDEN routine.

;The NULL routine requires only the name(s) of the argument(s).  The
;argument(s) may be the name(s) of numeric array(s), integer array(s)
;and/or string array(s).

;Null arguments are not allowed.

;  *	DEC, PDP and UNIBUS are registered trademarks of Digital
;	Equipment Corporation, Maynard, MA.
.SBTTL	TABLE I.  THE EXTENSIONS	09-OCT-78/20-DEC-78

;	GET(ARG1,ARG2)		Input a word from a UNIBUS address
;		ARG1	UNIBUS word address
;		ARG2	Word value returned

;	GETB(ARG1,ARG2)		Input a byte from a UNIBUS address
;		ARG1	UNIBUS byte address
;		ARG2	Byte value returned

;	IDEN			Output an identification message

;	NULL(ARG1(),ARG2(),...)	Zero array(s)
;		ARG()'s	Name(s) of array(s)

;	PUT(ARG1,ARG2)		Output a word to a UNIBUS address
;		ARG1	Word value delivered
;		ARG2	UNIBUS word address

;	PUTB(ARG1,ARG2)		Output a byte to a UNIBUS address
;		ARG1	Byte value delivered
;		ARG2	UNIBUS byte address

;	SBIT(ARG1,ARG2,ARG3)	Set or clear a bit at a UNIBUS address
;		ARG1	Bit number
;		ARG2	UNIBUS word address
;		ARG3	Bit value

;	TBIT(ARG1,ARG2,ARG3)	Test a bit at a UNIBUS address
;		ARG1	Bit number
;		ARG2	UNIBUS word address
;		ARG3	Bit value
.SBTTL	DIRECTIVES			14-OCT-78/12-JAN-81

	.PSECT	DATBAS
	.IDENT	\81A12C\
	.NLIST	BEX


.SBTTL	ASSIGNMENTS			13-OCT-78/

;CPU REGISTERS
;	R0			;SCRATCH
;	R1			;SCRATCH
;	R2			;SCRATCH
;	R3			;SCRATCH
;	R4			;DESCRIPTOR LIST POINTER
;	R5			;ARGUMENT LIST POINTER

;MISCELLANEOUS CONSTANTS
	CR	=15		;CARRIAGE RETURN
	LF	=12		;LINE FEED
	TIMOUT	=4		;TIME OUT TRAP VECTOR


.SBTTL	GLOBALS				14-OCT-78/17-OCT-78

;BASIC-11/RT-11 GLOBALS
	.GLOBL	$ALC		;ALLOCATE A STRING
	.GLOBL	$ARGER		;ARGUMENT ERROR
	.GLOBL	$BOMB		;ERROR ROUTINE
	.GLOBL	$DEALC		;DEALLOCATE A STRING
	.GLOBL	$FIND		;FIND A STRING
	.GLOBL	$IR		;INTEGER TO REAL CONVERSION
	.GLOBL	MSG		;OUTPUT A MESSAGE ON CONSOLE TT:
	.GLOBL	$POLSH		;ESTABLISH POLISH MODE
	.GLOBL	$RI		;REAL TO INTEGER CONVERSION
	.GLOBL	$STORE		;STORE A STRING
	.GLOBL	$UNPOL		;TERMINATE POLISH MODE

;DATBAS GLOBALS
	.GLOBL	GET		;INPUT A WORD FROM THE UNIBUS
	.GLOBL	GETB		;INPUT A BYTE FROM THE UNIBUS
	.GLOBL	IDEN		;IDENTIFY DATBAS
	.GLOBL	NULL		;ZERO ARRAY(S)
	.GLOBL	PUT		;OUTPUT A WORD TO THE UNIBUS
	.GLOBL	PUTB		;OUTPUT A BYTE TO THE UNIBUS
	.GLOBL	SBIT		;SET OR CLEAR A BIT ON THE UNIBUS
	.GLOBL	TBIT		;TEST A BIT ON THE UNIBUS
.SBTTL	MACROS				09-OCT-78/12-JAN-81

.MACRO	PSHVAL	?A,?B			;PUSH THE WORD OR BYTE POINTED
					;TO BY BUSADR ONTO THE STACK
					;ACCORDING TO THE STATUS OF
					;THE BYTFLG
	TST	BYTFLG			;PUSH A BYTE?
	BEQ	A			; NO
	MOVB	@BUSADR	,-(SP)		; YES, SO PUSH THE BYTE VALUE
	BR	B
A:	MOV	@BUSADR	,-(SP)		;PUSH THE WORD VALUE
B:
	.ENDM	PSHVAL


.SBTTL	MEMORY ALLOCATIONS		13-OCT-78/

;THESE STORAGE LOCATIONS ARE OF GENERAL USE AMONG THE BASIC-11 CALL ROUTINES.
;ADDITIONAL LOCATIONS THAT ARE FOR SPECIFIC DEDICATED USE WITHIN ANY GIVEN
;ROUTINE ARE ALLOCATED WITHIN THE LOCAL SYMBOL BLOCK OF THE ROUTINE.

ARGVAL:	0			;ARGUMENT VALUE (INTEGER)
BUSADR:	0			;UNIBUS ADDRESS
BYTFLG:	0			;BYTE ADDRESS FLAG
CRNTR5:	0			;CURRENT VALUE OF R5
ORIGR5:	0			;ORIGINAL VALUE OF R5
.SBTTL	THE BASIC-11/RT11 CALL ROUTINES


.SBTTL	GET				12-OCT-78/18-OCT-78

;DELIVER THE CONTENTS OF THE UNIBUS WORD ADDRESS OF ARGUMENT ONE TO THE
;BASIC-11 VARIABLE NAMED IN ARGUMENT TWO.

;CALLING SEQUENCE:
;	CALL GET(ARG1,ARG2)

;			OCTAL			DECIMAL
;	ARG1 RANGE:	0 TO 77776		0 TO 32766
;			100000 TO 177776	-32768 TO -2
;	ARG2 RANGE:	100000 TO 177777	-32768 TO -1
;			0 TO 77777		0 TO 32767

GET:	.BYTE	3			;ROUTINE NAME BLOCK
	.ASCII	\GET\
	.EVEN
	GET$

GET$:	MOV	R5	,ORIGR5		;SAVE ORIGINAL VALUE OF R5
	CMP	(R5)+	,#101002	;TWO ARGUMENTS?
	BNE	99$			; NO
	MOV	-4(R5)	,R4		; YES, SO GET DESCRIPTOR LIST POINTER
	JSR	PC	,GETARG		;PLACE ARG1 INTO R3
	JSR	PC	,TSTADR		;VERIFY ADDRESS
	ROR	R3			;WORD ADDRESS?
	BCS	99$			; NO
	ROL	R3			; YES
	MOV	R3	,BUSADR		;SAVE ARG1
	CLR	BYTFLG			; AS WORD ADDRESS
	JSR	PC	,DELARG		;DELIVER @BUSADR TO ARG2
	RTS	PC			;RETURN TO BASIC-11

99$:	JMP	$ARGER			;ARGUMENT ERROR
.SBTTL	GETB				12-OCT-78/18-OCT-78

;DELIVER THE CONTENTS OF THE UNIBUS BYTE ADDRESS OF ARGUMENT ONE TO THE
;BASIC-11 VARIABLE NAMED IN ARGUMENT TWO.

;CALLING SEQUENCE:
;	CALL GETB(ARG1,ARG2)

;			OCTAL			DECIMAL
;	ARG1 RANGE:	0 TO 77777		0 TO 32767
;			100000 TO 177777	-32768 TO -1
;	ARG2 RANGE:	200 TO 377		-128 TO -1
;			0 TO 177		0 TO 127

GETB:	.BYTE	4			;ROUTINE NAME BLOCK
	.ASCII	\GETB\
	.EVEN
	GETB$

GETB$:	MOV	R5	,ORIGR5		;SAVE ORIGINAL VALUE OF R5
	CMP	(R5)+	,#101002	;TWO ARGUMENTS?
	BNE	99$			; NO
	MOV	-4(R5)	,R4		; YES, SO GET DESCRIPTOR LIST POINTER
	JSR	PC	,GETARG		;GET ARG1 INTO R3
	JSR	PC	,TSTADR		;VERIFY ADDRESS
	MOV	R3	,BUSADR		;SAVE ARG1
	INC	BYTFLG			; AS BYTE ADDRESS
	JSR	PC	,DELARG		;DELIVER @BUSARD TO ARG2
	RTS	PC			;RETURN TO BASIC-11

99$:	JMP	$ARGER			;ARGUMENT ERROR
.SBTTL	IDEN				12-OCT-78/12-JAN-81

;OUTPUT A MESSAGE IDENTIFYING THE EXTENDED BASIC-11 INTERPRETER.  NO
;ARGUMENTS ARE REQUIRED.

;CALLING SEQUENCE:
;	CALL IDEN

IDEN:	.BYTE	4			;ROUTINE NAME BLOCK
	.ASCII	\IDEN\
	.EVEN
	IDEN$

IDEN$:	JSR	R1	,MSG		;OUTPUT THE MESSAGE
	.ASCII	\DATS BASIC	81A12C\
	.BYTE	CR,LF,LF,0
	.EVEN
	RTS	PC			;RETURN TO BASIC-11


.SBTTL	NULL				12-OCT-78/18-OCT-78

;NULL OR ZERO THE ARRAY(S) NAMED IN THE ARGUMENT(S).  THE ARGUMENT(S) MUST BE
;THE NAME(S) OF NUMERIC ARRAY(S), INTEGER ARRAY(S) AND/OR STRING ARRAY(S).
;ANY NUMBER OF ARGUMENTS MAY BE GIVEN, SUBJECT ONLY TO NORMAL LINE LENGTH
;LIMITATIONS.

;CALLING SEQUENCE:
;	CALL NULL(ARG1(),ARG2(),...)

NULL:	.BYTE	4			;ROUTINE NAME BLOCK
	.ASCII	\NULL\
	.EVEN
	NULL$

NULL$:	MOV	R5	,ORIGR5		;SAVE ORIGINAL VALUE OF R5
	MOV	(R5)+	,ARGVAL		;DETERMINE THE
	CLRB	ARGVAL+1		; NUMBER OF ARGUMENTS
	MOV	-4(R5)	,R4		;GET DESCRIPTOR LIST POINTER
	TST	ARGVAL			;ANY ARGUMENTS?
	BEQ	2$			; NO
1$:	JSR	PC	,NULARY		;ZERO THE ARRAY
	DEC	ARGVAL			;MORE TO DO?
	BGT	1$			; YES
2$:	RTS	PC			;RETURN TO BASIC-11
.SBTTL	PUT				12-OCT-78/18-OCT-78

;DEPOSIT THE VALUE OF ARGUMENT ONE AT THE UNIBUS WORD ADDRESS OF ARGUMENT TWO.

;CALLING SEQUENCE:
;	CALL PUT(ARG1,ARG2)

;			OCTAL			DECIMAL
;	ARG1 RANGE:	100000 TO 177777	-32768 TO -1
;			0 TO 77777		0 TO 32767
;	ARG2 RANGE:	0 TO 77776		0 TO 32766
;			100000 TO 177776	-32768 TO -2

PUT:	.BYTE	3			;ROUTINE NAME BLOCK
	.ASCII	\PUT\
	.EVEN
	PUT$

PUT$:	MOV	R5	,ORIGR5		;SAVE ORIGINAL VALUE 0F R5
	CMP	(R5)+	,#101002	;TWO ARGUMENTS?
	BNE	99$			; NO
	MOV	-4(R5)	,R4		; YES, SO GET DESCRIPTOR LIST POINTER
	JSR	PC	,GETARG		;PLACE ARG1 INTO R3
	MOV	R3	,ARGVAL		; AND SAVE IT
	JSR	PC	,GETARG		;PLACE ARG2 INTO R3
	JSR	PC	,TSTADR		;VERIFY ADDRESS
	ROR	R3			;WORD ADDRESS?
	BCS	99$			; NO
	ROL	R3			; YES
	MOV	ARGVAL	,(R3)		;DEPOSIT ARG1 AT ARG2
	RTS	PC			;RETURN TO BASIC-11

99$:	JMP	$ARGER			;ARGUMENT ERROR
.SBTTL	PUTB				12-OCT-78/18-OCT-78

;DEPOSIT THE VALUE OF ARGUMENT ONE AT THE UNIBUS BYTE ADDRESS OF ARGUMENT TWO.

;CALLING SEQUENCE:
;	CALL PUTB(ARG1,ARG2)

;			OCTAL			DECIMAL
;	ARG1 RANGE:	200 TO 377		-128 TO -1
;			0 TO 177		0 TO 127
;	ARG2 RANGE:	0 TO 77777		0 TO 32767
;			100000 TO 177777	-32768 TO -1

PUTB:	.BYTE	4			;ROUTINE NAME BLOCK
	.ASCII	\PUTB\
	.EVEN
	PUTB$

PUTB$:	MOV	R5	,ORIGR5		;SAVE ORIGINAL VALUE OF R5
	CMP	(R5)+	,#101002	;TWO ARGUMENTS?
	BNE	99$			; NO
	MOV	-4(R5)	,R4		; YES, SO GET DESCRIPTOR LIST POINTER
	JSR	PC	,GETARG		;PLACE ARG1 INTO R3
	CMP	R3	,#127.		;ARG1>127.?
	BGT	99$			; YES
	CMP	R3	,#-128.		;ARG1<-128.?
	BLT	99$			; YES
	MOV	R3	,ARGVAL		;SAVE ARG1
	JSR	PC	,GETARG		;PLACE ARG2 INTO R3
	JSR	PC	,TSTADR		;VERIFY ADDRESS
	MOVB	ARGVAL	,(R3)		;DEPOSIT ARG1 AT ARG2
	RTS	PC			;RETURN TO BASIC-11

99$:	JMP	$ARGER			;ARGUMENT ERROR
.SBTTL	SBIT				13-OCT-78/

;SET THE BIT NAMED IN ARGUMENT ONE AT THE UNIBUS WORD ADDRESS OF ARGUMENT TWO
;TO THE VALUE GIVEN IN ARGUMENT THREE.

;CALLING SEQUENCE:
;	CALL SBIT(ARG1,ARG2,ARG3)

;			OCTAL			DECIMAL
;	ARG1 RANGE:	0 TO 17			0 TO 15
;	ARG2 RANGE:	0 TO 77776		0 TO 32766
;			100000 TO 17776		-32768 TO -2
;	ARG3 RANGE:	0 OR 1			0 OR 1

SBIT:	.BYTE	4			;ROUTINE NAME BLOCK
	.ASCII	\SBIT\
	.EVEN
	SBIT$

SBIT$:	JSR	PC	,AG1AG2		;PLACE ARG1>ARGVAL AND ARG2>BUSADR
	JSR	PC	,GETARG		;PLACE ARG3 INTO R3
	TST	R3			;SET THE BIT?
	BEQ	1$			; NO
	BIS	ARGVAL	,@BUSADR	; YES, SO CLEAR IT
	BR	2$
1$:	BIC	ARGVAL	,@BUSADR	;SET THE BIT
2$:	RTS	PC			;RETURN TO BASIC-11
.SBTTL	TBIT				12-OCT-78/18-OCT-78

;TEST THE BIT NAMED ON ARGUMENT ONE AT THE UNIBUS WORD ADDRESS OF ARGUMENT
;TWO.  THE RESULT IS RETURNED IN THE VARIABLE NAMED IN ARGUMENT THREE.  IF THE
;BIT TESTED IS CLEAR THEN ARG3=0, AND IF SET ARG3=1.

;CALLING SEQUENCE:
;	CALL TBIT(ARG1,ARG2,ARG3)

;			OCTAL			DECIMAL
;	ARG1 RANGE:	0 TO 17			0 TO 15
;	ARG2 RANGE:	0 TO 77776		0 TO 32766
;			100000 TO 177776	-32768 TO -2
;	ARG3 RANGE:	0 OR 1			0 OR 1

TBIT:	.BYTE	4			;ROUTINE NAME BLOCK
	.ASCII	\TBIT\
	.EVEN
	TBIT$

TBIT$:	JSR	PC	,AG1AG2		;PLACE ARG1>ARGVAL AND ARG2>BUSADR
	BIT	ARGVAL	,@BUSADR	;IS THE BIT SET?
	BEQ	1$			; NO
	MOV	#1	,ARGVAL		; YES, SO SHOW SET
	BR	2$
1$:	CLR	ARGVAL			;SHOW CLEAR
2$:	MOV	#ARGVAL	,BUSADR		;SET UP ARGUMENT POINTER
	CLR	BYTFLG			;FOR WORD ADDRESS
	JSR	PC	,DELARG		;DELIVER RESULT TO ARG3
	RTS	PC
.SBTTL	THE SUPPORTING SUBROUTINES


.SBTTL	AG1AG2				12-OCT-78/18-OCT-78

;THIS SUBROUTINE PROCESSES ARGUMENTS ONE AND TWO FOR THE SBIT AND THE TBIT
;CALL ROUTINES.  ON ENTRY R5 MUST BE POINTING TO THE BASIC-11'S ARGUMENT LIST.
;A BITMASK IS CONSTRUCTED FROM ARGUMENT ONE AND RETURNED IN ARGVAL.  THE BUS
;ADDRESS OF ARGUMENT TWO IS RETURNED IN BUSADR.  ARGUMENT ERRORS ARE ISSUED
;ON OTHER THAN THREE ARGUMENTS AND ON BYTE ADDRESS.

;CALLING SEQUENCE:
;	JSR	PC	,AG1AG2

AG1AG2:	MOV	R5	,ORIGR5		;SAVE ORIGINAL VALUE OF R5
	CMP	(R5)+	,#101003	;THREE ARGUMENTS?
	BNE	99$			; NO
	MOV	-4(R5)	,R4		; YES, SO GET DESCRIPTOR LIST POINTER
	JSR	PC	,GETARG		;PLACE ARG1 INTO R3
	JSR	PC	,BITMSK		;MAKE AND PLACE BIT MASK INTO ARGVAL
	JSR	PC	,GETARG		;PLACE ARG2 INTO R3
	JSR	PC	,TSTADR		;VERIFY ADDRESS
	ROR	R3			;WORD ADDRESS?
	BCS	99$			; NO
	ROL	R3			; YES, SO
	MOV	R3	,BUSADR		;  SAVE ARG2 AS
	CLR	BYTFLG			;   BYTE ADDRESS  
	RTS	PC

99$:	JMP	$ARGER			;ARGUMENT ERROR
.SBTTL	BITMSK				13-OCT-78/18-OCT-78

;THIS SUBROUTINE BUILDS A BIT MASK FROM THE VALUE IN R3 AND RETURNS THE BIT
;MASK IN ARGVAL.  AN ARGUMENT ERROR IS ISSUED IF THE BIT NUMBER IN R3 IS
;INVALID.

;CALLING SEQUENCE:
;	JSR	PC	,BITMSK

BITMSK:	TST	R3			;R3<0?
	BLT	99$			; YES
	CMP	R3	,#15.		;R3>15.?
	BGT	99$			; YES
	CLR	ARGVAL			;SET UP TO MAKE
	SEC				; BIT MASK
1$:	ROL	ARGVAL			;MAKE THE MASK
	DEC	R3			;DONE?
	BGE	1$			; NO
	RTS	PC

99$:	JMP	$ARGER			;ARGUMENT ERROR


.SBTTL	DELARG				13-OCT-78/18-OCT-78

;THIS SUBROUTINE DELIVERS AN ARGUMENT VALUE TO BASIC-11.  ON ENTRY R4 MUST
;POINT TO THE DESCRIPTOR LIST AND R5 MUST POINT TO THE ARGUMENT LIST AT THE
;CURRENT ARGUMENTS POSITION.  THE VALUE IS DELIVERED PRIOR TO RETURN.

;CALLING SEQUENCE:
;	JSR	PC	,DELARG

DELARG:	JSR	PC	,GETDSC		;PLACE DESCRIPTOR POINTER INTO R2
					; AND DESCRIPTOR WORD INTO R3
	BIT	#100	,R3		;OCTAL ARGUMENT?
	BEQ	1$			; NO
	JSR	PC	,DELOCT		; YES, SO DELIVER OCTAL
	BR	3$
1$:	BIT	#40	,R3		;REAL ARGUMENT?
	BEQ	2$			; NO
	JSR	PC	,DELREL		; YES, SO DELIVER REAL
	BR	3$
2$:	JSR	PC	,DELINT		;DELIVER INTEGER
3$:	TST	(R5)+			;BUMP R5
	RTS	PC
.SBTTL	DELINT				13-OCT-78/12-JAN-81

;THIS SUBROUTINE DELIVERS EITHER THE WORD OR THE BYTE CONTENTS OF THE
;BUS ADDRESS POINTED TO BY BUSADR TO THE INTEGER ARGUMENT POINTED TO
;BY R5.  THE STATUS OF BYTFLG DETERMINES WORD OR BYTE DELIVERY.

;CALLING SEQUENCE:
;	JSR	PC	,DELINT

DELINT:	TST	BYTFLG			;DELIVER A BYTE VALUE?
	BEQ	2$			; NO
	MOVB	@BUSADR	,@(R5)		; YES, SO DELIVER BYTE VALUE
	BPL	1$
	BIS	#177400	,@(R5)		;  IF NEGATIVE BYTE
	BR	3$
1$:	BIC	#177400	,@(R5)		;  IF POSITIVE BYTE
	BR	3$
2$:	MOV	@BUSADR	,@(R5)		;DELIVER WORD VALUE
3$:	RTS	PC
.SBTTL	DELOCT				13-OCT-78/12-JAN-81

;THIS SUBROUTINE DELIVERS EITHER THE WORD OR THE BYTE VALUE OF THE BUS
;ADDRESS POINTED TO BY BUSADR TO THE OCTAL (STRING) VARIABLE POINTED TO
;BY R5.  THE STATUS OF BYTFLG DETERMINES WORD OR BYTE DELIVERY.  AN
;ARGUMENT ERROR IS ISSUED IF THE OCTAL CONVERSION FAILS.  A NO STRING
;SPACE ERROR IS ISSUED IF INSUFFICIENT MEMORY IS AVAILABLE FOR THE
;STRING.

;CALLING SEQUENCE:
;	JSR	PC	,DELOCT

DELOCT:	JSR	R5	,PSHRGS		;SAVE THE REGISTERS
	MOV	#3$	,-(SP)		;SA STRING BUFFER
	MOV	#6	,-(SP)		;WORD STRING LENGTH
	PSHVAL				;INTEGER VALUE ONTO STACK
	TST	BYTFLG			;DOING A BYTE?
	BEQ	1$			; NO
	CLRB	1(SP)			; YES
1$:	JSR	PC	,$OCO		;CONVERT INTEGER TO OCTAL STRING
	BCS	99$			; IF ERROR
	JSR	R5	,POPRGS		;RESTORE THE REGISTERS
	MOV	2(R2)	,4$		;SET UP TO
	MOV	#6	,R0		; ALLOCATE
	MOV	#100	,R1		;  THE STRING
	MOV	R5	,CRNTR5
	MOV	ORIGR5	,R5
	JSR	PC	,$ALC		;ALLOCATE THE STRING
	BCS	100$			; IF ERROR
	MOV	#6	,R1		;SET UP TO
	MOV	#3$	,R3		; MOVE THE STRING
2$:	MOVB	(R3)+	,(R0)+		;MOVE THE STRING
	DEC	R1			;DONE?
	BNE	2$			; NO
	MOV	SP	,R0		;SET UP TO
	MOV	4$	,R1		; DELIVER THE STRING
	JSR	PC	,$STORE		;DELIVER THE STRING TO BASIC
	JSR	PC	,$DEALC		;CLEAN UP THE STACK
	MOV	CRNTR5	,R5		;RESTORE R5
	RTS	PC

3$:	.BLKB	6			;STRING SPACE
	.EVEN
4$:	0				;STRING REFERENCE POINTER

99$:	JMP	$ARGER			;ARGUMENT ERROR
100$:	JSR	R1	,$BOMB
	.ASCIZ	\NO STRING SPACE\
	.EVEN
.SBTTL	DELREL				13-OCT-78/12-JAN-81

;THIS SUBROUTINE DELIVERS THE WORD OR BYTE VALUE OF THE BUS ADDRESS
;POINTER TO BY BUSADR TO THE REAL VARIABLE POINTED TO BY R5.  THE
;STATUS OF BYTFLG DETERMINES WORD OR BYTE DELIVERY.  ON ENTRY R2 MUST
;POINT TO THE DESCRIPTOR WORD OF THE VARIABLE.

;CALLING SEQUENCE:
;	JSR	PC	,DELREL

DELREL:	PSHVAL				;INTEGER ONTO THE STACK
	TST	BYTFLG			;DOING A BYTE?
	BEQ	2$			; NO
	TSTB	(SP)			; YES
	BPL	1$
	BISB	#377	,1(SP)		;  IF NEGATIVE BYTE
	BR	2$
1$:	CLRB	1(SP)			;  IF POSITIVE BYTE
2$:	JSR	R4	,$POLSH		;ENTER POLISH MODE
	$IR				;CONVERT INTEGER TO REAL
	$UNPOL				;EXIT POLISH MODE
	MOV	(R5)	,R3		;GET THE POINTER
	MOV	(SP)+	,(R3)		;DELIVER THE
	MOV	(SP)+	,2(R3)		; REAL VALUE TO BASIC-11
	RTS	PC


.SBTTL	GETARG				12-OCT-78/17-OCT-78

;THIS SUBROUTINE GETS THE THE INTEGER VALUE OF THE ARGUMENT POINTED TO BY R5.
;ON ENTRY R4 MUST POINT TO THE DESCRIPTOR LIST AND R5 TO THE ARGUMENT LIST AT
;THE POSITION OF THE VARIABLE.  THE RESULT IS RETURNED IN R3.

;CALLING SEQUENCE:
;	JSR	PC	,GETARG

GETARG:	JSR	PC	,GETDSC		;PLACE DESCRIPTOR POINTER INTO R2
					; AND DESCRIPTOR WORD INTO R3
	BIT	#100	,R3		;OCTAL ARGUMENT?
	BEQ	1$			; NO
	JSR	PC	,GETOCT		; YES, SO OCTAL TO INTEGER INTO R3
	BR	3$
1$:	BIT	#40	,R3		;REAL ARGUMENT?
	BEQ	2$			; NO
	JSR	PC	,GETREL		; YES, SO REAL TO INTEGER INTO R3
	BR	3$
2$:	MOV	@(R5)	,R3		;INTEGER INTO R3
3$:	TST	(R5)+			;BUMP R5
	RTS	PC
.SBTTL	GETDSC				12-OCT-78/20-DEC-78

;THIS SUBROUTINE DEPOSITS THE DESCRIPTOR POINTER INTO R2 AND THE DESCRIPTOR
;WORD INTO R3 OF THE ARGUMENT POINTED TO BY R4.  AN ARGUMENT ERROR IS ISSUED
;IF THE ARGUMENT IS NULL.

;CALLING SEQUENCE:
;	JSR	PC	,GETDSC

GETDSC:	MOV	R4	,R2		;TRY FOR THE DESCRIPTOR
	MOV	(R4)+	,R3		; POINTER AND WORD
	BIT	#1	,R3		;IS IT A POINTER?
	BNE	1$			; YES
	MOV	R3	,R2		;GET ACTUAL POINTER
	MOV	(R3)	,R3		; AND WORD
1$:	CMP	#177	,R3		;NULL ARGUMENT?
	BEQ	99$			; YES
	RTS	PC

99$:	JMP	$ARGER			;ARGUMENT ERROR


.SBTTL	GETOCT				12-OCT-78/17-OCT-78

;THIS SUBROUTINE FINDS AN OCTAL (STRING) ARGUMENT AND CONVERTS IT TO AN
;INTEGER VALUE.  ON ENTRY R2 MUST POINT TO THE DESCRIPTOR WORD, R4 MUST POINT
;TO THE DESCRIPTOR LIST AND R5 MUST POINT TO THE ARGUMENT LIST AT THIS
;ARGUMENTS LOCATION.  THE RESULT IS RETURNED IN R3.  AN ARGUMENT ERROR IS
;ISSUED IF THE CONVERSION FAILS.

GETOCT:	MOV	2(R2)	,R0		;SET UP TO
	MOV	#100	,R1		; FIND THE
	MOV	R5	,CRNTR5		;  STRING
	MOV	ORIGR5	,R5
	JSR	PC	,$FIND		;FIND THE STRING
	JSR	R5	,PSHRGS		;SAVE THE REGISTERS
	MOV	R0	,-(SP)		;SA STRING
	MOV	R1	,-(SP)		;STRING LENGTH
	JSR	PC	,$OCI		;CONVERT IT TO INTEGER
	BCS	99$			; IF ERROR
	MOV	(SP)+	,6(SP)		;SAVE INTEGER IN "R3"
	JSR	R5	,POPRGS		;RESTORE THE REGISTERS
	MOV	CRNTR5	,R5		;RESTORE R5
	RTS	PC

99$:	JMP	$ARGERR			;ARGUMENT ERROR
.SBTTL	GETREL				12-OCT-78/18-OCT-78

;THIS SUBROUTINE GETS AND CONVERTS A REAL ARGUMENT TO INTEGER.  ON ENTRY R5
;MUST POINT TO THE ARGUMENT LIST AT THIS ARGUMENTS LOCATION.  THE RESULT IS
;RETURNED IN R3.

;CALLING SEQUENCE:
;	JSR	PC	,GETREL

GETREL:	MOV	(R5)	,R3		;GET THE POINTER
	MOV	2(R3)	,-(SP)		;PUSH THE REAL
	MOV	(R3)	,-(SP)		; ARGUMENT
	JSR	R4	,$POLSH		;ENTER POLISH MODE
	$RI				;REAL TO INTEGER
	$UNPOL				;EXIT POLISH MODE
	MOV	(SP)+	,R3		;INTEGER TO R3
	RTS	PC


.SBTTL	NULARY				13-OCT-78/17-OCT-78

;THIS SUBROUTINE NULLS OR ZEROS THE ARRAY POINTED TO BY R5.  ON ENTRY R5 MUST
;POINT TO THE ARGUMENT LIST AT THE LOCATION OF THIS ARGUMENT.  AN ARGUMENT
;ERROR IS ISSUED IF THE ARGUMENT IS NOT AN ARRAY.

;CALLING SEQUENCE:
;	JSR	PC	,NULARY

NULARY:	JSR	PC	,GETDSC		;PLACE DESCRIPTOR POINTER INTO R2
					; AND DESCRIPTOR WORD INTO R3
	BIT	#20000	,R3		;IS IT AN ARRAY?
	BEQ	99$			; NO
	BIT	#100	,R3		;OCTAL ARRAY?
	BEQ	1$			; NO
	JSR	PC	,NULOCT		; YES, SO NULL THE OCTAL ARRAY
	BR	2$
1$:	JSR	PC	,NULNUM		;NULL THE REAL OR INTEGER ARRAY
2$:	RTS	PC

99$:	JMP	$ARGER			;ARGUMENT ERROR
.SBTTL	NULNUM				13-OCT-78/

;THIS SUBROUTINE NULLS OR ZEROS THE REAL OR INTEGER ARRAY POINTED RO BY R5.
;ON ENTRY R2 MUST CONTAIN THE ADDRESS OF THE ARGUMENTS DESCRIPTOR WORD AND
;R5 MUST POINT TO THE ARGUMENT LIST AT THE LOCATION OF THIS ARGUMENT.

;CALLING SEQUENCE:
;	JSR	PC	,NULNUM

NULNUM:	MOV	4(R2)	,R2		;GET THE ARRAY LENGTH
	ASR	R2			; IN WORDS
	MOV	(R5)+	,R3		;SA ARRAY
1$:	CLR	(R3)+			;NULL THE ARRAY
	DEC	R2			;DONE?
	BGT	1$			; NO
	RTS	PC


.SBTTL	NULOCT				13-OCT-78/

;THIS SUBROUTINE NULLS OR ZEROS A OCTAL (STRING) ARRAY.  ON ENTRY R2 MUST
;CONTAIN THE DESCRIPTOR POINTER AND R5 MUST POINT TO THE ARGUMENT LIST AT
;THIS ARRAYS LOCATION.

;CALLING SEQUENCE:
;	JSR	PC	,NULOCT

NULOCT:	MOV	4(R2)	,R2		;GET ARRAY LENGTH
	ASR	R2			; IN WORDS
	MOV	(R5)+	,R3		;SA ARRAY
1$:	MOV	#-1	,(R3)+		;NULL THE ARRAY
	DEC	R2			;DONE?
	BGT	1$			; NO
	RTS	PC
.SBTTL	POPRGS/PSHRGS			13-OCT-78/17-OCT-78

;THESE SUBROUTINES SAVE AND RESTORE REGISTERS R0 THROUGH R5 ON THE STACK.

;CALLING SEQUENCE:
;	JSR	R5	,POPRGS

POPRGS:	TST	(SP)+			;ADJUST THE STACK POINTER
	MOV	(SP)+	,R0		;RESTORE
	MOV	(SP)+	,R1		; THE
	MOV	(SP)+	,R2		;  REGISTERS
	MOV	(SP)+	,R3
	MOV	(SP)+	,R4
	RTS	R5

;CALLING SEQUENCE:
;	JSR	R5	,PSHRGS

PSHRGS:	MOV	R4	,-(SP)		;SAVE
	MOV	R3	,-(SP)		; THE
	MOV	R2	,-(SP)		;  REGISTERS
	MOV	R1	,-(SP)
	MOV	R0	,-(SP)
	JMP	(R5)


.SBTTL	TSTADR				13-OCT-78/

;THIS SUBROUTINE TESTS FOR THE IMPLEMENTATION OF THE BUS ADDRESS POINTED TO BY
;R3.  THE UNIMPLEMENTED BUS ADDRESS ERROR IS ISSUED IF THE ADDRESS IS NOT
;IMPLEMTNTED.

;CALLING SEQUENCE:
;	JSR	PC	,TSTADR

TSTADR:	MOV	@#TIMOUT,2$		;SAVE THE TRAP VECTOR
	MOV	#1$	,@#TIMOUT	;TRAP TO 1$ ON FAILURE
	TSTB	(R3)			;TEST THE BUS ADDRESS
	MOV	2$	,@#TIMOUT	;RESTORE THE VECTOR
	RTS	PC

1$:	MOV	2$	,@#TIMOUT	;RESTORE THE VECTOR
	JSR	R1	,$BOMB
	.ASCIZ	\UMIMPLEMENTED BUS ADDRESS\
	.EVEN
2$:	0				;SAVE TRAP VECTOR HERE
.PSECT	DECSTF				;COPIED FROM DEC'S FPMP.MAC


.SBTTL	$OCI/$ICI			12-OCT-78/

;THESE SUBROUTINES CONVERT CHARACTERS TO AN INTEGER, $OCI CONVERTS ASCII TO
;OCTAL, AND $ICI CONVERTS ASCII TO INTEGER.  RETURNS WITH INTEGER RESULT ON
;TOP OF STACK.

;CALLING SEQUENCE:
;	MOV	****	,-(SP)		;PUSH ADDRESS OF ASCII FIELD
;	MOV	****	,-(SP)		;PUSH LENGTH IN BYTES
;	JSR	PC	,$OCI		;OR $ICI

        .ENABL  LSB
$OCI::	MOV	#67,-(SP)	
	BR	1$
$ICI::	MOV	#471,-(SP)	
1$:	MOV	R1,-(SP)	
	MOV	8.(SP),R1	
	ADD	6(SP),8.(SP)	
	MOV	4(SP),6(SP)	
	MOV	R0,4(SP)	
	MOV	R2,-(SP)	
	CLR	-(SP)	
	CLR	R0	
2$:	MOVB	(R1)+,R2	
	BIC	#177600,R2
	CMPB	R2,#' 
	BNE	3$	
	CMP	R1,12.(SP)
	BLT	2$	
	BR	8$	
3$:	TSTB	7(SP)
	BNE	4$
	INC	@SP
	BR	6$
4$:	CMPB	R2,#'+
	BEQ	7$
	CMPB	R2,#'-
	BNE	6$	
	INC	@SP	
	BR	7$
5$:	MOVB	(R1)+,R2	
	BIC	#177600,R2
	CMPB	R2,#' 
	BNE	6$	
	MOVB	#60,R2	
6$:	CMPB	R2,#'0
	BLT	10$	
	CMPB	R2,6(SP)
	BGT	10$	
	SUB	#60,R2	
	TSTB	7(SP)	
	BEQ	12$
	ASL	R0	
	BVS	10$
	SUB	R0,R2
	ASL	R0
	BVS	10$
	ASL	R0
	BVS	10$
	SUB	R2,R0
	BVS	10$
7$:	CMP	R1,12.(SP)
	BLT	5$	
8$:	ROR	(SP)+	
	BCS	9$	
	NEG	R0	
	BVS	11$	
	CLC	
9$:	MOV	(SP)+,R2	
	MOV	(SP)+,R1	
	ROL	(SP)+	
	MOV	R0,4(SP)	
	MOV	(SP)+,R0
	RTS	PC
10$:	TST	(SP)+	
11$:	CLR	R0
	COM	4(SP)	
	BR	9$
12$:	ROL	R0
	BCS	10$
	ROL	R0
	BCS	10$
	ROL	R0
	BCS	10$
	ADD	R2,R0
	BR	7$
        .DSABL  LSB
.SBTTL	$OCO/$ICO			12-OCT-78/

;THESE SUBROUTINES CONVERT CHARACTERS EITHER OCTAL, OR INTEGER TO ASCII.
;$ICO CONVERTS INTEGER TO ASCII, AND $OCO CONVERTS OCTAL TO ASCII.  RETURNS
;WITH THE RESULT IN ADDRESS SPECIFIED.

;CALLING SEQUENCE:
;	MOV	****	,-(SP)		;PUSH ADDRESS OF ASCII FIELD
;	MOV	****	,-(SP)		;PUSH LENGTH IN BYTES
;	MOV	****	,-(SP)		;PUSH VALUE TO BE CONVERTED
;	JSR	PC	,$OCO		;OR $ICO

        .ENABL  LSB
$OCO::	MOV	#17$-4$,R0	
	BR	1$
$ICO::	MOV	#16$-4$,R0	
1$:	MOV	R4,-(SP)
	MOV	8.(SP),R3	
	MOV	6.(SP),R2	
	BGE	2$	
	CLR	R2
	CLR	6(SP)
2$:	MOV	4.(SP),R4	
	MOV	#' ,-(SP)	
	CMP	R0,#17$-4$	
	BEQ	3$	
	TST	R4
	BGE	3$	
	NEG	R4	
	MOV	#'-,@SP	
3$:	CLR	-(SP)	
	ADD	PC,R0
4$:
5$:	TST	@R0
	BEQ	9$	
	CLR	R1
6$:	SUB	@R0,R4	
	BLO	7$
	INC	R1	
	BR	6$
7$:	ADD	(R0)+,R4	
	TST	R1
	BNE	8$	
	TST	@SP
	BEQ	5$	
8$:	ADD	#60,R1	
	MOV	R1,-(SP)
	BR	5$
9$:	ADD	R2,R3	
	ADD	#60,R4	
	MOVB	R4,-(R3)
10$:	DEC	R2
	BLE	12$	
	MOVB	(SP)+,-(R3)	
	BNE	10$	
	MOVB	(SP)+,@R3	
11$:	DEC	R2
	BEQ	13$	
	MOVB	#' ,-(R3)	
	BR	11$
12$:	TST	(SP)+
	BNE	14$	
	CMP	#' ,(SP)+
	BNE	15$-4.	
13$:	MOV	(SP)+,R4
	MOV	(SP)+,4(SP)	
	TST	(SP)+	
	ROL	(SP)+	
	RTS	PC
14$:	TST	(SP)+
	BNE	14$
	TST	(SP)+	
	MOV	8.(SP),R3
15$:	MOVB	#'*,(R3)+	
	DEC	6(SP)
	BGT	15$	
	COM	6(SP)	
	BR	13$
16$:	.WORD	10000.,1000.,100.,10.,0
17$:	.WORD	100000,10000,1000,100,10,0
        .DSABL  LSB
.SBTTL	THE APPENDIXES
	.PSECT	DATBAS


.SBTTL	INSTALLATION			09-OCT-78/20-DEC-78

;The "BASIC-11/RT-11 Installation Guide" [3] describes the general technique
;used to install assembly language routines into the BASIC-11 interpreter.
;Table II lists the set of files which make up the DATBAS package.  The files
;DATBAS.TEC and DATBAS.MAC are needed along with DEC's BASIC-11/RT-11 binary
;distribution package to build an extended BASIC-11 interpreter.

;Installation of these of these routines requires five steps.  They are 
;modification of BSCLI.MAC to DATCLI.MAC, assembly of the DATCLI.MAC and
;DATBAS.MAC files, generation of a command file to build the interpreter,
;editing the command file to provide more stack space and finally executing
;the command file to build the extended BASIC-11 interpreter.

;DATCLI.MAC is constructed from BSCLI.MAC by executing the TECO macro file
;DATBAS.TEC.  It adds the GLOBALS and the FTBL entries required to access the
;DATBAS.MAC routines.  The following commands accomplish this.
;	.SET EDIT TECO
;	.EDIT/EXEC DATBAS

;The following commands will assemble DATCLI.MAC and DATBAS.MAC to produce OBJ
;files which will be used later by the command file to build the interpreter.
;	.RUN MACRO
;	*DATCLI,LP:<BSMAC,DATCLI/C
;	*DATBAS,LP:<DATBAS/C

;Now it is necessary to generate the command file which will be used to build
;the extended BASIC-11 interpreter.  This is accomplished by executing the
;single user configurator program, SUCNFG.BAS, as described in the
;"BASIC-11/RT-11 Installation Guide" [3].  The following shows the CALL part
;of the dialogue with user responses listed at the far right.
;	Do you want CALL support? (Y or N; default is N)):	Y
;	Module name:						DATCLI
;	Module name:						DATBAS
;	Module name:						BSCLLB
;	Module name:

;The extension routines require some extra stack space, therefore it is
;essential that the command file just generated be edited to add at least
;64. extra words to the available stack space.  The following sets of
;command strings show both the TECO and EDIT syntax to accomplish this task.
;	.RUN TECO		.RUN EDIT
;	*EBDATBAS.COM$		*EBDATBAS.COM$
;	S/B:1$DI2$		G/B:1$DI2$
;	EX$$			EX$$
;	.			.

;The command file is finally ready for execution to build the extended
;BASIC-11 interpreter.  Use the following command to execute the command file.
;	.@DATBAS

;The extended BASIC-11 interpreter is now ready for use.  It may be called
;into use as follows.
;	.RUN DATBAS


.SBTTL	TABLE II.  DATBAS FILES		21-OCT-78/

;	FILE NAME	DESCRIPTION

;	DATBAS.BAS	BASIC-11 program to test the extension routines
;			of DATBAS.MAC.

;	DATBAS.DAT	Resulting output from execution of DATBAS.BAS.

;	DATBAS.DIR	This directory of the DATBAS package.

;	DATBAS.DOC	Full description of the DATBAS package.

;	DATBAS.HLP	Brief description of the use of the DATBAS.MAC
;			Extension routines.

;	DATBAS.MAC	MACRO-11 source of the extension routines.

;	DATBAS.RNO	Source for DATBAS.DOC in RUNOFF format.

;	DATBAS.TEC	TECO macro to make DATCLI.MAC.
.SBTTL	TEST PROGRAM			21-OCT-78/

;Once the extended BASIC-11 interpreter has been built it should be tested.
;The following program thoroughly tests the extensions.  Messages are output
;to identify the particular test being performed.

;	100 REM  DATBAS.BAS  NAB/WAW  19-SEP-78/20-OCT-78
;	110 T$='TEST THE DATBAS.MAC ROUTINES'
;	120 DIM A$(1),V$(1),Z$(1)
;	130 DIM A%(1),V%(1),Z%(1)
;	140 DIM A(1),V(1),Z(1)
;	150 DIM D(100),D%(100),D$(100)
;	160 DIM E(10,10),E%(10,10),E$(10,10)
;	170 PRINT T$
;	180 CALL IDEN
;	190 PRINT 'ENTER THE OUTPUT DEVICE NAME',
;	200 INPUT O$
;	210 IF O$='' THEN O$='TT:'
;	220 OPEN O$ FOR OUTPUT AS FILE #1 DOUBLE BUF
;	230 PRINT #1
;	240 PRINT #1,T$
;	250 PRINT #1,DAT$,CLK$
;	260 GOSUB 350 \ REM	TEST PUT & GET
;	270 GOSUB 870 \ REM	TEST PUTB & GETB
;	280 GOSUB 1730 \ REM	TEST SBIT & TBIT
;	290 GOSUB 1390 \ REM	TEST NULL
;	300 PRINT #1
;	310 PRINT #1
;	320 PRINT #1,'END OF TESTS',CLK$
;	330 CLOSE #1
;	340 GO TO 3780 \ REM	END

;	350 PRINT #1
;	360 PRINT #1
;	370 PRINT #1,'TEST PUT & GET'
;	380 GOSUB 3000 \ REM	STRING CONSTANTS
;	390 CALL PUT('123','376')
;	400 CALL GET('376',Z$)
;	410 IF Z$<>'   123' THEN PRINT #1,'    ERROR: Z$<>123'
;	420 GOSUB 3040 \ REM	INTEGER CONSTANTS
;	430 CALL PUT(83%,254%)
;	440 CALL GET(254%,Z%)
;	450 IF Z%<>83% THEN PRINT #1,'    ERROR: Z%<>83'
;	460 GOSUB 3080 \ REM	NUMERIC CONSTANTS
;	470 CALL PUT(83,254)
;	480 CALL GET(254,Z)
;	490 IF Z<>83 THEN PRINT #1,'    ERROR: Z<>83'
;	500 GOSUB 3120 \ REM	STRING EXPRESSIONS
;	510 CALL PUT(V$&'23',A$&'76')
;	520 CALL GET(A$&'76',Z$)
;	530 IF Z$<>'   '&V$&'23' THEN PRINT #1,'    ERROR: Z$<>'V$&'23'
;	540 GOSUB 3190 \ REM	INTEGER EXPRESSIONS
;	550 CALL PUT(V%+100%,A%+200%)
;	560 CALL GET(A%+200%,Z%)
;	570 IF Z%<>V%+100% THEN PRINT #1,'    ERROR: Z%<>'V%+100%
;	580 GOSUB 3260 \ REM	NUMERIC EXPRESSIONS
;	590 CALL PUT(V/2,2*A)
;	600 CALL GET(2*A,Z)
;	610 IF Z<>V/2 THEN PRINT #1,'    ERROR: Z<>'V/2
;	620 GOSUB 3330 \ REM	STRING VARIABLES
;	630 CALL PUT(V$,A$)
;	640 CALL GET(A$,Z$)
;	650 IF Z$<>'   '&V$ THEN PRINT #1,'  Z$<>'V$
;	660 GOSUB 3400 \ REM	INTEGER VARIABLES
;	670 CALL PUT(V%,A%)
;	680 CALL GET(A%,Z%)
;	690 IF Z%<>V% THEN PRINT #1,'    ERROR: Z%<>'V%
;	700 GOSUB 3470 \ REM	NUMERIC VARIABLES
;	710 CALL PUT(V,A)
;	720 CALL GET(A,Z)
;	730 IF Z<>V THEN PRINT #1,'    ERROR: Z<>'V
;	740 GOSUB 3540 \ REM	STRING ARRAY ELEMENTS
;	750 CALL PUT(V$(0),A$(0))
;	760 CALL GET(A$(0),Z$(0))
;	770 IF Z$(0)<>'   '&V$(0) THEN PRINT #1,'    ERROR: Z$(0)<>'V$(0)
;	780 GOSUB 3610 \ REM	INTEGER ARRAY ELEMENTS
;	790 CALL PUT(V%(1),A%(1))
;	800 CALL GET(A%(1),Z%(1))
;	810 IF Z%(1)<>V%(1) THEN PRINT #1,'    ERROR: Z%(1)<>'V%(1)
;	820 GOSUB 3680 \ REM	NUMERIC ARRAY ELEMENTS
;	830 CALL PUT(V(0),A(0))
;	840 CALL GET(A(0),Z(0))
;	850 IF Z(0)<>V(0) THEN PRINT #1,'    ERROR: Z(0)<>'V(0)
;	860 RETURN

;	870 PRINT #1
;	880 PRINT #1
;	890 PRINT #1,'TEST PUTB & GETB'
;	900 GOSUB 3000 \ REM	STRING CONSTANTS
;	910 CALL PUTB('123','376')
;	920 CALL GETB('376',Z$)
;	930 IF Z$<>'   '&'123' THEN PRINT #1,'    ERROR: Z$<>123'
;	940 GOSUB 3040 \ REM	INTEGER CONSTANTS
;	950 CALL PUTB(83%,255%)
;	960 CALL GETB(255%,Z%)
;	970 IF Z%<>83% THEN PRINT #1,'    ERROR: Z%<>83'
;	980 GOSUB 3080 \ REM	NUMERIC CONSTANTS
;	990 CALL PUTB(83,254)
;	1000 CALL GETB(254,Z)
;	1010 IF Z<>83 THEN PRINT #1,'    ERROR: Z<>83'
;	1020 GOSUB 3120 \ REM	STRING EXPRESSIONS
;	1030 CALL PUTB(V$&'23',A$&'77')
;	1040 CALL GETB(A$&'77',Z$)
;	1050 IF Z$<>'   '&V$&'23' THEN PRINT #1,'    ERROR: Z$<>'V$&'23'
;	1060 GOSUB 3190 \ REM	INTEGER EXPRESSIONS
;	1070 CALL PUTB(V%+100%,A%+200%)
;	1080 CALL GETB(A%+200%,Z%)
;	1090 IF Z%<>V%+100% THEN PRINT #1,'    ERROR: Z%<>'V%+100%
;	1100 GOSUB 3260 \ REM	NUMERIC EXPRESSIONS
;	1110 CALL PUTB(V/2,2*A)
;	1120 CALL GETB(2*A,Z)
;	1130 IF Z<>V/2 THEN PRINT #1,'    ERROR: Z<>'V/2
;	1140 GOSUB 3330 \ REM	STRING VARIABLES
;	1150 CALL PUTB(V$,A$)
;	1160 CALL GETB(A$,Z$)
;	1170 IF Z$<>'   '&V$ THEN PRINT #1,'    ERROR: Z$<>'V$
;	1180 GOSUB 3400 \ REM	INTEGER VARIABLES
;	1190 CALL PUTB(V%,A%)
;	1200 CALL GETB(A%,Z%)
;	1210 IF Z$(0)<>'   '&V$(0) THEN PRINT #1,'    ERROR: Z$(0)<>'V$(0)
;	1220 IF Z%<>V% THEN PRINT #1,'    ERROR: Z%<>'V%
;	1230 GOSUB 3470 \ REM	NUMERIC VARIABLES
;	1240 CALL PUTB(V,A)
;	1250 CALL GETB(A,Z)
;	1260 IF Z<>V THEN PRINT #1,'    ERROR: Z<>'V
;	1270 GOSUB 3540 \ REM	STRING ARRAY ELEMENTS
;	1280 CALL PUTB(V$(0),A$(0))
;	1290 CALL GETB(A$(0),Z$(0))
;	1300 GOSUB 3610 \ REM	INTEGER ARRAY ELEMENTS
;	1310 CALL PUTB(V%(1),A%(1))
;	1320 CALL GETB(A%(1),Z%(1))
;	1330 IF Z%(1)<>V%(1) THEN PRINT #1,'    ERROR: Z%(1)<>'V%(1)
;	1340 GOSUB 3680 \ REM	NUMERIC ARRAY ELEMTNTS
;	1350 CALL PUTB(V(0),A(0))
;	1360 CALL GETB(A(0),Z(0))
;	1370 IF Z(0)<>V(0) THEN PRINT #1,'    ERROR: Z(0)<>'V(0)
;	1380 RETURN

;	1390 PRINT #1
;	1400 PRINT #1
;	1410 PRINT #1,'TEST NULL'
;	1420 PRINT #1
;	1430 PRINT #1,'  SINGLE DIMENSION ARRAYS'
;	1440 FOR I=0 TO 100
;	1450 D(I)=I
;	1460 D%(I)=I
;	1470 D$(I)=STR$(I)
;	1480 NEXT I
;	1490 CALL NULL(D(),D%(),D$())
;	1500 FOR I=0 TO 100
;	1510 IF D(I)<>0 THEN PRINT #1,'    ERROR: D('I')<>0'
;	1520 IF D%(I)<>0% THEN PRINT #1,'    ERROR: D%('I')<>0'
;	1530 IF D$(I)<>'' THEN PRINT #1,'    ERROR: D$('I') NOT NULL'
;	1540 NEXT I
;	1550 PRINT #1
;	1560 PRINT #1,'  TWO DIMENSION ARRAYS'
;	1570 FOR I=0 TO 10
;	1580 FOR J=0 TO 10
;	1590 E(I,J)=10*I+J
;	1600 E%(I,J)=I+J
;	1610 E$(I,J)=STR$(E(I,J))
;	1620 NEXT J
;	1630 NEXT I
;	1640 CALL NULL(E(),E%(),E$())
;	1650 FOR I=0 TO 10
;	1660 FOR J=0 TO 10
;	1670 IF E(I,J)<>0 THEN PRINT #1,'    ERROR: E('I','J')<>0'
;	1680 IF E%(I,J)<>0% THEN PRINT #1,'    ERROR: E%('I','J')<>0'
;	1690 IF E$(I,J)<>'' THEN PRINT #1,'    ERROR: E$('I','J') NOT NULL'
;	1700 NEXT J
;	1710 NEXT I
;	1720 RETURN

;	1730 PRINT #1
;	1740 PRINT #1
;	1750 PRINT #1,'TEST SBIT & TBIT'
;	1760 CALL PUT(0,254)
;	1770 GOSUB 3080 \ REM NUMERIC CONSTANTS
;	1780 CALL SBIT(5,254,1)
;	1790 CALL TBIT(5,254,Z)
;	1800 IF Z<>1 THEN PRINT #1,'    ERROR: Z<>'1
;	1810 GOSUB 3750 \ REM	TIME DELAY
;	1820 CALL SBIT(5,254,0)
;	1830 CALL TBIT(5,254,Z)
;	1840 IF Z<>0 THEN PRINT #1,'    ERROR: Z<>'0
;	1850 GOSUB 3040 \ REM	INTEGER CONSTANTS
;	1860 CALL SBIT(10%,254%,1%)
;	1870 CALL TBIT(10%,254%,Z%)
;	1880 IF Z%<>1% THEN PRINT #1,'    ERROR: Z%<>'1%
;	1890 GOSUB 3750 \ REM	TIME DELAY
;	1900 CALL SBIT(10%,254%,0%)
;	1910 CALL TBIT(10%,254%,Z%)
;	1920 IF Z%<>0% THEN PRINT #1,'    ERROR: Z%<>'0%
;	1930 GOSUB 3000 \ REM	STRING CONSTANTS
;	1940 CALL SBIT('15','376','1')
;	1950 CALL TBIT('15','376',Z$)
;	1960 IF Z$<>'     1' THEN PRINT #1,'    ERROR: Z$<>1'
;	1970 GOSUB 3750 \ REM	TIME DELAY
;	1980 CALL SBIT('15','376','0')
;	1990 CALL TBIT('15','376',Z$)
;	2000 IF Z$<>'     0' THEN PRINT #1,'    ERROR: Z$<>0'
;	2010 GOSUB 3260 \ REM	NUMERIC EXPRESSIONS
;	2020 CALL SBIT(14/2,2*A,2-1)
;	2030 CALL TBIT(3+4,2*A,Z)
;	2040 IF Z<>1 THEN PRINT #1,'    ERROR: Z<>'1
;	2050 GOSUB 3750 \ REM	TIME DELAY
;	2060 CALL SBIT(2*3.5,2*A,3-3)
;	2070 CALL TBIT(14-7,2*A,Z)
;	2080 IF Z<>0 THEN PRINT #1,'    ERROR: X<>'0
;	2090 GOSUB 3190 \ REM	INTEGER EXPRESSIONS
;	2100 CALL SBIT(18%/2%,200%+A%,4%/4%)
;	2110 CALL TBIT(5%+4%,A%+200%,Z%)
;	2120 IF Z%<>1% THEN PRINT #1,'    ERROR: Z%<>'1%
;	2130 GOSUB 3750 \ REM	TIME DELAY
;	2140 CALL SBIT(4%+5%,A%+200%,4%-4%)
;	2150 CALL TBIT(18%-9%,200%+A%,Z%)
;	2160 IF Z%<>0% THEN PRINT #1,'    ERROR: Z%<>'0%
;	2170 GOSUB 3120 \ REM	STRING EXPRESSIONS
;	2180 CALL SBIT('1'&'3',A$&'76','1')
;	2190 CALL TBIT('1'&'3',A$&'76',Z$)
;	2200 IF Z$<>'     1' THEN PRINT #1,'    ERROR: Z$<>1'
;	2210 GOSUB 3750 \ REM	TIME DELAY
;	2220 CALL SBIT('1'&'3',A$&'76','0')
;	2230 CALL TBIT('1'&'3',A$&'76',Z$)
;	2240 IF Z$<>'     0' THEN PRINT #1,'    ERROR: Z$<>0'
;	2250 GOSUB 3470 \ REM	NUMERIC VARIABLES
;	2260 V0=0
;	2270 V1=1
;	2280 FOR I=0 TO 15
;	2290 CALL SBIT(I,A,V1)
;	2300 CALL TBIT(I,A,Z)
;	2310 IF Z<>V1 THEN PRINT #1,'    ERROR: Z<>'V1
;	2320 GOSUB 3750 \ REM	TIME DELAY
;	2330 CALL SBIT(I,A,V0)
;	2340 CALL TBIT(I,A,Z)
;	2350 IF Z<>V0 THEN PRINT #1,'    ERROR: Z<>'V0
;	2360 GOSUB 3750 \ REM	TIME DELAY
;	2370 NEXT I
;	2380 GOSUB 3400 \ REM	INTEGER VARIABLES
;	2390 V0%=0%
;	2400 V1%=1%
;	2410 FOR I%=0% TO 15%
;	2420 CALL SBIT(I%,A%,V1%)
;	2430 CALL TBIT(I%,A%,Z%)
;	2440 IF Z%<>V1% THEN PRINT #1,'    ERROR: Z%<>'V1%
;	2450 GOSUB 3750 \ REM	TIME DELAY
;	2460 CALL SBIT(I%,A%,V0%)
;	2470 CALL TBIT(I%,A%,Z%)
;	2480 IF Z%<>V0% THEN PRINT #1,'    ERROR: Z%<>'V0%
;	2490 GOSUB 3750 \ REM	TIME DELAY
;	2500 NEXT I%
;	2510 GOSUB 3330 \ REM	STRING VARIABLES
;	2520 V0$='0'
;	2530 V1$='1'
;	2540 FOR I=0 TO 7
;	2550 I$=STR$(I)
;	2560 CALL SBIT(I$,A$,V1$)
;	2570 CALL TBIT(I$,A$,Z$)
;	2580 IF Z$<>'     '&V1$ THEN PRINT #1,'    ERROR: Z$<>'V1$
;	2590 GOSUB 3750
;	2600 CALL SBIT(I$,A$,V0$)
;	2610 CALL TBIT(I$,A$,Z$)
;	2620 IF Z$<>'     '&V0$ THEN PRINT #1,'    ERROR: Z$<>'V0$
;	2630 GOSUB 3750
;	2640 NEXT I
;	2650 GOSUB 3680 \ REM	NUMERIC ARRAY ELEMTNTS
;	2660 FOR I=0 TO 15
;	2670 CALL SBIT(I,A(0),V1)
;	2680 CALL TBIT(I,A(0),Z(0))
;	2690 IF Z(0)<>V1 THEN PRINT #1,'    ERROR: Z(0)<>'V1
;	2700 GOSUB 3750 \ REM	TIME DELAY
;	2710 CALL SBIT(I,A(0),V0)
;	2720 CALL TBIT(I,A(0),Z(0))
;	2730 IF Z(0)<>V0 THEN PRINT #1,'    ERROR: Z(0)<>'V0
;	2740 GOSUB 3750 \ REM	TIME DELAY
;	2750 NEXT I
;	2760 GOSUB 3610 \ REM	INTEGER ARRAY ELEMENTS
;	2770 FOR I%=0% TO 15%
;	2780 CALL SBIT(I%,A%(1),V1%)
;	2790 CALL TBIT(I%,A%(1),Z%(1))
;	2800 IF Z%(1)<>V1% THEN PRINT #1,'    ERROR: Z%(1)<>'V1%
;	2810 GOSUB 3750 \ REM	TIME DELAY
;	2820 CALL SBIT(I%,A%(1),V0%)
;	2830 CALL TBIT(I%,A%(1),Z%(1))
;	2840 IF Z%(1)<>V0% THEN PRINT #1,'    ERROR: Z%(1)<>'V0%
;	2850 GOSUB 3750 \ REM	TIME DELAY
;	2860 NEXT I%
;	2870 GOSUB 3540 \ REM	STRING ARRAY ELEMTNTS
;	2880 FOR I=0 TO 7
;	2890 I$=STR$(I)
;	2900 CALL SBIT(I$,A$(0),V1$)
;	2910 CALL TBIT(I$,A$(0),Z$(0))
;	2920 IF Z$(0)<>'     '&V1$ THEN PRINT #1,'    ERROR: Z$(0)<>'V1$
;	2930 GOSUB 3750 \ REM	TIME DELAY
;	2940 CALL SBIT(I$,A$(0),V0$)
;	2950 CALL TBIT(I$,A$(0),Z$(0))
;	2960 IF Z$(0)<>'     '&V0$ THEN PRINT #1,'    ERROR: Z$(0)<>'V0$
;	2970 GOSUB 3750 \ REM	TIME ELAY
;	2980 NEXT I
;	2990 RETURN

;	3000 PRINT #1
;	3010 PRINT #1,'  STRING CONSTANTS'
;	3020 GOSUB 3750
;	3030 RETURN

;	3040 PRINT #1
;	3050 PRINT #1,'  INTEGER CONSTANTS'
;	3060 GOSUB 3750 \ REM	TIME DELAY
;	3070 RETURN

;	3080 PRINT #1
;	3090 PRINT #1,'  NUMERIC CONSTANTS'
;	3100 GOSUB 3750 \ REM	TIME DELAY
;	3110 RETURN

;	3120 PRINT #1
;	3130 PRINT #1,'  STRING EXPRESSIONS'
;	3140 A$='3'
;	3150 V$='1'
;	3160 Z$=''
;	3170 GOSUB 3750 \ REM	TIME DELAY
;	3180 RETURN

;	3190 PRINT #1
;	3200 PRINT #1,'  INTEGER EXPRESSIONS'
;	3210 A%=54%
;	3220 V%=23%
;	3230 Z%=0%
;	3240 GOSUB 3750 \ REM	TIME DELAY
;	3250 RETURN

;	3260 PRINT #1
;	3270 PRINT #1,'  NUMERIC EXPRESSIONS'
;	3280 A=127
;	3290 V=246
;	3300 Z=0
;	3310 GOSUB 3750 \ REM	TIME DELAY
;	3320 RETURN

;	3330 PRINT #1
;	3340 PRINT #1,'  STRING VARIABLES'
;	3350 A$='376'
;	3360 V$='123'
;	3370 Z$=''
;	3380 GOSUB 3750 \ REM	TIME DELAY
;	3390 RETURN

;	3400 PRINT #1
;	3410 PRINT #1,'  INTEGER VARIABLES'
;	3420 V%=123%
;	3430 A%=254%
;	3440 Z%=0%
;	3450 GOSUB 3750 \ REM	TIME DELAY
;	3460 RETURN

;	3470 PRINT #1
;	3480 PRINT #1,'  NUMERIC VARIABLES'
;	3490 A=254
;	3500 V=123
;	3510 Z=0
;	3520 GOSUB 3750 \ REM	TIME DELAY
;	3530 RETURN

;	3540 PRINT #1
;	3550 PRINT #1,'  STRING ARRAY ELEMENTS'
;	3560 A$(0)='376'
;	3570 V$(0)='123'
;	3580 Z$(0)=''
;	3590 GOSUB 3750 \ REM	TIME DELAY
;	3600 RETURN

;	3610 PRINT #1
;	3620 PRINT #1,'  INTEGER ARRAY ELEMENTS'
;	3630 A%(1)=254%
;	3640 V%(1)=123%
;	3650 Z%(1)=0%
;	3660 GOSUB 3750 \ REM	TIME DELAY
;	3670 RETURN

;	3680 PRINT #1
;	3690 PRINT #1,'  NUMERIC ARRAY ELEMENTS'
;	3700 A(0)=254
;	3710 V(0)=123
;	3720 Z(0)=0
;	3730 GOSUB 3750 \ REM	TIME DELAY
;	3740 RETURN

;	3750 FOR K%=0% TO 1% \ REM MAKE 1000% FOR ODT
;	3760 NEXT K%
;	3770 RETURN

;	3780 END
.SBTTL	TEST RESULTS			21-OCT-78/

;The following is typical of the outout resulting from the execution of the
;test program, DATBAS.BAS.  Fatal errors are reported with BASIC-11's normal
;error message format [1].  Non-fatal errors are reported as shown.
;	  STRING VARIABLES
;	    ERROR: Z$<>123

;	TEST THE DATBAS.MAC ROUTINES
;	21-OCT-78     11:25:40
;	
;
;	TEST PUT & GET
;
;	  STRING CONSTANTS
;
;	  INTEGER CONSTANTS
;
;	  NUMERIC CONSTANTS
;
;	  STRING EXPRESSIONS
;
;	  INTEGER EXPRESSIONS
;
;	  NUMERIC EXPRESSIONS
;
;	  STRING VARIABLES
;
;	  INTEGER VARIABLES
;
;	  NUMERIC VARIABLES
;
;	  STRING ARRAY ELEMENTS
;
;	  INTEGER ARRAY ELEMENTS
;
;	  NUMERIC ARRAY ELEMENTS
;
;
;	TEST PUTB & GETB
;
;	  STRING CONSTANTS
;
;	  INTEGER CONSTANTS
;
;	  NUMERIC CONSTANTS
;
;	  STRING EXPRESSIONS
;
;	  INTEGER EXPRESSIONS
;
;	  NUMERIC EXPRESSIONS
;
;	  STRING VARIABLES
;
;	  INTEGER VARIABLES
;
;	  NUMERIC VARIABLES
;
;	  STRING ARRAY ELEMENTS
;
;	  INTEGER ARRAY ELEMENTS
;
;	  NUMERIC ARRAY ELEMENTS
;
;
;	TEST SBIT & TBIT
;
;	  NUMERIC CONSTANTS
;
;	  INTEGER CONSTANTS
;
;	  STRING CONSTANTS
;
;	  NUMERIC EXPRESSIONS
;
;	  INTEGER EXPRESSIONS
;
;	  STRING EXPRESSIONS
;
;	  NUMERIC VARIABLES
;
;	  INTEGER VARIABLES
;
;	  STRING VARIABLES
;
;	  NUMERIC ARRAY ELEMENTS
;
;	  INTEGER ARRAY ELEMENTS
;
;	  STRING ARRAY ELEMENTS
;
;
;	TEST NULL
;
;	  SINGLE DIMENSION ARRAYS
;
;	  TWO DIMENSION ARRAYS
;
;
;	END OF TESTS  11:25:47
.SBTTL	REFERENCES			12-OCT-78/16-OCT-78

; 1.	"BASIC-11 Language Reference Manual", DEC-11-LIBBB-A-D, Digital
;	Equipment Corporation, Maynard, MA, Sep-76.

; 2.	"BASIC-11/RT-11 User's Guide", DEC-11-LIBUA-A-D, Digital Equipment
;	Corporation, Maynard, MA, Aug-77.

; 3.	"BASIC-11/RT-11 Installation Guide", DEC-11-LIBTA-A-D, Digital
;	Equipment Corporation, Maynard, MA, Aug-77.

; 4.	"PDP-11 MACRO-11 Language Reference Manual", AA-5075A-TC, Digital
;	Equipment Corporation, Maynard, MA, Aug-77.

; 5.	"RT-11 System User's Guide", DEC-11-ORGDA-A-D, Digital Equipment
;	Corporation, Maynard, MA, Aug-77.

; 6.	N. A. Bourgeois, Jr. ,"Set of Utility Routines for any PDP-11 Machine 
;	Running RT-11 BASIC", DECUS-11-294, Digital Equipment Computer Users
;	Society, Marlboro, MA, 10-Jan-77.


.SBTTL	EDIT RECORD			12-OCT-78/12-JAN-81

;12-OCT-78	CONVERSION FROM RATBAS.MAC STARTED.  RATBAS.MAC WAS
;		COMPATIBLE WITH BASIC/RT-11 UNDER RT-11 V02 [6].
;18-OCT-78	CONVERSION AND DEBUGGING COMPLETED.
;21-OCT-78	TABLE II, TEST PROGRAM AND TEST RESULTS ADDED.
;20-DEC-78	CORRECTED TYPOGRAPHIC ERRORS, NO CODE CHANGED.
;12-JAN-81	CORRECTED ERROR IN "GETB" ROUTINE.


.SBTTL	END				12-OCT-78/

FINIS:	.END