	REM ********** BASIC RUNTIME PACKAGE TEST **********
	REM *** PART 2 OF 2 PARTS (CTLRTP14H) ***
	REM COPYRIGHT (C) 1977 SOFTWARE DYNAMICS
	REM ALL RIGHTS RESERVED
	REM 01/31/81 0915

	REM TEST RUNTIME PACKAGE OPCODES
	REM IF INPUT IS NULL, TESTS ALL OPCODES
	REM PROMPTS FOR OPCODE NUMBER (SEE LIST OF OPCODES IN BASIC COMPILER)
	REM REQUIRES I/O DEVICE WITH POSITION$ CAPABILITY AND READ/WRITE
	REM LINES WHICH TEST OPCODE NUMBER XXX...
	REM ARE LINES XXX00 THRU XXX99
	REM EACH OPCODE TEST ASSUMES ALL OTHER OPCODES WORK PROPERLY

	CONCATENATION BUFFER SIZE = 200
	REM FOR OPUPPERCASE, LOWERCASE TESTS

	REM DATA STORAGE
	DIM OPCODE$[10],OPCODE2$[10],V[100],S$/:1,"HELLO"/,T$[2]
	DIM U$[255],NEGONE/-1/,T/1/,DOALL$/"          "/
	DIM BIN257$/:00,:00,:00,:00,:1,:1/,BINPI$/:41,03,14,15,92,65/
	DIM SIX$[6],FORMAT$/"ABC.##D"/,ZEROLEN$[0],ONELEN$[1]
	DIM GPOPF/0/,ONETWENTYEIGHT$[128]
	DIM DOLLAR$/'$'/,MINUS$/'-'/,HASH$/'##########'/,PERIOD$/'.'/
	DIM CARET$/'^^^^^'/,F$(25)
	DIM TEMP/2/
	DIM INITSTRING$[25]/"STRING CONTENTS"/,GOELNFLAG/0/
	DIM JUNKFILE$/"JUNK"/
	DIM SPACES$[32]/"                                "/


50	REM INITIALIZE

	PRINT "*** RUNTIME PACKAGE TEST -- PART II (BASRTP14H) ***"
	PRINT "TESTS EXTENDED OPCODES 0-33"
	PRINT "TO TEST ALL OPCODES, TYPE <CR>"
	PRINT "TO TEST A SPECIFIC OPCODE 'X', TYPE 'X'"
	PRINT "TO TEST ALL OPCODES > X, TYPE '>X'"

	CREATE #T,JUNKFILE$\ ! A SCRATCH PLACE TO READ AND WRITE
	PRINT #T\ ! WRITE SOMETHING FOR SUBR 91 TO READ
	RESTORE #T,0\ !SET UP FOR SUBR 91

90	REM THIS IS WHERE WE ASK...
	ON ERROR GOTO 96
	INPUT "WHICH OPCODE ? " OPCODE$
	IF UPPERCASE$(OPCODE$)="STOP" THEN EXIT
	IF OPCODE$='          '
	THEN
		FOR OPCODE=0 TO 33
			PRINT OPCODE;
			GOSUB 95
			IF GPOPF<>0 OR GOELNFLAG<>0
			THEN GPOPF=0\GOELNFLAG=0\GOSUB 99
92		NEXT OPCODE
		PRINT '***DIAGNOSTIC PASS III COMPLETED***'
		EXIT
	ELSE
		IF OPCODE$(1)=ASC(">")
		THEN
			LET OPCODE2$=OPCODE$
			LET OPCODE2$[1]=ASC(" ")
			FOR OPCODE=VAL(OPCODE2$)+1 TO 33
				PRINT OPCODE;
				GOSUB 95
				IF GPOPF<>0 OR GOELNFLAG<>0
				THEN GPOPF=0\GOELNFLAG=0\GOSUB 99
			NEXT OPCODE
			PRINT '*** PARTIAL DIAGNOSTIC PASS COMPLETED ***'
		ELSE
			LET OPCODE=VAL(OPCODE$)
			GOSUB 95
			IF GPOPF<>0 OR GOELNFLAG<>0
			THEN GPOPF=0\GOELNFLAG=0\GOSUB 99
			PRINT "TEST COMPLETED"
		FI
	FI
	GOTO 90

