Article
· 15 hr ago 26m read

Building a robot with IRIS

#InterSystems IRIS #Caché

In this case, a robot is nothing like Gort from the movie “The Day the Earth Stood Still” or any other humanoid robot from science fiction. Nor is this Robot the one-armed automated welder from a real-world automotive assembly line. This Robot is a program that controls another program. You might want this for automated testing or to capture application logic from an application for which you don’t have the source, and the application’s author lacked the kindness or foresight to provide an API for its capabilities.

In this article, I will present two ways to implement a robot with InterSystems IRIS®.

  1. ^ROBOTB - relies on an external tool.
  2. ^ROBOTC - entirely IRIS based, and significantly easier to use.

1. ^ROBOTB

If you are fortunate enough to have a Macintosh computer, you can implement a robot with the free iTerm2 terminal emulator. I will do that here for the most straightforward code delivered with InterSystems IRIS. The routines ^%DB, ^%DOCTAL, ^%DX, ^%OB, ^%OD, ^%XB, and ^%XD convert numbers between various bases. We will start with a robot to test these routines. The testing method will be to pair the routines ^%DOCTAL ↔ ^%OD, and ^%DX ↔ ^%XD. Three of these routines don't have a partner. Therefore, I will supply them as non-percent routines: ^%DB ↔ ^BD, ^%OB ↔ ^BO, and ^%XB ↔ ^BX.

The test philosophy is to take one of the routines and send a range of reasonable input values and a few unreasonable input values, recording the response to each input value. After that, we send all the unique responses to the inverse conversion routine to test whether they returned the original value. The ^ROBOTB global keeps track of the values tested, deleting those with symmetric inversions, leaving only the possible errors. We must start IRIS in an iTerm2 terminal window to use the test. IRIS need not be running locally on the Macintosh System. The test will work with an SSH or telnet connection to a remote system running IRIS, Caché®, or InterSystems Standard MUMPS. It even works running InterSystems M/11+ on an emulated PDP-11 (that is how old the base conversion routines are). To run the Robot, select Session → Run Coprocess… or press ⎇⌘R, and enter the command /usr/local/bin/irissession iris "^ROBOTB"↩. The code for ^ROBOTB appears at the end of this article. It uses WRITE to send data to the controlled process, but it requires the robot to perform single-character reads wrapped in an inefficient routine named WAITFOR to read prompts sent by the controlled application. It is essential to understand the prompts that the controlled application makes very precisely, or you may find your robot is either not responding to prompts or sending data to the controlled program that it isn’t expecting. The robot’s starting method is suitable for testing but not for capturing logic from an application lacking an API. The test results revealed an embarrassment of defects (now all logged in defect report DP-441282). The defects included producing wrong results for input values near the maximum values, not handling negative values consistently, failing to recognize some bogus input and memory leaks.

2. ^ROBOTC

The I/O redirection capability of IRIS makes a more straightforward implementation of a Robot possible. The routine LAUNCH^ROBOT uses I/O redirection to enable a Robot to talk to a controlled and detached IRIS process running in the same IRIS environment on any platform. The Robot can communicate with the controlled process with simple READ and WRITE commands without the concern for dealing with single-character reads and almost entirely without concern for timeout details. The interface is quite simple. To launch an application call:

    SET dev=$$LAUNCH^ROBOT(entry,idle,echo)
