''
'' $Id: VarTest.bas,v 1.1 1994/05/09 13:40:44 alex Rel $
''
'' Simple REXX Variable Interface test
''

DEFINT A-Z

'REM $INCLUDE Exec.bh
'REM $INCLUDE DOS.bc
'REM $INCLUDE Rexx.bh

REM $INCLUDE BLib/PoolSupport.bas
REM $INCLUDE BLib/RexxSupport.bas

LIBRARY OPEN "exec.library", 36
LIBRARY OPEN "rexxsyslib.library", LIBRARY_MINIMUM&

DIM SHARED pool&

FUNCTION createRXPort&(name$)
	STATIC portName&, port&

	createRXPort& = NULL&
	portName& = LibAllocVecPooled&(pool&, LEN(name$) + 1)
	IF portName& <> NULL& THEN
		CopyMem SADD(name$ + CHR$(0)), portName&, LEN(name$) + 1
		port& = CreateMsgPort&	' create the message port before the Forbid
		IF port& THEN
			POKEL port& + mp_Node + ln_Name, portName&
			POKEB port& + mp_Node + ln_Pri, 0
			Forbid	' stop anything happening on the public port list
			IF FindPort&(portName&) = NULL& THEN
				AddPort port&
				Permit
				createRXPort& = port&
			ELSE
				Permit
			END IF
		END IF
	END IF
END FUNCTION

SUB deleteRXPort(BYVAL port&)
	RemPort port&
	LibFreeVecPooled pool&, PEEKL(port& + mp_Node + ln_Name)
	DeleteMsgPort port&
END SUB

FUNCTION main
	STATIC myPort&, rmPtr&, test, rxErr&, value&, junk&, done

	main = RETURN_FAIL&
	myPort& = createRXPort&("MYPORT")
	IF myPort& THEN
		main = RETURN_OK&
		done = FALSE&
		WHILE done = FALSE&
			junk& = WaitPort&(myPort&)
			rmPtr& = GetMsg&(myPort&)

			WHILE rmPtr& <> NULL& 
				' Show what we got
				PRINT "VarTest: received command "; PEEK$(PEEKL(rmPtr& + rm_Args))

				' Make sure it's a valid context
				IF CheckRexxMsg(rmptr&) THEN
					PRINT "VarTest: valid REXX context"

					rxErr& = GetRexxVar&(rmptr&, SADD("A.1" + CHR$(0)), value&)
					IF rxErr& = FALSE& THEN
						PRINT "VarTest: value of A.1 is "; PEEK$(value&)
					ELSE
						PRINT "VarTest: error from get"; rxErr&
					END IF
					
					rxErr& = SetRexxVar&(rmptr&, SADD("STATUS" + CHR$(0)), SADD("A-OK" + CHR$(0)), LEN("A-OK"))
					IF rxErr& <> FALSE& THEN
						PRINT "VarTest: error from set"; rxErr&
					END IF
				END IF

				' See whether it's the quit command
				IF UCASE$(PEEK$(PEEKL(rmPtr& + rm_Args))) = "QUIT" THEN
					done = TRUE&
				END IF
				POKEL rmPtr& + rm_Result1, 0	' return code
				POKEL rmPtr& + rm_Result2, 0	' secondary result
				ReplyMsg rmptr&	' send it back
				rmPtr& = GetMsg&(myPort&)
			WEND
		WEND
		deleteRXPort myPort&
	END IF
END FUNCTION

pool& = LibCreatePool&(MEMF_ANY& OR MEMF_CLEAR&, 8192, 4096)	' create a pool for our allocations
IF pool& <> NULL& THEN
	r = main
	LibDeletePool pool&	' takes all allocated memory with it
ELSE
	r = RETURN_FAIL
END IF
STOP r