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®.
^ROBOTB - relies on an external tool.^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
SET $ZTRAP="^%ETN"
KILL map,^ROBOTB
do INITMAP(.map)
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
WRITE $CHAR(13)
SET ans=$$WAITFOR(3,">")
IF +ans'=1 {
SET ^ROBOTB(b1,b2)=^ROBOTB(b1,b2)_" err 0 "_ans
CONTINUE
}
WRITE "DO ",$PIECE(test1,"|"),$CHAR(13)
SET bypass=0
FOR i=1:1:1000 {
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
}
}
SET before=$$RANDOM(b1)
WRITE before,$CHAR(13)
SET ans=$$WAITFOR(3,$PIECE(test1,"|",3),
$PIECE(test1,"|",2),">")
IF +ans=2 {
SET ^ROBOTB(b1,b2,"???",i)=before_"|"_ans
SET bypass=1 CONTINUE
}
IF +ans'=1 {
SET ^ROBOTB(b1,b2)=^ROBOTB(b1,b2)_" err "_i_" "_ans
QUIT
}
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
}
WRITE $CHAR(13)
SET ans=$$WAITFOR(3,">")
IF +ans'=1 {
SET ^ROBOTB(b1,b2)=^ROBOTB(b1,b2)_" err reverse "_ans
CONTINUE
}
WRITE "DO ",$PIECE(test2,"|"),$CHAR(13)
SET after="",bypass=0
FOR i=10000:1 {
SET after=$ORDER(^ROBOTB(b1,b2,after)) QUIT:after=""
CONTINUE:after="???"
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
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 after,$CHAR(13)
SET ans=$$WAITFOR(3,$PIECE(test2,"|",3),
$PIECE(test2,"|",2),">")
IF +ans=2 {
SET ^ROBOTB(b2,b1,"???",i)=after_"|"_ans
SET bypass=1 CONTINUE
}
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,*)
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
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"
}
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 {
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: "
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
ROBOTC() PUBLIC {
KILL map
do INITMAP(.map)
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
SET i=0 WHILE i<1000 {
IF bypass'=0 { SET bypass=0 } ELSE { READ prompt }
CONTINUE:prompt'[($PIECE(test1,"|",2)_$CHAR(5))
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 {
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: "
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
#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 %
}
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(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() {
$$$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() {
$$$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)
}
rstr(len,timeout) PUBLIC {
$$$DBG("rstr begin")
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 {
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)
}
}
}
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
}
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()
}
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()
}
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
wnl() PUBLIC {
$$$DBG("wnl")
IF $SYSTEM.Version.IsUnicode() { $$$RED($CHAR(8617)) }
RETURN:$SYSTEM.Event.Signal(^||ROBOT("p"),$CHAR(10))
$$$DBG("wnl shutdown")
DO nowrite()
}
wff() PUBLIC {
$$$DBG("wff")
IF $SYSTEM.Version.IsUnicode() { $$$RED($CHAR(9228)) }
RETURN:$SYSTEM.Event.Signal(^||ROBOT("p"),$CHAR(10,12))
$$$DBG("wff shutdown")
DO nowrite()
}
: DO KILL
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
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
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
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