91	REM SUBROUTINE TO INPUT INTO U$ FROM TEMP FILE
	REM AND REWIND TEMP FILE TO BYTE 0
	RESTORE #T,0
	INPUT #T,U$
	RESTORE #T,0
	RETURN

95	REM BRANCH TO OPCODE TEST SUBROUTINE
	RESTORE #T,0\! THIS SAVES DOING IT EVERYWHERE ELSE
	ON OPCODE+1 GOTO 100,150,200,300,400,500,600,700,800,900,...
&	1000,1100,1200,1300,1400,1500,1600,1700,1800,1900,...
&	2000,2100,2200,2300,2400,2500,2600,2700,2800,2900,...
&	3000,3100,3200,3300
	PRINT "I CAN'T TEST THAT OPCODE IN THIS PASS"\ RETURN


96	REM ERROR TRAP ROUTINE
	IF ELN=1000 AND ERR=14 THEN 1010
	IF ELN=1350 AND ERR=6 THEN 1360
	IF ELN=1370 AND ERR=6 THEN 1380
	IF ELN=1805 AND ERR=7 THEN 1830
	IF ELN=1830 AND ERR=7 THEN 1840
	IF ELN=1840 AND ERR=7 THEN 1850
	IF ELN=1850 AND ERR=7 THEN 1899
	IF ELN=2210 AND ERR=14 THEN X=3\ GOTO ELN
	IF ELN=2220 AND ERR=13 THEN 2299
	IF ELN=2310 AND ERR=16 THEN 2399
	IF ELN=3010 AND ERR=19 THEN 3020
	IF ELN=3020 AND ERR=19 THEN 3099
	IF ELN=3110 AND ERR=INT(I) THEN 3120
	IF ELN=3130 AND ERR=15 THEN 3199
	IF ELN=96 AND ERR=1 THEN PRINT "ESCAPE BOTHERED ERROR TRAP LINE #!?"\
				 GOSUB POP 0\
				 GOTO 90
	REM NOT A VALID TRAP!
97	PRINT "ERROR"; ERR; "OCCURRED DURING OPCODE"; OPCODE; "(LINE ";ELN;")"
	GOSUB POP 0
	GOTO 90

99	PRINT "OPCODE"; OPCODE; "FAILED"\ RETURN

	SUBROUTINE TESTRELATIVEERROR(TESTVALUE,ACTUALVALUE)
	IF ACTUALVALUE=0
	THEN
		RELATIVEERROR=ABS(TESTVALUE-ACTUALVALUE)
	ELSE
		RELATIVEERROR=ABS((TESTVALUE-ACTUALVALUE)/ACTUALVALUE)
	FI
	IF RELATIVEERROR>32767
	THEN PRINT "ERROR TOLERANCE EXCEEDED: ";TESTVALUE;ACTUALVALUE
	IF RELATIVEERROR>MAXRELATIVEERROR
	THEN	MAXRELATIVEERROR=RELATIVEERROR
	EXIT SUBROUTINE
	END


DEF MUSTTESTINMANUAL
	IF OPCODE$='          ' OR OPCODE$[1]=ASC(">") THEN
		PRINT "MUST TEST THIS OPCODE IN MANUAL MODE"
		RETURN TRUE
	ELSE	RETURN FALSE
END





100	REM TEST OPATN
	GOTO NOTIMPLEMENTED
150	REM TEST OPSIN
	GOTO NOTIMPLEMENTED


200	REM TEST OPCOS
	GOTO NOTIMPLEMENTED

