multics_sim.c

   1 #include <fcntl.h>
   2 #include <setjmp.h>
   3 #include <stdbool.h>
   4 #include <stdint.h>
   5 #include <stdio.h>
   6 #include <stdlib.h>
   7 #include <string.h>
   8 #include <sys/mman.h>
   9 #include <sys/stat.h>
  10 #include <unistd.h>
  11 #include "access_mode_values.h"
  12 #include "area_info.h"
  13 #include "definition_dcls.h"
  14 #include "dps8/dps8.h"
  15 #include "dps8/dps8_cpu.h"
  16 #include "dps8/dps8_simh.h"
  17 #include "dps8/dps8_sys.h"
  18 //#include "iox_modes.h"
  19 #include "linkdcl.h"
  20 #include "object_map.h"
  21 #include "pointer.h"
  22 #include "rassert.h"
  23 #include "stack_frame.h"
  24 #include "stack_header.h"
  25
  26 #define NAME_LEN 0x20
  27 #define DEBUG_NAME_LEN 0x100
  28 #define LINE_LEN 0x100
  29 #define PATH_LEN 0x1000
  30 #define RESULT_LEN 0x400 // must be multiple of 4
  31 #define DNAME_LEN 168
  32
  33 struct arg_list {
  34   uint64_t code : 18;
  35   uint64_t arg_count : 18;
  36   uint64_t dummy0 : 28;
  37
  38   uint64_t pad0 : 18;
  39   uint64_t desc_count : 18;
  40   uint64_t dummy1 : 28;
  41
  42   struct its_pointer args[];
  43 };
  44
  45 struct arg_desc {
  46   uint64_t size : 24;
  47   uint64_t number_dims : 4;
  48   uint64_t packed : 1;
  49   uint64_t type : 6;
  50   uint64_t flag : 1;
  51   uint64_t dummy0 : 28;
  52 };
  53
  54 // dcl 01 based_entry aligned based,
  55 struct based_entry {
  56   // 02 code_ptr ptr,
  57   struct its_pointer code_ptr;
  58   // 02 env_ptr ptr;
  59   struct its_pointer env_ptr;
  60 };
  61
  62 // make these configurable later
  63 const char *multics_root = "tape/word";
  64 const char *multics_home = ">sim_home";
  65 const char *multics_process = ">sim_process";
  66 const char *search_path[] = {
  67   ">library_dir_dir>system_library_1>execution",
  68   ">system_library_1",
  69   ">system_library_3rd_party>C_COMPILER>executable",
  70   ">system_library_obsolete",
  71   ">system_library_standard",
  72   ">system_library_tools",
  73   ">system_library_unbundled"
  74 };
  75 #define N_SEARCH_PATH (sizeof(search_path) / sizeof(const char *))
  76
  77 #define N_SYSTEM_LINK 0x100
  78 int n_system_link;
  79 struct system_link {
  80   struct system_link *next;
  81   int n_words;
  82   int offset;
  83   char name[NAME_LEN + 1];
  84 } system_link[N_SYSTEM_LINK];
  85
  86 #define N_DEBUG_SYMBOL 0x10000
  87 int n_debug_symbol;
  88 struct debug_symbol {
  89   int offset;
  90   const char *name;
  91 } debug_symbol[N_DEBUG_SYMBOL];
  92
  93 struct debug_symbol debug_symbol_pl1_operators[] = {
  94 #include "pl1_operators_.inc"
  95 };
  96 #define N_DEBUG_SYMBOL_PL1_OPERATORS \
  97   (sizeof(debug_symbol_pl1_operators) / sizeof(struct debug_symbol))
  98
  99 #define N_KNOWN_SEGMENT 0x100
 100 int n_known_segment;
 101 struct known_segment {
 102   const char *path;
 103   int segment;
 104   int bitcount;
 105   int linkage_offset;
 106   int n_debug_symbol;
 107   struct debug_symbol *debug_symbol;
 108   struct system_link *system_link_head;
 109   int n_ref_name;
 110   bool writeable;
 111 } known_segment[N_KNOWN_SEGMENT];
 112 struct known_segment *hcs;
 113 struct known_segment *iox;
 114 struct known_segment *sys_info;
 115
 116 #define N_SEGMENT 0x200
 117 int n_segment;
 118 struct known_segment *segment_to_known_segment[N_SEGMENT];
 119
 120 #define N_REF_NAME_TO_KNOWN_SEGMENT 0x400
 121 int n_ref_name_to_known_segment;
 122 struct ref_name_to_known_segment {
 123   const char *ref_name;
 124   struct known_segment *known_segment;
 125 } ref_name_to_known_segment[N_REF_NAME_TO_KNOWN_SEGMENT];
 126
 127 int linkage_segment;
 128 int next_linkage_offset;
 129 int emcall_stubs_offset;
 130 struct packed_pointer *lot;
 131 struct packed_pointer *isot;
 132
 133 int stack_segment;
 134 int next_stack_offset;
 135 struct stack_header *stack_header;
 136
 137 struct known_segment *iox;
 138 struct its_pointer *user_input;
 139 struct its_pointer *user_output;
 140 struct its_pointer *error_output;
 141
 142 struct known_segment *error_table;
 143 uint64_t *end_of_info;
 144 uint64_t *long_record;
 145 uint64_t *segknown;
 146 uint64_t *short_record;
 147
 148 jmp_buf exit_emulation;
 149
 150 void get_acc_string(uint64_t *acc_string, char *buf, int buf_len) {
 151   int len = (acc_string[0] >> 27) & 0777;
 152   rassert(len < buf_len);
 153
 154   static const int shifts[4] = {27, 18, 9, 0};
 155   for (int i = 0, j = 1; i < len; ++i, ++j)
 156     buf[i] = (char)(acc_string[j >> 2] >> shifts[j & 3]);
 157   buf[len] = 0;
 158 }
 159
 160 void get_string(char *buf, const uint64_t *string, int string_len) {
 161   static const int shifts[4] = {27, 18, 9, 0};
 162   for (int i = 0; i < string_len; ++i)
 163     buf[i] = (char)(string[i >> 2] >> shifts[i & 3]);
 164   buf[string_len] = 0;
 165 }
 166
 167 void get_string_rstrip(char *buf, const uint64_t *string, int string_len) {
 168   static const int shifts[4] = {27, 18, 9, 0};
 169   for (int i = 0; i < string_len; ++i)
 170     buf[i] = (char)(string[i >> 2] >> shifts[i & 3]);
 171   while (string_len && buf[string_len - 1] == ' ')
 172     --string_len;
 173   buf[string_len] = 0;
 174 }
 175
 176 int allocate_segment(void) {
 177   rassert(n_segment < N_SEGMENT);
 178   return n_segment++;
 179 }
 180
 181 int scratch_segment(void) {
 182   int segment = allocate_segment();
 183
 184   M[segment] = (word36 *)mmap(
 185     NULL,
 186     01000000 * sizeof(uint64_t),
 187     PROT_READ | PROT_WRITE,
 188     MAP_ANONYMOUS | MAP_PRIVATE,
 189     -1,
 190     (off_t)0
 191   );
 192   rassert(M[segment] != (word36 *)-1);
 193
 194   return segment;
 195 }
 196
 197 struct object_map *get_object_map(struct known_segment *p) {
 198   rassert(p->bitcount % 36 == 0);
 199   int wordcount = (p->bitcount / 36) & 0777777;
 200   rassert(wordcount >= 1);
 201   struct object_map *object_map = (struct object_map *)(
 202     M[p->segment] + (
 203       (M[p->segment][(wordcount - 1) & 0777777] >> 18) & 0777777
 204     )
 205   );
 206   rassert(object_map->decl_vers == 2);
 207   rassert(object_map->identifier[0] == 0157142152137); // 'obj_'
 208   rassert(object_map->identifier[1] == 0155141160040); // 'map '
 209
 210   return object_map;
 211 }
 212
 213 int allocate_linkage(int length, int align) {
 214   align -= 1;
 215   next_linkage_offset = (next_linkage_offset + align) & ~align;
 216   rassert(next_linkage_offset + length <= 01000000);
 217   int offset = next_linkage_offset;
 218   next_linkage_offset += length;
 219   return offset;
 220 }
 221
 222 int allocate_stack(int length, int align) {
 223   align -= 1;
 224   next_stack_offset = (next_stack_offset + align) & ~align;
 225   rassert(next_stack_offset + length <= 01000000);
 226   int offset = next_stack_offset;
 227   next_stack_offset += length;
 228   return offset;
 229 }
 230
 231 struct known_segment *make_known_segment(
 232   const char *dir_name,
 233   const char *entryname,
 234   bool writeable
 235 ) {
 236   // construct path to directory, translating multics separators
 237   int multics_root_len = strlen(multics_root);
 238   int dir_name_len = strlen(dir_name);
 239   char path[PATH_LEN];
 240   rassert(multics_root_len + dir_name_len + 1 < PATH_LEN);
 241   memcpy(path, multics_root, multics_root_len);
 242   for (int i = 0; i < dir_name_len; ++i) {
 243     int c = dir_name[i];
 244     path[multics_root_len + i] = c == '>' ? '/' : c == '/' ? '_' : c;
 245   }
 246   path[multics_root_len + dir_name_len] = '/';
 247
 248   // try to open directly
 249   int entryname_len = strlen(entryname);
 250   rassert(multics_root_len + dir_name_len + entryname_len < PATH_LEN);
 251   strcpy(path + multics_root_len + dir_name_len + 1, entryname);
 252   int fd = open(path, writeable ? O_RDWR : O_RDONLY);
 253   char line[LINE_LEN];
 254   if (fd == -1) {
 255     // try to open via an alias
 256     rassert(multics_root_len + dir_name_len + 1 + 6 < PATH_LEN);
 257     strcpy(path + multics_root_len + dir_name_len + 1, ".xlate");
 258
 259     FILE *fp = fopen(path, "r");
 260     if (fp == NULL)
 261       return NULL;
 262     while (fgets(line, sizeof(line), fp)) {
 263       char *p = strchr(line, ' ');
 264       if (p) {
 265         *p++ = 0;
 266         if (strcmp(line, entryname) == 0) {
 267           char *q = strchr(p, '\n');
 268           if (q)
 269             *q = 0;
 270           int p_len = strlen(p);
 271           rassert(multics_root_len + dir_name_len + 1 + p_len < PATH_LEN);
 272           strcpy(path + multics_root_len + dir_name_len + 1, p);
 273           fd = open(path, writeable ? O_RDWR : O_RDONLY);
 274           if (fd != -1) {
 275             fclose(fp);
 276             fprintf(stderr, "xlate entryname %s to %s\n", entryname, p);
 277             entryname = p;
 278             entryname_len = p_len;
 279             goto found_alias;
 280           }
 281         }
 282       }
 283     }
 284     fclose(fp);
 285     return NULL;
 286   found_alias:
 287     ;
 288   }
 289
 290   // see if already known under the found path (can be tricked)
 291   for (int i = 0; i < n_known_segment; ++i) {
 292     struct known_segment *p = known_segment + i;
 293     if (strcmp(p->path, path) == 0) {
 294       close(fd);
 295       return p;
 296     }
 297   }
 298
 299   // allocate table entries
 300   rassert(n_known_segment < N_KNOWN_SEGMENT);
 301   struct known_segment *p = known_segment + n_known_segment++;
 302   p->path = strdup(path);
 303   rassert(p->path);
 304   p->segment = allocate_segment();
 305   fprintf(stderr, "load %s into segment %06o\n", path, p->segment);
 306   segment_to_known_segment[p->segment] = p;
 307   p->writeable = writeable;
 308
 309   // map into memory
 310   M[p->segment] = (word36 *)mmap(
 311     NULL,
 312     01000000 * sizeof(uint64_t),
 313     PROT_READ | PROT_WRITE,
 314     writeable ? 0 : MAP_PRIVATE,
 315     fd,
 316     (off_t)0
 317   );
 318   rassert(M[p->segment] != (word36 *)-1);
 319   close(fd);
 320
 321   // see if we can find bitcount for segment
 322   rassert(multics_root_len + dir_name_len + 1 + 4 < PATH_LEN);
 323   strcpy(path + multics_root_len + dir_name_len + 1, ".dir");
 324
 325   FILE *fp = fopen(path, "r");
 326   if (fp) {
 327     char line[LINE_LEN];
 328     while (fgets(line, sizeof(line), fp)) {
 329       char *q = strchr(line, ' ');
 330       if (q) {
 331         *q++ = 0;
 332         if (strcmp(line, entryname) == 0) {
 333           p->bitcount = (int)strtol(q, NULL, 0);
 334           break;
 335         }
 336       }
 337     }
 338     fclose(fp);
 339   }
 340
 341   return p;
 342 }
 343
 344 struct known_segment *initiate_segment(
 345   const char *dir_name,
 346   const char *entryname,
 347   const char *ref_name,
 348   bool writeable,
 349   bool *already
 350 ) {
 351   // see if already known under this ref_name
 352   for (int i = 0; i < n_ref_name_to_known_segment; ++i)
 353     if (strcmp(ref_name_to_known_segment[i].ref_name, ref_name) == 0) {
 354       if (already)
 355         *already = true;
 356       return ref_name_to_known_segment[i].known_segment;
 357     }
 358
 359   // try either given dir_name or search path
 360   struct known_segment *p;
 361   if (dir_name) {
 362     p = make_known_segment(dir_name, entryname, writeable);
 363     if (p == NULL)
 364       return NULL;
 365   }
 366   else {
 367     for (int i = 0; i < N_SEARCH_PATH; ++i) {
 368       p = make_known_segment(search_path[i], entryname, writeable);
 369       if (p)
 370         goto found_search_path;
 371     }
 372     return NULL;
 373   found_search_path:
 374     ;
 375   }
 376
 377   // make known under this ref_name
 378   rassert(n_ref_name_to_known_segment < N_REF_NAME_TO_KNOWN_SEGMENT);
 379   struct ref_name_to_known_segment *q =
 380     ref_name_to_known_segment + n_ref_name_to_known_segment++;
 381   q->ref_name = strdup(ref_name);
 382   rassert(q->ref_name);
 383   q->known_segment = p;
 384   ++(p->n_ref_name);
 385
 386   if (already)
 387     *already = false;
 388   return p;
 389 }
 390
 391 int compare_debug_symbol(const void *p, const void *q) {
 392   return
 393     ((const struct debug_symbol *)p)->offset <
 394       ((const struct debug_symbol *)q)->offset ?
 395       -1 :
 396       ((const struct debug_symbol *)p)->offset >
 397         ((const struct debug_symbol *)q)->offset ?
 398         1 :
 399         strcmp(
 400           ((const struct debug_symbol *)p)->name,
 401           ((const struct debug_symbol *)q)->name
 402         );
 403 }
 404
 405 struct debug_symbol *find_debug_symbol(struct known_segment *p, int offset) {
 406   for (int i = p->n_debug_symbol; --i >= 0; ) {
 407     struct debug_symbol *q = p->debug_symbol + i;
 408     if (q->offset <= offset)
 409       return p->debug_symbol + i;
 410   }
 411   return NULL;
 412 }
 413
 414 int nesting;
 415 char *lookup_address(int segment, int offset) {
 416   if (segment >= N_SEGMENT)
 417     return NULL;
 418   struct known_segment *p = segment_to_known_segment[segment];
 419   if (p == NULL)
 420     return NULL;
 421
 422   struct debug_symbol *q = find_debug_symbol(p, offset);
 423   if (q == NULL)
 424     return NULL;
 425
 426   static char text[DEBUG_NAME_LEN + 0x20];
 427   int i = nesting & 0xf;
 428   memset(text, ' ', i);
 429   sprintf(text + i, "<%s + %06o>", q->name, offset - q->offset);
 430   return text;
 431 }
 432
 433 struct its_pointer find_definition(
 434   struct known_segment *p,
 435   const char *name,
 436   int class,
 437   bool entry
 438 ) {
 439   // redirect specific entry points to emcall stubs
 440   if (p == hcs) {
 441     if (strcmp(name, "make_entry") == 0)
 442       return its_pointer(linkage_segment, emcall_stubs_offset);
 443     if (strcmp(name, "make_ptr") == 0)
 444       return its_pointer(linkage_segment, emcall_stubs_offset + 3);
 445     if (strcmp(name, "make_seg") == 0)
 446       return its_pointer(linkage_segment, emcall_stubs_offset + 6);
 447     if (strcmp(name, "proc_info") == 0)
 448       return its_pointer(linkage_segment, emcall_stubs_offset + 9);
 449     if (strcmp(name, "set_ips_mask") == 0)
 450       return its_pointer(linkage_segment, emcall_stubs_offset + 12);
 451     if (strcmp(name, "reset_ips_mask") == 0)
 452       return its_pointer(linkage_segment, emcall_stubs_offset + 15);
 453     if (strcmp(name, "fs_search_get_wdir") == 0)
 454       return its_pointer(linkage_segment, emcall_stubs_offset + 18);
 455     if (strcmp(name, "initiate_count") == 0)
 456       return its_pointer(linkage_segment, emcall_stubs_offset + 21);
 457     if (strcmp(name, "fs_get_mode") == 0)
 458       return its_pointer(linkage_segment, emcall_stubs_offset + 24);
 459     if (strcmp(name, "high_low_seg_count") == 0)
 460       return its_pointer(linkage_segment, emcall_stubs_offset + 27);
 461     if (
 462       strcmp(name, ".my_lp") &&
 463         strcmp(name, "cpu_time_and_paging_") &&
 464         strcmp(name, "get_authorization")
 465     ) {
 466       fprintf(stderr, "unsupported emcall hcs_$%s\n", name);
 467       exit(EXIT_FAILURE);
 468     }
 469   }
 470   else if (p == iox) {
 471     if (strcmp(name, "get_line") == 0)
 472       return its_pointer(linkage_segment, emcall_stubs_offset + 30);
 473     if (strcmp(name, "put_chars") == 0)
 474       return its_pointer(linkage_segment, emcall_stubs_offset + 33);
 475     if (
 476       strcmp(name, "user_input") &&
 477         strcmp(name, "user_output") &&
 478         strcmp(name, "error_output") &&
 479         strcmp(name, "init_standard_iocbs") &&
 480         strcmp(name, "syn_attach") &&
 481         strcmp(name, "get_group_id_") &&
 482         strcmp(name, "modes")
 483     ) {
 484       fprintf(stderr, "unsupported emcall iox_$%s\n", name);
 485       exit(EXIT_FAILURE);
 486     }
 487   }
 488   else if (p == sys_info) {
 489     if (strcmp(name, "service_system") == 0)
 490       return its_pointer(linkage_segment, emcall_stubs_offset + 36);
 491   }
 492
 493   struct object_map *object_map = get_object_map(p);
 494   struct definition_header *definition_header = (struct definition_header *)(
 495     M[p->segment] + object_map->definition_offset
 496   );
 497
 498   for (
 499     struct definition *definition = (struct definition *)(
 500       (uint64_t *)definition_header + definition_header->def_list_relp
 501     );
 502     *(uint64_t *)definition;
 503     definition = (struct definition *)(
 504       (uint64_t *)definition_header + definition->forward_relp
 505     )
 506   ) {
 507     rassert(definition->class <= CLASS_HEAP);
 508     if (
 509       definition->class != CLASS_SEGNAME &&
 510       !definition->flags_ignore &&
 511       (class == -1 || definition->class == class) &&
 512       (!entry || definition->flags_entry)
 513     ) {
 514       char definition_name[NAME_LEN + 1];
 515       get_acc_string(
 516         (uint64_t *)definition_header + definition->name_relp,
 517         definition_name,
 518         NAME_LEN
 519       );
 520
 521       if (strcmp(definition_name, name) == 0)
 522         switch (definition->class) {
 523         case CLASS_TEXT:
 524           return its_pointer(
 525             p->segment,
 526             (int)(object_map->text_offset + definition->thing_relp)
 527           );
 528         case CLASS_LINKAGE:
 529           return its_pointer(
 530             linkage_segment,
 531             (int)(p->linkage_offset + definition->thing_relp)
 532           );
 533         default:
 534           fprintf(
 535             stderr,
 536             "unimplemented class %s in segment %s definition %s\n",
 537             class_names[definition->class],
 538             p->path,
 539             name
 540           );
 541           exit(EXIT_FAILURE);
 542         }
 543     }
 544   }
 545
 546   fprintf(
 547     stderr,
 548     "can't find segment %s definition %s\n",
 549     p->path,
 550     name
 551   );
 552   exit(EXIT_FAILURE);
 553 }
 554
 555 struct known_segment *link_segment(
 556   const char *dir_name,
 557   const char *entryname,
 558   const char *ref_name
 559 ) {
 560   struct known_segment *p =
 561     initiate_segment(dir_name, entryname, ref_name, false, NULL);
 562   rassert(p);
 563
 564   if (p->linkage_offset == 0) {
 565     struct object_map *object_map = get_object_map(p);
 566
 567     // validate linkage header
 568     rassert(
 569       object_map->linkage_length >=
 570         sizeof(struct linkage_header) / sizeof(uint64_t)
 571     );
 572     struct virgin_linkage_header *virgin_linkage_header =
 573       (struct virgin_linkage_header *)(
 574         M[p->segment] + object_map->linkage_offset
 575       );
 576     rassert(virgin_linkage_header->def_offset == object_map->definition_offset);
 577     rassert(virgin_linkage_header->first_ref_relp == 0);
 578     rassert(virgin_linkage_header->static_length == object_map->static_length);
 579
 580     // copy and fill in linkage section
 581     p->linkage_offset = allocate_linkage(object_map->linkage_length, 2);
 582     fprintf(
 583       stderr,
 584       "allocate_linkage %06o$[%06o, %06o)\n",
 585       linkage_segment,
 586       p->linkage_offset,
 587       p->linkage_offset + (int)object_map->linkage_length
 588     );
 589     if (strcmp(ref_name, "hcs_") == 0) {
 590       hcs = p;
 591       struct its_pointer my_lp_pointer = find_definition(
 592         p,
 593         ".my_lp",
 594         -1,
 595         false
 596       );
 597       *(struct its_pointer *)(
 598         M[my_lp_pointer.segment] + my_lp_pointer.offset
 599       ) = its_pointer(
 600         linkage_segment,
 601         p->linkage_offset
 602       );
 603     }
 604     else if (
 605       strcmp(ref_name, "iox_") == 0 ||
 606         strcmp(ref_name, "get_group_id_") == 0
 607     )
 608       iox = p;
 609     else if (strcmp(ref_name, "sys_info") == 0)
 610       sys_info = p;
 611     struct linkage_header *linkage_header = (struct linkage_header *)(
 612       M[linkage_segment] + p->linkage_offset
 613     );
 614     memcpy(
 615       linkage_header,
 616       virgin_linkage_header,
 617       object_map->linkage_length * sizeof(uint64_t)
 618     );
 619     linkage_header->def_ptr = its_pointer(
 620       p->segment,
 621       object_map->definition_offset
 622     );
 623     linkage_header->symbol_ptr = packed_pointer(
 624       p->segment,
 625       object_map->symbol_offset
 626     );
 627     linkage_header->original_linkage_ptr = packed_pointer(
 628       p->segment,
 629       object_map->linkage_offset
 630     );
 631     linkage_header->stats_segment_number = linkage_segment;
 632
 633     // copy static section
 634     int static_offset = allocate_linkage(object_map->static_length, 2);
 635     memcpy(
 636       M[linkage_segment] + static_offset,
 637       M[p->segment] + object_map->static_offset,
 638       object_map->static_length * sizeof(uint64_t)
 639     );
 640
 641     // update LOT, ISOT and LOT/ISOT high water
 642     lot[p->segment] = packed_pointer(linkage_segment, p->linkage_offset);
 643     isot[p->segment] = packed_pointer(linkage_segment, static_offset);
 644     stack_header->cur_lot_size = n_segment;
 645
 646     // create debug symbol table (optional)
 647     struct definition_header *definition_header = (struct definition_header *)(
 648       M[p->segment] + object_map->definition_offset
 649     );
 650
 651     int n_debug_symbol0 = n_debug_symbol;
 652     char name_buf[DEBUG_NAME_LEN + 1];
 653     int segname_len = 0;
 654     for (
 655       struct definition *definition = (struct definition *)(
 656         (uint64_t *)definition_header + definition_header->def_list_relp
 657       );
 658       *(uint64_t *)definition;
 659       definition = (struct definition *)(
 660         (uint64_t *)definition_header + definition->forward_relp
 661       )
 662     )
 663       if (definition->class == CLASS_SEGNAME) {
 664         get_acc_string(
 665           (uint64_t *)definition_header + definition->name_relp,
 666           name_buf,
 667           DEBUG_NAME_LEN - 1
 668         );
 669         segname_len = strlen(name_buf);
 670         name_buf[segname_len] = '$';
 671       }
 672       else if (definition->class == CLASS_TEXT) {
 673         rassert(n_debug_symbol < N_DEBUG_SYMBOL);
 674         struct debug_symbol *q = debug_symbol + n_debug_symbol++;
 675         q->offset = object_map->text_offset + definition->thing_relp;
 676
 677         get_acc_string(
 678           (uint64_t *)definition_header + definition->name_relp,
 679           name_buf + segname_len + 1,
 680           DEBUG_NAME_LEN - segname_len - 1
 681         );
 682         q->name = strdup(name_buf);
 683         rassert(q->name);
 684       }
 685
 686     p->n_debug_symbol = n_debug_symbol - n_debug_symbol0;
 687     p->debug_symbol = debug_symbol + n_debug_symbol0;
 688
 689     qsort(
 690       p->debug_symbol,
 691       p->n_debug_symbol,
 692       sizeof(struct debug_symbol),
 693       compare_debug_symbol
 694     );
 695   }
 696   return p;
 697 }
 698
 699 // callback from simulator when fault type 2 occurs
 700 void snap_link(void) {
 701   fprintf(
 702     stderr,
 703     "fault type 2 at %06o:%06o accessing %06o:%06o\n",
 704     cpu.PPR.PSR,
 705     cpu.PPR.IC,
 706     cpu.TPR.TSR,
 707     cpu.TPR.CA
 708   );
 709
 710   // find segment of faulting instruction (for validation purposes)
 711   rassert(cpu.PPR.PSR < n_segment);
 712   struct known_segment *p = segment_to_known_segment[cpu.PPR.PSR];
 713   rassert(p);
 714
 715   // validate link address, using read-only linkage section (safer)
 716   struct object_map *object_map = get_object_map(p);
 717   struct virgin_linkage_header *virgin_linkage_header =
 718     (struct virgin_linkage_header *)(
 719       M[p->segment] + object_map->linkage_offset
 720     );
 721   rassert(
 722     cpu.TPR.TSR == linkage_segment &&
 723     (cpu.TPR.CA & 1) == 0 &&
 724     cpu.TPR.CA >=
 725       p->linkage_offset + virgin_linkage_header->first_ref_relp &&
 726     cpu.TPR.CA <
 727       p->linkage_offset + object_map->linkage_length
 728   );
 729
 730   // validate link, using read-only linkage section (safer)
 731   int link_relp = (int)(cpu.TPR.CA - p->linkage_offset);
 732   struct link *virgin_link = (struct link *)(
 733     (uint64_t *)virgin_linkage_header + link_relp
 734   );
 735   rassert(virgin_link->head_ptr == (-link_relp & 0777777));
 736   rassert(virgin_link->ft2 == 046);
 737
 738   // make sure writeable copy of link hasn't been corrupted
 739   struct its_pointer *link = (struct its_pointer *)(
 740     M[cpu.TPR.TSR] + cpu.TPR.CA
 741   );
 742   rassert(memcmp(link, virgin_link, sizeof(struct link)) == 0);
 743
 744   // look up link target
 745   struct definition_header *definition_header = (struct definition_header *)(
 746     M[p->segment] + object_map->definition_offset
 747   );
 748   struct exp_word *exp_word = (struct exp_word *)(
 749     (uint64_t *)definition_header + virgin_link->exp_ptr
 750   );
 751   struct type_pair *type_pair = (struct type_pair *)(
 752     (uint64_t *)definition_header + exp_word->type_relp
 753   );
 754   //rassert(type_pair->trap_relp == 0);
 755   rassert(
 756     type_pair->type >= LINK_SELF_BASE &&
 757       type_pair->type <= LINK_CREATE_IF_NOT_FOUND
 758   );
 759
 760   // process link by type
 761   char offsetname[NAME_LEN + 1];
 762   get_acc_string(
 763     (uint64_t *)definition_header + type_pair->offsetname_relp,
 764     offsetname,
 765     NAME_LEN
 766   );
 767
 768   char segname[NAME_LEN + 1];
 769   static const int section_to_class[] = {
 770     CLASS_TEXT,
 771     CLASS_LINKAGE,
 772     CLASS_SYMBOL,
 773     -1,
 774     CLASS_STATIC
 775   };
 776   switch (type_pair->type) {
 777   case LINK_REFNAME_OFFSETNAME:
 778     rassert(type_pair->trap_relp == 0);
 779     get_acc_string(
 780       (uint64_t *)definition_header + type_pair->segname_relp,
 781       segname,
 782       NAME_LEN
 783     );
 784     *link = find_definition(
 785       link_segment(NULL, segname, segname),
 786       offsetname,
 787       -1,
 788       false
 789     );
 790     break;
 791   case LINK_SELF_OFFSETNAME:
 792     switch (type_pair->segname_relp) {
 793     case SECTION_TEXT: // 0
 794     case SECTION_LINK: // 1
 795     case SECTION_SYMBOL: // 2
 796     case SECTION_STATIC: // 4
 797       rassert(type_pair->trap_relp == 0);
 798       *link = find_definition(
 799         p,
 800         offsetname,
 801         section_to_class[type_pair->segname_relp],
 802         false
 803       );
 804       break;
 805     case SECTION_SYSTEM:
 806       ;
 807       struct link_init *link_init = (struct link_init *)(
 808         (uint64_t *)definition_header + type_pair->trap_relp
 809       );
 810       rassert(link_init->n_words < 01000000);
 811       rassert(link_init->type == INIT_NO_INIT);
 812
 813       {
 814         struct system_link *q;
 815         for (q = p->system_link_head; q; q = q->next)
 816           if (strcmp(q->name, offsetname) == 0) {
 817             rassert(q->n_words == (int)link_init->n_words);
 818             goto found_system_link;
 819           }
 820
 821         rassert(n_system_link < N_SYSTEM_LINK);
 822         q = system_link + n_system_link++;
 823         q->n_words = (int)link_init->n_words;
 824         q->offset = allocate_linkage((int)link_init->n_words, 2);
 825         strcpy(q->name, offsetname);
 826
 827       found_system_link:
 828         *link = its_pointer(linkage_segment, q->offset);
 829       }
 830       break;
 831     }
 832     break;
 833   default:
 834     fprintf(
 835       stderr,
 836       "unimplemented link type %s\n",
 837       link_type_names[type_pair->type - 1]
 838     );
 839     exit(EXIT_FAILURE);
 840   }
 841
 842   link->offset += exp_word->expression;
 843   link->modifier1 = virgin_link->modifier;
 844   fprintf(
 845     stderr,
 846     "snap link %06o:%06o -> %s$%s + %06o -> %06o:%06o\n",
 847     (int)cpu.TPR.TSR,
 848     (int)cpu.TPR.CA,
 849     type_pair->type == LINK_SELF_OFFSETNAME ?
 850       symbolic_section_names[type_pair->segname_relp] :
 851       segname,
 852     offsetname,
 853     (int)exp_word->expression,
 854     (int)link->segment,
 855     (int)link->offset
 856   );
 857 }
 858
 859 void emcall_exit_emulation(void) {
 860   longjmp(exit_emulation, 1);
 861 }
 862
 863 void emcall_make_entry(void) {
 864   struct arg_list *arg_list = (struct arg_list *)(
 865     M[cpu.PR[0].SNR] + cpu.PR[0].WORDNO
 866   );
 867
 868   rassert(arg_list->arg_count == 10);
 869   struct its_pointer *ref_pointer = (struct its_pointer *)(
 870     M[arg_list->args[0].segment] + arg_list->args[0].offset
 871   );
 872   uint64_t *entryname = (uint64_t *)(
 873     M[arg_list->args[1].segment] + arg_list->args[1].offset
 874   );
 875   uint64_t *entry_point_name = (uint64_t *)(
 876     M[arg_list->args[2].segment] + arg_list->args[2].offset
 877   );
 878   struct based_entry *entry_point = (struct based_entry *)(
 879     M[arg_list->args[3].segment] + arg_list->args[3].offset
 880   );
 881   uint64_t *code = (uint64_t *)(
 882     M[arg_list->args[4].segment] + arg_list->args[4].offset
 883   );
 884
 885   rassert(arg_list->desc_count == 10);
 886   struct arg_desc *entryname_desc = (struct arg_desc *)(
 887     M[arg_list->args[6].segment] + arg_list->args[6].offset
 888   );
 889   struct arg_desc *entry_point_name_desc = (struct arg_desc *)(
 890     M[arg_list->args[7].segment] + arg_list->args[7].offset
 891   );
 892
 893   char entryname_buf[NAME_LEN + 1];
 894   rassert(entryname_desc->size < NAME_LEN + 1);
 895   get_string_rstrip(
 896     entryname_buf,
 897     entryname,
 898     entryname_desc->size
 899   );
 900
 901   char entry_point_name_buf[NAME_LEN + 1];
 902   rassert(entry_point_name_desc->size < NAME_LEN + 1);
 903   get_string_rstrip(
 904     entry_point_name_buf,
 905     entry_point_name,
 906     entry_point_name_desc->size
 907   );
 908
 909   entry_point->code_ptr =
 910     entry_point_name_buf[0] ?
 911       find_definition(
 912         link_segment(
 913           NULL,
 914           entryname_buf,
 915           entryname_buf
 916         ),
 917         entry_point_name_buf,
 918         -1,
 919         false
 920       ) :
 921       its_pointer(
 922         link_segment(
 923           NULL,
 924           entryname_buf,
 925           entryname_buf
 926         )->segment,
 927         0
 928       );
 929   entry_point->env_ptr = its_pointer(-1, 1);
 930   *code = 0;
 931
 932   fprintf(
 933     stderr,
 934     "make_entry %s$%s -> %06o:%06o\n",
 935     entryname_buf,
 936     entry_point_name_buf,
 937     entry_point->code_ptr.segment,
 938     entry_point->code_ptr.offset
 939   );
 940 }
 941
 942 void emcall_make_ptr(void) {
 943   struct arg_list *arg_list = (struct arg_list *)(
 944     M[cpu.PR[0].SNR] + cpu.PR[0].WORDNO
 945   );
 946
 947   rassert(arg_list->arg_count == 10);
 948   //struct its_pointer *ref_pointer = (struct its_pointer *)(
 949   //  M[arg_list->args[0].segment] + arg_list->args[0].offset
 950   //);
 951   uint64_t *entryname = (uint64_t *)(
 952     M[arg_list->args[1].segment] + arg_list->args[1].offset
 953   );
 954   uint64_t *entry_point_name = (uint64_t *)(
 955     M[arg_list->args[2].segment] + arg_list->args[2].offset
 956   );
 957   struct its_pointer *entry_point_pointer = (struct its_pointer *)(
 958     M[arg_list->args[3].segment] + arg_list->args[3].offset
 959   );
 960   uint64_t *code = (uint64_t *)(
 961     M[arg_list->args[4].segment] + arg_list->args[4].offset
 962   );
 963
 964   rassert(arg_list->desc_count == 10);
 965   struct arg_desc *entryname_desc = (struct arg_desc *)(
 966     M[arg_list->args[6].segment] + arg_list->args[6].offset
 967   );
 968   struct arg_desc *entry_point_name_desc = (struct arg_desc *)(
 969     M[arg_list->args[7].segment] + arg_list->args[7].offset
 970   );
 971
 972   char entryname_buf[NAME_LEN + 1];
 973   rassert(entryname_desc->size < NAME_LEN + 1);
 974   get_string_rstrip(
 975     entryname_buf,
 976     entryname,
 977     entryname_desc->size
 978   );
 979
 980   char entry_point_name_buf[NAME_LEN + 1];
 981   rassert(entry_point_name_desc->size < NAME_LEN + 1);
 982   get_string_rstrip(
 983     entry_point_name_buf,
 984     entry_point_name,
 985     entry_point_name_desc->size
 986   );
 987
 988   *entry_point_pointer =
 989     entry_point_name_buf[0] ?
 990       find_definition(
 991         link_segment(
 992           NULL,
 993           entryname_buf,
 994           entryname_buf
 995         ),
 996         entry_point_name_buf,
 997         -1,
 998         false
 999       ) :
1000       its_pointer(
1001         initiate_segment(
1002           NULL,
1003           entryname_buf,
1004           entryname_buf,
1005           false,
1006           NULL
1007         )->segment,
1008         0
1009       );
1010   *code = 0;
1011
1012   fprintf(
1013     stderr,
1014     "make_ptr %s$%s -> %06o:%06o\n",
1015     entryname_buf,
1016     entry_point_name_buf,
1017     entry_point_pointer->segment,
1018     entry_point_pointer->offset
1019   );
1020 }
1021
1022 void emcall_make_seg(void) {
1023   struct arg_list *arg_list = (struct arg_list *)(
1024     M[cpu.PR[0].SNR] + cpu.PR[0].WORDNO
1025   );
1026
1027   rassert(arg_list->arg_count == 12);
1028   uint64_t *dir_name = (uint64_t *)(
1029     M[arg_list->args[0].segment] + arg_list->args[0].offset
1030   );
1031   uint64_t *entryname = (uint64_t *)(
1032     M[arg_list->args[1].segment] + arg_list->args[1].offset
1033   );
1034   uint64_t *ref_name = (uint64_t *)(
1035     M[arg_list->args[2].segment] + arg_list->args[2].offset
1036   );
1037   uint64_t *mode = (uint64_t *)(
1038     M[arg_list->args[3].segment] + arg_list->args[3].offset
1039   );
1040   struct its_pointer *seg_ptr = (struct its_pointer *)(
1041     M[arg_list->args[4].segment] + arg_list->args[4].offset
1042   );
1043   uint64_t *code = (uint64_t *)(
1044     M[arg_list->args[5].segment] + arg_list->args[5].offset
1045   );
1046
1047   rassert(arg_list->desc_count == 12);
1048   struct arg_desc *dir_name_desc = (struct arg_desc *)(
1049     M[arg_list->args[6].segment] + arg_list->args[6].offset
1050   );
1051   struct arg_desc *entryname_desc = (struct arg_desc *)(
1052     M[arg_list->args[7].segment] + arg_list->args[7].offset
1053   );
1054   struct arg_desc *ref_name_desc = (struct arg_desc *)(
1055     M[arg_list->args[8].segment] + arg_list->args[8].offset
1056   );
1057
1058   char dir_name_buf[PATH_LEN];
1059   rassert(dir_name_desc->size < PATH_LEN);
1060   get_string_rstrip(
1061     dir_name_buf,
1062     dir_name,
1063     dir_name_desc->size
1064   );
1065   if (dir_name_buf[0] == 0) {
1066     rassert(strlen(multics_process) < PATH_LEN);
1067     strcpy(dir_name_buf, multics_process);
1068   }
1069
1070   char entryname_buf[NAME_LEN + 1];
1071   rassert(entryname_desc->size < NAME_LEN + 1);
1072   get_string_rstrip(
1073     entryname_buf,
1074     entryname,
1075     entryname_desc->size
1076   );
1077
1078   char ref_name_buf[NAME_LEN + 1];
1079   rassert(ref_name_desc->size < NAME_LEN + 1);
1080   get_string_rstrip(
1081     ref_name_buf,
1082     ref_name,
1083     ref_name_desc->size
1084   );
1085
1086   // see if already known under this ref_name
1087   struct known_segment *p;
1088   for (int i = 0; i < n_ref_name_to_known_segment; ++i)
1089     if (strcmp(ref_name_to_known_segment[i].ref_name, ref_name_buf) == 0) {
1090       p = ref_name_to_known_segment[i].known_segment;
1091       *code = *segknown;
1092       goto already_known;
1093     }
1094   *code = 0;
1095
1096   // allocate table entries
1097   rassert(n_known_segment < N_KNOWN_SEGMENT);
1098   p = known_segment + n_known_segment++;
1099   p->path = "";
1100   p->segment = scratch_segment();
1101   fprintf(
1102     stderr,
1103     "make ref_name %s with segment %06o\n",
1104     ref_name_buf,
1105     p->segment
1106   );
1107   segment_to_known_segment[p->segment] = p;
1108   p->writeable = true;
1109
1110   // make known under this ref_name
1111   rassert(n_ref_name_to_known_segment < N_REF_NAME_TO_KNOWN_SEGMENT);
1112   struct ref_name_to_known_segment *q =
1113     ref_name_to_known_segment + n_ref_name_to_known_segment++;
1114   q->ref_name = strdup(ref_name_buf);
1115   rassert(q->ref_name);
1116   q->known_segment = p;
1117   ++(p->n_ref_name);
1118
1119 already_known:
1120   *seg_ptr = its_pointer(p->segment, 0);
1121
1122   fprintf(
1123     stderr,
1124     "make_seg %s>%s %s -> %06o:%06o\n",
1125     dir_name_buf,
1126     entryname_buf,
1127     ref_name_buf,
1128     seg_ptr->segment,
1129     seg_ptr->offset
1130   );
1131 }
1132
1133 void emcall_proc_info(void) {
1134   fprintf(stderr, "proc_info -> ignored\n");
1135 }
1136
1137 void emcall_set_ips_mask(void) {
1138   fprintf(stderr, "set_ips_mask -> ignored\n");
1139 }
1140
1141 void emcall_reset_ips_mask(void) {
1142   fprintf(stderr, "reset_ips_mask -> ignored\n");
1143 }
1144
1145 void emcall_fs_search_get_wdir(void) {
1146   struct arg_list *arg_list = (struct arg_list *)(
1147     M[cpu.PR[0].SNR] + cpu.PR[0].WORDNO
1148   );
1149
1150   rassert(arg_list->arg_count == 4);
1151   struct its_pointer *a_pathptr = (struct its_pointer *)(
1152     M[arg_list->args[0].segment] + arg_list->args[0].offset
1153   );
1154   uint64_t *a_pathcnt = (uint64_t *)(
1155     M[arg_list->args[1].segment] + arg_list->args[1].offset
1156   );
1157
1158   char path_buf[DNAME_LEN + 1];
1159   int path_len = strlen(multics_home);
1160   rassert(path_len < DNAME_LEN + 1);
1161   strcpy(path_buf, multics_home);
1162
1163   uint64_t *a_path = (uint64_t *)(
1164     M[a_pathptr->segment] + a_pathptr->offset
1165   );
1166   static const int shifts[] = {27, 18, 9, 0};
1167   int i;
1168   for (i = 0; i < path_len; ++i) {
1169     int j = i >> 2;
1170     int k = i & 3;
1171     a_path[j] =
1172       (a_path[j] & ~((uint64_t)0777 << shifts[k])) |
1173         ((uint64_t)path_buf[i] << shifts[k]);
1174   }
1175   for (; i < DNAME_LEN; ++i) {
1176     int j = i >> 2;
1177     int k = i & 3;
1178     a_path[j] =
1179       (a_path[j] & ~((uint64_t)0777 << shifts[k])) |
1180         ((uint64_t)' ' << shifts[k]);
1181   }
1182   *a_pathcnt = path_len;
1183
1184   fprintf(stderr, "fs_search_get_wdir -> %s\n", path_buf);
1185 }
1186
1187 void emcall_initiate_count(void) {
1188   struct arg_list *arg_list = (struct arg_list *)(
1189     M[cpu.PR[0].SNR] + cpu.PR[0].WORDNO
1190   );
1191
1192   rassert(arg_list->arg_count == 14);
1193   uint64_t *dir_name = (uint64_t *)(
1194     M[arg_list->args[0].segment] + arg_list->args[0].offset
1195   );
1196   uint64_t *entryname = (uint64_t *)(
1197     M[arg_list->args[1].segment] + arg_list->args[1].offset
1198   );
1199   uint64_t *ref_name = (uint64_t *)(
1200     M[arg_list->args[2].segment] + arg_list->args[2].offset
1201   );
1202   uint64_t *bit_count = (uint64_t *)(
1203     M[arg_list->args[3].segment] + arg_list->args[3].offset
1204   );
1205   //uint64_t *copy_ctl_sw = (uint64_t *)(
1206   //  M[arg_list->args[4].segment] + arg_list->args[4].offset
1207   //);
1208   struct its_pointer *seg_ptr = (struct its_pointer *)(
1209     M[arg_list->args[5].segment] + arg_list->args[5].offset
1210   );
1211   uint64_t *code = (uint64_t *)(
1212     M[arg_list->args[6].segment] + arg_list->args[6].offset
1213   );
1214
1215   rassert(arg_list->desc_count == 14);
1216   struct arg_desc *dir_name_desc = (struct arg_desc *)(
1217     M[arg_list->args[7].segment] + arg_list->args[7].offset
1218   );
1219   struct arg_desc *entryname_desc = (struct arg_desc *)(
1220     M[arg_list->args[8].segment] + arg_list->args[8].offset
1221   );
1222   struct arg_desc *ref_name_desc = (struct arg_desc *)(
1223     M[arg_list->args[9].segment] + arg_list->args[9].offset
1224   );
1225
1226   char dir_name_buf[PATH_LEN];
1227   rassert(dir_name_desc->size < PATH_LEN);
1228   get_string_rstrip(
1229     dir_name_buf,
1230     dir_name,
1231     dir_name_desc->size
1232   );
1233
1234   char entryname_buf[NAME_LEN + 1];
1235   rassert(entryname_desc->size < NAME_LEN + 1);
1236   get_string_rstrip(
1237     entryname_buf,
1238     entryname,
1239     entryname_desc->size
1240   );
1241
1242   char ref_name_buf[NAME_LEN + 1];
1243   rassert(ref_name_desc->size < NAME_LEN + 1);
1244   get_string_rstrip(
1245     ref_name_buf,
1246     ref_name,
1247     ref_name_desc->size
1248   );
1249
1250   bool already;
1251   struct known_segment *p = initiate_segment(
1252     dir_name_buf,
1253     entryname_buf,
1254     ref_name_buf,
1255     true,
1256     &already
1257   );
1258   *bit_count = p->bitcount;
1259   *seg_ptr = its_pointer(p->segment, 0);
1260   *code = already ? *segknown : 0;
1261
1262   fprintf(
1263     stderr,
1264     "initiate_count %s>%s %s -> %06o:%06o\n",
1265     dir_name_buf,
1266     entryname_buf,
1267     ref_name_buf,
1268     seg_ptr->segment,
1269     seg_ptr->offset
1270   );
1271 }
1272
1273 void emcall_fs_get_mode(void) {
1274   struct arg_list *arg_list = (struct arg_list *)(
1275     M[cpu.PR[0].SNR] + cpu.PR[0].WORDNO
1276   );
1277
1278   rassert(arg_list->arg_count == 6);
1279   struct its_pointer *seg_ptr = (struct its_pointer *)(
1280     M[arg_list->args[0].segment] + arg_list->args[0].offset
1281   );
1282   uint64_t *mode = (uint64_t *)(
1283     M[arg_list->args[1].segment] + arg_list->args[1].offset
1284   );
1285   uint64_t *code = (uint64_t *)(
1286     M[arg_list->args[2].segment] + arg_list->args[2].offset
1287   );
1288
1289   rassert(seg_ptr->segment < n_segment);
1290   struct known_segment *p = segment_to_known_segment[seg_ptr->segment];
1291   rassert(p);
1292
1293   *mode = p->writeable ? RW_ACCESS_BIN : R_ACCESS_BIN;
1294   *code = 0;
1295
1296   fprintf(
1297     stderr,
1298     "fs_get_mode %06o:%06o -> %lo\n",
1299     seg_ptr->segment,
1300     seg_ptr->offset,
1301     *mode
1302   );
1303 }
1304
1305 void emcall_high_low_seg_count(void) {
1306   struct arg_list *arg_list = (struct arg_list *)(
1307     M[cpu.PR[0].SNR] + cpu.PR[0].WORDNO
1308   );
1309
1310   rassert(arg_list->arg_count == 4);
1311   uint64_t *nonhardcore_seg_count = (uint64_t *)(
1312     M[arg_list->args[0].segment] + arg_list->args[0].offset
1313   );
1314   uint64_t *lowest_nonhardcore_segno = (uint64_t *)(
1315     M[arg_list->args[1].segment] + arg_list->args[1].offset
1316   );
1317
1318   *nonhardcore_seg_count = n_segment;
1319   *lowest_nonhardcore_segno = 1;
1320
1321   fprintf(
1322     stderr,
1323     "emcall_high_low_seg_count returns %012lo, %012lo\n",
1324     *nonhardcore_seg_count,
1325     *lowest_nonhardcore_segno
1326   );
1327 }
1328
1329
1330 void emcall_get_line(void) {
1331   struct arg_list *arg_list = (struct arg_list *)(
1332     M[cpu.PR[0].SNR] + cpu.PR[0].WORDNO
1333   );
1334
1335   rassert(arg_list->arg_count == 10);
1336   struct its_pointer *iocb_ptr = (struct its_pointer *)(
1337     M[arg_list->args[0].segment] + arg_list->args[0].offset
1338   );
1339   struct its_pointer *buff_ptr = (struct its_pointer *)(
1340     M[arg_list->args[1].segment] + arg_list->args[1].offset
1341   );
1342   uint64_t *buff_len = (uint64_t *)(
1343     M[arg_list->args[2].segment] + arg_list->args[2].offset
1344   );
1345   uint64_t *n_read = (uint64_t *)(
1346     M[arg_list->args[3].segment] + arg_list->args[3].offset
1347   );
1348   uint64_t *code = (uint64_t *)(
1349     M[arg_list->args[4].segment] + arg_list->args[4].offset
1350   );
1351
1352   FILE *fp;
1353   if (
1354     iocb_ptr->segment == user_input->segment &&
1355       iocb_ptr->offset == user_input->offset
1356   )
1357     fp = stdin;
1358   else
1359     rassert(false);
1360
1361   fprintf(stderr, "emcall_get_line %ld\n", *buff_len);
1362
1363   *n_read = 0;
1364   uint64_t *buff = (uint64_t *)(M[buff_ptr->segment] + buff_ptr->offset);
1365   static const int shifts[] = {27, 18, 9, 0};
1366   while (*n_read < *buff_len) {
1367     int c = fgetc(fp);
1368     if (c == EOF) {
1369       *code = *n_read ? *short_record : *end_of_info;
1370       fprintf(stderr, "emcall_get_line returns %ld, %012lo\n", *n_read, *code);
1371       return;
1372     }
1373     size_t i = (size_t)(*n_read >> 2);
1374     int j = (int)(*n_read & 3);
1375     ++*n_read;
1376     buff[i] =
1377       (buff[i] & ~((uint64_t)0777 << shifts[j])) |
1378         ((uint64_t)c << shifts[j]);
1379     if (c == '\n') {
1380       *code = 0;
1381       fprintf(stderr, "emcall_get_line returns %ld, %012lo\n", *n_read, *code);
1382       return;
1383     }
1384   }
1385   *code = *long_record;
1386   fprintf(stderr, "emcall_get_line returns %ld, %012lo\n", *n_read, *code);
1387 }
1388
1389 void emcall_put_chars(void) {
1390   struct arg_list *arg_list = (struct arg_list *)(
1391     M[cpu.PR[0].SNR] + cpu.PR[0].WORDNO
1392   );
1393
1394   rassert(arg_list->arg_count == 8);
1395   struct its_pointer *iocb_ptr = (struct its_pointer *)(
1396     M[arg_list->args[0].segment] + arg_list->args[0].offset
1397   );
1398   struct its_pointer *buff_ptr = (struct its_pointer *)(
1399     M[arg_list->args[1].segment] + arg_list->args[1].offset
1400   );
1401   uint64_t *n = (uint64_t *)(
1402     M[arg_list->args[2].segment] + arg_list->args[2].offset
1403   );
1404   uint64_t *code = (uint64_t *)(
1405     M[arg_list->args[3].segment] + arg_list->args[3].offset
1406   );
1407
1408   FILE *fp;
1409   if (
1410     iocb_ptr->segment == user_output->segment &&
1411       iocb_ptr->offset == user_output->offset
1412   )
1413     fp = stdout;
1414   else if (
1415     iocb_ptr->segment == error_output->segment &&
1416       iocb_ptr->offset == error_output->offset
1417   )
1418     fp = stderr;
1419   else
1420     rassert(false);
1421
1422   fprintf(stderr, "emcall_put_chars %ld\n", *n);
1423
1424   uint64_t *buff = (uint64_t *)(M[buff_ptr->segment] + buff_ptr->offset);
1425   static const int shifts[] = {27, 18, 9, 0};
1426   for (uint64_t i = 0; i < *n; ++i)
1427     fputc((char)(buff[i >> 2] >> shifts[i & 3]), fp);
1428  fflush(fp);
1429
1430   *code = 0;
1431 }
1432
1433 int main(int argc, char **argv) {
1434   bool af = false;
1435   if (argc >= 2 && strcmp(argv[1], "--af") == 0) {
1436     af = true;
1437     memmove(argv + 1, argv + 2, (argc - 2) * sizeof(char **));
1438     --argc;
1439   }
1440   if (argc < 2) {
1441     printf(
1442       "usage: %s [--af] entry_segname$entry_name [arguments]\n",
1443       argv[0]
1444     );
1445     exit(EXIT_FAILURE);
1446   }
1447   char *entry_segname, *entry_name;
1448   {
1449     char *p = strchr(argv[1], '$');
1450     rassert(p);
1451     *p++ = 0;
1452     entry_segname = argv[1];
1453     entry_name = p;
1454   }
1455   int n_args = argc - 2;
1456   char **args = argv + 2;
1457
1458   // initialize CPU
1459   sim_deb = stderr;
1460   cpu_dev.dctrl =
1461     DBG_TRACE |
1462     //DBG_MSG |
1463     //DBG_REGDUMPAQI |
1464     //DBG_REGDUMPIDX |
1465     //DBG_REGDUMPPR |
1466     //DBG_REGDUMPPPR |
1467     //DBG_REGDUMPDSBR |
1468     //DBG_REGDUMPFLT |
1469     //DBG_REGDUMP |
1470     //DBG_ADDRMOD |
1471     //DBG_APPENDING |
1472     //DBG_TRACEEXT |
1473     DBG_WARN |
1474     //DBG_DEBUG |
1475     //DBG_INFO |
1476     //DBG_NOTIFY |
1477     //DBG_SIM_USES_16 |
1478     //DBG_SIM_USES_17 |
1479     //DBG_SIM_USES_18 |
1480     //DBG_ERR |
1481     //DBG_ALL |
1482     DBG_FAULT |
1483     //DBG_INTR |
1484     //DBG_CORE |
1485     //DBG_CYCLE |
1486     //DBG_CAC |
1487     //DBG_FINAL |
1488     //DBG_AVC |
1489     0;
1490   cpu_reset_unit_idx(0, false);
1491   set_addr_mode(APPEND_mode);
1492
1493   // initialize memory
1494   uint64_t *null_segment = mmap(
1495     NULL,
1496     01000000 * sizeof(uint64_t),
1497     PROT_NONE,
1498     MAP_ANONYMOUS | MAP_PRIVATE,
1499     -1,
1500     (off_t)0
1501   );
1502   rassert(null_segment != (uint64_t *)-1);
1503   for (int i = 0; i < 0100000; ++i)
1504     M[i] = (word36 *)null_segment;
1505   n_segment = 1;
1506
1507   // create linkage segment
1508   linkage_segment = scratch_segment();
1509   //next_linkage_offset = 0;
1510
1511   // create stack segment
1512   stack_segment = scratch_segment();
1513   next_stack_offset = sizeof(struct stack_header) / sizeof(uint64_t);
1514   stack_header = (struct stack_header *)M[stack_segment];
1515   stack_header->null_ptr = its_pointer(-1, 1);
1516   stack_header->ect_ptr = its_pointer(-1, 1);
1517   stack_header->heap_header_ptr = its_pointer(-1, 1);
1518   stack_header->sys_link_info_ptr = its_pointer(-1, 1);
1519
1520   // allocate LOT and ISOT
1521   stack_header->max_lot_size = N_SEGMENT;
1522   int lot_offset = allocate_linkage(N_SEGMENT, 1);
1523   lot = (struct packed_pointer *)(M[linkage_segment] + lot_offset);
1524   stack_header->lot_ptr = its_pointer(linkage_segment, lot_offset);
1525   int isot_offset = allocate_linkage(N_SEGMENT, 1);
1526   isot = (struct packed_pointer *)(M[linkage_segment] + isot_offset);
1527   stack_header->isot_ptr = its_pointer(linkage_segment, isot_offset);
1528   int sct_offset = allocate_linkage(0, 1); // ???
1529   //sct = (struct packed_pointer *)(M[linkage_segment] + sct_offset);
1530   stack_header->sct_ptr = its_pointer(linkage_segment, sct_offset);
1531
1532   // load pl1 operators
1533   stack_header->signal_ptr = find_definition(
1534     link_segment(NULL, "signal_", "signal_"),
1535     "signal_",
1536     -1,
1537     false
1538   );
1539   stack_header->unwinder_ptr = find_definition(
1540     link_segment(NULL, "unwinder_", "unwinder_"),
1541     "unwinder_",
1542     -1,
1543     false
1544   );
1545   stack_header->trans_op_tv_ptr = find_definition(
1546     link_segment(NULL, "operator_pointers_", "operator_pointers_"),
1547     "operator_pointers_",
1548     -1,
1549     false
1550   );
1551
1552   struct known_segment *p =
1553     link_segment(NULL, "pl1_operators_", "pl1_operators_");
1554   struct its_pointer operator_table_pointer = find_definition(
1555     p,
1556     "operator_table",
1557     -1,
1558     false
1559   );
1560   stack_header->pl1_operators_ptr = operator_table_pointer;
1561   stack_header->call_op_ptr = find_definition(
1562     p,
1563     "alm_call",
1564     -1,
1565     false
1566   );
1567   stack_header->push_op_ptr = find_definition(
1568     p,
1569     "alm_push",
1570     -1,
1571     false
1572   );
1573   stack_header->return_op_ptr = find_definition(
1574     p,
1575     "alm_return",
1576     -1,
1577     false
1578   );
1579   stack_header->no_pop_op_ptr = find_definition(
1580     p,
1581     "alm_return_no_pop",
1582     -1,
1583     false
1584   );
1585   stack_header->entry_op_ptr = find_definition(
1586     p,
1587     "alm_entry",
1588     -1,
1589     false
1590   );
1591
1592   // optional: extra debugging symbols
1593   int begin_pl1_operators_offset = find_definition(
1594     p,
1595     "begin_pl1_operators",
1596     -1,
1597     false
1598   ).offset;
1599   rassert(n_debug_symbol + N_DEBUG_SYMBOL_PL1_OPERATORS <= N_DEBUG_SYMBOL);
1600   memcpy(
1601     debug_symbol + n_debug_symbol,
1602     debug_symbol_pl1_operators,
1603     sizeof(debug_symbol_pl1_operators)
1604   );
1605   for (int i = 0; i < N_DEBUG_SYMBOL_PL1_OPERATORS; ++i)
1606     debug_symbol[n_debug_symbol + i].offset += begin_pl1_operators_offset;
1607   n_debug_symbol += N_DEBUG_SYMBOL_PL1_OPERATORS;
1608   p->n_debug_symbol += N_DEBUG_SYMBOL_PL1_OPERATORS;
1609   qsort(
1610     p->debug_symbol,
1611     p->n_debug_symbol,
1612     sizeof(struct debug_symbol),
1613     compare_debug_symbol
1614   );
1615
1616   // initiate iox_ segment for emcall use
1617   struct known_segment *iox =
1618     link_segment(NULL, "iox_", "iox_");
1619   struct its_pointer user_input_pointer = find_definition(
1620     iox,
1621     "user_input",
1622     -1,
1623     false
1624   );
1625   user_input = (struct its_pointer *)(
1626     M[user_input_pointer.segment] + user_input_pointer.offset
1627   );
1628   struct its_pointer user_output_pointer = find_definition(
1629     iox,
1630     "user_output",
1631     -1,
1632     false
1633   );
1634   user_output = (struct its_pointer *)(
1635     M[user_output_pointer.segment] + user_output_pointer.offset
1636   );
1637   struct its_pointer error_output_pointer = find_definition(
1638     iox,
1639     "error_output",
1640     -1,
1641     false
1642   );
1643   error_output = (struct its_pointer *)(
1644     M[error_output_pointer.segment] + error_output_pointer.offset
1645   );
1646
1647   // initiate error_table segment for emcall use
1648   struct known_segment *error_table =
1649     link_segment(NULL, "error_table_", "error_table_");
1650   struct its_pointer end_of_info_pointer = find_definition(
1651     error_table,
1652     "end_of_info",
1653     -1,
1654     false
1655   );
1656   end_of_info = (uint64_t *)(
1657     M[end_of_info_pointer.segment] + end_of_info_pointer.offset
1658   );
1659   struct its_pointer long_record_pointer = find_definition(
1660     error_table,
1661     "long_record",
1662     -1,
1663     false
1664   );
1665   long_record = (uint64_t *)(
1666     M[long_record_pointer.segment] + long_record_pointer.offset
1667   );
1668   struct its_pointer segknown_pointer = find_definition(
1669     error_table,
1670     "segknown",
1671     -1,
1672     false
1673   );
1674   segknown = (uint64_t *)(
1675     M[segknown_pointer.segment] + segknown_pointer.offset
1676   );
1677   struct its_pointer short_record_pointer = find_definition(
1678     error_table,
1679     "short_record",
1680     -1,
1681     false
1682   );
1683   short_record = (uint64_t *)(
1684     M[short_record_pointer.segment] + short_record_pointer.offset
1685   );
1686
1687   // create first stack frame
1688   int stack_frame_offset = allocate_stack(
1689     sizeof(struct stack_frame) / sizeof(uint64_t),
1690     0x10
1691   );
1692   struct stack_frame *stack_frame = (struct stack_frame *)(
1693     M[stack_segment] + stack_frame_offset
1694   );
1695   stack_header->stack_begin_ptr = its_pointer(
1696     stack_segment,
1697     stack_frame_offset
1698   );
1699
1700   // create argument list, will be reused several times with different
1701   // sizes during initialization, also is a marker for resetting stack
1702   int arg_list_offset = allocate_stack(0, 2);
1703   struct arg_list *arg_list = (struct arg_list *)(
1704     M[stack_segment] + arg_list_offset
1705   );
1706
1707   // create emcall stubs
1708   emcall_stubs_offset = allocate_linkage(37, 1);
1709   uint64_t *emcall_stubs = (uint64_t *)(
1710     M[linkage_segment] + emcall_stubs_offset
1711   );
1712
1713   emcall_stubs[0] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1714   emcall_stubs[1] = 0000001420400L; // emcall make_entry
1715   emcall_stubs[2] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1716
1717   emcall_stubs[3] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1718   emcall_stubs[4] = 0000002420400L; // emcall make_ptr
1719   emcall_stubs[5] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1720
1721   emcall_stubs[6] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1722   emcall_stubs[7] = 0000003420400L; // emcall make_seg
1723   emcall_stubs[8] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1724
1725   emcall_stubs[9] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1726   emcall_stubs[10] = 0000004420400L; // emcall proc_info
1727   emcall_stubs[11] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1728
1729   emcall_stubs[12] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1730   emcall_stubs[13] = 0000005420400L; // emcall set_ips_mask
1731   emcall_stubs[14] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1732
1733   emcall_stubs[15] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1734   emcall_stubs[16] = 0000006420400L; // emcall reset_ips_mask
1735   emcall_stubs[17] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1736
1737   emcall_stubs[18] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1738   emcall_stubs[19] = 0000007420400L; // emcall fs_search_get_wdir
1739   emcall_stubs[20] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1740
1741   emcall_stubs[21] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1742   emcall_stubs[22] = 0000010420400L; // emcall initiate_count
1743   emcall_stubs[23] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1744
1745   emcall_stubs[24] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1746   emcall_stubs[25] = 0000011420400L; // emcall fs_get_mode
1747   emcall_stubs[26] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1748
1749   emcall_stubs[27] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1750   emcall_stubs[28] = 0000012420400L; // emcall high_low_seg_count
1751   emcall_stubs[29] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1752
1753   emcall_stubs[30] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1754   emcall_stubs[31] = 0000013420400L; // emcall get_line
1755   emcall_stubs[32] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1756
1757   emcall_stubs[33] = 0700046272120L; // tsp2 pr7|46,n* alm_entry
1758   emcall_stubs[34] = 0000014420400L; // emcall put_chars
1759   emcall_stubs[35] = 0700044710120L; // tra pr7|44,n* alm_return_no_pop
1760
1761   emcall_stubs[36] = 0400000000000L; // bit(1) indicating system is up
1762
1763   // create calling stub
1764   int calling_stub_offset = allocate_linkage(2, 1);
1765   uint64_t *calling_stub = (uint64_t *)(
1766     M[linkage_segment] + calling_stub_offset
1767   );
1768   stack_frame->return_ptr = its_pointer(
1769     linkage_segment,
1770     0 // will be overwritten by call_ext_out
1771   );
1772   calling_stub[0] = 0000622700100L; // tsx0 pr0|402 call_ext_out_desc
1773   calling_stub[1] = 0000000420400L; // emcall exit_emulation
1774
1775   // initialize area allocator
1776   fprintf(stderr, "call bound_library_1_$define_area_\n");
1777
1778   next_stack_offset = arg_list_offset;
1779   allocate_stack(sizeof(struct arg_list) / sizeof(uint64_t) + 4, 2);
1780
1781   int area_info_pointer_offset = allocate_stack(2, 2);
1782   arg_list->args[0] = its_pointer(stack_segment, area_info_pointer_offset);
1783
1784   struct its_pointer *area_info_pointer = (struct its_pointer *)(
1785     M[stack_segment] + area_info_pointer_offset
1786   );
1787   int area_info_offset = allocate_stack(
1788     sizeof(struct area_info) / sizeof(uint64_t),
1789     2
1790   );
1791   *area_info_pointer = its_pointer(stack_segment, area_info_offset);
1792
1793   struct area_info *area_info = (struct area_info *)(
1794     M[stack_segment] + area_info_offset
1795   );
1796   area_info->size = 0100000; // smaller than sys_info$max_seg_size
1797   area_info->areap = its_pointer(-1, 1);
1798   area_info->version = 1;
1799   memset(&area_info->control, 0, sizeof(area_info->control));
1800   area_info->control.extend = 1;
1801   area_info->control.zero_on_free = 1;
1802   area_info->control.system = 1;
1803   area_info->owner[0] = 0154151156153; // 'link'
1804   area_info->owner[1] = 0145162040040; // 'er  '
1805   area_info->owner[2] = 0040040040040; // '    '
1806   area_info->owner[3] = 0040040040040; // '    '
1807   area_info->owner[4] = 0040040040040; // '    '
1808   area_info->owner[5] = 0040040040040; // '    '
1809   area_info->owner[6] = 0040040040040; // '    '
1810   area_info->owner[7] = 0040040040040; // '    '
1811
1812   int code_offset = allocate_stack(1, 1);
1813   arg_list->args[1] = its_pointer(stack_segment, code_offset);
1814
1815   stack_header->stack_end_ptr = its_pointer(
1816     stack_segment,
1817     allocate_stack(0, 0x10)
1818   );
1819
1820   cpu.rA = 2 << 19;
1821   cpu.rX[1] = arg_list_offset;
1822
1823   cpu.PR[0].RNR = 3;
1824   cpu.PR[0].SNR = operator_table_pointer.segment;
1825   cpu.PR[0].WORDNO = operator_table_pointer.offset;
1826
1827   struct its_pointer define_area_pointer = find_definition(
1828     link_segment(NULL, "bound_library_1_", "bound_library_1_"),
1829     "define_area_",
1830     -1,
1831     false
1832   );
1833   cpu.PR[2].RNR = 3;
1834   cpu.PR[2].SNR = define_area_pointer.segment;
1835   cpu.PR[2].WORDNO = define_area_pointer.offset;
1836
1837   cpu.PR[6].RNR = 3;
1838   cpu.PR[6].SNR = stack_segment;
1839   cpu.PR[6].WORDNO = stack_frame_offset;
1840
1841   cpu.PPR.PRR = 3;
1842   cpu.PPR.PSR = linkage_segment;
1843   cpu.PPR.P = 0; // privilege
1844   cpu.PPR.IC = calling_stub_offset;
1845
1846   cpu.cycle = FETCH_cycle;
1847
1848   if (setjmp(exit_emulation) == 0) {
1849     sim_instr();
1850     rassert(false);
1851   }
1852
1853   rassert(M[stack_segment][code_offset] == 0);
1854   stack_header->system_free_ptr = area_info->areap;
1855   stack_header->user_free_ptr = area_info->areap;
1856   stack_header->system_free_ptr = area_info->areap;
1857   stack_header->assign_linkage_ptr = area_info->areap;
1858   stack_header->clr_ptr = area_info->areap;
1859
1860   // attach standard IOCBs
1861   // (they will not work -- but try to avoid crashes if accessed)
1862   fprintf(stderr, "call iox_$init_standard_iocbs\n");
1863
1864   next_stack_offset = arg_list_offset;
1865   allocate_stack(sizeof(struct arg_list) / sizeof(uint64_t), 2);
1866
1867   stack_header->stack_end_ptr = its_pointer(
1868     stack_segment,
1869     allocate_stack(0, 0x10)
1870   );
1871
1872   cpu.rA = 0;
1873   cpu.rX[1] = arg_list_offset;
1874
1875   cpu.PR[0].RNR = 3;
1876   cpu.PR[0].SNR = operator_table_pointer.segment;
1877   cpu.PR[0].WORDNO = operator_table_pointer.offset;
1878
1879   struct its_pointer init_standard_iocbs_pointer = find_definition(
1880     iox,
1881     "init_standard_iocbs",
1882     -1,
1883     false
1884   );
1885   cpu.PR[2].RNR = 3;
1886   cpu.PR[2].SNR = init_standard_iocbs_pointer.segment;
1887   cpu.PR[2].WORDNO = init_standard_iocbs_pointer.offset;
1888
1889   cpu.PR[6].RNR = 3;
1890   cpu.PR[6].SNR = stack_segment;
1891   cpu.PR[6].WORDNO = stack_frame_offset;
1892
1893   cpu.PPR.PRR = 3;
1894   cpu.PPR.PSR = linkage_segment;
1895   cpu.PPR.P = 0; // privilege
1896   cpu.PPR.IC = calling_stub_offset;
1897
1898   cpu.cycle = FETCH_cycle;
1899
1900   if (setjmp(exit_emulation) == 0) {
1901     sim_instr();
1902     rassert(false);
1903   }
1904
1905 #if 0 // opening does not work, gives a "not attached" error
1906   // open standard IOCBs
1907   fprintf(stderr, "call iox_$open\n");
1908
1909   next_stack_offset = arg_list_offset;
1910   allocate_stack(sizeof(struct arg_list) / sizeof(uint64_t) + 8, 2);
1911
1912   arg_list->args[0] = find_definition(
1913     iox,
1914     "user_io",
1915     -1,
1916     false
1917   );
1918
1919   int mode_offset = allocate_stack(1, 1);
1920   arg_list->args[1] = its_pointer(stack_segment, mode_offset);
1921   M[stack_segment][mode_offset] = STREAM_INPUT_OUTPUT;
1922
1923   int unused_offset = allocate_stack(1, 1);
1924   arg_list->args[2] = its_pointer(stack_segment, unused_offset);
1925   M[stack_segment][unused_offset] = 0;
1926
1927   /*int*/ code_offset = allocate_stack(1, 1);
1928   arg_list->args[3] = its_pointer(stack_segment, code_offset);
1929
1930   stack_header->stack_end_ptr = its_pointer(
1931     stack_segment,
1932     allocate_stack(0, 0x10)
1933   );
1934
1935   cpu.rA = 4 << 19;
1936   cpu.rX[1] = arg_list_offset;
1937
1938   cpu.PR[0].RNR = 3;
1939   cpu.PR[0].SNR = operator_table_pointer.segment;
1940   cpu.PR[0].WORDNO = operator_table_pointer.offset;
1941
1942   struct its_pointer open_pointer = find_definition(
1943     iox,
1944     "open",
1945     -1,
1946     false
1947   );
1948   cpu.PR[2].RNR = 3;
1949   cpu.PR[2].SNR = open_pointer.segment;
1950   cpu.PR[2].WORDNO = open_pointer.offset;
1951
1952   cpu.PR[6].RNR = 3;
1953   cpu.PR[6].SNR = stack_segment;
1954   cpu.PR[6].WORDNO = stack_frame_offset;
1955
1956   cpu.PPR.PRR = 3;
1957   cpu.PPR.PSR = linkage_segment;
1958   cpu.PPR.P = 0; // privilege
1959   cpu.PPR.IC = calling_stub_offset;
1960
1961   cpu.cycle = FETCH_cycle;
1962
1963   if (setjmp(exit_emulation) == 0) {
1964     sim_instr();
1965     rassert(false);
1966   }
1967
1968   rassert(M[stack_segment][code_offset] == 0);
1969 #endif
1970
1971   // call requested entry
1972   fprintf(stderr, "call %s$%s\n", entry_segname, entry_name);
1973
1974   int n_args_af = n_args + af;
1975   next_stack_offset = arg_list_offset;
1976   allocate_stack(
1977     sizeof(struct arg_list) / sizeof(uint64_t) + n_args_af * 4,
1978     2
1979   );
1980
1981   for (int i = 0; i < n_args; ++i) {
1982     int arg_len = strlen(args[i]);
1983     int arg_offset = allocate_stack((arg_len + 3) >> 2, 1);
1984     arg_list->args[i] = its_pointer(stack_segment, arg_offset);
1985
1986     uint64_t *arg = (uint64_t *)(M[stack_segment] + arg_offset);
1987     static int shifts[4] = {27, 18, 9, 0};
1988     for (int j = 0; j < arg_len; ++j) {
1989       int k = j >> 2;
1990       int l = j & 3;
1991       arg[k] =
1992         (arg[k] & ~((uint64_t)0777 << shifts[l])) |
1993           ((uint64_t)args[i][j] << shifts[l]);
1994     }
1995
1996     int arg_desc_offset = allocate_stack(
1997       sizeof(struct arg_desc) / sizeof(uint64_t),
1998       1
1999     );
2000     arg_list->args[n_args_af + i] =
2001       its_pointer(stack_segment, arg_desc_offset);
2002
2003     struct arg_desc *arg_desc = (struct arg_desc *)(
2004       M[stack_segment] + arg_desc_offset
2005     );
2006     arg_desc->flag = 1; // version 2 descriptor
2007     arg_desc->type = 21; // character string
2008     arg_desc->packed = 0;
2009     arg_desc->number_dims = 0;
2010     arg_desc->size = strlen(args[i]);
2011   }
2012
2013   int result_offset = 0; // shuts up compiler
2014   if (af) {
2015     result_offset = allocate_stack(((RESULT_LEN + 3) >> 2) + 1, 1);
2016     arg_list->args[n_args] = its_pointer(stack_segment, result_offset + 1);
2017
2018     int arg_desc_offset = allocate_stack(
2019       sizeof(struct arg_desc) / sizeof(uint64_t),
2020       1
2021     );
2022     arg_list->args[n_args_af + n_args] =
2023       its_pointer(stack_segment, arg_desc_offset);
2024
2025     struct arg_desc *arg_desc = (struct arg_desc *)(
2026       M[stack_segment] + arg_desc_offset
2027     );
2028     arg_desc->flag = 1; // version 2 descriptor
2029     arg_desc->type = 22; // varying character string
2030     arg_desc->packed = 0;
2031     arg_desc->number_dims = 0;
2032     arg_desc->size = RESULT_LEN;
2033   }
2034
2035   stack_header->stack_end_ptr = its_pointer(
2036     stack_segment,
2037     allocate_stack(0, 0x10)
2038   );
2039
2040   cpu.rA = n_args_af << 19;
2041   cpu.rX[1] = arg_list_offset;
2042
2043   cpu.PR[0].RNR = 3;
2044   cpu.PR[0].SNR = operator_table_pointer.segment;
2045   cpu.PR[0].WORDNO = operator_table_pointer.offset;
2046
2047   struct its_pointer entry_pointer = find_definition(
2048     link_segment(NULL, entry_segname, entry_segname),
2049     entry_name,
2050     -1,
2051     true
2052   );
2053   cpu.PR[2].RNR = 3;
2054   cpu.PR[2].SNR = entry_pointer.segment;
2055   cpu.PR[2].WORDNO = entry_pointer.offset;
2056
2057   cpu.PR[6].RNR = 3;
2058   cpu.PR[6].SNR = stack_segment;
2059   cpu.PR[6].WORDNO = stack_frame_offset;
2060
2061   cpu.PPR.PRR = 3;
2062   cpu.PPR.PSR = linkage_segment;
2063   cpu.PPR.P = 0; // privilege
2064   cpu.PPR.IC = calling_stub_offset;
2065
2066   cpu.cycle = FETCH_cycle;
2067
2068   if (setjmp(exit_emulation) == 0) {
2069     sim_instr();
2070     rassert(false);
2071   }
2072
2073   if (af) {
2074     char buf[RESULT_LEN + 1];
2075     uint64_t *result = (uint64_t *)(M[stack_segment] + result_offset);
2076     int result_len = (int)(*result++ & 0777777);
2077     rassert(result_len < sizeof(buf));
2078     get_string(buf, result, result_len);
2079     printf("%s\n", buf);
2080   }
2081
2082   return 0;
2083 }