home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Basic / MAXONB32.DMS / in.adf / Beispiele_2.0 / TestRVI / VarTest.bas < prev   
Encoding:
BASIC Source File  |  1994-05-09  |  2.5 KB  |  105 lines
  1. ''
  2. '' $Id: VarTest.bas,v 1.1 1994/05/09 13:40:44 alex Rel $
  3. ''
  4. '' Simple REXX Variable Interface test
  5. ''
  6.  
  7. DEFINT A-Z
  8.  
  9. 'REM $INCLUDE Exec.bh
  10. 'REM $INCLUDE DOS.bc
  11. 'REM $INCLUDE Rexx.bh
  12.  
  13. REM $INCLUDE BLib/PoolSupport.bas
  14. REM $INCLUDE BLib/RexxSupport.bas
  15.  
  16. LIBRARY OPEN "exec.library", 36
  17. LIBRARY OPEN "rexxsyslib.library", LIBRARY_MINIMUM&
  18.  
  19. DIM SHARED pool&
  20.  
  21. FUNCTION createRXPort&(name$)
  22.     STATIC portName&, port&
  23.  
  24.     createRXPort& = NULL&
  25.     portName& = LibAllocVecPooled&(pool&, LEN(name$) + 1)
  26.     IF portName& <> NULL& THEN
  27.         CopyMem SADD(name$ + CHR$(0)), portName&, LEN(name$) + 1
  28.         port& = CreateMsgPort&    ' create the message port before the Forbid
  29.         IF port& THEN
  30.             POKEL port& + mp_Node + ln_Name, portName&
  31.             POKEB port& + mp_Node + ln_Pri, 0
  32.             Forbid    ' stop anything happening on the public port list
  33.             IF FindPort&(portName&) = NULL& THEN
  34.                 AddPort port&
  35.                 Permit
  36.                 createRXPort& = port&
  37.             ELSE
  38.                 Permit
  39.             END IF
  40.         END IF
  41.     END IF
  42. END FUNCTION
  43.  
  44. SUB deleteRXPort(BYVAL port&)
  45.     RemPort port&
  46.     LibFreeVecPooled pool&, PEEKL(port& + mp_Node + ln_Name)
  47.     DeleteMsgPort port&
  48. END SUB
  49.  
  50. FUNCTION main
  51.     STATIC myPort&, rmPtr&, test, rxErr&, value&, junk&, done
  52.  
  53.     main = RETURN_FAIL&
  54.     myPort& = createRXPort&("MYPORT")
  55.     IF myPort& THEN
  56.         main = RETURN_OK&
  57.         done = FALSE&
  58.         WHILE done = FALSE&
  59.             junk& = WaitPort&(myPort&)
  60.             rmPtr& = GetMsg&(myPort&)
  61.  
  62.             WHILE rmPtr& <> NULL& 
  63.                 ' Show what we got
  64.                 PRINT "VarTest: received command "; PEEK$(PEEKL(rmPtr& + rm_Args))
  65.  
  66.                 ' Make sure it's a valid context
  67.                 IF CheckRexxMsg(rmptr&) THEN
  68.                     PRINT "VarTest: valid REXX context"
  69.  
  70.                     rxErr& = GetRexxVar&(rmptr&, SADD("A.1" + CHR$(0)), value&)
  71.                     IF rxErr& = FALSE& THEN
  72.                         PRINT "VarTest: value of A.1 is "; PEEK$(value&)
  73.                     ELSE
  74.                         PRINT "VarTest: error from get"; rxErr&
  75.                     END IF
  76.                     
  77.                     rxErr& = SetRexxVar&(rmptr&, SADD("STATUS" + CHR$(0)), SADD("A-OK" + CHR$(0)), LEN("A-OK"))
  78.                     IF rxErr& <> FALSE& THEN
  79.                         PRINT "VarTest: error from set"; rxErr&
  80.                     END IF
  81.                 END IF
  82.  
  83.                 ' See whether it's the quit command
  84.                 IF UCASE$(PEEK$(PEEKL(rmPtr& + rm_Args))) = "QUIT" THEN
  85.                     done = TRUE&
  86.                 END IF
  87.                 POKEL rmPtr& + rm_Result1, 0    ' return code
  88.                 POKEL rmPtr& + rm_Result2, 0    ' secondary result
  89.                 ReplyMsg rmptr&    ' send it back
  90.                 rmPtr& = GetMsg&(myPort&)
  91.             WEND
  92.         WEND
  93.         deleteRXPort myPort&
  94.     END IF
  95. END FUNCTION
  96.  
  97. pool& = LibCreatePool&(MEMF_ANY& OR MEMF_CLEAR&, 8192, 4096)    ' create a pool for our allocations
  98. IF pool& <> NULL& THEN
  99.     r = main
  100.     LibDeletePool pool&    ' takes all allocated memory with it
  101. ELSE
  102.     r = RETURN_FAIL
  103. END IF
  104. STOP r
  105.