where entry is the entry point from which you want the application to run.
  idle is a time in seconds that will serve as a maximum timeout for all reads. If the robot-controlled application waits at a read for more than idle seconds, the read will timeout, and the controlled application will exit. When the Robot finally pays attention to its controlled application, it will receive an end-of-file signal. Warning: If you are using the Robot to wrap a modern UI around a legacy application, don’t use this as your UI timeout. Be generous. The default is 3600 seconds or one hour.
  echo is optional. With a negative value, it will log the conversation between the controlling and controlled processes in the global ^ROBOTDBG (pid_of_robot_control_proc). With a positive value, the conversation appears on the robot’s $PRINCIPAL device with messages from the robot to the controlled process highlighted by the codes ␛[echom and ␛[m. Thus, using 1, prints robot input in bold, while 31 uses in red text. Other values are possible but unconventional.

An example:

    SET dev=$$LAUNCH^ROBOT("^%DX",30,1)
    USE dev
    READ prompt
    WRITE 42,!
    READ reply
    USE $PRINCIPAL
    WRITE "Decimal 42 = ", reply,!

The call to $$LAUNCH^ROBOT() returns an ObjectScript device. The returned device is the NULL device redirected to a spawned JOB running the application provided. Therefore, a controlling process may control only one process at a time.

The controlling process can provide commands to the controlled process with a simple USE dev WRITE command. There are no restrictions on what the controlling process can write to the virtual keyboard of the controlled process. WRITE ! will send a carriage return, and WRITE *n or WRITE $CHAR(n) will send arbitrary characters including control characters.

The controlling process can read the prompts and other output from the controlled process with READ var commands. In general, the controlling process will read whatever the controlled process writes. There are, however, two quirks.

First, whenever the controlled process initiates a READ, it adds an ␅ $CHAR(5) to the buffer transmitted to the controlling process. This way, the controlling process knows the controlled process is waiting for input before it parses the specific details of the prompt. If the controlled process should exit for any reason, the robot will transmit an ␄ $CHAR(4). Should the controlled process attempt to transmit either of these characters themselves, the LAUNCH^ROBOT code will filter them from the transmission.

The LAUNCH^ROBOT code will throw an END-OF-FILE error should it detect the controlled process has encountered any error. Therefore, writing your robot control code in a TRY {} block is wise.

A much simpler robot is shown in ^ROBOTC, which uses the LAUNCH^ROBOT facility. The major advantage of LAUNCH^ROBOT is when writing the controlling logic for the a robot, one always knows when the controlled process wants input. One doesn't have to rely on an assumption that all prompts match a certain pattern, and that that pattern never occurs outside of a prompt signaling the controlled process wants input.

Here are the Robots and the supporting code:

ROUTINE	ROBOTB
	; SRS 2025-08-11
	; Copyright (c) 2025, InterSystems Corporation
	;
	; This program is free software: you can redistribute it and/or
	; modify it under the terms of the GNU General Public License as
	; published by the Free Software Foundation, either version 3 of
	; the License, or (at your option) any later version.
	;
	; This program is distributed in the hope that it will be
	; useful, but WITHOUT ANY WARRANTY; without even the implied
	; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
	; PURPOSE.  See the GNU General Public License for more details.
	;
	; You should have received a copy of the GNU General Public
	; License along with this program.  If not, see
	; <https://www.gnu.org/licenses/>.
	;
	; Run under iTerm2 on macOS
	; Start co-process with
	; Session -> Run Co-process...
	; /usr/local/bin/irissession iris "^ROBOTB"
	SET $ZTRAP="^%ETN"
	; Uncomment the next three lines for trace debugging.
	; ZTRAP:$ZUTIL(128,2,1) "NODEBUG" ; Enable background debugging.
	; ZBREAK /TRACE:ALL:("/tmp/ROBOTB."_$ZDATE($HOROLOG,8)_".txt")
	; ZBREAK $:"T"
	KILL map,^ROBOTB
	do INITMAP(.map)
	; For each pair of bases
	FOR b1=2,8,10,16 {
	  FOR b2=2,8,10,16 {
	    CONTINUE:b1=b2
	    CONTINUE:$DATA(map(b1,b2),test1)=0
	    CONTINUE:$DATA(map(b2,b1),test2)=0
	    SET ^ROBOTB(b1,b2)=$ZHOROLOG
	    ; Get an interpreter prompt.
	    WRITE $CHAR(13)
	    SET ans=$$WAITFOR(3,">")
	    IF +ans'=1 {
	      SET ^ROBOTB(b1,b2)=^ROBOTB(b1,b2)_" err 0 "_ans
	      CONTINUE
	    }
	    ; Run the Convert from base b1 to b2 routine
	    WRITE "DO ",$PIECE(test1,"|"),$CHAR(13)
	    SET bypass=0
	    ; Sometimes we have already read the prompt.
	    FOR i=1:1:1000 {
	      ; Wait for prompt, unless already read.
	      IF bypass'=0 { SET bypass=0 } ELSE {
		SET ans=$$WAITFOR(3,$PIECE(test1,"|",2),">")
		IF +ans'=1 {
		  SET ^ROBOTB(b1,b2)=^ROBOTB(b1,b2)_" err "_i_" "_ans
		  QUIT
		}
	      }
	      ; Give it something to convert.
	      SET before=$$RANDOM(b1)
	      WRITE before,$CHAR(13)
	      SET ans=$$WAITFOR(3,$PIECE(test1,"|",3),
				  $PIECE(test1,"|",2),">")
	      ; Little bad, couldn't convert, do next bypass prompt.
	      IF +ans=2 {
		SET ^ROBOTB(b1,b2,"???",i)=before_"|"_ans
		SET bypass=1 CONTINUE
	      }
	      ; Big bad, move onto next test.
	      IF +ans'=1 {
		SET ^ROBOTB(b1,b2)=^ROBOTB(b1,b2)_" err "_i_" "_ans
		QUIT
	      }
	      ; Read the result.
	      SET ans=$$WAITFOR(3,$CHAR(13)," ",$CHAR(9))
	      IF +ans=0 {
		SET ^ROBOTB(b1,b2)=^ROBOTB(b1,b2)_" err "_i_" "_ans
		QUIT
	      }
	      IF +ans'=1 {
		SET junk=$$WAITFOR(3,$CHAR(13))
		IF +junk=0 {
		  SET ^ROBOTB(b1,b2)=^ROBOTB(b1,b2)_" err "_i_" "_ans
		  QUIT
		}
	      }
	      SET ^ROBOTB(b1,b2,$PIECE(ans,"|",2,*),i)=before
	    }
	    ; Ask for another interpreter prompt.
	    WRITE $CHAR(13)
	    SET ans=$$WAITFOR(3,">")
	    IF +ans'=1 {
	      SET ^ROBOTB(b1,b2)=^ROBOTB(b1,b2)_" err reverse "_ans
	      CONTINUE
	    }
	    ; Run the reverse conversion program.
	    WRITE "DO ",$PIECE(test2,"|"),$CHAR(13)
	    SET after="",bypass=0
	    ; For each result, skipping errors and duplicates.
	    FOR i=10000:1 {
	      SET after=$ORDER(^ROBOTB(b1,b2,after)) QUIT:after=""
	      CONTINUE:after="???"
	      ; Check for duplicate before values.
	      KILL t SET a=""
	      FOR {
		SET lasta=a
		SET a=$ORDER(^ROBOTB(b1,b2,after,a),1,before) QUIT:a=""
		SET t(before)=""
	      }
	      SET before=""
	      FOR n=0:1 { SET before=$ORDER(t(before)) QUIT:before=""  }
	      CONTINUE:n'=1
	      ; Wait for prompt, unless already read.
	      SET ans=$$WAITFOR(3,$PIECE(test2,"|",2),">")
	      IF bypass'=0 { SET bypass=0 } ELSE {
		IF +ans'=1 {
		  SET ^ROBOTB(b1,b2)=^ROBOTB(b1,b2)_" err "_i_" "_ans
		  QUIT
		}
	      }
	      ; Write answer to convert back.
	      WRITE after,$CHAR(13)
	      ; Hopefully read back original value.
	      SET ans=$$WAITFOR(3,$PIECE(test2,"|",3),
				  $PIECE(test2,"|",2),">")
	      ; Little bad, couldn't convert, do next bypass prompt.
	      IF +ans=2 {
		SET ^ROBOTB(b2,b1,"???",i)=after_"|"_ans
		SET bypass=1 CONTINUE
	      }
	      ; Big bad, move onto next test.
	      IF +ans'=1 {
		SET ^ROBOTB(b2,b1)=^ROBOTB(b1,b2)_" err "_i_" "_ans
		QUIT
	      }
	      SET ans=$$WAITFOR(3,$CHAR(13)," ",$CHAR(9))
	      IF +ans=0 {
		SET ^ROBOTB(b2,b1)=^ROBOTB(b1,b2)_" err "_i_" "_ans
		CONTINUE
	      }
	      SET before=$PIECE(ans,"|",2,*)
	      ; Delete entry to acknowledge success
	      IF before=^ROBOTB(b1,b2,after,lasta) {
		KILL ^ROBOTB(b1,b2,after)
	      } ELSE {
		SET ^ROBOTB(b1,b2,after,lasta)=
		    ^ROBOTB(b1,b2,after,lasta)_"|"_before
	      }
	    }
	  SET ^ROBOTB(b1,b2,"!")="Completed in "_
				 ($ZHOROLOG-^ROBOTB(b1,b2))_" sec"
	  }
	}
	WRITE $CHAR(13),"; Normal completion.",$CHAR(13)
	HALT
	; Wait for either of four events:
	; 0. A timeout.
	; 1. Reading the first string.
	; 2. Reading the second string.
	; 3. Reading the third string.
	; Returns the number 0 to 4, a pipe, and everything read before
	; the matching condition.
