Add standalone dump_entries and dump_segments programs, use dump_segments to add...

diff --git a/.gitignore b/.gitignore
index a3a29dc..ba3f6bd 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,6 @@
 *.o
+/dump_entries
+/dump_segments
 /multics_sim
 /tape/*.tap
 /tape/char

diff --git a/Makefile b/Makefile
index d62db25..443c873 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,8 @@
 CFLAGS=-g -std=c99 -U__STRICT_ANSI__ -IdecNumber -Idps8 -D_GNU_SOURCE -DUSE_READER_THREAD -DUSE_INT64 -DTESTING -Wall -Wno-comment -Wno-unused-label -Wno-unused-result -Wno-unused-value -Wno-unused-variable -Wno-unused-function
 #-O3
 
+all: multics_sim dump_entries dump_segments
+
 multics_sim: \
 multics_sim.o \
 pointer.o \
@@ -30,8 +32,30 @@ dps8/dps8_utils.o \
 dps8/hdbg.o
        ${CC} ${CFLAGS} -o $@ $^ -lm
 
-multics_sim.o: multics_sim.c definition_dcls.h object_map.h rassert.h
+dump_entries: \
+dump_entries.o \
+definition_dcls.o
+       ${CC} ${CFLAGS} -o $@ $^ -lm
+
+dump_segments: \
+dump_segments.o \
+definition_dcls.o
+
+multics_sim.o: \
+multics_sim.c \
+definition_dcls.h \
+dps8/dps8.h \
+dps8/dps8_cpu.h \
+dps8/dps8_sys.h \
+linkdcl.h \
+object_map.h \
+pointer.h \
+rassert.h \
+stack_header.h
+dump_entries.o: dump_entries.c definition_dcls.h object_map.h rassert.h
+dump_segments.o: dump_segments.c definition_dcls.h object_map.h rassert.h
 definition_dcls.o: definition_dcls.c definition_dcls.h
+pointer.o: pointer.c pointer.h
 decNumber/decContext.o: decNumber/decContext.c
 decNumber/decDouble.o: decNumber/decDouble.c
 decNumber/decimal128.o: decNumber/decimal128.c
@@ -57,4 +81,4 @@ dps8/dps8_utils.o: dps8/dps8_utils.c
 dps8/hdbg.o: dps8/hdbg.c
 
 clean:
-       rm -f *.o decNumber/*.o dps8/*.o multics_sim
+       rm -f *.o decNumber/*.o dps8/*.o multics_sim dump_entries dump_segments

diff --git a/dump_entries.c b/dump_entries.c
new file mode 100644 (file)
index 0000000..552a023
--- /dev/null
+++ b/dump_entries.c
@@ -0,0 +1,179 @@
+#include <fcntl.h>
+#include <stdbool.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/mman.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include "definition_dcls.h"
+#include "object_map.h"
+#include "rassert.h"
+
+uint64_t *load_segment(const char *path, int *bitcount) {
+  int fd = open(path, O_RDONLY);
+  if (fd == -1) {
+    fprintf(stderr, "can't find segment at %s\n", path);
+    exit(EXIT_FAILURE);
+  }
+
+  uint64_t *segment = (uint64_t *)mmap(
+    NULL,
+    01000000 * sizeof(uint64_t),
+    PROT_READ,
+    MAP_SHARED,
+    fd,
+    (off_t)0
+  );
+  rassert(segment != (uint64_t *)-1);
+
+  struct stat stat_buf;
+  rassert(fstat(fd, &stat_buf) != -1);
+
+  close(fd);
+
+  int i = strlen(path);
+  for (; i && path[i - 1] != '/'; --i)
+    ;
+  const char *name = path + i;
+
+  char path_dir[0x1000];
+  rassert(i + 4 < sizeof(path_dir));
+  memcpy(path_dir, path, i);
+  strcpy(path_dir + i, ".dir");
+
+  FILE *fp = fopen(path_dir, "r");
+  if (fp == NULL) {
+    fprintf(stderr, "can't find index %s\n", path_dir);
+    exit(EXIT_FAILURE);
+  }
+  char line[0x100];
+  while (fgets(line, 0x100, fp)) {
+    char *p = strchr(line, ' ');
+    if (p) {
+      *p++ = 0;
+      if (strcmp(line, name) == 0) {
+        fclose(fp);
+        *bitcount = (int)strtol(p, NULL, 0);
+        goto found_bitcount;
+      }
+    }
+  }
+  fclose(fp);
+
+  fprintf(stderr, "can't find segment name %s in index %s\n", name, path_dir);
+  exit(EXIT_FAILURE);
+
+found_bitcount:
+  if (*bitcount > (stat_buf.st_size / sizeof(uint64_t)) * 36) {
+    fprintf(
+      stderr,
+      "file size %ld bytes too short for bitcount %d\n",
+      stat_buf.st_size,
+      *bitcount
+    );
+    exit(EXIT_FAILURE);
+  }
+
+  return segment;
+}
+
+struct object_map *get_object_map(uint64_t *segment, int bitcount) {
+  if (bitcount % 36 != 0) {
+    fprintf(stderr, "bitcount %d not multiple of 36\n", bitcount);
+    exit(EXIT_FAILURE);
+  }
+
+  int wordcount = (bitcount / 36) & 0777777;
+  if (wordcount < 1) {
+    fprintf(stderr, "wordcount %d too short\n", wordcount);
+    exit(EXIT_FAILURE);
+  }
+
+  int object_map_offset = (segment[wordcount - 1] >> 18) & 0777777;
+  if (
+    object_map_offset + sizeof(struct object_map) / sizeof(uint64_t) + 1 >
+      wordcount
+  ) {
+    printf("bad object map offset\n");
+    exit(EXIT_FAILURE);
+  }
+
+  struct object_map *object_map = (struct object_map *)(
+    segment + object_map_offset
+  );
+  if (
+    object_map->decl_vers != 2 ||
+    object_map->identifier[0] != 0157142152137 || // 'obj_'
+    object_map->identifier[1] != 0155141160040 // 'map '
+  ) {
+    fprintf(stderr, "bad object map signature\n");
+    exit(EXIT_FAILURE);
+  }
+
+  return object_map;
+}
+
+void get_acc_string(uint64_t *acc_string, char *buf, int buf_len) {
+  int len = (acc_string[0] >> 27) & 0777;
+  rassert(len < buf_len);
+
+  static int shifts[4] = {27, 18, 9, 0};
+  for (int i = 0, j = 1; i < len; ++i, ++j)
+    buf[i] = (acc_string[j >> 2] >> shifts[j & 3]) & 0xff;
+  buf[len] = 0;
+}
+
+void dump_entries(uint64_t *segment, int bitcount) {
+  struct object_map *object_map = get_object_map(segment, bitcount);
+  struct definition_header *definition_header = (struct definition_header *)(
+    segment + object_map->definition_offset
+  );
+
+  for (
+    struct definition *definition = (struct definition *)(
+      (uint64_t *)definition_header + definition_header->def_list_relp
+    );
+    *(uint64_t *)definition;
+    definition = (struct definition *)(
+      (uint64_t *)definition_header + definition->forward_relp
+    )
+  ) {
+    char name[0x100];
+    get_acc_string(
+      (uint64_t *)definition_header + definition->name_relp,
+      name,
+      sizeof(name)
+    );
+    printf(
+      "%06o %s \"%s\" ignore %d entry %d indirect %d %s_relp %06o %s_relp %06o\n",
+      (int)((uint64_t *)definition - (uint64_t *)definition_header),
+      class_names[definition->class],
+      name,
+      definition->flags_ignore,
+      definition->flags_entry,
+      definition->flags_indirect,
+      definition->class == CLASS_SEGNAME ? "next_segname" : "thing",
+      definition->thing_relp,
+      definition->class == CLASS_SEGNAME ? "first" : "segname",
+      definition->segname_relp
+    );
+  }
+}
+
+int main(int argc, char **argv) {
+  if (argc < 2) {
+    printf(
+      "usage: %s path_to_segment\n",
+      argv[0]
+    );
+    exit(EXIT_FAILURE);
+  }
+
+  int bitcount;
+  uint64_t *segment = load_segment(argv[1], &bitcount);
+  dump_entries(segment, bitcount);
+
+  return 0;
+}

diff --git a/dump_segments.c b/dump_segments.c
new file mode 100644 (file)
index 0000000..e7e759e
--- /dev/null
+++ b/dump_segments.c
@@ -0,0 +1,170 @@
+#include <fcntl.h>
+#include <stdbool.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <sys/mman.h>
+#include <sys/stat.h>
+#include <unistd.h>
+#include "definition_dcls.h"
+#include "object_map.h"
+#include "rassert.h"
+
+uint64_t *load_segment(const char *path, int *bitcount) {
+  int fd = open(path, O_RDONLY);
+  if (fd == -1) {
+    fprintf(stderr, "can't find segment at %s\n", path);
+    exit(EXIT_FAILURE);
+  }
+
+  uint64_t *segment = (uint64_t *)mmap(
+    NULL,
+    01000000 * sizeof(uint64_t),
+    PROT_READ,
+    MAP_SHARED,
+    fd,
+    (off_t)0
+  );
+  rassert(segment != (uint64_t *)-1);
+
+  struct stat stat_buf;
+  rassert(fstat(fd, &stat_buf) != -1);
+
+  close(fd);
+
+  int i = strlen(path);
+  for (; i && path[i - 1] != '/'; --i)
+    ;
+  const char *name = path + i;
+
+  char path_dir[0x1000];
+  rassert(i + 4 < sizeof(path_dir));
+  memcpy(path_dir, path, i);
+  strcpy(path_dir + i, ".dir");
+
+  FILE *fp = fopen(path_dir, "r");
+  if (fp == NULL) {
+    fprintf(stderr, "can't find index %s\n", path_dir);
+    exit(EXIT_FAILURE);
+  }
+  char line[0x100];
+  while (fgets(line, 0x100, fp)) {
+    char *p = strchr(line, ' ');
+    if (p) {
+      *p++ = 0;
+      if (strcmp(line, name) == 0) {
+        fclose(fp);
+        *bitcount = (int)strtol(p, NULL, 0);
+        goto found_bitcount;
+      }
+    }
+  }
+  fclose(fp);
+
+  fprintf(stderr, "can't find segment name %s in index %s\n", name, path_dir);
+  exit(EXIT_FAILURE);
+
+found_bitcount:
+  if (*bitcount > (stat_buf.st_size / sizeof(uint64_t)) * 36) {
+    fprintf(
+      stderr,
+      "file size %ld bytes too short for bitcount %d\n",
+      stat_buf.st_size,
+      *bitcount
+    );
+    exit(EXIT_FAILURE);
+  }
+
+  return segment;
+}
+
+struct object_map *get_object_map(uint64_t *segment, int bitcount) {
+  if (bitcount % 36 != 0) {
+    fprintf(stderr, "bitcount %d not multiple of 36\n", bitcount);
+    exit(EXIT_FAILURE);
+  }
+
+  int wordcount = (bitcount / 36) & 0777777;
+  if (wordcount < 1) {
+    fprintf(stderr, "wordcount %d too short\n", wordcount);
+    exit(EXIT_FAILURE);
+  }
+
+  int object_map_offset = (segment[wordcount - 1] >> 18) & 0777777;
+  if (
+    object_map_offset + sizeof(struct object_map) / sizeof(uint64_t) + 1 >
+      wordcount
+  ) {
+    printf("bad object map offset\n");
+    exit(EXIT_FAILURE);
+  }
+
+  struct object_map *object_map = (struct object_map *)(
+    segment + object_map_offset
+  );
+  if (
+    object_map->decl_vers != 2 ||
+    object_map->identifier[0] != 0157142152137 || // 'obj_'
+    object_map->identifier[1] != 0155141160040 // 'map '
+  ) {
+    fprintf(stderr, "bad object map signature\n");
+    exit(EXIT_FAILURE);
+  }
+
+  return object_map;
+}
+
+void get_acc_string(uint64_t *acc_string, char *buf, int buf_len) {
+  int len = (acc_string[0] >> 27) & 0777;
+  rassert(len < buf_len);
+
+  static int shifts[4] = {27, 18, 9, 0};
+  for (int i = 0, j = 1; i < len; ++i, ++j)
+    buf[i] = (acc_string[j >> 2] >> shifts[j & 3]) & 0xff;
+  buf[len] = 0;
+}
+
+void dump_segments(uint64_t *segment, int bitcount) {
+  struct object_map *object_map = get_object_map(segment, bitcount);
+  struct definition_header *definition_header = (struct definition_header *)(
+    segment + object_map->definition_offset
+  );
+
+  for (
+    struct segname_definition *segname_definition =
+      (struct segname_definition *)(
+        (uint64_t *)definition_header + definition_header->def_list_relp
+      );
+    *(uint64_t *)segname_definition;
+    segname_definition = (struct segname_definition *)(
+      (uint64_t *)definition_header + segname_definition->next_segname_relp
+    )
+  ) {
+    rassert(segname_definition->class == CLASS_SEGNAME);
+
+    char name[0x100];
+    get_acc_string(
+      (uint64_t *)definition_header + segname_definition->name_relp,
+      name,
+      sizeof(name)
+    );
+    printf("%s\n", name);
+  }
+}
+
+int main(int argc, char **argv) {
+  if (argc < 2) {
+    printf(
+      "usage: %s path_to_segment\n",
+      argv[0]
+    );
+    exit(EXIT_FAILURE);
+  }
+
+  int bitcount;
+  uint64_t *segment = load_segment(argv[1], &bitcount);
+  dump_segments(segment, bitcount);
+
+  return 0;
+}

diff --git a/multics_sim.c b/multics_sim.c
index 4b01ad7..e7a4983 100644 (file)
--- a/multics_sim.c
+++ b/multics_sim.c
@@ -38,23 +38,15 @@ struct arg_desc {
   uint64_t dummy0 : 28;
 };
 
-// hack, until we can do alternative names
-#define N_XLATE 5
-struct {
-  const char *from;
-  const char *to;
-} xlate[N_XLATE] = {
-  {"ioa_", "bound_library_wired_"},
-  {"calc", "bound_calc_"},
-  {"com_err_", "bound_library_1_"},
-  {"cu_", "bound_library_1_"},
-  {"pl1_operators_", "bound_library_wired_"}
-};
-
-#define N_PATHS 2
+#define N_PATHS 7
 char *paths[N_PATHS] = {
+  "tape/word/library_dir_dir/system_library_1/execution/",
   "tape/word/system_library_1/",
-  "tape/word/system_library_standard/"
+  "tape/word/system_library_3rd_party/C_COMPILER/executable/",
+  "tape/word/system_library_obsolete/",
+  "tape/word/system_library_standard/",
+  "tape/word/system_library_tools/",
+  "tape/word/system_library_unbundled/"
 };
 
 #define N_LOADED_SEGMENT 0x100
@@ -130,13 +122,40 @@ int allocate_linkage(int length, bool even) {
   return offset;
 }
 
-// hack, until we can do alternative names
 const char *xlate_segment(const char *name) {
-  for (int i = 0; i < N_XLATE; ++i)
-    if (strcmp(name, xlate[i].from) == 0)
-      return xlate[i].to;
-  printf("cannot xlate %s\n", name);
-  return name; //exit(EXIT_FAILURE);
+  // search for segment in path
+  int path_index;
+  for (path_index = 0; path_index < N_PATHS; ++path_index) {
+    char path[0x1000];
+    rassert(strlen(paths[path_index]) + 6 < sizeof(path));
+    strcpy(path, paths[path_index]);
+    strcat(path, ".xlate");
+
+    FILE *fp = fopen(path, "r");
+    if (fp == NULL) {
+      fprintf(stderr, "can't find index %s\n", path);
+      exit(EXIT_FAILURE);
+    }
+    static char line[0x100];
+    while (fgets(line, 0x100, fp)) {
+      char *q = strchr(line, ' ');
+      if (q) {
+        *q++ = 0;
+        if (strcmp(line, name) == 0) {
+          fclose(fp);
+          char *r = strchr(q, '\n');
+          if (r)
+            *r = 0;
+          printf("xlate segment %s to %s\n", name, q);
+          return q;
+        }
+      }
+    }
+    fclose(fp);
+  }
+
+  printf("can't xlate segment %s\n", name);
+  return name;
 }
 
 struct loaded_segment *load_segment(const char *name) {
@@ -190,17 +209,23 @@ found_segment:
   strcat(path, ".dir");
 
   FILE *fp = fopen(path, "r");
+  if (fp == NULL) {
+    fprintf(stderr, "can't find index %s\n", path);
+    exit(EXIT_FAILURE);
+  }
   char line[0x100];
   while (fgets(line, 0x100, fp)) {
     char *q = strchr(line, ' ');
     if (q) {
       *q++ = 0;
       if (strcmp(line, name) == 0) {
+        fclose(fp);
         p->bitcount = (int)strtol(q, NULL, 0);
         goto found_bitcount;
       }
     }
   }
+  fclose(fp);
 
   fprintf(stderr, "can't find segment name %s in index %s\n", name, path);
   exit(EXIT_FAILURE);
@@ -269,48 +294,9 @@ void get_acc_string(uint64_t *acc_string, char *buf, int buf_len) {
   buf[len] = 0;
 }
 
-void dump_entries(struct loaded_segment *p) {
-  struct object_map *object_map = get_object_map(p);
-  struct definition_header *definition_header = (struct definition_header *)(
-    M[p->segment] + object_map->definition_offset
-  );
-
-  struct definition *definition;
-  for (
-    int definition_relp = (int)definition_header->def_list_relp;
-    definition_relp;
-    definition_relp = (int)definition->forward_relp
-  ) {
-    definition = (struct definition *)(
-      (uint64_t *)definition_header + definition_relp
-    );
-    if (definition->class >= 7)
-      break; // can be dummy entry at end with all zeros and illegal class
-
-    char name[0x20];
-    get_acc_string(
-      (uint64_t *)definition_header + definition->name_relp,
-      name,
-      sizeof(name)
-    );
-    printf(
-      "%06o %s \"%s\" ignore %d entry %d indirect %d thing_relp %06o %s_relp %06o\n",
-      definition_relp,
-      class_names[definition->class],
-      name,
-      definition->flags_ignore,
-      definition->flags_entry,
-      definition->flags_indirect,
-      definition->thing_relp,
-      definition->class == CLASS_SEGNAME ? "first" : "segname",
-      definition->segname_relp
-    );
-  }
-}
-
 int find_entry(
   struct loaded_segment *p,
-  const char *entry_segment,
+  const char *entry_segname,
   const char *entry_name,
   bool entry
 ) {
@@ -319,54 +305,55 @@ int find_entry(
     M[p->segment] + object_map->definition_offset
   );
 
-  struct definition *definition;
   for (
-    int definition_relp = (int)definition_header->def_list_relp;
-    definition_relp;
-    definition_relp = (int)definition->forward_relp
-  ) {
-    definition = (struct definition *)(
-      (uint64_t *)definition_header + definition_relp
+    struct definition *definition = (struct definition *)(
+      (uint64_t *)definition_header + definition_header->def_list_relp
     );
-    if (definition->class >= 7)
-      break; // can be dummy entry at end with all zeros and illegal class
-
+    *(uint64_t *)definition;
+    definition = (struct definition *)(
+      (uint64_t *)definition_header + definition->forward_relp
+    )
+  ) {
     if (
       definition->class == CLASS_TEXT &&
       !definition->flags_ignore &&
       (!entry || definition->flags_entry)
     ) {
+#if 0 // arg_list_ptr_$arg_list_ptr_ should be wired_utility_$arg_list_ptr_
       struct segname_definition *segname_definition =
         (struct segname_definition *)(
           (uint64_t *)definition_header + definition->segname_relp
         );
       rassert(segname_definition->class == CLASS_SEGNAME);
 
-      char definition_segment[0x20];
+      char segname[0x20];
       get_acc_string(
         (uint64_t *)definition_header + segname_definition->name_relp,
-        definition_segment,
-        sizeof(definition_segment)
+        segname,
+        sizeof(segname)
       );
 
-      if (strcmp(definition_segment, entry_segment) == 0) {
-        char definition_name[0x20];
+      if (strcmp(segname, entry_segname) == 0) {
+#endif
+        char name[0x20];
         get_acc_string(
           (uint64_t *)definition_header + definition->name_relp,
-          definition_name,
-          sizeof(definition_name)
+          name,
+          sizeof(name)
         );
 
-        if (strcmp(definition_name, entry_name) == 0)
+        if (strcmp(name, entry_name) == 0)
           return (int)(object_map->text_offset + definition->thing_relp);
+#if 0
       }
+#endif
     }
   }
 
   fprintf(
     stderr,
     "can't find entry %s$%s in segment %s\n",
-    entry_segment,
+    entry_segname,
     entry_name,
     p->name
   );
@@ -480,17 +467,17 @@ bool snap_link(void) {
 int main(int argc, char **argv) {
   if (argc < 2) {
     printf(
-      "usage: %s entry_segment$entry_name [arguments]\n",
+      "usage: %s entry_segname$entry_name [arguments]\n",
       argv[0]
     );
     exit(EXIT_FAILURE);
   }
-  char *entry_segment, *entry_name;
+  char *entry_segname, *entry_name;
   {
     char *p = strchr(argv[1], '$');
     rassert(p);
     *p++ = 0;
-    entry_segment = argv[1];
+    entry_segname = argv[1];
     entry_name = p;
   }
   int n_args = argc - 2;
@@ -585,8 +572,6 @@ int main(int argc, char **argv) {
 
   // load pl1 operators
   struct loaded_segment *p = load_segment(xlate_segment("pl1_operators_"));
-  //dump_entries(p);
-  //exit(EXIT_FAILURE);
   stack_header->pl1_operators_ptr = its_pointer(
     p->segment,
     find_entry(p, "pl1_operators_", "operator_table", false)
@@ -613,14 +598,14 @@ int main(int argc, char **argv) {
   );
 
   // set up registers
-  struct loaded_segment *q = load_segment(xlate_segment(entry_segment));
+  struct loaded_segment *q = load_segment(xlate_segment(entry_segname));
   set_addr_mode(APPEND_mode);
 
   // ic (instruction counter)
   cpu.PPR.PRR = 3; // ring
   cpu.PPR.PSR = q->segment; // segment
   cpu.PPR.P = 0; // privilege
-  cpu.PPR.IC = find_entry(q, entry_segment, entry_name, true); // address
+  cpu.PPR.IC = find_entry(q, entry_segname, entry_name, true); // address
 
   // ap (argument pointer)
   cpu.PR[0].RNR = 3; // ring

diff --git a/pl1/calc.list b/pl1/calc.list
new file mode 100644 (file)
index 0000000..c125f39
--- /dev/null
+++ b/pl1/calc.list
@@ -0,0 +1,4725 @@
+          COMPILATION LISTING OF SEGMENT calc\r
+          Compiled by: Multics PL/I Compiler, Release 33f, of February 11, 2017\r
+          Compiled at: Installation and location\r
+          Compiled on: 10/06/19  0217.7 pst Sun\r
+              Options: table list\r
+\r
+        1 /****^  ************************************************************\r
+        2*        *                                                          *\r
+        3*        * Copyright, (C) Honeywell Bull Inc., 1989                 *\r
+        4*        *                                                          *\r
+        5*        * Copyright, (C) Honeywell Information Systems Inc., 1982  *\r
+        6*        *                                                          *\r
+        7*        * Copyright, (C) Honeywell Information Systems Inc., 1980. *\r
+        8*        *                                                          *\r
+        9*        ************************************************************ \r
+\c*/\r
+       10\r
+       11\r
+       12\r
+       13\r
+       14 /****^  HISTORY COMMENTS:\r
+       15*  1) change(88-10-19,Lee), approve(88-11-21,MCR8025), audit(88-12-23,\r
+\cFlegel),\r
+       16*     install(89-01-23,MR12.3-1010):\r
+       17*     Commands 421 (phx09588, phx18231) - modified to not set up a pi\r
+       18*     handler if it is being invoked as an active function.\r
+       19*  2) change(88-10-19,Lee), approve(88-11-21,MCR8025), audit(88-12-23,\r
+\cFlegel),\r
+       20*     install(89-01-23,MR12.3-1010):\r
+       21*     Commands 464 (phx10119, phx20071) - modified to complain about\r
+       22*     invalid characters specified in function names.\r
+       23*  3) change(88-10-19,Lee), approve(88-11-21,MCR8025), audit(88-12-23,\r
+\cFlegel),\r
+       24*     install(89-01-23,MR12.3-1010):\r
+       25*     Commands 805 (phx21221) - modified to accept "reasonable" variab\r
+\cle\r
+       26*     names and to clean up invalid variables left after an error occu\r
+\crs.\r
+       27*                                                   END HISTORY COMMEN\r
+\cTS */\r
+       28\r
+       29\r
+       30 /* The calc command provides the user with a calculator capable of ev\r
+\caluatiing PL/I-like expressions */\r
+       31 /* with operator precedence, a set of often used functions, and an ad\r
+\cdressable-by-identifier memory. */\r
+       32\r
+       33 /* Changed to work as an active function by S. Herbst 10/07/78 */\r
+       34 /* Handlers added for pi, oveflow, underflow 09/28/79 S. Herbst */\r
+       35 /* . and .. features added 12/12/79 S. Herbst */\r
+       36 /* Red & black shifts removed, "q =" bug fixed 04/14/80 S. Herbst */\r
+       37 /* Fixed not to prompt with a space 01/12/81 S. Herbst */\r
+       38\r
+       39 /* format: style4,ind3 */\r
+       40\r
+       41 calc: proc;\r
+       42\r
+       43 dcl  arg char (arg_len) based (arg_ptr);\r
+       44 dcl  return_string char (return_len) varying based (return_ptr);\r
+       45\r
+       46 dcl  (af_sw, expr_arg_sw) bit (1) aligned;\r
+       47\r
+       48 dcl  (arg_ptr, return_ptr) ptr;\r
+       49\r
+       50 dcl  (arg_count, arg_len, return_len) fixed bin;\r
+       51\r
+       52 dcl  error_table_$not_act_fnc fixed bin (35) ext;\r
+       53\r
+       54 dcl  (active_fnc_err_, active_fnc_err_$af_suppress_name) entry option\r
+\cs (variable);\r
+       55 dcl  (com_err_, com_err_$suppress_name) entry options (variable);\r
+       56 dcl  cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (3\r
+\c5));\r
+       57 dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));\r
+       58\r
+       59\r
+       60 dcl  (calls static internal, ss, fv, fv_save, num) fixed bin (17);\r
+       61 dcl  code fixed bin (35);\r
+       62 dcl  dum float bin (27);\r
+       63 dcl  (sv, iptr, fvp, mp, vp) ptr;\r
+       64 dcl  floatval float bin (27) based (fvp);\r
+       65 dcl  in char (1300) unaligned;\r
+       66 dcl  move char (20) based (mp);\r
+       67 dcl  space (52) ptr;\r
+       68 dcl  error_string char (32);\r
+       69 dcl  out char (32) aligned;\r
+       70 dcl  var_name_chars char (63) static options (constant)     /* for va\r
+\criable/function name check */\r
+       71           init ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz\r
+\c0123456789_");\r
+       72 dcl  valid_token_delimiters char (9)                        /* for va\r
+\criable/function name delimiter check */\r
+       73           static options (constant) init (" .()=+-*/");\r
+       74\r
+       75 dcl  1 in_structure unaligned based (addr (in)),\r
+       76        2 pad char (2),\r
+       77        2 in_com char (1298);\r
+       78\r
+       79 dcl  1 s (0:63) aligned,                                    /* the st\r
+\cack */\r
+       80        2 type fixed bin (17),\r
+       81        2 op fixed bin (17),\r
+       82        2 value float bin (27),\r
+       83        2 var ptr;\r
+       84\r
+       85 dcl  1 vars based (vp) aligned,                             /* the li\r
+\cst of variables and values */\r
+       86        2 next ptr,\r
+       87        2 d (0:31),\r
+       88          3 name char (8) aligned,\r
+       89          3 value float bin (27);\r
+       90\r
+       91 dcl  ffip entry (ptr, fixed bin (17), fixed bin (17), float bin (27))\r
+\c;\r
+       92 dcl  ffop entry (char (32) aligned, fixed bin (17), float bin (27));\r
+       93 dcl  (ioa_, ioa_$ioa_switch) entry options (variable);\r
+       94 dcl  iox_$error_output ptr external;\r
+       95 dcl  iox_$get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (\r
+\c35));\r
+       96 dcl  iox_$put_chars entry (ptr, ptr, fixed bin, fixed bin (35));\r
+       97 dcl  iox_$user_output ptr ext;\r
+       98 dcl  iox_$user_input ptr ext;\r
+       99 dcl  cu_$cp entry (ptr, fixed bin, fixed bin (35));\r
+      100 dcl  cu_$grow_stack_frame entry (fixed bin (17), ptr, fixed bin (35))\r
+\c;\r
+      101 dcl  (noprt, ileq) bit (1);\r
+      102 dcl  funcs (0:6) char (8) static internal init ("sin", "cos", "tan", \r
+\c"atan", "abs", "ln", "log");\r
+      103 dcl  (abs, addr, atan, cos, fixed, index, length, log, log10, ltrim) \r
+\cbuiltin;\r
+      104 dcl  (mod, null, rtrim, sin, substr, tan, verify) builtin;\r
+      105\r
+      106 dcl  (fixedoverflow, overflow, program_interrupt, underflow) conditio\r
+\cn;\r
+      107                                                             /*\014\r
+\c                                                   */\r
+      108\r
+      109\r
+      110       call cu_$af_return_arg (arg_count, return_ptr, return_len, code\r
+\c);\r
+      111       if code = error_table_$not_act_fnc then do;\r
+      112          if arg_count > 1 then do;\r
+      113             call com_err_$suppress_name (0, "calc", "Usage:  calc {ex\r
+\cpression}");\r
+      114             return;\r
+      115          end;\r
+      116          else if arg_count = 1 then expr_arg_sw = "1"b;\r
+      117          else expr_arg_sw = "0"b;\r
+      118          af_sw = "0"b;\r
+      119       end;\r
+      120       else do;\r
+      121          if arg_count = 0 | arg_count > 1 then do;\r
+      122             call active_fnc_err_$af_suppress_name (0, "calc", "Usage:\r
+\c  [calc expression]");\r
+      123             return;\r
+      124          end;\r
+      125          af_sw, expr_arg_sw = "1"b;\r
+      126       end;\r
+      127\r
+      128       vp, sv = addr (space);                                /* initia\r
+\clize vars with e and pi */\r
+      129       iptr = addr (in);\r
+      130       vars.next = null;\r
+      131       vars.d.name (0) = "pi";\r
+      132       vars.d.value (0) = 3.14159265e0;\r
+      133       vars.d.name (1) = "e";\r
+      134       vars.d.value (1) = 2.7182818e0;\r
+      135       fv = 2;\r
+      136\r
+      137       if ^af_sw then                                        /* phx095\r
+\c88,phx18231: */\r
+      138            on program_interrupt go to new_line;             /* set up\r
+\c pi handler only if not active function */\r
+      139\r
+      140       on overflow, fixedoverflow begin;\r
+      141          error_string = "Overflow";\r
+      142          go to HANDLE_FAULT;\r
+      143       end;\r
+      144       on underflow begin;\r
+      145          error_string = "Exponent too small";\r
+      146          go to HANDLE_FAULT;\r
+      147       end;\r
+      148\r
+      149 new_line: ss = -1;                                          /* reinit\r
+\cialize variables */\r
+      150       calls = 0;\r
+      151       noprt, ileq = "0"b;\r
+      152       if fv > 31 then do;\r
+      153          call cu_$grow_stack_frame (104, vp, code);         /* if var\r
+\cs too big, get more space */\r
+      154          if code ^= 0 then do;\r
+      155             call ioa_ ("Fatal out of space");\r
+      156             return;\r
+      157          end;\r
+      158          vars.next = sv;\r
+      159          sv = vp;\r
+      160          fv = 0;\r
+      161       end;\r
+      162\r
+      163       if expr_arg_sw then do;\r
+      164          call cu_$arg_ptr (1, arg_ptr, arg_len, code);\r
+      165\r
+      166          begin;\r
+      167 dcl  expr_arg char (arg_len + 1);\r
+      168\r
+      169             expr_arg = arg || "\r
+      170 ";\r
+      171             call prec_calc (expr_arg, arg_len + 1, dum, code);\r
+      172\r
+      173          end;\r
+      174\r
+      175          return;\r
+      176       end;\r
+      177\r
+      178 GET_LINE: call iox_$get_line (iox_$user_input, iptr, length (in), num\r
+\c, (0));\r
+      179\r
+      180       if num = 1 then go to GET_LINE;                       /* newlin\r
+\ce */\r
+      181       else if num = 2 & substr (in, 1, 1) = "." then do;\r
+      182          call ioa_ ("CALC 1.1");\r
+      183          go to GET_LINE;\r
+      184       end;\r
+      185       else if substr (in, 1, 2) = ".." then do;\r
+      186          call cu_$cp (addr (in_com), num - 2, code);\r
+      187          go to GET_LINE;\r
+      188       end;\r
+      189\r
+      190       fv_save = fv;                                         /* phx212\r
+\c21: save to restore on error */\r
+      191       call prec_calc (in, num, dum, code);\r
+      192       if code > 1 then return;\r
+      193       go to new_line;\r
+      194\r
+      195\r
+      196 HANDLE_FAULT:\r
+      197       if af_sw then call active_fnc_err_ (0, "calc", "^a", error_stri\r
+\cng);\r
+      198       else call ioa_$ioa_switch (iox_$error_output, "^a", error_strin\r
+\cg);\r
+      199       if expr_arg_sw then return;\r
+      200       else go to new_line;\r
+      201                                                             /*\014\r
+\c                                                   */\r
+      202 /**** ****************************INTERNAL PROC PREC_CALC************\r
+\c************************* ****/\r
+      203\r
+      204\r
+      205 /* prec_calc does the actual work of the calc command.  It is recursi\r
+\cve so function references may */\r
+      206 /* contain expressions (including other function references). */\r
+      207\r
+      208 prec_calc: proc (in, num, fval, code);\r
+      209                                                             /* declar\r
+\cations */\r
+      210 dcl  (i, j, k, num, last, level, ip, strt) fixed bin (17);\r
+      211 dcl  code fixed bin (35);\r
+      212 dcl  (x, fval) float bin (27);\r
+      213 dcl  wrk char (1);\r
+      214 dcl  wrka char (8);\r
+      215 dcl  in char (*);\r
+      216 dcl  msg char (40) aligned;\r
+      217\r
+      218       code, ip, last = 1; level = 0;\r
+      219       calls = calls + 1; ss = ss + 1;\r
+      220       s.type (ss) = 0;\r
+      221       s.op (ss) = 1;                                        /* put a \r
+\cstart-of-stack char on s */\r
+      222       strt = ss - 1;\r
+      223\r
+      224 start: if s.op (ss) ^= 0 then go to op_red;                 /* if s: \r
+\c<op> */\r
+      225       i = s.op (ss - 1);\r
+      226       if i = 0 then do;                                     /* if s: \r
+\c<val> <val>  then error */\r
+      227 miss_op: msg = "Missing operator";\r
+      228          go to err;\r
+      229       end;\r
+      230       if ss - 2 = strt then go to add;                      /* if s: \r
+\c"sos" <val>  then add */\r
+      231       if s.op (ss - 2) = 0 then go to add;                  /* if s: \r
+\c<val> <op> <val> then add */\r
+      232       if i ^= 4 then\r
+      233            if i ^= 5 then do;                               /* if s ^\r
+\c : <op> "+"|"-" <val>  error */\r
+      234 ill_prefix:   msg = "Invalid prefix operator";\r
+      235               go to err;\r
+      236            end;\r
+      237       go to add;                                            /* syntax\r
+\c is OK so add to prefix to check prec */\r
+      238\r
+      239 op_red: i = s.op (ss);\r
+      240       if i = 1 then go to add;                              /* if s: \r
+\c"sos" then add */\r
+      241       j = s.op (ss - 1);\r
+      242       if j ^= 0 then do;                                    /* if s: \r
+\c<op> "-"|"+"  then add */\r
+      243          if i = 4 then go to add;\r
+      244          if i = 5 then go to add;\r
+      245       end;\r
+      246       if i = 2 then\r
+      247            if j = 1 then do;                                /* if s: \r
+\c"sos" "eoi"  error */\r
+      248               if calls = 1 then return;\r
+      249               else do;\r
+      250                  msg = "Null expression";\r
+      251                  go to err;\r
+      252               end;\r
+      253            end;\r
+      254       if i > 2 then\r
+      255            if j ^= 0 then go to ill_prefix;                 /* error \r
+\cif: <op> ^"eoi" */\r
+      256       j = s.op (ss - 2);\r
+      257       if j = 0 then go to miss_op;                          /* error \r
+\c*/\r
+      258       if i = 2 then\r
+      259            if j = 1 then go to print;                       /* if: "s\r
+\cos" <any> "eoi"  then print */\r
+      260                                                             /* if op1\r
+\c>op2 then add, i.e. check precedence */\r
+      261       if ss - 3 = strt then go to add;                      /* if <va\r
+\cl2> is really "sos" then add */\r
+      262       if s.op (ss - 3) ^= 0 then do;                        /* check \r
+\cfo r prefix op */\r
+      263          if s.type (ss) > s.type (ss - 2) + 4 then go to add; /* chec\r
+\ck precdence - prefix is very strong */\r
+      264          if j = 5 then s.value (ss - 1) = -s.value (ss - 1);/* do neg\r
+\cation */\r
+      265          addr (s.type (ss - 2)) -> move = addr (s.type (ss - 1)) -> m\r
+\cove; /* move over sign */\r
+      266          addr (s.type (ss - 1)) -> move = addr (s.type (ss)) -> move;\r
+      267          ss = ss - 1;\r
+      268          go to start;\r
+      269       end;\r
+      270       if s.type (ss) > s.type (ss - 2) then go to add;      /* s is: \r
+\c<val2><op2><val1><op1> */\r
+      271       j = j - 3;\r
+      272       go to operator (j);\r
+      273\r
+      274 operator (0):\r
+      275 ASSIGN: s.var (ss - 3) -> floatval = s.value (ss - 1);      /* do ass\r
+\cignment */\r
+      276       noprt = "1"b;\r
+      277       go to clean;\r
+      278 operator (1):\r
+      279 ADD:  s.value (ss - 3) = s.value (ss - 3) + s.value (ss - 1); /* do a\r
+\cddition */\r
+      280       go to clean;\r
+      281 operator (2):\r
+      282 SUBTRACT: s.value (ss - 3) = s.value (ss - 3) - s.value (ss - 1); /* \r
+\cdo subtraction */\r
+      283       go to clean;\r
+      284 operator (3):\r
+      285 MULTIPLY: s.value (ss - 3) = s.value (ss - 3) * s.value (ss - 1); /* \r
+\cdo multiplication */\r
+      286       go to clean;\r
+      287 operator (4):\r
+      288 DIVIDE: if s.value (ss - 1) = 0e0 then do;                  /* divisi\r
+\con by zero */\r
+      289          msg = "Divide by zero";\r
+      290          go to err;\r
+      291       end;\r
+      292       s.value (ss - 3) = s.value (ss - 3) / s.value (ss - 1); /* do d\r
+\civision */\r
+      293       go to clean;\r
+      294 operator (5):\r
+      295 EXPONENT: if s.value (ss - 3) < 0e0 then do;                /* ** of \r
+\cneg number */\r
+      296          if mod (s.value (ss - 1), 1e0) = 0e0 then do;      /* neg to\r
+\c integer power */\r
+      297             s.value (ss - 3) = s.value (ss - 3) ** fixed (s.value (ss\r
+\c - 1), 17, 0);\r
+      298             go to clean;\r
+      299          end;\r
+      300          msg = "Neg num ** non-integer";\r
+      301          go to err;\r
+      302       end;\r
+      303       if s.value (ss - 1) = 0e0 then\r
+      304            if s.value (ss - 3) = 0e0 then do;               /* zero *\r
+\c* zero */\r
+      305               msg = "Zero ** zero";\r
+      306               go to err;\r
+      307            end;\r
+      308       s.value (ss - 3) = s.value (ss - 3) ** s.value (ss - 1); /* do \r
+\cexponentiation */\r
+      309\r
+      310 clean: addr (s.type (ss - 2)) -> move = addr (s.type (ss)) -> move; /\r
+\c* remove top of stack */\r
+      311       ss = ss - 2;\r
+      312       go to start;\r
+      313\r
+      314 print: fval = s.value (ss - 1);\r
+      315       if calls > 1 then go to no_print;\r
+      316\r
+      317       if af_sw then do;\r
+      318          ip = 1;\r
+      319          call ffop (out, ip, fval);                         /* conver\r
+\ct value to char string */\r
+      320          return_string = rtrim (ltrim (substr (out, 1, ip - 1)));\r
+      321          return;\r
+      322       end;\r
+      323\r
+      324       if noprt then go to no_print;\r
+      325       ip = 5;\r
+      326       substr (out, 1, 5) = "=   ";                          /* set up\r
+\c output line */\r
+      327       call ffop (out, ip, fval);                            /* conver\r
+\ct value to char string */\r
+      328       substr (out, ip, 1) = "\r
+      329 ";                                                          /* append\r
+\c NL to output line */\r
+      330       call iox_$put_chars (iox_$user_output, addr (out), ip, (0));\r
+      331 no_print: calls = calls - 1;                                /* return\r
+\c to caller */\r
+      332       code = 0;\r
+      333       ss = strt;\r
+      334       return;\r
+      335\r
+      336 add:  ss = ss + 1;                                          /* put ne\r
+\cw cell on stack */\r
+      337       if ss > 63 then do;                                   /* too ma\r
+\cny tokens on stack */\r
+      338          msg = "Simplify expression";\r
+      339          go to err;\r
+      340       end;\r
+      341 blank: if ip >= num then do;                                /* look f\r
+\cor end of input line */\r
+      342          if level ^= 0 then do;\r
+      343             msg = "Too few )'s";\r
+      344             go to err;\r
+      345          end;\r
+      346          s.type (ss) = 0;\r
+      347          s.op (ss) = 2;                                     /* put "e\r
+\coi" on stack */\r
+      348          go to start;\r
+      349       end;\r
+      350       wrk = substr (in, ip, 1);\r
+      351       if wrk ^= " " then go to non_blank;                   /* look f\r
+\cor non-blank */\r
+      352 incr: ip = ip + 1;\r
+      353       go to blank;\r
+      354 non_blank:\r
+      355       i = index ("0123456789.()=+-*/", wrk);\r
+      356       if i = 0 then go to var_ref;                          /* if not\r
+\c as in index, then go to var_ref */\r
+      357       if i <= 11 then do;\r
+      358          call ffip (addr (in), num - 1, ip, s.value (ss));  /* if num\r
+\ceric then call ffip for conversion */\r
+      359          s.op (ss) = 0;\r
+      360          ileq = "1"b;\r
+      361          last = 2;\r
+      362          go to start;\r
+      363       end;\r
+      364       if i = 12 then do;                                    /* if ope\r
+\cn paren then up prec level */\r
+      365          if last ^= 1 then\r
+      366               if last ^= 3 then do;                         /* error \r
+\cif ( follows value or ) */\r
+      367                  msg = "Invalid use of (";\r
+      368                  go to err;\r
+      369               end;\r
+      370          last = 3;\r
+      371          level = level + 5;\r
+      372          ileq = "1"b;\r
+      373          go to incr;\r
+      374       end;\r
+      375\r
+      376       if i = 13 then do;                                    /* if ) c\r
+\check for error then lower prec level */\r
+      377          if level = 0 then do;\r
+      378             msg = "Too many )'s";\r
+      379             go to err;\r
+      380          end;\r
+      381          if last ^= 2 then\r
+      382               if last ^= 4 then do;                         /* error \r
+\cif ) follows ( or operator */\r
+      383                  msg = "Invalid use of )";\r
+      384                  go to err;\r
+      385               end;\r
+      386          last = 4;\r
+      387          level = level - 5;\r
+      388          ileq = "1"b;\r
+      389          go to incr;\r
+      390       end;\r
+      391\r
+      392       if last = 3 then\r
+      393            if i ^= 15 then\r
+      394                 if i ^= 16 then do;                         /* "(" <o\r
+\cp>^="+"|"-" */\r
+      395                    msg = "Invalid op after (";\r
+      396                    go to err;\r
+      397                 end;\r
+      398       last = 1;\r
+      399       if substr (in, ip, 2) = "**" then do;\r
+      400          i = 19;                                            /* check \r
+\cfor ** */\r
+      401          ip = ip + 1;\r
+      402       end;\r
+      403\r
+      404       if i = 14 then\r
+      405            if ileq then do;                                 /* anythi\r
+\cng but <variable> before "=" is error */\r
+      406               msg = "Invalid use of =";\r
+      407               go to err;\r
+      408            end;\r
+      409       k = level + 1;\r
+      410       if i > 18 then k = k + 3;                             /* assign\r
+\c precedence level to operator */\r
+      411       else if i > 16 then k = k + 2;\r
+      412       else if i > 14 then k = k + 1;\r
+      413       s.type (ss) = k;\r
+      414       s.op (ss) = i - 11;\r
+      415       ileq = "1"b;\r
+      416       ip = ip + 1;\r
+      417       go to start;\r
+      418\r
+      419 var_ref: i = ip;                                            /* save s\r
+\ctart of var name */\r
+      420       last = 2;\r
+      421       if verify (wrk, var_name_chars) ^= 0 then do;         /* phx101\r
+\c19,20071,21221: name validity check */\r
+      422 bad_char: msg = "Invalid char " || wrk;\r
+      423          go to err;\r
+      424       end;\r
+      425       go to first;\r
+      426 var_loop: ip = ip + 1;\r
+      427       wrk = substr (in, ip, 1);\r
+      428 first: if ip < num then do;\r
+      429          if verify (wrk, var_name_chars) = 0 then           /* phx101\r
+\c19,20071,21221: name validity check */\r
+      430               go to var_loop;                               /* find e\r
+\cnd of name */\r
+      431\r
+      432          if verify (wrk, valid_token_delimiters) ^= 0 then  /* check \r
+\cfor invalid */\r
+      433               go to bad_char;                               /* char a\r
+\cfter name */\r
+      434       end;\r
+      435\r
+      436       wrka = substr (in, i, ip - i);                        /* wrka i\r
+\cs var name */\r
+      437\r
+      438       if expr_arg_sw then do;\r
+      439          do i = 0 to 6;\r
+      440             if wrka = funcs (i) then go to func_ref;\r
+      441          end;\r
+      442          if af_sw then call active_fnc_err_ (0, "calc", "Variables no\r
+\ct allowed in expression argument.");\r
+      443          else call com_err_ (0, "calc", "Variables not allowed in exp\r
+\cression argument.");\r
+      444          return;\r
+      445       end;\r
+      446\r
+      447       vp = sv;\r
+      448       k = fv - 1;\r
+      449 next_v: do j = k to 0 by -1;                                /* search\r
+\c vars for wrka */\r
+      450          if wrka = vars.d.name (j) then go to found;\r
+      451       end;\r
+      452       vp = vars.next;                                       /* chain \r
+\cto next block of vars */\r
+      453       k = 31;\r
+      454       if vp ^= null then go to next_v;                      /* if nul\r
+\cl then name is undefined */\r
+      455       if wrka = "q" then do;                                /* a name\r
+\c of "q" is a quit so return  with quit code */\r
+      456          if num > 2 then do;                                /* other \r
+\cchars on the line */\r
+      457             msg = "Invalid var q";\r
+      458             go to err;\r
+      459          end;\r
+      460          code = 2;\r
+      461          return;\r
+      462       end;\r
+      463       if wrka = "list" then do;                             /* a name\r
+\c of "list" means list all vars */\r
+      464          wrk = "\r
+      465 ";                                                          /* set wr\r
+\ck = NL */\r
+      466          call iox_$put_chars (iox_$user_output, addr (wrk), 1, (0)); \r
+\c/* print a NL */\r
+      467          vp = sv;\r
+      468          k = fv - 1;\r
+      469 another: do j = k to 0 by -1;                               /* go thr\r
+\cough vars printing out values and names */\r
+      470             substr (out, 1, 8) = vars.d.name (j);\r
+      471             substr (out, 9, 4) = " =  ";\r
+      472             ip = 13;\r
+      473             call ffop (out, ip, vars.d.value (j));          /* call f\r
+\cfop to convert value to char string */\r
+      474             substr (out, ip, 1) = "\r
+      475 ";                                                          /* insert\r
+\c NL */\r
+      476             call iox_$put_chars (iox_$user_output, addr (out), ip, (0\r
+\c));\r
+      477          end;\r
+      478          vp = vars.next;\r
+      479          k = 31;\r
+      480          if vp ^= null then go to another;\r
+      481          call ioa_ (" ");\r
+      482          return;\r
+      483       end;\r
+      484       do i = 0 to 6;                                        /* see if\r
+\c var name is func name */\r
+      485          if wrka = funcs (i) then go to func_ref;\r
+      486       end;\r
+      487       if ileq then do;                                      /* since \r
+\cnot command or func then undef var */\r
+      488                                                             /* so inv\r
+\calid if not first in line */\r
+      489          msg = "Undef var " || wrka;\r
+      490          go to err;\r
+      491       end;\r
+      492       vp = sv;\r
+      493       j = fv;\r
+      494       fv = fv + 1;                                          /* define\r
+\c var */\r
+      495       vars.d.name (j) = wrka;\r
+      496       vars.d.value (j) = 0e0;\r
+      497 found: s.op (ss) = 0;\r
+      498       s.value (ss) = vars.d.value (j);                      /* put <v\r
+\cal> on stack */\r
+      499       s.var (ss) = addr (vars.d.value (j));\r
+      500       go to start;\r
+      501\r
+      502 func_ref: do ip = ip to num while (substr (in, ip, 1) ^= "("); /* fin\r
+\cd open paren */\r
+      503       end;\r
+      504       j = 0;\r
+      505       do k = ip to num;                                     /* find c\r
+\close paren */\r
+      506          if substr (in, k, 1) = "(" then j = j + 1;\r
+      507          if substr (in, k, 1) = ")" then j = j - 1;\r
+      508          if j = 0 then go to end_ref;\r
+      509       end;\r
+      510       msg = "Missing ) after " || wrka;\r
+      511       go to err;\r
+      512 end_ref: call prec_calc (substr (in, ip, k - ip + 2), k - ip + 2, x, \r
+\ccode);\r
+      513       if code ^= 0 then return;\r
+      514       code = 1;\r
+      515       ip = k + 1;\r
+      516       s.op (ss) = 0;\r
+      517       s.var (ss) = null;\r
+      518       go to func (i);\r
+      519 func (0):\r
+      520 SIN:  s.value (ss) = sin (x); go to start;\r
+      521 func (1):\r
+      522 COS:  s.value (ss) = cos (x); go to start;\r
+      523 func (2):\r
+      524 TAN:  s.value (ss) = tan (x); go to start;\r
+      525 func (3):\r
+      526 ATAN: s.value (ss) = atan (x); go to start;\r
+      527 func (4):\r
+      528 ABS:  s.value (ss) = abs (x); go to start;\r
+      529 func (5):\r
+      530 LN:   s.value (ss) = log (x); go to start;\r
+      531 func (6):\r
+      532 LOG:  s.value (ss) = log10 (x); go to start;\r
+      533\r
+      534 err:                                                        /* error \r
+\cprintout section */\r
+      535       if af_sw then do;\r
+      536          call active_fnc_err_ (0, "calc", "^a", msg);\r
+      537       end;\r
+      538       else call ioa_$ioa_switch (iox_$error_output, "^a", msg);\r
+      539       fv = fv_save;                                         /* phx212\r
+\c21 - clean up invalid variables on error */\r
+      540\r
+      541       return;\r
+      542\r
+      543    end prec_calc;\r
+      544\r
+      545 /**** *****************************************END INTERNAL PROC PREC\r
+\c_CALC********************************** ****/\r
+      546\r
+      547\r
+      548    end calc;\r
+\014      SOURCE FILES USED IN THIS COMPILATION.\r
+\r
+LINE      NUMBER  DATE MODIFIED     NAME                              PATHNAME\r
+             0    10/06/19  0217.6  calc.pl1                          >user_dir\r
+\c_dir>SysAdmin>Repair>calc.pl1\r
+\014      NAMES DECLARED IN THIS COMPILATION.\r
+\r
+IDENTIFIER               OFFSET    LOC STORAGE CLASS   DATA TYPE\r
+\c ATTRIBUTES AND REFERENCES\r
+\r
+\c (* indicates a set context)\r
+\r
+NAMES DECLARED BY DECLARE STATEMENT.\r
+abs                                                    builtin function\r
+\c dcl 103 ref 527\r
+active_fnc_err_                 000016 constant        entry\r
+\c external dcl 54 ref 196 442 536\r
+active_fnc_err_$af_suppress_name\r
+                                000020 constant        entry\r
+\c external dcl 54 ref 122\r
+addr                                                   builtin function\r
+\c dcl 103 ref 75 75 75 128 129 186 186 186 186 265 265\r
+\r
+\c   266 266 310 310 330 330 358 358 466 466 476 476\r
+\r
+\c   499\r
+af_sw                           000100 automatic       bit(1)\r
+\c dcl 46 set ref 118* 125* 137 196 317 442 534\r
+arg                                    based           char\r
+\c packed unaligned dcl 43 ref 169\r
+arg_count                       000106 automatic       fixed bin(17,0)\r
+\c dcl 50 set ref 110* 112 116 121 121\r
+arg_len                         000107 automatic       fixed bin(17,0)\r
+\c dcl 50 set ref 43 164* 167 169 171\r
+arg_ptr                         000102 automatic       pointer\r
+\c dcl 48 set ref 43 164* 169\r
+atan                                                   builtin function\r
+\c dcl 103 ref 525\r
+calls                           000010 internal static fixed bin(17,0)\r
+\c dcl 60 set ref 150* 219* 219 248 315 331* 331\r
+code                            000115 automatic       fixed bin(35,0)\r
+\c dcl 61 in procedure "calc" set ref 110* 111 153* 154\r
+\r
+\c   164* 171* 186* 191* 192\r
+code                                   parameter       fixed bin(35,0)\r
+\c dcl 211 in procedure "prec_calc" set ref 208 218*\r
+\r
+\c   332* 460* 512* 513 514*\r
+com_err_                        000022 constant        entry\r
+\c external dcl 55 ref 443\r
+com_err_$suppress_name          000024 constant        entry\r
+\c external dcl 55 ref 113\r
+cos                                                    builtin function\r
+\c dcl 103 ref 521\r
+cu_$af_return_arg               000026 constant        entry\r
+\c external dcl 56 ref 110\r
+cu_$arg_ptr                     000030 constant        entry\r
+\c external dcl 57 ref 164\r
+cu_$cp                          000054 constant        entry\r
+\c external dcl 99 ref 186\r
+cu_$grow_stack_frame            000056 constant        entry\r
+\c external dcl 100 ref 153\r
+d                         2            based           structure\r
+\c array level 2 dcl 85\r
+dum                             000116 automatic       float bin(27)\r
+\c dcl 62 set ref 171* 191*\r
+error_string                    001010 automatic       char(32)\r
+\c packed unaligned dcl 68 set ref 141* 145* 196* 198*\r
+error_table_$not_act_fnc        000014 external static fixed bin(35,0)\r
+\c dcl 52 ref 111\r
+expr_arg                        000100 automatic       char\r
+\c packed unaligned dcl 167 set ref 169* 171*\r
+expr_arg_sw                     000101 automatic       bit(1)\r
+\c dcl 46 set ref 116* 117* 125* 163 199 438\r
+ffip                            000032 constant        entry\r
+\c external dcl 91 ref 358\r
+ffop                            000034 constant        entry\r
+\c external dcl 92 ref 319 327 473\r
+fixed                                                  builtin function\r
+\c dcl 103 ref 297\r
+fixedoverflow                   001632 stack reference condition\r
+\c dcl 106 ref 140\r
+floatval                               based           float bin(27)\r
+\c dcl 64 set ref 274*\r
+funcs                           000015 constant        char(8)\r
+\c initial array packed unaligned dcl 102 ref 440 485\r
+fv                              000112 automatic       fixed bin(17,0)\r
+\c dcl 60 set ref 135* 152 160* 190 448 468 493 494*\r
+\r
+\c   494 539*\r
+fv_save                         000113 automatic       fixed bin(17,0)         \r
+\c dcl 60 set ref 190* 539\r
+fval                                   parameter       float bin(27)\r
+\c dcl 212 set ref 208 314* 319* 327*\r
+fvp                             000124 automatic       pointer\r
+\c dcl 63 ref 64\r
+i                               000100 automatic       fixed bin(17,0)\r
+\c dcl 210 set ref 225* 226 232 232 239* 240 243 244\r
+\r
+\c   246 254 258 354* 356 357 364 376 392 392 400* 404\r
+\r
+\c   410 411 412 414 419* 436 436 439* 440* 484* 485*\r
+\r
+\c   518\r
+ileq                            001631 automatic       bit(1)                  \r
+\c packed unaligned dcl 101 set ref 151* 360* 372* 388*\r
+\r
+\c   404 415* 487\r
+in                                     parameter       char\r
+\c packed unaligned dcl 215 in procedure "prec_calc"\r
+\r
+\c   set ref 208 350 358 358 399 427 436 502 506 507\r
+\r
+\c   512 512\r
+in                              000132 automatic       char(1300)\r
+\c packed unaligned dcl 65 in procedure "calc" set ref\r
+\r
+\c   75 75 75 129 178 178 181 185 186 186 191*\r
+in_com                    0(18)        based           char(1298)\r
+\c level 2 packed packed unaligned dcl 75 set ref 186\r
+\r
+\c   186\r
+in_structure                           based           structure\r
+\c level 1 packed packed unaligned dcl 75\r
+index                                                  builtin function\r
+\c dcl 103 ref 354\r
+ioa_                            000036 constant        entry\r
+\c external dcl 93 ref 155 182 481\r
+ioa_$ioa_switch                 000040 constant        entry\r
+\c external dcl 93 ref 198 538\r
+iox_$error_output               000042 external static pointer\r
+\c dcl 94 set ref 198* 538*\r
+iox_$get_line                   000044 constant        entry\r
+\c external dcl 95 ref 178\r
+iox_$put_chars                  000046 constant        entry\r
+\c external dcl 96 ref 330 466 476\r
+iox_$user_input                 000052 external static pointer\r
+\c dcl 98 set ref 178*\r
+iox_$user_output                000050 external static pointer\r
+\c dcl 97 set ref 330* 466* 476*\r
+ip                              000105 automatic       fixed bin(17,0)\r
+\c dcl 210 set ref 218* 318* 319* 320 325* 327* 328\r
+\r
+\c   330* 341 350 352* 352 358* 399 401* 401 416* 416\r
+\r
+\c   419 426* 426 427 428 436 472* 473* 474 476* 502*\r
+\r
+\c   502 502* 505 512 512 512 512 512 515*\r
+iptr                            000122 automatic       pointer\r
+\c dcl 63 set ref 129* 178*\r
+j                               000101 automatic       fixed bin(17,0)\r
+\c dcl 210 set ref 241* 242 246 254 256* 257 258 264\r
+\r
+\c   271* 271 272 449* 450* 469* 470 473* 493* 495 496\r
+\r
+\c   498 499 504* 506* 506 507* 507 508\r
+k                               000102 automatic       fixed bin(17,0)\r
+\c dcl 210 set ref 409* 410* 410 411* 411 412* 412 413\r
+\r
+\c   448* 449 453* 468* 469 479* 505* 506 507* 512 512\r
+\r
+\c   512 515\r
+last                            000103 automatic       fixed bin(17,0)\r
+\c dcl 210 set ref 218* 361* 365 365 370* 381 381 386*\r
+\r
+\c   392 398* 420*\r
+length                                                 builtin function\r
+\c dcl 103 ref 178 178\r
+level                           000104 automatic       fixed bin(17,0)\r
+\c dcl 210 set ref 218* 342 371* 371 377 387* 387 409\r
+log                                                    builtin function\r
+\c dcl 103 ref 529\r
+log10                                                  builtin function\r
+\c dcl 103 ref 531\r
+ltrim                                                  builtin function\r
+\c dcl 103 ref 320\r
+mod                                                    builtin function\r
+\c dcl 104 ref 296\r
+move                                   based           char(20)\r
+\c packed unaligned dcl 66 set ref 265* 265 266* 266\r
+\r
+\c   310* 310\r
+mp                              000126 automatic       pointer\r
+\c dcl 63 ref 66\r
+msg                             000114 automatic       char(40)\r
+\c dcl 216 set ref 227* 234* 250* 289* 300* 305* 338*\r
+\r
+\c   343* 367* 378* 383* 395* 406* 422* 457* 489* 510*\r
+\r
+\c   536* 538*\r
+name                      2            based           char(8)\r
+\c array level 3 dcl 85 set ref 131* 133* 450 470 495*\r
+next                                   based           pointer\r
+\c level 2 dcl 85 set ref 130* 158* 452 478\r
+noprt                           001630 automatic       bit(1)\r
+\c packed unaligned dcl 101 set ref 151* 276* 324\r
+null                                                   builtin function\r
+\c dcl 104 ref 130 454 480 517\r
+num                             000114 automatic       fixed bin(17,0)\r
+\c dcl 60 in procedure "calc" set ref 178* 180 181 186\r
+\r
+\c   191*\r
+num                                    parameter       fixed bin(17,0)\r
+\c dcl 210 in procedure "prec_calc" ref 208 341 358 428\r
+\r
+\c   456 502 505\r
+op                        1     001030 automatic       fixed bin(17,0)\r
+\c array level 2 dcl 79 set ref 221* 224 225 231 239\r
+\r
+\c   241 256 262 347* 359* 414* 497* 516*\r
+out                             001020 automatic       char(32)\r
+\c dcl 69 set ref 319* 320 326* 327* 328* 330 330 470*\r
+\r
+\c   471* 473* 474* 476 476\r
+overflow                        001640 stack reference condition\r
+\c dcl 106 ref 140\r
+program_interrupt               001646 stack reference condition\r
+\c dcl 106 ref 137\r
+return_len                      000110 automatic       fixed bin(17,0)\r
+\c dcl 50 set ref 44 110* 320\r
+return_ptr                      000104 automatic       pointer\r
+\c dcl 48 set ref 44 110* 320\r
+return_string                          based           varying char\r
+\c dcl 44 set ref 320*\r
+rtrim                                                  builtin function\r
+\c dcl 104 ref 320\r
+s                               001030 automatic       structure\r
+\c array level 1 dcl 79\r
+sin                                                    builtin function\r
+\c dcl 104 ref 519\r
+space                           000640 automatic       pointer\r
+\c array dcl 67 set ref 128\r
+ss                              000111 automatic       fixed bin(17,0)\r
+\c dcl 60 set ref 149* 219* 219 220 221 222 224 225 230\r
+\r
+\c   231 239 241 256 261 262 263 263 264 264 265 265\r
+\r
+\c   266 266 267* 267 270 270 274 274 278 278 278 281\r
+\r
+\c   281 281 284 284 284 287 292 292 292 294 296 297\r
+\r
+\c   297 297 303 303 308 308 308 310 310 311* 311 314\r
+\r
+\c   333* 336* 336 337 346 347 358 359 413 414 497 498\r
+\r
+\c   499 516 517 519 521 523 525 527 529 531\r
+strt                            000106 automatic       fixed bin(17,0)\r
+\c dcl 210 set ref 222* 230 261 333\r
+substr                                                 builtin function\r
+\c dcl 104 set ref 181 185 320 326* 328* 350 399 427\r
+\r
+\c   436 470* 471* 474* 502 506 507 512 512\r
+sv                              000120 automatic       pointer\r
+\c dcl 63 set ref 128* 158 159* 447 467 492\r
+tan                                                    builtin function\r
+\c dcl 104 ref 523\r
+type                            001030 automatic       fixed bin(17,0)\r
+\c array level 2 dcl 79 set ref 220* 263 263 265 265\r
+\r
+\c   266 266 270 270 310 310 346* 413*\r
+underflow                       001654 stack reference condition\r
+\c dcl 106 ref 144\r
+valid_token_delimiters          000033 constant        char(9)\r
+\c initial packed unaligned dcl 72 ref 432\r
+value                     2     001030 automatic       float bin(27)\r
+\c array level 2 in structure "s" dcl 79 in procedure\r
+\r
+\c   "calc" set ref 264* 264 274 278* 278 278 281* 281\r
+\r
+\c   281 284* 284 284 287 292* 292 292 294 296 297* 297\r
+\r
+\c   297 303 303 308* 308 308 314 358* 498* 519* 521*\r
+\r
+\c   523* 525* 527* 529* 531*\r
+value                     4            based           float bin(27)\r
+\c array level 3 in structure "vars" dcl 85\r
+\r
+\c   in procedure "calc" set ref 132* 134* 473* 496*\r
+\r
+\c   498 499\r
+var                       4     001030 automatic       pointer\r
+\c array level 2 dcl 79 set ref 274 499* 517*\r
+var_name_chars                  000036 constant        char(63)\r
+\c initial packed unaligned dcl 70 ref 421 429\r
+vars                                   based           structure\r
+\c level 1 dcl 85\r
+verify                                                 builtin function\r
+\c dcl 104 ref 421 429 432\r
+vp                              000130 automatic       pointer\r
+\c dcl 63 set ref 85 85 85 85 85 128* 130 131 132 133\r
+\r
+\c   134 153* 158 159 447* 450 452* 452 454 467* 470\r
+\r
+\c   473 478* 478 480 492* 495 496 498 499\r
+wrk                             000110 automatic       char(1)\r
+\c packed unaligned dcl 213 set ref 350* 351 354 421\r
+\r
+\c   422 427* 429 432 464* 466 466\r
+wrka                            000112 automatic       char(8)\r
+\c packed unaligned dcl 214 set ref 436* 440 450 455\r
+\r
+\c   463 485 489 495 510\r
+x                               000107 automatic       float bin(27)\r
+\c dcl 212 set ref 512* 519 521 523 525 527 529 531\r
+\r
+NAMES DECLARED BY EXPLICIT CONTEXT.\r
+ABS                             003360 constant        label\r
+\c dcl 527\r
+ADD                             001505 constant        label\r
+\c dcl 278\r
+ASSIGN                          001473 constant        label\r
+\c dcl 274\r
+ATAN                            003346 constant        label\r
+\c dcl 525\r
+COS                             003322 constant        label\r
+\c dcl 521\r
+DIVIDE                          001554 constant        label\r
+\c dcl 287\r
+EXPONENT                        001601 constant        label\r
+\c dcl 294\r
+GET_LINE                        000755 constant        label\r
+\c dcl 178 ref 180 183 187\r
+HANDLE_FAULT                    001112 constant        label\r
+\c dcl 196 ref 142 146\r
+LN                              003370 constant        label\r
+\c dcl 529\r
+LOG                             003402 constant        label\r
+\c dcl 531\r
+MULTIPLY                        001537 constant        label\r
+\c dcl 284\r
+SIN                             003310 constant        label\r
+\c dcl 519\r
+SUBTRACT                        001522 constant        label\r
+\c dcl 281\r
+TAN                             003334 constant        label\r
+\c dcl 523\r
+add                             002065 constant        label\r
+\c dcl 336 ref 230 231 237 240 243 244 261 263 270\r
+another                         002711 constant        label\r
+\c dcl 469 ref 480\r
+bad_char                        002400 constant        label\r
+\c dcl 422 ref 432\r
+blank                           002075 constant        label\r
+\c dcl 341 ref 353\r
+calc                            000320 constant        entry\r
+\c external dcl 41\r
+clean                           001676 constant        label\r
+\c dcl 310 ref 277 280 283 286 293 298\r
+end_ref                         003220 constant        label\r
+\c dcl 512 ref 508\r
+err                             003414 constant        label\r
+\c dcl 534 ref 228 235 251 290 301 306 339 344 368 379\r
+\r
+\c   384 396 407 423 458 490 511\r
+first                           002426 constant        label\r
+\c dcl 428 ref 425\r
+found                           003103 constant        label\r
+\c dcl 497 ref 450\r
+func                            000006 constant        label\r
+\c array(0:6) dcl 519 ref 518\r
+func_ref                        003126 constant        label\r
+\c dcl 502 ref 440 485\r
+ill_prefix                      001274 constant        label\r
+\c dcl 234 ref 254\r
+incr                            002132 constant        label\r
+\c dcl 352 ref 373 389\r
+miss_op                         001251 constant        label\r
+\c dcl 227 ref 257\r
+new_line                        000571 constant        label\r
+\c dcl 149 ref 137 193 200\r
+next_v                          002573 constant        label\r
+\c dcl 449 ref 454\r
+no_print                        002054 constant        label\r
+\c dcl 331 ref 315 324\r
+non_blank                       002134 constant        label\r
+\c dcl 354 ref 351\r
+op_red                          001301 constant        label\r
+\c dcl 239 ref 224\r
+operator                        000000 constant        label\r
+\c array(0:5) dcl 274 ref 272\r
+prec_calc                       001176 constant        entry\r
+\c internal dcl 208 ref 171 191 512\r
+print                           001714 constant        label\r
+\c dcl 314 ref 258\r
+start                           001236 constant        label\r
+\c dcl 224 ref 268 312 348 362 417 500 520 522 524 526\r
+\r
+\c   528 530 532\r
+var_loop                        002416 constant        label\r
+\c dcl 426 ref 429\r
+var_ref                         002364 constant        label\r
+\c dcl 419 ref 356\r
+\r
+THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION.\r
+\r
+STORAGE REQUIREMENTS FOR THIS PROGRAM.\r
+\r
+          Object    Text      Link      Symbol    Defs      Static\r
+Start          0       0      3760        4040    3511        3770\r
+Length      7516    3511        60        3442     246           2\r
+\r
+BLOCK NAME                   STACK SIZE     TYPE            WHY NONQUICK/WHO SH\r
+\cARES STACK FRAME\r
+calc                                995 external procedure  is an external proc\r
+\cedure.\r
+on unit on line 137                  64 on unit\r
+on unit on line 140                  64 on unit\r
+on unit on line 144                  64 on unit\r
+begin block on line 166              90 begin block         uses auto adjustabl\r
+\ce storage.\r
+prec_calc                           140 internal procedure  is called during a \r
+\cstack extension.\r
+\r
+STORAGE FOR INTERNAL STATIC VARIABLES.\r
+\r
+   LOC IDENTIFIER                  BLOCK NAME\r
+000010 calls                       calc\r
+\r
+STORAGE FOR AUTOMATIC VARIABLES.\r
+\r
+STACK FRAME                 LOC IDENTIFIER                  BLOCK NAME\r
+begin block on line 166  000100 expr_arg                    begin block on line\r
+\c 166\r
+calc                     000100 af_sw                       calc\r
+                         000101 expr_arg_sw                 calc\r
+                         000102 arg_ptr                     calc\r
+                         000104 return_ptr                  calc\r
+                         000106 arg_count                   calc\r
+                         000107 arg_len                     calc\r
+                         000110 return_len                  calc\r
+                         000111 ss                          calc\r
+                         000112 fv                          calc\r
+                         000113 fv_save                     calc\r
+                         000114 num                         calc\r
+                         000115 code                        calc\r
+                         000116 dum                         calc\r
+                         000120 sv                          calc\r
+                         000122 iptr                        calc\r
+                         000124 fvp                         calc\r
+                         000126 mp                          calc\r
+                         000130 vp                          calc\r
+                         000132 in                          calc\r
+                         000640 space                       calc\r
+                         001010 error_string                calc\r
+                         001020 out                         calc\r
+                         001030 s                           calc\r
+                         001630 noprt                       calc\r
+                         001631 ileq                        calc\r
+prec_calc                000100 i                           prec_calc\r
+                         000101 j                           prec_calc\r
+                         000102 k                           prec_calc\r
+                         000103 last                        prec_calc\r
+                         000104 level                       prec_calc\r
+                         000105 ip                          prec_calc\r
+                         000106 strt                        prec_calc\r
+                         000107 x                           prec_calc\r
+                         000110 wrk                         prec_calc\r
+                         000112 wrka                        prec_calc\r
+                         000114 msg                         prec_calc\r
+\r
+THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM.\r
+r_g_a               r_e_as              alloc_char_temp     enter_begin_block\r
+\c leave_begin_block   call_ext_out_desc\r
+call_ext_out        call_int_this_desc  call_int_other_desc return_mac\r
+\c fl2_to_fx1          tra_ext_1\r
+alloc_auto_adj      mdfl1               enable_op           shorten_stack\r
+\c ext_entry           int_entry\r
+int_entry_desc      sine_radians_       cosine_radians_     tangent_radians_\r
+\c arc_tangent_radians_log_base_e_\r
+log_base_10_        single_power_single_single_power_integer_\r
+\r
+THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM.\r
+active_fnc_err_               active_fnc_err_$af_suppress_name\r
+\c           com_err_\r
+com_err_$suppress_name        cu_$af_return_arg             cu_$arg_ptr\r
+\c           cu_$cp\r
+cu_$grow_stack_frame          ffip                          ffop\r
+\c           ioa_\r
+ioa_$ioa_switch               iox_$get_line                 iox_$put_chars\r
+\r
+THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM.\r
+error_table_$not_act_fnc      iox_$error_output             iox_$user_input\r
+\c           iox_$user_output\r
+\r
+\r
+\014CONSTANTS\r
+003502  aa     075040040040\r
+003503  aa     040000000000\r
+\r
+000015  aa  163 151 156 040   sin\r
+000016  aa  040 040 040 040\r
+000017  aa  143 157 163 040   cos\r
+000020  aa  040 040 040 040\r
+000021  aa  164 141 156 040   tan\r
+000022  aa  040 040 040 040\r
+000023  aa  141 164 141 156   atan\r
+000024  aa  040 040 040 040\r
+000025  aa  141 142 163 040   abs\r
+000026  aa  040 040 040 040\r
+000027  aa  154 156 040 040   ln\r
+000030  aa  040 040 040 040\r
+000031  aa  154 157 147 040   log\r
+000032  aa  040 040 040 040\r
+\r
+000033  aa  040 056 050 051    .()\r
+000034  aa  075 053 055 052   =+-*\r
+000035  aa  057 000 000 000   /\r
+\r
+000036  aa  101 102 103 104   ABCD\r
+000037  aa  105 106 107 110   EFGH\r
+000040  aa  111 112 113 114   IJKL\r
+000041  aa  115 116 117 120   MNOP\r
+000042  aa  121 122 123 124   QRST\r
+000043  aa  125 126 127 130   UVWX\r
+000044  aa  131 132 141 142   YZab\r
+000045  aa  143 144 145 146   cdef\r
+000046  aa  147 150 151 152   ghij\r
+000047  aa  153 154 155 156   klmn\r
+000050  aa  157 160 161 162   opqr\r
+000051  aa  163 164 165 166   stuv\r
+000052  aa  167 170 171 172   wxyz\r
+000053  aa  060 061 062 063   0123\r
+000054  aa  064 065 066 067   4567\r
+000055  aa  070 071 137 000   89_\r
+\r
+000056  aa     524000000050\r
+\r
+000057  aa     524000000000\r
+\r
+003504  aa  051 000 000 000   )\r
+\r
+003505  aa  050 000 000 000   (\r
+\r
+000060  aa     524000000001\r
+\r
+000061  aa  040 075 040 040    =\r
+\r
+000062  aa  154 151 163 164   list\r
+\r
+000063  aa     524000000055\r
+\r
+003506  aa  052 052 000 000   **\r
+\r
+003507  aa     002400000000\r
+\r
+000064  aa     526077777777\r
+\r
+000065  aa     526000000000\r
+\r
+003510  aa  012 000 000 000\r
+\r
+\r
+000066  aa     464000000000\r
+\r
+000067  aa     526000000040\r
+\r
+000070  aa     524000000002\r
+\r
+000071  aa     404000000043\r
+\r
+000072  aa     414000000033\r
+\r
+000073  aa     404000000021\r
+\r
+000074  aa     526000002424\r
+\r
+000075  aa     524000000010\r
+\r
+000076  aa     524000000022\r
+\r
+000077  aa     004533741242\r
+\r
+000100  aa     004622077325\r
+\r
+000101  aa     524000000031\r
+\r
+000102  aa     524000000004\r
+\r
+000103  aa  143 141 154 143   calc\r
+\r
+000104  aa     404000000005\r
+\r
+000106  aa  075 040 040 040   =\r
+000107  aa  040 000 000 000\r
+\r
+000110  aa  117 166 145 162   Over\r
+000111  aa  146 154 157 167   flow\r
+\r
+000112  aa  103 101 114 103   CALC\r
+000113  aa  040 061 056 061    1.1\r
+\r
+000114  aa  145 040 040 040   e\r
+000115  aa  040 040 040 040\r
+\r
+000116  aa  160 151 040 040   pi\r
+000117  aa  040 040 040 040\r
+\r
+000120  aa     077777000043\r
+000121  aa     000001000000\r
+\r
+000122  aa  157 166 145 162   over\r
+000123  aa  146 154 157 167   flow\r
+\r
+000124  aa  125 156 144 145   Unde\r
+000125  aa  146 040 166 141   f va\r
+000126  aa  162 040 000 000   r\r
+\r
+000127  aa  124 157 157 040   Too\r
+000130  aa  155 141 156 171   many\r
+000131  aa  040 051 047 163    )'s\r
+\r
+000132  aa  124 157 157 040   Too\r
+000133  aa  146 145 167 040   few\r
+000134  aa  051 047 163 000   )'s\r
+\r
+000135  aa  132 145 162 157   Zero\r
+000136  aa  040 052 052 040    **\r
+000137  aa  172 145 162 157   zero\r
+\r
+000140  aa  165 156 144 145   unde\r
+000141  aa  162 146 154 157   rflo\r
+000142  aa  167 000 000 000   w\r
+\r
+000143  aa  115 151 163 163   Miss\r
+000144  aa  151 156 147 040   ing\r
+000145  aa  051 040 141 146   ) af\r
+000146  aa  164 145 162 040   ter\r
+\r
+000147  aa  111 156 166 141   Inva\r
+000150  aa  154 151 144 040   lid\r
+000151  aa  166 141 162 040   var\r
+000152  aa  161 000 000 000   q\r
+\r
+000153  aa  111 156 166 141   Inva\r
+000154  aa  154 151 144 040   lid\r
+000155  aa  143 150 141 162   char\r
+000156  aa  040 000 000 000\r
+\r
+000157  aa  111 156 166 141   Inva\r
+000160  aa  154 151 144 040   lid\r
+000161  aa  165 163 145 040   use\r
+000162  aa  157 146 040 075   of =\r
+\r
+000163  aa  111 156 166 141   Inva\r
+000164  aa  154 151 144 040   lid\r
+000165  aa  165 163 145 040   use\r
+000166  aa  157 146 040 051   of )\r
+\r
+000167  aa  111 156 166 141   Inva\r
+000170  aa  154 151 144 040   lid\r
+000171  aa  165 163 145 040   use\r
+000172  aa  157 146 040 050   of (\r
+\r
+000173  aa  104 151 166 151   Divi\r
+000174  aa  144 145 040 142   de b\r
+000175  aa  171 040 172 145   y ze\r
+000176  aa  162 157 000 000   ro\r
+\r
+000177  aa  116 165 154 154   Null\r
+000200  aa  040 145 170 160    exp\r
+000201  aa  162 145 163 163   ress\r
+000202  aa  151 157 156 000   ion\r
+\r
+000203  aa  115 151 163 163   Miss\r
+000204  aa  151 156 147 040   ing\r
+000205  aa  157 160 145 162   oper\r
+000206  aa  141 164 157 162   ator\r
+\r
+000207  aa  146 151 170 145   fixe\r
+000210  aa  144 157 166 145   dove\r
+000211  aa  162 146 154 157   rflo\r
+000212  aa  167 000 000 000   w\r
+\r
+000213  aa  111 156 166 141   Inva\r
+000214  aa  154 151 144 040   lid\r
+000215  aa  157 160 040 141   op a\r
+000216  aa  146 164 145 162   fter\r
+000217  aa  040 050 000 000    (\r
+\r
+000220  aa  060 061 062 063   0123\r
+000221  aa  064 065 066 067   4567\r
+000222  aa  070 071 056 050   89.(\r
+000223  aa  051 075 053 055   )=+-\r
+000224  aa  052 057 000 000   */\r
+\r
+000225  aa  123 151 155 160   Simp\r
+000226  aa  154 151 146 171   lify\r
+000227  aa  040 145 170 160    exp\r
+000230  aa  162 145 163 163   ress\r
+000231  aa  151 157 156 000   ion\r
+\r
+000232  aa  105 170 160 157   Expo\r
+000233  aa  156 145 156 164   nent\r
+000234  aa  040 164 157 157    too\r
+000235  aa  040 163 155 141    sma\r
+000236  aa  154 154 000 000   ll\r
+\r
+000237  aa  106 141 164 141   Fata\r
+000240  aa  154 040 157 165   l ou\r
+000241  aa  164 040 157 146   t of\r
+000242  aa  040 163 160 141    spa\r
+000243  aa  143 145 000 000   ce\r
+\r
+000244  aa  160 162 157 147   prog\r
+000245  aa  162 141 155 137   ram_\r
+000246  aa  151 156 164 145   inte\r
+000247  aa  162 162 165 160   rrup\r
+000250  aa  164 000 000 000   t\r
+\r
+000251  aa  116 145 147 040   Neg\r
+000252  aa  156 165 155 040   num\r
+000253  aa  052 052 040 156   ** n\r
+000254  aa  157 156 055 151   on-i\r
+000255  aa  156 164 145 147   nteg\r
+000256  aa  145 162 000 000   er\r
+\r
+000257  aa  111 156 166 141   Inva\r
+000260  aa  154 151 144 040   lid\r
+000261  aa  160 162 145 146   pref\r
+000262  aa  151 170 040 157   ix o\r
+000263  aa  160 145 162 141   pera\r
+000264  aa  164 157 162 000   tor\r
+\r
+000265  aa  125 163 141 147   Usag\r
+000266  aa  145 072 040 040   e:\r
+000267  aa  133 143 141 154   [cal\r
+000270  aa  143 040 145 170   c ex\r
+000271  aa  160 162 145 163   pres\r
+000272  aa  163 151 157 156   sion\r
+000273  aa  135 000 000 000   ]\r
+\r
+000274  aa  125 163 141 147   Usag\r
+000275  aa  145 072 040 040   e:\r
+000276  aa  143 141 154 143   calc\r
+000277  aa  040 173 145 170    {ex\r
+000300  aa  160 162 145 163   pres\r
+000301  aa  163 151 157 156   sion\r
+000302  aa  175 000 000 000   }\r
+\r
+000303  aa  126 141 162 151   Vari\r
+000304  aa  141 142 154 145   able\r
+000305  aa  163 040 156 157   s no\r
+000306  aa  164 040 141 154   t al\r
+000307  aa  154 157 167 145   lowe\r
+000310  aa  144 040 151 156   d in\r
+000311  aa  040 145 170 160    exp\r
+000312  aa  162 145 163 163   ress\r
+000313  aa  151 157 156 040   ion\r
+000314  aa  141 162 147 165   argu\r
+000315  aa  155 145 156 164   ment\r
+000316  aa  056 000 000 000   .\r
+\r
+LABEL ARRAYS\r
+000000  aa   001473 7100 04   tra       827,ic              001473\r
+000001  aa   001504 7100 04   tra       836,ic              001505\r
+000002  aa   001520 7100 04   tra       848,ic              001522\r
+000003  aa   001534 7100 04   tra       860,ic              001537\r
+000004  aa   001550 7100 04   tra       872,ic              001554\r
+000005  aa   001574 7100 04   tra       892,ic              001601\r
+\r
+000006  aa   003302 7100 04   tra       1730,ic             003310\r
+000007  aa   003313 7100 04   tra       1739,ic             003322\r
+000010  aa   003324 7100 04   tra       1748,ic             003334\r
+000011  aa   003335 7100 04   tra       1757,ic             003346\r
+000012  aa   003346 7100 04   tra       1766,ic             003360\r
+000013  aa   003355 7100 04   tra       1773,ic             003370\r
+000014  aa   003366 7100 04   tra       1782,ic             003402\r
+\r
+BEGIN PROCEDURE calc\r
+ENTRY TO calc                                               STATEMENT 1 ON LINE\r
+\c 41\r
+calc: proc;\r
+\r
+000317  da     000207200000\r
+000320  aa   001760 6270 00   eax7      1008\r
+000321  aa  7 00034 3521 20   epp2      pr7|28,*\r
+000322  aa  2 01045 2721 00   tsp2      pr2|549             ext_entry\r
+000323  aa     000000000000\r
+000324  2s     000012000125\r
+                                                            STATEMENT 1 ON LINE\r
+\c 110\r
+      call cu_$af_return_arg (arg_count, return_ptr, return_len, code);\r
+\r
+000325  aa  6 00106 3521 00   epp2      pr6|70              arg_count\r
+000326  aa  6 01664 2521 00   spri2     pr6|948\r
+000327  aa  6 00104 3521 00   epp2      pr6|68              return_ptr\r
+000330  aa  6 01666 2521 00   spri2     pr6|950\r
+000331  aa  6 00110 3521 00   epp2      pr6|72              return_len\r
+000332  aa  6 01670 2521 00   spri2     pr6|952\r
+000333  aa  6 00115 3521 00   epp2      pr6|77              code\r
+000334  aa  6 01672 2521 00   spri2     pr6|954\r
+000335  aa  6 01662 6211 00   eax1      pr6|946\r
+000336  aa   020000 4310 07   fld       8192,dl\r
+000337  la  4 00026 3521 20   epp2      pr4|22,*            cu_$af_return_arg\r
+000340  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 111\r
+      if code = error_table_$not_act_fnc then do;\r
+\r
+000341  aa  6 00115 2361 00   ldq       pr6|77              code\r
+000342  aa  6 00044 3701 20   epp4      pr6|36,*\r
+000343  la  4 00014 1161 20   cmpq      pr4|12,*            error_table_$not_ac\r
+\ct_fnc\r
+000344  aa   000042 6010 04   tnz       34,ic               000406\r
+                                                            STATEMENT 1 ON LINE\r
+\c 112\r
+         if arg_count > 1 then do;\r
+\r
+000345  aa  6 00106 2361 00   ldq       pr6|70              arg_count\r
+000346  aa   000001 1160 07   cmpq      1,dl\r
+000347  aa   000030 6044 04   tmoz      24,ic               000377\r
+                                                            STATEMENT 1 ON LINE\r
+\c 113\r
+            call com_err_$suppress_name (0, "calc", "Usage:  calc {expression}"\r
+\c);\r
+\r
+000350  aa  6 01674 4501 00   stz       pr6|956\r
+000351  aa   777532 2350 04   lda       -166,ic             000103 = 1431411541\r
+\c43\r
+000352  aa  6 01675 7551 00   sta       pr6|957\r
+000353  aa  000 100 100 404   mlr       (ic),(pr),fill(000)\r
+000354  aa   777721 00 0034   desc9a    -47,28              000274 = 1251631411\r
+\c47\r
+000355  aa  6 01662 00 0034   desc9a    pr6|946,28\r
+000356  aa  6 01674 3521 00   epp2      pr6|956\r
+000357  aa  6 01700 2521 00   spri2     pr6|960\r
+000360  aa  6 01675 3521 00   epp2      pr6|957\r
+000361  aa  6 01702 2521 00   spri2     pr6|962\r
+000362  aa  6 01662 3521 00   epp2      pr6|946\r
+000363  aa  6 01704 2521 00   spri2     pr6|964\r
+000364  aa   777520 3520 04   epp2      -176,ic             000104 = 4040000000\r
+\c05\r
+000365  aa  6 01706 2521 00   spri2     pr6|966\r
+000366  aa   777514 3520 04   epp2      -180,ic             000102 = 5240000000\r
+\c04\r
+000367  aa  6 01710 2521 00   spri2     pr6|968\r
+000370  aa   777511 3520 04   epp2      -183,ic             000101 = 5240000000\r
+\c31\r
+000371  aa  6 01712 2521 00   spri2     pr6|970\r
+000372  aa  6 01676 6211 00   eax1      pr6|958\r
+000373  aa   014000 4310 07   fld       6144,dl\r
+000374  la  4 00024 3521 20   epp2      pr4|20,*            com_err_$suppress_n\r
+\came\r
+000375  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 114\r
+            return;\r
+\r
+000376  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 115\r
+         end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 116\r
+         else if arg_count = 1 then expr_arg_sw = "1"b;\r
+\r
+000377  aa   000004 6010 04   tnz       4,ic                000403\r
+000400  aa   400000 2350 03   lda       131072,du\r
+000401  aa  6 00101 7551 00   sta       pr6|65              expr_arg_sw\r
+000402  aa   000002 7100 04   tra       2,ic                000404\r
+                                                            STATEMENT 1 ON LINE\r
+\c 117\r
+         else expr_arg_sw = "0"b;\r
+\r
+000403  aa  6 00101 4501 00   stz       pr6|65              expr_arg_sw\r
+                                                            STATEMENT 1 ON LINE\r
+\c 118\r
+         af_sw = "0"b;\r
+\r
+000404  aa  6 00100 4501 00   stz       pr6|64              af_sw\r
+                                                            STATEMENT 1 ON LINE\r
+\c 119\r
+      end;\r
+\r
+000405  aa   000043 7100 04   tra       35,ic               000450\r
+                                                            STATEMENT 1 ON LINE\r
+\c 120\r
+      else do;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 121\r
+         if arg_count = 0 | arg_count > 1 then do;\r
+\r
+000406  aa  6 00106 2361 00   ldq       pr6|70              arg_count\r
+000407  aa   000001 1160 07   cmpq      1,dl\r
+000410  aa  0 00503 7001 00   tsx0      pr0|323             r_g_a\r
+000411  aa  6 01675 7551 00   sta       pr6|957\r
+000412  aa  6 00106 2361 00   ldq       pr6|70              arg_count\r
+000413  aa  0 00512 7001 00   tsx0      pr0|330             r_e_as\r
+000414  aa  6 01675 2751 00   ora       pr6|957\r
+000415  aa   000030 6000 04   tze       24,ic               000445\r
+                                                            STATEMENT 1 ON LINE\r
+\c 122\r
+            call active_fnc_err_$af_suppress_name (0, "calc", "Usage:  [calc ex\r
+\cpression]");\r
+\r
+000416  aa  6 01675 4501 00   stz       pr6|957\r
+000417  aa   777464 2350 04   lda       -204,ic             000103 = 1431411541\r
+\c43\r
+000420  aa  6 01674 7551 00   sta       pr6|956\r
+000421  aa  000 100 100 404   mlr       (ic),(pr),fill(000)\r
+000422  aa   777644 00 0034   desc9a    -92,28              000265 = 1251631411\r
+\c47\r
+000423  aa  6 01662 00 0034   desc9a    pr6|946,28\r
+000424  aa  6 01675 3521 00   epp2      pr6|957\r
+000425  aa  6 01700 2521 00   spri2     pr6|960\r
+000426  aa  6 01674 3521 00   epp2      pr6|956\r
+000427  aa  6 01702 2521 00   spri2     pr6|962\r
+000430  aa  6 01662 3521 00   epp2      pr6|946\r
+000431  aa  6 01704 2521 00   spri2     pr6|964\r
+000432  aa   777452 3520 04   epp2      -214,ic             000104 = 4040000000\r
+\c05\r
+000433  aa  6 01706 2521 00   spri2     pr6|966\r
+000434  aa   777446 3520 04   epp2      -218,ic             000102 = 5240000000\r
+\c04\r
+000435  aa  6 01710 2521 00   spri2     pr6|968\r
+000436  aa   777443 3520 04   epp2      -221,ic             000101 = 5240000000\r
+\c31\r
+000437  aa  6 01712 2521 00   spri2     pr6|970\r
+000440  aa  6 01676 6211 00   eax1      pr6|958\r
+000441  aa   014000 4310 07   fld       6144,dl\r
+000442  la  4 00020 3521 20   epp2      pr4|16,*            active_fnc_err_$af_\r
+\csuppress_name\r
+000443  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 123\r
+            return;\r
+\r
+000444  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 124\r
+         end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 125\r
+         af_sw, expr_arg_sw = "1"b;\r
+\r
+000445  aa   400000 2350 03   lda       131072,du\r
+000446  aa  6 00100 7551 00   sta       pr6|64              af_sw\r
+000447  aa  6 00101 7551 00   sta       pr6|65              expr_arg_sw\r
+                                                            STATEMENT 1 ON LINE\r
+\c 126\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 128\r
+      vp, sv = addr (space);\r
+\r
+000450  aa  6 00640 3735 00   epp7      pr6|416             space\r
+000451  aa  6 01714 6535 00   spri7     pr6|972\r
+000452  aa  6 00130 6535 00   spri7     pr6|88              vp\r
+000453  aa  6 00120 6535 00   spri7     pr6|80              sv\r
+                                                            STATEMENT 1 ON LINE\r
+\c 129\r
+      iptr = addr (in);\r
+\r
+000454  aa  6 00132 3715 00   epp5      pr6|90              in\r
+000455  aa  6 00122 6515 00   spri5     pr6|82              iptr\r
+                                                            STATEMENT 1 ON LINE\r
+\c 130\r
+      vars.next = null;\r
+\r
+000456  aa   777442 2370 04   ldaq      -222,ic             000120 = 0777770000\r
+\c43 000001000000\r
+000457  aa  6 00130 7571 20   staq      pr6|88,*            vars.next\r
+                                                            STATEMENT 1 ON LINE\r
+\c 131\r
+      vars.d.name (0) = "pi";\r
+\r
+000460  aa   777436 2370 04   ldaq      -226,ic             000116 = 1601510400\r
+\c40 040040040040\r
+000461  aa  6 00130 3535 20   epp3      pr6|88,*            vp\r
+000462  aa  3 00002 7551 00   sta       pr3|2               vars.name\r
+000463  aa  3 00003 7561 00   stq       pr3|3               vars.name\r
+                                                            STATEMENT 1 ON LINE\r
+\c 132\r
+      vars.d.value (0) = 3.14159265e0;\r
+\r
+000464  aa   777414 4310 04   fld       -244,ic             000100 = 0046220773\r
+\c25\r
+000465  aa  3 00004 4551 00   fst       pr3|4               vars.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 133\r
+      vars.d.name (1) = "e";\r
+\r
+000466  aa   777426 2370 04   ldaq      -234,ic             000114 = 1450400400\r
+\c40 040040040040\r
+000467  aa  3 00005 7551 00   sta       pr3|5               vars.name\r
+000470  aa  3 00006 7561 00   stq       pr3|6               vars.name\r
+                                                            STATEMENT 1 ON LINE\r
+\c 134\r
+      vars.d.value (1) = 2.7182818e0;\r
+\r
+000471  aa   777406 4310 04   fld       -250,ic             000077 = 0045337412\r
+\c42\r
+000472  aa  3 00007 4551 00   fst       pr3|7               vars.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 135\r
+      fv = 2;\r
+\r
+000473  aa   000002 2360 07   ldq       2,dl\r
+000474  aa  6 00112 7561 00   stq       pr6|74              fv\r
+                                                            STATEMENT 1 ON LINE\r
+\c 137\r
+      if ^af_sw then                                        /* phx09588,phx1823\r
+\c1: */\r
+           on program_interrupt go to new_line;\r
+\r
+000475  aa  6 00100 2351 00   lda       pr6|64              af_sw\r
+000476  aa   000020 6010 04   tnz       16,ic               000516\r
+000477  aa   000021 7260 07   lxl6      17,dl\r
+000500  aa   777544 3520 04   epp2      -156,ic             000244 = 1601621571\r
+\c47\r
+000501  aa  0 00717 7001 00   tsx0      pr0|463             enable_op\r
+000502  aa   000004 7100 04   tra       4,ic                000506\r
+000503  aa     001646000000\r
+000504  aa   000012 7100 04   tra       10,ic               000516\r
+BEGIN CONDITION program_interrupt.1\r
+ENTRY TO program_interrupt.1                                STATEMENT 1 ON LINE\r
+\c 137\r
+      if ^af_sw then                                        /* phx09588,phx1823\r
+\c1: */\r
+           on program_interrupt go to new_line;\r
+\r
+000505  da     000217200000\r
+000506  aa   000100 6270 00   eax7      64\r
+000507  aa  7 00034 3521 20   epp2      pr7|28,*\r
+000510  aa  2 01047 2721 00   tsp2      pr2|551             int_entry\r
+000511  aa     000000000000\r
+000512  2s  0 00012 0011 15   mme1      pr0|10,5\r
+000513  aa   000056 3520 04   epp2      46,ic               000571 = 0000013360\r
+\c07\r
+000514  aa   000001 7270 07   lxl7      1,dl\r
+000515  aa  0 00657 7101 00   tra       pr0|431             tra_ext_1\r
+  END CONDITION program_interrupt.1\r
+                                                            STATEMENT 1 ON LINE\r
+\c 140\r
+      on overflow, fixedoverflow begin;\r
+\r
+000516  aa   000010 7260 07   lxl6      8,dl\r
+000517  aa   777403 3520 04   epp2      -253,ic             000122 = 1571661451\r
+\c62\r
+000520  aa  0 00717 7001 00   tsx0      pr0|463             enable_op\r
+000521  aa   000004 7100 04   tra       4,ic                000525\r
+000522  aa     001640000000\r
+000523  aa   000016 7100 04   tra       14,ic               000541\r
+BEGIN CONDITION fixedoverflow.3\r
+ENTRY TO fixedoverflow.3                                    STATEMENT 1 ON LINE\r
+\c 140\r
+      on overflow, fixedoverflow begin;\r
+\r
+000524  da     000226200000\r
+000525  aa   000100 6270 00   eax7      64\r
+000526  aa  7 00034 3521 20   epp2      pr7|28,*\r
+000527  aa  2 01047 2721 00   tsp2      pr2|551             int_entry\r
+000530  aa     000000000000\r
+000531  2s  0 00012 0011 34   mme1      pr0|10,4*\r
+                                                            STATEMENT 1 ON LINE\r
+\c 141\r
+         error_string = "Overflow";\r
+\r
+000532  aa  6 00040 3735 20   epp7      pr6|32,*\r
+000533  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+000534  aa   777355 00 0010   desc9a    -275,8              000110 = 1171661451\r
+\c62\r
+000535  aa  7 01010 00 0040   desc9a    pr7|520,32          error_string\r
+                                                            STATEMENT 1 ON LINE\r
+\c 142\r
+         go to HANDLE_FAULT;\r
+\r
+000536  aa   000354 3520 04   epp2      236,ic              001112 = 6001002351\r
+\c00\r
+000537  aa   000001 7270 07   lxl7      1,dl\r
+000540  aa  0 00657 7101 00   tra       pr0|431             tra_ext_1\r
+                                                            STATEMENT 1 ON LINE\r
+\c 143\r
+      end;\r
+\r
+  END CONDITION fixedoverflow.3\r
+                                                            STATEMENT 1 ON LINE\r
+\c 140\r
+      on overflow, fixedoverflow begin;\r
+\r
+000541  aa   000015 7260 07   lxl6      13,dl\r
+000542  aa   777445 3520 04   epp2      -219,ic             000207 = 1461511701\r
+\c45\r
+000543  aa  0 00717 7001 00   tsx0      pr0|463             enable_op\r
+000544  aa   777761 7100 04   tra       -15,ic              000525\r
+000545  aa     001632000000\r
+                                                            STATEMENT 1 ON LINE\r
+\c 144\r
+      on underflow begin;\r
+\r
+000546  aa   000011 7260 07   lxl6      9,dl\r
+000547  aa   777371 3520 04   epp2      -263,ic             000140 = 1651561441\r
+\c45\r
+000550  aa  0 00717 7001 00   tsx0      pr0|463             enable_op\r
+000551  aa   000004 7100 04   tra       4,ic                000555\r
+000552  aa     001654000000\r
+000553  aa   000016 7100 04   tra       14,ic               000571\r
+BEGIN CONDITION underflow.4\r
+ENTRY TO underflow.4                                        STATEMENT 1 ON LINE\r
+\c 144\r
+      on underflow begin;\r
+\r
+000554  da     000234200000\r
+000555  aa   000100 6270 00   eax7      64\r
+000556  aa  7 00034 3521 20   epp2      pr7|28,*\r
+000557  aa  2 01047 2721 00   tsp2      pr2|551             int_entry\r
+000560  aa     000000000000\r
+000561  2s     000012001152\r
+                                                            STATEMENT 1 ON LINE\r
+\c 145\r
+         error_string = "Exponent too small";\r
+\r
+000562  aa  6 00040 3735 20   epp7      pr6|32,*\r
+000563  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+000564  aa   777447 00 0022   desc9a    -217,18             000232 = 1051701601\r
+\c57\r
+000565  aa  7 01010 00 0040   desc9a    pr7|520,32          error_string\r
+                                                            STATEMENT 1 ON LINE\r
+\c 146\r
+         go to HANDLE_FAULT;\r
+\r
+000566  aa   000324 3520 04   epp2      212,ic              001112 = 6001002351\r
+\c00\r
+000567  aa   000001 7270 07   lxl7      1,dl\r
+000570  aa  0 00657 7101 00   tra       pr0|431             tra_ext_1\r
+                                                            STATEMENT 1 ON LINE\r
+\c 147\r
+      end;\r
+\r
+  END CONDITION underflow.4\r
+                                                            STATEMENT 1 ON LINE\r
+\c 149\r
+new_line: ss = -1;\r
+\r
+000571  aa   000001 3360 07   lcq       1,dl\r
+000572  aa  6 00111 7561 00   stq       pr6|73              ss\r
+                                                            STATEMENT 1 ON LINE\r
+\c 150\r
+      calls = 0;\r
+\r
+000573  aa  6 00044 3701 20   epp4      pr6|36,*\r
+000574  ia  4 00010 4501 00   stz       pr4|8               calls\r
+                                                            STATEMENT 1 ON LINE\r
+\c 151\r
+      noprt, ileq = "0"b;\r
+\r
+000575  aa  6 01630 4501 00   stz       pr6|920             noprt\r
+000576  aa  6 01631 4501 00   stz       pr6|921             ileq\r
+                                                            STATEMENT 1 ON LINE\r
+\c 152\r
+      if fv > 31 then do;\r
+\r
+000577  aa  6 00112 2361 00   ldq       pr6|74              fv\r
+000600  aa   000037 1160 07   cmpq      31,dl\r
+000601  aa   000041 6044 04   tmoz      33,ic               000642\r
+                                                            STATEMENT 1 ON LINE\r
+\c 153\r
+         call cu_$grow_stack_frame (104, vp, code);\r
+\r
+000602  aa   000150 2360 07   ldq       104,dl\r
+000603  aa  6 01674 7561 00   stq       pr6|956\r
+000604  aa  6 01674 3521 00   epp2      pr6|956\r
+000605  aa  6 01664 2521 00   spri2     pr6|948\r
+000606  aa  6 00130 3521 00   epp2      pr6|88              vp\r
+000607  aa  6 01666 2521 00   spri2     pr6|950\r
+000610  aa  6 00115 3521 00   epp2      pr6|77              code\r
+000611  aa  6 01670 2521 00   spri2     pr6|952\r
+000612  aa  6 01662 6211 00   eax1      pr6|946\r
+000613  aa   014000 4310 07   fld       6144,dl\r
+000614  la  4 00056 3521 20   epp2      pr4|46,*            cu_$grow_stack_fram\r
+\ce\r
+000615  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 154\r
+         if code ^= 0 then do;\r
+\r
+000616  aa  6 00115 2361 00   ldq       pr6|77              code\r
+000617  aa   000016 6000 04   tze       14,ic               000635\r
+                                                            STATEMENT 1 ON LINE\r
+\c 155\r
+            call ioa_ ("Fatal out of space");\r
+\r
+000620  aa  000 100 100 404   mlr       (ic),(pr),fill(000)\r
+000621  aa   777417 00 0024   desc9a    -241,20             000237 = 1061411641\r
+\c41\r
+000622  aa  6 01662 00 0024   desc9a    pr6|946,20\r
+000623  aa  6 01662 3521 00   epp2      pr6|946\r
+000624  aa  6 01700 2521 00   spri2     pr6|960\r
+000625  aa   777251 3520 04   epp2      -343,ic             000076 = 5240000000\r
+\c22\r
+000626  aa  6 01702 2521 00   spri2     pr6|962\r
+000627  aa  6 01676 6211 00   eax1      pr6|958\r
+000630  aa   004000 4310 07   fld       2048,dl\r
+000631  aa  6 00044 3701 20   epp4      pr6|36,*\r
+000632  la  4 00036 3521 20   epp2      pr4|30,*            ioa_\r
+000633  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 156\r
+            return;\r
+\r
+000634  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 157\r
+         end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 158\r
+         vars.next = sv;\r
+\r
+000635  aa  6 00120 3735 20   epp7      pr6|80,*            sv\r
+000636  aa  6 00130 6535 20   spri7     pr6|88,*            vars.next\r
+                                                            STATEMENT 1 ON LINE\r
+\c 159\r
+         sv = vp;\r
+\r
+000637  aa  6 00130 3715 20   epp5      pr6|88,*            vp\r
+000640  aa  6 00120 6515 00   spri5     pr6|80              sv\r
+                                                            STATEMENT 1 ON LINE\r
+\c 160\r
+         fv = 0;\r
+\r
+000641  aa  6 00112 4501 00   stz       pr6|74              fv\r
+                                                            STATEMENT 1 ON LINE\r
+\c 161\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 163\r
+      if expr_arg_sw then do;\r
+\r
+000642  aa  6 00101 2351 00   lda       pr6|65              expr_arg_sw\r
+000643  aa   000112 6000 04   tze       74,ic               000755\r
+                                                            STATEMENT 1 ON LINE\r
+\c 164\r
+         call cu_$arg_ptr (1, arg_ptr, arg_len, code);\r
+\r
+000644  aa   000001 2360 07   ldq       1,dl\r
+000645  aa  6 01674 7561 00   stq       pr6|956\r
+000646  aa  6 01674 3521 00   epp2      pr6|956\r
+000647  aa  6 01664 2521 00   spri2     pr6|948\r
+000650  aa  6 00102 3521 00   epp2      pr6|66              arg_ptr\r
+000651  aa  6 01666 2521 00   spri2     pr6|950\r
+000652  aa  6 00107 3521 00   epp2      pr6|71              arg_len\r
+000653  aa  6 01670 2521 00   spri2     pr6|952\r
+000654  aa  6 00115 3521 00   epp2      pr6|77              code\r
+000655  aa  6 01672 2521 00   spri2     pr6|954\r
+000656  aa  6 01662 6211 00   eax1      pr6|946\r
+000657  aa   020000 4310 07   fld       8192,dl\r
+000660  aa  6 00044 3701 20   epp4      pr6|36,*\r
+000661  la  4 00030 3521 20   epp2      pr4|24,*            cu_$arg_ptr\r
+000662  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 166\r
+         begin;\r
+\r
+000663  aa   000140 6270 00   eax7      96\r
+000664  aa  0 00614 2721 00   tsp2      pr0|396             enter_begin_block\r
+000665  2s  0 00012 0011 64   mme1      pr0|10,*ic\r
+BEGIN BLOCK  1\r
+PROLOGUE SEQUENCE                                           STATEMENT 1 ON LINE\r
+\c 167\r
+000666  aa  6 00040 3735 20   epp7      pr6|32,*\r
+000667  aa  7 00107 2361 00   ldq       pr7|71              arg_len\r
+000670  aa   000001 0760 07   adq       1,dl\r
+000671  aa  6 00100 7561 00   stq       pr6|64\r
+000672  aa   000003 0760 07   adq       3,dl\r
+000673  aa   000002 7320 00   qrs       2\r
+000674  aa  6 00101 7561 00   stq       pr6|65\r
+000675  aa  0 00661 7001 00   tsx0      pr0|433             alloc_auto_adj\r
+000676  aa  6 00102 2521 00   spri2     pr6|66\r
+                                                            STATEMENT 1 ON LINE\r
+\c 171\r
+000677  aa  6 00100 2361 00   ldq       pr6|64\r
+000700  aa   526000 2760 03   orq       175104,du\r
+000701  aa  6 00104 7561 00   stq       pr6|68\r
+MAIN SEQUENCE                                               STATEMENT 1 ON LINE\r
+\c 169\r
+            expr_arg = arg || "\r
+";\r
+\r
+000702  aa  7 00107 2361 00   ldq       pr7|71              arg_len\r
+000703  aa   000001 0760 07   adq       1,dl\r
+000704  aa  0 00551 7001 00   tsx0      pr0|361             alloc_char_temp\r
+000705  aa  7 00102 3715 20   epp5      pr7|66,*            arg_ptr\r
+000706  aa  7 00107 7271 00   lxl7      pr7|71              arg_len\r
+000707  aa  040 140 100 540   mlr       (pr,rl),(pr,rl),fill(040)\r
+000710  aa  5 00000 00 0017   desc9a    pr5|0,x7            arg\r
+000711  aa  2 00000 00 0017   desc9a    pr2|0,x7\r
+000712  aa  040 117 100 404   mlr       (ic),(pr,x7),fill(040)\r
+000713  aa   002576 00 0001   desc9a    1406,1              003510 = 0120000000\r
+\c00\r
+000714  aa  2 00000 00 0001   desc9a    pr2|0,1\r
+000715  aa  6 00102 3535 20   epp3      pr6|66,*\r
+000716  aa  6 00100 2351 00   lda       pr6|64\r
+000717  aa  040 140 100 540   mlr       (pr,rl),(pr,rl),fill(040)\r
+000720  aa  2 00000 00 0006   desc9a    pr2|0,ql\r
+000721  aa  3 00000 00 0005   desc9a    pr3|0,al            expr_arg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 171\r
+            call prec_calc (expr_arg, arg_len + 1, dum, code);\r
+\r
+000722  aa  0 01014 7001 00   tsx0      pr0|524             shorten_stack\r
+000723  aa  7 00107 2361 00   ldq       pr7|71              arg_len\r
+000724  aa   000001 0760 07   adq       1,dl\r
+000725  aa  6 00105 7561 00   stq       pr6|69\r
+000726  aa  3 00000 3521 00   epp2      pr3|0               expr_arg\r
+000727  aa  6 00110 2521 00   spri2     pr6|72\r
+000730  aa  6 00105 3521 00   epp2      pr6|69\r
+000731  aa  6 00112 2521 00   spri2     pr6|74\r
+000732  aa  7 00116 3521 00   epp2      pr7|78              dum\r
+000733  aa  6 00114 2521 00   spri2     pr6|76\r
+000734  aa  7 00115 3521 00   epp2      pr7|77              code\r
+000735  aa  6 00116 2521 00   spri2     pr6|78\r
+000736  aa  6 00104 3521 00   epp2      pr6|68\r
+000737  aa  6 00122 2521 00   spri2     pr6|82\r
+000740  aa   777133 3520 04   epp2      -421,ic             000073 = 4040000000\r
+\c21\r
+000741  aa  6 00124 2521 00   spri2     pr6|84\r
+000742  aa   777130 3520 04   epp2      -424,ic             000072 = 4140000000\r
+\c33\r
+000743  aa  6 00126 2521 00   spri2     pr6|86\r
+000744  aa   777125 3520 04   epp2      -427,ic             000071 = 4040000000\r
+\c43\r
+000745  aa  6 00130 2521 00   spri2     pr6|88\r
+000746  aa   000001 7270 07   lxl7      1,dl\r
+000747  aa  6 00106 6211 00   eax1      pr6|70\r
+000750  aa   020000 4310 07   fld       8192,dl\r
+000751  aa   000225 3520 04   epp2      149,ic              001176 = 0002206270\r
+\c00\r
+000752  aa  0 00626 7001 00   tsx0      pr0|406             call_int_other_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 173\r
+         end;\r
+\r
+000753  aa  0 00615 7001 00   tsx0      pr0|397             leave_begin_block\r
+  END BLOCK  1\r
+                                                            STATEMENT 1 ON LINE\r
+\c 175\r
+         return;\r
+\r
+000754  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 176\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 178\r
+GET_LINE: call iox_$get_line (iox_$user_input, iptr, length (in), num, (0));\r
+\r
+000755  aa   002424 2360 07   ldq       1300,dl\r
+000756  aa  6 01674 7561 00   stq       pr6|956\r
+000757  aa  6 01675 4501 00   stz       pr6|957\r
+000760  aa  6 00044 3701 20   epp4      pr6|36,*\r
+000761  la  4 00052 3521 20   epp2      pr4|42,*            iox_$user_input\r
+000762  aa  6 01700 2521 00   spri2     pr6|960\r
+000763  aa  6 00122 3521 00   epp2      pr6|82              iptr\r
+000764  aa  6 01702 2521 00   spri2     pr6|962\r
+000765  aa  6 01674 3521 00   epp2      pr6|956\r
+000766  aa  6 01704 2521 00   spri2     pr6|964\r
+000767  aa  6 00114 3521 00   epp2      pr6|76              num\r
+000770  aa  6 01706 2521 00   spri2     pr6|966\r
+000771  aa  6 01675 3521 00   epp2      pr6|957\r
+000772  aa  6 01710 2521 00   spri2     pr6|968\r
+000773  aa  6 01676 6211 00   eax1      pr6|958\r
+000774  aa   024000 4310 07   fld       10240,dl\r
+000775  la  4 00044 3521 20   epp2      pr4|36,*            iox_$get_line\r
+000776  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 180\r
+      if num = 1 then go to GET_LINE;\r
+\r
+000777  aa  6 00114 2361 00   ldq       pr6|76              num\r
+001000  aa   000001 1160 07   cmpq      1,dl\r
+001001  aa   000002 6010 04   tnz       2,ic                001003\r
+001002  aa   777753 7100 04   tra       -21,ic              000755\r
+                                                            STATEMENT 1 ON LINE\r
+\c 181\r
+      else if num = 2 & substr (in, 1, 1) = "." then do;\r
+\r
+001003  aa  6 00132 2351 00   lda       pr6|90              in\r
+001004  aa  0 00022 3771 00   anaq      pr0|18              = 777000000000 0000\r
+\c00000000\r
+001005  aa   056000 1150 03   cmpa      23552,du\r
+001006  aa  0 00512 7001 00   tsx0      pr0|330             r_e_as\r
+001007  aa  6 01675 7551 00   sta       pr6|957\r
+001010  aa  6 00114 2361 00   ldq       pr6|76              num\r
+001011  aa   000002 1160 07   cmpq      2,dl\r
+001012  aa  0 00512 7001 00   tsx0      pr0|330             r_e_as\r
+001013  aa  6 01675 3151 00   cana      pr6|957\r
+001014  aa   000015 6000 04   tze       13,ic               001031\r
+                                                            STATEMENT 1 ON LINE\r
+\c 182\r
+         call ioa_ ("CALC 1.1");\r
+\r
+001015  aa   777075 2370 04   ldaq      -451,ic             000112 = 1031011141\r
+\c03 040061056061\r
+001016  aa  6 01714 7571 00   staq      pr6|972\r
+001017  aa  6 01714 3521 00   epp2      pr6|972\r
+001020  aa  6 01664 2521 00   spri2     pr6|948\r
+001021  aa   777054 3520 04   epp2      -468,ic             000075 = 5240000000\r
+\c10\r
+001022  aa  6 01666 2521 00   spri2     pr6|950\r
+001023  aa  6 01662 6211 00   eax1      pr6|946\r
+001024  aa   004000 4310 07   fld       2048,dl\r
+001025  aa  6 00044 3701 20   epp4      pr6|36,*\r
+001026  la  4 00036 3521 20   epp2      pr4|30,*            ioa_\r
+001027  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 183\r
+         go to GET_LINE;\r
+\r
+001030  aa   777725 7100 04   tra       -43,ic              000755\r
+                                                            STATEMENT 1 ON LINE\r
+\c 184\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 185\r
+      else if substr (in, 1, 2) = ".." then do;\r
+\r
+001031  aa  6 00132 2351 00   lda       pr6|90              in\r
+001032  aa  0 00044 3771 00   anaq      pr0|36              = 777777000000 0000\r
+\c00000000\r
+001033  aa   056056 1150 03   cmpa      23598,du\r
+001034  aa   000024 6010 04   tnz       20,ic               001060\r
+                                                            STATEMENT 1 ON LINE\r
+\c 186\r
+         call cu_$cp (addr (in_com), num - 2, code);\r
+\r
+001035  aa   000002 7270 07   lxl7      2,dl\r
+001036  aa  6 00132 3521 00   epp2      pr6|90              in_structure.in_com\r
+001037  aa  2 00000 5005 17   a9bd      pr2|0,7\r
+001040  aa  6 01714 2521 00   spri2     pr6|972\r
+001041  aa  6 00114 2361 00   ldq       pr6|76              num\r
+001042  aa   000002 1760 07   sbq       2,dl\r
+001043  aa  6 01675 7561 00   stq       pr6|957\r
+001044  aa  6 01714 3521 00   epp2      pr6|972\r
+001045  aa  6 01664 2521 00   spri2     pr6|948\r
+001046  aa  6 01675 3521 00   epp2      pr6|957\r
+001047  aa  6 01666 2521 00   spri2     pr6|950\r
+001050  aa  6 00115 3521 00   epp2      pr6|77              code\r
+001051  aa  6 01670 2521 00   spri2     pr6|952\r
+001052  aa  6 01662 6211 00   eax1      pr6|946\r
+001053  aa   014000 4310 07   fld       6144,dl\r
+001054  aa  6 00044 3701 20   epp4      pr6|36,*\r
+001055  la  4 00054 3521 20   epp2      pr4|44,*            cu_$cp\r
+001056  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 187\r
+         go to GET_LINE;\r
+\r
+001057  aa   777676 7100 04   tra       -66,ic              000755\r
+                                                            STATEMENT 1 ON LINE\r
+\c 188\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 190\r
+      fv_save = fv;\r
+\r
+001060  aa  6 00112 2361 00   ldq       pr6|74              fv\r
+001061  aa  6 00113 7561 00   stq       pr6|75              fv_save\r
+                                                            STATEMENT 1 ON LINE\r
+\c 191\r
+      call prec_calc (in, num, dum, code);\r
+\r
+001062  aa  6 00132 3521 00   epp2      pr6|90              in\r
+001063  aa  6 01720 2521 00   spri2     pr6|976\r
+001064  aa  6 00114 3521 00   epp2      pr6|76              num\r
+001065  aa  6 01722 2521 00   spri2     pr6|978\r
+001066  aa  6 00116 3521 00   epp2      pr6|78              dum\r
+001067  aa  6 01724 2521 00   spri2     pr6|980\r
+001070  aa  6 00115 3521 00   epp2      pr6|77              code\r
+001071  aa  6 01726 2521 00   spri2     pr6|982\r
+001072  aa   777002 3520 04   epp2      -510,ic             000074 = 5260000024\r
+\c24\r
+001073  aa  6 01732 2521 00   spri2     pr6|986\r
+001074  aa   776777 3520 04   epp2      -513,ic             000073 = 4040000000\r
+\c21\r
+001075  aa  6 01734 2521 00   spri2     pr6|988\r
+001076  aa   776774 3520 04   epp2      -516,ic             000072 = 4140000000\r
+\c33\r
+001077  aa  6 01736 2521 00   spri2     pr6|990\r
+001100  aa   776771 3520 04   epp2      -519,ic             000071 = 4040000000\r
+\c43\r
+001101  aa  6 01740 2521 00   spri2     pr6|992\r
+001102  aa  6 01716 6211 00   eax1      pr6|974\r
+001103  aa   020000 4310 07   fld       8192,dl\r
+001104  aa   000072 3520 04   epp2      58,ic               001176 = 0002206270\r
+\c00\r
+001105  aa  0 00624 7001 00   tsx0      pr0|404             call_int_this_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 192\r
+      if code > 1 then return;\r
+\r
+001106  aa  6 00115 2361 00   ldq       pr6|77              code\r
+001107  aa   000001 1160 07   cmpq      1,dl\r
+001110  aa  0 00631 6055 00   tpnz      pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 193\r
+      go to new_line;\r
+\r
+001111  aa   777460 7100 04   tra       -208,ic             000571\r
+                                                            STATEMENT 1 ON LINE\r
+\c 196\r
+HANDLE_FAULT:\r
+      if af_sw then call active_fnc_err_ (0, "calc", "^a", error_string);\r
+\r
+001112  aa  6 00100 2351 00   lda       pr6|64              af_sw\r
+001113  aa   000034 6000 04   tze       28,ic               001147\r
+001114  aa  6 01675 4501 00   stz       pr6|957\r
+001115  aa   776766 2350 04   lda       -522,ic             000103 = 1431411541\r
+\c43\r
+001116  aa  6 01674 7551 00   sta       pr6|956\r
+001117  aa   136141 2350 03   lda       48225,du\r
+001120  aa  6 01742 7551 00   sta       pr6|994\r
+001121  aa  6 01675 3521 00   epp2      pr6|957\r
+001122  aa  6 01720 2521 00   spri2     pr6|976\r
+001123  aa  6 01674 3521 00   epp2      pr6|956\r
+001124  aa  6 01722 2521 00   spri2     pr6|978\r
+001125  aa  6 01742 3521 00   epp2      pr6|994\r
+001126  aa  6 01724 2521 00   spri2     pr6|980\r
+001127  aa  6 01010 3521 00   epp2      pr6|520             error_string\r
+001130  aa  6 01726 2521 00   spri2     pr6|982\r
+001131  aa   776753 3520 04   epp2      -533,ic             000104 = 4040000000\r
+\c05\r
+001132  aa  6 01730 2521 00   spri2     pr6|984\r
+001133  aa   776747 3520 04   epp2      -537,ic             000102 = 5240000000\r
+\c04\r
+001134  aa  6 01732 2521 00   spri2     pr6|986\r
+001135  aa   776733 3520 04   epp2      -549,ic             000070 = 5240000000\r
+\c02\r
+001136  aa  6 01734 2521 00   spri2     pr6|988\r
+001137  aa   776730 3520 04   epp2      -552,ic             000067 = 5260000000\r
+\c40\r
+001140  aa  6 01736 2521 00   spri2     pr6|990\r
+001141  aa  6 01716 6211 00   eax1      pr6|974\r
+001142  aa   020000 4310 07   fld       8192,dl\r
+001143  aa  6 00044 3701 20   epp4      pr6|36,*\r
+001144  la  4 00016 3521 20   epp2      pr4|14,*            active_fnc_err_\r
+001145  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+001146  aa   000024 7100 04   tra       20,ic               001172\r
+                                                            STATEMENT 1 ON LINE\r
+\c 198\r
+      else call ioa_$ioa_switch (iox_$error_output, "^a", error_string);\r
+\r
+001147  aa   136141 2350 03   lda       48225,du\r
+001150  aa  6 01742 7551 00   sta       pr6|994\r
+001151  aa  6 00044 3701 20   epp4      pr6|36,*\r
+001152  la  4 00042 3521 20   epp2      pr4|34,*            iox_$error_output\r
+001153  aa  6 01700 2521 00   spri2     pr6|960\r
+001154  aa  6 01742 3521 00   epp2      pr6|994\r
+001155  aa  6 01702 2521 00   spri2     pr6|962\r
+001156  aa  6 01010 3521 00   epp2      pr6|520             error_string\r
+001157  aa  6 01704 2521 00   spri2     pr6|964\r
+001160  aa   776706 3520 04   epp2      -570,ic             000066 = 4640000000\r
+\c00\r
+001161  aa  6 01706 2521 00   spri2     pr6|966\r
+001162  aa   776706 3520 04   epp2      -570,ic             000070 = 5240000000\r
+\c02\r
+001163  aa  6 01710 2521 00   spri2     pr6|968\r
+001164  aa   776703 3520 04   epp2      -573,ic             000067 = 5260000000\r
+\c40\r
+001165  aa  6 01712 2521 00   spri2     pr6|970\r
+001166  aa  6 01676 6211 00   eax1      pr6|958\r
+001167  aa   014000 4310 07   fld       6144,dl\r
+001170  la  4 00040 3521 20   epp2      pr4|32,*            ioa_$ioa_switch\r
+001171  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 199\r
+      if expr_arg_sw then return;\r
+\r
+001172  aa  6 00101 2351 00   lda       pr6|65              expr_arg_sw\r
+001173  aa  0 00631 6011 00   tnz       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 200\r
+      else go to new_line;\r
+\r
+001174  aa   777375 7100 04   tra       -259,ic             000571\r
+                                                            STATEMENT 1 ON LINE\r
+\c 548\r
+   end calc;\r
+\r
+BEGIN PROCEDURE prec_calc\r
+ENTRY TO prec_calc                                          STATEMENT 1 ON LINE\r
+\c 208\r
+prec_calc: proc (in, num, fval, code);\r
+\r
+001175  da     000242200000\r
+001176  aa   000220 6270 00   eax7      144\r
+001177  aa  7 00034 3521 20   epp2      pr7|28,*\r
+001200  aa  2 01050 2721 00   tsp2      pr2|552             int_entry_desc\r
+001201  aa     000010000000\r
+001202  2s     000012001207\r
+001203  aa  6 00042 3735 20   epp7      pr6|34,*\r
+001204  aa  7 00000 2361 20   ldq       pr7|0,*\r
+001205  aa   000002 6040 04   tmi       2,ic                001207\r
+001206  aa   777777 3760 07   anq       262143,dl\r
+001207  aa  0 00250 3761 00   anq       pr0|168             = 000077777777\r
+001210  aa  6 00130 7561 00   stq       pr6|88\r
+                                                            STATEMENT 1 ON LINE\r
+\c 218\r
+      code, ip, last = 1;\r
+\r
+001211  aa   000001 2360 07   ldq       1,dl\r
+001212  aa  6 00032 3715 20   epp5      pr6|26,*\r
+001213  aa  5 00010 7561 20   stq       pr5|8,*             code\r
+001214  aa   000001 2360 07   ldq       1,dl\r
+001215  aa  6 00105 7561 00   stq       pr6|69              ip\r
+001216  aa  6 00103 7561 00   stq       pr6|67              last\r
+                                                            STATEMENT 2 ON LINE\r
+\c 218\r
+ level = 0;\r
+\r
+001217  aa  6 00104 4501 00   stz       pr6|68              level\r
+                                                            STATEMENT 1 ON LINE\r
+\c 219\r
+      calls = calls + 1;\r
+\r
+001220  ia  4 00010 0541 00   aos       pr4|8               calls\r
+                                                            STATEMENT 2 ON LINE\r
+\c 219\r
+ ss = ss + 1;\r
+\r
+001221  aa  6 00040 3535 20   epp3      pr6|32,*\r
+001222  aa  3 00111 0541 00   aos       pr3|73              ss\r
+                                                            STATEMENT 1 ON LINE\r
+\c 220\r
+      s.type (ss) = 0;\r
+\r
+001223  aa  3 00111 2361 00   ldq       pr3|73              ss\r
+001224  aa   000006 4020 07   mpy       6,dl\r
+001225  aa  3 01030 4501 06   stz       pr3|536,ql          s.type\r
+                                                            STATEMENT 1 ON LINE\r
+\c 221\r
+      s.op (ss) = 1;\r
+\r
+001226  aa  3 00111 2361 00   ldq       pr3|73              ss\r
+001227  aa   000006 4020 07   mpy       6,dl\r
+001230  aa   000000 6270 06   eax7      0,ql\r
+001231  aa   000001 2360 07   ldq       1,dl\r
+001232  aa  3 01031 7561 17   stq       pr3|537,7           s.op\r
+                                                            STATEMENT 1 ON LINE\r
+\c 222\r
+      strt = ss - 1;\r
+\r
+001233  aa  3 00111 2361 00   ldq       pr3|73              ss\r
+001234  aa   000001 1760 07   sbq       1,dl\r
+001235  aa  6 00106 7561 00   stq       pr6|70              strt\r
+                                                            STATEMENT 1 ON LINE\r
+\c 224\r
+start: if s.op (ss) ^= 0 then go to op_red;\r
+\r
+001236  aa  6 00040 3735 20   epp7      pr6|32,*\r
+001237  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001240  aa   000006 4020 07   mpy       6,dl\r
+001241  aa  7 01031 2361 06   ldq       pr7|537,ql          s.op\r
+001242  aa   000002 6000 04   tze       2,ic                001244\r
+001243  aa   000036 7100 04   tra       30,ic               001301\r
+                                                            STATEMENT 1 ON LINE\r
+\c 225\r
+      i = s.op (ss - 1);\r
+\r
+001244  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001245  aa   000006 4020 07   mpy       6,dl\r
+001246  aa  7 01023 2361 06   ldq       pr7|531,ql          s.op\r
+001247  aa  6 00100 7561 00   stq       pr6|64              i\r
+                                                            STATEMENT 1 ON LINE\r
+\c 226\r
+      if i = 0 then do;\r
+\r
+001250  aa   000005 6010 04   tnz       5,ic                001255\r
+                                                            STATEMENT 1 ON LINE\r
+\c 227\r
+miss_op: msg = "Missing operator";\r
+\r
+001251  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+001252  aa   776732 00 0020   desc9a    -550,16             000203 = 1151511631\r
+\c63\r
+001253  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 228\r
+         go to err;\r
+\r
+001254  aa   002140 7100 04   tra       1120,ic             003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 229\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 230\r
+      if ss - 2 = strt then go to add;\r
+\r
+001255  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001256  aa   000002 1760 07   sbq       2,dl\r
+001257  aa  6 00106 1161 00   cmpq      pr6|70              strt\r
+001260  aa   000002 6010 04   tnz       2,ic                001262\r
+001261  aa   000604 7100 04   tra       388,ic              002065\r
+                                                            STATEMENT 1 ON LINE\r
+\c 231\r
+      if s.op (ss - 2) = 0 then go to add;\r
+\r
+001262  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001263  aa   000006 4020 07   mpy       6,dl\r
+001264  aa  7 01015 2361 06   ldq       pr7|525,ql          s.op\r
+001265  aa   000002 6010 04   tnz       2,ic                001267\r
+001266  aa   000577 7100 04   tra       383,ic              002065\r
+                                                            STATEMENT 1 ON LINE\r
+\c 232\r
+      if i ^= 4 then\r
+           if i ^= 5 then do;\r
+\r
+001267  aa  6 00100 2361 00   ldq       pr6|64              i\r
+001270  aa   000004 1160 07   cmpq      4,dl\r
+001271  aa   000007 6000 04   tze       7,ic                001300\r
+001272  aa   000005 1160 07   cmpq      5,dl\r
+001273  aa   000005 6000 04   tze       5,ic                001300\r
+                                                            STATEMENT 1 ON LINE\r
+\c 234\r
+ill_prefix:   msg = "Invalid prefix operator";\r
+\r
+001274  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+001275  aa   776763 00 0027   desc9a    -525,23             000257 = 1111561661\r
+\c41\r
+001276  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 235\r
+              go to err;\r
+\r
+001277  aa   002115 7100 04   tra       1101,ic             003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 236\r
+           end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 237\r
+      go to add;\r
+\r
+001300  aa   000565 7100 04   tra       373,ic              002065\r
+                                                            STATEMENT 1 ON LINE\r
+\c 239\r
+op_red: i = s.op (ss);\r
+\r
+001301  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001302  aa   000006 4020 07   mpy       6,dl\r
+001303  aa  7 01031 2361 06   ldq       pr7|537,ql          s.op\r
+001304  aa  6 00100 7561 00   stq       pr6|64              i\r
+                                                            STATEMENT 1 ON LINE\r
+\c 240\r
+      if i = 1 then go to add;\r
+\r
+001305  aa   000001 1160 07   cmpq      1,dl\r
+001306  aa   000002 6010 04   tnz       2,ic                001310\r
+001307  aa   000556 7100 04   tra       366,ic              002065\r
+                                                            STATEMENT 1 ON LINE\r
+\c 241\r
+      j = s.op (ss - 1);\r
+\r
+001310  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001311  aa   000006 4020 07   mpy       6,dl\r
+001312  aa  7 01023 2361 06   ldq       pr7|531,ql          s.op\r
+001313  aa  6 00101 7561 00   stq       pr6|65              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 242\r
+      if j ^= 0 then do;\r
+\r
+001314  aa   000010 6000 04   tze       8,ic                001324\r
+                                                            STATEMENT 1 ON LINE\r
+\c 243\r
+         if i = 4 then go to add;\r
+\r
+001315  aa  6 00100 2361 00   ldq       pr6|64              i\r
+001316  aa   000004 1160 07   cmpq      4,dl\r
+001317  aa   000002 6010 04   tnz       2,ic                001321\r
+001320  aa   000545 7100 04   tra       357,ic              002065\r
+                                                            STATEMENT 1 ON LINE\r
+\c 244\r
+         if i = 5 then go to add;\r
+\r
+001321  aa   000005 1160 07   cmpq      5,dl\r
+001322  aa   000002 6010 04   tnz       2,ic                001324\r
+001323  aa   000542 7100 04   tra       354,ic              002065\r
+                                                            STATEMENT 1 ON LINE\r
+\c 245\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 246\r
+      if i = 2 then\r
+           if j = 1 then do;\r
+\r
+001324  aa  6 00100 2361 00   ldq       pr6|64              i\r
+001325  aa   000002 1160 07   cmpq      2,dl\r
+001326  aa   000014 6010 04   tnz       12,ic               001342\r
+001327  aa  6 00101 2361 00   ldq       pr6|65              j\r
+001330  aa   000001 1160 07   cmpq      1,dl\r
+001331  aa   000011 6010 04   tnz       9,ic                001342\r
+                                                            STATEMENT 1 ON LINE\r
+\c 248\r
+              if calls = 1 then return;\r
+\r
+001332  aa  6 00044 3701 20   epp4      pr6|36,*\r
+001333  ia  4 00010 2361 00   ldq       pr4|8               calls\r
+001334  aa   000001 1160 07   cmpq      1,dl\r
+001335  aa  0 00631 6001 00   tze       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 249\r
+              else do;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 250\r
+                 msg = "Null expression";\r
+\r
+001336  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+001337  aa   776641 00 0017   desc9a    -607,15             000177 = 1161651541\r
+\c54\r
+001340  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 251\r
+                 go to err;\r
+\r
+001341  aa   002053 7100 04   tra       1067,ic             003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 252\r
+              end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 253\r
+           end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 254\r
+      if i > 2 then\r
+           if j ^= 0 then go to ill_prefix;\r
+\r
+001342  aa  6 00100 2361 00   ldq       pr6|64              i\r
+001343  aa   000002 1160 07   cmpq      2,dl\r
+001344  aa   000004 6044 04   tmoz      4,ic                001350\r
+001345  aa  6 00101 2361 00   ldq       pr6|65              j\r
+001346  aa   000002 6000 04   tze       2,ic                001350\r
+001347  aa   777725 7100 04   tra       -43,ic              001274\r
+                                                            STATEMENT 1 ON LINE\r
+\c 256\r
+      j = s.op (ss - 2);\r
+\r
+001350  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001351  aa   000006 4020 07   mpy       6,dl\r
+001352  aa  7 01015 2361 06   ldq       pr7|525,ql          s.op\r
+001353  aa  6 00101 7561 00   stq       pr6|65              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 257\r
+      if j = 0 then go to miss_op;\r
+\r
+001354  aa   000002 6010 04   tnz       2,ic                001356\r
+001355  aa   777674 7100 04   tra       -68,ic              001251\r
+                                                            STATEMENT 1 ON LINE\r
+\c 258\r
+      if i = 2 then\r
+           if j = 1 then go to print;\r
+\r
+001356  aa  6 00100 2361 00   ldq       pr6|64              i\r
+001357  aa   000002 1160 07   cmpq      2,dl\r
+001360  aa   000005 6010 04   tnz       5,ic                001365\r
+001361  aa  6 00101 2361 00   ldq       pr6|65              j\r
+001362  aa   000001 1160 07   cmpq      1,dl\r
+001363  aa   000002 6010 04   tnz       2,ic                001365\r
+001364  aa   000330 7100 04   tra       216,ic              001714\r
+                                                            STATEMENT 1 ON LINE\r
+\c 261\r
+      if ss - 3 = strt then go to add;\r
+\r
+001365  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001366  aa   000003 1760 07   sbq       3,dl\r
+001367  aa  6 00106 1161 00   cmpq      pr6|70              strt\r
+001370  aa   000002 6010 04   tnz       2,ic                001372\r
+001371  aa   000474 7100 04   tra       316,ic              002065\r
+                                                            STATEMENT 1 ON LINE\r
+\c 262\r
+      if s.op (ss - 3) ^= 0 then do;\r
+\r
+001372  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001373  aa   000006 4020 07   mpy       6,dl\r
+001374  aa  7 01007 2361 06   ldq       pr7|519,ql          s.op\r
+001375  aa   000060 6000 04   tze       48,ic               001455\r
+                                                            STATEMENT 1 ON LINE\r
+\c 263\r
+         if s.type (ss) > s.type (ss - 2) + 4 then go to add;\r
+\r
+001376  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001377  aa   000006 4020 07   mpy       6,dl\r
+001400  aa   000000 6270 06   eax7      0,ql\r
+001401  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001402  aa   000006 4020 07   mpy       6,dl\r
+001403  aa  7 01014 2361 06   ldq       pr7|524,ql          s.type\r
+001404  aa   000004 0760 07   adq       4,dl\r
+001405  aa  7 01030 1161 17   cmpq      pr7|536,7           s.type\r
+001406  aa   000002 6050 04   tpl       2,ic                001410\r
+001407  aa   000456 7100 04   tra       302,ic              002065\r
+                                                            STATEMENT 1 ON LINE\r
+\c 264\r
+         if j = 5 then s.value (ss - 1) = -s.value (ss - 1);\r
+\r
+001410  aa  6 00101 2361 00   ldq       pr6|65              j\r
+001411  aa   000005 1160 07   cmpq      5,dl\r
+001412  aa   000012 6010 04   tnz       10,ic               001424\r
+001413  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001414  aa   000006 4020 07   mpy       6,dl\r
+001415  aa   000000 6260 06   eax6      0,ql\r
+001416  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001417  aa   000006 4020 07   mpy       6,dl\r
+001420  aa   000000 6250 06   eax5      0,ql\r
+001421  aa  7 01024 4311 16   fld       pr7|532,6           s.value\r
+001422  aa   000000 5130 00   fneg      0\r
+001423  aa  7 01024 4551 15   fst       pr7|532,5           s.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 265\r
+         addr (s.type (ss - 2)) -> move = addr (s.type (ss - 1)) -> move;\r
+\r
+001424  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001425  aa   000006 4020 07   mpy       6,dl\r
+001426  aa   000000 6260 06   eax6      0,ql\r
+001427  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001430  aa   000006 4020 07   mpy       6,dl\r
+001431  aa   000000 6250 06   eax5      0,ql\r
+001432  aa  7 01014 3715 16   epp5      pr7|524,6           move\r
+001433  aa  7 01022 3535 15   epp3      pr7|530,5           move\r
+001434  aa  000 100 100 500   mlr       (pr),(pr),fill(000)\r
+001435  aa  3 00000 00 0024   desc9a    pr3|0,20            move\r
+001436  aa  5 00000 00 0024   desc9a    pr5|0,20            move\r
+                                                            STATEMENT 1 ON LINE\r
+\c 266\r
+         addr (s.type (ss - 1)) -> move = addr (s.type (ss)) -> move;\r
+\r
+001437  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001440  aa   000006 4020 07   mpy       6,dl\r
+001441  aa   000000 6240 06   eax4      0,ql\r
+001442  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001443  aa   000006 4020 07   mpy       6,dl\r
+001444  aa   000000 6230 06   eax3      0,ql\r
+001445  aa  7 01022 3515 14   epp1      pr7|530,4           move\r
+001446  aa  7 01030 3535 13   epp3      pr7|536,3           move\r
+001447  aa  000 100 100 500   mlr       (pr),(pr),fill(000)\r
+001450  aa  3 00000 00 0024   desc9a    pr3|0,20            move\r
+001451  aa  1 00000 00 0024   desc9a    pr1|0,20            move\r
+                                                            STATEMENT 1 ON LINE\r
+\c 267\r
+         ss = ss - 1;\r
+\r
+001452  aa   000001 3360 07   lcq       1,dl\r
+001453  aa  7 00111 0561 00   asq       pr7|73              ss\r
+                                                            STATEMENT 1 ON LINE\r
+\c 268\r
+         go to start;\r
+\r
+001454  aa   777562 7100 04   tra       -142,ic             001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 269\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 270\r
+      if s.type (ss) > s.type (ss - 2) then go to add;\r
+\r
+001455  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001456  aa   000006 4020 07   mpy       6,dl\r
+001457  aa   000000 6270 06   eax7      0,ql\r
+001460  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001461  aa   000006 4020 07   mpy       6,dl\r
+001462  aa   000000 6260 06   eax6      0,ql\r
+001463  aa  7 01030 2361 17   ldq       pr7|536,7           s.type\r
+001464  aa  7 01014 1161 16   cmpq      pr7|524,6           s.type\r
+001465  aa   000002 6044 04   tmoz      2,ic                001467\r
+001466  aa   000377 7100 04   tra       255,ic              002065\r
+                                                            STATEMENT 1 ON LINE\r
+\c 271\r
+      j = j - 3;\r
+\r
+001467  aa   000003 3360 07   lcq       3,dl\r
+001470  aa  6 00101 0561 00   asq       pr6|65              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 272\r
+      go to operator (j);\r
+\r
+001471  aa  6 00101 7251 00   lxl5      pr6|65              j\r
+001472  ta   000000 7100 15   tra       0,5\r
+                                                            STATEMENT 1 ON LINE\r
+\c 274\r
+operator (0):\r
+ASSIGN: s.var (ss - 3) -> floatval = s.value (ss - 1);\r
+\r
+001473  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001474  aa   000006 4020 07   mpy       6,dl\r
+001475  aa   000000 6240 06   eax4      0,ql\r
+001476  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001477  aa   000006 4020 07   mpy       6,dl\r
+001500  aa  7 01024 4311 06   fld       pr7|532,ql          s.value\r
+001501  aa  7 01012 4551 34   fst       pr7|522,4*          floatval\r
+                                                            STATEMENT 1 ON LINE\r
+\c 276\r
+      noprt = "1"b;\r
+\r
+001502  aa   400000 2350 03   lda       131072,du\r
+001503  aa  7 01630 7551 00   sta       pr7|920             noprt\r
+                                                            STATEMENT 1 ON LINE\r
+\c 277\r
+      go to clean;\r
+\r
+001504  aa   000172 7100 04   tra       122,ic              001676\r
+                                                            STATEMENT 1 ON LINE\r
+\c 278\r
+operator (1):\r
+ADD:  s.value (ss - 3) = s.value (ss - 3) + s.value (ss - 1);\r
+\r
+001505  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001506  aa   000006 4020 07   mpy       6,dl\r
+001507  aa   000000 6230 06   eax3      0,ql\r
+001510  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001511  aa   000006 4020 07   mpy       6,dl\r
+001512  aa   000000 6240 06   eax4      0,ql\r
+001513  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001514  aa   000006 4020 07   mpy       6,dl\r
+001515  aa   000000 6220 06   eax2      0,ql\r
+001516  aa  7 01010 4311 14   fld       pr7|520,4           s.value\r
+001517  aa  7 01024 4751 13   fad       pr7|532,3           s.value\r
+001520  aa  7 01010 4551 12   fst       pr7|520,2           s.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 280\r
+      go to clean;\r
+\r
+001521  aa   000155 7100 04   tra       109,ic              001676\r
+                                                            STATEMENT 1 ON LINE\r
+\c 281\r
+operator (2):\r
+SUBTRACT: s.value (ss - 3) = s.value (ss - 3) - s.value (ss - 1);\r
+\r
+001522  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001523  aa   000006 4020 07   mpy       6,dl\r
+001524  aa   000000 6230 06   eax3      0,ql\r
+001525  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001526  aa   000006 4020 07   mpy       6,dl\r
+001527  aa   000000 6240 06   eax4      0,ql\r
+001530  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001531  aa   000006 4020 07   mpy       6,dl\r
+001532  aa   000000 6220 06   eax2      0,ql\r
+001533  aa  7 01010 4311 14   fld       pr7|520,4           s.value\r
+001534  aa  7 01024 5751 13   fsb       pr7|532,3           s.value\r
+001535  aa  7 01010 4551 12   fst       pr7|520,2           s.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 283\r
+      go to clean;\r
+\r
+001536  aa   000140 7100 04   tra       96,ic               001676\r
+                                                            STATEMENT 1 ON LINE\r
+\c 284\r
+operator (3):\r
+MULTIPLY: s.value (ss - 3) = s.value (ss - 3) * s.value (ss - 1);\r
+\r
+001537  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001540  aa   000006 4020 07   mpy       6,dl\r
+001541  aa   000000 6230 06   eax3      0,ql\r
+001542  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001543  aa   000006 4020 07   mpy       6,dl\r
+001544  aa   000000 6240 06   eax4      0,ql\r
+001545  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001546  aa   000006 4020 07   mpy       6,dl\r
+001547  aa   000000 6220 06   eax2      0,ql\r
+001550  aa  7 01010 4311 14   fld       pr7|520,4           s.value\r
+001551  aa  7 01024 4611 13   fmp       pr7|532,3           s.value\r
+001552  aa  7 01010 4551 12   fst       pr7|520,2           s.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 286\r
+      go to clean;\r
+\r
+001553  aa   000123 7100 04   tra       83,ic               001676\r
+                                                            STATEMENT 1 ON LINE\r
+\c 287\r
+operator (4):\r
+DIVIDE: if s.value (ss - 1) = 0e0 then do;\r
+\r
+001554  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001555  aa   000006 4020 07   mpy       6,dl\r
+001556  aa  7 01024 4311 06   fld       pr7|532,ql          s.value\r
+001557  aa   000005 6010 04   tnz       5,ic                001564\r
+                                                            STATEMENT 1 ON LINE\r
+\c 289\r
+         msg = "Divide by zero";\r
+\r
+001560  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+001561  aa   776413 00 0016   desc9a    -757,14             000173 = 1041511661\r
+\c51\r
+001562  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 290\r
+         go to err;\r
+\r
+001563  aa   001631 7100 04   tra       921,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 291\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 292\r
+      s.value (ss - 3) = s.value (ss - 3) / s.value (ss - 1);\r
+\r
+001564  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001565  aa   000006 4020 07   mpy       6,dl\r
+001566  aa   000000 6230 06   eax3      0,ql\r
+001567  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001570  aa   000006 4020 07   mpy       6,dl\r
+001571  aa   000000 6240 06   eax4      0,ql\r
+001572  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001573  aa   000006 4020 07   mpy       6,dl\r
+001574  aa   000000 6220 06   eax2      0,ql\r
+001575  aa  7 01010 4311 14   fld       pr7|520,4           s.value\r
+001576  aa  7 01024 5651 13   fdv       pr7|532,3           s.value\r
+001577  aa  7 01010 4551 12   fst       pr7|520,2           s.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 293\r
+      go to clean;\r
+\r
+001600  aa   000076 7100 04   tra       62,ic               001676\r
+                                                            STATEMENT 1 ON LINE\r
+\c 294\r
+operator (5):\r
+EXPONENT: if s.value (ss - 3) < 0e0 then do;\r
+\r
+001601  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001602  aa   000006 4020 07   mpy       6,dl\r
+001603  aa  7 01010 4311 06   fld       pr7|520,ql          s.value\r
+001604  aa   000036 6050 04   tpl       30,ic               001642\r
+                                                            STATEMENT 1 ON LINE\r
+\c 296\r
+         if mod (s.value (ss - 1), 1e0) = 0e0 then do;\r
+\r
+001605  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001606  aa   000006 4020 07   mpy       6,dl\r
+001607  aa  7 01024 4311 06   fld       pr7|532,ql          s.value\r
+001610  aa   001677 3520 04   epp2      959,ic              003507 = 0024000000\r
+\c00\r
+001611  aa  0 00702 7001 00   tsx0      pr0|450             mdfl1\r
+001612  aa   000024 6010 04   tnz       20,ic               001636\r
+                                                            STATEMENT 1 ON LINE\r
+\c 297\r
+            s.value (ss - 3) = s.value (ss - 3) ** fixed (s.value (ss - 1), 17,\r
+\c 0);\r
+\r
+001613  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001614  aa   000006 4020 07   mpy       6,dl\r
+001615  aa   000000 6240 06   eax4      0,ql\r
+001616  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001617  aa   000006 4020 07   mpy       6,dl\r
+001620  aa  6 00132 7561 00   stq       pr6|90\r
+001621  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001622  aa   000006 4020 07   mpy       6,dl\r
+001623  aa  7 01024 4311 06   fld       pr7|532,ql          s.value\r
+001624  aa  0 00654 7001 00   tsx0      pr0|428             fl2_to_fx1\r
+001625  aa  6 00133 7561 00   stq       pr6|91\r
+001626  aa  7 01010 4311 14   fld       pr7|520,4           s.value\r
+001627  aa  6 00133 3515 00   epp1      pr6|91\r
+001630  aa  6 00134 3521 00   epp2      pr6|92\r
+001631  aa  0 01350 2731 00   tsp3      pr0|744             single_power_intege\r
+\cr_\r
+001632  aa  6 00132 7271 00   lxl7      pr6|90\r
+001633  aa  6 00040 3735 20   epp7      pr6|32,*\r
+001634  aa  7 01010 4551 17   fst       pr7|520,7           s.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 298\r
+            go to clean;\r
+\r
+001635  aa   000041 7100 04   tra       33,ic               001676\r
+                                                            STATEMENT 1 ON LINE\r
+\c 299\r
+         end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 300\r
+         msg = "Neg num ** non-integer";\r
+\r
+001636  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+001637  aa   776413 00 0026   desc9a    -757,22             000251 = 1161451470\r
+\c40\r
+001640  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 301\r
+         go to err;\r
+\r
+001641  aa   001553 7100 04   tra       875,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 302\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 303\r
+      if s.value (ss - 1) = 0e0 then\r
+           if s.value (ss - 3) = 0e0 then do;\r
+\r
+001642  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001643  aa   000006 4020 07   mpy       6,dl\r
+001644  aa  7 01024 4311 06   fld       pr7|532,ql          s.value\r
+001645  aa   000011 6010 04   tnz       9,ic                001656\r
+001646  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001647  aa   000006 4020 07   mpy       6,dl\r
+001650  aa  7 01010 4311 06   fld       pr7|520,ql          s.value\r
+001651  aa   000005 6010 04   tnz       5,ic                001656\r
+                                                            STATEMENT 1 ON LINE\r
+\c 305\r
+              msg = "Zero ** zero";\r
+\r
+001652  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+001653  aa   776263 00 0014   desc9a    -845,12             000135 = 1321451621\r
+\c57\r
+001654  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 306\r
+              go to err;\r
+\r
+001655  aa   001537 7100 04   tra       863,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 307\r
+           end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 308\r
+      s.value (ss - 3) = s.value (ss - 3) ** s.value (ss - 1);\r
+\r
+001656  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001657  aa   000006 4020 07   mpy       6,dl\r
+001660  aa   000000 6230 06   eax3      0,ql\r
+001661  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001662  aa   000006 4020 07   mpy       6,dl\r
+001663  aa   000000 6240 06   eax4      0,ql\r
+001664  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001665  aa   000006 4020 07   mpy       6,dl\r
+001666  aa  6 00133 7561 00   stq       pr6|91\r
+001667  aa  7 01010 4311 14   fld       pr7|520,4           s.value\r
+001670  aa  7 01024 3515 13   epp1      pr7|532,3           s.value\r
+001671  aa  6 00134 3521 00   epp2      pr6|92\r
+001672  aa  0 01347 2731 00   tsp3      pr0|743             single_power_single\r
+\c_\r
+001673  aa  6 00133 7271 00   lxl7      pr6|91\r
+001674  aa  6 00040 3735 20   epp7      pr6|32,*\r
+001675  aa  7 01010 4551 17   fst       pr7|520,7           s.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 310\r
+clean: addr (s.type (ss - 2)) -> move = addr (s.type (ss)) -> move;\r
+\r
+001676  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001677  aa   000006 4020 07   mpy       6,dl\r
+001700  aa   000000 6270 06   eax7      0,ql\r
+001701  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001702  aa   000006 4020 07   mpy       6,dl\r
+001703  aa   000000 6260 06   eax6      0,ql\r
+001704  aa  7 01014 3715 17   epp5      pr7|524,7           move\r
+001705  aa  7 01030 3535 16   epp3      pr7|536,6           move\r
+001706  aa  000 100 100 500   mlr       (pr),(pr),fill(000)\r
+001707  aa  3 00000 00 0024   desc9a    pr3|0,20            move\r
+001710  aa  5 00000 00 0024   desc9a    pr5|0,20            move\r
+                                                            STATEMENT 1 ON LINE\r
+\c 311\r
+      ss = ss - 2;\r
+\r
+001711  aa   000002 3360 07   lcq       2,dl\r
+001712  aa  7 00111 0561 00   asq       pr7|73              ss\r
+                                                            STATEMENT 1 ON LINE\r
+\c 312\r
+      go to start;\r
+\r
+001713  aa   777323 7100 04   tra       -301,ic             001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 314\r
+print: fval = s.value (ss - 1);\r
+\r
+001714  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+001715  aa   000006 4020 07   mpy       6,dl\r
+001716  aa  7 01024 4311 06   fld       pr7|532,ql          s.value\r
+001717  aa  6 00032 3715 20   epp5      pr6|26,*\r
+001720  aa  5 00006 4551 20   fst       pr5|6,*             fval\r
+                                                            STATEMENT 1 ON LINE\r
+\c 315\r
+      if calls > 1 then go to no_print;\r
+\r
+001721  aa  6 00044 3701 20   epp4      pr6|36,*\r
+001722  ia  4 00010 2361 00   ldq       pr4|8               calls\r
+001723  aa   000001 1160 07   cmpq      1,dl\r
+001724  aa   000002 6044 04   tmoz      2,ic                001726\r
+001725  aa   000127 7100 04   tra       87,ic               002054\r
+                                                            STATEMENT 1 ON LINE\r
+\c 317\r
+      if af_sw then do;\r
+\r
+001726  aa  7 00100 2351 00   lda       pr7|64              af_sw\r
+001727  aa   000056 6000 04   tze       46,ic               002005\r
+                                                            STATEMENT 1 ON LINE\r
+\c 318\r
+         ip = 1;\r
+\r
+001730  aa   000001 2360 07   ldq       1,dl\r
+001731  aa  6 00105 7561 00   stq       pr6|69              ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 319\r
+         call ffop (out, ip, fval);\r
+\r
+001732  aa  7 01020 3521 00   epp2      pr7|528             out\r
+001733  aa  6 00136 2521 00   spri2     pr6|94\r
+001734  aa  6 00105 3521 00   epp2      pr6|69              ip\r
+001735  aa  6 00140 2521 00   spri2     pr6|96\r
+001736  aa  5 00006 3521 20   epp2      pr5|6,*             fval\r
+001737  aa  6 00142 2521 00   spri2     pr6|98\r
+001740  aa  6 00134 6211 00   eax1      pr6|92\r
+001741  aa   014000 4310 07   fld       6144,dl\r
+001742  la  4 00034 3521 20   epp2      pr4|28,*            ffop\r
+001743  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 320\r
+         return_string = rtrim (ltrim (substr (out, 1, ip - 1)));\r
+\r
+001744  aa  6 00105 2361 00   ldq       pr6|69              ip\r
+001745  aa   000001 1760 07   sbq       1,dl\r
+001746  aa  6 00040 3735 20   epp7      pr6|32,*\r
+001747  aa  6 00132 7561 00   stq       pr6|90\r
+001750  aa  000 000 164 540   tct       (pr,rl)\r
+001751  aa  7 01020 00 0006   desc9a    pr7|528,ql          out\r
+001752  aa  0 76605 0001 00   arg       pr0|-635            = 777777777777\r
+001753  aa  6 00056 0001 00   arg       pr6|46\r
+001754  aa  6 00056 2361 00   ldq       pr6|46\r
+001755  aa  0 00242 3761 00   anq       pr0|162             = 000777777777\r
+001756  aa  6 00133 7561 00   stq       pr6|91\r
+001757  aa  6 00132 2361 00   ldq       pr6|90\r
+001760  aa  6 00133 1761 00   sbq       pr6|91\r
+001761  aa  6 00133 2351 00   lda       pr6|91\r
+001762  aa  6 00132 7561 00   stq       pr6|90\r
+001763  aa  000 000 165 545   tctr      (pr,rl,al)\r
+001764  aa  7 01020 00 0006   desc9a    pr7|528,ql          out\r
+001765  aa  0 76605 0001 00   arg       pr0|-635            = 777777777777\r
+001766  aa  6 00056 0001 00   arg       pr6|46\r
+001767  aa  6 00056 2361 00   ldq       pr6|46\r
+001770  aa  0 00242 3761 00   anq       pr0|162             = 000777777777\r
+001771  aa  6 00131 7561 00   stq       pr6|89\r
+001772  aa  6 00132 2361 00   ldq       pr6|90\r
+001773  aa  6 00131 1761 00   sbq       pr6|89\r
+001774  aa  7 00110 1161 00   cmpq      pr7|72              return_len\r
+001775  aa   000002 6040 04   tmi       2,ic                001777\r
+001776  aa  7 00110 2361 00   ldq       pr7|72              return_len\r
+001777  aa  7 00104 7561 20   stq       pr7|68,*            return_string\r
+002000  aa  7 00104 3715 20   epp5      pr7|68,*            return_ptr\r
+002001  aa  040 140 100 545   mlr       (pr,rl,al),(pr,rl),fill(040)\r
+002002  aa  7 01020 00 0006   desc9a    pr7|528,ql          out\r
+002003  aa  5 00001 00 0006   desc9a    pr5|1,ql            return_string\r
+                                                            STATEMENT 1 ON LINE\r
+\c 321\r
+         return;\r
+\r
+002004  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 322\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 324\r
+      if noprt then go to no_print;\r
+\r
+002005  aa  7 01630 2351 00   lda       pr7|920             noprt\r
+002006  aa   000002 6000 04   tze       2,ic                002010\r
+002007  aa   000045 7100 04   tra       37,ic               002054\r
+                                                            STATEMENT 1 ON LINE\r
+\c 325\r
+      ip = 5;\r
+\r
+002010  aa   000005 2360 07   ldq       5,dl\r
+002011  aa  6 00105 7561 00   stq       pr6|69              ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 326\r
+      substr (out, 1, 5) = "=   ";\r
+\r
+002012  aa   001470 2370 04   ldaq      824,ic              003502 = 0750400400\r
+\c40 040000000000\r
+002013  aa  7 01020 7551 00   sta       pr7|528             out\r
+002014  aa  7 01021 5521 40   stbq      pr7|529,40          out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 327\r
+      call ffop (out, ip, fval);\r
+\r
+002015  aa  7 01020 3521 00   epp2      pr7|528             out\r
+002016  aa  6 00136 2521 00   spri2     pr6|94\r
+002017  aa  6 00105 3521 00   epp2      pr6|69              ip\r
+002020  aa  6 00140 2521 00   spri2     pr6|96\r
+002021  aa  5 00006 3521 20   epp2      pr5|6,*             fval\r
+002022  aa  6 00142 2521 00   spri2     pr6|98\r
+002023  aa  6 00134 6211 00   eax1      pr6|92\r
+002024  aa   014000 4310 07   fld       6144,dl\r
+002025  la  4 00034 3521 20   epp2      pr4|28,*            ffop\r
+002026  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 328\r
+      substr (out, ip, 1) = "\r
+";\r
+\r
+002027  aa  6 00105 7271 00   lxl7      pr6|69              ip\r
+002030  aa  6 00040 3735 20   epp7      pr6|32,*\r
+002031  aa  012 117 100 400   mlr       (),(pr,x7),fill(012)\r
+002032  aa   000000 00 0000   desc9a    0,0\r
+002033  aa  7 01017 60 0001   desc9a    pr7|527(3),1        out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 330\r
+      call iox_$put_chars (iox_$user_output, addr (out), ip, (0));\r
+\r
+002034  aa  7 01020 3715 00   epp5      pr7|528             out\r
+002035  aa  6 00174 6515 00   spri5     pr6|124\r
+002036  aa  6 00133 4501 00   stz       pr6|91\r
+002037  aa  6 00044 3701 20   epp4      pr6|36,*\r
+002040  la  4 00050 3521 20   epp2      pr4|40,*            iox_$user_output\r
+002041  aa  6 00136 2521 00   spri2     pr6|94\r
+002042  aa  6 00174 3521 00   epp2      pr6|124\r
+002043  aa  6 00140 2521 00   spri2     pr6|96\r
+002044  aa  6 00105 3521 00   epp2      pr6|69              ip\r
+002045  aa  6 00142 2521 00   spri2     pr6|98\r
+002046  aa  6 00133 3521 00   epp2      pr6|91\r
+002047  aa  6 00144 2521 00   spri2     pr6|100\r
+002050  aa  6 00134 6211 00   eax1      pr6|92\r
+002051  aa   020000 4310 07   fld       8192,dl\r
+002052  la  4 00046 3521 20   epp2      pr4|38,*            iox_$put_chars\r
+002053  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 331\r
+no_print: calls = calls - 1;\r
+\r
+002054  aa   000001 3360 07   lcq       1,dl\r
+002055  aa  6 00044 3701 20   epp4      pr6|36,*\r
+002056  ia  4 00010 0561 00   asq       pr4|8               calls\r
+                                                            STATEMENT 1 ON LINE\r
+\c 332\r
+      code = 0;\r
+\r
+002057  aa  6 00032 3735 20   epp7      pr6|26,*\r
+002060  aa  7 00010 4501 20   stz       pr7|8,*             code\r
+                                                            STATEMENT 1 ON LINE\r
+\c 333\r
+      ss = strt;\r
+\r
+002061  aa  6 00106 2361 00   ldq       pr6|70              strt\r
+002062  aa  6 00040 3715 20   epp5      pr6|32,*\r
+002063  aa  5 00111 7561 00   stq       pr5|73              ss\r
+                                                            STATEMENT 1 ON LINE\r
+\c 334\r
+      return;\r
+\r
+002064  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 336\r
+add:  ss = ss + 1;\r
+\r
+002065  aa  7 00111 0541 00   aos       pr7|73              ss\r
+                                                            STATEMENT 1 ON LINE\r
+\c 337\r
+      if ss > 63 then do;\r
+\r
+002066  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+002067  aa   000077 1160 07   cmpq      63,dl\r
+002070  aa   000005 6044 04   tmoz      5,ic                002075\r
+                                                            STATEMENT 1 ON LINE\r
+\c 338\r
+         msg = "Simplify expression";\r
+\r
+002071  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+002072  aa   776134 00 0023   desc9a    -932,19             000225 = 1231511551\r
+\c60\r
+002073  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 339\r
+         go to err;\r
+\r
+002074  aa   001320 7100 04   tra       720,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 340\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 341\r
+blank: if ip >= num then do;\r
+\r
+002075  aa  6 00105 2361 00   ldq       pr6|69              ip\r
+002076  aa  6 00032 3735 20   epp7      pr6|26,*\r
+002077  aa  7 00004 1161 20   cmpq      pr7|4,*             num\r
+002100  aa   000021 6040 04   tmi       17,ic               002121\r
+                                                            STATEMENT 1 ON LINE\r
+\c 342\r
+         if level ^= 0 then do;\r
+\r
+002101  aa  6 00104 2361 00   ldq       pr6|68              level\r
+002102  aa   000005 6000 04   tze       5,ic                002107\r
+                                                            STATEMENT 1 ON LINE\r
+\c 343\r
+            msg = "Too few )'s";\r
+\r
+002103  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+002104  aa   776027 00 0013   desc9a    -1001,11            000132 = 1241571570\r
+\c40\r
+002105  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 344\r
+            go to err;\r
+\r
+002106  aa   001306 7100 04   tra       710,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 345\r
+         end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 346\r
+         s.type (ss) = 0;\r
+\r
+002107  aa  6 00040 3715 20   epp5      pr6|32,*\r
+002110  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+002111  aa   000006 4020 07   mpy       6,dl\r
+002112  aa  5 01030 4501 06   stz       pr5|536,ql          s.type\r
+                                                            STATEMENT 1 ON LINE\r
+\c 347\r
+         s.op (ss) = 2;\r
+\r
+002113  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+002114  aa   000006 4020 07   mpy       6,dl\r
+002115  aa   000000 6270 06   eax7      0,ql\r
+002116  aa   000002 2360 07   ldq       2,dl\r
+002117  aa  5 01031 7561 17   stq       pr5|537,7           s.op\r
+                                                            STATEMENT 1 ON LINE\r
+\c 348\r
+         go to start;\r
+\r
+002120  aa   777116 7100 04   tra       -434,ic             001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 349\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 350\r
+      wrk = substr (in, ip, 1);\r
+\r
+002121  aa  6 00110 4501 00   stz       pr6|72              wrk\r
+002122  aa  7 00002 3715 20   epp5      pr7|2,*\r
+002123  aa  040 100 100 506   mlr       (pr,ql),(pr),fill(040)\r
+002124  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+002125  aa  6 00110 00 0001   desc9a    pr6|72,1            wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 351\r
+      if wrk ^= " " then go to non_blank;\r
+\r
+002126  aa  6 00110 2351 00   lda       pr6|72              wrk\r
+002127  aa   040000 1150 03   cmpa      16384,du\r
+002130  aa   000002 6000 04   tze       2,ic                002132\r
+002131  aa   000003 7100 04   tra       3,ic                002134\r
+                                                            STATEMENT 1 ON LINE\r
+\c 352\r
+incr: ip = ip + 1;\r
+\r
+002132  aa  6 00105 0541 00   aos       pr6|69              ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 353\r
+      go to blank;\r
+\r
+002133  aa   777742 7100 04   tra       -30,ic              002075\r
+                                                            STATEMENT 1 ON LINE\r
+\c 354\r
+non_blank:\r
+      i = index ("0123456789.()=+-*/", wrk);\r
+\r
+002134  aa  000 100 124 404   scm       (ic),(pr),mask(000)\r
+002135  aa   776064 00 0022   desc9a    -972,18             000220 = 0600610620\r
+\c63\r
+002136  aa  6 00110 00 0001   desc9a    pr6|72,1            wrk\r
+002137  aa  6 00056 0001 00   arg       pr6|46\r
+002140  aa  6 00056 2361 00   ldq       pr6|46\r
+002141  aa   000002 6070 04   ttf       2,ic                002143\r
+002142  aa   000001 3360 07   lcq       1,dl\r
+002143  aa   000001 0760 07   adq       1,dl\r
+002144  aa  6 00100 7561 00   stq       pr6|64              i\r
+                                                            STATEMENT 1 ON LINE\r
+\c 356\r
+      if i = 0 then go to var_ref;\r
+\r
+002145  aa   000002 6010 04   tnz       2,ic                002147\r
+002146  aa   000216 7100 04   tra       142,ic              002364\r
+                                                            STATEMENT 1 ON LINE\r
+\c 357\r
+      if i <= 11 then do;\r
+\r
+002147  aa   000013 1160 07   cmpq      11,dl\r
+002150  aa   000037 6054 04   tpnz      31,ic               002207\r
+                                                            STATEMENT 1 ON LINE\r
+\c 358\r
+         call ffip (addr (in), num - 1, ip, s.value (ss));\r
+\r
+002151  aa  7 00002 3521 20   epp2      pr7|2,*             in\r
+002152  aa  6 00174 2521 00   spri2     pr6|124\r
+002153  aa  7 00004 2361 20   ldq       pr7|4,*             num\r
+002154  aa   000001 1760 07   sbq       1,dl\r
+002155  aa  6 00133 7561 00   stq       pr6|91\r
+002156  aa  6 00040 3535 20   epp3      pr6|32,*\r
+002157  aa  3 00111 2361 00   ldq       pr3|73              ss\r
+002160  aa   000006 4020 07   mpy       6,dl\r
+002161  aa  6 00174 3521 00   epp2      pr6|124\r
+002162  aa  6 00136 2521 00   spri2     pr6|94\r
+002163  aa  6 00133 3521 00   epp2      pr6|91\r
+002164  aa  6 00140 2521 00   spri2     pr6|96\r
+002165  aa  6 00105 3521 00   epp2      pr6|69              ip\r
+002166  aa  6 00142 2521 00   spri2     pr6|98\r
+002167  aa  3 01032 3521 06   epp2      pr3|538,ql          s.value\r
+002170  aa  6 00144 2521 00   spri2     pr6|100\r
+002171  aa  6 00134 6211 00   eax1      pr6|92\r
+002172  aa   020000 4310 07   fld       8192,dl\r
+002173  aa  6 00044 3701 20   epp4      pr6|36,*\r
+002174  la  4 00032 3521 20   epp2      pr4|26,*            ffip\r
+002175  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 359\r
+         s.op (ss) = 0;\r
+\r
+002176  aa  6 00040 3735 20   epp7      pr6|32,*\r
+002177  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+002200  aa   000006 4020 07   mpy       6,dl\r
+002201  aa  7 01031 4501 06   stz       pr7|537,ql          s.op\r
+                                                            STATEMENT 1 ON LINE\r
+\c 360\r
+         ileq = "1"b;\r
+\r
+002202  aa   400000 2350 03   lda       131072,du\r
+002203  aa  7 01631 7551 00   sta       pr7|921             ileq\r
+                                                            STATEMENT 1 ON LINE\r
+\c 361\r
+         last = 2;\r
+\r
+002204  aa   000002 2360 07   ldq       2,dl\r
+002205  aa  6 00103 7561 00   stq       pr6|67              last\r
+                                                            STATEMENT 1 ON LINE\r
+\c 362\r
+         go to start;\r
+\r
+002206  aa   777030 7100 04   tra       -488,ic             001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 363\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 364\r
+      if i = 12 then do;\r
+\r
+002207  aa   000014 1160 07   cmpq      12,dl\r
+002210  aa   000022 6010 04   tnz       18,ic               002232\r
+                                                            STATEMENT 1 ON LINE\r
+\c 365\r
+         if last ^= 1 then\r
+              if last ^= 3 then do;\r
+\r
+002211  aa  6 00103 2361 00   ldq       pr6|67              last\r
+002212  aa   000001 1160 07   cmpq      1,dl\r
+002213  aa   000007 6000 04   tze       7,ic                002222\r
+002214  aa   000003 1160 07   cmpq      3,dl\r
+002215  aa   000005 6000 04   tze       5,ic                002222\r
+                                                            STATEMENT 1 ON LINE\r
+\c 367\r
+                 msg = "Invalid use of (";\r
+\r
+002216  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+002217  aa   775751 00 0020   desc9a    -1047,16            000167 = 1111561661\r
+\c41\r
+002220  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 368\r
+                 go to err;\r
+\r
+002221  aa   001173 7100 04   tra       635,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 369\r
+              end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 370\r
+         last = 3;\r
+\r
+002222  aa   000003 2360 07   ldq       3,dl\r
+002223  aa  6 00103 7561 00   stq       pr6|67              last\r
+                                                            STATEMENT 1 ON LINE\r
+\c 371\r
+         level = level + 5;\r
+\r
+002224  aa   000005 2360 07   ldq       5,dl\r
+002225  aa  6 00104 0561 00   asq       pr6|68              level\r
+                                                            STATEMENT 1 ON LINE\r
+\c 372\r
+         ileq = "1"b;\r
+\r
+002226  aa   400000 2350 03   lda       131072,du\r
+002227  aa  6 00040 3535 20   epp3      pr6|32,*\r
+002230  aa  3 01631 7551 00   sta       pr3|921             ileq\r
+                                                            STATEMENT 1 ON LINE\r
+\c 373\r
+         go to incr;\r
+\r
+002231  aa   777701 7100 04   tra       -63,ic              002132\r
+                                                            STATEMENT 1 ON LINE\r
+\c 374\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 376\r
+      if i = 13 then do;\r
+\r
+002232  aa   000015 1160 07   cmpq      13,dl\r
+002233  aa   000030 6010 04   tnz       24,ic               002263\r
+                                                            STATEMENT 1 ON LINE\r
+\c 377\r
+         if level = 0 then do;\r
+\r
+002234  aa  6 00104 2361 00   ldq       pr6|68              level\r
+002235  aa   000005 6010 04   tnz       5,ic                002242\r
+                                                            STATEMENT 1 ON LINE\r
+\c 378\r
+            msg = "Too many )'s";\r
+\r
+002236  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+002237  aa   775671 00 0014   desc9a    -1095,12            000127 = 1241571570\r
+\c40\r
+002240  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 379\r
+            go to err;\r
+\r
+002241  aa   001153 7100 04   tra       619,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 380\r
+         end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 381\r
+         if last ^= 2 then\r
+              if last ^= 4 then do;\r
+\r
+002242  aa  6 00103 2361 00   ldq       pr6|67              last\r
+002243  aa   000002 1160 07   cmpq      2,dl\r
+002244  aa   000007 6000 04   tze       7,ic                002253\r
+002245  aa   000004 1160 07   cmpq      4,dl\r
+002246  aa   000005 6000 04   tze       5,ic                002253\r
+                                                            STATEMENT 1 ON LINE\r
+\c 383\r
+                 msg = "Invalid use of )";\r
+\r
+002247  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+002250  aa   775714 00 0020   desc9a    -1076,16            000163 = 1111561661\r
+\c41\r
+002251  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 384\r
+                 go to err;\r
+\r
+002252  aa   001142 7100 04   tra       610,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 385\r
+              end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 386\r
+         last = 4;\r
+\r
+002253  aa   000004 2360 07   ldq       4,dl\r
+002254  aa  6 00103 7561 00   stq       pr6|67              last\r
+                                                            STATEMENT 1 ON LINE\r
+\c 387\r
+         level = level - 5;\r
+\r
+002255  aa   000005 3360 07   lcq       5,dl\r
+002256  aa  6 00104 0561 00   asq       pr6|68              level\r
+                                                            STATEMENT 1 ON LINE\r
+\c 388\r
+         ileq = "1"b;\r
+\r
+002257  aa   400000 2350 03   lda       131072,du\r
+002260  aa  6 00040 3535 20   epp3      pr6|32,*\r
+002261  aa  3 01631 7551 00   sta       pr3|921             ileq\r
+                                                            STATEMENT 1 ON LINE\r
+\c 389\r
+         go to incr;\r
+\r
+002262  aa   777650 7100 04   tra       -88,ic              002132\r
+                                                            STATEMENT 1 ON LINE\r
+\c 390\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 392\r
+      if last = 3 then\r
+           if i ^= 15 then\r
+                if i ^= 16 then do;\r
+\r
+002263  aa  6 00103 2361 00   ldq       pr6|67              last\r
+002264  aa   000003 1160 07   cmpq      3,dl\r
+002265  aa   000012 6010 04   tnz       10,ic               002277\r
+002266  aa  6 00100 2361 00   ldq       pr6|64              i\r
+002267  aa   000017 1160 07   cmpq      15,dl\r
+002270  aa   000007 6000 04   tze       7,ic                002277\r
+002271  aa   000020 1160 07   cmpq      16,dl\r
+002272  aa   000005 6000 04   tze       5,ic                002277\r
+                                                            STATEMENT 1 ON LINE\r
+\c 395\r
+                   msg = "Invalid op after (";\r
+\r
+002273  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+002274  aa   775720 00 0022   desc9a    -1072,18            000213 = 1111561661\r
+\c41\r
+002275  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 396\r
+                   go to err;\r
+\r
+002276  aa   001116 7100 04   tra       590,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 397\r
+                end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 398\r
+      last = 1;\r
+\r
+002277  aa   000001 2360 07   ldq       1,dl\r
+002300  aa  6 00103 7561 00   stq       pr6|67              last\r
+                                                            STATEMENT 1 ON LINE\r
+\c 399\r
+      if substr (in, ip, 2) = "**" then do;\r
+\r
+002301  aa  6 00105 7271 00   lxl7      pr6|69              ip\r
+002302  aa  040 004 106 517   cmpc      (pr,x7),(ic),fill(040)\r
+002303  aa  5 77777 60 0002   desc9a    pr5|-1(3),2         in\r
+002304  aa   001204 00 0002   desc9a    644,2               003506 = 0520520000\r
+\c00\r
+002305  aa   000004 6010 04   tnz       4,ic                002311\r
+                                                            STATEMENT 1 ON LINE\r
+\c 400\r
+         i = 19;\r
+\r
+002306  aa   000023 2360 07   ldq       19,dl\r
+002307  aa  6 00100 7561 00   stq       pr6|64              i\r
+                                                            STATEMENT 1 ON LINE\r
+\c 401\r
+         ip = ip + 1;\r
+\r
+002310  aa  6 00105 0541 00   aos       pr6|69              ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 402\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 404\r
+      if i = 14 then\r
+           if ileq then do;\r
+\r
+002311  aa  6 00100 2361 00   ldq       pr6|64              i\r
+002312  aa   000016 1160 07   cmpq      14,dl\r
+002313  aa   000010 6010 04   tnz       8,ic                002323\r
+002314  aa  6 00040 3535 20   epp3      pr6|32,*\r
+002315  aa  3 01631 2351 00   lda       pr3|921             ileq\r
+002316  aa   000005 6000 04   tze       5,ic                002323\r
+                                                            STATEMENT 1 ON LINE\r
+\c 406\r
+              msg = "Invalid use of =";\r
+\r
+002317  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+002320  aa   775640 00 0020   desc9a    -1120,16            000157 = 1111561661\r
+\c41\r
+002321  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 407\r
+              go to err;\r
+\r
+002322  aa   001072 7100 04   tra       570,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 408\r
+           end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 409\r
+      k = level + 1;\r
+\r
+002323  aa  6 00104 2361 00   ldq       pr6|68              level\r
+002324  aa   000001 0760 07   adq       1,dl\r
+002325  aa  6 00102 7561 00   stq       pr6|66              k\r
+                                                            STATEMENT 1 ON LINE\r
+\c 410\r
+      if i > 18 then k = k + 3;\r
+\r
+002326  aa  6 00100 2361 00   ldq       pr6|64              i\r
+002327  aa   000022 1160 07   cmpq      18,dl\r
+002330  aa   000004 6044 04   tmoz      4,ic                002334\r
+002331  aa   000003 2360 07   ldq       3,dl\r
+002332  aa  6 00102 0561 00   asq       pr6|66              k\r
+002333  aa   000011 7100 04   tra       9,ic                002344\r
+                                                            STATEMENT 1 ON LINE\r
+\c 411\r
+      else if i > 16 then k = k + 2;\r
+\r
+002334  aa   000020 1160 07   cmpq      16,dl\r
+002335  aa   000004 6044 04   tmoz      4,ic                002341\r
+002336  aa   000002 2360 07   ldq       2,dl\r
+002337  aa  6 00102 0561 00   asq       pr6|66              k\r
+002340  aa   000004 7100 04   tra       4,ic                002344\r
+                                                            STATEMENT 1 ON LINE\r
+\c 412\r
+      else if i > 14 then k = k + 1;\r
+\r
+002341  aa   000016 1160 07   cmpq      14,dl\r
+002342  aa   000002 6044 04   tmoz      2,ic                002344\r
+002343  aa  6 00102 0541 00   aos       pr6|66              k\r
+                                                            STATEMENT 1 ON LINE\r
+\c 413\r
+      s.type (ss) = k;\r
+\r
+002344  aa  6 00040 3535 20   epp3      pr6|32,*\r
+002345  aa  3 00111 2361 00   ldq       pr3|73              ss\r
+002346  aa   000006 4020 07   mpy       6,dl\r
+002347  aa   000000 6270 06   eax7      0,ql\r
+002350  aa  6 00102 2361 00   ldq       pr6|66              k\r
+002351  aa  3 01030 7561 17   stq       pr3|536,7           s.type\r
+                                                            STATEMENT 1 ON LINE\r
+\c 414\r
+      s.op (ss) = i - 11;\r
+\r
+002352  aa  3 00111 2361 00   ldq       pr3|73              ss\r
+002353  aa   000006 4020 07   mpy       6,dl\r
+002354  aa   000000 6260 06   eax6      0,ql\r
+002355  aa  6 00100 2361 00   ldq       pr6|64              i\r
+002356  aa   000013 1760 07   sbq       11,dl\r
+002357  aa  3 01031 7561 16   stq       pr3|537,6           s.op\r
+                                                            STATEMENT 1 ON LINE\r
+\c 415\r
+      ileq = "1"b;\r
+\r
+002360  aa   400000 2350 03   lda       131072,du\r
+002361  aa  3 01631 7551 00   sta       pr3|921             ileq\r
+                                                            STATEMENT 1 ON LINE\r
+\c 416\r
+      ip = ip + 1;\r
+\r
+002362  aa  6 00105 0541 00   aos       pr6|69              ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 417\r
+      go to start;\r
+\r
+002363  aa   776653 7100 04   tra       -597,ic             001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 419\r
+var_ref: i = ip;\r
+\r
+002364  aa  6 00105 2361 00   ldq       pr6|69              ip\r
+002365  aa  6 00100 7561 00   stq       pr6|64              i\r
+                                                            STATEMENT 1 ON LINE\r
+\c 420\r
+      last = 2;\r
+\r
+002366  aa   000002 2360 07   ldq       2,dl\r
+002367  aa  6 00103 7561 00   stq       pr6|67              last\r
+                                                            STATEMENT 1 ON LINE\r
+\c 421\r
+      if verify (wrk, var_name_chars) ^= 0 then do;\r
+\r
+002370  aa  000 100 124 404   scm       (ic),(pr),mask(000)\r
+002371  aa   775446 00 0077   desc9a    -1242,63            000036 = 1011021031\r
+\c04\r
+002372  aa  6 00110 00 0001   desc9a    pr6|72,1            wrk\r
+002373  aa  6 00056 0001 00   arg       pr6|46\r
+002374  aa   000001 2360 07   ldq       1,dl\r
+002375  aa   000002 6064 04   ttn       2,ic                002377\r
+002376  aa   000000 2360 07   ldq       0,dl\r
+002377  aa   000016 6000 04   tze       14,ic               002415\r
+                                                            STATEMENT 1 ON LINE\r
+\c 422\r
+bad_char: msg = "Invalid char " || wrk;\r
+\r
+002400  aa   000016 2360 07   ldq       14,dl\r
+002401  aa  0 00551 7001 00   tsx0      pr0|361             alloc_char_temp\r
+002402  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+002403  aa   775551 00 0015   desc9a    -1175,13            000153 = 1111561661\r
+\c41\r
+002404  aa  2 00000 00 0015   desc9a    pr2|0,13\r
+002405  aa  040 100 100 500   mlr       (pr),(pr),fill(040)\r
+002406  aa  6 00110 00 0001   desc9a    pr6|72,1            wrk\r
+002407  aa  2 00003 20 0001   desc9a    pr2|3(1),1\r
+002410  aa  040 100 100 500   mlr       (pr),(pr),fill(040)\r
+002411  aa  2 00000 00 0016   desc9a    pr2|0,14\r
+002412  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 423\r
+         go to err;\r
+\r
+002413  aa  0 01014 7001 00   tsx0      pr0|524             shorten_stack\r
+002414  aa   001000 7100 04   tra       512,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 424\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 425\r
+      go to first;\r
+\r
+002415  aa   000011 7100 04   tra       9,ic                002426\r
+                                                            STATEMENT 1 ON LINE\r
+\c 426\r
+var_loop: ip = ip + 1;\r
+\r
+002416  aa  6 00105 0541 00   aos       pr6|69              ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 427\r
+      wrk = substr (in, ip, 1);\r
+\r
+002417  aa  6 00110 4501 00   stz       pr6|72              wrk\r
+002420  aa  6 00105 7271 00   lxl7      pr6|69              ip\r
+002421  aa  6 00032 3735 20   epp7      pr6|26,*\r
+002422  aa  7 00002 3715 20   epp5      pr7|2,*\r
+002423  aa  040 100 100 517   mlr       (pr,x7),(pr),fill(040)\r
+002424  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+002425  aa  6 00110 00 0001   desc9a    pr6|72,1            wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 428\r
+first: if ip < num then do;\r
+\r
+002426  aa  6 00105 2361 00   ldq       pr6|69              ip\r
+002427  aa  7 00004 1161 20   cmpq      pr7|4,*             num\r
+002430  aa   000023 6050 04   tpl       19,ic               002453\r
+                                                            STATEMENT 1 ON LINE\r
+\c 429\r
+         if verify (wrk, var_name_chars) = 0 then           /* phx10119,20071,2\r
+\c1221: name validity check */\r
+              go to var_loop;\r
+\r
+002431  aa  000 100 124 404   scm       (ic),(pr),mask(000)\r
+002432  aa   775405 00 0077   desc9a    -1275,63            000036 = 1011021031\r
+\c04\r
+002433  aa  6 00110 00 0001   desc9a    pr6|72,1            wrk\r
+002434  aa  6 00056 0001 00   arg       pr6|46\r
+002435  aa   000001 2360 07   ldq       1,dl\r
+002436  aa   000002 6064 04   ttn       2,ic                002440\r
+002437  aa   000000 2360 07   ldq       0,dl\r
+002440  aa   000002 6010 04   tnz       2,ic                002442\r
+002441  aa   777755 7100 04   tra       -19,ic              002416\r
+                                                            STATEMENT 1 ON LINE\r
+\c 432\r
+         if verify (wrk, valid_token_delimiters) ^= 0 then  /* check for invali\r
+\cd */\r
+              go to bad_char;\r
+\r
+002442  aa  000 100 124 404   scm       (ic),(pr),mask(000)\r
+002443  aa   775371 00 0011   desc9a    -1287,9             000033 = 0400560500\r
+\c51\r
+002444  aa  6 00110 00 0001   desc9a    pr6|72,1            wrk\r
+002445  aa  6 00056 0001 00   arg       pr6|46\r
+002446  aa   000001 2360 07   ldq       1,dl\r
+002447  aa   000002 6064 04   ttn       2,ic                002451\r
+002450  aa   000000 2360 07   ldq       0,dl\r
+002451  aa   000002 6000 04   tze       2,ic                002453\r
+002452  aa   777726 7100 04   tra       -42,ic              002400\r
+                                                            STATEMENT 1 ON LINE\r
+\c 434\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 436\r
+      wrka = substr (in, i, ip - i);\r
+\r
+002453  aa  6 00105 2361 00   ldq       pr6|69              ip\r
+002454  aa  6 00100 1761 00   sbq       pr6|64              i\r
+002455  aa  6 00100 7271 00   lxl7      pr6|64              i\r
+002456  aa  040 100 100 557   mlr       (pr,rl,x7),(pr),fill(040)\r
+002457  aa  5 77777 60 0006   desc9a    pr5|-1(3),ql        in\r
+002460  aa  6 00112 00 0010   desc9a    pr6|74,8            wrka\r
+                                                            STATEMENT 1 ON LINE\r
+\c 438\r
+      if expr_arg_sw then do;\r
+\r
+002461  aa  6 00040 3535 20   epp3      pr6|32,*\r
+002462  aa  3 00101 2351 00   lda       pr3|65              expr_arg_sw\r
+002463  aa   000103 6000 04   tze       67,ic               002566\r
+                                                            STATEMENT 1 ON LINE\r
+\c 439\r
+         do i = 0 to 6;\r
+\r
+002464  aa  6 00100 4501 00   stz       pr6|64              i\r
+002465  aa   000000 0110 03   nop       0,du\r
+002466  aa  6 00100 2361 00   ldq       pr6|64              i\r
+002467  aa   000006 1160 07   cmpq      6,dl\r
+002470  aa   000013 6054 04   tpnz      11,ic               002503\r
+                                                            STATEMENT 1 ON LINE\r
+\c 440\r
+            if wrka = funcs (i) then go to func_ref;\r
+\r
+002471  aa   000001 7360 00   qls       1\r
+002472  aa   000000 6270 06   eax7      0,ql\r
+002473  aa  6 00112 2371 00   ldaq      pr6|74              wrka\r
+002474  ta   000015 1150 17   cmpa      13,7\r
+002475  aa   000002 6010 04   tnz       2,ic                002477\r
+002476  ta   000016 1160 17   cmpq      14,7\r
+002477  aa   000002 6010 04   tnz       2,ic                002501\r
+002500  aa   000426 7100 04   tra       278,ic              003126\r
+                                                            STATEMENT 1 ON LINE\r
+\c 441\r
+         end;\r
+\r
+002501  aa  6 00100 0541 00   aos       pr6|64              i\r
+002502  aa   777764 7100 04   tra       -12,ic              002466\r
+                                                            STATEMENT 1 ON LINE\r
+\c 442\r
+         if af_sw then call active_fnc_err_ (0, "calc", "Variables not allowed \r
+\cin expression argument.");\r
+\r
+002503  aa  6 00040 3735 20   epp7      pr6|32,*\r
+002504  aa  7 00100 2351 00   lda       pr7|64              af_sw\r
+002505  aa   000031 6000 04   tze       25,ic               002536\r
+002506  aa  6 00133 4501 00   stz       pr6|91\r
+002507  aa   775374 2350 04   lda       -1284,ic            000103 = 1431411541\r
+\c43\r
+002510  aa  6 00131 7551 00   sta       pr6|89\r
+002511  aa  000 100 100 404   mlr       (ic),(pr),fill(000)\r
+002512  aa   775572 00 0060   desc9a    -1158,48            000303 = 1261411621\r
+\c51\r
+002513  aa  6 00134 00 0060   desc9a    pr6|92,48\r
+002514  aa  6 00133 3521 00   epp2      pr6|91\r
+002515  aa  6 00200 2521 00   spri2     pr6|128\r
+002516  aa  6 00131 3521 00   epp2      pr6|89\r
+002517  aa  6 00202 2521 00   spri2     pr6|130\r
+002520  aa  6 00134 3521 00   epp2      pr6|92\r
+002521  aa  6 00204 2521 00   spri2     pr6|132\r
+002522  aa   775362 3520 04   epp2      -1294,ic            000104 = 4040000000\r
+\c05\r
+002523  aa  6 00206 2521 00   spri2     pr6|134\r
+002524  aa   775356 3520 04   epp2      -1298,ic            000102 = 5240000000\r
+\c04\r
+002525  aa  6 00210 2521 00   spri2     pr6|136\r
+002526  aa   775335 3520 04   epp2      -1315,ic            000063 = 5240000000\r
+\c55\r
+002527  aa  6 00212 2521 00   spri2     pr6|138\r
+002530  aa  6 00176 6211 00   eax1      pr6|126\r
+002531  aa   014000 4310 07   fld       6144,dl\r
+002532  aa  6 00044 3701 20   epp4      pr6|36,*\r
+002533  la  4 00016 3521 20   epp2      pr4|14,*            active_fnc_err_\r
+002534  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+002535  aa   000030 7100 04   tra       24,ic               002565\r
+                                                            STATEMENT 1 ON LINE\r
+\c 443\r
+         else call com_err_ (0, "calc", "Variables not allowed in expression ar\r
+\cgument.");\r
+\r
+002536  aa  6 00131 4501 00   stz       pr6|89\r
+002537  aa   775344 2350 04   lda       -1308,ic            000103 = 1431411541\r
+\c43\r
+002540  aa  6 00133 7551 00   sta       pr6|91\r
+002541  aa  000 100 100 404   mlr       (ic),(pr),fill(000)\r
+002542  aa   775542 00 0060   desc9a    -1182,48            000303 = 1261411621\r
+\c51\r
+002543  aa  6 00176 00 0060   desc9a    pr6|126,48\r
+002544  aa  6 00131 3521 00   epp2      pr6|89\r
+002545  aa  6 00136 2521 00   spri2     pr6|94\r
+002546  aa  6 00133 3521 00   epp2      pr6|91\r
+002547  aa  6 00140 2521 00   spri2     pr6|96\r
+002550  aa  6 00176 3521 00   epp2      pr6|126\r
+002551  aa  6 00142 2521 00   spri2     pr6|98\r
+002552  aa   775332 3520 04   epp2      -1318,ic            000104 = 4040000000\r
+\c05\r
+002553  aa  6 00144 2521 00   spri2     pr6|100\r
+002554  aa   775326 3520 04   epp2      -1322,ic            000102 = 5240000000\r
+\c04\r
+002555  aa  6 00146 2521 00   spri2     pr6|102\r
+002556  aa   775305 3520 04   epp2      -1339,ic            000063 = 5240000000\r
+\c55\r
+002557  aa  6 00150 2521 00   spri2     pr6|104\r
+002560  aa  6 00134 6211 00   eax1      pr6|92\r
+002561  aa   014000 4310 07   fld       6144,dl\r
+002562  aa  6 00044 3701 20   epp4      pr6|36,*\r
+002563  la  4 00022 3521 20   epp2      pr4|18,*            com_err_\r
+002564  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 444\r
+         return;\r
+\r
+002565  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 445\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 447\r
+      vp = sv;\r
+\r
+002566  aa  3 00120 3515 20   epp1      pr3|80,*            sv\r
+002567  aa  3 00130 2515 00   spri1     pr3|88              vp\r
+                                                            STATEMENT 1 ON LINE\r
+\c 448\r
+      k = fv - 1;\r
+\r
+002570  aa  3 00112 2361 00   ldq       pr3|74              fv\r
+002571  aa   000001 1760 07   sbq       1,dl\r
+002572  aa  6 00102 7561 00   stq       pr6|66              k\r
+                                                            STATEMENT 1 ON LINE\r
+\c 449\r
+next_v: do j = k to 0 by -1;\r
+\r
+002573  aa  6 00102 2361 00   ldq       pr6|66              k\r
+002574  aa  6 00101 7561 00   stq       pr6|65              j\r
+002575  aa   000000 0110 03   nop       0,du\r
+002576  aa  6 00101 2361 00   ldq       pr6|65              j\r
+002577  aa   000016 6040 04   tmi       14,ic               002615\r
+                                                            STATEMENT 1 ON LINE\r
+\c 450\r
+         if wrka = vars.d.name (j) then go to found;\r
+\r
+002600  aa   000003 4020 07   mpy       3,dl\r
+002601  aa   000000 6270 06   eax7      0,ql\r
+002602  aa  6 00112 2371 00   ldaq      pr6|74              wrka\r
+002603  aa  6 00040 3735 20   epp7      pr6|32,*\r
+002604  aa  7 00130 3715 20   epp5      pr7|88,*            vp\r
+002605  aa  5 00002 1151 17   cmpa      pr5|2,7             vars.name\r
+002606  aa   000002 6010 04   tnz       2,ic                002610\r
+002607  aa  5 00003 1161 17   cmpq      pr5|3,7             vars.name\r
+002610  aa   000002 6010 04   tnz       2,ic                002612\r
+002611  aa   000272 7100 04   tra       186,ic              003103\r
+                                                            STATEMENT 1 ON LINE\r
+\c 451\r
+      end;\r
+\r
+002612  aa   000001 3360 07   lcq       1,dl\r
+002613  aa  6 00101 0561 00   asq       pr6|65              j\r
+002614  aa   777762 7100 04   tra       -14,ic              002576\r
+                                                            STATEMENT 1 ON LINE\r
+\c 452\r
+      vp = vars.next;\r
+\r
+002615  aa  6 00040 3735 20   epp7      pr6|32,*\r
+002616  aa  7 00130 3735 20   epp7      pr7|88,*            vars.next\r
+002617  aa  7 00000 3735 20   epp7      pr7|0,*             vars.next\r
+002620  aa  6 00040 3715 20   epp5      pr6|32,*\r
+002621  aa  5 00130 6535 00   spri7     pr5|88              vp\r
+                                                            STATEMENT 1 ON LINE\r
+\c 453\r
+      k = 31;\r
+\r
+002622  aa   000037 2360 07   ldq       31,dl\r
+002623  aa  6 00102 7561 00   stq       pr6|66              k\r
+                                                            STATEMENT 1 ON LINE\r
+\c 454\r
+      if vp ^= null then go to next_v;\r
+\r
+002624  aa  5 00130 2371 00   ldaq      pr5|88              vp\r
+002625  aa   775273 6770 04   eraq      -1349,ic            000120 = 0777770000\r
+\c43 000001000000\r
+002626  aa  0 00460 3771 00   anaq      pr0|304             = 077777000077 7777\r
+\c77077077\r
+002627  aa   000002 6000 04   tze       2,ic                002631\r
+002630  aa   777743 7100 04   tra       -29,ic              002573\r
+                                                            STATEMENT 1 ON LINE\r
+\c 455\r
+      if wrka = "q" then do;\r
+\r
+002631  aa   161000 2350 03   lda       57856,du\r
+002632  aa  0 00022 3771 00   anaq      pr0|18              = 777000000000 0000\r
+\c00000000\r
+002633  aa  0 00442 2771 00   oraq      pr0|290             = 000040040040 0400\r
+\c40040040\r
+002634  aa  6 00112 1171 00   cmpaq     pr6|74              wrka\r
+002635  aa   000014 6010 04   tnz       12,ic               002651\r
+                                                            STATEMENT 1 ON LINE\r
+\c 456\r
+         if num > 2 then do;\r
+\r
+002636  aa  6 00032 3535 20   epp3      pr6|26,*\r
+002637  aa  3 00004 2361 20   ldq       pr3|4,*             num\r
+002640  aa   000002 1160 07   cmpq      2,dl\r
+002641  aa   000005 6044 04   tmoz      5,ic                002646\r
+                                                            STATEMENT 1 ON LINE\r
+\c 457\r
+            msg = "Invalid var q";\r
+\r
+002642  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+002643  aa   775305 00 0015   desc9a    -1339,13            000147 = 1111561661\r
+\c41\r
+002644  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 458\r
+            go to err;\r
+\r
+002645  aa   000547 7100 04   tra       359,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 459\r
+         end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 460\r
+         code = 2;\r
+\r
+002646  aa   000002 2360 07   ldq       2,dl\r
+002647  aa  3 00010 7561 20   stq       pr3|8,*             code\r
+                                                            STATEMENT 1 ON LINE\r
+\c 461\r
+         return;\r
+\r
+002650  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 462\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 463\r
+      if wrka = "list" then do;\r
+\r
+002651  aa   775211 2350 04   lda       -1399,ic            000062 = 1541511631\r
+\c64\r
+002652  aa  0 00110 3771 00   anaq      pr0|72              = 777777777777 0000\r
+\c00000000\r
+002653  aa  0 00450 2771 00   oraq      pr0|296             = 000000000000 0400\r
+\c40040040\r
+002654  aa  6 00112 1171 00   cmpaq     pr6|74              wrka\r
+002655  aa   000150 6010 04   tnz       104,ic              003025\r
+                                                            STATEMENT 1 ON LINE\r
+\c 464\r
+         wrk = "\r
+";\r
+\r
+002656  aa   012000 2350 03   lda       5120,du\r
+002657  aa  6 00110 7551 00   sta       pr6|72              wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 466\r
+         call iox_$put_chars (iox_$user_output, addr (wrk), 1, (0));\r
+\r
+002660  aa  6 00110 3535 00   epp3      pr6|72              wrk\r
+002661  aa  6 00174 2535 00   spri3     pr6|124\r
+002662  aa   000001 2360 07   ldq       1,dl\r
+002663  aa  6 00133 7561 00   stq       pr6|91\r
+002664  aa  6 00131 4501 00   stz       pr6|89\r
+002665  aa  6 00044 3701 20   epp4      pr6|36,*\r
+002666  la  4 00050 3521 20   epp2      pr4|40,*            iox_$user_output\r
+002667  aa  6 00200 2521 00   spri2     pr6|128\r
+002670  aa  6 00174 3521 00   epp2      pr6|124\r
+002671  aa  6 00202 2521 00   spri2     pr6|130\r
+002672  aa  6 00133 3521 00   epp2      pr6|91\r
+002673  aa  6 00204 2521 00   spri2     pr6|132\r
+002674  aa  6 00131 3521 00   epp2      pr6|89\r
+002675  aa  6 00206 2521 00   spri2     pr6|134\r
+002676  aa  6 00176 6211 00   eax1      pr6|126\r
+002677  aa   020000 4310 07   fld       8192,dl\r
+002700  la  4 00046 3521 20   epp2      pr4|38,*            iox_$put_chars\r
+002701  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 467\r
+         vp = sv;\r
+\r
+002702  aa  6 00040 3735 20   epp7      pr6|32,*\r
+002703  aa  7 00120 3735 20   epp7      pr7|80,*            sv\r
+002704  aa  6 00040 3715 20   epp5      pr6|32,*\r
+002705  aa  5 00130 6535 00   spri7     pr5|88              vp\r
+                                                            STATEMENT 1 ON LINE\r
+\c 468\r
+         k = fv - 1;\r
+\r
+002706  aa  5 00112 2361 00   ldq       pr5|74              fv\r
+002707  aa   000001 1760 07   sbq       1,dl\r
+002710  aa  6 00102 7561 00   stq       pr6|66              k\r
+                                                            STATEMENT 1 ON LINE\r
+\c 469\r
+another: do j = k to 0 by -1;\r
+\r
+002711  aa  6 00102 2361 00   ldq       pr6|66              k\r
+002712  aa  6 00101 7561 00   stq       pr6|65              j\r
+002713  aa   000000 0110 03   nop       0,du\r
+002714  aa  6 00101 2361 00   ldq       pr6|65              j\r
+002715  aa   000060 6040 04   tmi       48,ic               002775\r
+                                                            STATEMENT 1 ON LINE\r
+\c 470\r
+            substr (out, 1, 8) = vars.d.name (j);\r
+\r
+002716  aa   000003 4020 07   mpy       3,dl\r
+002717  aa  6 00040 3735 20   epp7      pr6|32,*\r
+002720  aa  7 00130 3715 20   epp5      pr7|88,*            vp\r
+002721  aa  5 00002 2351 06   lda       pr5|2,ql            vars.name\r
+002722  aa  5 00003 2361 06   ldq       pr5|3,ql            vars.name\r
+002723  aa  7 01020 7571 00   staq      pr7|528             out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 471\r
+            substr (out, 9, 4) = " =  ";\r
+\r
+002724  aa   775135 2350 04   lda       -1443,ic            000061 = 0400750400\r
+\c40\r
+002725  aa  7 01022 7551 00   sta       pr7|530             out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 472\r
+            ip = 13;\r
+\r
+002726  aa   000015 2360 07   ldq       13,dl\r
+002727  aa  6 00105 7561 00   stq       pr6|69              ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 473\r
+            call ffop (out, ip, vars.d.value (j));\r
+\r
+002730  aa  6 00101 2361 00   ldq       pr6|65              j\r
+002731  aa   000003 4020 07   mpy       3,dl\r
+002732  aa  7 01020 3521 00   epp2      pr7|528             out\r
+002733  aa  6 00200 2521 00   spri2     pr6|128\r
+002734  aa  6 00105 3521 00   epp2      pr6|69              ip\r
+002735  aa  6 00202 2521 00   spri2     pr6|130\r
+002736  aa  5 00004 3521 06   epp2      pr5|4,ql            vars.value\r
+002737  aa  6 00204 2521 00   spri2     pr6|132\r
+002740  aa  6 00176 6211 00   eax1      pr6|126\r
+002741  aa   014000 4310 07   fld       6144,dl\r
+002742  aa  6 00044 3701 20   epp4      pr6|36,*\r
+002743  la  4 00034 3521 20   epp2      pr4|28,*            ffop\r
+002744  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 474\r
+            substr (out, ip, 1) = "\r
+";\r
+\r
+002745  aa  6 00105 7271 00   lxl7      pr6|69              ip\r
+002746  aa  6 00040 3735 20   epp7      pr6|32,*\r
+002747  aa  012 117 100 400   mlr       (),(pr,x7),fill(012)\r
+002750  aa   000000 00 0000   desc9a    0,0\r
+002751  aa  7 01017 60 0001   desc9a    pr7|527(3),1        out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 476\r
+            call iox_$put_chars (iox_$user_output, addr (out), ip, (0));\r
+\r
+002752  aa  7 01020 3715 00   epp5      pr7|528             out\r
+002753  aa  6 00174 6515 00   spri5     pr6|124\r
+002754  aa  6 00131 4501 00   stz       pr6|89\r
+002755  aa  6 00044 3701 20   epp4      pr6|36,*\r
+002756  la  4 00050 3521 20   epp2      pr4|40,*            iox_$user_output\r
+002757  aa  6 00200 2521 00   spri2     pr6|128\r
+002760  aa  6 00174 3521 00   epp2      pr6|124\r
+002761  aa  6 00202 2521 00   spri2     pr6|130\r
+002762  aa  6 00105 3521 00   epp2      pr6|69              ip\r
+002763  aa  6 00204 2521 00   spri2     pr6|132\r
+002764  aa  6 00131 3521 00   epp2      pr6|89\r
+002765  aa  6 00206 2521 00   spri2     pr6|134\r
+002766  aa  6 00176 6211 00   eax1      pr6|126\r
+002767  aa   020000 4310 07   fld       8192,dl\r
+002770  la  4 00046 3521 20   epp2      pr4|38,*            iox_$put_chars\r
+002771  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+                                                            STATEMENT 1 ON LINE\r
+\c 477\r
+         end;\r
+\r
+002772  aa   000001 3360 07   lcq       1,dl\r
+002773  aa  6 00101 0561 00   asq       pr6|65              j\r
+002774  aa   777720 7100 04   tra       -48,ic              002714\r
+                                                            STATEMENT 1 ON LINE\r
+\c 478\r
+         vp = vars.next;\r
+\r
+002775  aa  6 00040 3735 20   epp7      pr6|32,*\r
+002776  aa  7 00130 3735 20   epp7      pr7|88,*            vars.next\r
+002777  aa  7 00000 3735 20   epp7      pr7|0,*             vars.next\r
+003000  aa  6 00040 3715 20   epp5      pr6|32,*\r
+003001  aa  5 00130 6535 00   spri7     pr5|88              vp\r
+                                                            STATEMENT 1 ON LINE\r
+\c 479\r
+         k = 31;\r
+\r
+003002  aa   000037 2360 07   ldq       31,dl\r
+003003  aa  6 00102 7561 00   stq       pr6|66              k\r
+                                                            STATEMENT 1 ON LINE\r
+\c 480\r
+         if vp ^= null then go to another;\r
+\r
+003004  aa  5 00130 2371 00   ldaq      pr5|88              vp\r
+003005  aa   775113 6770 04   eraq      -1461,ic            000120 = 0777770000\r
+\c43 000001000000\r
+003006  aa  0 00460 3771 00   anaq      pr0|304             = 077777000077 7777\r
+\c77077077\r
+003007  aa   000002 6000 04   tze       2,ic                003011\r
+003010  aa   777701 7100 04   tra       -63,ic              002711\r
+                                                            STATEMENT 1 ON LINE\r
+\c 481\r
+         call ioa_ (" ");\r
+\r
+003011  aa   040000 2350 03   lda       16384,du\r
+003012  aa  6 00131 7551 00   sta       pr6|89\r
+003013  aa  6 00131 3521 00   epp2      pr6|89\r
+003014  aa  6 00200 2521 00   spri2     pr6|128\r
+003015  aa   775043 3520 04   epp2      -1501,ic            000060 = 5240000000\r
+\c01\r
+003016  aa  6 00202 2521 00   spri2     pr6|130\r
+003017  aa  6 00176 6211 00   eax1      pr6|126\r
+003020  aa   004000 4310 07   fld       2048,dl\r
+003021  aa  6 00044 3701 20   epp4      pr6|36,*\r
+003022  la  4 00036 3521 20   epp2      pr4|30,*            ioa_\r
+003023  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 482\r
+         return;\r
+\r
+003024  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 483\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 484\r
+      do i = 0 to 6;\r
+\r
+003025  aa  6 00100 4501 00   stz       pr6|64              i\r
+003026  aa  6 00100 2361 00   ldq       pr6|64              i\r
+003027  aa   000006 1160 07   cmpq      6,dl\r
+003030  aa   000013 6054 04   tpnz      11,ic               003043\r
+                                                            STATEMENT 1 ON LINE\r
+\c 485\r
+         if wrka = funcs (i) then go to func_ref;\r
+\r
+003031  aa   000001 7360 00   qls       1\r
+003032  aa   000000 6270 06   eax7      0,ql\r
+003033  aa  6 00112 2371 00   ldaq      pr6|74              wrka\r
+003034  ta   000015 1150 17   cmpa      13,7\r
+003035  aa   000002 6010 04   tnz       2,ic                003037\r
+003036  ta   000016 1160 17   cmpq      14,7\r
+003037  aa   000002 6010 04   tnz       2,ic                003041\r
+003040  aa   000066 7100 04   tra       54,ic               003126\r
+                                                            STATEMENT 1 ON LINE\r
+\c 486\r
+      end;\r
+\r
+003041  aa  6 00100 0541 00   aos       pr6|64              i\r
+003042  aa   777764 7100 04   tra       -12,ic              003026\r
+                                                            STATEMENT 1 ON LINE\r
+\c 487\r
+      if ileq then do;\r
+\r
+003043  aa  6 00040 3735 20   epp7      pr6|32,*\r
+003044  aa  7 01631 2351 00   lda       pr7|921             ileq\r
+003045  aa   000016 6000 04   tze       14,ic               003063\r
+                                                            STATEMENT 1 ON LINE\r
+\c 489\r
+         msg = "Undef var " || wrka;\r
+\r
+003046  aa   000022 2360 07   ldq       18,dl\r
+003047  aa  0 00551 7001 00   tsx0      pr0|361             alloc_char_temp\r
+003050  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+003051  aa   775054 00 0012   desc9a    -1492,10            000124 = 1251561441\r
+\c45\r
+003052  aa  2 00000 00 0012   desc9a    pr2|0,10\r
+003053  aa  040 100 100 500   mlr       (pr),(pr),fill(040)\r
+003054  aa  6 00112 00 0010   desc9a    pr6|74,8            wrka\r
+003055  aa  2 00002 40 0010   desc9a    pr2|2(2),8\r
+003056  aa  040 100 100 500   mlr       (pr),(pr),fill(040)\r
+003057  aa  2 00000 00 0022   desc9a    pr2|0,18\r
+003060  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 490\r
+         go to err;\r
+\r
+003061  aa  0 01014 7001 00   tsx0      pr0|524             shorten_stack\r
+003062  aa   000332 7100 04   tra       218,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 491\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 492\r
+      vp = sv;\r
+\r
+003063  aa  7 00120 3715 20   epp5      pr7|80,*            sv\r
+003064  aa  7 00130 6515 00   spri5     pr7|88              vp\r
+                                                            STATEMENT 1 ON LINE\r
+\c 493\r
+      j = fv;\r
+\r
+003065  aa  7 00112 2361 00   ldq       pr7|74              fv\r
+003066  aa  6 00101 7561 00   stq       pr6|65              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 494\r
+      fv = fv + 1;\r
+\r
+003067  aa  7 00112 0541 00   aos       pr7|74              fv\r
+                                                            STATEMENT 1 ON LINE\r
+\c 495\r
+      vars.d.name (j) = wrka;\r
+\r
+003070  aa   000003 4020 07   mpy       3,dl\r
+003071  aa   000000 6270 06   eax7      0,ql\r
+003072  aa  6 00112 2371 00   ldaq      pr6|74              wrka\r
+003073  aa  7 00130 3535 20   epp3      pr7|88,*            vp\r
+003074  aa  3 00002 7551 17   sta       pr3|2,7             vars.name\r
+003075  aa  3 00003 7561 17   stq       pr3|3,7             vars.name\r
+                                                            STATEMENT 1 ON LINE\r
+\c 496\r
+      vars.d.value (j) = 0e0;\r
+\r
+003076  aa  6 00101 2361 00   ldq       pr6|65              j\r
+003077  aa   000003 4020 07   mpy       3,dl\r
+003100  aa   000000 6260 06   eax6      0,ql\r
+003101  aa   400000 4310 03   fld       131072,du\r
+003102  aa  3 00004 4551 16   fst       pr3|4,6             vars.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 497\r
+found: s.op (ss) = 0;\r
+\r
+003103  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+003104  aa   000006 4020 07   mpy       6,dl\r
+003105  aa  7 01031 4501 06   stz       pr7|537,ql          s.op\r
+                                                            STATEMENT 1 ON LINE\r
+\c 498\r
+      s.value (ss) = vars.d.value (j);\r
+\r
+003106  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+003107  aa   000006 4020 07   mpy       6,dl\r
+003110  aa   000000 6270 06   eax7      0,ql\r
+003111  aa  6 00101 2361 00   ldq       pr6|65              j\r
+003112  aa   000003 4020 07   mpy       3,dl\r
+003113  aa  7 00130 3715 20   epp5      pr7|88,*            vp\r
+003114  aa  5 00004 4311 06   fld       pr5|4,ql            vars.value\r
+003115  aa  7 01032 4551 17   fst       pr7|538,7           s.value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 499\r
+      s.var (ss) = addr (vars.d.value (j));\r
+\r
+003116  aa  7 00111 2361 00   ldq       pr7|73              ss\r
+003117  aa   000006 4020 07   mpy       6,dl\r
+003120  aa   000000 6260 06   eax6      0,ql\r
+003121  aa  6 00101 2361 00   ldq       pr6|65              j\r
+003122  aa   000003 4020 07   mpy       3,dl\r
+003123  aa  5 00004 3535 06   epp3      pr5|4,ql            vars.value\r
+003124  aa  7 01034 2535 16   spri3     pr7|540,6           s.var\r
+                                                            STATEMENT 1 ON LINE\r
+\c 500\r
+      go to start;\r
+\r
+003125  aa   776111 7100 04   tra       -951,ic             001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 502\r
+func_ref: do ip = ip to num while (substr (in, ip, 1) ^= "(");\r
+\r
+003126  aa  6 00032 3735 20   epp7      pr6|26,*\r
+003127  aa  7 00004 2361 20   ldq       pr7|4,*             num\r
+003130  aa  6 00126 7561 00   stq       pr6|86\r
+003131  aa  6 00105 2361 00   ldq       pr6|69              ip\r
+003132  aa  6 00105 7561 00   stq       pr6|69              ip\r
+003133  aa   000000 0110 03   nop       0,du\r
+003134  aa  6 00105 2361 00   ldq       pr6|69              ip\r
+003135  aa  6 00126 1161 00   cmpq      pr6|86\r
+003136  aa   000011 6054 04   tpnz      9,ic                003147\r
+003137  aa  6 00032 3735 20   epp7      pr6|26,*\r
+003140  aa  7 00002 3715 20   epp5      pr7|2,*\r
+003141  aa  040 004 106 506   cmpc      (pr,ql),(ic),fill(040)\r
+003142  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+003143  aa   000344 00 0001   desc9a    228,1               003505 = 0500000000\r
+\c00\r
+003144  aa   000003 6000 04   tze       3,ic                003147\r
+                                                            STATEMENT 1 ON LINE\r
+\c 503\r
+      end;\r
+\r
+003145  aa  6 00105 0541 00   aos       pr6|69              ip\r
+003146  aa   777766 7100 04   tra       -10,ic              003134\r
+                                                            STATEMENT 1 ON LINE\r
+\c 504\r
+      j = 0;\r
+\r
+003147  aa  6 00101 4501 00   stz       pr6|65              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 505\r
+      do k = ip to num;\r
+\r
+003150  aa  6 00032 3735 20   epp7      pr6|26,*\r
+003151  aa  7 00004 2361 20   ldq       pr7|4,*             num\r
+003152  aa  6 00127 7561 00   stq       pr6|87\r
+003153  aa  6 00105 2361 00   ldq       pr6|69              ip\r
+003154  aa  6 00102 7561 00   stq       pr6|66              k\r
+003155  aa   000000 0110 03   nop       0,du\r
+003156  aa  6 00102 2361 00   ldq       pr6|66              k\r
+003157  aa  6 00127 1161 00   cmpq      pr6|87\r
+003160  aa   000023 6054 04   tpnz      19,ic               003203\r
+                                                            STATEMENT 1 ON LINE\r
+\c 506\r
+         if substr (in, k, 1) = "(" then j = j + 1;\r
+\r
+003161  aa  6 00032 3735 20   epp7      pr6|26,*\r
+003162  aa  7 00002 3715 20   epp5      pr7|2,*\r
+003163  aa  040 004 106 506   cmpc      (pr,ql),(ic),fill(040)\r
+003164  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+003165  aa   000322 00 0001   desc9a    210,1               003505 = 0500000000\r
+\c00\r
+003166  aa   000002 6010 04   tnz       2,ic                003170\r
+003167  aa  6 00101 0541 00   aos       pr6|65              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 507\r
+         if substr (in, k, 1) = ")" then j = j - 1;\r
+\r
+003170  aa  040 004 106 506   cmpc      (pr,ql),(ic),fill(040)\r
+003171  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+003172  aa   000314 00 0001   desc9a    204,1               003504 = 0510000000\r
+\c00\r
+003173  aa   000003 6010 04   tnz       3,ic                003176\r
+003174  aa   000001 3360 07   lcq       1,dl\r
+003175  aa  6 00101 0561 00   asq       pr6|65              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 508\r
+         if j = 0 then go to end_ref;\r
+\r
+003176  aa  6 00101 2361 00   ldq       pr6|65              j\r
+003177  aa   000002 6010 04   tnz       2,ic                003201\r
+003200  aa   000020 7100 04   tra       16,ic               003220\r
+                                                            STATEMENT 1 ON LINE\r
+\c 509\r
+      end;\r
+\r
+003201  aa  6 00102 0541 00   aos       pr6|66              k\r
+003202  aa   777754 7100 04   tra       -20,ic              003156\r
+                                                            STATEMENT 1 ON LINE\r
+\c 510\r
+      msg = "Missing ) after " || wrka;\r
+\r
+003203  aa   000030 2360 07   ldq       24,dl\r
+003204  aa  0 00551 7001 00   tsx0      pr0|361             alloc_char_temp\r
+003205  aa  040 100 100 404   mlr       (ic),(pr),fill(040)\r
+003206  aa   774736 00 0020   desc9a    -1570,16            000143 = 1151511631\r
+\c63\r
+003207  aa  2 00000 00 0020   desc9a    pr2|0,16\r
+003210  aa  040 100 100 500   mlr       (pr),(pr),fill(040)\r
+003211  aa  6 00112 00 0010   desc9a    pr6|74,8            wrka\r
+003212  aa  2 00004 00 0010   desc9a    pr2|4,8\r
+003213  aa  040 100 100 500   mlr       (pr),(pr),fill(040)\r
+003214  aa  2 00000 00 0030   desc9a    pr2|0,24\r
+003215  aa  6 00114 00 0050   desc9a    pr6|76,40           msg\r
+                                                            STATEMENT 1 ON LINE\r
+\c 511\r
+      go to err;\r
+\r
+003216  aa  0 01014 7001 00   tsx0      pr0|524             shorten_stack\r
+003217  aa   000175 7100 04   tra       125,ic              003414\r
+                                                            STATEMENT 1 ON LINE\r
+\c 512\r
+end_ref: call prec_calc (substr (in, ip, k - ip + 2), k - ip + 2, x, code);\r
+\r
+003220  aa  6 00102 2361 00   ldq       pr6|66              k\r
+003221  aa  6 00105 1761 00   sbq       pr6|69              ip\r
+003222  aa   000002 0760 07   adq       2,dl\r
+003223  aa  6 00133 7561 00   stq       pr6|91\r
+003224  aa   524000 2760 03   orq       174080,du\r
+003225  aa  6 00131 7561 00   stq       pr6|89\r
+003226  aa  6 00133 2361 00   ldq       pr6|91\r
+003227  aa  0 00551 7001 00   tsx0      pr0|361             alloc_char_temp\r
+003230  aa  6 00136 2521 00   spri2     pr6|94\r
+003231  aa  6 00105 7271 00   lxl7      pr6|69              ip\r
+003232  aa  040 140 100 557   mlr       (pr,rl,x7),(pr,rl),fill(040)\r
+003233  aa  5 77777 60 0006   desc9a    pr5|-1(3),ql        in\r
+003234  aa  2 00000 00 0006   desc9a    pr2|0,ql\r
+003235  aa  6 00102 2361 00   ldq       pr6|66              k\r
+003236  aa  6 00105 1761 00   sbq       pr6|69              ip\r
+003237  aa   000002 0760 07   adq       2,dl\r
+003240  aa  6 00132 7561 00   stq       pr6|90\r
+003241  aa  6 00132 3521 00   epp2      pr6|90\r
+003242  aa  6 00140 2521 00   spri2     pr6|96\r
+003243  aa  6 00107 3521 00   epp2      pr6|71              x\r
+003244  aa  6 00142 2521 00   spri2     pr6|98\r
+003245  aa  7 00010 3521 20   epp2      pr7|8,*             code\r
+003246  aa  6 00144 2521 00   spri2     pr6|100\r
+003247  aa  6 00131 3521 00   epp2      pr6|89\r
+003250  aa  6 00150 2521 00   spri2     pr6|104\r
+003251  aa   774622 3520 04   epp2      -1646,ic            000073 = 4040000000\r
+\c21\r
+003252  aa  6 00152 2521 00   spri2     pr6|106\r
+003253  aa   774617 3520 04   epp2      -1649,ic            000072 = 4140000000\r
+\c33\r
+003254  aa  6 00154 2521 00   spri2     pr6|108\r
+003255  aa   774614 3520 04   epp2      -1652,ic            000071 = 4040000000\r
+\c43\r
+003256  aa  6 00156 2521 00   spri2     pr6|110\r
+003257  aa   000001 7270 07   lxl7      1,dl\r
+003260  aa  6 00134 6211 00   eax1      pr6|92\r
+003261  aa   020000 4310 07   fld       8192,dl\r
+003262  aa   775714 3520 04   epp2      -1076,ic            001176 = 0002206270\r
+\c00\r
+003263  aa  0 00626 7001 00   tsx0      pr0|406             call_int_other_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 513\r
+      if code ^= 0 then return;\r
+\r
+003264  aa  0 01014 7001 00   tsx0      pr0|524             shorten_stack\r
+003265  aa  6 00032 3735 20   epp7      pr6|26,*\r
+003266  aa  7 00010 2361 20   ldq       pr7|8,*             code\r
+003267  aa  0 00631 6011 00   tnz       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 514\r
+      code = 1;\r
+\r
+003270  aa   000001 2360 07   ldq       1,dl\r
+003271  aa  7 00010 7561 20   stq       pr7|8,*             code\r
+                                                            STATEMENT 1 ON LINE\r
+\c 515\r
+      ip = k + 1;\r
+\r
+003272  aa  6 00102 2361 00   ldq       pr6|66              k\r
+003273  aa   000001 0760 07   adq       1,dl\r
+003274  aa  6 00105 7561 00   stq       pr6|69              ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 516\r
+      s.op (ss) = 0;\r
+\r
+003275  aa  6 00040 3715 20   epp5      pr6|32,*\r
+003276  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+003277  aa   000006 4020 07   mpy       6,dl\r
+003300  aa  5 01031 4501 06   stz       pr5|537,ql          s.op\r
+                                                            STATEMENT 1 ON LINE\r
+\c 517\r
+      s.var (ss) = null;\r
+\r
+003301  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+003302  aa   000006 4020 07   mpy       6,dl\r
+003303  aa   000000 6270 06   eax7      0,ql\r
+003304  aa   774614 2370 04   ldaq      -1652,ic            000120 = 0777770000\r
+\c43 000001000000\r
+003305  aa  5 01034 7571 17   staq      pr5|540,7           s.var\r
+                                                            STATEMENT 1 ON LINE\r
+\c 518\r
+      go to func (i);\r
+\r
+003306  aa  6 00100 7261 00   lxl6      pr6|64              i\r
+003307  ta   000006 7100 16   tra       6,6\r
+                                                            STATEMENT 1 ON LINE\r
+\c 519\r
+func (0):\r
+SIN:  s.value (ss) = sin (x);\r
+\r
+003310  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+003311  aa   000006 4020 07   mpy       6,dl\r
+003312  aa  6 00131 7561 00   stq       pr6|89\r
+003313  aa  6 00107 4311 00   fld       pr6|71              x\r
+003314  aa  6 00134 3521 00   epp2      pr6|92\r
+003315  aa  0 01275 2731 00   tsp3      pr0|701             sine_radians_\r
+003316  aa  6 00131 7271 00   lxl7      pr6|89\r
+003317  aa  6 00040 3735 20   epp7      pr6|32,*\r
+003320  aa  7 01032 4551 17   fst       pr7|538,7           s.value\r
+                                                            STATEMENT 2 ON LINE\r
+\c 520\r
+ go to start;\r
+\r
+003321  aa   775715 7100 04   tra       -1075,ic            001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 521\r
+func (1):\r
+COS:  s.value (ss) = cos (x);\r
+\r
+003322  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+003323  aa   000006 4020 07   mpy       6,dl\r
+003324  aa  6 00131 7561 00   stq       pr6|89\r
+003325  aa  6 00107 4311 00   fld       pr6|71              x\r
+003326  aa  6 00134 3521 00   epp2      pr6|92\r
+003327  aa  0 01277 2731 00   tsp3      pr0|703             cosine_radians_\r
+003330  aa  6 00131 7271 00   lxl7      pr6|89\r
+003331  aa  6 00040 3735 20   epp7      pr6|32,*\r
+003332  aa  7 01032 4551 17   fst       pr7|538,7           s.value\r
+                                                            STATEMENT 2 ON LINE\r
+\c 522\r
+ go to start;\r
+\r
+003333  aa   775703 7100 04   tra       -1085,ic            001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 523\r
+func (2):\r
+TAN:  s.value (ss) = tan (x);\r
+\r
+003334  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+003335  aa   000006 4020 07   mpy       6,dl\r
+003336  aa  6 00131 7561 00   stq       pr6|89\r
+003337  aa  6 00107 4311 00   fld       pr6|71              x\r
+003340  aa  6 00134 3521 00   epp2      pr6|92\r
+003341  aa  0 01301 2731 00   tsp3      pr0|705             tangent_radians_\r
+003342  aa  6 00131 7271 00   lxl7      pr6|89\r
+003343  aa  6 00040 3735 20   epp7      pr6|32,*\r
+003344  aa  7 01032 4551 17   fst       pr7|538,7           s.value\r
+                                                            STATEMENT 2 ON LINE\r
+\c 524\r
+ go to start;\r
+\r
+003345  aa   775671 7100 04   tra       -1095,ic            001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 525\r
+func (3):\r
+ATAN: s.value (ss) = atan (x);\r
+\r
+003346  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+003347  aa   000006 4020 07   mpy       6,dl\r
+003350  aa  6 00131 7561 00   stq       pr6|89\r
+003351  aa  6 00107 4311 00   fld       pr6|71              x\r
+003352  aa  6 00134 3521 00   epp2      pr6|92\r
+003353  aa  0 01307 2731 00   tsp3      pr0|711             arc_tangent_radians\r
+\c_\r
+003354  aa  6 00131 7271 00   lxl7      pr6|89\r
+003355  aa  6 00040 3735 20   epp7      pr6|32,*\r
+003356  aa  7 01032 4551 17   fst       pr7|538,7           s.value\r
+                                                            STATEMENT 2 ON LINE\r
+\c 526\r
+ go to start;\r
+\r
+003357  aa   775657 7100 04   tra       -1105,ic            001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 527\r
+func (4):\r
+ABS:  s.value (ss) = abs (x);\r
+\r
+003360  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+003361  aa   000006 4020 07   mpy       6,dl\r
+003362  aa   000000 6250 06   eax5      0,ql\r
+003363  aa  6 00107 4311 00   fld       pr6|71              x\r
+003364  aa   000002 6050 04   tpl       2,ic                003366\r
+003365  aa   000000 5130 00   fneg      0\r
+003366  aa  5 01032 4551 15   fst       pr5|538,5           s.value\r
+                                                            STATEMENT 2 ON LINE\r
+\c 528\r
+ go to start;\r
+\r
+003367  aa   775647 7100 04   tra       -1113,ic            001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 529\r
+func (5):\r
+LN:   s.value (ss) = log (x);\r
+\r
+003370  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+003371  aa   000006 4020 07   mpy       6,dl\r
+003372  aa  6 00131 7561 00   stq       pr6|89\r
+003373  aa  6 00107 4311 00   fld       pr6|71              x\r
+003374  aa  6 00134 3521 00   epp2      pr6|92\r
+003375  aa  0 01312 2731 00   tsp3      pr0|714             log_base_e_\r
+003376  aa  6 00131 7271 00   lxl7      pr6|89\r
+003377  aa  6 00040 3735 20   epp7      pr6|32,*\r
+003400  aa  7 01032 4551 17   fst       pr7|538,7           s.value\r
+                                                            STATEMENT 2 ON LINE\r
+\c 530\r
+ go to start;\r
+\r
+003401  aa   775635 7100 04   tra       -1123,ic            001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 531\r
+func (6):\r
+LOG:  s.value (ss) = log10 (x);\r
+\r
+003402  aa  5 00111 2361 00   ldq       pr5|73              ss\r
+003403  aa   000006 4020 07   mpy       6,dl\r
+003404  aa  6 00131 7561 00   stq       pr6|89\r
+003405  aa  6 00107 4311 00   fld       pr6|71              x\r
+003406  aa  6 00134 3521 00   epp2      pr6|92\r
+003407  aa  0 01313 2731 00   tsp3      pr0|715             log_base_10_\r
+003410  aa  6 00131 7271 00   lxl7      pr6|89\r
+003411  aa  6 00040 3735 20   epp7      pr6|32,*\r
+003412  aa  7 01032 4551 17   fst       pr7|538,7           s.value\r
+                                                            STATEMENT 2 ON LINE\r
+\c 532\r
+ go to start;\r
+\r
+003413  aa   775623 7100 04   tra       -1133,ic            001236\r
+                                                            STATEMENT 1 ON LINE\r
+\c 534\r
+err:                                                        /* error printout s\r
+\cection */\r
+      if af_sw then do;\r
+\r
+003414  aa  6 00040 3735 20   epp7      pr6|32,*\r
+003415  aa  7 00100 2351 00   lda       pr7|64              af_sw\r
+003416  aa   000034 6000 04   tze       28,ic               003452\r
+                                                            STATEMENT 1 ON LINE\r
+\c 536\r
+         call active_fnc_err_ (0, "calc", "^a", msg);\r
+\r
+003417  aa  6 00131 4501 00   stz       pr6|89\r
+003420  aa   774463 2350 04   lda       -1741,ic            000103 = 1431411541\r
+\c43\r
+003421  aa  6 00132 7551 00   sta       pr6|90\r
+003422  aa   136141 2350 03   lda       48225,du\r
+003423  aa  6 00133 7551 00   sta       pr6|91\r
+003424  aa  6 00131 3521 00   epp2      pr6|89\r
+003425  aa  6 00136 2521 00   spri2     pr6|94\r
+003426  aa  6 00132 3521 00   epp2      pr6|90\r
+003427  aa  6 00140 2521 00   spri2     pr6|96\r
+003430  aa  6 00133 3521 00   epp2      pr6|91\r
+003431  aa  6 00142 2521 00   spri2     pr6|98\r
+003432  aa  6 00114 3521 00   epp2      pr6|76              msg\r
+003433  aa  6 00144 2521 00   spri2     pr6|100\r
+003434  aa   774450 3520 04   epp2      -1752,ic            000104 = 4040000000\r
+\c05\r
+003435  aa  6 00146 2521 00   spri2     pr6|102\r
+003436  aa   774444 3520 04   epp2      -1756,ic            000102 = 5240000000\r
+\c04\r
+003437  aa  6 00150 2521 00   spri2     pr6|104\r
+003440  aa   774430 3520 04   epp2      -1768,ic            000070 = 5240000000\r
+\c02\r
+003441  aa  6 00152 2521 00   spri2     pr6|106\r
+003442  aa   774414 3520 04   epp2      -1780,ic            000056 = 5240000000\r
+\c50\r
+003443  aa  6 00154 2521 00   spri2     pr6|108\r
+003444  aa  6 00134 6211 00   eax1      pr6|92\r
+003445  aa   020000 4310 07   fld       8192,dl\r
+003446  aa  6 00044 3701 20   epp4      pr6|36,*\r
+003447  la  4 00016 3521 20   epp2      pr4|14,*            active_fnc_err_\r
+003450  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 537\r
+      end;\r
+\r
+003451  aa   000024 7100 04   tra       20,ic               003475\r
+                                                            STATEMENT 1 ON LINE\r
+\c 538\r
+      else call ioa_$ioa_switch (iox_$error_output, "^a", msg);\r
+\r
+003452  aa   136141 2350 03   lda       48225,du\r
+003453  aa  6 00133 7551 00   sta       pr6|91\r
+003454  aa  6 00044 3701 20   epp4      pr6|36,*\r
+003455  la  4 00042 3521 20   epp2      pr4|34,*            iox_$error_output\r
+003456  aa  6 00200 2521 00   spri2     pr6|128\r
+003457  aa  6 00133 3521 00   epp2      pr6|91\r
+003460  aa  6 00202 2521 00   spri2     pr6|130\r
+003461  aa  6 00114 3521 00   epp2      pr6|76              msg\r
+003462  aa  6 00204 2521 00   spri2     pr6|132\r
+003463  aa   774403 3520 04   epp2      -1789,ic            000066 = 4640000000\r
+\c00\r
+003464  aa  6 00206 2521 00   spri2     pr6|134\r
+003465  aa   774403 3520 04   epp2      -1789,ic            000070 = 5240000000\r
+\c02\r
+003466  aa  6 00210 2521 00   spri2     pr6|136\r
+003467  aa   774367 3520 04   epp2      -1801,ic            000056 = 5240000000\r
+\c50\r
+003470  aa  6 00212 2521 00   spri2     pr6|138\r
+003471  aa  6 00176 6211 00   eax1      pr6|126\r
+003472  aa   014000 4310 07   fld       6144,dl\r
+003473  la  4 00040 3521 20   epp2      pr4|32,*            ioa_$ioa_switch\r
+003474  aa  0 00622 7001 00   tsx0      pr0|402             call_ext_out_desc\r
+                                                            STATEMENT 1 ON LINE\r
+\c 539\r
+      fv = fv_save;\r
+\r
+003475  aa  6 00040 3735 20   epp7      pr6|32,*\r
+003476  aa  7 00113 2361 00   ldq       pr7|75              fv_save\r
+003477  aa  7 00112 7561 00   stq       pr7|74              fv\r
+                                                            STATEMENT 1 ON LINE\r
+\c 541\r
+      return;\r
+\r
+003500  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 543\r
+   end prec_calc;\r
+\r
+  END PROCEDURE prec_calc\r
+  END PROCEDURE calc\r
+

diff --git a/pl1/calc.pl1 b/pl1/calc.pl1
new file mode 100644 (file)
index 0000000..e01e6fc
--- /dev/null
+++ b/pl1/calc.pl1
@@ -0,0 +1,739 @@
+/****^  ************************************************************\r
+        *                                                          *\r
+        * Copyright, (C) Honeywell Bull Inc., 1989                 *\r
+        *                                                          *\r
+        * Copyright, (C) Honeywell Information Systems Inc., 1982  *\r
+        *                                                          *\r
+        * Copyright, (C) Honeywell Information Systems Inc., 1980. *\r
+        *                                                          *\r
+        ************************************************************ */\r
+\r
+\r
+\r
+\r
+/****^  HISTORY COMMENTS:\r
+  1) change(88-10-19,Lee), approve(88-11-21,MCR8025), audit(88-12-23,Flegel),\r
+     install(89-01-23,MR12.3-1010):\r
+     Commands 421 (phx09588, phx18231) - modified to not set up a pi\r
+     handler if it is being invoked as an active function.\r
+  2) change(88-10-19,Lee), approve(88-11-21,MCR8025), audit(88-12-23,Flegel),\r
+     install(89-01-23,MR12.3-1010):\r
+     Commands 464 (phx10119, phx20071) - modified to complain about\r
+     invalid characters specified in function names.\r
+  3) change(88-10-19,Lee), approve(88-11-21,MCR8025), audit(88-12-23,Flegel),\r
+     install(89-01-23,MR12.3-1010):\r
+     Commands 805 (phx21221) - modified to accept "reasonable" variable\r
+     names and to clean up invalid variables left after an error occurs.\r
+                                                   END HISTORY COMMENTS */\r
+\r
+\r
+/* The calc command provides the user with a calculator capable of evaluatiing \r
+\cPL/I-like expressions */\r
+/* with operator precedence, a set of often used functions, and an addressable-\r
+\cby-identifier memory. */\r
+\r
+/* Changed to work as an active function by S. Herbst 10/07/78 */\r
+/* Handlers added for pi, oveflow, underflow 09/28/79 S. Herbst */\r
+/* . and .. features added 12/12/79 S. Herbst */\r
+/* Red & black shifts removed, "q =" bug fixed 04/14/80 S. Herbst */\r
+/* Fixed not to prompt with a space 01/12/81 S. Herbst */\r
+\r
+/* format: style4,ind3 */\r
+\r
+calc: proc;\r
+\r
+dcl  arg char (arg_len) based (arg_ptr);\r
+dcl  return_string char (return_len) varying based (return_ptr);\r
+\r
+dcl  (af_sw, expr_arg_sw) bit (1) aligned;\r
+\r
+dcl  (arg_ptr, return_ptr) ptr;\r
+\r
+dcl  (arg_count, arg_len, return_len) fixed bin;\r
+\r
+dcl  error_table_$not_act_fnc fixed bin (35) ext;\r
+\r
+dcl  (active_fnc_err_, active_fnc_err_$af_suppress_name) entry options (variabl\r
+\ce);\r
+dcl  (com_err_, com_err_$suppress_name) entry options (variable);\r
+dcl  cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35));\r
+dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));\r
+\r
+\r
+dcl  (calls static internal, ss, fv, fv_save, num) fixed bin (17);\r
+dcl  code fixed bin (35);\r
+dcl  dum float bin (27);\r
+dcl  (sv, iptr, fvp, mp, vp) ptr;\r
+dcl  floatval float bin (27) based (fvp);\r
+dcl  in char (1300) unaligned;\r
+dcl  move char (20) based (mp);\r
+dcl  space (52) ptr;\r
+dcl  error_string char (32);\r
+dcl  out char (32) aligned;\r
+dcl  var_name_chars char (63) static options (constant)     /* for variable/fun\r
+\cction name check */\r
+          init ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789\r
+\c_");\r
+dcl  valid_token_delimiters char (9)                        /* for variable/fun\r
+\cction name delimiter check */\r
+          static options (constant) init (" .()=+-*/");\r
+\r
+dcl  1 in_structure unaligned based (addr (in)),\r
+       2 pad char (2),\r
+       2 in_com char (1298);\r
+\r
+dcl  1 s (0:63) aligned,                                    /* the stack */\r
+       2 type fixed bin (17),\r
+       2 op fixed bin (17),\r
+       2 value float bin (27),\r
+       2 var ptr;\r
+\r
+dcl  1 vars based (vp) aligned,                             /* the list of vari\r
+\cables and values */\r
+       2 next ptr,\r
+       2 d (0:31),\r
+         3 name char (8) aligned,\r
+         3 value float bin (27);\r
+\r
+dcl  ffip entry (ptr, fixed bin (17), fixed bin (17), float bin (27));\r
+dcl  ffop entry (char (32) aligned, fixed bin (17), float bin (27));\r
+dcl  (ioa_, ioa_$ioa_switch) entry options (variable);\r
+dcl  iox_$error_output ptr external;\r
+dcl  iox_$get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35));\r
+dcl  iox_$put_chars entry (ptr, ptr, fixed bin, fixed bin (35));\r
+dcl  iox_$user_output ptr ext;\r
+dcl  iox_$user_input ptr ext;\r
+dcl  cu_$cp entry (ptr, fixed bin, fixed bin (35));\r
+dcl  cu_$grow_stack_frame entry (fixed bin (17), ptr, fixed bin (35));\r
+dcl  (noprt, ileq) bit (1);\r
+dcl  funcs (0:6) char (8) static internal init ("sin", "cos", "tan", "atan", "a\r
+\cbs", "ln", "log");\r
+dcl  (abs, addr, atan, cos, fixed, index, length, log, log10, ltrim) builtin;\r
+dcl  (mod, null, rtrim, sin, substr, tan, verify) builtin;\r
+\r
+dcl  (fixedoverflow, overflow, program_interrupt, underflow) condition;\r
+                                                            /*\014\r
+\c                                         */\r
+\r
+\r
+      call cu_$af_return_arg (arg_count, return_ptr, return_len, code);\r
+      if code = error_table_$not_act_fnc then do;\r
+         if arg_count > 1 then do;\r
+            call com_err_$suppress_name (0, "calc", "Usage:  calc {expression}"\r
+\c);\r
+            return;\r
+         end;\r
+         else if arg_count = 1 then expr_arg_sw = "1"b;\r
+         else expr_arg_sw = "0"b;\r
+         af_sw = "0"b;\r
+      end;\r
+      else do;\r
+         if arg_count = 0 | arg_count > 1 then do;\r
+            call active_fnc_err_$af_suppress_name (0, "calc", "Usage:  [calc ex\r
+\cpression]");\r
+            return;\r
+         end;\r
+         af_sw, expr_arg_sw = "1"b;\r
+      end;\r
+\r
+      vp, sv = addr (space);                                /* initialize vars \r
+\cwith e and pi */\r
+      iptr = addr (in);\r
+      vars.next = null;\r
+      vars.d.name (0) = "pi";\r
+      vars.d.value (0) = 3.14159265e0;\r
+      vars.d.name (1) = "e";\r
+      vars.d.value (1) = 2.7182818e0;\r
+      fv = 2;\r
+\r
+      if ^af_sw then                                        /* phx09588,phx1823\r
+\c1: */\r
+           on program_interrupt go to new_line;             /* set up pi handle\r
+\cr only if not active function */\r
+\r
+      on overflow, fixedoverflow begin;\r
+         error_string = "Overflow";\r
+         go to HANDLE_FAULT;\r
+      end;\r
+      on underflow begin;\r
+         error_string = "Exponent too small";\r
+         go to HANDLE_FAULT;\r
+      end;\r
+\r
+new_line: ss = -1;                                          /* reinitialize var\r
+\ciables */\r
+      calls = 0;\r
+      noprt, ileq = "0"b;\r
+      if fv > 31 then do;\r
+         call cu_$grow_stack_frame (104, vp, code);         /* if vars too big,\r
+\c get more space */\r
+         if code ^= 0 then do;\r
+            call ioa_ ("Fatal out of space");\r
+            return;\r
+         end;\r
+         vars.next = sv;\r
+         sv = vp;\r
+         fv = 0;\r
+      end;\r
+\r
+      if expr_arg_sw then do;\r
+         call cu_$arg_ptr (1, arg_ptr, arg_len, code);\r
+\r
+         begin;\r
+dcl  expr_arg char (arg_len + 1);\r
+\r
+            expr_arg = arg || "\r
+";\r
+            call prec_calc (expr_arg, arg_len + 1, dum, code);\r
+\r
+         end;\r
+\r
+         return;\r
+      end;\r
+\r
+GET_LINE: call iox_$get_line (iox_$user_input, iptr, length (in), num, (0));\r
+\r
+      if num = 1 then go to GET_LINE;                       /* newline */\r
+      else if num = 2 & substr (in, 1, 1) = "." then do;\r
+         call ioa_ ("CALC 1.1");\r
+         go to GET_LINE;\r
+      end;\r
+      else if substr (in, 1, 2) = ".." then do;\r
+         call cu_$cp (addr (in_com), num - 2, code);\r
+         go to GET_LINE;\r
+      end;\r
+\r
+      fv_save = fv;                                         /* phx21221: save t\r
+\co restore on error */\r
+      call prec_calc (in, num, dum, code);\r
+      if code > 1 then return;\r
+      go to new_line;\r
+\r
+\r
+HANDLE_FAULT:\r
+      if af_sw then call active_fnc_err_ (0, "calc", "^a", error_string);\r
+      else call ioa_$ioa_switch (iox_$error_output, "^a", error_string);\r
+      if expr_arg_sw then return;\r
+      else go to new_line;\r
+                                                            /*\014\r
+\c                                         */\r
+/**** ****************************INTERNAL PROC PREC_CALC**********************\r
+\c*************** ****/\r
+\r
+\r
+/* prec_calc does the actual work of the calc command.  It is recursive so func\r
+\ction references may */\r
+/* contain expressions (including other function references). */\r
+\r
+prec_calc: proc (in, num, fval, code);\r
+                                                            /* declarations */\r
+dcl  (i, j, k, num, last, level, ip, strt) fixed bin (17);\r
+dcl  code fixed bin (35);\r
+dcl  (x, fval) float bin (27);\r
+dcl  wrk char (1);\r
+dcl  wrka char (8);\r
+dcl  in char (*);\r
+dcl  msg char (40) aligned;\r
+\r
+      code, ip, last = 1; level = 0;\r
+      calls = calls + 1; ss = ss + 1;\r
+      s.type (ss) = 0;\r
+      s.op (ss) = 1;                                        /* put a start-of-s\r
+\ctack char on s */\r
+      strt = ss - 1;\r
+\r
+start: if s.op (ss) ^= 0 then go to op_red;                 /* if s: <op> */\r
+      i = s.op (ss - 1);\r
+      if i = 0 then do;                                     /* if s: <val> <val\r
+\c>  then error */\r
+miss_op: msg = "Missing operator";\r
+         go to err;\r
+      end;\r
+      if ss - 2 = strt then go to add;                      /* if s: "sos" <val\r
+\c>  then add */\r
+      if s.op (ss - 2) = 0 then go to add;                  /* if s: <val> <op>\r
+\c <val> then add */\r
+      if i ^= 4 then\r
+           if i ^= 5 then do;                               /* if s ^ : <op> "+\r
+\c"|"-" <val>  error */\r
+ill_prefix:   msg = "Invalid prefix operator";\r
+              go to err;\r
+           end;\r
+      go to add;                                            /* syntax is OK so \r
+\cadd to prefix to check prec */\r
+\r
+op_red: i = s.op (ss);\r
+      if i = 1 then go to add;                              /* if s: "sos" then\r
+\c add */\r
+      j = s.op (ss - 1);\r
+      if j ^= 0 then do;                                    /* if s: <op> "-"|"\r
+\c+"  then add */\r
+         if i = 4 then go to add;\r
+         if i = 5 then go to add;\r
+      end;\r
+      if i = 2 then\r
+           if j = 1 then do;                                /* if s: "sos" "eoi\r
+\c"  error */\r
+              if calls = 1 then return;\r
+              else do;\r
+                 msg = "Null expression";\r
+                 go to err;\r
+              end;\r
+           end;\r
+      if i > 2 then\r
+           if j ^= 0 then go to ill_prefix;                 /* error if: <op> ^\r
+\c"eoi" */\r
+      j = s.op (ss - 2);\r
+      if j = 0 then go to miss_op;                          /* error */\r
+      if i = 2 then\r
+           if j = 1 then go to print;                       /* if: "sos" <any> \r
+\c"eoi"  then print */\r
+                                                            /* if op1>op2 then \r
+\cadd, i.e. check precedence */\r
+      if ss - 3 = strt then go to add;                      /* if <val2> is rea\r
+\clly "sos" then add */\r
+      if s.op (ss - 3) ^= 0 then do;                        /* check fo r prefi\r
+\cx op */\r
+         if s.type (ss) > s.type (ss - 2) + 4 then go to add; /* check precdenc\r
+\ce - prefix is very strong */\r
+         if j = 5 then s.value (ss - 1) = -s.value (ss - 1);/* do negation */\r
+         addr (s.type (ss - 2)) -> move = addr (s.type (ss - 1)) -> move; /* mo\r
+\cve over sign */\r
+         addr (s.type (ss - 1)) -> move = addr (s.type (ss)) -> move;\r
+         ss = ss - 1;\r
+         go to start;\r
+      end;\r
+      if s.type (ss) > s.type (ss - 2) then go to add;      /* s is: <val2><op2\r
+\c><val1><op1> */\r
+      j = j - 3;\r
+      go to operator (j);\r
+\r
+operator (0):\r
+ASSIGN: s.var (ss - 3) -> floatval = s.value (ss - 1);      /* do assignment */\r
+      noprt = "1"b;\r
+      go to clean;\r
+operator (1):\r
+ADD:  s.value (ss - 3) = s.value (ss - 3) + s.value (ss - 1); /* do addition */\r
+      go to clean;\r
+operator (2):\r
+SUBTRACT: s.value (ss - 3) = s.value (ss - 3) - s.value (ss - 1); /* do subtrac\r
+\ction */\r
+      go to clean;\r
+operator (3):\r
+MULTIPLY: s.value (ss - 3) = s.value (ss - 3) * s.value (ss - 1); /* do multipl\r
+\cication */\r
+      go to clean;\r
+operator (4):\r
+DIVIDE: if s.value (ss - 1) = 0e0 then do;                  /* division by zero\r
+\c */\r
+         msg = "Divide by zero";\r
+         go to err;\r
+      end;\r
+      s.value (ss - 3) = s.value (ss - 3) / s.value (ss - 1); /* do division */\r
+      go to clean;\r
+operator (5):\r
+EXPONENT: if s.value (ss - 3) < 0e0 then do;                /* ** of neg number\r
+\c */\r
+         if mod (s.value (ss - 1), 1e0) = 0e0 then do;      /* neg to integer p\r
+\cower */\r
+            s.value (ss - 3) = s.value (ss - 3) ** fixed (s.value (ss - 1), 17,\r
+\c 0);\r
+            go to clean;\r
+         end;\r
+         msg = "Neg num ** non-integer";\r
+         go to err;\r
+      end;\r
+      if s.value (ss - 1) = 0e0 then\r
+           if s.value (ss - 3) = 0e0 then do;               /* zero ** zero */\r
+              msg = "Zero ** zero";\r
+              go to err;\r
+           end;\r
+      s.value (ss - 3) = s.value (ss - 3) ** s.value (ss - 1); /* do exponentia\r
+\ction */\r
+\r
+clean: addr (s.type (ss - 2)) -> move = addr (s.type (ss)) -> move; /* remove t\r
+\cop of stack */\r
+      ss = ss - 2;\r
+      go to start;\r
+\r
+print: fval = s.value (ss - 1);\r
+      if calls > 1 then go to no_print;\r
+\r
+      if af_sw then do;\r
+         ip = 1;\r
+         call ffop (out, ip, fval);                         /* convert value to\r
+\c char string */\r
+         return_string = rtrim (ltrim (substr (out, 1, ip - 1)));\r
+         return;\r
+      end;\r
+\r
+      if noprt then go to no_print;\r
+      ip = 5;\r
+      substr (out, 1, 5) = "=   ";                          /* set up output li\r
+\cne */\r
+      call ffop (out, ip, fval);                            /* convert value to\r
+\c char string */\r
+      substr (out, ip, 1) = "\r
+";                                                          /* append NL to out\r
+\cput line */\r
+      call iox_$put_chars (iox_$user_output, addr (out), ip, (0));\r
+no_print: calls = calls - 1;                                /* return to caller\r
+\c */\r
+      code = 0;\r
+      ss = strt;\r
+      return;\r
+\r
+add:  ss = ss + 1;                                          /* put new cell on \r
+\cstack */\r
+      if ss > 63 then do;                                   /* too many tokens \r
+\con stack */\r
+         msg = "Simplify expression";\r
+         go to err;\r
+      end;\r
+blank: if ip >= num then do;                                /* look for end of \r
+\cinput line */\r
+         if level ^= 0 then do;\r
+            msg = "Too few )'s";\r
+            go to err;\r
+         end;\r
+         s.type (ss) = 0;\r
+         s.op (ss) = 2;                                     /* put "eoi" on sta\r
+\cck */\r
+         go to start;\r
+      end;\r
+      wrk = substr (in, ip, 1);\r
+      if wrk ^= " " then go to non_blank;                   /* look for non-bla\r
+\cnk */\r
+incr: ip = ip + 1;\r
+      go to blank;\r
+non_blank:\r
+      i = index ("0123456789.()=+-*/", wrk);\r
+      if i = 0 then go to var_ref;                          /* if not as in ind\r
+\cex, then go to var_ref */\r
+      if i <= 11 then do;\r
+         call ffip (addr (in), num - 1, ip, s.value (ss));  /* if numeric then \r
+\ccall ffip for conversion */\r
+         s.op (ss) = 0;\r
+         ileq = "1"b;\r
+         last = 2;\r
+         go to start;\r
+      end;\r
+      if i = 12 then do;                                    /* if open paren th\r
+\cen up prec level */\r
+         if last ^= 1 then\r
+              if last ^= 3 then do;                         /* error if ( follo\r
+\cws value or ) */\r
+                 msg = "Invalid use of (";\r
+                 go to err;\r
+              end;\r
+         last = 3;\r
+         level = level + 5;\r
+         ileq = "1"b;\r
+         go to incr;\r
+      end;\r
+\r
+      if i = 13 then do;                                    /* if ) check for e\r
+\crror then lower prec level */\r
+         if level = 0 then do;\r
+            msg = "Too many )'s";\r
+            go to err;\r
+         end;\r
+         if last ^= 2 then\r
+              if last ^= 4 then do;                         /* error if ) follo\r
+\cws ( or operator */\r
+                 msg = "Invalid use of )";\r
+                 go to err;\r
+              end;\r
+         last = 4;\r
+         level = level - 5;\r
+         ileq = "1"b;\r
+         go to incr;\r
+      end;\r
+\r
+      if last = 3 then\r
+           if i ^= 15 then\r
+                if i ^= 16 then do;                         /* "(" <op>^="+"|"-\r
+\c" */\r
+                   msg = "Invalid op after (";\r
+                   go to err;\r
+                end;\r
+      last = 1;\r
+      if substr (in, ip, 2) = "**" then do;\r
+         i = 19;                                            /* check for ** */\r
+         ip = ip + 1;\r
+      end;\r
+\r
+      if i = 14 then\r
+           if ileq then do;                                 /* anything but <va\r
+\criable> before "=" is error */\r
+              msg = "Invalid use of =";\r
+              go to err;\r
+           end;\r
+      k = level + 1;\r
+      if i > 18 then k = k + 3;                             /* assign precedenc\r
+\ce level to operator */\r
+      else if i > 16 then k = k + 2;\r
+      else if i > 14 then k = k + 1;\r
+      s.type (ss) = k;\r
+      s.op (ss) = i - 11;\r
+      ileq = "1"b;\r
+      ip = ip + 1;\r
+      go to start;\r
+\r
+var_ref: i = ip;                                            /* save start of va\r
+\cr name */\r
+      last = 2;\r
+      if verify (wrk, var_name_chars) ^= 0 then do;         /* phx10119,20071,2\r
+\c1221: name validity check */\r
+bad_char: msg = "Invalid char " || wrk;\r
+         go to err;\r
+      end;\r
+      go to first;\r
+var_loop: ip = ip + 1;\r
+      wrk = substr (in, ip, 1);\r
+first: if ip < num then do;\r
+         if verify (wrk, var_name_chars) = 0 then           /* phx10119,20071,2\r
+\c1221: name validity check */\r
+              go to var_loop;                               /* find end of name\r
+\c */\r
+\r
+         if verify (wrk, valid_token_delimiters) ^= 0 then  /* check for invali\r
+\cd */\r
+              go to bad_char;                               /* char after name \r
+\c*/\r
+      end;\r
+\r
+      wrka = substr (in, i, ip - i);                        /* wrka is var name\r
+\c */\r
+\r
+      if expr_arg_sw then do;\r
+         do i = 0 to 6;\r
+            if wrka = funcs (i) then go to func_ref;\r
+         end;\r
+         if af_sw then call active_fnc_err_ (0, "calc", "Variables not allowed \r
+\cin expression argument.");\r
+         else call com_err_ (0, "calc", "Variables not allowed in expression ar\r
+\cgument.");\r
+         return;\r
+      end;\r
+\r
+      vp = sv;\r
+      k = fv - 1;\r
+next_v: do j = k to 0 by -1;                                /* search vars for \r
+\cwrka */\r
+         if wrka = vars.d.name (j) then go to found;\r
+      end;\r
+      vp = vars.next;                                       /* chain to next bl\r
+\cock of vars */\r
+      k = 31;\r
+      if vp ^= null then go to next_v;                      /* if null then nam\r
+\ce is undefined */\r
+      if wrka = "q" then do;                                /* a name of "q" is\r
+\c a quit so return  with quit code */\r
+         if num > 2 then do;                                /* other chars on t\r
+\che line */\r
+            msg = "Invalid var q";\r
+            go to err;\r
+         end;\r
+         code = 2;\r
+         return;\r
+      end;\r
+      if wrka = "list" then do;                             /* a name of "list"\r
+\c means list all vars */\r
+         wrk = "\r
+";                                                          /* set wrk = NL */\r
+         call iox_$put_chars (iox_$user_output, addr (wrk), 1, (0)); /* print a\r
+\c NL */\r
+         vp = sv;\r
+         k = fv - 1;\r
+another: do j = k to 0 by -1;                               /* go through vars \r
+\cprinting out values and names */\r
+            substr (out, 1, 8) = vars.d.name (j);\r
+            substr (out, 9, 4) = " =  ";\r
+            ip = 13;\r
+            call ffop (out, ip, vars.d.value (j));          /* call ffop to con\r
+\cvert value to char string */\r
+            substr (out, ip, 1) = "\r
+";                                                          /* insert NL */\r
+            call iox_$put_chars (iox_$user_output, addr (out), ip, (0));\r
+         end;\r
+         vp = vars.next;\r
+         k = 31;\r
+         if vp ^= null then go to another;\r
+         call ioa_ (" ");\r
+         return;\r
+      end;\r
+      do i = 0 to 6;                                        /* see if var name \r
+\cis func name */\r
+         if wrka = funcs (i) then go to func_ref;\r
+      end;\r
+      if ileq then do;                                      /* since not comman\r
+\cd or func then undef var */\r
+                                                            /* so invalid if no\r
+\ct first in line */\r
+         msg = "Undef var " || wrka;\r
+         go to err;\r
+      end;\r
+      vp = sv;\r
+      j = fv;\r
+      fv = fv + 1;                                          /* define var */\r
+      vars.d.name (j) = wrka;\r
+      vars.d.value (j) = 0e0;\r
+found: s.op (ss) = 0;\r
+      s.value (ss) = vars.d.value (j);                      /* put <val> on sta\r
+\cck */\r
+      s.var (ss) = addr (vars.d.value (j));\r
+      go to start;\r
+\r
+func_ref: do ip = ip to num while (substr (in, ip, 1) ^= "("); /* find open par\r
+\cen */\r
+      end;\r
+      j = 0;\r
+      do k = ip to num;                                     /* find close paren\r
+\c */\r
+         if substr (in, k, 1) = "(" then j = j + 1;\r
+         if substr (in, k, 1) = ")" then j = j - 1;\r
+         if j = 0 then go to end_ref;\r
+      end;\r
+      msg = "Missing ) after " || wrka;\r
+      go to err;\r
+end_ref: call prec_calc (substr (in, ip, k - ip + 2), k - ip + 2, x, code);\r
+      if code ^= 0 then return;\r
+      code = 1;\r
+      ip = k + 1;\r
+      s.op (ss) = 0;\r
+      s.var (ss) = null;\r
+      go to func (i);\r
+func (0):\r
+SIN:  s.value (ss) = sin (x); go to start;\r
+func (1):\r
+COS:  s.value (ss) = cos (x); go to start;\r
+func (2):\r
+TAN:  s.value (ss) = tan (x); go to start;\r
+func (3):\r
+ATAN: s.value (ss) = atan (x); go to start;\r
+func (4):\r
+ABS:  s.value (ss) = abs (x); go to start;\r
+func (5):\r
+LN:   s.value (ss) = log (x); go to start;\r
+func (6):\r
+LOG:  s.value (ss) = log10 (x); go to start;\r
+\r
+err:                                                        /* error printout s\r
+\cection */\r
+      if af_sw then do;\r
+         call active_fnc_err_ (0, "calc", "^a", msg);\r
+      end;\r
+      else call ioa_$ioa_switch (iox_$error_output, "^a", msg);\r
+      fv = fv_save;                                         /* phx21221 - clean\r
+\c up invalid variables on error */\r
+\r
+      return;\r
+\r
+   end prec_calc;\r
+\r
+/**** *****************************************END INTERNAL PROC PREC_CALC*****\r
+\c***************************** ****/\r
+\r
+\r
+   end calc;\r
+\r
+\r
+r 00:27 5.572 6\r
+\r
+prf\b \b ffip.pl1\r
+\r
+                    ffip.pl1  10/07/19  0027.7 pst Mon\r
+\r
+\r
+/* ***********************************************************\r
+   *                                                         *\r
+   * Copyright, (C) Honeywell Information Systems Inc., 1982 *\r
+   *                                                         *\r
+   * Copyright (c) 1972 by Massachusetts Institute of        *\r
+   * Technology and Honeywell Information Systems, Inc.      *\r
+   *                                                         *\r
+   *********************************************************** */\r
+\r
+\r
+ffip:     proc(inp, len, ip, ret_value);\r
+/* ffip converts a free format inputted string into a bin float number */\r
+dcl\r
+          (len, code, ip, ex, j, llen) fixed bin(17),\r
+          (val_mult, new_div, ret_value) float bin(27),\r
+          (pos, e_pos, frac) bit(1),\r
+          in char(llen) based(inp1) unaligned,\r
+          (inp, inp1) ptr,\r
+          wrk char(1) aligned,\r
+          (value, new) float bin(63),\r
+          ten float bin(27) static init(10e0);\r
+\r
+          code = 5000;\r
+          llen = len;\r
+          inp1 = inp;\r
+blank:    if ip>len then do;\r
+                    code = 5001;\r
+                    return;\r
+                    end;\r
+          if substr(in,ip,1)^=" " then go to non_blank;\r
+          ip = ip+1;\r
+          go to blank;\r
+\r
+non_blank:          pos = "1"b; frac = "0"b; val_mult = ten; new_div = 1.e0; va\r
+\clue = 0.e0;\r
+          wrk = substr(in,ip,1);\r
+          if wrk="+" then go to plus;\r
+          if wrk^="-" then go to no_sign;\r
+                    pos = "0"b;\r
+           plus:ip = ip+1;\r
+                    if ip>len then return;\r
+                    wrk = substr(in,ip,1);\r
+no_sign: next:\r
+          new = index("0123456789", wrk)-1;\r
+          if new<0e0 then go to not_num;\r
+          code = 0;\r
+          if frac then do;\r
+                    new_div = new_div*ten;\r
+                    new = new / new_div;\r
+                    end;\r
+          value = val_mult*value+new;\r
+          ip = ip+1;\r
+          if ip>len then go to fin;\r
+          wrk = substr(in,ip,1);\r
+          go to next;\r
+not_num:  if wrk="." then do;\r
+                    if frac then go to fin;\r
+                    frac = "1"b;\r
+                    ip = ip+1;\r
+                    if ip>len then go to fin;\r
+                    wrk = substr(in,ip,1);\r
+                    val_mult = 1.e0;\r
+                    go to next;\r
+                    end;\r
+          if wrk^="e" then\r
+             if wrk^="E" then go to fin;\r
+          e_pos = "1"b; ex = 0;\r
+          ip = ip+1;\r
+          if ip>len then go to fin;\r
+          wrk = substr(in,ip,1);\r
+          if wrk="+" then go to e_plus;\r
+          if wrk^="-" then go to e_no_sign;\r
+                    e_pos = "0"b;\r
+           e_plus:ip = ip+1;\r
+                    if ip>len then go to fin;\r
+                    wrk = substr(in,ip,1);\r
+e_no_sign: e_next:\r
+          j = index("0123456789",wrk)-1;\r
+          if j<0 then go to e_fin;\r
+          ex = ten*ex+j;\r
+          ip = ip+1;\r
+          if ip>len then go to e_fin;\r
+          wrk = substr(in,ip,1);\r
+go to e_next;\r
+e_fin:    if ^e_pos then ex = -ex;\r
+          value = value*10.e0**ex;\r
+fin:      if ^pos then value= - value;\r
+          ret_value = value;\r
+          return;\r
+          end;\r
+

diff --git a/pl1/ffip.list b/pl1/ffip.list
new file mode 100644 (file)
index 0000000..3197a72
--- /dev/null
+++ b/pl1/ffip.list
@@ -0,0 +1,763 @@
+          COMPILATION LISTING OF SEGMENT ffip\r
+          Compiled by: Multics PL/I Compiler, Release 33f, of February 11, 2017\r
+          Compiled at: Installation and location\r
+          Compiled on: 10/06/19  0218.3 pst Sun\r
+              Options: table list\r
+\r
+        1 /* ***********************************************************\r
+        2*   *                                                         *\r
+        3*   * Copyright, (C) Honeywell Information Systems Inc., 1982 *\r
+        4*   *                                                         *\r
+        5*   * Copyright (c) 1972 by Massachusetts Institute of        *\r
+        6*   * Technology and Honeywell Information Systems, Inc.      *\r
+        7*   *                                                         *\r
+        8*   *********************************************************** */\r
+        9\r
+       10\r
+       11 ffip:     proc(inp, len, ip, ret_value);\r
+       12 /* ffip converts a free format inputted string into a bin float numbe\r
+\cr */\r
+       13 dcl\r
+       14           (len, code, ip, ex, j, llen) fixed bin(17),\r
+       15           (val_mult, new_div, ret_value) float bin(27),\r
+       16           (pos, e_pos, frac) bit(1),\r
+       17           in char(llen) based(inp1) unaligned,\r
+       18           (inp, inp1) ptr,\r
+       19           wrk char(1) aligned,\r
+       20           (value, new) float bin(63),\r
+       21           ten float bin(27) static init(10e0);\r
+       22\r
+       23           code = 5000;\r
+       24           llen = len;\r
+       25           inp1 = inp;\r
+       26 blank:    if ip>len then do;\r
+       27                     code = 5001;\r
+       28                     return;\r
+       29                     end;\r
+       30           if substr(in,ip,1)^=" " then go to non_blank;\r
+       31           ip = ip+1;\r
+       32           go to blank;\r
+       33\r
+       34 non_blank:          pos = "1"b; frac = "0"b; val_mult = ten; new_div \r
+\c= 1.e0; value = 0.e0;\r
+       35           wrk = substr(in,ip,1);\r
+       36           if wrk="+" then go to plus;\r
+       37           if wrk^="-" then go to no_sign;\r
+       38                     pos = "0"b;\r
+       39            plus:ip = ip+1;\r
+       40                     if ip>len then return;\r
+       41                     wrk = substr(in,ip,1);\r
+       42 no_sign: next:\r
+       43           new = index("0123456789", wrk)-1;\r
+       44           if new<0e0 then go to not_num;\r
+       45           code = 0;\r
+       46           if frac then do;\r
+       47                     new_div = new_div*ten;\r
+       48                     new = new / new_div;\r
+       49                     end;\r
+       50           value = val_mult*value+new;\r
+       51           ip = ip+1;\r
+       52           if ip>len then go to fin;\r
+       53           wrk = substr(in,ip,1);\r
+       54           go to next;\r
+       55 not_num:  if wrk="." then do;\r
+       56                     if frac then go to fin;\r
+       57                     frac = "1"b;\r
+       58                     ip = ip+1;\r
+       59                     if ip>len then go to fin;\r
+       60                     wrk = substr(in,ip,1);\r
+       61                     val_mult = 1.e0;\r
+       62                     go to next;\r
+       63                     end;\r
+       64           if wrk^="e" then\r
+       65              if wrk^="E" then go to fin;\r
+       66           e_pos = "1"b; ex = 0;\r
+       67           ip = ip+1;\r
+       68           if ip>len then go to fin;\r
+       69           wrk = substr(in,ip,1);\r
+       70           if wrk="+" then go to e_plus;\r
+       71           if wrk^="-" then go to e_no_sign;\r
+       72                     e_pos = "0"b;\r
+       73            e_plus:ip = ip+1;\r
+       74                     if ip>len then go to fin;\r
+       75                     wrk = substr(in,ip,1);\r
+       76 e_no_sign: e_next:\r
+       77           j = index("0123456789",wrk)-1;\r
+       78           if j<0 then go to e_fin;\r
+       79           ex = ten*ex+j;\r
+       80           ip = ip+1;\r
+       81           if ip>len then go to e_fin;\r
+       82           wrk = substr(in,ip,1);\r
+       83 go to e_next;\r
+       84 e_fin:    if ^e_pos then ex = -ex;\r
+       85           value = value*10.e0**ex;\r
+       86 fin:      if ^pos then value= - value;\r
+       87           ret_value = value;\r
+       88           return;\r
+       89           end;\r
+\014      SOURCE FILES USED IN THIS COMPILATION.\r
+\r
+LINE      NUMBER  DATE MODIFIED     NAME                              PATHNAME\r
+             0    10/06/19  0216.6  ffip.pl1                          >user_dir\r
+\c_dir>SysAdmin>Repair>ffip.pl1\r
+\014      NAMES DECLARED IN THIS COMPILATION.\r
+\r
+IDENTIFIER               OFFSET    LOC STORAGE CLASS   DATA TYPE\r
+\c ATTRIBUTES AND REFERENCES\r
+\r
+\c (* indicates a set context)\r
+\r
+NAMES DECLARED BY DECLARE STATEMENT.\r
+code                            000100 automatic       fixed bin(17,0)\r
+\c dcl 13 set ref 23* 27* 45*\r
+e_pos                           000107 automatic       bit(1)\r
+\c packed unaligned dcl 13 set ref 66* 72* 84\r
+ex                              000101 automatic       fixed bin(17,0)\r
+\c dcl 13 set ref 66* 79* 79 84* 84 85\r
+frac                            000110 automatic       bit(1)\r
+\c packed unaligned dcl 13 set ref 34* 46 56 57*\r
+in                                     based           char\r
+\c packed unaligned dcl 13 ref 30 35 41 53 60 69 75 82\r
+inp                                    parameter       pointer\r
+\c dcl 13 ref 11 25\r
+inp1                            000112 automatic       pointer\r
+\c dcl 13 set ref 13 25* 30 35 41 53 60 69 75 82\r
+ip                                     parameter       fixed bin(17,0)\r
+\c dcl 13 set ref 11 26 30 31* 31 35 39* 39 40 41 51*\r
+\r
+\c   51 52 53 58* 58 59 60 67* 67 68 69 73* 73 74 75\r
+\r
+\c   80* 80 81 82\r
+j                               000102 automatic       fixed bin(17,0)\r
+\c dcl 13 set ref 76* 78 79\r
+len                                    parameter       fixed bin(17,0)\r
+\c dcl 13 ref 11 24 26 40 52 59 68 74 81\r
+llen                            000103 automatic       fixed bin(17,0)\r
+\c dcl 13 set ref 13 24* 30 35 41 53 60 69 75 82\r
+new                             000120 automatic       float bin(63)\r
+\c dcl 13 set ref 42* 44 48* 48 50\r
+new_div                         000105 automatic       float bin(27)\r
+\c dcl 13 set ref 34* 47* 47 48\r
+pos                             000106 automatic       bit(1)\r
+\c packed unaligned dcl 13 set ref 34* 38* 86\r
+ret_value                              parameter       float bin(27)\r
+\c dcl 13 set ref 11 87*\r
+ten                             000000 constant        float bin(27)\r
+\c initial dcl 13 ref 34 47 79\r
+val_mult                        000104 automatic       float bin(27)\r
+\c dcl 13 set ref 34* 50 61*\r
+value                           000116 automatic       float bin(63)\r
+\c dcl 13 set ref 34* 50* 50 85* 85 86* 86 87\r
+wrk                             000114 automatic       char(1)\r
+\c dcl 13 set ref 35* 36 37 41* 42 53* 55 60* 64 64 69*\r
+\r
+\c   70 71 75* 76 82*\r
+\r
+NAMES DECLARED BY EXPLICIT CONTEXT.\r
+blank                           000035 constant        label\r
+\c dcl 26 ref 32\r
+e_fin                           000314 constant        label\r
+\c dcl 84 ref 78 81\r
+e_next                          000255 constant        label\r
+\c dcl 76 ref 83\r
+e_no_sign                       000255 constant        label\r
+\c dcl 76 ref 71\r
+e_plus                          000243 constant        label\r
+\c dcl 73 ref 70\r
+ffip                            000020 constant        entry\r
+\c external dcl 11\r
+fin                             000351 constant        label\r
+\c dcl 86 ref 52 56 59 64 68 74\r
+next                            000114 constant        label\r
+\c dcl 42 ref 54 62\r
+no_sign                         000114 constant        label\r
+\c dcl 42 ref 37\r
+non_blank                       000055 constant        label\r
+\c dcl 34 ref 30\r
+not_num                         000160 constant        label\r
+\c dcl 55 ref 44\r
+plus                            000103 constant        label\r
+\c dcl 39 ref 36\r
+\r
+NAMES DECLARED BY CONTEXT OR IMPLICATION.\r
+index                                                  builtin function\r
+\c ref 42 76\r
+substr                                                 builtin function\r
+\c ref 30 35 41 53 60 69 75 82\r
+\r
+STORAGE REQUIREMENTS FOR THIS PROGRAM.\r
+\r
+          Object    Text      Link      Symbol    Defs      Static\r
+Start          0       0       420         434     363         430\r
+Length      1420     363        14         750      35           0\r
+\r
+BLOCK NAME                   STACK SIZE     TYPE            WHY NONQUICK/WHO SH\r
+\cARES STACK FRAME\r
+ffip                                154 external procedure  is an external proc\r
+\cedure.\r
+\r
+STORAGE FOR AUTOMATIC VARIABLES.\r
+\r
+STACK FRAME                 LOC IDENTIFIER                  BLOCK NAME\r
+ffip                     000100 code                        ffip\r
+                         000101 ex                          ffip\r
+                         000102 j                           ffip\r
+                         000103 llen                        ffip\r
+                         000104 val_mult                    ffip\r
+                         000105 new_div                     ffip\r
+                         000106 pos                         ffip\r
+                         000107 e_pos                       ffip\r
+                         000110 frac                        ffip\r
+                         000112 inp1                        ffip\r
+                         000114 wrk                         ffip\r
+                         000116 value                       ffip\r
+                         000120 new                         ffip\r
+\r
+THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM.\r
+fx1_to_fl2          call_ext_out        return_mac          fl2_to_fx1\r
+\c ext_entry           real_to_real_round_\r
+\r
+THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM.\r
+decimal_exp_\r
+\r
+NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM.\r
+\r
+\r
+\014CONSTANTS\r
+000000  aa     010500000000\r
+\r
+000001  aa     053061060000\r
+\r
+000362  aa  040 000 000 000\r
+\r
+000002  aa     464000000000\r
+\r
+000003  aa     414000000033\r
+\r
+000004  aa     404000000021\r
+\r
+000006  aa     400000000000\r
+000007  aa     000000000000\r
+\r
+000010  aa  060 061 062 063   0123\r
+000011  aa  064 065 066 067   4567\r
+000012  aa  070 071 000 000   89\r
+\r
+BEGIN PROCEDURE ffip\r
+ENTRY TO ffip                                               STATEMENT 1 ON LINE\r
+\c 11\r
+ffip:     proc(inp, len, ip, ret_value);\r
+\r
+000013  at     000004000002\r
+000014  tt     000004000004\r
+000015  ta     000003000000\r
+000016  ta     000013000000\r
+000017  da     000031300000\r
+000020  aa   000240 6270 00   eax7      160\r
+000021  aa  7 00034 3521 20   epp2      pr7|28,*\r
+000022  aa  2 01045 2721 00   tsp2      pr2|549             ext_entry\r
+000023  aa     000010000000\r
+000024  2s     000010000125\r
+                                                            STATEMENT 1 ON LINE\r
+\c 23\r
+          code = 5000;\r
+\r
+000025  aa   011610 2360 07   ldq       5000,dl\r
+000026  aa  6 00100 7561 00   stq       pr6|64              code\r
+                                                            STATEMENT 1 ON LINE\r
+\c 24\r
+          llen = len;\r
+\r
+000027  aa  6 00032 3735 20   epp7      pr6|26,*\r
+000030  aa  7 00004 2361 20   ldq       pr7|4,*             len\r
+000031  aa  6 00103 7561 00   stq       pr6|67              llen\r
+                                                            STATEMENT 1 ON LINE\r
+\c 25\r
+          inp1 = inp;\r
+\r
+000032  aa  7 00002 3715 20   epp5      pr7|2,*             inp\r
+000033  aa  5 00000 3715 20   epp5      pr5|0,*             inp\r
+000034  aa  6 00112 6515 00   spri5     pr6|74              inp1\r
+                                                            STATEMENT 1 ON LINE\r
+\c 26\r
+blank:    if ip>len then do;\r
+\r
+000035  aa  6 00032 3735 20   epp7      pr6|26,*\r
+000036  aa  7 00006 2361 20   ldq       pr7|6,*             ip\r
+000037  aa  7 00004 1161 20   cmpq      pr7|4,*             len\r
+000040  aa   000004 6044 04   tmoz      4,ic                000044\r
+                                                            STATEMENT 1 ON LINE\r
+\c 27\r
+                    code = 5001;\r
+\r
+000041  aa   011611 2360 07   ldq       5001,dl\r
+000042  aa  6 00100 7561 00   stq       pr6|64              code\r
+                                                            STATEMENT 1 ON LINE\r
+\c 28\r
+                    return;\r
+\r
+000043  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 29\r
+                    end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 30\r
+          if substr(in,ip,1)^=" " then go to non_blank;\r
+\r
+000044  aa  7 00006 7271 20   lxl7      pr7|6,*             ip\r
+000045  aa  6 00112 3715 20   epp5      pr6|74,*            inp1\r
+000046  aa  040 004 106 517   cmpc      (pr,x7),(ic),fill(040)\r
+000047  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+000050  aa   000314 00 0001   desc9a    204,1               000362 = 0400000000\r
+\c00\r
+000051  aa   000002 6000 04   tze       2,ic                000053\r
+000052  aa   000003 7100 04   tra       3,ic                000055\r
+                                                            STATEMENT 1 ON LINE\r
+\c 31\r
+          ip = ip+1;\r
+\r
+000053  aa  7 00006 0541 20   aos       pr7|6,*             ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 32\r
+          go to blank;\r
+\r
+000054  aa   777761 7100 04   tra       -15,ic              000035\r
+                                                            STATEMENT 1 ON LINE\r
+\c 34\r
+non_blank:          pos = "1"b;\r
+\r
+000055  aa   400000 2350 03   lda       131072,du\r
+000056  aa  6 00106 7551 00   sta       pr6|70              pos\r
+                                                            STATEMENT 2 ON LINE\r
+\c 34\r
+ frac = "0"b;\r
+\r
+000057  aa  6 00110 4501 00   stz       pr6|72              frac\r
+                                                            STATEMENT 3 ON LINE\r
+\c 34\r
+ val_mult = ten;\r
+\r
+000060  aa   010500 4310 03   fld       4416,du\r
+000061  aa  6 00104 4551 00   fst       pr6|68              val_mult\r
+                                                            STATEMENT 4 ON LINE\r
+\c 34\r
+ new_div = 1.e0;\r
+\r
+000062  aa   002400 4310 03   fld       1280,du\r
+000063  aa  6 00105 4551 00   fst       pr6|69              new_div\r
+                                                            STATEMENT 5 ON LINE\r
+\c 34\r
+ value = 0.e0;\r
+\r
+000064  aa   777722 4330 04   dfld      -46,ic              000006 = 4000000000\r
+\c00 000000000000\r
+000065  aa  6 00116 4571 00   dfst      pr6|78              value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 35\r
+          wrk = substr(in,ip,1);\r
+\r
+000066  aa  6 00114 4501 00   stz       pr6|76              wrk\r
+000067  aa  7 00006 7261 20   lxl6      pr7|6,*             ip\r
+000070  aa  040 100 100 516   mlr       (pr,x6),(pr),fill(040)\r
+000071  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+000072  aa  6 00114 00 0001   desc9a    pr6|76,1            wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 36\r
+          if wrk="+" then go to plus;\r
+\r
+000073  aa  6 00114 2351 00   lda       pr6|76              wrk\r
+000074  aa   053000 1150 03   cmpa      22016,du\r
+000075  aa   000002 6010 04   tnz       2,ic                000077\r
+000076  aa   000005 7100 04   tra       5,ic                000103\r
+                                                            STATEMENT 1 ON LINE\r
+\c 37\r
+          if wrk^="-" then go to no_sign;\r
+\r
+000077  aa   055000 1150 03   cmpa      23040,du\r
+000100  aa   000002 6000 04   tze       2,ic                000102\r
+000101  aa   000013 7100 04   tra       11,ic               000114\r
+                                                            STATEMENT 1 ON LINE\r
+\c 38\r
+                    pos = "0"b;\r
+\r
+000102  aa  6 00106 4501 00   stz       pr6|70              pos\r
+                                                            STATEMENT 1 ON LINE\r
+\c 39\r
+           plus:ip = ip+1;\r
+\r
+000103  aa  7 00006 0541 20   aos       pr7|6,*             ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 40\r
+                    if ip>len then return;\r
+\r
+000104  aa  7 00006 2361 20   ldq       pr7|6,*             ip\r
+000105  aa  7 00004 1161 20   cmpq      pr7|4,*             len\r
+000106  aa  0 00631 6055 00   tpnz      pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 41\r
+                    wrk = substr(in,ip,1);\r
+\r
+000107  aa  6 00114 4501 00   stz       pr6|76              wrk\r
+000110  aa  7 00006 7251 20   lxl5      pr7|6,*             ip\r
+000111  aa  040 100 100 515   mlr       (pr,x5),(pr),fill(040)\r
+000112  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+000113  aa  6 00114 00 0001   desc9a    pr6|76,1            wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 42\r
+no_sign: next:\r
+          new = index("0123456789", wrk)-1;\r
+\r
+000114  aa  000 100 124 404   scm       (ic),(pr),mask(000)\r
+000115  aa   777674 00 0012   desc9a    -68,10              000010 = 0600610620\r
+\c63\r
+000116  aa  6 00114 00 0001   desc9a    pr6|76,1            wrk\r
+000117  aa  6 00056 0001 00   arg       pr6|46\r
+000120  aa  6 00056 2361 00   ldq       pr6|46\r
+000121  aa   000002 6070 04   ttf       2,ic                000123\r
+000122  aa   000001 3360 07   lcq       1,dl\r
+000123  aa  0 00465 7001 00   tsx0      pr0|309             fx1_to_fl2\r
+000124  aa  6 00120 4571 00   dfst      pr6|80              new\r
+                                                            STATEMENT 1 ON LINE\r
+\c 44\r
+          if new<0e0 then go to not_num;\r
+\r
+000125  aa   000002 6050 04   tpl       2,ic                000127\r
+000126  aa   000032 7100 04   tra       26,ic               000160\r
+                                                            STATEMENT 1 ON LINE\r
+\c 45\r
+          code = 0;\r
+\r
+000127  aa  6 00100 4501 00   stz       pr6|64              code\r
+                                                            STATEMENT 1 ON LINE\r
+\c 46\r
+          if frac then do;\r
+\r
+000130  aa  6 00110 2351 00   lda       pr6|72              frac\r
+000131  aa   000006 6000 04   tze       6,ic                000137\r
+                                                            STATEMENT 1 ON LINE\r
+\c 47\r
+                    new_div = new_div*ten;\r
+\r
+000132  aa  6 00105 4311 00   fld       pr6|69              new_div\r
+000133  aa   010500 4610 03   fmp       4416,du\r
+000134  aa  6 00105 4551 00   fst       pr6|69              new_div\r
+                                                            STATEMENT 1 ON LINE\r
+\c 48\r
+                    new = new / new_div;\r
+\r
+000135  aa  6 00120 5271 00   dfdi      pr6|80              new\r
+000136  aa  6 00120 4571 00   dfst      pr6|80              new\r
+                                                            STATEMENT 1 ON LINE\r
+\c 49\r
+                    end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 50\r
+          value = val_mult*value+new;\r
+\r
+000137  aa  6 00104 4311 00   fld       pr6|68              val_mult\r
+000140  aa  6 00116 4631 00   dfmp      pr6|78              value\r
+000141  aa  6 00120 4771 00   dfad      pr6|80              new\r
+000142  aa  6 00116 4571 00   dfst      pr6|78              value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 51\r
+          ip = ip+1;\r
+\r
+000143  aa  6 00032 3735 20   epp7      pr6|26,*\r
+000144  aa  7 00006 0541 20   aos       pr7|6,*             ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 52\r
+          if ip>len then go to fin;\r
+\r
+000145  aa  7 00006 2361 20   ldq       pr7|6,*             ip\r
+000146  aa  7 00004 1161 20   cmpq      pr7|4,*             len\r
+000147  aa   000002 6044 04   tmoz      2,ic                000151\r
+000150  aa   000201 7100 04   tra       129,ic              000351\r
+                                                            STATEMENT 1 ON LINE\r
+\c 53\r
+          wrk = substr(in,ip,1);\r
+\r
+000151  aa  6 00114 4501 00   stz       pr6|76              wrk\r
+000152  aa  7 00006 7271 20   lxl7      pr7|6,*             ip\r
+000153  aa  6 00112 3715 20   epp5      pr6|74,*            inp1\r
+000154  aa  040 100 100 517   mlr       (pr,x7),(pr),fill(040)\r
+000155  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+000156  aa  6 00114 00 0001   desc9a    pr6|76,1            wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 54\r
+          go to next;\r
+\r
+000157  aa   777735 7100 04   tra       -35,ic              000114\r
+                                                            STATEMENT 1 ON LINE\r
+\c 55\r
+not_num:  if wrk="." then do;\r
+\r
+000160  aa  6 00114 2351 00   lda       pr6|76              wrk\r
+000161  aa   056000 1150 03   cmpa      23552,du\r
+000162  aa   000025 6010 04   tnz       21,ic               000207\r
+                                                            STATEMENT 1 ON LINE\r
+\c 56\r
+                    if frac then go to fin;\r
+\r
+000163  aa  6 00110 2351 00   lda       pr6|72              frac\r
+000164  aa   000002 6000 04   tze       2,ic                000166\r
+000165  aa   000164 7100 04   tra       116,ic              000351\r
+                                                            STATEMENT 1 ON LINE\r
+\c 57\r
+                    frac = "1"b;\r
+\r
+000166  aa   400000 2350 03   lda       131072,du\r
+000167  aa  6 00110 7551 00   sta       pr6|72              frac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 58\r
+                    ip = ip+1;\r
+\r
+000170  aa  6 00032 3735 20   epp7      pr6|26,*\r
+000171  aa  7 00006 0541 20   aos       pr7|6,*             ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 59\r
+                    if ip>len then go to fin;\r
+\r
+000172  aa  7 00006 2361 20   ldq       pr7|6,*             ip\r
+000173  aa  7 00004 1161 20   cmpq      pr7|4,*             len\r
+000174  aa   000002 6044 04   tmoz      2,ic                000176\r
+000175  aa   000154 7100 04   tra       108,ic              000351\r
+                                                            STATEMENT 1 ON LINE\r
+\c 60\r
+                    wrk = substr(in,ip,1);\r
+\r
+000176  aa  6 00114 4501 00   stz       pr6|76              wrk\r
+000177  aa  7 00006 7271 20   lxl7      pr7|6,*             ip\r
+000200  aa  6 00112 3715 20   epp5      pr6|74,*            inp1\r
+000201  aa  040 100 100 517   mlr       (pr,x7),(pr),fill(040)\r
+000202  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+000203  aa  6 00114 00 0001   desc9a    pr6|76,1            wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 61\r
+                    val_mult = 1.e0;\r
+\r
+000204  aa   002400 4310 03   fld       1280,du\r
+000205  aa  6 00104 4551 00   fst       pr6|68              val_mult\r
+                                                            STATEMENT 1 ON LINE\r
+\c 62\r
+                    go to next;\r
+\r
+000206  aa   777706 7100 04   tra       -58,ic              000114\r
+                                                            STATEMENT 1 ON LINE\r
+\c 63\r
+                    end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 64\r
+          if wrk^="e" then\r
+             if wrk^="E" then go to fin;\r
+\r
+000207  aa   145000 1150 03   cmpa      51712,du\r
+000210  aa   000004 6000 04   tze       4,ic                000214\r
+000211  aa   105000 1150 03   cmpa      35328,du\r
+000212  aa   000002 6000 04   tze       2,ic                000214\r
+000213  aa   000136 7100 04   tra       94,ic               000351\r
+                                                            STATEMENT 1 ON LINE\r
+\c 66\r
+          e_pos = "1"b;\r
+\r
+000214  aa   400000 2350 03   lda       131072,du\r
+000215  aa  6 00107 7551 00   sta       pr6|71              e_pos\r
+                                                            STATEMENT 2 ON LINE\r
+\c 66\r
+ ex = 0;\r
+\r
+000216  aa  6 00101 4501 00   stz       pr6|65              ex\r
+                                                            STATEMENT 1 ON LINE\r
+\c 67\r
+          ip = ip+1;\r
+\r
+000217  aa  6 00032 3735 20   epp7      pr6|26,*\r
+000220  aa  7 00006 0541 20   aos       pr7|6,*             ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 68\r
+          if ip>len then go to fin;\r
+\r
+000221  aa  7 00006 2361 20   ldq       pr7|6,*             ip\r
+000222  aa  7 00004 1161 20   cmpq      pr7|4,*             len\r
+000223  aa   000002 6044 04   tmoz      2,ic                000225\r
+000224  aa   000125 7100 04   tra       85,ic               000351\r
+                                                            STATEMENT 1 ON LINE\r
+\c 69\r
+          wrk = substr(in,ip,1);\r
+\r
+000225  aa  6 00114 4501 00   stz       pr6|76              wrk\r
+000226  aa  7 00006 7271 20   lxl7      pr7|6,*             ip\r
+000227  aa  6 00112 3715 20   epp5      pr6|74,*            inp1\r
+000230  aa  040 100 100 517   mlr       (pr,x7),(pr),fill(040)\r
+000231  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+000232  aa  6 00114 00 0001   desc9a    pr6|76,1            wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 70\r
+          if wrk="+" then go to e_plus;\r
+\r
+000233  aa  6 00114 2351 00   lda       pr6|76              wrk\r
+000234  aa   053000 1150 03   cmpa      22016,du\r
+000235  aa   000002 6010 04   tnz       2,ic                000237\r
+000236  aa   000005 7100 04   tra       5,ic                000243\r
+                                                            STATEMENT 1 ON LINE\r
+\c 71\r
+          if wrk^="-" then go to e_no_sign;\r
+\r
+000237  aa   055000 1150 03   cmpa      23040,du\r
+000240  aa   000002 6000 04   tze       2,ic                000242\r
+000241  aa   000014 7100 04   tra       12,ic               000255\r
+                                                            STATEMENT 1 ON LINE\r
+\c 72\r
+                    e_pos = "0"b;\r
+\r
+000242  aa  6 00107 4501 00   stz       pr6|71              e_pos\r
+                                                            STATEMENT 1 ON LINE\r
+\c 73\r
+           e_plus:ip = ip+1;\r
+\r
+000243  aa  7 00006 0541 20   aos       pr7|6,*             ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 74\r
+                    if ip>len then go to fin;\r
+\r
+000244  aa  7 00006 2361 20   ldq       pr7|6,*             ip\r
+000245  aa  7 00004 1161 20   cmpq      pr7|4,*             len\r
+000246  aa   000002 6044 04   tmoz      2,ic                000250\r
+000247  aa   000102 7100 04   tra       66,ic               000351\r
+                                                            STATEMENT 1 ON LINE\r
+\c 75\r
+                    wrk = substr(in,ip,1);\r
+\r
+000250  aa  6 00114 4501 00   stz       pr6|76              wrk\r
+000251  aa  7 00006 7261 20   lxl6      pr7|6,*             ip\r
+000252  aa  040 100 100 516   mlr       (pr,x6),(pr),fill(040)\r
+000253  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+000254  aa  6 00114 00 0001   desc9a    pr6|76,1            wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 76\r
+e_no_sign: e_next:\r
+          j = index("0123456789",wrk)-1;\r
+\r
+000255  aa  000 100 124 404   scm       (ic),(pr),mask(000)\r
+000256  aa   777533 00 0012   desc9a    -165,10             000010 = 0600610620\r
+\c63\r
+000257  aa  6 00114 00 0001   desc9a    pr6|76,1            wrk\r
+000260  aa  6 00056 0001 00   arg       pr6|46\r
+000261  aa  6 00056 2361 00   ldq       pr6|46\r
+000262  aa   000002 6070 04   ttf       2,ic                000264\r
+000263  aa   000001 3360 07   lcq       1,dl\r
+000264  aa  6 00102 7561 00   stq       pr6|66              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 78\r
+          if j<0 then go to e_fin;\r
+\r
+000265  aa   000002 6050 04   tpl       2,ic                000267\r
+000266  aa   000026 7100 04   tra       22,ic               000314\r
+                                                            STATEMENT 1 ON LINE\r
+\c 79\r
+          ex = ten*ex+j;\r
+\r
+000267  aa  0 00465 7001 00   tsx0      pr0|309             fx1_to_fl2\r
+000270  aa  6 00122 4551 00   fst       pr6|82\r
+000271  aa  6 00101 2361 00   ldq       pr6|65              ex\r
+000272  aa  0 00465 7001 00   tsx0      pr0|309             fx1_to_fl2\r
+000273  aa   010500 4610 03   fmp       4416,du\r
+000274  aa  6 00122 4751 00   fad       pr6|82\r
+000275  aa  0 00654 7001 00   tsx0      pr0|428             fl2_to_fx1\r
+000276  aa  6 00101 7561 00   stq       pr6|65              ex\r
+                                                            STATEMENT 1 ON LINE\r
+\c 80\r
+          ip = ip+1;\r
+\r
+000277  aa  6 00032 3735 20   epp7      pr6|26,*\r
+000300  aa  7 00006 0541 20   aos       pr7|6,*             ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 81\r
+          if ip>len then go to e_fin;\r
+\r
+000301  aa  7 00006 2361 20   ldq       pr7|6,*             ip\r
+000302  aa  7 00004 1161 20   cmpq      pr7|4,*             len\r
+000303  aa   000002 6044 04   tmoz      2,ic                000305\r
+000304  aa   000010 7100 04   tra       8,ic                000314\r
+                                                            STATEMENT 1 ON LINE\r
+\c 82\r
+          wrk = substr(in,ip,1);\r
+\r
+000305  aa  6 00114 4501 00   stz       pr6|76              wrk\r
+000306  aa  7 00006 7271 20   lxl7      pr7|6,*             ip\r
+000307  aa  6 00112 3715 20   epp5      pr6|74,*            inp1\r
+000310  aa  040 100 100 517   mlr       (pr,x7),(pr),fill(040)\r
+000311  aa  5 77777 60 0001   desc9a    pr5|-1(3),1         in\r
+000312  aa  6 00114 00 0001   desc9a    pr6|76,1            wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 83\r
+go to e_next;\r
+\r
+000313  aa   777742 7100 04   tra       -30,ic              000255\r
+                                                            STATEMENT 1 ON LINE\r
+\c 84\r
+e_fin:    if ^e_pos then ex = -ex;\r
+\r
+000314  aa  6 00107 2351 00   lda       pr6|71              e_pos\r
+000315  aa   000003 6010 04   tnz       3,ic                000320\r
+000316  aa  6 00101 3361 00   lcq       pr6|65              ex\r
+000317  aa  6 00101 7561 00   stq       pr6|65              ex\r
+                                                            STATEMENT 1 ON LINE\r
+\c 85\r
+          value = value*10.e0**ex;\r
+\r
+000320  aa  000 300 300 404   mvn       (ic),(pr),round\r
+000321  aa   777461 00 0004   desc9fl   -207,4              000001 = 0530610600\r
+\c00\r
+000322  aa  6 00124 00 0075   desc9fl   pr6|84,61\r
+000323  aa  6 00124 3521 00   epp2      pr6|84\r
+000324  aa  6 00166 2521 00   spri2     pr6|118\r
+000325  aa  6 00101 3521 00   epp2      pr6|65              ex\r
+000326  aa  6 00170 2521 00   spri2     pr6|120\r
+000327  aa  6 00144 3521 00   epp2      pr6|100\r
+000330  aa  6 00172 2521 00   spri2     pr6|122\r
+000331  aa  6 00164 6211 00   eax1      pr6|116\r
+000332  aa   014000 4310 07   fld       6144,dl\r
+000333  aa  6 00044 3701 20   epp4      pr6|36,*\r
+000334  la  4 00012 3521 20   epp2      pr4|10,*            decimal_exp_\r
+000335  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+000336  aa  6 00144 3535 00   epp3      pr6|100\r
+000337  aa   000073 2360 07   ldq       59,dl\r
+000340  aa   000024 7270 07   lxl7      20,dl\r
+000341  aa  6 00174 3515 00   epp1      pr6|124\r
+000342  aa   000077 2350 07   lda       63,dl\r
+000343  aa   000010 7260 07   lxl6      8,dl\r
+000344  aa  6 00176 3715 00   epp5      pr6|126\r
+000345  aa  0 01254 7001 00   tsx0      pr0|684             real_to_real_round_\r
+000346  aa  6 00174 4331 00   dfld      pr6|124\r
+000347  aa  6 00116 4631 00   dfmp      pr6|78              value\r
+000350  aa  6 00116 4571 00   dfst      pr6|78              value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 86\r
+fin:      if ^pos then value= - value;\r
+\r
+000351  aa  6 00106 2351 00   lda       pr6|70              pos\r
+000352  aa   000004 6010 04   tnz       4,ic                000356\r
+000353  aa  6 00116 4331 00   dfld      pr6|78              value\r
+000354  aa   000000 5130 00   fneg      0\r
+000355  aa  6 00116 4571 00   dfst      pr6|78              value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 87\r
+          ret_value = value;\r
+\r
+000356  aa  6 00116 4331 00   dfld      pr6|78              value\r
+000357  aa  6 00032 3735 20   epp7      pr6|26,*\r
+000360  aa  7 00010 4551 20   fst       pr7|8,*             ret_value\r
+                                                            STATEMENT 1 ON LINE\r
+\c 88\r
+          return;\r
+\r
+000361  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 89\r
+          end;\r
+\r
+  END PROCEDURE ffip\r
+

diff --git a/pl1/ffip.pl1 b/pl1/ffip.pl1
new file mode 100644 (file)
index 0000000..2c1a704
--- /dev/null
+++ b/pl1/ffip.pl1
@@ -0,0 +1,91 @@
+/* ***********************************************************\r
+   *                                                         *\r
+   * Copyright, (C) Honeywell Information Systems Inc., 1982 *\r
+   *                                                         *\r
+   * Copyright (c) 1972 by Massachusetts Institute of        *\r
+   * Technology and Honeywell Information Systems, Inc.      *\r
+   *                                                         *\r
+   *********************************************************** */\r
+\r
+\r
+ffip:     proc(inp, len, ip, ret_value);\r
+/* ffip converts a free format inputted string into a bin float number */\r
+dcl\r
+          (len, code, ip, ex, j, llen) fixed bin(17),\r
+          (val_mult, new_div, ret_value) float bin(27),\r
+          (pos, e_pos, frac) bit(1),\r
+          in char(llen) based(inp1) unaligned,\r
+          (inp, inp1) ptr,\r
+          wrk char(1) aligned,\r
+          (value, new) float bin(63),\r
+          ten float bin(27) static init(10e0);\r
+\r
+          code = 5000;\r
+          llen = len;\r
+          inp1 = inp;\r
+blank:    if ip>len then do;\r
+                    code = 5001;\r
+                    return;\r
+                    end;\r
+          if substr(in,ip,1)^=" " then go to non_blank;\r
+          ip = ip+1;\r
+          go to blank;\r
+\r
+non_blank:          pos = "1"b; frac = "0"b; val_mult = ten; new_div = 1.e0; va\r
+\clue = 0.e0;\r
+          wrk = substr(in,ip,1);\r
+          if wrk="+" then go to plus;\r
+          if wrk^="-" then go to no_sign;\r
+                    pos = "0"b;\r
+           plus:ip = ip+1;\r
+                    if ip>len then return;\r
+                    wrk = substr(in,ip,1);\r
+no_sign: next:\r
+          new = index("0123456789", wrk)-1;\r
+          if new<0e0 then go to not_num;\r
+          code = 0;\r
+          if frac then do;\r
+                    new_div = new_div*ten;\r
+                    new = new / new_div;\r
+                    end;\r
+          value = val_mult*value+new;\r
+          ip = ip+1;\r
+          if ip>len then go to fin;\r
+          wrk = substr(in,ip,1);\r
+          go to next;\r
+not_num:  if wrk="." then do;\r
+                    if frac then go to fin;\r
+                    frac = "1"b;\r
+                    ip = ip+1;\r
+                    if ip>len then go to fin;\r
+                    wrk = substr(in,ip,1);\r
+                    val_mult = 1.e0;\r
+                    go to next;\r
+                    end;\r
+          if wrk^="e" then\r
+             if wrk^="E" then go to fin;\r
+          e_pos = "1"b; ex = 0;\r
+          ip = ip+1;\r
+          if ip>len then go to fin;\r
+          wrk = substr(in,ip,1);\r
+          if wrk="+" then go to e_plus;\r
+          if wrk^="-" then go to e_no_sign;\r
+                    e_pos = "0"b;\r
+           e_plus:ip = ip+1;\r
+                    if ip>len then go to fin;\r
+                    wrk = substr(in,ip,1);\r
+e_no_sign: e_next:\r
+          j = index("0123456789",wrk)-1;\r
+          if j<0 then go to e_fin;\r
+          ex = ten*ex+j;\r
+          ip = ip+1;\r
+          if ip>len then go to e_fin;\r
+          wrk = substr(in,ip,1);\r
+go to e_next;\r
+e_fin:    if ^e_pos then ex = -ex;\r
+          value = value*10.e0**ex;\r
+fin:      if ^pos then value= - value;\r
+          ret_value = value;\r
+          return;\r
+          end;\r
+

diff --git a/pl1/ffop.list b/pl1/ffop.list
new file mode 100644 (file)
index 0000000..1186a3e
--- /dev/null
+++ b/pl1/ffop.list
@@ -0,0 +1,902 @@
+          COMPILATION LISTING OF SEGMENT ffop\r
+          Compiled by: Multics PL/I Compiler, Release 33f, of February 11, 2017\r
+          Compiled at: Installation and location\r
+          Compiled on: 10/06/19  0218.3 pst Sun\r
+              Options: table list\r
+\r
+        1 /****^  ***********************************************************\r
+        2*        *                                                         *\r
+        3*        * Copyright, (C) Honeywell Bull Inc., 1989                *\r
+        4*        *                                                         *\r
+        5*        * Copyright, (C) Honeywell Information Systems Inc., 1982 *\r
+        6*        *                                                         *\r
+        7*        * Copyright (c) 1972 by Massachusetts Institute of        *\r
+        8*        * Technology and Honeywell Information Systems, Inc.      *\r
+        9*        *                                                         *\r
+       10*        *********************************************************** *\r
+\c/\r
+       11\r
+       12\r
+       13\r
+       14\r
+       15 /****^  HISTORY COMMENTS:\r
+       16*  1) change(88-10-19,Lee), approve(88-11-21,MCR8025), audit(88-12-23,\r
+\cFlegel),\r
+       17*     install(89-01-23,MR12.3-1010):\r
+       18*     Commands 393 (phx16310) - fixed bug displaying small numbers whe\r
+\cn\r
+       19*     ten**(prec-mag) exceeds exponent size.\r
+       20*                                                   END HISTORY COMMEN\r
+\cTS */\r
+       21\r
+       22\r
+       23 /* format: style4,ind3 */\r
+       24\r
+       25 ffop: proc (string, ip, value);\r
+       26\r
+       27 dcl  (ip, mag, dif, i, j, k, m, n) fixed bin (17);\r
+       28 dcl  val float bin (63);\r
+       29 dcl  roundit float bin (63) static internal init (0.5e0);\r
+       30 dcl  ten float bin (63) static internal init (10e0);\r
+       31 dcl  (num, numt) fixed bin (71);\r
+       32 dcl  value float bin (27);\r
+       33 dcl  numbers (0:9) char (1) static internal init ("0", "1", "2", "3",\r
+\c "4", "5", "6", "7", "8", "9");\r
+       34 dcl  string char (32) aligned;\r
+       35 dcl  sign char (1) aligned;\r
+       36 dcl  wrk char (26) aligned;\r
+       37 dcl  (prec init (6), len init (32)) fixed bin (17) internal static;\r
+       38 dcl  temp float bin (63);\r
+       39 dcl  (divide, log10, multiply, substr) builtin;\r
+       40\r
+       41 dcl  1 e aligned,\r
+       42        2 p bit (1) aligned,\r
+       43        2 old_mag fixed bin (17) aligned;\r
+       44\r
+       45       wrk = " ";\r
+       46       e.p = "0"b;\r
+       47       sign = " ";\r
+       48       val = value;\r
+       49       if val = 0.e0 then do;\r
+       50          mag = prec - 1;\r
+       51          go to no_log;\r
+       52       end;\r
+       53       if val < 0.e0 then do;\r
+       54          val = -val;\r
+       55          sign = "-";\r
+       56       end;\r
+       57       mag = log10 (val);\r
+       58       if mag < 0 then mag = mag - 1;\r
+       59       if mag > prec then go to e_stuff;\r
+       60       if mag < -1 then do;\r
+       61\r
+       62 e_stuff: e.p = "1"b;\r
+       63          e.old_mag = mag;\r
+       64\r
+       65 /* fixed for phx16310 - if value if mag is small, */\r
+       66 /* ten**(prec-mag) may generate exponent overflow; */\r
+       67 /* multiply in two steps to prevent this condition */\r
+       68\r
+       69          val = multiply (val, ten ** (prec), 63);\r
+       70          val = multiply (val, ten ** (-mag), 63);\r
+       71\r
+       72          num = val + roundit;\r
+       73          mag = 0;\r
+       74          dif = 0;\r
+       75          go to no_dif;\r
+       76       end;\r
+       77       if mag < 0 then mag = mag - 1;\r
+       78\r
+       79 no_log:\r
+       80       temp = 10e0 ** (prec - mag);\r
+       81       num = val * temp + roundit;\r
+       82\r
+       83 no_dif:\r
+       84       mag = mag + 18 - prec;\r
+       85       i = 18;\r
+       86\r
+       87 next_num:\r
+       88       if i = mag then do;\r
+       89          substr (wrk, i, 1) = ".";\r
+       90          i = i - 1;\r
+       91       end;\r
+       92       numt = divide (num, 10, 63, 0);\r
+       93       k = num - numt * 10;\r
+       94       num = numt;\r
+       95       substr (wrk, i, 1) = numbers (k);\r
+       96       i = i - 1;\r
+       97       if num > 0 then go to next_num;\r
+       98       if i >= mag - 1 then go to next_num;\r
+       99       substr (wrk, i, 1) = sign;\r
+      100       do j = 18 to mag by -1 while (substr (wrk, j, 1) = "0" | substr\r
+\c (wrk, j, 1) = ".");\r
+      101       end;\r
+      102       if e.p then do;\r
+      103          substr (wrk, j + 1, 1) = "E";\r
+      104          if e.old_mag < 0 then do;\r
+      105             substr (wrk, j + 2, 1) = "-";\r
+      106             e.old_mag = -e.old_mag;\r
+      107          end;\r
+      108          else substr (wrk, j + 2, 1) = "+";\r
+      109          m = divide (e.old_mag, 100, 17);\r
+      110          n = e.old_mag - m * 100;\r
+      111          if m > 0 then do;\r
+      112             substr (wrk, j + 3, 1) = numbers (m);\r
+      113             j = j + 1;\r
+      114          end;\r
+      115          m = divide (n, 10, 17);\r
+      116          n = n - m * 10;\r
+      117          if m > 0 then do;\r
+      118             substr (wrk, j + 3, 1) = numbers (m);\r
+      119             j = j + 1;\r
+      120          end;\r
+      121          substr (wrk, j + 3, 1) = numbers (n);\r
+      122          j = j + 3;\r
+      123       end;\r
+      124       if len - ip < j - i + 1 then do;\r
+      125          substr (string, ip, len - ip) = (26)"*";\r
+      126          ip = len + 1;\r
+      127          return;\r
+      128       end;\r
+      129       substr (string, ip, j - i + 1) = substr (wrk, i, j - i + 1);\r
+      130       ip = ip + j - i + 1;\r
+      131       return;\r
+      132    end;\r
+\014      SOURCE FILES USED IN THIS COMPILATION.\r
+\r
+LINE      NUMBER  DATE MODIFIED     NAME                              PATHNAME\r
+             0    10/06/19  0214.6  ffop.pl1                          >user_dir\r
+\c_dir>SysAdmin>Repair>ffop.pl1\r
+\014      NAMES DECLARED IN THIS COMPILATION.\r
+\r
+IDENTIFIER               OFFSET    LOC STORAGE CLASS   DATA TYPE\r
+\c ATTRIBUTES AND REFERENCES\r
+\r
+\c (* indicates a set context)\r
+\r
+NAMES DECLARED BY DECLARE STATEMENT.\r
+dif                             000101 automatic       fixed bin(17,0)\r
+\c dcl 27 set ref 74*\r
+divide                                                 builtin function\r
+\c dcl 39 ref 92 109 115\r
+e                               000130 automatic       structure\r
+\c level 1 dcl 41\r
+i                               000102 automatic       fixed bin(17,0)\r
+\c dcl 27 set ref 85* 87 89 90* 90 95 96* 96 98 99 124\r
+\r
+\c   129 129 129 130\r
+ip                                     parameter       fixed bin(17,0)\r
+\c dcl 27 set ref 25 124 125 125 126* 129 130* 130\r
+j                               000103 automatic       fixed bin(17,0)\r
+\c dcl 27 set ref 100* 100 100* 103 105 108 112 113*\r
+\r
+\c   113 118 119* 119 121 122* 122 124 129 129 130\r
+k                               000104 automatic       fixed bin(17,0)\r
+\c dcl 27 set ref 93* 95\r
+len                             000000 constant        fixed bin(17,0)\r
+\c initial dcl 37 ref 124 125 126\r
+log10                                                  builtin function\r
+\c dcl 39 ref 57\r
+m                               000105 automatic       fixed bin(17,0)\r
+\c dcl 27 set ref 109* 110 111 112 115* 116 117 118\r
+mag                             000100 automatic       fixed bin(17,0)\r
+\c dcl 27 set ref 50* 57* 58 58* 58 59 60 63 70 73* 77\r
+\r
+\c   77* 77 79 83* 83 87 98 100\r
+multiply                                               builtin function\r
+\c dcl 39 ref 69 70\r
+n                               000106 automatic       fixed bin(17,0)\r
+\c dcl 27 set ref 110* 115 116* 116 121\r
+num                             000112 automatic       fixed bin(71,0)\r
+\c dcl 31 set ref 72* 81* 92 93 94* 97\r
+numbers                         000002 constant        char(1)\r
+\c initial array packed unaligned dcl 33 ref 95 112 118\r
+\r
+\c   121\r
+numt                            000114 automatic       fixed bin(71,0)\r
+\c dcl 31 set ref 92* 93 94\r
+old_mag                   1     000130 automatic       fixed bin(17,0)\r
+\c level 2 dcl 41 set ref 63* 104 106* 106 109 110\r
+p                               000130 automatic       bit(1)\r
+\c level 2 dcl 41 set ref 46* 62* 102\r
+prec                            000001 constant        fixed bin(17,0)\r
+\c initial dcl 37 ref 50 59 69 79 83\r
+roundit                         000010 constant        float bin(63)\r
+\c initial dcl 29 ref 72 81\r
+sign                            000116 automatic       char(1)\r
+\c dcl 35 set ref 47* 55* 99\r
+string                                 parameter       char(32)\r
+\c dcl 34 set ref 25 125* 129*\r
+substr                                                 builtin function\r
+\c dcl 39 set ref 89* 95* 99* 100 100 103* 105* 108*\r
+\r
+\c   112* 118* 121* 125* 129* 129\r
+temp                            000126 automatic       float bin(63)\r
+\c dcl 38 set ref 79* 81\r
+ten                             000006 constant        float bin(63)\r
+\c initial dcl 30 ref 69 70\r
+val                             000110 automatic       float bin(63)\r
+\c dcl 28 set ref 48* 49 53 54* 54 57 69* 69 70* 70 72\r
+\r
+\c   81\r
+value                                  parameter       float bin(27)\r
+\c dcl 32 ref 25 48\r
+wrk                             000117 automatic       char(26)\r
+\c dcl 36 set ref 45* 89* 95* 99* 100 100 103* 105*\r
+\r
+\c   108* 112* 118* 121* 129\r
+\r
+NAMES DECLARED BY EXPLICIT CONTEXT.\r
+e_stuff                         000067 constant        label\r
+\c dcl 62 ref 59\r
+ffop                            000022 constant        entry\r
+\c external dcl 25\r
+next_num                        000166 constant        label\r
+\c dcl 87 ref 97 98\r
+no_dif                          000161 constant        label\r
+\c dcl 83 ref 75\r
+no_log                          000123 constant        label\r
+\c dcl 79 ref 51\r
+\r
+THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION.\r
+\r
+STORAGE REQUIREMENTS FOR THIS PROGRAM.\r
+\r
+          Object    Text      Link      Symbol    Defs      Static\r
+Start          0       0       466         502     431         476\r
+Length      1462     431        14         743      35           0\r
+\r
+BLOCK NAME                   STACK SIZE     TYPE            WHY NONQUICK/WHO SH\r
+\cARES STACK FRAME\r
+ffop                                148 external procedure  is an external proc\r
+\cedure.\r
+\r
+STORAGE FOR AUTOMATIC VARIABLES.\r
+\r
+STACK FRAME                 LOC IDENTIFIER                  BLOCK NAME\r
+ffop                     000100 mag                         ffop\r
+                         000101 dif                         ffop\r
+                         000102 i                           ffop\r
+                         000103 j                           ffop\r
+                         000104 k                           ffop\r
+                         000105 m                           ffop\r
+                         000106 n                           ffop\r
+                         000110 val                         ffop\r
+                         000112 num                         ffop\r
+                         000114 numt                        ffop\r
+                         000116 sign                        ffop\r
+                         000117 wrk                         ffop\r
+                         000126 temp                        ffop\r
+                         000130 e                           ffop\r
+\r
+THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM.\r
+r_e_as              call_ext_out        return_mac          fl2_to_fx1\r
+\c fl2_to_fx2          mpfx2\r
+ext_entry           real_to_real_round_ divide_fx3          double_log_base_10_\r
+\c double_power_integer_\r
+\r
+THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM.\r
+decimal_exp_\r
+\r
+NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM.\r
+\r
+\r
+\014CONSTANTS\r
+000000  aa     000000000040\r
+\r
+000001  aa     000000000006\r
+\r
+000002  aa  060 061 062 063   0123\r
+000003  aa  064 065 066 067   4567\r
+000004  aa  070 071 000 000   89\000\000\r
+\r
+000006  aa     010500000000\r
+000007  aa     000000000000\r
+\r
+000010  aa     000400000000\r
+000011  aa     000000000000\r
+\r
+000416  aa  060 000 000 000   0\r
+\r
+000417  aa     000000000012\r
+\r
+000420  aa  056 000 000 000   .\r
+\r
+000012  aa     053061060000\r
+\r
+000421  aa     777777777777\r
+\r
+000013  aa     524000000040\r
+\r
+000014  aa     414000000033\r
+\r
+000015  aa     404000000021\r
+\r
+000422  aa  052 052 052 052   ****\r
+000423  aa  052 052 052 052   ****\r
+000424  aa  052 052 052 052   ****\r
+000425  aa  052 052 052 052   ****\r
+000426  aa  052 052 052 052   ****\r
+000427  aa  052 052 052 052   ****\r
+000430  aa  052 052 000 000   **\r
+\r
+BEGIN PROCEDURE ffop\r
+ENTRY TO ffop                                               STATEMENT 1 ON LINE\r
+\c 25\r
+ffop: proc (string, ip, value);\r
+\r
+000016  at     000003000013\r
+000017  tt     000015000014\r
+000020  ta     000016000000\r
+000021  da     000031300000\r
+000022  aa   000240 6270 00   eax7      160\r
+000023  aa  7 00034 3521 20   epp2      pr7|28,*\r
+000024  aa  2 01045 2721 00   tsp2      pr2|549             ext_entry\r
+000025  aa     000006000000\r
+000026  2s     000010000125\r
+                                                            STATEMENT 1 ON LINE\r
+\c 45\r
+      wrk = " ";\r
+\r
+000027  aa  040 100 100 400   mlr       (),(pr),fill(040)\r
+000030  aa   000000 00 0000   desc9a    0,0\r
+000031  aa  6 00117 00 0032   desc9a    pr6|79,26           wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 46\r
+      e.p = "0"b;\r
+\r
+000032  aa  6 00130 4501 00   stz       pr6|88              e.p\r
+                                                            STATEMENT 1 ON LINE\r
+\c 47\r
+      sign = " ";\r
+\r
+000033  aa   040000 2350 03   lda       16384,du\r
+000034  aa  6 00116 7551 00   sta       pr6|78              sign\r
+                                                            STATEMENT 1 ON LINE\r
+\c 48\r
+      val = value;\r
+\r
+000035  aa  6 00032 3735 20   epp7      pr6|26,*\r
+000036  aa  7 00006 4311 20   fld       pr7|6,*             value\r
+000037  aa  6 00110 4571 00   dfst      pr6|72              val\r
+                                                            STATEMENT 1 ON LINE\r
+\c 49\r
+      if val = 0.e0 then do;\r
+\r
+000040  aa   000004 6010 04   tnz       4,ic                000044\r
+                                                            STATEMENT 1 ON LINE\r
+\c 50\r
+         mag = prec - 1;\r
+\r
+000041  aa   000005 2360 07   ldq       5,dl\r
+000042  aa  6 00100 7561 00   stq       pr6|64              mag\r
+                                                            STATEMENT 1 ON LINE\r
+\c 51\r
+         go to no_log;\r
+\r
+000043  aa   000060 7100 04   tra       48,ic               000123\r
+                                                            STATEMENT 1 ON LINE\r
+\c 52\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 53\r
+      if val < 0.e0 then do;\r
+\r
+000044  aa   000005 6050 04   tpl       5,ic                000051\r
+                                                            STATEMENT 1 ON LINE\r
+\c 54\r
+         val = -val;\r
+\r
+000045  aa   000000 5130 00   fneg      0\r
+000046  aa  6 00110 4571 00   dfst      pr6|72              val\r
+                                                            STATEMENT 1 ON LINE\r
+\c 55\r
+         sign = "-";\r
+\r
+000047  aa   055000 2350 03   lda       23040,du\r
+000050  aa  6 00116 7551 00   sta       pr6|78              sign\r
+                                                            STATEMENT 1 ON LINE\r
+\c 56\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 57\r
+      mag = log10 (val);\r
+\r
+000051  aa  6 00110 4331 00   dfld      pr6|72              val\r
+000052  aa  6 00134 3521 00   epp2      pr6|92\r
+000053  aa  0 01334 2731 00   tsp3      pr0|732             double_log_base_10_\r
+000054  aa  0 00654 7001 00   tsx0      pr0|428             fl2_to_fx1\r
+000055  aa  6 00100 7561 00   stq       pr6|64              mag\r
+                                                            STATEMENT 1 ON LINE\r
+\c 58\r
+      if mag < 0 then mag = mag - 1;\r
+\r
+000056  aa   000003 6050 04   tpl       3,ic                000061\r
+000057  aa   000001 3360 07   lcq       1,dl\r
+000060  aa  6 00100 0561 00   asq       pr6|64              mag\r
+                                                            STATEMENT 1 ON LINE\r
+\c 59\r
+      if mag > prec then go to e_stuff;\r
+\r
+000061  aa  6 00100 2361 00   ldq       pr6|64              mag\r
+000062  aa   000006 1160 07   cmpq      6,dl\r
+000063  aa   000002 6044 04   tmoz      2,ic                000065\r
+000064  aa   000003 7100 04   tra       3,ic                000067\r
+                                                            STATEMENT 1 ON LINE\r
+\c 60\r
+      if mag < -1 then do;\r
+\r
+000065  aa   000334 1160 04   cmpq      220,ic              000421 = 7777777777\r
+\c77\r
+000066  aa   000031 6050 04   tpl       25,ic               000117\r
+                                                            STATEMENT 1 ON LINE\r
+\c 62\r
+e_stuff: e.p = "1"b;\r
+\r
+000067  aa   400000 2350 03   lda       131072,du\r
+000070  aa  6 00130 7551 00   sta       pr6|88              e.p\r
+                                                            STATEMENT 1 ON LINE\r
+\c 63\r
+         e.old_mag = mag;\r
+\r
+000071  aa  6 00131 7561 00   stq       pr6|89              e.old_mag\r
+                                                            STATEMENT 1 ON LINE\r
+\c 69\r
+         val = multiply (val, ten ** (prec), 63);\r
+\r
+000072  aa   777714 4330 04   dfld      -52,ic              000006 = 0105000000\r
+\c00 000000000000\r
+000073  aa   777713 4630 04   dfmp      -53,ic              000006 = 0105000000\r
+\c00 000000000000\r
+000074  aa   777712 4630 04   dfmp      -54,ic              000006 = 0105000000\r
+\c00 000000000000\r
+000075  aa  6 00056 4571 00   dfst      pr6|46\r
+000076  aa  6 00056 4631 00   dfmp      pr6|46\r
+000077  aa  6 00110 4631 00   dfmp      pr6|72              val\r
+000100  aa  6 00110 4571 00   dfst      pr6|72              val\r
+                                                            STATEMENT 1 ON LINE\r
+\c 70\r
+         val = multiply (val, ten ** (-mag), 63);\r
+\r
+000101  aa  6 00100 3361 00   lcq       pr6|64              mag\r
+000102  aa  6 00133 7561 00   stq       pr6|91\r
+000103  aa   777703 4330 04   dfld      -61,ic              000006 = 0105000000\r
+\c00 000000000000\r
+000104  aa  6 00133 3515 00   epp1      pr6|91\r
+000105  aa  6 00134 3521 00   epp2      pr6|92\r
+000106  aa  0 01346 2731 00   tsp3      pr0|742             double_power_intege\r
+\cr_\r
+000107  aa  6 00110 4631 00   dfmp      pr6|72              val\r
+000110  aa  6 00110 4571 00   dfst      pr6|72              val\r
+                                                            STATEMENT 1 ON LINE\r
+\c 72\r
+         num = val + roundit;\r
+\r
+000111  aa   777677 4770 04   dfad      -65,ic              000010 = 0004000000\r
+\c00 000000000000\r
+000112  aa  0 00655 7001 00   tsx0      pr0|429             fl2_to_fx2\r
+000113  aa  6 00112 7571 00   staq      pr6|74              num\r
+                                                            STATEMENT 1 ON LINE\r
+\c 73\r
+         mag = 0;\r
+\r
+000114  aa  6 00100 4501 00   stz       pr6|64              mag\r
+                                                            STATEMENT 1 ON LINE\r
+\c 74\r
+         dif = 0;\r
+\r
+000115  aa  6 00101 4501 00   stz       pr6|65              dif\r
+                                                            STATEMENT 1 ON LINE\r
+\c 75\r
+         go to no_dif;\r
+\r
+000116  aa   000043 7100 04   tra       35,ic               000161\r
+                                                            STATEMENT 1 ON LINE\r
+\c 76\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 77\r
+      if mag < 0 then mag = mag - 1;\r
+\r
+000117  aa  6 00100 2361 00   ldq       pr6|64              mag\r
+000120  aa   000003 6050 04   tpl       3,ic                000123\r
+000121  aa   000001 3360 07   lcq       1,dl\r
+000122  aa  6 00100 0561 00   asq       pr6|64              mag\r
+                                                            STATEMENT 1 ON LINE\r
+\c 79\r
+no_log:\r
+      temp = 10e0 ** (prec - mag);\r
+\r
+000123  aa  000 300 300 404   mvn       (ic),(pr),round\r
+000124  aa   777667 00 0004   desc9fl   -73,4               000012 = 0530610600\r
+\c00\r
+000125  aa  6 00134 00 0075   desc9fl   pr6|92,61\r
+000126  aa   000006 2360 07   ldq       6,dl\r
+000127  aa  6 00100 1761 00   sbq       pr6|64              mag\r
+000130  aa  6 00133 7561 00   stq       pr6|91\r
+000131  aa  6 00134 3521 00   epp2      pr6|92\r
+000132  aa  6 00216 2521 00   spri2     pr6|142\r
+000133  aa  6 00133 3521 00   epp2      pr6|91\r
+000134  aa  6 00220 2521 00   spri2     pr6|144\r
+000135  aa  6 00174 3521 00   epp2      pr6|124\r
+000136  aa  6 00222 2521 00   spri2     pr6|146\r
+000137  aa  6 00214 6211 00   eax1      pr6|140\r
+000140  aa   014000 4310 07   fld       6144,dl\r
+000141  aa  6 00044 3701 20   epp4      pr6|36,*\r
+000142  la  4 00012 3521 20   epp2      pr4|10,*            decimal_exp_\r
+000143  aa  0 00623 7001 00   tsx0      pr0|403             call_ext_out\r
+000144  aa  6 00174 3535 00   epp3      pr6|124\r
+000145  aa   000073 2360 07   ldq       59,dl\r
+000146  aa   000024 7270 07   lxl7      20,dl\r
+000147  aa  6 00126 3515 00   epp1      pr6|86              temp\r
+000150  aa   000077 2350 07   lda       63,dl\r
+000151  aa   000010 7260 07   lxl6      8,dl\r
+000152  aa  6 00134 3715 00   epp5      pr6|92\r
+000153  aa  0 01254 7001 00   tsx0      pr0|684             real_to_real_round_\r
+                                                            STATEMENT 1 ON LINE\r
+\c 81\r
+      num = val * temp + roundit;\r
+\r
+000154  aa  6 00110 4331 00   dfld      pr6|72              val\r
+000155  aa  6 00126 4631 00   dfmp      pr6|86              temp\r
+000156  aa   777632 4770 04   dfad      -102,ic             000010 = 0004000000\r
+\c00 000000000000\r
+000157  aa  0 00655 7001 00   tsx0      pr0|429             fl2_to_fx2\r
+000160  aa  6 00112 7571 00   staq      pr6|74              num\r
+                                                            STATEMENT 1 ON LINE\r
+\c 83\r
+no_dif:\r
+      mag = mag + 18 - prec;\r
+\r
+000161  aa  6 00100 2361 00   ldq       pr6|64              mag\r
+000162  aa   000014 0760 07   adq       12,dl\r
+000163  aa  6 00100 7561 00   stq       pr6|64              mag\r
+                                                            STATEMENT 1 ON LINE\r
+\c 85\r
+      i = 18;\r
+\r
+000164  aa   000022 2360 07   ldq       18,dl\r
+000165  aa  6 00102 7561 00   stq       pr6|66              i\r
+                                                            STATEMENT 1 ON LINE\r
+\c 87\r
+next_num:\r
+      if i = mag then do;\r
+\r
+000166  aa  6 00102 2361 00   ldq       pr6|66              i\r
+000167  aa  6 00100 1161 00   cmpq      pr6|64              mag\r
+000170  aa   000006 6010 04   tnz       6,ic                000176\r
+                                                            STATEMENT 1 ON LINE\r
+\c 89\r
+         substr (wrk, i, 1) = ".";\r
+\r
+000171  aa  056 106 100 400   mlr       (),(pr,ql),fill(056)\r
+000172  aa   000000 00 0000   desc9a    0,0\r
+000173  aa  6 00116 60 0001   desc9a    pr6|78(3),1         wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 90\r
+         i = i - 1;\r
+\r
+000174  aa   000001 3360 07   lcq       1,dl\r
+000175  aa  6 00102 0561 00   asq       pr6|66              i\r
+                                                            STATEMENT 1 ON LINE\r
+\c 91\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 92\r
+      numt = divide (num, 10, 63, 0);\r
+\r
+000176  aa  6 00112 2371 00   ldaq      pr6|74              num\r
+000177  aa   000220 3520 04   epp2      144,ic              000417 = 0000000000\r
+\c12\r
+000200  aa  0 01264 7001 00   tsx0      pr0|692             divide_fx3\r
+000201  aa     000000000000\r
+000202  aa  6 00114 7571 00   staq      pr6|76              numt\r
+                                                            STATEMENT 1 ON LINE\r
+\c 93\r
+      k = num - numt * 10;\r
+\r
+000203  aa  2 00000 2361 00   ldq       pr2|0\r
+000204  aa  6 00114 3521 00   epp2      pr6|76              numt\r
+000205  aa  0 00671 7001 00   tsx0      pr0|441             mpfx2\r
+000206  aa   000000 5330 00   negl      0\r
+000207  aa  6 00112 0771 00   adaq      pr6|74              num\r
+000210  aa  6 00104 7561 00   stq       pr6|68              k\r
+                                                            STATEMENT 1 ON LINE\r
+\c 94\r
+      num = numt;\r
+\r
+000211  aa  2 00000 2371 00   ldaq      pr2|0               numt\r
+000212  aa  6 00112 7571 00   staq      pr6|74              num\r
+                                                            STATEMENT 1 ON LINE\r
+\c 95\r
+      substr (wrk, i, 1) = numbers (k);\r
+\r
+000213  aa  6 00102 7271 00   lxl7      pr6|66              i\r
+000214  aa  6 00104 7261 00   lxl6      pr6|68              k\r
+000215  aa  040 117 100 416   mlr       (x6),(pr,x7),fill(040)\r
+000216  ta   000002 00 0001   desc9a    2,1\r
+000217  aa  6 00116 60 0001   desc9a    pr6|78(3),1         wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 96\r
+      i = i - 1;\r
+\r
+000220  aa   000001 3360 07   lcq       1,dl\r
+000221  aa  6 00102 0561 00   asq       pr6|66              i\r
+                                                            STATEMENT 1 ON LINE\r
+\c 97\r
+      if num > 0 then go to next_num;\r
+\r
+000222  aa  6 00112 2371 00   ldaq      pr6|74              num\r
+000223  aa   000002 6044 04   tmoz      2,ic                000225\r
+000224  aa   777742 7100 04   tra       -30,ic              000166\r
+                                                            STATEMENT 1 ON LINE\r
+\c 98\r
+      if i >= mag - 1 then go to next_num;\r
+\r
+000225  aa  6 00100 2361 00   ldq       pr6|64              mag\r
+000226  aa   000001 1760 07   sbq       1,dl\r
+000227  aa  6 00102 1161 00   cmpq      pr6|66              i\r
+000230  aa   000002 6054 04   tpnz      2,ic                000232\r
+000231  aa   777735 7100 04   tra       -35,ic              000166\r
+                                                            STATEMENT 1 ON LINE\r
+\c 99\r
+      substr (wrk, i, 1) = sign;\r
+\r
+000232  aa  6 00102 7271 00   lxl7      pr6|66              i\r
+000233  aa  040 117 100 500   mlr       (pr),(pr,x7),fill(040)\r
+000234  aa  6 00116 00 0001   desc9a    pr6|78,1            sign\r
+000235  aa  6 00116 60 0001   desc9a    pr6|78(3),1         wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 100\r
+      do j = 18 to mag by -1 while (substr (wrk, j, 1) = "0" | substr (wrk, j, \r
+\c1) = ".");\r
+\r
+000236  aa  6 00100 2361 00   ldq       pr6|64              mag\r
+000237  aa  6 00132 7561 00   stq       pr6|90\r
+000240  aa   000022 2360 07   ldq       18,dl\r
+000241  aa  6 00103 7561 00   stq       pr6|67              j\r
+000242  aa  6 00103 2361 00   ldq       pr6|67              j\r
+000243  aa  6 00132 1161 00   cmpq      pr6|90\r
+000244  aa   000017 6040 04   tmi       15,ic               000263\r
+000245  aa  040 004 106 506   cmpc      (pr,ql),(ic),fill(040)\r
+000246  aa  6 00116 60 0001   desc9a    pr6|78(3),1         wrk\r
+000247  aa   000153 00 0001   desc9a    107,1               000420 = 0560000000\r
+\c00\r
+000250  aa  0 00512 7001 00   tsx0      pr0|330             r_e_as\r
+000251  aa  6 00133 7551 00   sta       pr6|91\r
+000252  aa  040 004 106 506   cmpc      (pr,ql),(ic),fill(040)\r
+000253  aa  6 00116 60 0001   desc9a    pr6|78(3),1         wrk\r
+000254  aa   000144 00 0001   desc9a    100,1               000416 = 0600000000\r
+\c00\r
+000255  aa  0 00512 7001 00   tsx0      pr0|330             r_e_as\r
+000256  aa  6 00133 2751 00   ora       pr6|91\r
+000257  aa   000004 6000 04   tze       4,ic                000263\r
+                                                            STATEMENT 1 ON LINE\r
+\c 101\r
+      end;\r
+\r
+000260  aa   000001 3360 07   lcq       1,dl\r
+000261  aa  6 00103 0561 00   asq       pr6|67              j\r
+000262  aa   777760 7100 04   tra       -16,ic              000242\r
+                                                            STATEMENT 1 ON LINE\r
+\c 102\r
+      if e.p then do;\r
+\r
+000263  aa  6 00130 2351 00   lda       pr6|88              e.p\r
+000264  aa   000064 6000 04   tze       52,ic               000350\r
+                                                            STATEMENT 1 ON LINE\r
+\c 103\r
+         substr (wrk, j + 1, 1) = "E";\r
+\r
+000265  aa  105 106 100 400   mlr       (),(pr,ql),fill(105)\r
+000266  aa   000000 00 0000   desc9a    0,0\r
+000267  aa  6 00117 00 0001   desc9a    pr6|79,1            wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 104\r
+         if e.old_mag < 0 then do;\r
+\r
+000270  aa  6 00131 2361 00   ldq       pr6|89              e.old_mag\r
+000271  aa   000010 6050 04   tpl       8,ic                000301\r
+                                                            STATEMENT 1 ON LINE\r
+\c 105\r
+            substr (wrk, j + 2, 1) = "-";\r
+\r
+000272  aa  6 00103 2351 00   lda       pr6|67              j\r
+000273  aa  055 105 100 400   mlr       (),(pr,al),fill(055)\r
+000274  aa   000000 00 0000   desc9a    0,0\r
+000275  aa  6 00117 20 0001   desc9a    pr6|79(1),1         wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 106\r
+            e.old_mag = -e.old_mag;\r
+\r
+000276  aa  6 00131 3361 00   lcq       pr6|89              e.old_mag\r
+000277  aa  6 00131 7561 00   stq       pr6|89              e.old_mag\r
+                                                            STATEMENT 1 ON LINE\r
+\c 107\r
+         end;\r
+\r
+000300  aa   000005 7100 04   tra       5,ic                000305\r
+                                                            STATEMENT 1 ON LINE\r
+\c 108\r
+         else substr (wrk, j + 2, 1) = "+";\r
+\r
+000301  aa  6 00103 2351 00   lda       pr6|67              j\r
+000302  aa  053 105 100 400   mlr       (),(pr,al),fill(053)\r
+000303  aa   000000 00 0000   desc9a    0,0\r
+000304  aa  6 00117 20 0001   desc9a    pr6|79(1),1         wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 109\r
+         m = divide (e.old_mag, 100, 17);\r
+\r
+000305  aa   000144 5060 07   div       100,dl\r
+000306  aa  6 00105 7561 00   stq       pr6|69              m\r
+                                                            STATEMENT 1 ON LINE\r
+\c 110\r
+         n = e.old_mag - m * 100;\r
+\r
+000307  aa   000144 4020 07   mpy       100,dl\r
+000310  aa  6 00133 7561 00   stq       pr6|91\r
+000311  aa  6 00131 2361 00   ldq       pr6|89              e.old_mag\r
+000312  aa  6 00133 1761 00   sbq       pr6|91\r
+000313  aa  6 00106 7561 00   stq       pr6|70              n\r
+                                                            STATEMENT 1 ON LINE\r
+\c 111\r
+         if m > 0 then do;\r
+\r
+000314  aa  6 00105 2361 00   ldq       pr6|69              m\r
+000315  aa   000006 6044 04   tmoz      6,ic                000323\r
+                                                            STATEMENT 1 ON LINE\r
+\c 112\r
+            substr (wrk, j + 3, 1) = numbers (m);\r
+\r
+000316  aa  6 00103 2351 00   lda       pr6|67              j\r
+000317  aa  040 105 100 406   mlr       (ql),(pr,al),fill(040)\r
+000320  ta   000002 00 0001   desc9a    2,1\r
+000321  aa  6 00117 40 0001   desc9a    pr6|79(2),1         wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 113\r
+            j = j + 1;\r
+\r
+000322  aa  6 00103 0541 00   aos       pr6|67              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 114\r
+         end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 115\r
+         m = divide (n, 10, 17);\r
+\r
+000323  aa  6 00106 2361 00   ldq       pr6|70              n\r
+000324  aa   000012 5060 07   div       10,dl\r
+000325  aa  6 00105 7561 00   stq       pr6|69              m\r
+                                                            STATEMENT 1 ON LINE\r
+\c 116\r
+         n = n - m * 10;\r
+\r
+000326  aa   000012 4020 07   mpy       10,dl\r
+000327  aa  6 00133 7561 00   stq       pr6|91\r
+000330  aa  6 00133 3361 00   lcq       pr6|91\r
+000331  aa  6 00106 0561 00   asq       pr6|70              n\r
+                                                            STATEMENT 1 ON LINE\r
+\c 117\r
+         if m > 0 then do;\r
+\r
+000332  aa  6 00105 2361 00   ldq       pr6|69              m\r
+000333  aa   000006 6044 04   tmoz      6,ic                000341\r
+                                                            STATEMENT 1 ON LINE\r
+\c 118\r
+            substr (wrk, j + 3, 1) = numbers (m);\r
+\r
+000334  aa  6 00103 2351 00   lda       pr6|67              j\r
+000335  aa  040 105 100 406   mlr       (ql),(pr,al),fill(040)\r
+000336  ta   000002 00 0001   desc9a    2,1\r
+000337  aa  6 00117 40 0001   desc9a    pr6|79(2),1         wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 119\r
+            j = j + 1;\r
+\r
+000340  aa  6 00103 0541 00   aos       pr6|67              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 120\r
+         end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 121\r
+         substr (wrk, j + 3, 1) = numbers (n);\r
+\r
+000341  aa  6 00103 2351 00   lda       pr6|67              j\r
+000342  aa  6 00106 7271 00   lxl7      pr6|70              n\r
+000343  aa  040 105 100 417   mlr       (x7),(pr,al),fill(040)\r
+000344  ta   000002 00 0001   desc9a    2,1\r
+000345  aa  6 00117 40 0001   desc9a    pr6|79(2),1         wrk\r
+                                                            STATEMENT 1 ON LINE\r
+\c 122\r
+         j = j + 3;\r
+\r
+000346  aa   000003 2360 07   ldq       3,dl\r
+000347  aa  6 00103 0561 00   asq       pr6|67              j\r
+                                                            STATEMENT 1 ON LINE\r
+\c 123\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 124\r
+      if len - ip < j - i + 1 then do;\r
+\r
+000350  aa  6 00103 2361 00   ldq       pr6|67              j\r
+000351  aa  6 00102 1761 00   sbq       pr6|66              i\r
+000352  aa   000001 0760 07   adq       1,dl\r
+000353  aa  6 00133 7561 00   stq       pr6|91\r
+000354  aa   000040 2360 07   ldq       32,dl\r
+000355  aa  6 00032 3735 20   epp7      pr6|26,*\r
+000356  aa  7 00004 1761 20   sbq       pr7|4,*             ip\r
+000357  aa  6 00133 1161 00   cmpq      pr6|91\r
+000360  aa   000013 6050 04   tpl       11,ic               000373\r
+                                                            STATEMENT 1 ON LINE\r
+\c 125\r
+         substr (string, ip, len - ip) = (26)"*";\r
+\r
+000361  aa   000040 2360 07   ldq       32,dl\r
+000362  aa  7 00004 1761 20   sbq       pr7|4,*             ip\r
+000363  aa  7 00004 7271 20   lxl7      pr7|4,*             ip\r
+000364  aa  7 00002 3715 20   epp5      pr7|2,*\r
+000365  aa  040 157 100 404   mlr       (ic),(pr,rl,x7),fill(040)\r
+000366  aa   000035 00 0032   desc9a    29,26               000422 = 0520520520\r
+\c52\r
+000367  aa  5 77777 60 0006   desc9a    pr5|-1(3),ql        string\r
+                                                            STATEMENT 1 ON LINE\r
+\c 126\r
+         ip = len + 1;\r
+\r
+000370  aa   000041 2360 07   ldq       33,dl\r
+000371  aa  7 00004 7561 20   stq       pr7|4,*             ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 127\r
+         return;\r
+\r
+000372  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 128\r
+      end;\r
+\r
+                                                            STATEMENT 1 ON LINE\r
+\c 129\r
+      substr (string, ip, j - i + 1) = substr (wrk, i, j - i + 1);\r
+\r
+000373  aa  6 00103 2361 00   ldq       pr6|67              j\r
+000374  aa  6 00102 1761 00   sbq       pr6|66              i\r
+000375  aa   000001 0760 07   adq       1,dl\r
+000376  aa   000000 6250 06   eax5      0,ql\r
+000377  aa  6 00103 2361 00   ldq       pr6|67              j\r
+000400  aa  6 00102 1761 00   sbq       pr6|66              i\r
+000401  aa   000001 0760 07   adq       1,dl\r
+000402  aa  7 00004 7271 20   lxl7      pr7|4,*             ip\r
+000403  aa  7 00002 3715 20   epp5      pr7|2,*\r
+000404  aa  6 00102 7261 00   lxl6      pr6|66              i\r
+000405  aa  040 157 100 556   mlr       (pr,rl,x6),(pr,rl,x7),fill(040)\r
+000406  aa  6 00116 60 0006   desc9a    pr6|78(3),ql        wrk\r
+000407  aa  5 77777 60 0015   desc9a    pr5|-1(3),x5        string\r
+                                                            STATEMENT 1 ON LINE\r
+\c 130\r
+      ip = ip + j - i + 1;\r
+\r
+000410  aa  7 00004 2361 20   ldq       pr7|4,*             ip\r
+000411  aa  6 00103 0761 00   adq       pr6|67              j\r
+000412  aa  6 00102 1761 00   sbq       pr6|66              i\r
+000413  aa   000001 0760 07   adq       1,dl\r
+000414  aa  7 00004 7561 20   stq       pr7|4,*             ip\r
+                                                            STATEMENT 1 ON LINE\r
+\c 131\r
+      return;\r
+\r
+000415  aa  0 00631 7101 00   tra       pr0|409             return_mac\r
+                                                            STATEMENT 1 ON LINE\r
+\c 132\r
+   end;\r
+\r
+  END PROCEDURE ffop\r
+

diff --git a/pl1/ffop.pl1 b/pl1/ffop.pl1
new file mode 100644 (file)
index 0000000..6108709
--- /dev/null
+++ b/pl1/ffop.pl1
@@ -0,0 +1,135 @@
+/****^  ***********************************************************\r
+        *                                                         *\r
+        * Copyright, (C) Honeywell Bull Inc., 1989                *\r
+        *                                                         *\r
+        * Copyright, (C) Honeywell Information Systems Inc., 1982 *\r
+        *                                                         *\r
+        * Copyright (c) 1972 by Massachusetts Institute of        *\r
+        * Technology and Honeywell Information Systems, Inc.      *\r
+        *                                                         *\r
+        *********************************************************** */\r
+\r
+\r
+\r
+\r
+/****^  HISTORY COMMENTS:\r
+  1) change(88-10-19,Lee), approve(88-11-21,MCR8025), audit(88-12-23,Flegel),\r
+     install(89-01-23,MR12.3-1010):\r
+     Commands 393 (phx16310) - fixed bug displaying small numbers when\r
+     ten**(prec-mag) exceeds exponent size.\r
+                                                   END HISTORY COMMENTS */\r
+\r
+\r
+/* format: style4,ind3 */\r
+\r
+ffop: proc (string, ip, value);\r
+\r
+dcl  (ip, mag, dif, i, j, k, m, n) fixed bin (17);\r
+dcl  val float bin (63);\r
+dcl  roundit float bin (63) static internal init (0.5e0);\r
+dcl  ten float bin (63) static internal init (10e0);\r
+dcl  (num, numt) fixed bin (71);\r
+dcl  value float bin (27);\r
+dcl  numbers (0:9) char (1) static internal init ("0", "1", "2", "3", "4", "5",\r
+\c "6", "7", "8", "9");\r
+dcl  string char (32) aligned;\r
+dcl  sign char (1) aligned;\r
+dcl  wrk char (26) aligned;\r
+dcl  (prec init (6), len init (32)) fixed bin (17) internal static;\r
+dcl  temp float bin (63);\r
+dcl  (divide, log10, multiply, substr) builtin;\r
+\r
+dcl  1 e aligned,\r
+       2 p bit (1) aligned,\r
+       2 old_mag fixed bin (17) aligned;\r
+\r
+      wrk = " ";\r
+      e.p = "0"b;\r
+      sign = " ";\r
+      val = value;\r
+      if val = 0.e0 then do;\r
+         mag = prec - 1;\r
+         go to no_log;\r
+      end;\r
+      if val < 0.e0 then do;\r
+         val = -val;\r
+         sign = "-";\r
+      end;\r
+      mag = log10 (val);\r
+      if mag < 0 then mag = mag - 1;\r
+      if mag > prec then go to e_stuff;\r
+      if mag < -1 then do;\r
+\r
+e_stuff: e.p = "1"b;\r
+         e.old_mag = mag;\r
+\r
+/* fixed for phx16310 - if value if mag is small, */\r
+/* ten**(prec-mag) may generate exponent overflow; */\r
+/* multiply in two steps to prevent this condition */\r
+\r
+         val = multiply (val, ten ** (prec), 63);\r
+         val = multiply (val, ten ** (-mag), 63);\r
+\r
+         num = val + roundit;\r
+         mag = 0;\r
+         dif = 0;\r
+         go to no_dif;\r
+      end;\r
+      if mag < 0 then mag = mag - 1;\r
+\r
+no_log:\r
+      temp = 10e0 ** (prec - mag);\r
+      num = val * temp + roundit;\r
+\r
+no_dif:\r
+      mag = mag + 18 - prec;\r
+      i = 18;\r
+\r
+next_num:\r
+      if i = mag then do;\r
+         substr (wrk, i, 1) = ".";\r
+         i = i - 1;\r
+      end;\r
+      numt = divide (num, 10, 63, 0);\r
+      k = num - numt * 10;\r
+      num = numt;\r
+      substr (wrk, i, 1) = numbers (k);\r
+      i = i - 1;\r
+      if num > 0 then go to next_num;\r
+      if i >= mag - 1 then go to next_num;\r
+      substr (wrk, i, 1) = sign;\r
+      do j = 18 to mag by -1 while (substr (wrk, j, 1) = "0" | substr (wrk, j, \r
+\c1) = ".");\r
+      end;\r
+      if e.p then do;\r
+         substr (wrk, j + 1, 1) = "E";\r
+         if e.old_mag < 0 then do;\r
+            substr (wrk, j + 2, 1) = "-";\r
+            e.old_mag = -e.old_mag;\r
+         end;\r
+         else substr (wrk, j + 2, 1) = "+";\r
+         m = divide (e.old_mag, 100, 17);\r
+         n = e.old_mag - m * 100;\r
+         if m > 0 then do;\r
+            substr (wrk, j + 3, 1) = numbers (m);\r
+            j = j + 1;\r
+         end;\r
+         m = divide (n, 10, 17);\r
+         n = n - m * 10;\r
+         if m > 0 then do;\r
+            substr (wrk, j + 3, 1) = numbers (m);\r
+            j = j + 1;\r
+         end;\r
+         substr (wrk, j + 3, 1) = numbers (n);\r
+         j = j + 3;\r
+      end;\r
+      if len - ip < j - i + 1 then do;\r
+         substr (string, ip, len - ip) = (26)"*";\r
+         ip = len + 1;\r
+         return;\r
+      end;\r
+      substr (string, ip, j - i + 1) = substr (wrk, i, j - i + 1);\r
+      ip = ip + j - i + 1;\r
+      return;\r
+   end;\r
+

diff --git a/tape/unarchive_all.sh b/tape/unarchive_all.sh
index a953124..3d44f63 100755 (executable)
--- a/tape/unarchive_all.sh
+++ b/tape/unarchive_all.sh
@@ -1,11 +1,11 @@
 #!/bin/sh
-for i in `find char -name '*.archive' -print`
+find word -name '*.dir' -print |while read line
 do
-  echo $i
-  mkdir ${i}__temp__
-  if ./unarchive.py $i ${i}__temp__
+  echo $line
+  mkdir ${line}__temp__
+  if ./unarchive.py $i ${line}__temp__
   then
-    rm $i
-    mv ${i}__temp__ $i
+    rm $line
+    mv ${line}__temp__ $line
   fi
 done

diff --git a/tape/xlate.sh b/tape/xlate.sh
new file mode 100755 (executable)
index 0000000..8d881e5
--- /dev/null
+++ b/tape/xlate.sh
@@ -0,0 +1,21 @@
+#!/bin/sh
+dir=$1
+result=1
+while read line
+do
+  set $line
+  file=$1
+  if ../dump_segments $dir/$file >__segtemp__
+  then
+    while read line
+    do
+      if test "$line" != "$file"
+      then
+        echo "$line $file"
+        result=0
+      fi
+    done <__segtemp__
+  fi
+  rm -f __segtemp__
+done <$dir/.dir
+exit $result

diff --git a/tape/xlate_all.sh b/tape/xlate_all.sh
new file mode 100755 (executable)
index 0000000..230c9aa
--- /dev/null
+++ b/tape/xlate_all.sh
@@ -0,0 +1,11 @@
+#!/bin/sh
+find word -name '.dir' -print |while read line
+do
+  echo $line
+  dirname=`dirname $line`
+  if ./xlate.sh $dirname >__xlatetemp__
+  then
+    LC_ALL=C sort <__xlatetemp__ >$dirname/.xlate
+  fi
+  rm __xlatetemp__
+done