PROGRAM mothertask

? This program demonstrates how one F-Basic program can launch another
?   F-Basic program as a separate task (in fact, a separate process).
?   The program BabyTask follows in this file.
?   Courtesy of Douglas A. Nelson; 2006 N 49th Avenue; Omaha, NE  68104

INCLUDE finclude/AmigaExecTypes

TYPE SetupMsg IS RECORD
   INTEGER success
   INTEGER babysignal
   PTR_TO Task mothertask
   INTEGER rastport
   INTEGER mothersignal
   TEXT*50 greeting
   PTR_TO INTEGER arrayptr
ENDTYPE

TYPE FakeWBStartup IS RECORD
   Message  sm_Message
   PTR_TO MsgPort sm_Process
   INTEGER  sm_Segment
   INTEGER  sm_NumArgs
   PTR_TO TEXT    sm_ToolWindow
   INTEGER  sm_ArgList
   INTEGER  wa_Lock
   PTR_TO TEXT wa_Name
ENDTYPE

GLOBAL
   INTEGER execbase,dosbase,dummy
   INTEGER array(3,5,7)
   SetupMsg setupmsg
LOCAL
   INTEGER winptr,rastport
   INTEGER segptr
   INTEGER mothersignal,babysignal
   PTR_TO MsgPort babyport
   PTR_TO Task thistask,babytask
   TEXT procname*20
   INTEGER priority
   FakeWBStartup fakewbstartup

SUBPROGRAM
   INTEGER SendFakeWBMsg,CreateSetupMsg,CheckSetupMsg

&SYSLIB 1

IF 0=OPENLIB("exec.library",33) ! execbase THEN GOTO Cleanup
IF 0=OPENLIB("dos.library",33) ! dosbase THEN GOTO Cleanup

?***** allocate a signal for mothertask
IF -1 = AllocSignal(execbase,-1) ! mothersignal THEN GOTO Cleanup

?***** open a window
winptr = WINDOW #1 (100,50,520,100,100,50,640,400,-1,-1,1+2+4+16,@"Mother's Window",-1)
rastport = WINDOW_INFO(3)
CURS_INV

?***** load babytask into memory from disk
procname = "babytask.bin" ;? this can be full path name if needed
? terminate procname with null byte
procname(LENGTH(procname)+1) = CHAR(0)
segptr = LoadSeg(dosbase,@procname)
IF segptr=0 THEN
   PRINT "No seg loaded"
   GOTO Cleanup
ENDIF

?***** start babytask
thistask = FindTask(execbase,0)
priority = thistask.tc_Node.ln_Pri
? We will start babytask at the same priority as mothertask; a different
? priority can be used if needed
babyport = CreateProc(dosbase,@procname,priority,segptr,8000)
IF babyport=0 THEN
   PRINT "No process created"
   GOTO Cleanup
ENDIF

? [Under AmigaDos 2.0, you can substitute System() for
?  LoadSeg() and CreateProc().]

? The call to CreateProc() causes babytask to start.  Babytask executes the
? standard F-Basic startup code.  This code looks in the pr_CLI field of
? babytask's Process record to see if it was started from a CLI.  Since it
? was not, this field will be zero.  When the startup code finds pr_CLI to
? be zero, it assumes (erroneously in this case) that the program was
? started from the Workbench, so it waits for the arrival of a WBStartup
? message.  This wait is convenient for us. We can now supply babytask with
? any data it needs to begin execution.

? The Task record has a field named tc_UserData that we can use to pass data
? to babytask.  We will organize the data to be passed as a RECORD in
? CreateSetupMsg, and put a pointer to this RECORD in tc_UserData.

babytask = babyport - SIZEOF(Task)
IF FALSE=CreateSetupMsg(setupmsg,thistask,rastport,mothersignal,@array) THEN
   GOTO Cleanup
ENDIF
babytask.tc_UserData = @setupmsg

?***** initialize on element of array for babytask to find
array(1,2,3) = 19

? Babytask is still waiting for the arrival of a WBStartup message, but
? since it was not started from the Workbench, Workbench will not be sending
? one.  We must send a fake WBStartup to awaken babytask.

IF FALSE=SendFakeWBMsg(fakewbstartup,babyport,segptr,@procname) THEN GOTO Cleanup