WAITFOR(timeout,a,b,c) {
	SET endtime=$ZHOROLOG+timeout
	SET la=$SELECT($DATA(a):$LENGTH(a),1:0)
	SET lb=$SELECT($DATA(b):$LENGTH(b),1:0)
	SET lc=$SELECT($DATA(c):$LENGTH(c),1:0)
	SET r=""
	FOR {
	  SET timeleft=endtime-$ZHOROLOG RETURN:timeleft'>0 "0|"_r
	  READ *c:timeleft RETURN:'$TEST "0|"_r
	  SET r=r_$CHAR(c)
	  RETURN:la&&($EXTRACT(r,*-(la-1),*)=a) "1|"_$EXTRACT(r,1,*-la)
	  RETURN:lb&&($EXTRACT(r,*-(lb-1),*)=b) "2|"_$EXTRACT(r,1,*-lb)
	  RETURN:lc&&($EXTRACT(r,*-(lc-1),*)=c) "3|"_$EXTRACT(r,1,*-lc)
	}
}
RANDOM(base) {
	IF $RANDOM(25)=0 {
	  RETURN $PIECE("-0|99|HELP|6.875|1CAT|2DOGS|0111|1234|d|Dead",
		 "|",$RANDOM(10)+1)
	}
	IF base=2 {
	  SET r="",b=2**$RANDOM(4)*8
	  FOR i=1:1:b { SET r=r_$RANDOM(2) }
	  RETURN r
	}
	IF base=8 {
	  SET r="",b=2**$RANDOM(4)*8
	  SET r=$RANDOM(2**(b#3))
	  FOR i=1:1:b\3 { SET r=r_$RANDOM(8) }
	  RETURN r
	}
	IF base=10 {
	  SET b=2**$RANDOM(4)
	  SET r="" FOR i=1:1:b { SET r=r_$CHAR($RANDOM(256)) }
	  RETURN $CASE(b,1:$ASCII(r),
			 2:$ZWASCII(r),
			 4:$ZLASCII(r),
			 8:$ZQASCII(r))
	}
	IF base=16 {
	  SET b=2**$RANDOM(4)*2
	  SET r=""
	  FOR i=1:1:b {
	    SET r=r_$EXTRACT("0123456789ABCDEF",$RANDOM(16)+1)
	  }
	  RETURN r
	}
	ZTRAP "BADBASE"
}
	; This is an extra entry point that will show that ^%XB has a
	; memory leak
	; Start co-process with
	; Session -> Run Co-process...
	; /usr/local/bin/irissession iris "LEAK^ROBOTB"
LEAK() PUBLIC {
	WRITE !,"SET $ZSTORAGE=20",!,"KILL",!
	WRITE "DO ^%XB",!
	FOR i=0:1 {
	   SET ans=$$WAITFOR(3,"Hex #: ") QUIT:+ans'=1
	   WRITE $ZHEX(i),!
	}
	HALT
}
INITMAP(map) PUBLIC {
	; Three parts separated by pipes:
	;  1. Name of routine
	;  2. Prompt (for input)
	;  3. Prefix to result.
	SET map(10,2)="^%DB|Decimal #: |Binary #: "
	SET map(10,8)="^%DOCTAL|Decimal #: |Octal "
	SET map(10,16)="^%DX|Decimal: |Hex: "
	SET map(8,2)="^%OB|Octal #: |Binary #: "
	SET map(8,10)="^%OD|Octal #: |Decimal: "
	SET map(16,2)="^%XB|Hex #: |Binary #: "
	SET map(16,10)="^%XD|Hex: |Decimal: "
	; user routines added for testing symmetry.
	SET map(2,8)="^BO|Binary: |Octal "
	SET map(2,10)="^BD|Binary: |Decimal "
	SET map(2,16)="^BX|Binary: |Hexadecimal "
}

In addition to not having to write the WAITFOR routine, using LAUNCH^ROBOT() simplifies the code, dropping forty-four lines or about 26%.

ROUTINE	ROBOTC
	; SRS 2025-08-11
	; Copyright (c) 2025, InterSystems Corporation
	;
	; This program is free software: you can redistribute it and/or
	; modify it under the terms of the GNU General Public License as
	; published by the Free Software Foundation, either version 3 of
	; the License, or (at your option) any later version.
	;
	; This program is distributed in the hope that it will be
	; useful, but WITHOUT ANY WARRANTY; without even the implied
	; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
	; PURPOSE.  See the GNU General Public License for more details.
	;
	; You should have received a copy of the GNU General Public
	; License along with this program.  If not, see
	; <https://www.gnu.org/licenses/>.
	;
ROBOTC()	PUBLIC {
	KILL map
	do INITMAP(.map)
	; For each pair of bases
	FOR b1=2,8,10,16 {
	  FOR b2=2,8,10,16 {
	    CONTINUE:b1=b2
	    CONTINUE:$DATA(map(b1,b2),test1)=0
	    CONTINUE:$DATA(map(b2,b1),test2)=0
	    SET ^ROBOTB(b1,b2)=$ZHOROLOG
            TRY {
              SET dev=$$LAUNCH^ROBOT($PIECE(test1,"|"),300,31)
              USE dev
              SET bypass=0 ; Sometimes we have already read the prompt.
	      SET i=0 WHILE i<1000 {
	        ; Wait for prompt, unless already read.
	        IF bypass'=0 { SET bypass=0 } ELSE { READ prompt }
		CONTINUE:prompt'[($PIECE(test1,"|",2)_$CHAR(5))
		; Give it something to convert.
	        SET before=$$RANDOM(b1)
	        WRITE before,!
		READ ans
		IF ans[$CHAR(5) {
		  SET prompt=ans,bypass=1
		  SET ^ROBOTC(b1,b2,"???",i)=before_"|"_ans,i=i+1
		  CONTINUE
		}
		SET ans=$PIECE(ans,$PIECE(test1,"|",3),2)
		IF ans="" {
		  SET ^ROBOTC(b1,b2,"???",i)=before,i=i+1
		  CONTINUE
		}
		SET ^ROBOTC(b1,b2,ans,i)=before,i=i+1
	      }
	    } CATCH err {
	      IF err.Data[" ENDOFFILE " { QUIT }
	      THROW err
	    }
	    TRY {
	      SET dev=$$LAUNCH^ROBOT($PIECE(test2,"|"),300,31)
	      USE dev
	      SET bypass=0,after=""
	      SET i=10000 FOR {
		SET after=$ORDER(^ROBOTC(b1,b2,after)) QUIT:after=""
		CONTINUE:after="???"
		KILL t SET a=""
		FOR {
		  SET lasta=a
		  SET a=$ORDER(^ROBOTC(b1,b2,after,a),1,before)
		  QUIT:a=""
		  SET t(before)=""
		}
		SET before=""
		FOR n=0:1 {
		  SET before=$ORDER(t(before)) QUIT:before=""
		}
		CONTINUE:n'=1
		IF bypass'=0 { SET bypass=0 } ELSE { READ prompt }
		CONTINUE:prompt'[($PIECE(test2,"|",2)_$CHAR(5))
		WRITE after,!
		READ ans
		IF ans[$CHAR(5) {
		  SET ^ROBOTC(b1,b2,"???",i)=after_"|"_ans,i=i+1
		  SET bypass=1 CONTINUE
		}
		SET ans=$PIECE(ans,$PIECE(test2,"|",3),2)
		IF ans="" {
		  SET ^ROBOTC(b1,b2,after,i)=before,i=i+1
		  CONTINUE
		}
		IF ans=before { KILL ^ROBOTC(b1,b2,after) CONTINUE }
		SET ^ROBOTC(b1,b2,after,i)=before_"|"_ans
	      }
	    } CATCH err {
	      IF err.Data[" ENDOFFILE " { QUIT }
	      THROW err
	    }
	    SET ^ROBOTC(b1,b2,"!")="Completed in "_
				   ($ZHOROLOG-^ROBOTB(b1,b2))_" sec"
	  }
	}
}
RANDOM(base) {
	IF $RANDOM(25)=0 {
	  RETURN $PIECE("-0|99|HELP|6.875|1CAT|2DOGS|0111|1234|d|Dead",
		 "|",$RANDOM(10)+1)
	}
	IF base=2 {
	  SET r="",b=2**$RANDOM(4)*8
	  FOR i=1:1:b { SET r=r_$RANDOM(2) }
	  RETURN r
	}
	IF base=8 {
	  SET r="",b=2**$RANDOM(4)*8
	  SET r=$RANDOM(2**(b#3))
	  FOR i=1:1:b\3 { SET r=r_$RANDOM(8) }
	  RETURN r
	}
	IF base=10 {
	  SET b=2**$RANDOM(4)
	  SET r="" FOR i=1:1:b { SET r=r_$CHAR($RANDOM(256)) }
	  RETURN $CASE(b,1:$ASCII(r),
			 2:$ZWASCII(r),
			 4:$ZLASCII(r),
			 8:$ZQASCII(r))
	}
	IF base=16 {
	  SET b=2**$RANDOM(4)*2
	  SET r=""
	  FOR i=1:1:b {
	    SET r=r_$EXTRACT("0123456789ABCDEF",$RANDOM(16)+1)
	  }
	  RETURN r
	}
	ZTRAP "BADBASE"
}
INITMAP(map) PUBLIC {
	; Three parts separated by pipes:
	;  1. Name of routine
	;  2. Prompt (for input)
	;  3. Prefix to result.
	SET map(10,2)="^%DB|Decimal #: |Binary #: "
	SET map(10,8)="^%DOCTAL|Decimal #: |Octal "
	SET map(10,16)="^%DX|Decimal: |Hex: "
	SET map(8,2)="^%OB|Octal #: |Binary #: "
	SET map(8,10)="^%OD|Octal #: |Decimal: "
	SET map(16,2)="^%XB|Hex #: |Binary #: "
	SET map(16,10)="^%XD|Hex: |Decimal: "
	; user routines added for testing symmetry.
	SET map(2,8)="^BO|Binary: |Octal "
	SET map(2,10)="^BD|Binary: |Decimal "
	SET map(2,16)="^BX|Binary: |Hexadecimal "
}

Here is LAUCH^ROBOT for reference:

ROUTINE	ROBOT
ROBOT	; SRS 2025-08-11
    ; ------------------------------------------------------------ ;
    ; LAUNCH^ROBOT -- Robotic control of another IRIS JOB.         ;
    ; Copyright (c) 2025, InterSystems Corporation.                ;
    ;                                                              ;
    ; This program is free software: you can redistribute it       ;
    ; and/or modify it under the terms of the GNU General Public   ;
    ; License as published by the Free Software Foundation, either ;
    ; version 3 of the License, or (at your option) any later      ;
    ; version.                                                     ;
    ;                                                              ;
    ; This program is distributed in the hope that it will be      ;
    ; useful, but WITHOUT ANY WARRANTY; without even the implied   ;
    ; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR      ;
    ; PURPOSE.  See the GNU General Public License for more        ;
    ; details.                                                     ;
    ;                                                              ;
    ; You should have received a copy of the GNU General Public    ;
    ; License along with this program.  If not, see                ;
    ; <https://www.gnu.org/licenses/>.                             ;
    ;                                                              ;
    ; ------------------------------------------------------------ ;
    ; Launch a legacy ObjectScript (née MUMPS) routine under       ;
    ; robotic control.                                             ;
    ;                                                              ;
    ;   TRY {                                                      ;
    ;     SET dev=$$LAUNCH^ROBOT(entry,idle,debug).                ;
    ;     USE dev READ outputfromroutine                           ;
    ;     USE dev WRITE inputtoroutine                             ;
    ;   }                                                          ;
    ;   CATCH {                                                    ;
    ;     USE dev WRITE /KILL CLOSE dev                            ;
    ;   }                                                          ;
    ; ------------------------------------------------------------ ;
    ; This code relies on these process private globals:           ;
    ; ^||ROBOT("i") - idle timeout.                                ;
    ; ^||ROBOT("o")- initial value ##CLASS(%Device).ReDirectIO().  ;
    ; ^||ROBOT("p") - $JOB value of other process.                 ;
    ; ^||ROBOT("t") - typeahead buffer.                            ;
    ; ^||ROBOT("d") - debug flag.                                  ;
    ; ^||ROBOT("e") - echo flag.                                   ;
    ; ^||ROBOT("c") - Am I the controlled process?                 ;
    ; ------------------------------------------------------------ ;
    ; Debugging macro, writes debug messages to ^ROBOTDBG if       ;
    ; $$LAUNCH^DEUBG() is called with third argument < 0.          ;
#DEFINE %DBG(%x) SET:^||ROBOT("d") ^ROBOTDBG(               ##CONTINUE
                    ^||ROBOT("d"),                          ##CONTINUE
                    $INCREMENT(^ROBOTDBG(^||ROBOT("d"))))=  ##CONTINUE
                    $ZDATETIME($HOROLOG,3,1)_" "_^||ROBOT("c")_" "_%x
#DEFINE RED(%x) IF ^||ROBOT("e")>0 {                        ##CONTINUE
                    SET %=$IO USE $PRINCIPAL                ##CONTINUE
                    WRITE $CHAR(27)_"["_^||ROBOT("e")_"m"   ##CONTINUE
                    WRITE %x                                ##CONTINUE
                    WRITE $CHAR(27)_"[m"                    ##CONTINUE
                    USE %                                   ##CONTINUE
                }
#DEFINE BLK(%x) IF ^||ROBOT("e")>0 {                        ##CONTINUE
                    SET %=$IO USE $PRINCIPAL                ##CONTINUE
                    WRITE %x                                ##CONTINUE
                    USE %
                }
    ; ------------------------------------------------------------ ;
    ;   SET dev=$$LAUNCH^ROBOT(entry,idle,echo)                    ;
    ;                                                              ;
    ; Spawns a JOB to DO entry with all I/O redirected to the      ;
    ; calling process where output from the controlled process can ;
    ; be READ from the returned device, and input can be send to   ;
    ; the controlled process with WRITE. Note: The controlled      ;
    ; process must confine is I/O to a simple roll-and-scroll      ;
    ; interface. A failure in the controlled process will signal   ;
    ; an <ENDOFFILE> in the calling process on the next READ, so   ;
    ; the call and robot logic should be in a TRY {} CATCH {}      ;
    ; block.                                                       ;
    ;                                                              ;
    ; This routines logic adds two characters to the communication ;
    ; from the controlled process to to calling process. An ENQ    ;
    ; ($CHAR(5)) signals the controlled process wants to read      ;
    ; something. Thus if the calling process READs a line ending   ;
    ; in $CHAR(5), it knows the rest of what it read is a prompt.  ;
    ; an EOT ($CHAR(4) indicates the controlled process has        ;
    ; encountered a fatal error.                                   ;
    ;                                                              ;
    ; The idle argument is a timeout in seconds. If the            ;
    ; controlling process ignores the controlled process for idle  ;
    ; seconds while the controlled process is waiting on a read    ;
    ; the controlled process will timeout and die, leading to and  ;
    ; <ENDOFFILE> error for the controlling process, should it     ;
    ; ever decide to read or write data to the controlled process. ;
    ;                                                              ;
    ; The echo argument if absent or zero, performs no local       ;
    ; echoing or debugging. If the value is negative, debug        ;
    ; entries are recorded in the ^ROBOTDBG global, while a        ;
    ; positive value will cause the dialog to echo to $PRINCIPAL   ;
    ; with the communication between the controlling process and   ;
    ; controlled process appearing between <ESC>[<echo>m and       ;
    ; <ESC>[0m. values of debug that make the most sense are 1 for ;
    ;  bold, and 31 for red.                                       ;
    ; ------------------------------------------------------------ ;
LAUNCH(entry,idle,echo) PUBLIC {
    KILL ^||ROBOT
    SET idle=$GET(idle,3600)
    SET echo=$GET(echo,0)
    SET ^||ROBOT("i")=idle
    SET ^||ROBOT("d")=$SELECT(+echo<0:$JOB,1:0)
    SET ^||ROBOT("e")=$SELECT(+echo>0:echo,1:0)
    SET dev=##CLASS(%Device).GetNullDevice()
    OPEN dev:::("^"_$ZNAME)
    SET old=$IO USE dev
    SET ^||ROBOT("o")=##CLASS(%Device).ReDirectIO(1)
    USE old
    JOB job(entry,$JOB,idle,+echo)
    SET ^||ROBOT("p")=$ZCHILD
    SET ^||ROBOT("t")=""
    SET ^||ROBOT("c")=0
    QUIT dev
}
    ; ------------------------------------------------------------ ;
    ;   JOB job(entry,parent,idle,echo)                            ;
    ;                                                              ;
    ; This is the wrapper under which the child process runs. Do   ;
    ; not call this from external code. It is for use only by      ;
    ; LAUNCH^ROBOT().                                              ;
    ; ------------------------------------------------------------ ;
job(entry,robot,idle,echo) PUBLIC {
    TRY {
      KILL ^||ROBOT
      SET ^||ROBOT("p")=robot
      SET ^||ROBOT("i")=idle
      SET ^||ROBOT("d")=$SELECT(echo<0:echo,1:0)
      SET ^||ROBOT("e")=0
      SET dev=##CLASS(%Device).GetNullDevice()
      OPEN dev:::("^"_$ZNAME)
      USE dev
      SET ^||ROBOT("o")=##CLASS(%Device).ReDirectIO(1)
      SET ok=##CLASS(%Device).ChangePrincipal()
      SET ^||ROBOT("t")=""
      SET ^||ROBOT("c")=1
      DO:ok @entry
    }
    CATCH err {
      SET x=$$DumpObjectToArray^%occRun(err,.error)
      IF ^||ROBOT("d") {
        FOR ii=1:1:error($GET(error,1)) {
          $$$DBG(error($GET(error,1),ii))
        }
      }
      DO LOG^%ETN
    }
    WRITE *4
    HALT
}
    ; ------------------------------------------------------------ ;
    ; noread() is called when the controlled process can't signal  ;
    ; the controlling process that it is awaiting input. Since the ;
    ; controlling process is presumably gone, we just log the      ;
    ; error and halt.                                              ;
    ; ------------------------------------------------------------ ;
noread() {
    $$$DBG("shutdown during read")
    IF ^||ROBOT("d") {
      FOR ii=$STACK(-1):-1:0 {
        $$$DBG(ii_" "_$STACK(ii,"PLACE")_"~"_$STACK(ii,"MCODE"))
      }
    }
    DO LOG^%ETN
    HALT
}
    ; ------------------------------------------------------------ ;
    ; nowrite() is called when the either process can't read from  ;
    ; the other process. If we are the controlled process we call  ;
    ; LOG^%ETN so that a human can review the error trap to try    ;
    ; to determine what went wrong. If we are the controlling      ;
    ; process we signal an <ENDOFFILE> error.                      ;
    ; ------------------------------------------------------------ ;
nowrite() {
    $$$DBG("shutdown during write")
    IF ^||ROBOT("d") {
      FOR ii=$STACK(-1):-1:0 {
        $$$DBG(ii_" "_$STACK(ii,"PLACE")_"~"_$STACK(ii,"MCODE"))
      }
    }
    IF ^||ROBOT("c") { DO LOG^%ETN HALT  }
    SET loc=$STACK($STACK-1,"PLACE")
    THROW ##CLASS(%Exception.General).%New("ENDOFFILE",42,loc)
}
    ; ------------------------------------------------------------ ;
    ; The I/O thunks follow. They pass READs to WRITEs and WRITEs  ;
    ; to READs. Any partial READ is saved in ^||ROBOT("t")         ;
    ; between calls.                                               ;
    ; ------------------------------------------------------------ ;
    ; SET var=$$rstr(len,timeout)                                  ;
    ;       implements                                             ;
    ; READ var#len:timeout                                         ;
    ; ------------------------------------------------------------ ;
rstr(len,timeout) PUBLIC {
    $$$DBG("rstr begin")
    ; The controlled process signals it has a read with an ENQ.
    IF ^||ROBOT("c") {
      IF $SYSTEM.Event.Signal(^||ROBOT("p"),$CHAR(5))=0 {
        RETURN:$$noread()
      }
    }
    SET len=$GET(len,32000)
    SET endtime=$ZHOROLOG+$GET(timeout,^||ROBOT("i"))
    FOR {
      ; Search for the first ENQ, LF, or EOT.
      SET case=0
      SET e1=$FIND(^||ROBOT("t"),$CHAR(5))
      SET e2=$FIND(^||ROBOT("t"),$CHAR(10))
      SET e3=$FIND(^||ROBOT("t"),$CHAR(4))
      IF e1,e1<len { SET case=1,len=e1-1 }
      IF e2,e2<len { SET case=2,len=e2-1 }
      IF e3,e3<len { SET case=3,len=e3-1 }
      IF case=0 {
        IF $LENGTH(^||ROBOT("t"))'<len {
          SET result=$EXTRACT(^||ROBOT("t"),1,len)
          SET ^||ROBOT("t")=$EXTRACT(^||ROBOT("t"),len+1,*)
          $$$DBG("rstr case 0(#"_len_") "_result)
          $$$BLK(result)
          RETURN result
        }
        SET timeleft=endtime-$ZHOROLOG
        SET msg=$SYSTEM.Event.WaitMsg("",timeleft)
        IF $LIST(msg)'=0 {
          SET ^||ROBOT("t")=^||ROBOT("t")_$LIST(msg,2)
          CONTINUE
        }
        IF $ZHOROLOG>endtime {
          $$$DBG("rstr <TIMEOUT>")
          DO $SYSTEM.Process.IODollarTest(0)
          RETURN ""
        }
        SET loc=$STACK($STACK-1,"PLACE")
        $$$DBG("rstr error @ "_loc)
        $$$BLK("<ENDOFFILE>")
        THROW ##CLASS(%Exception.General).%New("ENDOFFILE",42,loc)
      }
      IF case=1 {
        SET result=$EXTRACT(^||ROBOT("t"),1,len)
        SET ^||ROBOT("t")=$EXTRACT(^||ROBOT("t"),len+1,*)
        $$$DBG("rstr case 1(ENQ) "_result)
        $$$BLK(result)
        RETURN result
      }
      IF case=2 {
        SET result=$EXTRACT(^||ROBOT("t"),1,len-1)
        SET ^||ROBOT("t")=$EXTRACT(^||ROBOT("t"),len+1,*)
        $$$DBG("rstr case 2(LF) "_result)
        $$$BLK(result)
        $$$BLK(!)
        RETURN result
      }
      IF case=3 {
        IF ^||ROBOT("c") { HALT }
        SET ^||ROBOT("t")=$EXTRACT(^||ROBOT("t"),len+1,*)
        $$$DBG("rstr case 3(EOT)")
        $$$BLK("^D")
        RETURN $CHAR(4)
      }
    }
}
    ; ------------------------------------------------------------ ;
    ; SET var=$$rchr(timeout)                                      ;
    ;       implements                                             ;
    ; READ *var:timeout                                            ;
    ; ------------------------------------------------------------ ;
rchr(timeout) PUBLIC {
    $$$DBG("rchr begin")
    IF ^||ROBOT("c") {
      IF $SYSTEM.Event.Signal(^||ROBOT("p"),$CHAR(5))=0 {
        RETURN:$$noread()
      }
    }
    SET endtime=$ZHOROLOG+$GET(timeout,^||ROBOT("i"))
    FOR {
      QUIT:$LENGTH(^||ROBOT("t"))>0
      SET timeleft=endtime-$ZHOROLOG
      SET msg=$SYSTEM.Event.WaitMsg("",timeleft)
      IF $LIST(msg)=0 {
        IF $ZHROLOG>endtime {
          $$$DBG("rchr <TIMEOUT>")
          DO $SYSTEM.Process.IODollarTest(0)
          RETURN 0
        }
        SET loc=$STACK($STACK-1,"PLACE")
        $$$DBG("rchrk errror @ "_loc)
        $$$BLK("<ENDOFFILE>")
        THROW ##CLASS(%Exception.General).%New("ENDOFFILE",42,loc)
      }
      SET ^||ROBOT("t")=^||ROBOT("t")_$LIST(msg,2)
    }
    SET result=$ASCII(^||ROBOT("t"))
    SET ^||ROBOT("t")=$EXTRACT(^||ROBOT("t"),2,*)
    $$$DBG("rchr "_result)
    $$$BLK($CHAR(result))
    RETURN result
}
    ; ------------------------------------------------------------ ;
    ; DO wstr(str)                                                 ;
    ;       implements                                             ;
    ; WRITE str                                                    ;
    ; ------------------------------------------------------------ ;
wstr(str) PUBLIC {
    $$$DBG("wstr "_str)
    $$$RED(str)
    SET str=$TRANSLATE(str,$CHAR(5,21))
    RETURN:$LENGTH(str)=0
    RETURN:$SYSTEM.Event.Signal(^||ROBOT("p"),str)
    $$$DBG("wstr shutdown")
    DO nowrite()
}
    ; ------------------------------------------------------------ ;
    ; DO wchr(chr)                                                 ;
    ;                                                              ;
    ; WRITE *chr                                                   ;
    ; ------------------------------------------------------------ ;
wchr(chr) PUBLIC {
    $$$DBG("wchr "_chr)
    $$$RED($CHAR(chr))
    RETURN:chr=5  RETURN:chr=21
    RETURN:$SYSTEM.Event.Signal(^||ROBOT("p"),$CHAR(chr))
    $$$DBG("wchr shutdown")
    DO nowrite()
}
    ; ------------------------------------------------------------ ;
    ; DO wtab(col)                                                 ;
    ;       implements                                             ;
    ; WRITE ?col                                                   ;
    ; ------------------------------------------------------------ ;
wtab(col) PUBLIC {
    $$$DBG("wtab "_col)
    $$$RED(?col)
    SET col=col-$X RETURN:col'>0  SET str=$JUSTIFY("",col)
    RETURN:$SYSTEM.Event.Signal(^||ROBOT("p"),str)
    $$$DBG("wtab shutdown")
    DO nowrite()
}
    ; ------------------------------------------------------------ ;
    : DO wnl                                                       ;
    ;       implements                                             ;
    ; WRITE !                                                      ;
    ; ------------------------------------------------------------ ;
wnl() PUBLIC {
    $$$DBG("wnl")
    ; For a local Unicode version, echo a LEFTWARDS ARROW WITH HOOK.
    IF $SYSTEM.Version.IsUnicode() { $$$RED($CHAR(8617)) }
    RETURN:$SYSTEM.Event.Signal(^||ROBOT("p"),$CHAR(10))
    $$$DBG("wnl shutdown")
    DO nowrite()
}
    ; ------------------------------------------------------------ ;
    ; DO wff                                                       ;
    ;       implements                                             ;
    ; WRITE #                                                      ;
    ; ------------------------------------------------------------ ;
wff() PUBLIC {
    $$$DBG("wff")
    ; For a local Unicode version, echo a SYMBOL FOR FORM FEED.
    IF $SYSTEM.Version.IsUnicode() { $$$RED($CHAR(9228)) }
    RETURN:$SYSTEM.Event.Signal(^||ROBOT("p"),$CHAR(10,12))
    $$$DBG("wff shutdown")
    DO nowrite()
}
    ; ------------------------------------------------------------ ;
    : DO KILL                                                      ;
    ;       impements                                              ;
    ; WRITE /KILL                                                  ;
    ; This provides a way for the controlling process to terminate ;
    ; the controlled process. First politely, and then if          ;
    ; necessary, with more force.                                  ;
    ; ------------------------------------------------------------ ;
KILL() PUBLIC {
    $$$DBG("/KILL")
    RETURN:^||ROBOT("c")
    RETURN:$SYSTEM.Event.Signal(^||ROBOT("p"),$CHAR(21))
    HANG 1
    IF $SYSTEM.Process.Terminate(^||ROBOT("p"))
    RETURN
}

Finally, here are the three missing base conversion routines. They are written in traditional MUMPS style so they can be tested as far back as InterSystems M/11+.

ROUTINE	BD [Type=INT]
BD	; BINARY TO DECIMAL CONVERSION
	N %BD
ASK	R !,"Binary: ",%BD Q:%BD=""
	D INT W ?19," Decimal ",%BD G ASK
INT	I $TR(%BD,"01")'="" S %BD="???" Q
	N X S X=-$E(%BD)
	N I F I=2:1:$L(%BD) S X=X*2+$E(%BD,I)
	S:X+1=X X="???" S %BD=X Q
ROUTINE	BO [Type=INT]
BO	; BINARY TO OCTAL CONVERSION
	N %BO
ASK	R !,"Binary: ",%BO Q:%BO=""
	D INT W ?19," Octal ",%BO G ASK
INT	I $TR(%BO,"01")'="" S %BO="???" Q
	N X,L S X=%BO,L=$L(X)-1#3+1,%BO=$E(X,1,L)#8
	F  Q:L'<$L(X)  S %BO=%BO_($E(X,L+1,L+3)#8),L=L+3
	Q
ROUTINE	BX [Type=INT]
BX	; BINARY TO HEXADECIMAL CONVESION
	N %BX
ASK	R !,"Binary: ",%BX Q:%BX=""
	D INT W ?19," Hexadecimal ",%BX G ASK
INT	I $TR(%BX,"01")'="" S %BX="???" Q
	N X,Q S X=$L(%BX)-1#4+1,Q=$TR($J($E(%BX,1,X),4)," ","0")
	N V,C S V="",C=$R(2)*32 F  D DIG Q:X>$L(%BX)  S Q=$E(%BX,X-3,X)
	S %BX=V Q
DIG	S:+$E(Q,3) Q=1-$E(Q,1)_$E(Q,2,4)
	S Q=Q#16 S:Q>9 Q=$C(Q+55+C) S V=V_Q,X=X+4 Q
Discussion (0)1
Log in or sign up to continue