300	REM TEST OPLOG
	GOTO NOTIMPLEMENTED

400	REM TEST OP EXP
	GOTO NOTIMPLEMENTED

500	REM  TEST OPSQR
	GOTO NOTIMPLEMENTED

600	REM TEST OPRND
	GOTO NOTIMPLEMENTED


DEF RANDOM
	SEED=((SEED**-1) XOR ((SEED&1)*:C003))
	RETURN   SEED &:7FFF
END

700	REM TEST OPABS
	LET X=-100
710	WHILE X<100 DO
		IF X<0 AND ABS(X)<>-X THEN GOSUB 99\ RETURN
		IF X>=0 AND ABS(X)<>X THEN GOSUB 99\ RETURN
		LET X=X+RANDOM
	END
	RETURN

800	REM TEST OPDBG
	IF MUSTTESTINMANUAL THEN RETURN
	ELSE DEBUG
	RETURN


900	REM TEST OPOWER
	GOTO NOTIMPLEMENTED

1000	REM TEST OPERRST
	CALL ERRSTTEST(5)
1010	IF MUSTTESTINMANUAL THEN RETURN
	ELSE
		Print "Should print 'Error 14' and then stop"
		ERROR
		GOSUB 99
	FI
1099	RETURN

SUBROUTINE ERRSTTEST(ERRSTARG)
	X=ERRSTARG
	ON ERROR GOTO ERRST1
	IF ERRSTARG/0*0=0 THEN GOSUB 99
	GOSUB 99
ERRST1: IF ERR=14 THEN X=0\ ERROR
	GOSUB 99
	END

1100	REM TEST OPSETSEED
	GOTO NOTIMPLEMENTED

1200	REM TEST OPCOL
	PRINT #T
	FOR I=1 TO 255
		IF COL(T)<>I THEN GOSUB 99
		PRINT #T,"*";
	NEXT I
	REM TEST RESTORE RESETS COL(T) = 1
	RESTORE #T,0
	IF COL(T)<>1 THEN GOSUB 99
	RETURN

1300	REM TEST OPGPOP
	PRINT "MUST TEST OPGPOP IN SUBROUTINE, TOO!"
	PRINT "TO MAKE SURE IT DOESN'T AFFECT MAINLINE CODE"
	GOSUB 1310\GOTO 1340
1310	GOSUB 1320\ GOSUB 99\GOSUB POP 0\ GOTO 90
1320	GOSUB 1330\ GOSUB 99\GOSUB POP 0\ GOTO 90
1330	GOSUB POP 2\ RETURN
1340	GOSUB POP 0\ GPOPF=1
1350	RETURN\!SHOULD TRAP
1360	GOSUB POP 0\ GOSUB 1370\ REM PUT A RETURN ADDRESS ON THE STACK
1370	GOSUB POP 2\ REM TEST TOO MANY POPS ... SHOULD TRAP
	GOSUB 99
1380	GPOPF=0
	IF MUSTTESTINMANUAL THEN 92 ELSE PRINT "TEST COMPLETED"\ GOTO 90

1400	REM TEST OPDAT
	GOTO NOTIMPLEMENTED

1500	REM TEST OPTIM
	GOTO NOTIMPLEMENTED


1600	REM TEST OPNUM
	IF NUM$(127)<>" 127" THEN GOSUB 99
1700	REM INVENT ALL POSSIBLE NUMBER FORMATS
	GOTO NOTIMPLEMENTED

1800	REM TEST OPVAL
	IF VAL("       0A")<>0 THEN GOSUB 99
	IF VAL(":239G")<>:239 THEN GOSUB 99
	LET SIX$="   257"
	IF VAL(SIX$)<> 257 THEN GOSUB 99
1805	IF VAL(":7AACD")*0=0 THEN GOSUB 99
1830	IF VAL("")*0=0 THEN GOSUB 99
1840	IF VAL(":")*0=0 THEN GOSUB 99
1850	IF VAL("   -")*0=0 THEN GOSUB 99
1899	RETURN