? The F-Basic startup code now passes control to the user code.  The user
? code does whatever initialization is needed, then tells mothertask that it
? is ready to run.  A real program will probably have mothertask and
? babytask set up message ports and communicate by messages.  For this
? example, we will avoid the overhead of that by having babytask communicate
? with mothertask by a simple Signal().

?***** wait for babytask to signal that it is ready to run
dummy = Wait(execbase,(1 LSL mothersignal))

? If babytask has initialized successfully, it will set a marker in setupmsg.
? If we were communicating by Messages, then babytask could send a Message
? to this effect, but NOTE: there is no guarantee that babytask can allocate
? the memory for a Message, so the memory for the initialization Message
? should be allocated by mothertask, and passed to babytask in the setupmsg.

?***** check that babytask initialized successfully
IF CheckSetupMsg(setupmsg)=FALSE THEN GOTO Cleanup

{main}
?*****do whatever the program does

DELAY(250)  ;? let user read output

?***** tell babytask to cleanup and quit
Signal(execbase,babytask,(1 LSL setupmsg.babysignal))

{Cleanup}
IF segptr THEN
   WHILE 0<>FindTask(execbase,@procname) DO ;? wait til babytask is gone
      Delay(dosbase,1)
   ENDWHILE
   UnloadSeg(dosbase,segptr)
ENDIF
IF winptr THEN WINDOW_CLOSE #1
IF dosbase THEN dummy=CLOSELIB(dosbase)
IF execbase THEN dummy=CLOSELIB(execbase)

END


FUNCTION SendFakeWBMsg
?***** returns TRUE if successful
PARAMETER
   FakeWBStartup fakewbmsg
   INTEGER process,segment
   PTR_TO TEXT processname
LOCAL
   INTEGER lock

   fakewbmsg.sm_Message.mn_Node.ln_Type = NT_MESSAGE
   fakewbmsg.sm_Message.mn_ReplyPort = 0
   fakewbmsg.sm_Message.mn_Length = SIZEOF(FakeWBStartup)
   fakewbmsg.sm_Process = process
   fakewbmsg.sm_Segment = segment
   fakewbmsg.sm_NumArgs = 1
   fakewbmsg.sm_ArgList = @fakewbmsg.wa_Lock

?  The current directory lock can be found in the Process struct,
?  but using CurrentDir() is easier.
   lock = CurrentDir(dosbase,0)  ;? Lock 0 is SYS:
   fakewbmsg.wa_Lock = lock
   lock = CurrentDir(dosbase,lock)

   fakewbmsg.wa_Name = processname

   PutMsg(execbase,process,fakewbmsg)

   SendFakeWBMsg = TRUE
END


FUNCTION CreateSetupMsg
?***** returns TRUE if successful.  If this function is changed to allocate
?***** memory, it should return a pointer to the memory.
PARAMETER
   SetupMsg babysetupmsg
   PTR_TO Task mothertask
   INTEGER rp
   INTEGER signal
   PTR_TO INTEGER arrayptr
LOCAL

   CreateSetupMsg = FALSE

   babysetupmsg.success = FALSE
   babysetupmsg.babysignal = 0
   babysetupmsg.mothertask = mothertask
   babysetupmsg.rastport = rp
   babysetupmsg.mothersignal = signal
   dummy = FILLCHAR(babysetupmsg.greeting," ")
   babysetupmsg.greeting = "Hello world!"
   babysetupmsg.arrayptr = arrayptr

