$CONTROL USLINIT,MAP,ERRORS=5

<<\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\>>
<<                                                                 >>
<< Program: DROID                                                  >>
<<                                                                 >>
<< Authors: Robert Yazhari, Reichhold Chemicals, Tacoma, WA        >>
<<          Joshua Kors,                                           >>
<<          Craig Fransen                                          >>
<<                                                                 >>
<<                                                                 >>
<<  Source: DOSS.DROID.USER                                        >>
<<                                                                 >>
<< Version: A.00 (01/01/84)                                        >>
<<                                                                 >>
<< Prepare:                                                        >>
<<                                                                 >>
<<    Desc: Droid Operating System ...                             >>
<<                                                                 >>
<<                                                                 >>
<<                                                                 >>
<<                                                                 >>
<<                                                                 >>
<<                                                                 >>
<< Modifications:                                                  >>
<<                                                                 >>
<< A.02 05/22/84 CSF Changed number of degrees in circle to 3600.  >>
<< A.03 07/12/84 JGK Implemented tournament play.                  >>
<<                                                                 >>
<<                                                                 >>
<<                                                                 >>
<<                                                                 >>
<<                                                                 >>
<<\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\>>

$PAGE "DROID ** Variable Declarations         "
BEGIN

  ENTRY TOURNEY,TEST;

  EQUATE
     COST'PAGE'IN            = 1,
     COST'RADAR              = 12,
     COST'TRAN               = 6,
     DAMAGE'REG              = 29,
     DIST'PER'UPDATE         = 100,
     ESC                     = 27,
     MAXDROIDS               = 7,
     MAXREG                  = 64,
     MAXSTACK                = 500,
     MAXNAME                 = 4,
     MAX'DEAD'LOCK           = 900,
     MAX'COL                 = 64,
     MAX'FREQ                = 99,
     MAX'ROW                 = 22,
     MAX'SPEED               = 10000,
     MAX'TEMP                = 100,
     MAX'X                   = 6400,
     MAX'Y                   = 3520,
     PAGELEN                 = 128,
     RADAR'REG               = 28,
     RANDOM'REG              = 32,
     SHOT'REG                = 27,
     TURRET'REG              = 26,
     SHOT'TEMP               = 1000,
     STACK'OVERFLOW          = 1,
     STACK'UNDERFLOW         = 2,
     INVALID'INSTRUCTION     = 3,
     INVALID'REGISTER        = 4,
     DIV'BY'ZERO             = 5,
     INTEGER'OVERFLOW        = 6,
     SWAP'POINT              = 30,
     WIDTH'REG               = 33,
     X'REG                   = 23,
     Y'REG                   = 24;

  DEFINE BLANK'BUF           = BEGIN
                                 BUF:="  "; MOVE BUF(1):=BUF,(39);
                                 END#,
         BLANK'MSG           = BEGIN
                                 MSG :="  ";
                                 MOVE MSG(1):=MSG,(49);
                                 END#,
         DISPLAY             = BEGIN
                                 TOS := @MSG;
                                 MOVE B'MSG := #,
         EOD                 =   ,2;
                                 TOS:=-(TOS-@B'MSG);
                                 IF NOLIST THEN BEGIN
                                    DEL;DEL;
                                    END
                                 ELSE PRINT(*,*,0);
                                 END#,
         ASK                 =   ,2;
                                 TOS:=-(TOS-@B'MSG);
                                 IF NOLIST THEN BEGIN
                                    DEL;DEL;
                                    END
                                 ELSE PRINT(*,*,%320);
                                 END#,
         BEEP                = DISPLAY (7) ASK#,
         CONCAT              = ,2;MOVE*:=#,
         LINE'FEED           = PRINT(MSG,0,0)#,
         ADDRESS'CURSOR      = ESC,"&a"#,
         CLEAR'DISPLAY       = ESC,"J"#,
         ENH'DISPLAY         = ESC,"&d"#,
         ENH'HI              = ESC,"&dJ"#,
         ENH'HIU             = ESC,"&dN"#,
         ENH'I               = ESC,"&dB"#,
         ENH'IU              = ESC,"&dF"#,
         ENH'B               = ESC,"&dA"#,
         ENH'U               = ESC,"&dD"#,
         END'ENH             = ESC,"&d@"#,
         FMT'MODE'ON         = ESC,"W"#,
         FMT'MODE'OFF        = ESC,"X"#,
         HOME'CURSOR         = ESC,"H"#,
         DOWN'CURSOR         = ESC,"F"#,
         TEST'DEBUG          = SAVE'PARM.(13:1)#,
         NOISY               = SAVE'PARM.(14:1)#,
         NOLIST              = SAVE'PARM.(15:1)#,
         SESSION             = MODE.(15:1)#;

  DEFINE C'INDIRECT         = CODE.(0:1)#,
         C'GROUP            = CODE.(1:3)#,
         C'INSTR            = CODE.(4:6)#,
         C'OPRND            = CODE.(10:6)#;

  DEFINE RD'X               = RD'REG(DROID*MAXREG+23)#,
         RD'Y               = RD'REG(DROID*MAXREG+24)#,
         RD'TURRET          = RD'REG(DROID*MAXREG+26)#,
         WR'TURRET          = WR'REG(DROID*MAXREG+26)#,
         RD'SHOT            = RD'REG(DROID*MAXREG+27)#,
         WR'SHOT            = WR'REG(DROID*MAXREG+27)#,
         RD'RADAR           = RD'REG(DROID*MAXREG+28)#,
         WR'RADAR           = WR'REG(DROID*MAXREG+28)#,
         RD'DAMAGE          = I'RD'REG(DROID*MAXREG+29)#,
         WR'DAMAGE          = WR'REG(DROID*MAXREG+29)#,
         RD'SPEEDX          = I'RD'REG(DROID*MAXREG+30)#,
         WR'SPEEDX          = I'WR'REG(DROID*MAXREG+30)#,
         RD'SPEEDY          = I'RD'REG(DROID*MAXREG+31)#,
         WR'SPEEDY          = I'WR'REG(DROID*MAXREG+31)#,
         RD'RANDOM          = RD'REG(DROID*MAXREG+32)#,
         WR'RANDOM          = WR'REG(DROID*MAXREG+32)#,
         RD'WIDTH           = RD'REG(DROID*MAXREG+33)#,
         WR'WIDTH           = WR'REG(DROID*MAXREG+33)#;

  INTEGER
     BENCH'DROID := 0,
     CURR'PAGE,
     DEAD'DROIDS:=0,
     DEAD'LOCK:=0,
     DROID,
     DROID'PAGE,
     I,
     LAST'DROID,
     LIMIT,
     MOST'INJURED,
     NEW'SCREEN'ROW,
     NEW'SCREEN'COL,
     NUM'DROIDS,
     OLD'SCREEN'ROW,
     OLD'SCREEN'COL,
     PAGE'OFFSET,
     TOTAL'DEADLOCKS := 0;

  LOGICAL
     CODE,
     CTL'Y := FALSE,
     FINISHED,
     MODE,
     NO'BATTLES,
     RUN'PARM=Q-4,
     SAVE'NO'BATTLES,
     SAVE'PARM,
     SWAP,
     TEMP,
     TEST'BENCH := FALSE,
     UNITS'PER'ROW,
     UNITS'PER'COL,
     WRITE'MODE := FALSE;

  DOUBLE
     D'INSTR'EXECUTED,
     D'START'SECONDS,
     D'END'SECONDS;

  REAL
     R'DAMAGE'FACTOR := .2,
     R'DAMAGE'RADIUS := 100.,
     R'MAX'SPEED := 10000.,
     R'SEED := .5;

  INTEGER ARRAY
        OLD'RADR'SLICE(0:MAXDROIDS),
        OLD'TURR'SLICE(0:MAXDROIDS);

  ARRAY BATTLES'WON(0:MAXDROIDS) := 0,0,0,0,0,0,0;
  ARRAY TOT'DAM'INCURRED(0:MAXDROIDS) := 0,0,0,0,0,0,0;
  ARRAY TOT'DAM'INFLICTED(0:MAXDROIDS) := 0,0,0,0,0,0,0;
  ARRAY BUF(0:39),
        DEAD(0:MAXDROIDS),
        MSG(0:49),
        NAME(0:MAXDROIDS*MAXNAME),
        PAGE(0:MAXDROIDS*PAGELEN),
        PROGFILE(0:MAXDROIDS),
        STACK(0:MAXDROIDS*MAXSTACK),
        WR'REG(0:MAXDROIDS*MAXREG),
        RD'REG(0:MAXDROIDS*MAXREG),
        P'REG(0:MAXDROIDS),
        S'REG(0:MAXDROIDS),
        LPAGE(0:MAXDROIDS),
        RANKING(0:MAXDROIDS*MAXDROIDS),
        REM'DAMAGE(0:MAXDROIDS),
        SCREEN(0:((MAX'COL+1)*(MAX'ROW+1))/2),
        SEDS(0:MAX'FREQ),
        ROW(0:0),
        COL(0:0);

  ARRAY REG'COL(0:MAXREG) := 13(66),13(74),66,66,74,66,74,74,66,
                             74,74,74,74,74,66,66,66,66;
  ARRAY REG'ROW(0:MAXREG) := 1,2,3,4,5,6,7,8,9,10,11,12,13,
                             1,2,3,4,5,6,7,8,9,10,11,12,13,
                             16,17,14,15,15,16,14,17,22,21,20,19,
                             19,20,21,22;
  ARRAY DAMAGE'ROW(0:MAXDROIDS) := 1,4,7,10,13,16,19;
  ARRAY DAMAGE'COL(0:MAXDROIDS) := 7(76);
  INTEGER ARRAY XOFF(0:7) := 1,1,0,-1,-1,-1,0,1;
  INTEGER ARRAY YOFF(0:7) := 0,-1,-1,-1,0,1,1,1;

  BYTE ARRAY B'BUF(*)=BUF,
             B'MSG(*)=MSG,
             B'NAME(*)=NAME,
             B'ROW(*) = ROW,
             B'COL(*) = COL,
             B'SCREEN(*)=SCREEN;

  INTEGER ARRAY I'BATTLES'WON(*)=BATTLES'WON,
                I'STACK(*)=STACK,
                I'P'REG(*)=P'REG,
                I'REM'DAMAGE(*)=REM'DAMAGE,
                I'RD'REG(*)=RD'REG,
                I'WR'REG(*)=WR'REG,
                I'S'REG(*)=S'REG,
                I'LPAGE(*)=LPAGE;

  INTRINSIC READ,FOPEN,PRINT,PRINT'FILE'INFO,TERMINATE,
            FREADDIR,SIN,COS,QUIT,PAUSE,ASCII,BINARY,DEBUG,
            WHO,DASCII,TIMER,RESETCONTROL,XCONTRAP,PROCTIME;
$PAGE "DROID ** Option Forward Declarations"
REAL PROCEDURE ARCTAN'(X);
  VALUE X;
  REAL X;
  OPTION FORWARD;
REAL PROCEDURE COS'(X);
  VALUE X;
  REAL X;
  OPTION FORWARD;
PROCEDURE DISPLAY'DAMAGE;
  OPTION FORWARD;
PROCEDURE DISPLAY'INSTR;
  OPTION FORWARD;
PROCEDURE DISPLAY'REMOTE'DAMAGE(DROID);
  VALUE DROID;
  INTEGER DROID;
  OPTION FORWARD;
PROCEDURE DISPLAY'STACK;
  OPTION FORWARD;
PROCEDURE DISPLAY'SYS'REG;
  OPTION FORWARD;
PROCEDURE DISPLAY'VALUE (ROW,COL,VAL);
  VALUE ROW,COL,VAL;
  INTEGER ROW,COL,VAL;
  OPTION FORWARD;
PROCEDURE DO'RADAR (DROID);
  VALUE DROID;
  INTEGER DROID;
  OPTION FORWARD;
PROCEDURE DO'SHOOT (DROID);
  VALUE DROID;
  INTEGER DROID;
  OPTION FORWARD;
PROCEDURE DRAW'SCREEN (NUM'DROIDS);
   VALUE NUM'DROIDS;
   INTEGER NUM'DROIDS;
  OPTION FORWARD;
BYTE PROCEDURE GET'CHAR(ROW,COL);
  VALUE ROW,COL;
  INTEGER ROW,COL;
  OPTION FORWARD;
PROCEDURE INITIALIZE;
  OPTION FORWARD;
PROCEDURE KILL (DROID);
  VALUE DROID;
  INTEGER DROID;
  OPTION FORWARD;
LOGICAL PROCEDURE LOADOK(CODE);
  VALUE CODE;
  LOGICAL CODE;
  OPTION FORWARD;
PROCEDURE OPEN'PROGFILES (NUM'DROIDS);
  INTEGER NUM'DROIDS;
  OPTION FORWARD;
PROCEDURE POS'CUR (L'ROW,L'COL);
   VALUE L'ROW,L'COL;
   LOGICAL L'ROW,L'COL;
  OPTION FORWARD;
PROCEDURE PUTCHAR (ROW,COL,B'CHAR);
  VALUE ROW,COL,B'CHAR;
  INTEGER ROW,COL;
  BYTE B'CHAR;
  OPTION FORWARD;
INTEGER PROCEDURE RANDOM (LIMIT);
  VALUE LIMIT;
  INTEGER LIMIT;
  OPTION FORWARD;
LOGICAL PROCEDURE READ'PAGE(LPAGE,DROID);
  VALUE LPAGE,DROID;
  INTEGER LPAGE,DROID;
  OPTION FORWARD;
PROCEDURE RUN'TIME'ERROR(DROID,SWAP,ERROR);
  VALUE DROID,ERROR;
  INTEGER DROID,SWAP,ERROR;
  OPTION FORWARD;
REAL PROCEDURE SIN'(X);
  VALUE X;
  REAL X;
  OPTION FORWARD;
LOGICAL PROCEDURE STOROK(CODE);
  VALUE CODE;
  INTEGER CODE;
  OPTION FORWARD;
PROCEDURE UPDATE(DROID);
  VALUE DROID;
  INTEGER DROID;
  OPTION FORWARD;
PROCEDURE XEQ(DROID);
  VALUE DROID;
  INTEGER DROID;
  OPTION FORWARD;
PROCEDURE DISPLAY'OCTAL (ROW,COL,VAL);
  VALUE ROW,COL,VAL;
  INTEGER ROW,COL,VAL;
  OPTION FORWARD;
$PAGE "DROID ** Procedure ARCTAN'"
<<Finds ATAN of passed value, converts resulting radians to degrees>>

REAL PROCEDURE ARCTAN'(X);
  VALUE X;
  REAL X;
BEGIN
  REAL RADIANS,HOLD;
  INTRINSIC ATAN;

  HOLD := ATAN(X);
  ARCTAN' := HOLD*1800./3.1415927;
  END;
$PAGE "DROID ** Procedure COMPILE'BATTLE'STATISTICS"
PROCEDURE COMPILE'BATTLE'STATISTICS;
BEGIN
  INTEGER DROID;

  FOR DROID := 0 UNTIL NUM'DROIDS-1 DO BEGIN
      IF NOT DEAD(DROID) THEN
         BATTLES'WON(DROID) := BATTLES'WON(DROID)+1;
      TOT'DAM'INCURRED(DROID) :=
               TOT'DAM'INCURRED(DROID)+100-LOGICAL(RD'DAMAGE);
      TOT'DAM'INFLICTED(DROID) :=
               TOT'DAM'INFLICTED(DROID)+REM'DAMAGE(DROID);
      END;
  END;
$PAGE "DROID ** Procedure CONTROL'Y'TRAP"
PROCEDURE CONTROL'Y'TRAP;
BEGIN
  INTEGER SDEC;

  SWAP := SWAP'POINT+1;
  CTL'Y := TRUE;
  RESETCONTROL;                 <<  REARM CONTROL-Y TRAP  >>
  TOS:=%31400 + SDEC.(8:8);     << BUILD EXIT INSTRUCTION >>
  ASSEMBLE(XEQ 0);              << EXECUTE THE EXIT       >>
  END;
$PAGE "DROID ** Procedure COS'"
<<Converts passed degree value to radians, passes it by reference. >>

REAL PROCEDURE COS'(X);
  VALUE X;
  REAL X;
BEGIN
  REAL RADIANS;

  RADIANS := 3.1415927/1800. * X;
  COS' := COS(RADIANS);
  END;
$PAGE "DROID ** Procedure DISPLAY'BATTLE'STATISTICS"
PROCEDURE DISPLAY'BATTLE'STATISTICS;
BEGIN
  INTEGER J,K,MINUTES,SECONDS;
  DOUBLE TIME;
  ARRAY BUF(0:50);
    BYTE ARRAY B'BUF(*)=BUF;

  IF NOT NOLIST THEN POS'CUR(27,0)
  ELSE BEGIN
     PRINT(BUF,0,0);
     PRINT(BUF,0,0);
     END;
  MOVE B'BUF := ("                            AVG DAMAGE",
                 "           NUMBER OF TIMES RANKED     ");
  PRINT(BUF,-76,0);
  IF SESSION THEN BEGIN
     MOVE B'BUF := (ENH'U,
                    "DROID NAME       WON   INFLICTED INCURRED",
                    "   1ST  2ND  3RD  4TH  5TH  6TH  7TH");
     PRINT(BUF,-81,0);
     END
  ELSE BEGIN
     MOVE B'BUF := ("DROID NAME       WON   INFLICTED INCURRED",
                    "   1ST  2ND  3RD  4TH  5TH  6TH  7TH");
     PRINT(BUF,-77,0);
     MOVE B'BUF := ("-----------------------------------------",
                    "------------------------------------");
     PRINT(BUF,-77,0);
     END;
  FOR DROID := 0 UNTIL NUM'DROIDS-1 DO BEGIN
     BLANK'BUF;
     B'BUF := DROID+65;
     MOVE B'BUF(3) := B'NAME(DROID*MAXNAME*2),(8);
     J:=8;
     FOR K:=0 UNTIL 7 DO BEGIN
        IF B'BUF(3+K)="." THEN BEGIN
           J:=K;
           K:=7;
           END;
        END;
     MOVE B'BUF(3+J):="        ";
     ASCII(I'BATTLES'WON(DROID),-10,B'BUF(19));
     I := TOT'DAM'INCURRED(DROID)/
          (SAVE'NO'BATTLES-NO'BATTLES+1);
     ASCII(I,-10,B'BUF(37));
     I := TOT'DAM'INFLICTED(DROID)/
          (SAVE'NO'BATTLES-NO'BATTLES+1);
     ASCII(I,-10,B'BUF(28));
     FOR J:=0 UNTIL MAXDROIDS-1 DO
         IF (I := RANKING(DROID*MAXDROIDS+J))=0 THEN
            MOVE B'BUF(44+J*5) := "---  "
         ELSE BEGIN
            MOVE B'BUF(44+J*5) := "     ";
            ASCII(I,-10,B'BUF(46+J*5));
            END;
     PRINT(BUF,-78,0);
     END;
  PRINT(BUF,0,0);
  PRINT(BUF,0,0);
  BLANK'BUF;
  MOVE B'BUF := "TOTAL MATCHES:";
  I := INTEGER(SAVE'NO'BATTLES-NO'BATTLES+1);
  ASCII(I,10,B'BUF(15));
  PRINT(BUF,-30,0);
  BLANK'BUF;
  TIME := PROCTIME;
  MINUTES := INTEGER(TIME/60000D);
  SECONDS := INTEGER((TIME-DOUBLE(MINUTES)*60000D)/1000D);
  MOVE B'BUF := "CPU TIME:";
  I := 15+ASCII(MINUTES,10,B'BUF(15));
  MOVE B'BUF(I) := ":00";
  ASCII(SECONDS,-10,B'BUF(I+2));
  PRINT(BUF,-30,0);
  BLANK'BUF;
  D'END'SECONDS := TIMER;
  D'END'SECONDS := D'END'SECONDS - D'START'SECONDS;
  IF D'END'SECONDS < 0D THEN
     D'END'SECONDS := D'END'SECONDS + 2073600000D;
  MINUTES := INTEGER(D'END'SECONDS/60000D);
  SECONDS := INTEGER((D'END'SECONDS-DOUBLE(MINUTES)*60000D)/1000D);
  MOVE B'BUF := "ELAPSED TIME:";
  I := 15+ASCII(MINUTES,10,B'BUF(15));
  MOVE B'BUF(I) := ":00";
  ASCII(SECONDS,-10,B'BUF(I+2));
  PRINT(BUF,-30,0);
  BLANK'BUF;
  MOVE B'BUF := "INSTRUCTIONS:";
  PRINT(BUF,-DASCII(D'INSTR'EXECUTED,10,B'BUF(15))-15,%320);
  BLANK'BUF;
  BUF := " (";
  MOVE B'BUF(DASCII(D'INSTR'EXECUTED/
       (D'END'SECONDS/1000D),10,B'BUF(2))+2) := "/second)";
  PRINT(BUF,-30,0);
  BLANK'BUF;
  MOVE B'BUF := "DEADLOCKS:";
  ASCII(TOTAL'DEADLOCKS,10,B'BUF(15));
  PRINT(BUF,-30,0);
  END;
$PAGE "DROID ** Procedure DISPLAY'DAMAGE"
PROCEDURE DISPLAY'DAMAGE;
BEGIN
  INTEGER CURR'DROID;

  ARRAY BUF(0:10);
     BYTE ARRAY B'BUF(*)=BUF;

  FOR CURR'DROID:=0 UNTIL NUM'DROIDS-1 DO BEGIN
     POS'CUR (DAMAGE'ROW(CURR'DROID),DAMAGE'COL(CURR'DROID));
     MOVE BUF:="          ";
     ASCII(I'RD'REG(CURR'DROID*MAXREG+DAMAGE'REG),-10,BUF(3));
     DISPLAY B'BUF(4),(3) ASK;
     END;
  END;
$PAGE "DROID ** Procedure DISPLAY'INSTR"
PROCEDURE DISPLAY'INSTR;
BEGIN
  LOGICAL I;  INTEGER K;

  DROID'PAGE := DROID*PAGELEN;
  FOR K := 0 UNTIL 3 DO BEGIN
     I:=INTEGER(K);
     CURR'PAGE := (P'REG(DROID)+I)/PAGELEN;
     IF CURR'PAGE <> I'LPAGE(DROID) THEN BEGIN
        IF NOT READ'PAGE (CURR'PAGE,DROID) THEN RETURN;
        END;
     PAGE'OFFSET := (P'REG(DROID)+I) MOD PAGELEN;
     CODE := PAGE(DROID'PAGE + PAGE'OFFSET);
     DISPLAY'OCTAL (REG'ROW(38+I),REG'COL(38+I),CODE);
     END;
  IF NOT READ'PAGE (LPAGE(DROID),DROID) THEN RETURN;
  POS'CUR (23,60);
  ASCII(P'REG(DROID),8,BUF);
  DISPLAY "  LOC="
   CONCAT B'BUF,(6) ASK;
  POS'CUR(23,52);
  DISPLAY "CYCLES="
   CONCAT B'BUF,(ASCII(SWAP,10,BUF)) ASK;
  END;
$PAGE "DROID ** Procedure DISPLAY'REMOTE'DAMAGE"
PROCEDURE DISPLAY'REMOTE'DAMAGE(DROID);
  VALUE DROID;
  INTEGER DROID;
BEGIN
  ARRAY BUF(0:10);
     BYTE ARRAY B'BUF(*)=BUF;

  POS'CUR (DROID*3+2,76);
  MOVE BUF:="          ";
  ASCII(I'REM'DAMAGE(DROID),-10,BUF(3));
  DISPLAY B'BUF(4),(3) ASK;
  END;
$PAGE "DROID ** Procedure DISPLAY'STACK"
PROCEDURE DISPLAY'STACK;
BEGIN
  LOGICAL I;
  INTEGER K;

  FOR K:=0 STEP -1 UNTIL -3 DO BEGIN
     I:=INTEGER(K);
     IF INTEGER(S'REG(DROID))+K < 0 THEN BEGIN
        POS'CUR (REG'ROW(37+I),REG'COL(37+I));
        DISPLAY "  **  " ASK;
        END
     ELSE DISPLAY'VALUE (REG'ROW(37+I),REG'COL(37+I),
                     STACK(DROID*MAXSTACK+I'S'REG(DROID)+K));
     END;
  POS'CUR (23,73);
  IF I'S'REG(DROID)<0 THEN MOVE BUF := "S=NULL"
  ELSE BEGIN
     MOVE BUF := "S=0000";
     ASCII(S'REG(DROID),-10,B'BUF(5));
     END;
  DISPLAY B'BUF,(6) ASK;
  END;
$PAGE "DROID ** Procedure DISPLAY'SYS'REG"
PROCEDURE DISPLAY'SYS'REG;
BEGIN
  FOR I:=26 UNTIL 33 DO
     DISPLAY'VALUE (REG'ROW(I),REG'COL(I),
       IF WRITE'MODE THEN WR'REG(DROID*MAXREG+I)
       ELSE RD'REG(DROID*MAXREG+I));
  FOR I:=23 UNTIL 24 DO
     DISPLAY'VALUE (REG'ROW(I),REG'COL(I),
                     RD'REG(DROID*MAXREG+I));
  POS'CUR (22,15);
  IF WRITE'MODE THEN DISPLAY "Sys Reg Mode: Write" ASK
  ELSE DISPLAY "Sys Reg Mode: Read " ASK;
  END;
$PAGE "DROID ** Procedure DISPLAY'TIME"
PROCEDURE DISPLAY'TIME;
BEGIN
   INTEGER
       I,
       MINUTES,
       SECONDS;

   ARRAY BUF(0:20);
     BYTE ARRAY B'BUF(*)=BUF;

   BUF:="  "; MOVE BUF(1) := BUF,(20);
   I := DASCII(D'INSTR'EXECUTED,10,B'BUF);
   MOVE B'BUF(40) := B'BUF(I-1),(-I);
   POS'CUR(23,70);
   DISPLAY B'BUF(32),(9) ASK;
   D'END'SECONDS := TIMER;
   D'END'SECONDS := D'END'SECONDS - D'START'SECONDS;
   IF D'END'SECONDS < 0D THEN
      D'END'SECONDS := D'END'SECONDS + 2073600000D;
   D'END'SECONDS := D'END'SECONDS / 1000D;
   MINUTES := INTEGER(D'END'SECONDS / 60D);
   SECONDS := INTEGER(D'END'SECONDS MOD 60D);
   BUF:="  "; MOVE BUF(1) := BUF,(20);
   B'BUF(3) := ":";
   ASCII(MINUTES,-10,B'BUF(2));
   B'BUF(4) := "0";
   ASCII(SECONDS,-10,B'BUF(5));
   POS'CUR(22,73);
   DISPLAY B'BUF,(6) ASK;
   END;
$PAGE "DROID ** Procedure DISPLAY'VALUE"
PROCEDURE DISPLAY'VALUE (ROW,COL,VAL);
  VALUE ROW,COL,VAL;
  INTEGER ROW,COL,VAL;
BEGIN
  LOGICAL OCTAL := FALSE;
  INTEGER I;
  ARRAY BUF(0:39);
    BYTE ARRAY B'BUF(*)=BUF;

  ENTRY DISPLAY'OCTAL;

  IF FALSE THEN
DISPLAY'OCTAL: OCTAL := TRUE;

  POS'CUR (ROW,COL);
  MOVE BUF := "      ";
  IF NOT OCTAL THEN BEGIN
     I := ASCII(VAL,10,BUF(10));
     MOVE B'BUF(6-I) := B'BUF(20),(I);
     END
  ELSE ASCII(VAL,8,BUF);
  DISPLAY B'BUF,(6) ASK;
  END;
$PAGE "DROID ** Procedure DO'RADAR"
PROCEDURE DO'RADAR (DROID);
  VALUE DROID;
  INTEGER DROID;
BEGIN

  INTEGER
     CURR'DROID,
     QUAD,
     I'BEAM,
     NEW'RADR'SLICE,
     NEW'RADAR'COL,
     NEW'RADAR'ROW,
     OLD'RADAR'ROW,
     OLD'RADAR'COL;

  REAL BETA,BEAM'DEGREE,HALF'RADAR'MAX,X'DR,Y'DR,D1,D2,
       DIFF,SHORTEST'DISTANCE,X1'DR,Y1'DR,MAXX'X,MAXX'Y;

  REAL DISTANCE;
  REAL DELTA'X;
  REAL DELTA'Y;

  HALF'RADAR'MAX := REAL(RD'WIDTH)/2.;
  CURR'DROID:=DROID;
  BEAM'DEGREE := REAL(WR'RADAR MOD 3600);
  I'BEAM := INTEGER(FIXT(BEAM'DEGREE));
  IF (I'BEAM MOD 900)=0 THEN BEAM'DEGREE:=BEAM'DEGREE+.1;
  X'DR:=REAL(RD'X);
  Y'DR:=REAL(RD'Y);
  SHORTEST'DISTANCE:=1.E9;

  FOR DROID:=0 UNTIL NUM'DROIDS-1 DO BEGIN
     IF DROID<>CURR'DROID AND NOT DEAD(DROID) THEN BEGIN
        X1'DR:=REAL(RD'X);
        Y1'DR:=REAL(RD'Y);
        DISTANCE:=((DELTA'X:=(X1'DR - X'DR))^2 +
           (DELTA'Y:=(Y1'DR - Y'DR))^2)^.5;
        IF DELTA'X=0. THEN DELTA'X := .01;
        BETA := ARCTAN'(DELTA'Y/DELTA'X);
        IF DELTA'X < 0. THEN BETA := BETA + 1800.;
        IF BETA<0. THEN BETA:=BETA+3600.;
        IF (DIFF:=\(BETA - BEAM'DEGREE)\) > 1800. THEN
           DIFF:=3600. - DIFF;
        IF DIFF <= HALF'RADAR'MAX THEN
           IF DISTANCE < SHORTEST'DISTANCE THEN
              SHORTEST'DISTANCE := DISTANCE;
        END;
     END;

  DROID:=CURR'DROID;
  IF SHORTEST'DISTANCE < .9E9 THEN
     RD'RADAR := INTEGER(FIXR(SHORTEST'DISTANCE))
  ELSE BEGIN                         <<Find distance to wall.      >>
     QUAD:=INTEGER(FIXT(BEAM'DEGREE/900.)) ;
     X1'DR:=REAL(RD'X);
     Y1'DR:=REAL(RD'Y);
     MAXX'X:=REAL(MAX'X);
     MAXX'Y:=REAL(MAX'Y);

     IF QUAD=0 THEN BEGIN
        D1:=(MAXX'Y-Y1'DR)/SIN'(BEAM'DEGREE);
        D2:=(MAXX'X-X1'DR)/COS'(BEAM'DEGREE);
        END
     ELSE IF QUAD=1 THEN BEGIN
        D1:=(MAXX'Y-Y1'DR)/COS'(BEAM'DEGREE-900.0);
        D2:=X1'DR/SIN'(BEAM'DEGREE-900.0);
        END
     ELSE IF QUAD=2 THEN BEGIN
        D1:=Y1'DR/SIN'(BEAM'DEGREE-1800.0);
        D2:=X1'DR/COS'(BEAM'DEGREE-1800.0);
        END
     ELSE IF QUAD=3 THEN BEGIN
        D1:=Y1'DR/COS'(BEAM'DEGREE-2700.0);
        D2:=(MAXX'X-X1'DR)/SIN'(BEAM'DEGREE-2700.0);
        END;
     IF D1<D2 THEN RD'RADAR:=INTEGER(FIXR(D1*-1.0))
        ELSE RD'RADAR:=INTEGER(FIXR(D2*-1.0));
     END;

  OLD'SCREEN'COL := INTEGER(RD'X)/INTEGER(UNITS'PER'COL);
  OLD'SCREEN'ROW := INTEGER(MAX'Y-RD'Y)/INTEGER(UNITS'PER'ROW);
  NEW'RADR'SLICE := ((WR'RADAR+225)  MOD 3600)/450;
  OLD'RADAR'COL := OLD'SCREEN'COL + XOFF(OLD'RADR'SLICE(DROID));
  OLD'RADAR'ROW := OLD'SCREEN'ROW + YOFF(OLD'RADR'SLICE(DROID));
  IF NEW'RADR'SLICE <> OLD'RADR'SLICE(DROID) THEN BEGIN
     IF GET'CHAR(OLD'RADAR'ROW,OLD'RADAR'COL)="." THEN
        PUTCHAR (OLD'RADAR'ROW,OLD'RADAR'COL," ");
     NEW'RADAR'COL  := OLD'SCREEN'COL + XOFF(NEW'RADR'SLICE);
     NEW'RADAR'ROW  := OLD'SCREEN'ROW + YOFF(NEW'RADR'SLICE);
     IF GET'CHAR(NEW'RADAR'ROW,NEW'RADAR'COL)=" " THEN
        PUTCHAR (NEW'RADAR'ROW,NEW'RADAR'COL,".");
     END;
  OLD'RADR'SLICE(DROID) := NEW'RADR'SLICE;
  IF TEST'BENCH AND DROID=BENCH'DROID THEN DISPLAY'SYS'REG;
  END;
$PAGE "DROID ** Procedure DO'SHOOT"
PROCEDURE DO'SHOOT (DROID);
  VALUE DROID;
  INTEGER DROID;
BEGIN

  INTEGER
     DAMAGE'INFLICTED,
     CURR'DROID,
     HOLD'DAMAGE,
     I,
     NUM'STEPS;
  INTEGER POINTER I'PTR;
  BYTE B'SAVE;
  REAL R'X,
       R'Y,
       R'DIST,
       R'DELTA'X,
       R'DELTA'Y,
       R'FACTOR;

  IF RD'TURRET > MAX'TEMP THEN BEGIN
     WR'SHOT := 0;                   <<Shoot yourself in foot.     >>
     END;
  IF NOISY THEN BEEP;
  R'X := REAL(RD'X);
  R'Y := REAL(RD'Y);
  @I'PTR := @WR'SHOT;
  WR'SHOT := LOGICAL(\I'PTR\);
  R'DELTA'X := COS'(REAL(WR'TURRET));
  R'DELTA'Y := SIN'(REAL(WR'TURRET));
  NUM'STEPS := WR'SHOT/DIST'PER'UPDATE/2;
  R'FACTOR  := REAL(WR'SHOT)/REAL(NUM'STEPS+1);
  R'DELTA'X := R'DELTA'X * R'FACTOR;
  R'DELTA'Y := R'DELTA'Y * R'FACTOR;
  OLD'SCREEN'ROW := -1;
  FOR I := 0 UNTIL NUM'STEPS DO BEGIN
     NEW'SCREEN'ROW := (MAX'Y-INTEGER(FIXR(R'Y)))/
                                         INTEGER(UNITS'PER'ROW);
     NEW'SCREEN'COL := INTEGER(FIXR(R'X))/
                                  INTEGER(UNITS'PER'COL);
     IF NEW'SCREEN'ROW<=0 THEN BEGIN
        NEW'SCREEN'ROW := 1;
        R'Y:=
          (REAL(MAX'ROW) - REAL(NEW'SCREEN'ROW))*REAL(UNITS'PER'ROW);
        R'DELTA'Y := -R'DELTA'Y;
        END
     ELSE IF NEW'SCREEN'ROW>=MAX'ROW THEN BEGIN
        NEW'SCREEN'ROW := MAX'ROW-1;
        R'Y:=
          (REAL(MAX'ROW) - REAL(NEW'SCREEN'ROW))*REAL(UNITS'PER'ROW);
        R'DELTA'Y := -R'DELTA'Y;
        END;
     IF NEW'SCREEN'COL<=0 THEN BEGIN
        NEW'SCREEN'COL := 1;
        R'X := REAL(NEW'SCREEN'COL)*REAL(UNITS'PER'COL);
        R'DELTA'X := -R'DELTA'X;
        END
     ELSE IF NEW'SCREEN'COL>=MAX'COL THEN BEGIN
        NEW'SCREEN'COL := MAX'COL-1;
        R'X := REAL(NEW'SCREEN'COL)*REAL(UNITS'PER'COL);
        R'DELTA'X := -R'DELTA'X;
        END;
     IF OLD'SCREEN'ROW <> -1 THEN
        IF B'SAVE <> "Z" THEN
           PUTCHAR(OLD'SCREEN'ROW,OLD'SCREEN'COL,B'SAVE)
        ELSE
           PUTCHAR(OLD'SCREEN'ROW,OLD'SCREEN'COL," ");
     B'SAVE := GET'CHAR(NEW'SCREEN'ROW,NEW'SCREEN'COL);
     PUTCHAR(NEW'SCREEN'ROW,NEW'SCREEN'COL,"*");
     OLD'SCREEN'ROW := NEW'SCREEN'ROW;
     OLD'SCREEN'COL := NEW'SCREEN'COL;
     R'X := R'X + R'DELTA'X;
     R'Y := R'Y + R'DELTA'Y;
     END;
  IF OLD'SCREEN'ROW <> -1 THEN
     IF B'SAVE <> "Z" THEN
        PUTCHAR(OLD'SCREEN'ROW,OLD'SCREEN'COL,B'SAVE)
     ELSE
        PUTCHAR(OLD'SCREEN'ROW,OLD'SCREEN'COL," ");
  RD'TURRET := RD'TURRET+SHOT'TEMP;
  IF NOISY THEN BEEP;                <<Did we hit anybody?         >>
  DAMAGE'INFLICTED:=-1;
  CURR'DROID:=DROID;
  FOR DROID := 0 UNTIL NUM'DROIDS-1 DO BEGIN
     R'DIST := ((R'X-REAL(RD'X))^2 + (R'Y-REAL(RD'Y))^2)^.5;
     IF NOT DEAD(DROID) AND R'DIST < R'DAMAGE'RADIUS THEN BEGIN
        HOLD'DAMAGE:=RD'DAMAGE;
        RD'DAMAGE := RD'DAMAGE-INTEGER(FIXT(
                          (R'DAMAGE'RADIUS-R'DIST)*R'DAMAGE'FACTOR));
        IF RD'DAMAGE <= 0 THEN
           RD'DAMAGE := 0;
        IF HOLD'DAMAGE - RD'DAMAGE > 0 THEN
           IF DROID <> CURR'DROID THEN BEGIN
              I'REM'DAMAGE (CURR'DROID):=I'REM'DAMAGE (CURR'DROID) +
                     HOLD'DAMAGE - RD'DAMAGE;
              DEAD'LOCK := 0;               <<Reset DEAD'LOCK flag >>
              END
           ELSE
              DEAD'LOCK := 0                <<Reset DEAD'LOCK flag >>
        ELSE
           GOTO NO'FLICKER'NO'DAMAGE;
        IF HOLD'DAMAGE<>RD'DAMAGE AND DROID <> CURR'DROID THEN
           IF HOLD'DAMAGE - RD'DAMAGE > DAMAGE'INFLICTED THEN
              DAMAGE'INFLICTED := HOLD'DAMAGE - RD'DAMAGE;
        OLD'SCREEN'ROW := INTEGER(MAX'Y-RD'Y)/INTEGER(UNITS'PER'ROW);
        OLD'SCREEN'COL := INTEGER(RD'X)/INTEGER(UNITS'PER'COL);
        B'SAVE := 65+BYTE(DROID);
        FOR I := 1 UNTIL 20 DO BEGIN
           PUTCHAR(OLD'SCREEN'ROW,OLD'SCREEN'COL," ");
           PUTCHAR(OLD'SCREEN'ROW,OLD'SCREEN'COL," ");
           PUTCHAR(OLD'SCREEN'ROW,OLD'SCREEN'COL," ");
           PUTCHAR(OLD'SCREEN'ROW,OLD'SCREEN'COL,B'SAVE);
           END;
        IF NOT TEST'BENCH THEN DISPLAY'DAMAGE;
        IF RD'DAMAGE <= 0 THEN KILL(DROID);
NO'FLICKER'NO'DAMAGE:
        END;
     END;
  DROID := CURR'DROID;
  IF DAMAGE'INFLICTED > 0 THEN BEGIN
     RD'SHOT := DAMAGE'INFLICTED;
     IF NOT TEST'BENCH THEN DISPLAY'REMOTE'DAMAGE(CURR'DROID);
     END
  ELSE RD'SHOT := 0;
  END;
$PAGE "DROID ** Procedure DRAW'SCREEN          "
PROCEDURE DRAW'SCREEN (NUM'DROIDS);
   VALUE NUM'DROIDS;
   INTEGER NUM'DROIDS;
BEGIN

INTEGER  I,J,K,L1,L2;
LOGICAL L'DR'NUM;
REAL TEN'SEC;
$PAGE
SUBROUTINE DRAW'TEMPLATE (NUM'DROIDS);
   INTEGER NUM'DROIDS;
BEGIN

   BLANK'BUF;
   DISPLAY (HOME'CURSOR,CLEAR'DISPLAY) ASK;

   FOR I:=0 UNTIL 23 DO BEGIN
     IF I>=1 AND I<=21 THEN BEGIN
        DISPLAY (ENH'HI," ",END'ENH) ASK;
        POS'CUR (I,64);
        DISPLAY (ENH'HI)
        CONCAT B'BUF,(16) ASK;
        BLANK'BUF;
        END
     ELSE BEGIN
        DISPLAY (ENH'HI) CONCAT B'BUF,(80) ASK;
        BLANK'BUF;
        END
     END;

   POS'CUR(0,1);
   DISPLAY  "DROID A.03  (C) 1984 Reichhold Chemicals, Inc." ASK;

   FOR I := 0 UNTIL NUM'DROIDS-1 DO BEGIN
      DROID:=I;
      POS'CUR(I*3+1,65);
      DISPLAY (ENH'I) ASK;
      B'BUF := I+65;
      MOVE BUF(1):=NAME(DROID*MAXNAME),(4);
      J:=8;
      FOR K:=0 UNTIL 7 DO BEGIN
         IF B'BUF(2+K)="." THEN BEGIN
            J:=K;
            K:=7;
            END;
         END;
      MOVE B'BUF(2+J):="        ";
      DISPLAY B'BUF,(1)
      CONCAT (ENH'HI," ",ENH'I)
      CONCAT B'BUF(2),(8)
      CONCAT (ENH'HI," ",ENH'I,"   ",ENH'HI," ") ASK;
      POS'CUR(I*3+2,65);
      DISPLAY (END'ENH,"          ",ENH'HI,"     ") ASK;
      DISPLAY'REMOTE'DAMAGE(I);
      END;

   POS'CUR (22,3);
   MOVE BUF := "WIN 2ND 3RD 4TH 5TH 6TH 7TH";
   I := NUM'DROIDS*4-1;
   DISPLAY B'BUF,(I) ASK;
   END;
$PAGE
SUBROUTINE DRAW'TEST'BENCH (NUM'DROIDS);
   INTEGER NUM'DROIDS;
BEGIN

   BLANK'BUF;
   DISPLAY (HOME'CURSOR,CLEAR'DISPLAY) ASK;

   FOR I:=0 UNTIL 23 DO BEGIN
     IF I>=1 AND I<=21 THEN BEGIN
        DISPLAY (ENH'HI," ",END'ENH) ASK;
        POS'CUR (I,64);
        DISPLAY (ENH'HI)
        CONCAT B'BUF,(16) ASK;
        BLANK'BUF;
        END
     ELSE BEGIN
        DISPLAY (ENH'HI) CONCAT B'BUF,(80) ASK;
        BLANK'BUF;
        END
     END;

   POS'CUR(0,1);
   DISPLAY  "DROID  Version A.03 (Test Bench Mode)"  ASK;

   POS'CUR(22,1);
   BLANK'BUF;
   DISPLAY (ENH'I)
   CONCAT B'BUF,(63)
   CONCAT (ENH'HI) ASK;

   FOR I := 1 UNTIL 13 DO BEGIN
     B'BUF := 64+I;
     POS'CUR (I,64);
     DISPLAY B'BUF,(1) CONCAT "=" CONCAT (ENH'IU)
      CONCAT "      " CONCAT (ENH'HI) ASK;
     B'BUF := B'BUF+13;
     DISPLAY B'BUF,(1) CONCAT "=" CONCAT (ENH'IU)
      CONCAT "      " ASK;
     END;

   MOVE BUF := ("RN","RD","DM","SX","TR","SY","SH","WD");
   FOR I := 0 UNTIL 3 DO BEGIN
      POS'CUR(I+14,64);
      DISPLAY B'BUF(I*4),(2) CONCAT (ENH'IU)
          CONCAT "      " CONCAT (ENH'HI)
          CONCAT B'BUF(I*4+2),(2) CONCAT (ENH'IU)
          CONCAT "      " ASK;
      END;

   POS'CUR(18,66);DISPLAY "INSTR   STACK" ASK;
   MOVE BUF := (" 0","TS","+1","-1","+2","-2","+3","-3");
   FOR I := 0 UNTIL 3 DO BEGIN
      POS'CUR(I+19,64);
      DISPLAY B'BUF(I*4),(2) CONCAT (ENH'IU)
       CONCAT "      " CONCAT (ENH'HI)
       CONCAT B'BUF(I*4+2),(2) CONCAT (ENH'IU)
       CONCAT "      " ASK;
      END;
   END;
$PAGE
IF NOT TEST'BENCH THEN DRAW'TEMPLATE(NUM'DROIDS)
ELSE DRAW'TEST'BENCH(NUM'DROIDS);

END;    <<  DRAW'SCREEN >>
$PAGE "DROID ** Procedure GET'CHAR"
BYTE PROCEDURE GET'CHAR(ROW,COL);
  VALUE ROW,COL;
  INTEGER ROW,COL;
BEGIN
  GET'CHAR := B'SCREEN (ROW*(MAX'COL+1)+COL);
  END;
$PAGE "DROID ** Procedure GET'TOURNAMENT'INFO"
PROCEDURE GET'TOURNAMENT'INFO;
BEGIN
  RANKING := 0; MOVE RANKING(1) := RANKING,(MAXDROIDS*MAXDROIDS);
ASK'AGAIN:
  DISPLAY "Enter number of battles for this tournament: " ASK;
  I := READ(BUF,-80);
  IF I = 0 THEN BEGIN
     NO'BATTLES := SAVE'NO'BATTLES := 0;
     RETURN;
     END;
  WHILE I>0 AND B'BUF(I-1)=" " DO I:=I-1;
  B'BUF(I):=" ";
  IF NOT SESSION THEN DISPLAY B'BUF,(I) EOD;
  NO'BATTLES := BINARY(B'BUF,I);
  IF <> THEN BEGIN
TOURNEY'ERROR:
     BEEP;
     DISPLAY "Please enter a number from 1 to 30000, or <CR> " EOD;
     LINE'FEED;
     GO ASK'AGAIN;
     END;
  SAVE'NO'BATTLES := NO'BATTLES;
  IF NO'BATTLES < 1 OR NO'BATTLES > 30000 THEN
     GO TOURNEY'ERROR;
  END;
$PAGE "DROID ** Procedure INITIALIZE     "
PROCEDURE INITIALIZE;
BEGIN

  INTEGER
     NEW'RADAR'COL,
     NEW'RADAR'ROW,
     NEW'TURRET'COL,
     NEW'TURRET'ROW;

  BYTE B'SAVE;

  INTRINSIC RAND1;

  DEAD'DROIDS := 0;
  FINISHED := FALSE;
  DEAD'LOCK := 0;
  R'SEED := RAND1;
  PAGE  := 0; MOVE PAGE(1)  := PAGE,(PAGELEN*MAXDROIDS);
  REM'DAMAGE := 0; MOVE REM'DAMAGE(1) := REM'DAMAGE,(MAXDROIDS);
  STACK := 0; MOVE STACK(1) := STACK,(MAXSTACK*MAXDROIDS);
  RD'REG := 0; MOVE RD'REG(1) := RD'REG,(MAXREG*MAXDROIDS);
  WR'REG := 0; MOVE WR'REG(1) := WR'REG,(MAXREG*MAXDROIDS);
  P'REG := 0; MOVE P'REG(1) := P'REG,(MAXDROIDS);
  S'REG :=-1; MOVE S'REG(1) := S'REG,(MAXDROIDS);
  LPAGE :=-1; MOVE LPAGE(1) := LPAGE,(MAXDROIDS);
  SWAP  := 0;
  DEAD  := FALSE; MOVE DEAD(1)  := DEAD,(MAXDROIDS);
  SCREEN := "  "; MOVE SCREEN(1):=SCREEN,((MAX'COL+1)*(MAX'ROW+1)/2);
  FOR I := MAX'ROW+1 STEP -1 UNTIL 0 DO BEGIN
     B'SCREEN(I*(MAX'COL+1)):="Z";B'SCREEN((I+1)*(MAX'COL+1)-1):="Z";
     END;
  MOVE B'SCREEN(1) := B'SCREEN,((MAX'COL+1)-1);
  MOVE B'SCREEN(((MAX'ROW+1)-1)*(MAX'COL+1)+1) :=
           B'SCREEN(((MAX'ROW+1)-1)*(MAX'COL+1)),((MAX'COL+1)-1);
  UNITS'PER'ROW := MAX'Y/MAX'ROW;
  UNITS'PER'COL := MAX'X/MAX'COL;
  FOR DROID := 0 UNTIL NUM'DROIDS-1 DO BEGIN
     DO BEGIN
        NEW'SCREEN'ROW := RANDOM(MAX'ROW-1)+1;
        NEW'SCREEN'COL := RANDOM(MAX'COL-1)+1;
        END UNTIL GET'CHAR(NEW'SCREEN'ROW,NEW'SCREEN'COL)=" ";
     B'SAVE := 65+BYTE(DROID);
     PUTCHAR(NEW'SCREEN'ROW,NEW'SCREEN'COL,B'SAVE);
     RD'WIDTH := 100;
     WR'WIDTH := 100;
     RD'X := LOGICAL(NEW'SCREEN'COL) * UNITS'PER'COL;
     RD'Y := LOGICAL((MAX'ROW-NEW'SCREEN'ROW)) * UNITS'PER'ROW;
     WR'TURRET := RANDOM(3600);
     OLD'TURR'SLICE(DROID) := ((WR'TURRET+225) MOD 3600)/450;
     NEW'TURRET'COL := NEW'SCREEN'COL + XOFF(OLD'TURR'SLICE(DROID));
     NEW'TURRET'ROW := NEW'SCREEN'ROW + YOFF(OLD'TURR'SLICE(DROID));
     IF GET'CHAR(NEW'TURRET'ROW,NEW'TURRET'COL)=" " OR
        GET'CHAR(NEW'TURRET'ROW,NEW'TURRET'COL)="." THEN
            PUTCHAR(NEW'TURRET'ROW,NEW'TURRET'COL,"o");
     WR'RADAR  := RANDOM(3600);
     OLD'RADR'SLICE(DROID) := ((WR'RADAR+225) MOD 3600)/450;
     NEW'RADAR'COL := NEW'SCREEN'COL + XOFF(OLD'RADR'SLICE(DROID));
     NEW'RADAR'ROW := NEW'SCREEN'ROW + YOFF(OLD'RADR'SLICE(DROID));
     IF GET'CHAR(NEW'RADAR'ROW,NEW'RADAR'COL)=" " THEN
        PUTCHAR(NEW'RADAR'ROW,NEW'RADAR'COL,".");
     RD'DAMAGE := 100;
     END;
  IF NOT TEST'BENCH THEN DISPLAY'DAMAGE;
  XCONTRAP (@CONTROL'Y'TRAP,I);
  END;
$PAGE "DROID ** Procedure KILL"
PROCEDURE KILL (DROID);
  VALUE DROID;
  INTEGER DROID;
BEGIN

  INTEGER
     OLD'SCREEN'COL,
     OLD'SCREEN'ROW,
     OLD'TURRET'COL,
     OLD'TURRET'ROW,
     OLD'RADAR'COL,
     OLD'RADAR'ROW;

  BYTE ARRAY
     B'BUF(0:9);

  IF DEAD(DROID) THEN RETURN;
  DEAD(DROID) := TRUE;
  DEAD'DROIDS := DEAD'DROIDS+1;
  OLD'SCREEN'COL := INTEGER(RD'X)/INTEGER(UNITS'PER'COL);
  OLD'SCREEN'ROW := INTEGER(MAX'Y-RD'Y)/INTEGER(UNITS'PER'ROW);
  OLD'TURRET'COL := OLD'SCREEN'COL + XOFF(OLD'TURR'SLICE(DROID));
  OLD'TURRET'ROW := OLD'SCREEN'ROW + YOFF(OLD'TURR'SLICE(DROID));
  OLD'RADAR'COL := OLD'SCREEN'COL + XOFF(OLD'RADR'SLICE(DROID));
  OLD'RADAR'ROW := OLD'SCREEN'ROW + YOFF(OLD'RADR'SLICE(DROID));
  B'BUF:=DROID+65;
  IF GET'CHAR(OLD'SCREEN'ROW,OLD'SCREEN'COL)=B'BUF THEN
     PUTCHAR (OLD'SCREEN'ROW,OLD'SCREEN'COL," ");
  IF GET'CHAR(OLD'TURRET'ROW,OLD'TURRET'COL)="o" THEN
     PUTCHAR (OLD'TURRET'ROW,OLD'TURRET'COL," ");
  IF GET'CHAR(OLD'RADAR'ROW,OLD'RADAR'COL)="." THEN
     PUTCHAR (OLD'RADAR'ROW,OLD'RADAR'COL," ");
  POS'CUR(23,(NUM'DROIDS-DEAD'DROIDS)*4+4);
  B'BUF:=DROID+65;
  DISPLAY B'BUF,(1) ASK;
  IF DEAD'DROIDS = NUM'DROIDS THEN FINISHED := TRUE;
  IF NOT TEST'BENCH THEN BEGIN
     DISPLAY'DAMAGE;
     DISPLAY'REMOTE'DAMAGE(DROID);
     END;
  IF SAVE'NO'BATTLES > 1 THEN
     RANKING(DROID*MAXDROIDS+NUM'DROIDS-DEAD'DROIDS) :=
     RANKING(DROID*MAXDROIDS+NUM'DROIDS-DEAD'DROIDS)+1;
  END;
$PAGE "DROID ** Procedure LOADOK               "
LOGICAL PROCEDURE LOADOK(CODE);
  VALUE CODE;
  LOGICAL CODE;
BEGIN
  I:=C'OPRND;
  IF I>=0 AND I<=35 THEN
     LOADOK:=TRUE;
  END;
$PAGE "DROID ** Procedure OPEN'PROGFILES       "
PROCEDURE OPEN'PROGFILES (NUM'DROIDS);
  INTEGER NUM'DROIDS;
BEGIN
  NUM'DROIDS := 0;
  LINE'FEED;BLANK'BUF;
  DISPLAY "Enter DROID name: " ASK;
  I := READ(BUF,-80);
  WHILE I>0 AND NUM'DROIDS<MAXDROIDS DO BEGIN

     WHILE I>0 AND B'BUF(I-1)=" " DO I:=I-1;
     B'BUF(I):=" ";
     IF NOT SESSION THEN DISPLAY B'BUF,(I) EOD;

     I := FOPEN(B'BUF,1);
     IF <> THEN BEGIN
        BEEP;
        DISPLAY "Couldn't open that DROID's program file." EOD;
        PRINT'FILE'INFO(I);
        LINE'FEED;
        END
     ELSE BEGIN
        PROGFILE(NUM'DROIDS) := I;
        DROID := NUM'DROIDS;
        MOVE NAME(DROID*MAXNAME) := BUF,(4);
        NUM'DROIDS := NUM'DROIDS + 1;
        END;
     IF NUM'DROIDS=MAXDROIDS THEN BEGIN
        LINE'FEED;LINE'FEED;
        RETURN;
        END;
     DISPLAY "Enter DROID name: " ASK;
     BLANK'BUF;
     I := READ(BUF,-80);
     END;
  IF NUM'DROIDS=0 THEN TERMINATE;
  LINE'FEED;LINE'FEED;
  END;
$PAGE "DROID ** Procedure POS'CUR              "
PROCEDURE POS'CUR (L'ROW,L'COL);
   VALUE L'ROW,L'COL;
   LOGICAL L'ROW,L'COL;
BEGIN
   ARRAY BUF(0:39);
     BYTE ARRAY B'BUF(*)=BUF;
   IF NOLIST THEN RETURN;
   MOVE B'BUF := (ADDRESS'CURSOR,"00r00C");
   ASCII(L'ROW,-10,B'BUF(4));
   ASCII(L'COL,-10,B'BUF(7));
   PRINT(BUF,-9,%320);
   END;
$PAGE "DROID ** Procedure PUTCHAR       "
PROCEDURE PUTCHAR (ROW,COL,B'CHAR);
  VALUE ROW,COL,B'CHAR;
  INTEGER ROW,COL;
  BYTE B'CHAR;
BEGIN
  INTEGER SCRN'ADDR;

  MOVE B'BUF := (27,"&a00r00C");B'BUF(9):=B'CHAR;
  ASCII(ROW,-10,B'BUF(4));
  ASCII(COL,-10,B'BUF(7));
  DISPLAY B'BUF,(10) ASK;
  SCRN'ADDR:=ROW*(MAX'COL+1) + COL; B'SCREEN(SCRN'ADDR) := B'CHAR;
  END;
$PAGE "DROID ** Procedure RANDOM               "
<<Returns a random integer between 0 and LIMIT.                    >>

INTEGER PROCEDURE RANDOM (LIMIT);
  VALUE LIMIT;
  INTEGER LIMIT;
BEGIN

  INTRINSIC RAND;

  RANDOM := INTEGER(FIXT(RAND(R'SEED)*REAL(LIMIT)));
  END;
$PAGE "DROID ** Procedure READ'PAGE            "
LOGICAL PROCEDURE READ'PAGE(LPAGE,DROID);
  VALUE LPAGE,DROID;
  INTEGER LPAGE,DROID;
BEGIN
  FREADDIR(PROGFILE(DROID),PAGE(DROID*PAGELEN),
                                        PAGELEN,DOUBLE(LPAGE));
  IF <> THEN BEGIN
     POS'CUR (30,0);
     DISPLAY "FATAL ERROR READING PROGRAM PAGE." EOD;
     DISPLAY "Droid #"
      CONCAT B'BUF,(ASCII(DROID,10,B'BUF))
      CONCAT "." EOD;
     LINE'FEED;
     PRINT'FILE'INFO(PROGFILE(DROID));
     QUIT(DROID);
     END;
  READ'PAGE := TRUE;
  END;
$PAGE "DROID ** Procedure RUN'TIME'ERROR       "
PROCEDURE RUN'TIME'ERROR(DROID,SWAP,ERROR);
  VALUE DROID,ERROR;
  INTEGER DROID,SWAP,ERROR;
BEGIN
  IF NOT TEST'BENCH THEN BEGIN
     POS'CUR(DROID*3+2,65);
     IF ERROR=0 THEN DISPLAY "HALTED    " ASK
     ELSE BEGIN
        DISPLAY "ERROR " ASK;
        I := ASCII(ERROR,10,BUF);
        DISPLAY B'BUF,(I) CONCAT "    " ASK;
        END;
     END;
  POS'CUR(22,35);
  B'BUF := 65+DROID;
  DISPLAY "DROID "
   CONCAT B'BUF,(1)
   CONCAT " ERROR "
   CONCAT B'BUF,(ASCII(ERROR,10,B'BUF))
   CONCAT " AT LOC=" ASK;
  ASCII(P'REG(DROID),8,BUF);
  DISPLAY B'BUF,(6) ASK;
  IF TEST'DEBUG THEN BEGIN
     BENCH'DROID := DROID;
     TEST'BENCH  := TRUE;
     DRAW'SCREEN (NUM'DROIDS);
     DISPLAY'STACK;
     DISPLAY'SYS'REG;
     DISPLAY'INSTR;
     XEQ (DROID);
     QUIT(0);
     END;
  KILL (DROID);
  SWAP := SWAP'POINT+1;
  RD'DAMAGE := 0;
  END;
$PAGE "DROID ** Procedure SIN'"
<<Converts passed degree value to radians, passes it by reference. >>

REAL PROCEDURE SIN'(X);
  VALUE X;
  REAL X;
BEGIN
  REAL RADIANS;

  RADIANS := 3.1415927/1800. * X;
  SIN' := SIN(RADIANS);
  END;
$PAGE "DROID ** Procedure STOROK               "
LOGICAL PROCEDURE STOROK(CODE);
  VALUE CODE;
  INTEGER CODE;
BEGIN
  I:=C'OPRND;
  IF I>=0 AND I<=35 THEN
     STOROK:=TRUE;
  IF I=X'REG OR I=Y'REG OR I=DAMAGE'REG THEN
     STOROK:=FALSE;
  END;
$PAGE "DROID ** Procedure UPDATE               "
PROCEDURE UPDATE(DROID);
  VALUE DROID;
  INTEGER DROID;
BEGIN

  INTEGER
     NEW'X,
     NEW'Y,
     NEW'RADR'SLICE,
     NEW'RADAR'COL,
     NEW'RADAR'ROW,
     NEW'TURRET'ROW,
     NEW'TURRET'COL,
     NEW'TURR'SLICE,
     OLD'RADAR'ROW,
     OLD'RADAR'COL,
     OLD'SPEEDY,
     OLD'TURRET'ROW,
     OLD'TURRET'COL;

  LOGICAL XNEG,YNEG;

  REAL R'SPEED;

  BYTE B'NAME;

                                     <<The famous RY fix.          >>
  OLD'SCREEN'COL := INTEGER(RD'X)/INTEGER(UNITS'PER'COL);
  OLD'SCREEN'ROW := INTEGER(MAX'Y-RD'Y)/INTEGER(UNITS'PER'ROW);
  NEW'TURR'SLICE := ((WR'TURRET+225) MOD 3600)/450;
  OLD'TURRET'COL := OLD'SCREEN'COL + XOFF(OLD'TURR'SLICE(DROID));
  OLD'TURRET'ROW := OLD'SCREEN'ROW + YOFF(OLD'TURR'SLICE(DROID));
  IF NEW'TURR'SLICE <> OLD'TURR'SLICE(DROID) THEN BEGIN
     IF GET'CHAR(OLD'TURRET'ROW,OLD'TURRET'COL)="o" THEN
        PUTCHAR (OLD'TURRET'ROW,OLD'TURRET'COL," ");
     NEW'TURRET'COL := OLD'SCREEN'COL + XOFF(NEW'TURR'SLICE);
     NEW'TURRET'ROW := OLD'SCREEN'ROW + YOFF(NEW'TURR'SLICE);
     IF GET'CHAR(NEW'TURRET'ROW,NEW'TURRET'COL)=" " OR
             GET'CHAR(NEW'TURRET'ROW,NEW'TURRET'COL)="." THEN
        PUTCHAR (NEW'TURRET'ROW,NEW'TURRET'COL,"o");
     END;
  OLD'TURR'SLICE(DROID) := NEW'TURR'SLICE;

  IF WR'SHOT <> 0 THEN DO'SHOOT(DROID)
  ELSE RD'TURRET := RD'TURRET - (RD'TURRET+1)/6;
  IF DEAD(DROID) = TRUE THEN RETURN;
  WR'SHOT:=0;

  IF \WR'SPEEDX\ > MAX'SPEED THEN
     WR'SPEEDX := MAX'SPEED *
          (IF LOGICAL(WR'SPEEDX.(0:1)) THEN -1 ELSE 1);
  IF \WR'SPEEDY\ > MAX'SPEED THEN
     WR'SPEEDY := MAX'SPEED *
          (IF LOGICAL(WR'SPEEDY.(0:1)) THEN -1 ELSE 1);
  RD'SPEEDX := RD'SPEEDX +
               (INTEGER(DOUBLE(WR'SPEEDX)-DOUBLE(RD'SPEEDX))+4)/5;
  RD'SPEEDY := RD'SPEEDY +
               (INTEGER(DOUBLE(WR'SPEEDY)-DOUBLE(RD'SPEEDY))+4)/5;
  R'SPEED   := (REAL(RD'SPEEDX)^2 + REAL(RD'SPEEDY)^2)^.5;
  IF R'SPEED > R'MAX'SPEED THEN BEGIN
     OLD'SPEEDY := RD'SPEEDY;
     XNEG := RD'SPEEDX < 0;
     YNEG := RD'SPEEDY < 0;
     IF RD'SPEEDY <> 0 THEN
        RD'SPEEDY  := INTEGER(FIXT(R'MAX'SPEED/
                    (REAL(RD'SPEEDX)^2/REAL(RD'SPEEDY)^2+1.)^.5));
     IF OLD'SPEEDY <> 0 THEN
        RD'SPEEDX  := \INTEGER(FIXT(
           REAL(RD'SPEEDX)*REAL(RD'SPEEDY)/REAL(OLD'SPEEDY)))\
     ELSE RD'SPEEDX := INTEGER(FIXT(R'MAX'SPEED));
     IF XNEG THEN RD'SPEEDX := -RD'SPEEDX;
     IF YNEG THEN RD'SPEEDY := -RD'SPEEDY;
     WR'SPEEDY  := RD'SPEEDY;
     WR'SPEEDX  := RD'SPEEDX;
     END;
  NEW'X := INTEGER(RD'X) + RD'SPEEDX/DIST'PER'UPDATE;
  NEW'Y := INTEGER(RD'Y) + RD'SPEEDY/DIST'PER'UPDATE;
  NEW'SCREEN'COL := NEW'X/INTEGER(UNITS'PER'COL);
  NEW'SCREEN'ROW := (MAX'Y-NEW'Y)/INTEGER(UNITS'PER'ROW);
  OLD'SCREEN'COL := INTEGER(RD'X)/INTEGER(UNITS'PER'COL);
  OLD'SCREEN'ROW := INTEGER(MAX'Y-RD'Y)/INTEGER(UNITS'PER'ROW);
  NEW'TURR'SLICE := ((WR'TURRET+225) MOD 3600)/450;
  NEW'RADR'SLICE := ((WR'RADAR+225)  MOD 3600)/450;
  OLD'TURRET'COL := OLD'SCREEN'COL + XOFF(OLD'TURR'SLICE(DROID));
  OLD'TURRET'ROW := OLD'SCREEN'ROW + YOFF(OLD'TURR'SLICE(DROID));
  OLD'RADAR'COL := OLD'SCREEN'COL + XOFF(OLD'RADR'SLICE(DROID));
  OLD'RADAR'ROW := OLD'SCREEN'ROW + YOFF(OLD'RADR'SLICE(DROID));
  B'NAME := BYTE(DROID+65);          <<Has the droid moved and hit?>>
  IF GET'CHAR(NEW'SCREEN'ROW,NEW'SCREEN'COL) = ALPHA AND
     GET'CHAR(NEW'SCREEN'ROW,NEW'SCREEN'COL) <> "o"  AND
     GET'CHAR(NEW'SCREEN'ROW,NEW'SCREEN'COL) <> B'NAME THEN BEGIN
     RD'DAMAGE := RD'DAMAGE - 10;
     IF RD'DAMAGE <= 0 THEN BEGIN
        RD'DAMAGE := 0;
        KILL(DROID);
        END;
     IF NOT TEST'BENCH THEN DISPLAY'DAMAGE;
     IF DEAD(DROID)=TRUE THEN
        RETURN;
     RD'SPEEDX := WR'SPEEDX := 0;
     RD'SPEEDY := WR'SPEEDX := 0;
     NEW'X := RD'X;
     NEW'Y := RD'Y;
     NEW'SCREEN'COL := OLD'SCREEN'COL;
     NEW'SCREEN'ROW := OLD'SCREEN'ROW;
     END                             <<Else, has the droid moved?  >>
  ELSE IF GET'CHAR(NEW'SCREEN'ROW,NEW'SCREEN'COL)<>B'NAME THEN BEGIN
     IF GET'CHAR(OLD'TURRET'ROW,OLD'TURRET'COL)="o" THEN
        PUTCHAR (OLD'TURRET'ROW,OLD'TURRET'COL," ");
     IF GET'CHAR(OLD'RADAR'ROW,OLD'RADAR'COL)="." THEN
        PUTCHAR (OLD'RADAR'ROW,OLD'RADAR'COL," ");
     PUTCHAR (OLD'SCREEN'ROW,OLD'SCREEN'COL," ");
     PUTCHAR (NEW'SCREEN'ROW,NEW'SCREEN'COL,B'NAME);
     OLD'TURR'SLICE(DROID) :=        <<Force update of turr,radar. >>
                OLD'RADR'SLICE(DROID) := -1;
     END;
  RD'X := NEW'X;
  RD'Y := NEW'Y;
  IF NEW'TURR'SLICE <> OLD'TURR'SLICE(DROID) THEN BEGIN
     IF GET'CHAR(OLD'TURRET'ROW,OLD'TURRET'COL)="o" THEN
        PUTCHAR (OLD'TURRET'ROW,OLD'TURRET'COL," ");
     NEW'TURRET'COL := NEW'SCREEN'COL + XOFF(NEW'TURR'SLICE);
     NEW'TURRET'ROW := NEW'SCREEN'ROW + YOFF(NEW'TURR'SLICE);
     IF GET'CHAR(NEW'TURRET'ROW,NEW'TURRET'COL)=" " OR
        GET'CHAR(NEW'TURRET'ROW,NEW'TURRET'COL)="." THEN
        PUTCHAR (NEW'TURRET'ROW,NEW'TURRET'COL,"o");
     END;
  IF NEW'RADR'SLICE <> OLD'RADR'SLICE(DROID) THEN BEGIN
     IF GET'CHAR(OLD'RADAR'ROW,OLD'RADAR'COL)="." THEN
        PUTCHAR (OLD'RADAR'ROW,OLD'RADAR'COL," ");
     NEW'RADAR'COL  := NEW'SCREEN'COL + XOFF(NEW'RADR'SLICE);
     NEW'RADAR'ROW  := NEW'SCREEN'ROW + YOFF(NEW'RADR'SLICE);
     IF GET'CHAR(NEW'RADAR'ROW,NEW'RADAR'COL)=" " THEN
        PUTCHAR (NEW'RADAR'ROW,NEW'RADAR'COL,".");
     END;
  OLD'TURR'SLICE(DROID) := NEW'TURR'SLICE;
  OLD'RADR'SLICE(DROID) := NEW'RADR'SLICE;
  IF RD'DAMAGE <= 0 THEN BEGIN
     KILL(DROID);
     RD'DAMAGE:=0;
     END;
  IF TEST'BENCH AND DROID=BENCH'DROID THEN DISPLAY'SYS'REG;
  END;
$PAGE "DROID ** Procedure XEQ                  "
<<Executes DROID's code until SWAP exceeds SWAP'POINT.             >>

PROCEDURE XEQ(DROID);
  VALUE DROID;
  INTEGER DROID;
BEGIN

  INTEGER I,WORD'COUNT;
  LOGICAL T;
  DOUBLE D'CHECK;
  REAL DELTA'X,DELTA'Y,TRUE'X,TRUE'Y;
  ARRAY BUF(0:63);
    BYTE ARRAY B'BUF(*)=BUF;

  SUBROUTINE DO'JMP;
  BEGIN
    P'REG(DROID) := P'REG(DROID)+1;
    IF (P'REG(DROID) MOD PAGELEN)=0 THEN BEGIN
       LPAGE(DROID) := LPAGE(DROID)+1;
       IF NOT READ'PAGE (LPAGE(DROID),DROID) THEN RETURN;
       END;
    P'REG(DROID) :=
                PAGE(DROID*PAGELEN+(I'P'REG(DROID) MOD PAGELEN));
    END;

  SUBROUTINE DO'ABS;
  BEGIN
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) := \I'STACK(TEMP)\;
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'ADD;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)-1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) := STACK(TEMP)+STACK(TEMP+1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'AND;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) := STACK(TEMP) LAND STACK(TEMP+1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'COS;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) :=
        INTEGER(FIXR(REAL(I'STACK(TEMP))*COS'(REAL(STACK(TEMP+1)))));
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'DECR;
  BEGIN
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) := STACK(TEMP) - 1;
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'DEL;
  BEGIN
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)-1;
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'DIV;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)-1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    IF STACK(TEMP+1) = 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,DIV'BY'ZERO);
       RETURN;
       END;
    I'STACK(TEMP) := I'STACK(TEMP)/I'STACK(TEMP+1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'DUP;
  BEGIN
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    IF S'REG(DROID)=MAXSTACK THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'OVERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)+1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) := STACK(TEMP-1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'GSB;
  BEGIN
    IF S'REG(DROID)=MAXSTACK THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'OVERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)+1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    P'REG(DROID) := P'REG(DROID)+1;
    IF (P'REG(DROID) MOD PAGELEN)=0 THEN BEGIN
       LPAGE(DROID) := LPAGE(DROID)+1;
       IF NOT READ'PAGE (LPAGE(DROID),DROID) THEN RETURN;
       END;
    STACK(TEMP) := P'REG(DROID) + 1;
    P'REG(DROID) :=
               PAGE(DROID*PAGELEN+(I'P'REG(DROID) MOD PAGELEN));
    END;

  SUBROUTINE DO'HALT;
  BEGIN
    RUN'TIME'ERROR (DROID,SWAP,0);
    END;

  SUBROUTINE DO'INCR;
  BEGIN
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) := STACK(TEMP) + 1;
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'JEQ;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 2;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    IF STACK(TEMP+1) = STACK(TEMP+2) THEN DO'JMP
    ELSE P'REG(DROID) := P'REG(DROID)+2;
    END;

  SUBROUTINE DO'JGE;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 2;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    IF I'STACK(TEMP+1) >= I'STACK(TEMP+2) THEN DO'JMP
    ELSE P'REG(DROID) := P'REG(DROID)+2;
    END;

  SUBROUTINE DO'JGT;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 2;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    IF I'STACK(TEMP+1) > I'STACK(TEMP+2) THEN DO'JMP
    ELSE P'REG(DROID) := P'REG(DROID)+2;
    END;

  SUBROUTINE DO'JLE;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 2;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    IF I'STACK(TEMP+1) <= I'STACK(TEMP+2) THEN DO'JMP
    ELSE P'REG(DROID) := P'REG(DROID)+2;
    END;

  SUBROUTINE DO'JLT;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 2;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    IF I'STACK(TEMP+1) < I'STACK(TEMP+2) THEN DO'JMP
    ELSE P'REG(DROID) := P'REG(DROID)+2;
    END;

  SUBROUTINE DO'JNE;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 2;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    IF I'STACK(TEMP+1) <> I'STACK(TEMP+2) THEN DO'JMP
    ELSE P'REG(DROID) := P'REG(DROID)+2;
    END;

  SUBROUTINE DO'JNZ;
  BEGIN
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    IF STACK(TEMP+1) <> 0 THEN DO'JMP
    ELSE P'REG(DROID) := P'REG(DROID)+2;
    END;

  SUBROUTINE DO'JZR;
  BEGIN
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    IF STACK(TEMP+1) = 0 THEN DO'JMP
    ELSE P'REG(DROID) := P'REG(DROID)+2;
    END;

  SUBROUTINE DO'LDI;
  BEGIN
    P'REG(DROID) := P'REG(DROID)+1;
    IF (P'REG(DROID) MOD PAGELEN)=0 THEN BEGIN
       LPAGE(DROID) := LPAGE(DROID)+1;
       IF NOT READ'PAGE (LPAGE(DROID),DROID) THEN RETURN;
       END;
    IF S'REG(DROID)=MAXSTACK THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'OVERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)+1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) :=
                  PAGE(DROID*PAGELEN+(I'P'REG(DROID) MOD PAGELEN));
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'LAB;
  BEGIN
    BUF:="  "; MOVE BUF(1) := BUF,(63);
    WORD'COUNT := (C'OPRND+1)/2;
    FOR I := 0 UNTIL WORD'COUNT-1 DO BEGIN
       P'REG(DROID) := P'REG(DROID)+1;
       IF (P'REG(DROID) MOD PAGELEN)=0 THEN BEGIN
          LPAGE(DROID) := LPAGE(DROID)+1;
          IF NOT READ'PAGE (LPAGE(DROID),DROID) THEN RETURN;
          END;
       BUF(I) := PAGE(DROID*PAGELEN+(I'P'REG(DROID) MOD PAGELEN));
       END;
    P'REG(DROID) := P'REG(DROID)+1;
    IF NOT TEST'BENCH THEN BEGIN
       POS'CUR(DROID*3+2,65);
       DISPLAY B'BUF,(10) ASK;
       END
    ELSE IF DROID=BENCH'DROID THEN BEGIN
       POS'CUR (0,44);
       DISPLAY "LAB = " CONCAT B'BUF,(10) ASK;
       END;
    END;

  SUBROUTINE DO'LOAD;
  BEGIN
    IF NOT LOADOK(CODE) THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,INVALID'REGISTER);
       RETURN;
       END;
    IF S'REG(DROID)=MAXSTACK THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'OVERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)+1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    I:=C'OPRND;
    IF I=RANDOM'REG THEN RD'RANDOM:=RANDOM(WR'RANDOM);
    STACK(TEMP) := RD'REG(DROID*MAXREG+I);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'MAX;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)-1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    I'STACK(TEMP) := IF I'STACK(TEMP) > I'STACK(TEMP+1) THEN
                              I'STACK(TEMP) ELSE I'STACK(TEMP+1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'MIN;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)-1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    I'STACK(TEMP) := IF I'STACK(TEMP) < I'STACK(TEMP+1) THEN
                              I'STACK(TEMP) ELSE I'STACK(TEMP+1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'MOD;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    I'STACK(TEMP) := I'STACK(TEMP) MOD I'STACK(TEMP+1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'MUL;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)-1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    D'CHECK := DOUBLE(I'STACK(TEMP))*DOUBLE(I'STACK(TEMP+1));
    IF D'CHECK > 32767D OR D'CHECK < -32768D THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,INTEGER'OVERFLOW);
       RETURN;
       END;
    I'STACK(TEMP) := I'STACK(TEMP)*I'STACK(TEMP+1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'NEG;
  BEGIN
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP):=NOT STACK(TEMP)+1;
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'NOP;
  BEGIN
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'NOT;
  BEGIN
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP):=NOT STACK(TEMP);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'OR;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) := STACK(TEMP) LOR STACK(TEMP+1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'PTOR;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    DELTA'X := REAL(I'STACK(TEMP-1))*COS'(REAL(I'STACK(TEMP)));
    DELTA'Y := REAL(I'STACK(TEMP-1))*SIN'(REAL(I'STACK(TEMP)));
    I'STACK(TEMP)   := INTEGER(FIXR(DELTA'X));
    I'STACK(TEMP-1) := INTEGER(FIXR(DELTA'Y));
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'RECV;
  BEGIN
    P'REG(DROID) := P'REG(DROID)+1;
    IF (P'REG(DROID) MOD PAGELEN)=0 THEN BEGIN
       LPAGE(DROID) := LPAGE(DROID)+1;
       IF NOT READ'PAGE (LPAGE(DROID),DROID) THEN RETURN;
       END;
    IF S'REG(DROID)=MAXSTACK THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'OVERFLOW);
       RETURN;
       END;
    TEMP := PAGE(DROID*PAGELEN+(I'P'REG(DROID) MOD PAGELEN));
    IF TEMP>MAX'FREQ THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,INVALID'REGISTER);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)+1;
    STACK(DROID*MAXSTACK+I'S'REG(DROID)) := SEDS(TEMP);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'RET;
  BEGIN
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    P'REG(DROID) := STACK(TEMP+1);
    END;

  SUBROUTINE DO'RTOP;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    DELTA'X := REAL(I'STACK(TEMP));
    DELTA'Y := REAL(I'STACK(TEMP-1));
    IF DELTA'X=0. THEN DELTA'X := .01;
    I'STACK(TEMP) := INTEGER(FIXR(ARCTAN'(DELTA'Y/DELTA'X)));
    IF DELTA'X<0. THEN               <<If delta'X < 0 then add 1800>>
       I'STACK(TEMP) := I'STACK(TEMP) + 1800;
    I'STACK(TEMP) := (I'STACK(TEMP)+3600) MOD 3600;
    I'STACK(TEMP-1) := INTEGER(FIXR((DELTA'X^2+DELTA'Y^2)^.5));
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'STOR;
  BEGIN
    IF NOT STOROK(CODE) THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,INVALID'REGISTER);
       RETURN;
       END;
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)-1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    I:=C'OPRND;
    IF I>25 THEN
         WR'REG(DROID*MAXREG+I) := T := STACK(TEMP+1)
    ELSE RD'REG(DROID*MAXREG+I) := T := STACK(TEMP+1);
    IF I=WIDTH'REG THEN
       RD'REG(DROID*MAXREG+I):=T;
    IF I=RADAR'REG THEN BEGIN
       DO'RADAR(DROID);
       SWAP := SWAP+COST'RADAR;
       END;
    IF I=SHOT'REG  THEN SWAP := SWAP'POINT+1;
    IF I=TURRET'REG THEN SWAP := SWAP'POINT+1;
    IF I=RANDOM'REG THEN RD'RANDOM:=RANDOM(T);
    IF TEST'BENCH AND DROID=BENCH'DROID
                              AND (I<=25 OR WRITE'MODE) THEN
       DISPLAY'VALUE (REG'ROW(I),REG'COL(I),T);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'SIN;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) :=
        INTEGER(FIXR(REAL(I'STACK(TEMP))*SIN'(REAL(STACK(TEMP+1)))));
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'SUB;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID)-1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) := STACK(TEMP)-STACK(TEMP+1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'SWAP;
  BEGIN
    SWAP := SWAP'POINT+1;
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'TRAN;
  BEGIN
    P'REG(DROID) := P'REG(DROID)+1;
    IF (P'REG(DROID) MOD PAGELEN)=0 THEN BEGIN
       LPAGE(DROID) := LPAGE(DROID)+1;
       IF NOT READ'PAGE (LPAGE(DROID),DROID) THEN RETURN;
       END;
    IF I'S'REG(DROID) < 0 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    TEMP := PAGE(DROID*PAGELEN+(I'P'REG(DROID) MOD PAGELEN));
    IF TEMP>MAX'FREQ THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,INVALID'REGISTER);
       RETURN;
       END;
    SEDS(TEMP) := STACK(DROID*MAXSTACK+I'S'REG(DROID));
    S'REG(DROID) := S'REG(DROID)-1;
    P'REG(DROID) := P'REG(DROID)+1;
    SWAP := SWAP + COST'TRAN;
    END;

  SUBROUTINE DO'XCHG;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    T := STACK(TEMP);
    STACK(TEMP) := STACK(TEMP-1);
    STACK(TEMP-1) := T;
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE DO'XOR;
  BEGIN
    IF I'S'REG(DROID) < 1 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,STACK'UNDERFLOW);
       RETURN;
       END;
    S'REG(DROID) := S'REG(DROID) - 1;
    TEMP := DROID*MAXSTACK+I'S'REG(DROID);
    STACK(TEMP) := STACK(TEMP) XOR STACK(TEMP+1);
    P'REG(DROID) := P'REG(DROID)+1;
    END;

  SUBROUTINE ARITHMETIC'OPS;
  BEGIN
    IF C'INSTR > 12 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,INVALID'INSTRUCTION);
       RETURN;
       END;
    CASE C'INSTR OF BEGIN
      <<0>> DO'ADD;
      <<1>> DO'SUB;
      <<2>> DO'MUL;
      <<3>> DO'DIV;
      <<4>> DO'NEG;
      <<5>> DO'MOD;
      <<6>> DO'ABS;
      <<7>> DO'RTOP;
      <<8>> DO'PTOR;
      <<9>> DO'SIN;
     <<10>> DO'COS;
     <<11>> DO'MIN;
     <<12>> DO'MAX;
      END;

    IF TEST'BENCH AND DROID=BENCH'DROID THEN DISPLAY'STACK;
    END;

  SUBROUTINE JUMP'OPS;
  BEGIN
    IF C'INSTR > 10 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,INVALID'INSTRUCTION);
       RETURN;
       END;
    CASE C'INSTR OF BEGIN
      << 0>> DO'JMP;
      << 1>> DO'JEQ;
      << 2>> DO'JNE;
      << 3>> DO'JLT;
      << 4>> DO'JGT;
      << 5>> DO'JLE;
      << 6>> DO'JGE;
      << 7>> DO'JZR;
      << 8>> DO'JNZ;
      << 9>> DO'GSB;
      <<10>> DO'RET;
      END;
    IF TEST'BENCH AND DROID=BENCH'DROID THEN DISPLAY'STACK;
    END;

  SUBROUTINE LOGICAL'OPS;
  BEGIN
    IF C'INSTR > 3 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,INVALID'INSTRUCTION);
       RETURN;
       END;
    CASE C'INSTR OF BEGIN
      <<0>> DO'AND;
      <<1>> DO'OR;
      <<2>> DO'XOR;
      <<3>> DO'NOT;
      END;
    IF TEST'BENCH AND DROID=BENCH'DROID THEN DISPLAY'STACK;
    END;

  SUBROUTINE SPECIAL'OPS;
  BEGIN
    IF C'INSTR > 5 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,INVALID'INSTRUCTION);
       RETURN;
       END;
    CASE C'INSTR OF BEGIN
       <<0>> DO'LAB;
       <<1>> DO'NOP;
       <<2>> DO'HALT;
       <<3>> DO'SWAP;
       <<4>> DO'RECV;
       <<5>> DO'TRAN;
       END;
     END;

  SUBROUTINE STACK'MEM'OPS;
  BEGIN
    IF C'INSTR > 7 THEN BEGIN
       RUN'TIME'ERROR (DROID,SWAP,INVALID'INSTRUCTION);
       RETURN;
       END;
    CASE C'INSTR OF BEGIN
      <<0>> DO'LOAD;
      <<1>> DO'STOR;                 <<Displays new register val.  >>
      <<2>> DO'LDI;
      <<3>> DO'XCHG;
      <<4>> DO'DEL;
      <<5>> DO'INCR;
      <<6>> DO'DECR;
      <<7>> DO'DUP;
      END;
    IF TEST'BENCH AND DROID=BENCH'DROID THEN DISPLAY'STACK;
    END;
$PAGE "DROID ** Procedure XEQ   main proc body "
  DROID'PAGE := DROID*PAGELEN;
  SWAP := 0;
  WHILE SWAP < SWAP'POINT DO BEGIN
     CURR'PAGE := P'REG(DROID)/PAGELEN;
     IF CURR'PAGE <> I'LPAGE(DROID) THEN BEGIN
        IF NOT READ'PAGE (CURR'PAGE,DROID) THEN RETURN;
        LPAGE(DROID) := CURR'PAGE;
        SWAP := SWAP + COST'PAGE'IN;
        END;
     IF TEST'BENCH AND DROID=BENCH'DROID THEN BEGIN
        DISPLAY'INSTR;
        DO BEGIN
           POS'CUR (22,2);
           DISPLAY "Command: " ASK;
           BUF := "X ";
           READ(BUF,-1);
           BUF.(2:1) := 0; <<upshift>>
           IF      B'BUF="X" THEN <<Same as <CR>>
           ELSE IF B'BUF="W" THEN BEGIN
              WRITE'MODE := TRUE;
              DISPLAY'SYS'REG;
              END
           ELSE IF B'BUF="R" THEN BEGIN
              WRITE'MODE := FALSE;
              DISPLAY'SYS'REG;
              END
           ELSE IF B'BUF="S" THEN RETURN <<SWAP>>
           ELSE IF B'BUF="Q" THEN BEGIN
              CTL'Y := TRUE;
              RETURN;
              END
           ELSE IF B'BUF="Z" THEN BEGIN
              SWAP := 0;
              DISPLAY'INSTR;
              END
           ELSE BEEP;
           END UNTIL B'BUF="X";
        END;
     PAGE'OFFSET := P'REG(DROID) MOD PAGELEN;
     CODE := PAGE(DROID'PAGE + PAGE'OFFSET);
     CASE C'GROUP OF BEGIN
       <<0>> STACK'MEM'OPS;
       <<1>> ARITHMETIC'OPS;
       <<2>> LOGICAL'OPS;
       <<3>> JUMP'OPS;
       <<4>> RUN'TIME'ERROR (DROID,SWAP,INVALID'INSTRUCTION);
       <<5>> RUN'TIME'ERROR (DROID,SWAP,INVALID'INSTRUCTION);
       <<6>> RUN'TIME'ERROR (DROID,SWAP,INVALID'INSTRUCTION);
       <<7>> SPECIAL'OPS;
       END;
     SWAP := SWAP + 1;
     D'INSTR'EXECUTED := D'INSTR'EXECUTED + 1D;
     IF D'INSTR'EXECUTED MOD 251D = 0D AND NOT TEST'BENCH THEN
        DISPLAY'TIME;
     END;
  END;
$PAGE "DROID ** MAIN"
  GO START;
TEST:
  TEST'BENCH := TRUE;
  GO START;
TOURNEY:
  DISPLAY "DROID ** DOS A.03 ** Tournament Mode" EOD;
  LINE'FEED;
  WHO(MODE);
  GET'TOURNAMENT'INFO;

START:
  IF SAVE'NO'BATTLES <= 1 THEN BEGIN
     DISPLAY "DROID ** DOS A.03 ** Reichhold Chemicals, Inc." ASK;
     IF TEST'BENCH THEN DISPLAY " ** TEST BENCH MODE" EOD
     ELSE DISPLAY " ** Single Match Mode" EOD;
     LINE'FEED;
     END;
  WHO(MODE);
  OPEN'PROGFILES(NUM'DROIDS);        <<Open droids.                >>
  SAVE'PARM := RUN'PARM;
  DRAW'SCREEN(NUM'DROIDS);
  D'START'SECONDS := TIMER;

NEXT'BATTLE:
  IF SAVE'NO'BATTLES > 1 THEN BEGIN
     BLANK'BUF;
     MOVE B'BUF := "Match: ";
     I := ASCII((SAVE'NO'BATTLES-NO'BATTLES+1),10,B'BUF(7));
     POS'CUR (0,67);
     DISPLAY B'BUF,(7+I) ASK;
     IF NOLIST AND SESSION THEN PRINT(BUF,-(7+I),%53);
     MOVE REM'DAMAGE := MAXDROIDS(0);
     FOR DROID := 0 UNTIL NUM'DROIDS-1 DO
         DISPLAY'REMOTE'DAMAGE(DROID);
     POS'CUR(23,4);
     BLANK'BUF;
     DISPLAY B'BUF,(NUM'DROIDS*4) ASK;
     END;
  INITIALIZE;                        <<Initialize segments & stacks>>

  IF TEST'BENCH THEN BEGIN
     DROID := 0;
     DISPLAY'STACK;
     DISPLAY'SYS'REG;
     END
  ELSE DROID := RANDOM(NUM'DROIDS-1);
  WHILE NOT FINISHED DO BEGIN
     IF NOT DEAD(DROID) THEN BEGIN
        XEQ(DROID);                  <<XEQ a droid until SWAPPOINT >>
        UPDATE(DROID);               <<then update that droid.     >>
        IF NUM'DROIDS > 1 THEN
           DEAD'LOCK := DEAD'LOCK + 1;
        END;
     IF DEAD'DROIDS = NUM'DROIDS - 1 AND NUM'DROIDS > 1 AND
                NOT DEAD(DROID) THEN BEGIN
        IF SAVE'NO'BATTLES > 1 THEN
           COMPILE'BATTLE'STATISTICS;
        KILL(DROID);
        IF NOT TEST'BENCH THEN DISPLAY'TIME;
        POS'CUR(25,1);
        GO CHECK'NO'BATTLES;
        END;
     DROID := (DROID+1) MOD NUM'DROIDS;
CHECK'DEAD:
     IF CTL'Y OR DEAD'LOCK > MAX'DEAD'LOCK AND NOT TEST'BENCH AND
                                   NUM'DROIDS > 1 THEN BEGIN
        MOST'INJURED := 101;
        FINISHED := TRUE;
        FOR DROID := 0 UNTIL NUM'DROIDS - 1 DO BEGIN
           IF NOT DEAD(DROID) THEN BEGIN
              IF MOST'INJURED > RD'DAMAGE THEN BEGIN
                 MOST'INJURED := RD'DAMAGE;
                 LAST'DROID := DROID;
                 END;
              END;
           END;
        IF DEAD'DROIDS = NUM'DROIDS-1 THEN
           IF SAVE'NO'BATTLES > 1 THEN
              COMPILE'BATTLE'STATISTICS;
        KILL(LAST'DROID);
        IF DEAD'DROIDS < NUM'DROIDS THEN
           GO CHECK'DEAD;
        END;
     END;
  IF TEST'BENCH THEN BEGIN
     DROID := BENCH'DROID;
     DISPLAY'SYS'REG;
     END
  ELSE DISPLAY'TIME;
  IF CTL'Y THEN BEGIN
     POS'CUR(25,0);
     DISPLAY "DOS ABORTED." EOD;
     IF SAVE'NO'BATTLES > 1 THEN
        DISPLAY'BATTLE'STATISTICS;
     RETURN;
     END;
  IF DEAD'LOCK > MAX'DEAD'LOCK THEN BEGIN
     IF SAVE'NO'BATTLES <= 1 THEN BEGIN
        POS'CUR(25,0);
        DISPLAY "DEADLOCK DETECTED." EOD;
        END;
     TOTAL'DEADLOCKS := TOTAL'DEADLOCKS+1;
     END;
CHECK'NO'BATTLES:
  IF NO'BATTLES > 1 THEN BEGIN
     NO'BATTLES := NO'BATTLES-1;
     GO NEXT'BATTLE;
     END;
  IF SAVE'NO'BATTLES > 1 THEN
     DISPLAY'BATTLE'STATISTICS;
$PAGE "DROID ** MAP"
  END.
PROCEDURE DISPLAY'OCTAL (ROW,COL,VAL);
  VALUE ROW,COL,VAL;
  INTEGER ROW,COL,VAL;
BEGIN