1900	REM TEST OPTAN
	GOTO NOTIMPLEMENTED

2000	REM TEST OPPOLY
	GOTO NOTIMPLEMENTED

2100	REM TEST OPHEX
	IF HEX$(:B972)<>":B972" THEN GOSUB 99
	FOR I=-32768 TO 32766
		IF VAL(HEX$(I))<>I THEN GOSUB 99
	NEXT I
	IF VAL(HEX$(32767))<>32767 THEN GOSUB 99
2199	RETURN

2200	REM TEST OPGOELN
	LET X=0
	PRINT "Should print 'Got back from error trap routine'"
2210	IF X<>3 THEN LET X=X/0
	PRINT "Got back from error trap routine"
2220	GOTO ELN\ GOSUB 99
2299	RETURN

2300	REM TEST OPUPPERC
	LET ONETWENTYEIGHT$=""
	FOR I=0 TO 127
		LET ONETWENTYEIGHT$(I+1)=I
	NEXT I
	LET ONETWENTYEIGHT$=UPPERCASE$(ONETWENTYEIGHT$)
	FOR I=0 TO 127
		IF I<ASC('A')+32 OR I>ASC('Z')+32
		THEN	IF ONETWENTYEIGHT$(I+1)<>I THEN GOSUB 99 FI
		ELSE	IF ONETWENTYEIGHT$(I+1)<>I-32 THEN GOSUB 99
	NEXT I
	REM CHECK FOR CATBUF OVERFLOW CORRECTLY DETECTED
2310	LET U$=UPPERCASE$(U$)
2399	RETURN

2400	REM TEST OPLOWRC
	GOTO NOTIMPLEMENTED

2500	REM TEST OPEXIT
	IF MUSTTESTINMANUAL THEN RETURN
	ELSE
		PRINT "Should EXIT properly."
		EXIT
	FI
	RETURN

2600	REM TEST OPLENVECTOR
	IF 100<>LEN(V) THEN GOSUB 99
	CALL TESTOPLENVECTORONPARAMETER(V)
	RETURN

SUBROUTINE TESTOPLENVECTORONPARAMETER(TESTOPLENVECTORARG[*])
	IF LEN(TESTOPLENVECTORARG)<>100 THEN GOSUB 99
	EXIT SUBROUTINE
END

2700	REM TEST OPROWSARRAY
	GOTO NOTIMPLEMENTED


2800	REM TEST OPCOLSARRAY
	GOTO NOTIMPLEMENTED

2900	REM TEST OPFUNRET
	DEF OPFUNRET1(OPFUNRETARG)=12
	DEF OPFUNRET2$(OPFUNRETARG1)="HELLO"
	REM MUST TEST CONTEXT BLOCK POP
	IF 12<>OPFUNRET1(0) THEN GOSUB 99
	IF "HELLO"<>OPFUNRET2$(0) THEN GOSUB 99
	RETURN

3000	REM TEST OPCHR

	FOR I=0 TO 255
		IF I<>CHR$(I)[1] THEN GOSUB 99
	NEXT I
	IF "B"<>CHR$(ASC("A")+1) THEN GOSUB 99
3010	LET U$=CHR$(256)\ GOSUB 99
3020	LET U$=CHR$(-1)\ GOSUB 99
3099	RETURN

3100	REM TEST OPERRCAUSE
	FOR I=1 TO 1000

3110		ERROR I
		GOSUB 99
3120	NEXT I
3130	ERROR -1\ GOSUB 99
3199	RETURN

3200	REM TEST OPSSA
	GOTO NOTIMPLEMENTED

3300	REM TEST OPSAINIT
	GOTO NOTIMPLEMENTED

NOTIMPLEMENTED:
	PRINT "OPCODE NOT IMPLEMENTED IN CONTROL BASIC"
	RETURN
	END