? Other things to pass in the setupmsg: memory allocation for messages,
? memory allocation for message ports (but note that babytask must create
? the MsgPort itself so that the port's signal is assigned properly),
? file names or file handles.

   CreateSetupMsg = TRUE
END

FUNCTION CheckSetupMsg
PARAMETER
   PTR_TO SetupMsg babysetupmsg

   CheckSetupMsg = babysetupmsg.success
END
.
PROGRAM babytask
? This is a program to be launched by mothertask.  Mothertask expects the
? executable to be named "babytask.bin".  Babytask will open a default
? F-Basic window unless it is compiled as:
?     FB babytask opt-I0

INCLUDE finclude/AmigaExecTypes

TYPE SetupMsg IS RECORD
   INTEGER success
   INTEGER babysignal
   PTR_TO Task mothertask
   INTEGER rastport
   INTEGER mothersignal
   TEXT*50 greeting
   PTR_TO INTEGER arrayptr
ENDTYPE

GLOBAL
   INTEGER execbase,dosbase,gfxbase,dummy

LOCAL
   PTR_TO Task babytask,mothertask
   PTR_TO SetupMsg babysetupmsg
   INTEGER rastport,mothersignal,babysignal,sig,element
   TEXT*50 greeting,numeralstr
   PTR_TO INTEGER arrayptr

SUBPROGRAM
   INTEGER ReadArray

DATA(numeralstr," ")

&SYSLIB 1

?***** initialize
IF 0=OPENLIB("exec.library",33) ! execbase THEN GOTO Cleanup
IF 0=OPENLIB("dos.library",33) ! dosbase THEN GOTO Cleanup
IF 0=OPENLIB("graphics.library",33) ! gfxbase THEN GOTO Cleanup

?***** find babysetupmsg
babytask = FindTask(execbase,0)
babysetupmsg = babytask.tc_UserData

?***** read babysetupmsg
mothertask = babysetupmsg.mothertask
rastport = babysetupmsg.rastport
mothersignal = babysetupmsg.mothersignal
greeting = babysetupmsg.greeting
arrayptr = babysetupmsg.arrayptr

?***** allocate babysignal
IF -1=AllocSignal(execbase,-1) ! babysignal THEN GOTO Cleanup

?***** initialization is complete, so signal success to mothertask
babysetupmsg.success = TRUE
babysetupmsg.babysignal = babysignal
Signal(execbase,mothertask,(1 LSL mothersignal))

{main}
?***** put a message on mothertask's window
   Move(gfxbase,rastport,5,20)
   Text(gfxbase,rastport,@greeting,LENGTH(greeting))

? We use tc_UserData to pass a pointer to a RECORD to babytask.  We can
? use this method to pass any kind of data that a RECORD can contain, but
? there is one kind of data that a RECORD cannot contain, namely a
? multiply-subscripted array.  However, we can use a little trick to pass
? even this.  We pass the address of the array as an element of the RECORD
? babysetupmsg.  In babytask we define this element as a PTR_TO INTEGER.
? The main program of babytask cannot read from the array, but a subprogram
? can.  The trick here is that when an array is passed to a subprogram as a
? parameter, it is passed by reference, as a pointer.  So we call the
? function ReadArray() with the array pointer as a parameter, then in
? ReadArray() we define that parameter as a multiply-subscripted array.
? ReadArray() correctly reads any element that we want from the array.

?***** read an element from the array in mothertask
   element = ReadArray(arrayptr,1,2,3)
? in mothertask we set array(1,2,3)=19
   numeralstr = DIGSTRING(element)
   Move(gfxbase,rastport,5,30)
   Text(gfxbase,rastport,@numeralstr,LENGTH(numeralstr))


?***** check for signal to quit
REPEAT
   sig = SetSignal(execbase,0,0) AND (1 LSL babysignal)
UNTIL sig<>0
? Remember, do not use
?      WHILE SetSignal(execbase,0,0) AND (1 LSL babysignal)
? because in a control statement the AND will be a short-circuit AND
? instead of a bitwise AND.

{Cleanup}
   IF gfxbase THEN dummy = CLOSELIB(gfxbase)
   IF dosbase THEN dummy = CLOSELIB(dosbase)
   IF execbase THEN
      IF mothertask THEN ;? signal mothertask in case of failure
         Signal(execbase,mothertask,mothersignal)
      ENDIF
      dummy = CLOSELIB(execbase)
   ENDIF
END

FUNCTION ReadArray
   PARAMETER
      INTEGER array(*,*,*),i,j,k

  ReadArray = array(i,j,k)

? At this point, inquiring minds may ask, How is it that ReadArray() can
? find an element in an array when we have not told it what the dimensions
? of the array are, and when the array itself was not even created in this
? program?  The answer is that F-Basic considerately stores this information
? in memory, just before the address of the array.  The information is
? stored as INTEGERs in this format:

? @array-4 holds size in bytes of array units- 1 for bytes, 2 for words,
?   4 for integers, 8 for reals; for text it is length of text variable
? @array-8 holds number of subscripts - for array(5,7,11) this is 3
? @array-12 holds total number of array units - for array(5,7,11) this is
?   5 * 7 * 11.
? @array-16 holds size of last subscript - for array(5,7,11), this is 11
? @array-20 holds size of next-to-last subscript - for array(5,7,11), this
?   is 7
? and so on.

? With this information, it is straight-forward to write code to check if
? an array reference is in bounds.  It would also be possible to set up
? dynamically-allocated arrays.
END