1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) Honeywell Bull Inc., 1988                *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   6         *                                                         *
   7         * Copyright (c) 1972 by Massachusetts Institute of        *
   8         * Technology and Honeywell Information Systems, Inc.      *
   9         *                                                         *
  10         *********************************************************** */
  11 
  12 
  13 
  14 
  15 /****^  HISTORY COMMENTS:
  16   1) change(86-09-30,Oke), approve(86-09-30,MCR7543), audit(86-09-30,JRGray),
  17      install(86-10-08,MR12.0-1180):
  18      Allow ALM to support double word constants.
  19   2) change(86-10-01,JRGray), approve(86-10-01,MCR7507),
  20      audit(86-10-27,RWaters), install(86-11-12,MR12.0-1202):
  21      Modified to support severity, *heap references, and the "init_link"
  22      pseudo.
  23   3) change(86-11-14,JRGray), approve(86-11-14,MCR7568),
  24      audit(86-11-21,RWaters), install(86-11-26,MR12.0-1228):
  25      Also MCR7572. Modified to add support for the three new pseudo-ops:
  26      ext_extry, oct_unal, and dec_unal.
  27   4) change(88-08-02,JRGray), approve(88-08-05,MCR7952),
  28      audit(88-09-30,WAAnderson), install(88-10-17,MR12.2-1169):
  29      Modified to support new Symbol Table Pseudo-Ops.
  30                                                    END HISTORY COMMENTS */
  31 
  32 
  33 pass2_:
  34      procedure( decor,target_value,no_target_given,first_time_thru );  /* decor is passed in from alm_6180_, set in pass1_ ;
  35                                                                           target_value and no_target_given come from alm
  36                                                                           via alm_6180_; first_time_thru comes from alm_6180_ */
  37 
  38 
  39 /*  pass2 second pass of the Multics assembler for the GE - 645 and Honeywell 6180.  */
  40 
  41 
  42 /*  pass2 is primarily concerned with generating binary output.
  43    pass2 processes all operations and pseudo-operations for
  44    the binary  (text) output that they produce. All such output
  45    is generated and put out in the output file along with an
  46    assembly listing. Some pseudo-operations are only concerned
  47    the generating information about the linkage and are
  48    treated accordingly. The post - processor will handle the
  49    external reference information and put out the linkage and symbol
  50    segments and the linkage part of the text segment.
  51 
  52           Modified to support *heap links by R Gray and W Anderson on 2/05/86.
  53           Modified for changes requested by MTR 175 on 3/25/81 by EBush
  54           Modified to implement -target on 2/5/81 by EBush
  55           Modified for decor pseudo-op on 12/30/80 by E Bush
  56           Modified for "vfd" pseudo-op on 12/15/75 by Eugene E Wiatrowski
  57           Modified for prelinking on 06/15/75 by Eugene E Wiatrowski
  58           Modified on 08/07/73 at 23:58:43 by R F Mabee.
  59           by RFM in June 1973 to add EIS instructions, etc.
  60           by RFM on 2 May 1972 adding getlp, short_call, and include pseudo-ops.
  61           by RFM on 24 March 1972 for new object segment format.
  62           by RFM on 5 March 1972 to add new call/save/return operators.
  63           by RHG on 4 June 1971 to fix "rem" pseudo-op
  64           by RHG 0n 3 June 1971 to fix clearing of flags (upkflg does orsa not sta)
  65           by RHG on 2 June 1971 to produce "N" flag for "file" pseudo-op
  66           by RHG on 25 May 1971 to clear flags in rem pseudo-op
  67           by RHG on 2 May 1971 to fix bug in last_p2pcl initialization
  68           by RHG on 2 April 1971 to have "eight,sixtyfour,mod" all produce nop's rather than 0's
  69                                  to allow bss ,x where no label is specified before the ,
  70                                  to cause r error when save is given a relocatable arg
  71                                  to clean up the processing of the rem pseudo-op
  72    R H Campbell, 29 October 1970, for inhibit bit in ITS/ITB pseudo-ops.
  73    by RHG on 17 Sept 1970 for new listing package
  74    by RHG on 6 August 1970 at 2321 to not set sthedr from name pseudo-op
  75    by NA on June 28, 1970 at 2123 for the new CODTAB.
  76           ^L  */                                            /*  INCLUDE FILES  */
  77 
  78 
  79 
  80 % include varcom;
  81 
  82 % include concom;
  83 
  84 % include erflgs;
  85 
  86 % include codtab;
  87 
  88 % include alm_prototypes;
  89 
  90 % include relbit;
  91 
  92 % include labarg;
  93 
  94 % include alm_lc;
  95 
  96 % include sthedr;
  97 
  98 % include alm_options;
  99 
 100 % include alm_data;
 101 
 102           /*  END OF THE INCLUDE FILES  */                  /*  ^L  */
 103 
 104 /*  PARAMETERS */
 105 
 106 dcl       decor fixed bin(35); /* passed from  alm_6180_, set in pass1_ */
 107 dcl       target_value  fixed bin(17);
 108 dcl       (no_target_given,first_time_thru) bit(1);
 109 
 110 
 111 /* CONDITIONS */
 112 
 113 dcl       cleanup condition;
 114 
 115 
 116 /*  BASED STORAGE DECLARATIONS  */
 117 
 118  dcl      long_int_based fixed bin(71) based unaligned;
 119 
 120  dcl      1 word based aligned,
 121             2 (left, right) bit (18) unaligned;
 122 
 123  dcl      1 glpl_words (0:262143) based (eb_data_$lavptr) aligned,
 124             2 left bit (18) unaligned,
 125             2 right bit (18) unaligned;
 126 
 127  dcl      1 acc_string based ( addr (sym (1))) aligned,
 128             2 length fixed bin (9) unsigned unaligned,
 129             2 chars char (acc_string.length) unaligned;
 130 
 131  dcl      1 opcode_overlay based aligned,
 132             2 filler bit (18) unaligned,
 133             2 opcode bit (10) unaligned,
 134             2 flags bit (4) unaligned,            /*  Any value pass2_ might need.  */
 135             2 iclass bit (4) unaligned;           /*  Intersection of decors in which it is valid */
 136 
 137  dcl      1 descop_overlay based aligned,
 138             2 filler bit(24) unaligned,
 139             2 format bit(4)  unaligned,
 140             2 flags  bit(4)  unaligned,
 141             2 decor  bit(4)  unaligned;
 142 
 143 /*  EXTERNAL ENTRIES USED BY PASS2  */
 144 
 145 dcl  alm_symtab_$block entry(char(*)),
 146      alm_symtab_$cleanup entry,
 147      alm_symtab_$end_block entry,
 148      alm_symtab_$end_enum entry,
 149      alm_symtab_$end_source entry,
 150      alm_symtab_$end_structure entry,
 151      alm_symtab_$end_union entry,
 152      alm_symtab_$enum entry(char(*)),
 153      alm_symtab_$initialize entry,
 154      alm_symtab_$source entry(char(*), bit(36) aligned, fixed bin(71)),
 155      alm_symtab_$statement entry(fixed bin(26), fixed bin(26), fixed bin(26), fixed bin(26), fixed bin(26)),
 156      alm_symtab_$structure entry(char(*)),
 157      alm_symtab_$symbol entry(char(*), char(*), fixed bin(26), fixed bin(26), fixed bin(26), fixed bin(26), fixed bin(26), fixed bin(26)),
 158      alm_symtab_$union entry(char(*)),
 159      getid_$getid_ ext entry,
 160      getid_$getnam ext entry,
 161      getid_$setid ext entry (fixed bin (26)),
 162      getbit_$getbit_ ext entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26)),
 163      inputs_$next ext entry,
 164      inputs_$nxtnb ext entry,
 165      inputs_$next_statement ext entry,
 166      inputs_$next_statement_nolist ext entry,
 167      litevl_$itbevl ext entry (fixed bin (26), fixed bin (26)),
 168      utils_$upkflg ext entry (fixed bin),
 169      utils_$abort ext entry,
 170      litevl_$itsevl ext entry (fixed bin (26), fixed bin (26)),
 171      litevl_$litasn ext entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26)),
 172      prwrd_$source_only ext entry,
 173      prnter_$prnter_ ext entry (char (*)),
 174      putout_$putwrd ext entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26)),
 175      prwrd_$prwrd_ ext entry (fixed bin (26), fixed bin (26), fixed bin (26)),
 176      putout_$putlst ext entry (fixed bin (26), fixed bin (26), fixed bin (26),
 177      fixed bin (26), fixed bin (26)),
 178      glpl_$slwrd ext entry (fixed bin (26), fixed bin (26), fixed bin (26)),
 179      glpl_$storl ext entry (fixed bin (26), fixed bin (26)),
 180      glpl_$storr ext entry (fixed bin (26), fixed bin (26));
 181  dcl      alm_include_file_$pass2 ext entry,
 182           alm_include_file_$insert ext entry (ptr, fixed bin (26), fixed bin (26)),
 183           alm_include_file_$pop ext entry,
 184           expand_pathname_$component entry(char(*), char(*), char(*), char(*), fixed bin(35)),
 185           initiate_file_$component entry(char(*), char(*), char(*), bit(*), ptr, fixed bin(24), fixed bin(35)),
 186           inputs_$get_ptr entry (ptr, fixed bin (26), fixed bin (26), bit (1) aligned),
 187           mexp_      ext entry (char (*), fixed bin (17), fixed bin(17), bit(1), bit(1)),
 188           mexp_$define_macro ext entry (char (*)),
 189           oplook_$reset ext entry,
 190           oplook_$redefine  entry,
 191           system_type_   entry (char(*), char(*), fixed bin, fixed bin(35)),
 192           terminate_file_ entry(ptr, fixed bin(24), bit(*), fixed bin(35)),
 193           translator_info_$component_get_source_info entry(ptr, char(*), char(*), char(*), fixed bin(71), bit(36) aligned, fixed bin(35));
 194 
 195 /*  EXTERNAL FUNCTIONS CALLED BY PASS2  */
 196 
 197 dcl (ascevl_$accevl ext entry (fixed bin (26)),
 198      ascevl_$acievl ext entry (fixed bin (26)),
 199      ascevl_$ac4evl ext entry (fixed bin (26)),
 200      ascevl_$bcdevl ext entry (fixed bin (26)),
 201      expevl_$expevl_ ext entry (fixed bin (26), fixed bin (26), fixed bin (26)),
 202      lstman_$blkasn ext entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26)),
 203      glpl_$cwrd ext entry (fixed bin (26)),
 204      glpl_$glwrd ext entry (fixed bin (26), fixed bin (26)),
 205      decevl_$decevl_ ext entry (fixed bin (26), fixed bin (26)),
 206      lstman_$eptasn ext entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26),
 207      fixed bin (26), fixed bin (26)),
 208      utils_$exadrs ext entry (fixed bin (26), fixed bin (26)),
 209      lstman_$lnkasn ext entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26)),
 210      lstman_$outasn ext entry (fixed bin (26), fixed bin (26), fixed bin (26)),
 211      lstman_$calser ext entry (fixed bin (26), fixed bin (26)),
 212      lstman_$sdfasn ext entry (fixed bin (26), fixed bin (26), fixed bin (26),
 213      fixed bin (26), fixed bin (26)),
 214      lstman_$namasn ext entry (fixed bin (26)),
 215      utils_$rs ext entry (fixed bin (26), fixed bin (26)),
 216      utils_$and ext entry (fixed bin (26), fixed bin (26)),
 217      utils_$makins ext entry (fixed bin (26), fixed bin (26), fixed bin (26),
 218      fixed bin (26), fixed bin (26)),
 219      octevl_$octevl_ ext entry (fixed bin (26)),
 220      oplook_$oplook_ ext entry (fixed bin, fixed bin (26)),
 221      table_$table_ ext entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26),
 222      fixed bin (26)),
 223      lstman_$trpasn ext entry (fixed bin (26), fixed bin (26)),
 224      varevl_$varevl_ ext entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26),
 225      fixed bin (26), fixed bin (26)),
 226      vfdevl_$vfdevl_ ext entry (fixed bin (26), fixed bin (26)),
 227      vfdevl_$vfdcnt ext entry (fixed bin (26), fixed bin (26))
 228      ) returns (fixed bin (26));
 229  dcl      alm_eis_parse_$descriptor ext entry (fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26)) returns (fixed bin  (26)),
 230           alm_eis_parse_$instruction ext entry (fixed bin (26), fixed bin (26), fixed bin (26)) returns (fixed bin  (26));
 231 
 232 /*  AUTOMATIC VARIABLES  */
 233 
 234 dcl (rleft, rright, rslts (128), binop, flags, basno, value, b29, admod, class, instruction_class,
 235      type, xnlnk, ptrarg, ptrcal, trplnk, blklnk, symlnk, zleft, zright, rrslts (128), option,
 236      argout, traout, tderr, tbss, tlc, i, iaddr, ik, iloc, irtblk, itemp, itype, j, junk,
 237      k, lcl, lcloc, lcr, link, lnkorg, lpaswd, n, name, nobits, nowrds, last_p2pcl) fixed bin (26);
 238 
 239  dcl      link_not_found bit(1);
 240  dcl      termination_conditions bit (7);
 241  dcl      full_word_temp fixed bin (26);
 242  dcl      stkclst fixed bin(26);        /* used to remember calculated stackframe sizes */
 243  dcl      dup_ptr ptr init (null ()),
 244           temp_ptr ptr,
 245           dup_count fixed bin (26),
 246           dup_start fixed bin (26),
 247           dup_string (0:262143) char (1) unal based (dup_ptr),
 248           tmacl bit (2) aligned,
 249           operand char(32) varying,
 250           canonical_operand char(24),
 251           code      fixed bin(35),
 252           unique_id bit(36) aligned,
 253           dtcm fixed bin(71),
 254           (path, var_name, var_type) char(256) varying,
 255           (st_offset, st_length, st_line, st_num) fixed bin(26);
 256 
 257 dcl  trprtn label local;
 258 
 259 dcl       label_flag bit (1) aligned;
 260 dcl       end_statement_flag bit (1) aligned;
 261 
 262 /*  EXTERNAL STATIC VARIABLES IN THE ASSEMBLER'S DATA SEGMENT  */
 263 
 264 dcl (eb_data_$unwind (3), eb_data_$atext (2), eb_data_$alink (2), eb_data_$asym (2), eb_data_$astat (2), eb_data_$asys (2),
 265      eb_data_$aheap (2),
 266      eb_data_$mstaq, eb_data_$ion, eb_data_$ioff, eb_data_$mx7, eb_data_$ib6,
 267      eb_data_$isave, eb_data_$irestore, eb_data_$iobject,
 268      eb_data_$nmxsav, eb_data_$tsym, eb_data_$anl) ext fixed bin (26),
 269      eb_data_$rpt_terminators (7) external fixed bin (35);            /*  Contain three-letter ACC names.  */
 270  dcl      eb_data_$lavptr external pointer;
 271 dcl       eb_data_$entry_bound ext fixed bin(26);
 272 dcl       eb_data_$macro_depth ext fixed bin (26),
 273           eb_data_$macro_listing_control bit (36) aligned ext;
 274 
 275           /* fixed bin sym code for 'function' */
 276 dcl       (ifun1 init(1100540526), ifun2 init(13318017647), ifun3 init(14763950080))
 277                int static options(constant) fixed bin(35);
 278 
 279 
 280 
 281 
 282 /*  entry to subroutine, set up variables before main loop.  */
 283 
 284 label_100:
 285           pc = 0;
 286 
 287 
 288 
 289 
 290 
 291 
 292 
 293 
 294 /*  clear buffer for relocation bits  */
 295 
 296 label_110:
 297 
 298           rrslts (*) = 0;     /*initialize*/
 299           curlc = lptext;
 300           tvorg = fixed (glpl_words (lptv + 3).left, 18);
 301           lnkorg = fixed (glpl_words (lpsect + 3).left, 18);
 302           call glpl_$storr (lplit + 1, litc);
 303 on        cleanup   call alm_symtab_$cleanup;
 304           call alm_symtab_$initialize;
 305           litorg = fixed (glpl_words (lplit + 3).left, 18);
 306           lreter = fixed (glpl_words (lpcall + 3).left, 18);
 307 
 308           /* retrieve remembered value of stackframe size */
 309           stkclst = stkc;     /* stkc is used to pass this value from pass1 */
 310           stkc = fixed(glpl_words(stkclst).left);
 311           stkclst = fixed(glpl_words(stkclst).right);
 312 
 313           stkc = 16 * (divide (stkc + 15, 16, 17, 0));
 314           p2pcl = pclst;
 315           binlin = 1;
 316           eb_data_$macro_listing_control = (36)"0"b;
 317           call oplook_$reset;
 318 
 319 /*  main loop re - entry, setup flags and check symbol assignment.  */
 320 
 321 label_200:
 322           spc = pc;
 323           tpc = fixed (glpl_words (p2pcl).left, 18);
 324           tlc = fixed (glpl_words (p2pcl + 2).left, 18);
 325           call utils_$upkflg (glpl_$cwrd (p2pcl + 1));
 326           last_p2pcl = p2pcl;
 327           p2pcl = fixed (glpl_words (p2pcl).right, 18);
 328           value = 0;
 329 
 330           label_flag = ""b;
 331 label_220:
 332           brk (1) = isp;
 333           call getid_$getid_;
 334           if (brk (1) ^= icol) then go to label_300;
 335           if (eb_data_$tsym ^= 0) then if (table_$table_ (iassgn, sym (1), pc, flocrf, curlc) = 0) then prnts = 1;
 336           label_flag = "1"b;
 337           go to label_220;
 338 
 339 /*  get operator and test for pseudo operation.  */
 340 
 341 label_300:
 342           if eb_data_$tsym ^= 0 then go to label_301;
 343           if brk (1) = inl then go to label_870;
 344           if brk (1) = iquot then go to label_870;
 345 label_301:
 346           binop = oplook_$oplook_ (prnto, itype);
 347           if prnto ^= 0 then do;
 348                call mexp_ (addr (sym (1)) -> acc_string.chars, prnto, target_value, no_target_given,first_time_thru);
 349                if prnto ^= 0 then go to label_3200;
 350                else go to label_200;
 351           end;
 352           if (brk (1) = isp | brk (1) = inl) then go to label_305;
 353 
 354 /*  there was an illegal character after the op or pseudo-op  */
 355           prnto = 1;
 356           go to label_3200;
 357 
 358 label_305:
 359           instruction_class = fixed (addr (binop) -> opcode_overlay.iclass, 4);
 360           if ^data2.compatible(instruction_class,decor)
 361               then prntb = 1;
 362 
 363           go to label_vector (itype);
 364 
 365 
 366 
 367 /*  control group of pseudo operations.  */
 368 
 369 /*  end pseudo-operation, scan to end of card, and return to caller.  */
 370 
 371 
 372 label_vector (1):             /*  end  */
 373 label_450:
 374 
 375           if label_flag then call prwrd_$prwrd_(spc+fixed (glpl_words(curlc+3).left, 18),0,ibb); else call prwrd_$source_only;
 376           return;
 377 
 378 /*  include statement, use new source file.  */
 379 
 380 label_vector (50):            /*  include  */
 381 label_include:
 382           call getid_$getid_ ();
 383           if eb_data_$tsym = 0 then goto label_3100;
 384           call prwrd_$source_only ();
 385           call inputs_$next_statement ();
 386           call alm_include_file_$pass2 ();
 387           goto label_220;
 388 
 389 /*  use pseudo-operation, use another location counter.  */
 390 
 391 label_vector (2):             /*  use  */
 392 label_500:
 393 
 394           call getid_$getid_;
 395           if (eb_data_$tsym = 0) then go to label_3100;
 396 
 397 /*  save current value of old location counter.  */
 398           call glpl_$storr (curlc + 1, pc);
 399 
 400 /*  use new lc as the current lc.  */
 401           if (table_$table_ (iserch, sym (1), pc, fmlcrf, curlc) ^= 0) then go to label_3010;
 402           call prnter_$prnter_ ("fatal error in PASS2 in symbol table search for USE lc");
 403           call utils_$abort;
 404 
 405 
 406 /*  org pseudo-operation. set the value of the pc.  */
 407 
 408 label_vector (3):             /*  org  */
 409 label_525:
 410 
 411           if (varevl_$varevl_ (invrvl, basno, value, admod, b29, iaddr) = 0) then go to label_3110;
 412           if (iaddr ^= 0) then go to label_3300;
 413           pc = value;
 414           go to label_3200;
 415 
 416 /*  join pseudo-op. ignored in pass2.  */
 417 
 418 label_vector (4):             /*  join  */
 419 label_550:
 420 
 421           go to label_3010;
 422 
 423 /*  even pseudo-operation, force pc to even location.  */
 424 
 425 label_vector (5):             /*  even  */
 426 label_600:
 427 
 428           if (mod (spc, 2) ^= 0) then
 429           call putout_$putwrd (pc, (mnopdu), i642, 0);
 430           go to label_3010;
 431 
 432 /*  odd pseudo-operation, force pc to odd location.  */
 433 
 434 label_vector (6):             /*  odd  */
 435 label_630:
 436 
 437           if (mod (spc, 2) = 0) then
 438           call putout_$putwrd (pc, (mnopdu), i642, 0);
 439           go to label_3010;
 440 
 441 /*  eight pseudo-operation, force pc to zero mod eight.  */
 442 
 443 label_vector (7):             /*  eight  */
 444 label_660:
 445 
 446           if (mod (pc, 8) = 0) then go to label_3010;
 447           call putout_$putwrd (pc, (mnopdu), i642, 0);
 448           go to label_660;
 449 
 450 /*  sixtyfour pseudo-operation, force pc to zero mod 64.  */
 451 
 452 label_vector (8):             /*  sixtyfour  */
 453 label_680:
 454 
 455           if (mod (pc, 64) = 0) then go to label_3010;
 456           call putout_$putwrd (pc, (mnopdu), i642, 0);
 457           go to label_680;
 458 
 459 /*  movdef pseudo-operation. ignored in pass two.  */
 460 
 461 label_vector (11):            /*  movdef  */
 462 label_755:
 463 label_vector (61):            /* ppstatic */
 464 
 465           go to label_3300;
 466 
 467 
 468 
 469 /* decor pseudo-operation:  just like pass1_ */
 470 
 471 label_vector (62):             /* decor */
 472 label_decor:
 473 
 474           call getid_$getid_();
 475           operand = addr(sym(1)) -> acc_string.chars;
 476           call system_type_((operand),canonical_operand,(0),code);
 477           if code ^=0
 478              then prntf = 1;
 479           else do;
 480                     do n = 1 to hbound(data1.decor,1) while(rtrim(canonical_operand) ^= data1.decor(n).name);
 481                     end;
 482                     decor = data1.decor(n).number;
 483                end;
 484 
 485           goto label_3300;
 486 
 487 
 488 /* error pseudo-operation, sets fatal error flag, causing "Translation failed" message. */
 489 
 490 label_vector (63):            /* error */
 491 label_error:
 492           tfatal = 3;         /* severity 3 error */
 493           goto label_3300;
 494 
 495 
 496 
 497 /*  firstref pseudo-operation, first reference trap procedure specified.  */
 498 
 499 label_vector (48):            /*  firstref  */
 500 label_firstref:
 501           if tfirstreftrap ^= 1 then prntp = 1;
 502           if varevl_$varevl_ (ixvrvl, basno, value, admod, b29, iaddr) = 0 then goto label_3120;
 503           if b29 = 0 then value = lstman_$lnkasn (myblk, value, admod, iaddr);
 504           if first_ref_trap_proc_linkno ^= value then prntu = 1;
 505           first_ref_trap_proc_linkno = first_ref_trap_proc_linkno + fixed (glpl_words (lpsect + 3).left, 18);
 506           if brk (1) = ilpar then do;
 507                     if varevl_$varevl_ (ixvrvl, basno, value, admod, b29, iaddr) = 0 then goto label_3120;
 508                     if b29 = 0 then value = lstman_$lnkasn (myblk, value, admod, iaddr);
 509                     if first_ref_trap_arg_linkno ^= value then prntu = 1;
 510                     first_ref_trap_arg_linkno = first_ref_trap_arg_linkno + fixed (glpl_words (lpsect + 3).left, 18);
 511                     end;
 512           else if first_ref_trap_arg_linkno ^= 0 then prntu = 1;
 513           goto label_3300;
 514 
 515 /*  inhibit pseudo-operation, set inhibit mode on or off.  */
 516 
 517 label_vector (12):            /*  inhibit  */
 518 label_760:
 519 
 520           call getid_$getid_;
 521           if (eb_data_$tsym = 0) then go to label_765;
 522           if (sym (1) = eb_data_$ion) then go to label_770;
 523           if (sym (1) = eb_data_$ioff) then go to label_775;
 524           prntf = 1;
 525           go to label_3300;
 526 
 527 
 528 label_765:
 529 
 530           if tinhib = 1 then
 531           tinhib = 0;
 532           else tinhib = 1;
 533           go to label_3300;
 534 
 535 
 536 label_770:
 537 
 538           tinhib = 1;
 539           go to label_3300;
 540 
 541 
 542 label_775:
 543 
 544           tinhib = 0;
 545           go to label_3300;
 546 
 547 /*  name pseudo-operation, ignored in pass2.  */
 548 
 549 label_vector (14):            /*  name  */
 550 label_820:
 551 
 552           goto label_3300;
 553 
 554 /*  null pseudo-operation, print location only.  */
 555 
 556 label_vector (15):            /*  null  */
 557 label_850:
 558 
 559           go to label_3300;
 560 
 561 /*  rem pseudo-operation, print no octal listing.  */
 562 
 563 label_vector (16):            /*  rem  */
 564 label_870:
 565 
 566           if label_flag then goto label_850;
 567           do i = 1 to 36;     /*  clear all the flags  */
 568                flgvec(i) = 0;
 569           end;
 570           p2pcl = last_p2pcl;
 571           go to label_3040;
 572 
 573 
 574 /*  symbol defining pseudo-operations.  */
 575 
 576 /*  basref pseudo-operation, check definitions of pass1.  */
 577 
 578 label_vector (17):            /*  basref  */
 579 label_900:
 580 
 581           call getid_$getid_;
 582           if (eb_data_$tsym = 0) then go to label_910;
 583           if (table_$table_ (iserch, sym (1), value, clbas, junk) ^= 0) then go to label_915;
 584 
 585 label_905:
 586 
 587           do i = 1 to 8;
 588                if (sym (1) ^= symbas (i)) then
 589                go to label_905a;
 590                value = i - 1;
 591                go to label_915;
 592 
 593 label_905a:
 594 
 595           end label_905;
 596           if (table_$table_ (iserch, sym (1), basno, clint, junk) ^= 0) then go to label_915;
 597           go to label_3130;
 598 
 599 
 600 label_910:
 601 
 602           if (varevl_$varevl_ (invrvp, basno, value, admod, b29, iaddr) = 0) then go to label_3120;
 603           if (iaddr ^= 0) then go to label_3300;
 604 
 605 
 606 label_915:
 607 
 608           link = utils_$exadrs (value, 0);
 609           type = 2;
 610           class = fbasrf;
 611 
 612 /*  re - entry from segref pseudo-operation.  */
 613 
 614 label_920:
 615 
 616           call getid_$getid_;
 617           xnlnk = lstman_$namasn (sym (1));
 618 
 619 label_930:
 620 
 621           trprtn = label_970;
 622           tderr = 0;
 623           trplnk = 0;
 624 
 625 label_933:
 626 
 627           if (brk (1) ^= ilpar) then go to label_970;
 628           ptrcal = 0;
 629           ptrarg = 0;
 630           if (varevl_$varevl_ (ixvrvl, basno, ptrcal, admod, b29, iaddr) ^= 0) then go to label_935;
 631           tderr = 1;
 632           go to label_945;
 633 
 634 label_935:
 635 
 636           if (b29 ^= 0) then go to label_945;
 637           if tprot = 1 then go to label_940;
 638           ptrcal = lstman_$lnkasn (myblk, ptrcal, admod, iaddr);
 639           go to label_945;
 640 
 641 label_940:
 642 
 643           ptrcal = lstman_$eptasn (ptrcal, 0, mylnk, curlc, 0, 1);
 644 
 645 label_945:
 646 
 647           if (brk (1) ^= ilpar) then go to label_960;
 648           if (varevl_$varevl_ (ixvrvl, basno, ptrarg, admod, b29, iaddr) ^= 0) then go to label_950;
 649           tderr = 1;
 650           go to label_955;
 651 
 652 label_950:
 653 
 654           if (b29 = 0) then
 655           ptrarg = lstman_$lnkasn (myblk, ptrarg, admod, iaddr);
 656 
 657 label_955:
 658 
 659           if (brk (1) = irpar) then
 660           call inputs_$next;
 661 
 662 label_960:
 663 
 664           if (brk (1) = irpar) then go to label_965;
 665           tderr = 1;
 666           go to trprtn;
 667 
 668 label_965:
 669 
 670           call inputs_$next;
 671           if (tderr ^= 0) then go to trprtn;
 672           trplnk = lstman_$trpasn (ptrcal, ptrarg);
 673           go to trprtn;
 674 
 675 
 676 label_970:
 677 
 678           if (tderr = 0) then go to label_975;
 679           prntf = 1;
 680           go to label_980;
 681 
 682 label_975:
 683 
 684           if (table_$table_ (iassgn, fixed (glpl_words (xnlnk).left, 18), lstman_$blkasn (type, link, xnlnk, trplnk), class,
 685           junk) = 0) then
 686           prnts = 1;
 687 
 688 label_980:
 689 
 690           if (brk (1) = icomma) then go to label_920;
 691           go to label_3300;
 692 
 693 /*  bool pseudo-operation, check boolean symbol assignment.  */
 694 
 695 label_vector (18):            /*  bool  */
 696 label_1000:
 697 
 698           call getid_$setid (symlnk);
 699           if (brk (1) ^= icomma | symlnk = 0) then go to label_3100;
 700           if (varevl_$varevl_ (ibvrvl, basno, value, admod, b29, iaddr) = 0) then go to label_3120;
 701           if (iaddr ^= 0) then go to label_3300;
 702           if (table_$table_ (iassgn, symlnk, value, fbolrf, junk) = 0) then go to label_3120;
 703           go to label_3200;
 704 
 705 /*  equ pseudo-operation, check arithmetic symbol assignment.  */
 706 
 707 label_vector (19):            /*  equ  */
 708 label_1100:
 709 
 710           call getid_$setid (symlnk);
 711           if (brk (1) ^= icomma | symlnk = 0) then go to label_3100;
 712           if (varevl_$varevl_ (invrvl, basno, value, admod, b29, iaddr) = 0) then go to label_3120;
 713           class = fequrf;
 714           if (iaddr ^= 0) then
 715           class = flocrf;
 716           if (table_$table_ (iassgn, symlnk, value, class, iaddr) = 0) then go to label_3120;
 717           if (iaddr = 0) then go to label_3200;
 718 
 719 /*  set value to absolute value.  */
 720           value = value + fixed (glpl_words (iaddr + 3).left, 18);
 721           go to label_3200;
 722 
 723 /*  link pseudo-operation, check link number assignment.  */
 724 
 725 label_vector (20):            /*  link  */
 726 label_1200:
 727 
 728           call getid_$setid (symlnk);
 729           if (brk (1) ^= icomma | symlnk = 0) then go to label_3100;
 730           if (varevl_$varevl_ (ixvrvl, basno, value, admod, b29, iaddr) = 0) then go to label_3120;
 731           if (b29 = 0) then
 732           value = lstman_$lnkasn (myblk, value, admod, iaddr);
 733           if (table_$table_ (iassgn, symlnk, value, flocrf, lpsect) = 0) then go to label_3120;
 734 
 735 /*  set value to its absolute value for printing.  */
 736           value = value + fixed (glpl_words (lpsect + 3).left, 18);
 737           go to label_3200;
 738 
 739 /*  init_link pseudo-operation, associate init info with link.  */
 740 
 741 label_vector (65):            /*  init_link       name, extexpression  */
 742 
 743           call getid_$getid_;
 744           if (eb_data_$tsym = 0) then go to label_3100;
 745           if (table_$table_ (iserch, sym(1), value, flocrf, lcloc) = 0) then go to label_3130;
 746           if (brk(1) ^= icomma) then go to label_3100;
 747           itemp = value + fixed(glpl_words(lcloc+3).left,18);
 748           if (varevl_$varevl_ (ixvrvl, basno, value, admod, b29, iaddr) = 0) then go to label_3120;
 749           j = lnklst; /* search for the appropriate link */
 750           link_not_found = "1"b;
 751           i = 1;
 752           do while (link_not_found);
 753              if (fixed(glpl_words(j).left,18) = 2) then
 754                 j = fixed(glpl_words(j).right, 18);
 755              else do;
 756                 if (i <= value/2) then do;
 757                    j = fixed(glpl_words(j).right, 18);
 758                    i = i + 1;
 759                    end;
 760                 else link_not_found = "0"b;
 761                 end;
 762              end;
 763           j = fixed(glpl_words(j+1).left, 18); /* find expression word */
 764           j = fixed(glpl_words(j+1).left, 18); /* find type pair */
 765           glpl_words(j+1).right = bit(fixed(itemp+1, 18), 18); /* set init label to loc + 1 */
 766 
 767           go to label_3200;
 768 
 769 /*  set pseudo-operation, assign resettable equivalence.  */
 770 
 771 label_vector (21):            /*  set  */
 772 label_1250:
 773 
 774           call getid_$setid (symlnk);
 775           if (brk (1) ^= icomma | symlnk = 0) then go to label_3100;
 776           if (varevl_$varevl_ (invrvl, basno, value, admod, b29, iaddr) = 0) then go to label_3120;
 777           if (iaddr ^= 0) then go to label_3300;
 778           if (table_$table_ (iassgn, symlnk, value, fsetrf, junk) = 0) then go to label_3120;
 779           go to label_3200;
 780 
 781 /*  segref pseudo-operation, check definitions of pass1.  */
 782 
 783 label_vector (22):            /*  segref  */
 784 label_1300:
 785 
 786           call getid_$getnam;
 787           if (brk (1) ^= icomma) then go to label_3100;
 788           class = fsegrf;
 789           if (sym (1) ^= eb_data_$atext (1) | sym (2) ^= eb_data_$atext (2)) then go to label_1310;
 790           type = 5;
 791           link = 0;
 792           go to label_920;
 793 
 794 label_1310:
 795 
 796           if (sym (1) ^= eb_data_$alink (1) | sym (2) ^= eb_data_$alink (2)) then go to label_1320;
 797           type = 5;
 798           link = 1;
 799           go to label_920;
 800 
 801 label_1320:
 802 
 803           if (sym (1) ^= eb_data_$asym (1) | sym (2) ^= eb_data_$asym (2)) then go to label_1330;
 804           type = 5;
 805           link = 2;
 806           go to label_920;
 807 
 808 label_1330:
 809 
 810           if (sym (1) ^= eb_data_$astat (1) | sym (2) ^= eb_data_$astat (2)) then go to label_1340;
 811           type = 5;
 812           link = 4;
 813           go to label_920;
 814 
 815 label_1340:
 816 
 817           if (sym (1) ^= eb_data_$asys (1) | sym (2) ^= eb_data_$asys (2)) then go to label_1350;
 818           type = 5;
 819           link = 5;
 820           go to label_920;
 821 
 822 label_1350:
 823           if (sym (1) ^= eb_data_$aheap (1) | sym (2) ^= eb_data_$aheap (2)) then go to label_1360;
 824           type = 5;
 825           link = 6;
 826           go to label_920;
 827 
 828 label_1360:
 829 
 830           type = 4;
 831           link = lstman_$namasn (sym (1));
 832           go to label_920;
 833 
 834 /*  temp and tempd pseudo-operations, ignored in pass2.  */
 835 
 836 label_vector (23):            /*  temp  */
 837 label_1400:
 838 
 839 
 840 label_vector (24):            /*  tempd  */
 841 label_1500:
 842 
 843           go to label_3010;
 844 
 845 label_vector (25):            /*  temp8  */
 846 label_1505:
 847 
 848           go to label_3010;
 849 
 850 
 851 /*  generative class of pseudo-operations.  */
 852 
 853 /*  acc and aci pseudo-operations, ascii code generators.  */
 854 /*  also bci pseudo-operation to generate 6-bit character codes.  */
 855 /*  absolute relocation bits always  */
 856 
 857 label_vector (26):            /*  acc  */
 858 label_1600:
 859           n = ascevl_$accevl (rslts (1));
 860           go to label_1710;
 861 
 862 label_vector (27):            /*  aci  */
 863 label_1700:
 864           n = ascevl_$acievl (rslts (1));
 865           goto label_1710;
 866 
 867 label_vector (13):            /*  bci  */
 868 label_bci:
 869           n = ascevl_$bcdevl (rslts (1));
 870           go to label_1710;
 871 
 872 label_vector (59):
 873 label_ac4:
 874           n = ascevl_$ac4evl (rslts (1));
 875 
 876 label_1710:
 877           do i = 1 to n;
 878                rrslts (i) = 0;
 879           end label_1710;
 880           call putout_$putlst (pc, rslts (1), i3333, n, rrslts (1));
 881           go to label_3010;
 882 
 883 /*  dec pseudo-operation, integer, fixed, and floating point.  */
 884 /*  absolute relocation bits always.  */
 885 
 886 label_vector (28):            /*  dec  */
 887 label_1800:
 888 
 889           n = decevl_$decevl_ (rslts (1), type);
 890           if (n >= 2 & mod (pc, 2) ^= 0) then
 891           call putout_$putwrd (pc, 0, i66, 0);
 892           rrslts (1) = 0;
 893           rrslts (2) = 0;
 894           call putout_$putlst (pc, rslts (1), i66, n, rrslts (1));
 895           if (brk (1) = icomma) then go to label_1800;
 896           go to label_3010;
 897 
 898 /*  dec_unal pseudo-operation, integer, fixed, and floating point unaligned.  */
 899 /*  absolute relocation bits always.  */
 900 
 901 label_vector (66):            /*  dec_unal  */
 902 label_1801:
 903 
 904           n = decevl_$decevl_ (rslts (1), type);
 905           rrslts (1) = 0;
 906           rrslts (2) = 0;
 907           call putout_$putlst (pc, rslts (1), i66, n, rrslts (1));
 908           if (brk (1) = icomma) then go to label_1801;
 909           go to label_3010;
 910 
 911 /*  oct pseudo-operation, octal number generator.  */
 912 /*  absolute relocation bits always.  */
 913 
 914 label_vector (29):            /*  oct  */
 915 label_1900:
 916 
 917           n = octevl_$octevl_ (rslts (1));
 918           if (n >= 2 & mod (pc, 2) ^= 0) then
 919           call putout_$putwrd (pc, 0, i66, 0);
 920           rrslts (1) = 0;
 921           rrslts (2) = 0;
 922           call putout_$putlst (pc, rslts (1), i66, n, rrslts (1));
 923           if (brk (1) = icomma) then go to label_1900;
 924           go to label_3010;
 925 
 926 /* oct_unal pseudo-operation, unaligned octal number generator.  */
 927 /*  absolute relocation bits always.  */
 928 
 929 label_vector (67):            /* oct_unal  */
 930 label_1901:
 931 
 932           n = octevl_$octevl_ (rslts (1));
 933           rrslts (1) = 0;
 934           rrslts (2) = 0;
 935           call putout_$putlst (pc, rslts (1), i66, n, rrslts (1));
 936           if (brk (1) = icomma) then go to label_1901;
 937           go to label_3010;
 938 
 939 /*  vfd pseudo-operation, variable field data generator.  */
 940 
 941 label_vector (30):            /*  vfd  */
 942 label_2000:
 943 
 944           prnte = 0;
 945 
 946 label_2001:
 947 
 948           rrslts(*) = 0;
 949           n = vfdevl_$vfdevl_ (rslts (1), flags);
 950           if (flags = 0) then go to label_2015;
 951 
 952 label_2010:
 953 
 954           do k = 1 to n;
 955                lcl = fixed (glpl_words (flags + k - 1).left, 18);
 956                lcr = fixed (glpl_words (flags + k - 1).right, 18);
 957                zleft = utils_$rs (rslts (k), 18);
 958                zright = utils_$and (rslts (k), sixsev);
 959                rleft = 0;
 960                rright = 0;
 961                if (lcl = 0) then
 962                go to label_2003;
 963                zleft = zleft + fixed (glpl_words (lcl + 3).left, 18);
 964                call getbit_$getbit_ (lcl, 0, 0, rleft);
 965 
 966 label_2003:
 967 
 968                if (lcr = 0) then
 969                go to label_2005;
 970                zright = zright + fixed (glpl_words (lcr + 3).left, 18);
 971                call getbit_$getbit_ (lcr, 0, 0, rright);
 972 
 973 label_2005:
 974 
 975                rslts (k) = glpl_$glwrd (zleft, zright);
 976                rrslts (k) = glpl_$glwrd (rleft, rright);
 977           end label_2010;
 978 
 979 label_2015:
 980 
 981           call putout_$putlst (pc, rslts (1), i66, n, rrslts (1));
 982           go to label_3010;
 983 
 984 /*  mod pseudo-operation. force the location counter mod expression.  */
 985 
 986 label_vector (31):            /*  mod  */
 987 label_2020:
 988 
 989           call getid_$getid_;
 990           junk = expevl_$expevl_ (0, value, iaddr);
 991           if iaddr ^= 0 then prntr = 1;
 992 
 993 label_2025:
 994 
 995           if (mod (pc, value) = 0) then go to label_3010;
 996           call putout_$putwrd (pc, (mnopdu), i642, 0);
 997           go to label_2025;
 998 
 999 
1000 /*  storage allocating pseudo-operations.  */
1001 
1002 /*  bfs pseudo-operation, block followed by symbol.  */
1003 
1004 label_vector (32):            /*  bfs  */
1005 label_2100:
1006 
1007           tbss = 0;
1008           go to label_2210;
1009 
1010 /*  bss pseudo-operation, block started by symbol.  */
1011 
1012 label_vector (33):            /*  bss  */
1013 label_2200:
1014 
1015           tbss = 1;
1016 
1017 label_2210:
1018 
1019           call getid_$setid (symlnk);
1020           if (brk (1) ^= icomma) then go to label_3100;
1021           if (varevl_$varevl_ (invrvl, basno, value, admod, b29, iaddr) = 0) then go to label_3110;
1022           if (iaddr = 0) then go to label_2220;
1023           prntr = 1;
1024           go to label_3120;
1025 
1026 label_2220:
1027 
1028           pc = spc + value;
1029           if (b29 ^= 0 ) then prntf = 1;
1030           value = pc;
1031           if (tbss = 1) then
1032           value = spc;
1033           if symlnk ^= 0 then if (table_$table_ (iassgn, symlnk, value, flocrf, curlc) = 0) then prnts = 1;
1034           call prwrd_$prwrd_ (value + fixed (glpl_words (curlc + 3).left, 18), 0, ibb);
1035           go to label_3010;
1036 
1037 /*  zero pseudo-operation, generate double address word.  */
1038 
1039 label_vector (34):            /*  zero  */
1040 label_2350:
1041 
1042           junk = varevl_$varevl_ (invrvl, basno, zleft, admod, b29, iaddr);
1043           call getbit_$getbit_ (iaddr, basno, b29, rleft);
1044           if (iaddr ^= 0) then
1045           zleft = zleft + fixed (glpl_words (iaddr + 3).left, 18);
1046           rright, zright = 0;
1047           if (brk (1) = icomma) then
1048           do;
1049                junk = varevl_$varevl_ (invrvl, basno, zright, admod, b29, iaddr);
1050                call getbit_$getbit_ (iaddr, basno, b29, rright);
1051                if (iaddr ^= 0) then
1052                zright = zright + fixed (glpl_words (iaddr + 3).left, 18);
1053           end;
1054           call putout_$putwrd (pc, glpl_$glwrd (zleft, zright), i66, glpl_$glwrd (rleft, rright));
1055           go to label_3010;
1056 
1057 /*  itb pseudo-operation, generate link pair.  */
1058 
1059 label_vector (35):            /*  itb  */
1060 label_2400:
1061 
1062           call litevl_$itbevl (rslts (1), rrslts (1));
1063           go to label_2455;
1064 
1065 /*  its pseudo-operation, generate link pair.  */
1066 
1067 label_vector (36):            /*  its  */
1068 label_2450:
1069 
1070           call litevl_$itsevl (rslts (1), rrslts (1));
1071 
1072 label_2455:
1073 
1074           if (mod (spc, 2) ^= 0) then
1075           call putout_$putwrd (pc, (mnopdu), i642, 0);
1076           call putout_$putlst (pc, rslts (1), i66, 2, rrslts (1)); /*  I66 format is fudge to avoid inhibit bit.  */
1077           go to label_3010;
1078 
1079 
1080 /*  subroutine linkage pseudo-operations.  */
1081 
1082 /*  call pseudo-operation, call subroutine with args and returns.  */
1083 
1084 label_vector (37):            /*  call  */
1085 label_2500:
1086 
1087           junk = varevl_$varevl_ (ixvrvl, basno, value, admod, b29, iaddr);
1088           call getbit_$getbit_ (iaddr, basno, b29, rleft);
1089 
1090           addr (nslbit (5)) -> word.left , addr (new_nslbit (3)) -> word.left = addr (rleft) -> word.right;
1091 
1092           if (iaddr ^= 0) then
1093           value = value + fixed (glpl_words (iaddr + 3).left, 18);
1094           traout = utils_$makins (basno, value, mtra, b29, admod);
1095           new_slcall (3) = utils_$makins (basno, value, new_slcall (3), b29, admod);
1096           if (brk (1) = ilpar) then go to label_2510;
1097           call litevl_$litasn (value, dzero (1), 2, 0);
1098           argout = utils_$makins (0, value + fixed (glpl_words (lplit + 3).left, 18), meapap, 0, 0);
1099           nslbit (3), new_nslbit (2) = iltext;
1100           go to label_2520;
1101 
1102 label_2505:
1103 
1104 
1105 /*  mm/xo call with no args  */
1106 /*  ap points to  */
1107           argout = utils_$makins (6, 30, meapap, 1, 0);
1108           nslbit (3), new_nslbit (2) = iltext;
1109           go to label_2520;
1110 
1111 label_2510:
1112 
1113           junk = varevl_$varevl_ (ixvrvl, basno, value, admod, b29, iaddr);
1114           call getbit_$getbit_ (iaddr, basno, b29, rleft);
1115 
1116           addr (nslbit (3)) -> word.left, addr (new_nslbit (2)) -> word.left = addr (rleft) -> word.right;
1117 
1118           if (iaddr ^= 0) then
1119           value = value + fixed (glpl_words (iaddr + 3).left, 18);
1120           argout = utils_$makins (basno, value, meapap, b29, admod);
1121 
1122 label_2520:
1123 
1124           if (tstsw (1) ^= 0) then go to label_2550;
1125           slcall (3), new_slcall (2) = argout;
1126           slcall (5) = traout;
1127           if tnewcall ^= 0 then call putout_$putlst (pc, new_slcall (1), i642, new_nslcal, new_nslbit (1));
1128           else call putout_$putlst (pc, slcall (1), i642, nslcal, nslbit (1));
1129           go to label_3140;
1130 
1131 /*  mastermode calls changed per bd.7.03, july 14, 1967.  */
1132 /*  lpaswd is simply the transfer vector number as a literal.  */
1133 /*  the call is made from text segment.  */
1134 /*  return is made to the link segment.  */
1135 /*  j.d.mills 12 july 67  (please compare dates.)  */
1136 
1137 
1138 label_2550:
1139 
1140           j = lstman_$calser (spc, link);
1141           link = link + fixed (glpl_words (lpsect + 3).left, 18);
1142           call litevl_$litasn (lpaswd, fixed (glpl_words (j + 2).right, 18), 1, 0);
1143           mxcall (3) = utils_$makins (lp, link, meapap, 1, 0);
1144           mxcall (5) = argout;
1145           mxcbit (5) = nslbit (3);
1146           mxcall (7) = utils_$makins (0, lpaswd + fixed (glpl_words (lplit + 3).left, 18), mldq, 0, 0);
1147           mxcall (11) = traout;
1148           mxcbit (11) = nslbit (5);
1149           call putout_$putlst (pc, mxcall (1), i642, nmxcal, mxcbit (1));
1150 
1151           mxclbk (2) = utils_$makins (0, lpaswd + fixed (glpl_words (lplit + 3).left, 18), mcmpq, 0, 0);
1152           mxlbit (2) = iltext;
1153           mxclbk (3) = utils_$makins (0, lreter, mtnz, 0, 0);
1154           mxlbit (3) = iltext;
1155           call putout_$putlst (pc, mxclbk (1), i642, nmxclb, mxlbit (1));
1156           go to label_3140;
1157 
1158 /*  short_call pseudo-operation, call without saving any registers.  */
1159 
1160 label_vector (51):            /*  short_call  */
1161 label_short_call:   /*  AP already set to arg list.  */
1162           junk = varevl_$varevl_ (ixvrvl, basno, value, admod, b29, iaddr);
1163           call getbit_$getbit_ (iaddr, basno, b29, rleft);
1164           addr (short_nslbit (1)) -> word.left = addr (rleft) -> word.right;
1165           if iaddr ^= 0 then value = value + fixed (glpl_words (iaddr + 3).left, 18);
1166           short_slcall (1) = utils_$makins (basno, value, short_slcall (1), b29, admod);
1167           call putout_$putlst (pc, short_slcall (1), i642, short_nslcal, short_nslbit (1));
1168           goto label_3140;
1169 
1170 /*  entry pseudo-operation, enter symbol into entry point table.  */
1171 
1172 label_vector (38):            /*  entry  */
1173 label_2600:
1174 
1175           call getid_$getid_;
1176           if (eb_data_$tsym = 0) then go to label_3100;
1177           if (table_$table_ (iserch, sym (1), value, flocrf, lcloc) = 0) then go to label_3130;
1178           link = mylnk;
1179           name = lstman_$namasn (sym (1));
1180 
1181 /*  ft2 has xr7 modif.  -  int expr. word has  */
1182 /*  absol 0  (no location counter) for a value.  */
1183           if (tprot = 0) then if tnewobject = 0 then
1184           link = lstman_$lnkasn (lstman_$blkasn (1, fixed (glpl_words (lcloc + 4).right, 18), 0, 0), 0, eb_data_$mx7, 0);
1185           else link = 0;
1186           trplnk = 0;
1187           if (brk (1) ^= ilpar) then go to label_2620;
1188           tmvdef = 1;
1189           tderr = 0;
1190           trprtn = label_2610;
1191           go to label_933;
1192 
1193 label_2610:
1194 
1195           if (tderr ^= 0) then
1196           prntf = 1;
1197 
1198 label_2620:
1199 
1200           class = 1;
1201           if (brk (1) ^= ilsb) then go to label_2640;
1202           call getid_$getid_;
1203           if (expevl_$expevl_ (0, class, iaddr) = 0) then
1204           prntr,prntf = 1;
1205           if (iaddr ^= 0) then
1206           prntr = 1;
1207           if (brk (1) = irsb) then go to label_2630;
1208           prntf = 1;
1209           go to label_2640;
1210 
1211 label_2630:
1212 
1213           call inputs_$next;
1214 
1215 label_2640:
1216 
1217           junk = lstman_$eptasn (value, name, link, lcloc, trplnk, class);
1218           if (brk (1) = icomma) then go to label_2600;
1219           if (lcloc = 0) then go to label_3200;
1220           value = value + fixed (glpl_words (lcloc + 3).left, 18);
1221           go to label_3200;
1222 
1223 /* ext_entry pseudo_operation Usage: ext_entry elabel,stackframe_size,clabel,dlabel,function */
1224 
1225 label_vector (64):
1226 label_2641:
1227           call getid_$getid_;
1228           if eb_data_$tsym = 0 then goto label_3100;        /* field error */
1229           j = bin("000240000"b3, 26);   /* default entry seq flags: rev1, variable */
1230 
1231           /* retrieve calculated stackframe size */
1232           stkc = fixed(glpl_words(stkclst).left);
1233           stkclst = fixed(glpl_words(stkclst).right);
1234           i = stkc; /* use calculated value as default stackframe size */
1235 
1236           if table_$table_(iserch, sym(1), value, flocrf, lcloc) = 0 then goto label_3130; /* undefined error */
1237           if lcloc = 0 then goto label_3200;
1238           value = value + fixed(glpl_words(lcloc+3).left, 18); /* addr(elabel) */
1239           name = lstman_$namasn(sym(1));
1240           if brk(1) ^= icomma then goto label_2642;         /* emit code */
1241           /* second arg stackframe size */
1242           junk = varevl_$varevl_(invrvl, basno, k, admod, b29, iaddr);
1243           if junk ^= 0 & k ^= 0 then i = k;
1244           if iaddr ^= 0 then prntr = 1;
1245           if brk(1) ^= icomma then goto label_2642;         /* emit code */
1246           call getid_$getid_;
1247           /* third argument clabel, skip in this pass */
1248           if brk(1) ^= icomma then goto label_2642;         /* emit code */
1249           call getid_$getid_;
1250           /* fourth argument descriptor label */
1251           if sym(1) ^= 0 then do;
1252                if table_$table_(iserch, sym(1), j, flocrf, iaddr) = 0 then goto label_3130;         /* undefined */
1253                if iaddr^=0 then j = j + fixed(glpl_words(iaddr+3).left, 18);
1254                call putout_$putlst(pc, 262144 * j, i66, 1, iltext);
1255                j = bin("000300000"b3, 26);        /* entry seq flags rev1, has_descriptors */
1256             end;
1257           if brk(1) ^= icomma then goto label_2642;         /* emit code */
1258           call getid_$getid_;
1259           /* fifth argument, function */
1260           if sym(1) ^= 0 then do;
1261                if (sym(1) ^= ifun1) | (sym(2) ^= ifun2) | (sym(3) ^= ifun3) then goto label_3130; /* undefined symbol */
1262                else  j = j + bin("000020000"b3, 26); /* entry seq flags function */
1263             end;
1264 
1265 label_2642:         /* emit structures and code for entry sequence */
1266           class = fixed(glpl_words(curlc + 4).right, 18) + fixed("100000"b3, 18);         /* entry flag */
1267           junk = lstman_$sdfasn (pc + 1 + fixed(glpl_words(curlc+3).left, 18), name, curlc, 0, class);
1268 
1269           /*        def_relp(filled in later), flags        */
1270           call putout_$putlst(pc, j, i66, 1, ildefs);
1271 
1272           /*        eax7      stack_size          */
1273           i = 16 * divide(i + 15, 16, 18, 0);     /* mod 16 boundary */
1274           call putout_$putlst(pc, i*262144 + bin("627000"b3, 19), i66, 1, 0);
1275 
1276           /*        epp2      pr7|28,*  */
1277           call putout_$putlst(pc, bin("700034352120"b3, 36), i66, 1, 0);
1278 
1279           /*        tsp2      pr2|549   */
1280           call putout_$putlst(pc, bin("201045272100"b3, 36), i66, 1, 0);
1281 
1282           /*        offset sequence     */
1283           call putout_$putlst(pc, 0, i66, 1, 0);
1284           call putout_$putlst(pc, 0, i66, 1, isymbl);
1285 
1286           /*        tra       label (value)       */
1287           call putout_$putlst(pc, value * 262144 + bin("710000"b3, 26), i66, 1, iltext);
1288           goto label_3010;    /* done */
1289 
1290 
1291 /*  return pseudo-operation, return control to caller.  */
1292 
1293 label_vector (39):            /*  return  */
1294 label_2700:
1295 
1296           call getid_$getid_;
1297           if (brk (1) ^= iques) then go to label_2720;
1298           junk = varevl_$varevl_ (invrvl, basno, value, admod, b29, iaddr);
1299           if (iaddr = 0) then go to label_2710;
1300           pc = spc + nertls;
1301           go to label_3300;
1302 
1303 
1304 label_2710:
1305 
1306           ertlst (5) = utils_$makins (ap, 2 * value, mldaq, 1, 0);
1307           ertlst (6) = utils_$makins (sp, labarg + 2, eb_data_$mstaq, 1, 0);
1308           ertlst (7) = utils_$makins (sp, labarg, meapap, 1, 0);
1309           irtblk = lstman_$blkasn (4, lstman_$namasn (eb_data_$unwind (1)), lstman_$namasn (eb_data_$unwind (1)), 0);
1310           ertlst (11) = utils_$makins (lp, lstman_$lnkasn (irtblk, 0, 0, 0) + fixed (glpl_words (lpsect + 3).left, 18),
1311                                                                                 mtra, 1, mri);
1312           call putout_$putlst (pc, ertlst (1), i642, nertls, merbit (1));
1313           go to label_3140;
1314 
1315 /*  normal return sequence.  */
1316 
1317 label_2720:
1318 
1319           if tnewcall ^= 0 then call putout_$putlst (pc, new_retlst (1), i642, new_nretls, new_mrtbit (1));
1320           else call putout_$putlst (pc, retlst (1), i642, nretls, mrtbit (1));
1321           go to label_3140;
1322 
1323 /*  short_return pseudo-operation, return with no previous save.  */
1324 
1325 label_vector (46):            /*  short_return  */
1326 label_short_return:
1327           if tnewcall = 0 then prnto = 1;
1328           call putout_$putlst (pc, short_retlst (1), i642, short_nretls, short_mrtbit (1));
1329           goto label_3140;
1330 
1331 /*  save pseudo-operation, stack setup for subroutine call.  */
1332 
1333 label_vector (41):            /*  save/push  */
1334 label_2800:
1335 
1336           junk = varevl_$varevl_ (invrvl, basno, value, admod, b29, iaddr);
1337           if (value = 0) then go to label_2810;
1338           if (iaddr = 0) then go to label_2805;
1339           prntr = 1;
1340           if tnewcall ^= 0 then pc = spc + new_nslsav;
1341           else pc = spc + nslsav;
1342           if tprot = 1 then
1343           pc = pc + eb_data_$nmxsav;
1344           go to label_3300;
1345 
1346 label_2805:
1347 
1348           value = 8 * (divide (value + 7, 8, 17, 0));
1349           go to label_2820;
1350 
1351 label_2810:
1352 
1353           value = stkc;
1354           basno, admod, b29 = 0;
1355 
1356 label_2820:
1357 
1358           if tnewcall ^= 0 then if tprot = 0 then do;
1359                     value = 16 * divide (value + 15, 16, 17, 0);
1360                     new_slsave (1) = utils_$makins (basno, value, new_slsave (1), b29, admod);
1361                     call putout_$putlst (pc, new_slsave (1), i642, new_nslsav, new_mslbit (1));
1362                     goto label_3140;
1363                     end;
1364 
1365           slsave (3) = utils_$makins (bp, value, meapbp, 1, 0);
1366           slsave (4) = utils_$makins (bp, 18 - value, mstpbp, 1, 0);
1367           slsave (5) = utils_$makins (bp, - value, meabsp, 1, 0);
1368           if tprot = 1 then
1369           call putout_$putlst (pc, mxsave (1), i642, eb_data_$nmxsav, mxsbit (1));
1370           call putout_$putlst (pc, slsave (1), i642, nslsav, mslbit (1));
1371           go to label_3140;
1372 
1373 /*  segdef pseudo-operation, put symbol on external definition list.  */
1374 
1375 label_vector (42):            /*  segdef  */
1376 label_2900:
1377 
1378           call getid_$getid_;
1379           if (eb_data_$tsym = 0) then go to label_3100;
1380           if (table_$table_ (iserch, sym (1), value, flocrf, lcloc) = 0) then go to label_3130;
1381           name = lstman_$namasn (sym (1));
1382           trplnk = 0;
1383           if (brk (1) ^= ilpar) then go to label_2920;
1384           tmvdef = 1;
1385           tderr = 0;
1386           trprtn = label_2910;
1387           go to label_933;
1388 
1389 label_2910:
1390 
1391           if (tderr = 1) then
1392           prntf = 1;
1393 
1394 label_2920:
1395 
1396           class = fixed (glpl_words (lcloc + 4).right, 18);
1397           if (brk (1) ^= ilsb) then go to label_2940;
1398           call getid_$getid_;
1399           if (expevl_$expevl_ (0, class, iaddr) = 0) then
1400           prntr,prntf = 1;
1401           if (iaddr ^= 0) then
1402           prntr = 1;
1403           if (brk (1) = irsb) then go to label_2930;
1404           prntf = 1;
1405           go to label_2940;
1406 
1407 label_2930:
1408 
1409           call inputs_$next;
1410 
1411 label_2940:
1412 
1413           junk = lstman_$sdfasn (value, name, lcloc, trplnk, class);
1414           if (brk (1) = icomma) then go to label_2900;
1415           if (lcloc = 0) then go to label_3200;
1416           value = value + fixed (glpl_words (lcloc + 3).left, 18);
1417           go to label_3200;
1418 
1419 
1420           /* block  indicate the start of a program block for statement map */
1421 label_vector (68):  /* block  {block_name} */
1422           call getid_$getid_;
1423           if eb_data_$tsym = 0 then call alm_symtab_$block("");
1424           else call alm_symtab_$block( addr(sym(1)) -> acc_string.chars );
1425           goto label_3140;    /* all done */
1426 
1427           /* end_block        indicate the end of a program block for statement map */
1428 label_vector (69):  /* end_block */
1429           call alm_symtab_$end_block;
1430           goto label_3140;    /* all done */
1431 
1432           /* enum   indicate start of enumerated-type symbol table dcls */
1433 label_vector (70):  /* enum */
1434           call getid_$getid_;
1435           var_name = addr(sym(1)) -> acc_string.chars;
1436           do while(brk(1) ^= icomma & brk(1) ^= inl & brk(1) ^= iquot);
1437                var_name = var_name || addr(brk(2)) -> dup_string(3);
1438                call getid_$getid_;
1439                var_name = var_name || addr(sym(1)) -> acc_string.chars;
1440             end;
1441           if var_name = "" then goto label_3100;  /* field error */
1442           else call alm_symtab_$enum( (var_name) );
1443           goto label_3140;    /* all done */
1444 
1445           /* end_enum         indicate end of enum symbol table dcls */
1446 label_vector (71):  /* end_enum */
1447           call alm_symtab_$end_enum;
1448           goto label_3140;    /* all done */
1449 
1450           /* source indicate the current source for statement map */
1451 label_vector (72):  /* source <source_path> */
1452           unique_id = "0"b;
1453           dtcm = 0;
1454           call getid_$getid_; /* get first part of path */
1455           path = addr(sym(1)) -> acc_string.chars;
1456           do while(brk(1) ^= icomma & brk(1) ^= inl & brk(1) ^= iquot);         /* get rest of path */
1457                path = path || addr(brk(2)) -> dup_string(3);          /* add break char */
1458                call getid_$getid_;
1459                path = path || addr(sym(1)) -> acc_string.chars;            /* add next word */
1460             end;
1461           if path = "" then goto label_3100;      /* field error */
1462           if brk(1) = icomma then do;   /* get unique id and dtcm */
1463                n = octevl_$octevl_ (rslts (1));
1464                if n >=2 then goto label_3100; /* number too big, field error */
1465                unique_id = unspec(rslts(1));
1466                if brk(1) ^= icomma then goto label_3100; /* missing dtcm, field error */
1467                n = decevl_$decevl_(rslts(1), type);
1468                if n = 1 then dtcm = rslts(1);
1469                else dtcm = addr(rslts(1)) -> long_int_based;
1470             end;
1471           else begin;         /* no dtcm & unique_id figure it out ourselves */
1472           dcl       (dirname char(256), entryname char(32), compname char(32)) automatic;
1473           dcl       seg_ptr ptr;
1474           dcl       code fixed bin(35);
1475 
1476                seg_ptr = null();
1477                call expand_pathname_$component((path), dirname, entryname, compname, code);
1478                if code ^= 0 then goto label_2950;      /* forget it */
1479           on     cleanup call terminate_file_(seg_ptr, 0, "001"b, 0);
1480                call initiate_file_$component(dirname, entryname, compname, "100"b, seg_ptr, 0, code);
1481                if code ^= 0 then goto label_2950;      /* forget it */
1482                call translator_info_$component_get_source_info(seg_ptr, dirname, entryname, compname, dtcm, unique_id, code);
1483                if code ^= 0 then goto label_2950;      /* can't figure it out */
1484                call terminate_file_(seg_ptr, 0, "001"b, code);
1485                path = rtrim(dirname, "> ") || ">" || rtrim(entryname, " ");
1486                if compname ^= "" then path = path || "::" || compname;
1487             end;
1488 label_2950:
1489           call alm_symtab_$source((path), unique_id, dtcm);
1490           goto label_3140;    /* all done */
1491 
1492           /* end_source       indicate end of source segment for statement map */
1493 label_vector (73):  /* end_source */
1494           call alm_symtab_$end_source;
1495           goto label_3140;    /* all done */
1496 
1497           /* statement        <st_offset>,<len>,<line_no>{,<stmnt_no>} */
1498 label_vector (74):  /* statement */
1499           junk = varevl_$varevl_(invrvl, basno, st_offset, admod, b29, iaddr);
1500           if iaddr ^= 0 then prntr = 1;
1501           if brk(1) ^= icomma then goto label_3100;         /* field error */
1502           junk = varevl_$varevl_(invrvl, basno, st_length, admod, b29, iaddr);
1503           if iaddr ^= 0 then prntr = 1;
1504           if brk(1) ^= icomma then goto label_3100;         /* field error */
1505           junk = varevl_$varevl_(invrvl, basno, st_line, admod, b29, iaddr);
1506           if iaddr ^= 0 then prntr = 1;
1507           if brk(1) = icomma then do;   /* optional statement num */
1508                junk = varevl_$varevl_(invrvl, basno, st_num, admod, b29, iaddr);
1509                if iaddr ^= 0 then prntr = 1;
1510             end;
1511           else st_num = 1;    /* if not specified, then statement num = 1 */
1512           call alm_symtab_$statement(pc + fixed(glpl_words(curlc+3).left, 18),
1513                st_offset, st_length, st_line, st_num);
1514           goto label_3140;
1515 
1516           /* structure        indicate start of structure symbol table dcls */
1517 label_vector (75):  /* structure        <structure_name> */
1518           call getid_$getid_;
1519           var_name = addr(sym(1)) -> acc_string.chars;
1520           do while(brk(1) ^= icomma & brk(1) ^= inl & brk(1) ^= iquot);
1521                var_name = var_name || addr(brk(2)) -> dup_string(3);
1522                call getid_$getid_;
1523                var_name = var_name || addr(sym(1)) -> acc_string.chars;
1524             end;
1525           if var_name = "" then goto label_3100;  /* field error */
1526           else call alm_symtab_$structure( (var_name) );
1527           goto label_3140;    /* all done */
1528 
1529           /* end_structure    indicate end of structure symbol table dcls */
1530 label_vector (76):  /* end_structure */
1531           call alm_symtab_$end_structure;
1532           goto label_3140;    /* all done */
1533 
1534 label_vector (77):  /* symbol <symbol_name>,<symbol_type>{,location} */
1535           call getid_$getid_; /* name */
1536           var_name = addr(sym(1)) -> acc_string.chars;
1537           do while(brk(1) ^= icomma & brk(1) ^= inl & brk(1) ^= iquot);
1538                var_name = var_name || addr(brk(2)) -> dup_string(3);
1539                call getid_$getid_;
1540                var_name = var_name || addr(sym(1)) -> acc_string.chars;
1541             end;
1542           if var_name = "" then goto label_3100;  /* field error */
1543 
1544           call getid_$getid_; /* type */
1545           var_type = addr(sym(1)) -> acc_string.chars;
1546           i = 0;    /* nesting level for '[' ... ']' pairs */
1547           do while(brk(1) ^= inl & (brk(1) ^= icomma | i > 0) & brk(1) ^= iquot);
1548                if brk(1) = ilsb then i = i + 1;   /* another '[' */
1549                else if brk(1) = irsb then i = i - 1;        /* matching ']' */
1550                var_type = var_type || addr(brk(2)) -> dup_string(3);
1551                if brk(1) ^= ilsb & brk(1) ^= icomma & brk(1) ^= icol then do;
1552                     call getid_$getid_;
1553                     var_type = var_type || addr(sym(1)) -> acc_string.chars;
1554                  end;
1555                else do;
1556                     call getid_$getid_;
1557                     /* if the identifier has a symbolic value use it */
1558                     junk = table_$table_(iserch, sym(1), value, flocrf, lcloc);
1559                     if junk=0 then var_type = var_type || addr(sym(1)) -> acc_string.chars;
1560                     else do;
1561                          if lcloc ^= 0 then value = value + fixed(glpl_words(lcloc+3).left, 18);
1562                          var_type = var_type || ltrim(char(value));
1563                       end;
1564                  end;
1565             end;
1566           if var_type = "" | i > 0 then goto label_3100;    /* field error */
1567 
1568           /* location {optional} */
1569           i = 0;    /* initial offset = 0 bits */
1570           if brk(1) = icomma then do;
1571                if varevl_$varevl_(ixvrvl, basno, value, admod, b29, iaddr) = 0 then goto label_3120; /* S error */
1572                if brk(1) = ilpar then do;         /* bit offset */
1573                     if varevl_$varevl_(invrvp, 0, i, 0, 0, 0) = 0 then goto label_3120;   /* S error */
1574                  end;
1575                if basno = 0 & value = 0 & admod = 0 & b29 = 0 & iaddr = 0 & i = 0 then goto label_3100; /* F error */
1576                call alm_symtab_$symbol((var_name), (var_type), basno, value, admod, b29, iaddr, i);
1577             end;
1578           else call alm_symtab_$symbol((var_name), (var_type), 0, 0, 0, 0, 0, 0);
1579           goto label_3140;    /* all done */
1580 
1581 
1582           /* union  indicate start of union symbol table dcls */
1583 label_vector (78):  /* union  <union_name> */
1584           call getid_$getid_;
1585           var_name = addr(sym(1)) -> acc_string.chars;
1586           do while(brk(1) ^= icomma & brk(1) ^= inl & brk(1) ^= iquot);
1587                var_name = var_name || addr(brk(2)) -> dup_string(3);
1588                call getid_$getid_;
1589                var_name = var_name || addr(sym(1)) -> acc_string.chars;
1590             end;
1591           if var_name = "" then goto label_3100;  /* field error */
1592           else call alm_symtab_$union( (var_name) );
1593           goto label_3140;    /* all done */
1594 
1595           /* end_union        indicate end of union symbol table dcls */
1596 label_vector (79):  /* end_union */
1597           call alm_symtab_$end_union;
1598           goto label_3140;    /* all done */
1599 
1600 
1601 /*  setlp pseudo - op.  */
1602 /*  generate eaplp -*, ic with 3a relocation bits.  */
1603 
1604 label_vector (45):            /*  setlp  */
1605 label_2970:
1606 
1607           call putout_$putwrd (pc, utils_$makins (0, - fixed (glpl_words (curlc + 3).left, 18) - pc, meaplp, 0, mpc),
1608                                                                                 i642, glpl_$glwrd (imlink, 0));
1609           go to label_3010;
1610 
1611 /*  getlp pseudo-operation, set LP from lot.  */
1612 
1613 label_vector (49):            /*  getlp  */
1614 label_getlp:
1615           call putout_$putlst (pc, new_getlp (1), i642, new_ngetlp, new_getbit (1));
1616           goto label_3140;
1617 
1618 
1619 
1620 /*  EIS multi-word instruction operand descriptors are generated by these pseudo-ops.  */
1621 
1622 label_vector (55):            /*  desc9a, desc6a, desc4a  */
1623 label_eis_desca:
1624           type = 1;
1625           goto desc_common;
1626 
1627 label_vector (56):            /*  descb  */
1628 label_eis_descb:
1629           type = 2;
1630           goto desc_common;
1631 
1632 label_vector (57):            /*  desc9fl, desc4us, etc.  */
1633 label_eis_descn:
1634           type = 3;
1635 
1636 desc_common:
1637           nobits = fixed (addr (binop) -> descop_overlay.flags, 4);   /*  9, 6, 4, or 1  */
1638           class = fixed (addr (binop) -> descop_overlay.format, 4);   /*  Numeric operand format (fixed vs. float, etc.).  */
1639           full_word_temp = alm_eis_parse_$descriptor (type, nobits, class, rleft);
1640           call putout_$putwrd (pc, full_word_temp, i66, rleft);
1641           goto label_3015;
1642 
1643 
1644 label_vector (52):            /*  rpt, rpd, rpl  */
1645 label_repeat:                 /*  repeat type instructions rpt, rpd, and rpl.  Format is:
1646                                         RPT       tally,delta,term1,term2,...
1647                                  where term_^Hi are the names of the conditional transfer instructions
1648                                  that test the states to be terminated on.  The A, B, and C bits are
1649                                  kept in the opcode_overlay.flags field (viz. RPD, RPDA, RPTX).  */
1650 
1651           call getid_$getid_;
1652           if expevl_$expevl_ (0, zleft, iaddr) = 0 then prnte = 1;
1653           if iaddr ^= 0 then prntr = 1;
1654           if brk (1) = icomma then do;
1655                     call getid_$getid_;
1656                     if expevl_$expevl_ (0, zright, iaddr) = 0 then prnte = 1;
1657                     if iaddr ^= 0 then prntr = 1;
1658                     if zright < 0 | zright > 63 then prnte = 1;
1659                     end;
1660           else zright = 1;                        /*  delta defaults to 1.  */
1661 
1662           termination_conditions = ""b;
1663           do i = 1 to 7 while (brk (1) = icomma);
1664                     call getid_$getid_;
1665                     do j = 1 to 7;
1666                               if sym (1) = eb_data_$rpt_terminators (j) then do;
1667                                         substr (termination_conditions, j, 1) = "1"b;
1668                                         goto rpt_out;
1669                                         end;
1670                               end;
1671                     prntu = 1;
1672           rpt_out:  end;
1673 
1674           zleft = zleft * 1024 + fixed (addr (binop) -> opcode_overlay.flags || termination_conditions, 11);
1675           itemp = tinhib;               /*  Processor manual calls for RPT to have inhibit flag on always.  */
1676           tinhib = 1;
1677           call putout_$putwrd (pc, utils_$makins (0, zleft, binop, 0, zright), i642, 0);
1678           tinhib = itemp;
1679           goto label_3015;
1680 
1681 
1682 label_vector (53):            /*  awd, swd, abd, sbd, etc.  */
1683 label_eis_single:             /*  single word EIS instructions awd, abd, etc.  Format is:
1684                                         AWD       base|offset,tag
1685                                  where base is required, in order to select a target register.
1686                                  For AWDX, etc., the opcode_overlay.flags field is non-zero to indicate
1687                                  that bit 29 should be turned off.  (This makes add into clear-and-add, etc.)  */
1688 
1689           if varevl_$varevl_ (ixvrvl, basno, value, admod, b29, iaddr) = 0 then prnte = 1;
1690           if b29 = 0 then do;           /*  Base number _^Hm_^Hu_^Hs_^Ht be specified.  */
1691                     prnte = 1;
1692                     b29 = 1;
1693                     end;
1694           if iaddr = 0 then rleft = 0;            /*  calculate relocation bits.  */
1695           else do;
1696                     value = value + fixed (glpl_words (iaddr + 3).left, 18);
1697                     call getbit_$getbit_ (iaddr, basno, b29, rleft);
1698                     rleft = rleft * 262144;
1699                     end;
1700 
1701           full_word_temp = utils_$makins (basno, value, binop, b29, admod);
1702           if addr (binop) -> opcode_overlay.flags then full_word_temp = full_word_temp - 64;        /*  turn b29 OFF  */
1703           call putout_$putwrd (pc, full_word_temp, i642, rleft);
1704           goto label_3015;
1705 
1706 label_vector (54):            /*  mvn, cmpb, ad2d, etc.  */
1707 label_eis_multiple:           /*  EIS instructions with multi-word operand descriptors, MLR, CMPB, etc.
1708                                  The instruction word contains up to three tags for the operands
1709                                  and several kinds of flags and numeric values.  */
1710 
1711           flags = fixed (addr (binop) -> opcode_overlay.flags, 4);              /*  Non-zero if FILL field is only one bit wide.  */
1712           full_word_temp = alm_eis_parse_$instruction (binop, flags, rleft);
1713           call putout_$putwrd (pc, full_word_temp, i642, rleft);
1714           goto label_3015;
1715 
1716 
1717 label_vector (44):            /*  eap, sprp, etc.  */
1718 label_get_base:               /*  normal base register instructions written as:
1719                                         EAP       bp,ap|2,*
1720                                  This is so symbolic names can be used for base registers.  */
1721 
1722           rslts (1) = sym (1); rslts (2) = sym (2);         /*  Save opcode name.  */
1723           call getid_$getid_;
1724           do itemp = 0 to 7;            /*  Search for predefined base register name first.  */
1725                     if sym (1) = symbas (itemp + 1) then goto got_index;
1726                     end;
1727           goto get_index;               /*  join common code.  */
1728 
1729 label_vector (43):            /*  eax, canx, etc.  */
1730 label_get_index:              /*  normal index register instructions written with separate register name as above.  */
1731           rslts (1) = sym (1); rslts (2) = sym (2);         /*  As above. */
1732           call getid_$getid_;
1733 
1734 get_index:
1735           if expevl_$expevl_ (0, itemp, iaddr) = 0 then prnte = 1;
1736           if iaddr ^= 0 then prntr = 1;
1737 
1738 got_index:
1739           if itemp < 0 | itemp > 7 then do;
1740                     prnte = 1;
1741                     itemp = 0;
1742                     end;
1743           sym (1) = rslts (1); sym (2) = rslts (2);         /*  Put opcode name back.  */
1744                     /*  Fudge opcode name to contain register number.  */
1745           j = addr (sym) -> acc_string.length + 1;
1746           addr (sym) -> acc_string.length = j;
1747           substr (addr (sym) -> acc_string.chars, j, 1) = substr ("01234567", itemp + 1, 1);
1748           if brk (1) = icomma then brk (1) = isp;/*fix equ bug*/
1749           goto label_301;                         /*  Go re-evaluate opcode.  */
1750 
1751 label_vector (58):
1752 label_entrybound:
1753           eb_data_$entry_bound = spc + fixed(glpl_words(curlc + 3).left, 18);
1754           goto label_3010;
1755 
1756 
1757 /*  NORMAL INSTRUCTIONS  */
1758 
1759 label_vector (0):             /*  Normal instruction.  */
1760 label_3000:
1761           if (varevl_$varevl_ (ixvrvl, basno, value, admod, b29, iaddr) = 0) then prnte = 1;
1762           rleft = 0;
1763           if (iaddr = 0) then go to label_3008;
1764           value = value + fixed (glpl_words (iaddr + 3).left, 18);
1765 
1766 /*  determine the proper relocation bits  */
1767 
1768           call getbit_$getbit_ (iaddr, basno, b29, rleft);
1769 
1770 /*  the following statement left justifies the reloc. bits  */
1771 /*  and avoids a call to glpl_$glwrd (rleft, 0) for each instruction.  */
1772 
1773           rleft = rleft * 262144;
1774 
1775 label_3008:
1776 
1777           call putout_$putwrd (pc, utils_$makins (basno, value, binop, b29, admod), i642, rleft);
1778           goto label_3015;
1779 
1780 /*  re - entry from pseudo-operation processing.  */
1781 
1782 label_3010:
1783           call prwrd_$source_only;
1784 label_3015:
1785 
1786           if (pc = tpc & curlc = tlc) then go to label_3040;
1787           call prnter_$prnter_ ("fatal phase error in pass2.");
1788           call utils_$abort;
1789 
1790 
1791 
1792 /*  skip over comment portion of card  */
1793 
1794 label_3040:
1795 
1796           call inputs_$next_statement;
1797           go to label_200;
1798 
1799 
1800 /*  error return for pseudo-operations.  */
1801 
1802 /*  field (f) error.  */
1803 
1804 label_3100:
1805 
1806           prntf = 1;
1807           go to label_3200;
1808 
1809 /*  phase (p) error.  */
1810 
1811 label_3110:
1812 
1813           prntp = 1;
1814           go to label_3200;
1815 
1816 /*  symbol (s) definition error.  */
1817 
1818 label_3120:
1819 
1820           prnts = 1;
1821           go to label_3200;
1822 
1823 /*  undefined (u) symbol error.  */
1824 
1825 label_3130:
1826 
1827           prntu = 1;
1828           go to label_3200;
1829 
1830 /*  variable length macro phase error.  */
1831 
1832 label_3140:
1833 
1834           if curlc = tlc then go to label_3150;
1835           call prnter_$prnter_ ("fatal multiple location counter mismatch in pass2.");
1836           call utils_$abort;
1837 
1838 label_3150:
1839 
1840           if pc = tpc then go to label_3040;
1841           prntp = 1;
1842           pc = tpc;
1843           go to label_3040;
1844 
1845 
1846 label_vector (9):             /* dup */
1847 label_dup:
1848           if dup_ptr ^= null () then go to label_3120;
1849           if varevl_$varevl_ (invrvl, basno, value, admod, b29, iaddr) = 0 then go to label_3120;
1850           if iaddr ^= 0 then go to label_3300;
1851           if value <= 0 then go to label_3120;
1852           dup_count = value - 1;
1853           call prwrd_$prwrd_ (spc + fixed (glpl_words (curlc + 3).left, 18), value, eb_data_$ib6);
1854           call inputs_$next_statement;
1855           call inputs_$get_ptr (dup_ptr, dup_start, junk, end_statement_flag);
1856           go to label_200;
1857 
1858 label_vector (10):            /* dupend */
1859 label_dupend:
1860           if dup_ptr = null () then go to label_3120;
1861           call inputs_$get_ptr (temp_ptr, i, j, end_statement_flag);
1862           if temp_ptr ^= dup_ptr then go to label_3100;
1863           i = begin_line;                         /* Really want beginning of line. */
1864           call inputs_$next_statement;
1865           if dup_count > 0 then
1866                call alm_include_file_$insert (addr (dup_string (dup_start)), i - dup_start, dup_count);
1867           dup_ptr = null ();
1868           go to label_200;
1869 
1870 label_vector (60):
1871 label_macro:
1872           call getid_$getid_;
1873           if eb_data_$tsym = 0 then goto label_3100;
1874           call oplook_$redefine;
1875           call inputs_$next_statement;
1876           call mexp_$define_macro (addr (sym (1)) -> acc_string.chars);
1877           go to label_200;
1878 
1879 label_vector (40):
1880 label_maclist:
1881           call getid_$getid_;
1882           if eb_data_$tsym = eb_data_$ion then
1883                tmacl = "00"b;
1884           else if eb_data_$tsym = eb_data_$ioff then
1885                tmacl = "11"b;
1886           else if eb_data_$tsym = eb_data_$iobject then
1887                tmacl = "10"b;
1888           else if eb_data_$tsym = eb_data_$irestore then do;
1889                eb_data_$macro_listing_control = substr (eb_data_$macro_listing_control, 3);
1890                go to end_maclist;
1891           end;
1892           else go to label_3100;
1893 
1894           if brk (1) = icomma then do;
1895                call getid_$getid_;
1896                if eb_data_$tsym = eb_data_$isave then
1897                     eb_data_$macro_listing_control = tmacl || eb_data_$macro_listing_control;
1898                else go to label_3100;
1899           end;
1900 
1901           else substr (eb_data_$macro_listing_control, 1, 2) = tmacl;
1902 
1903 end_maclist:
1904           if eb_data_$macro_depth > 0 then do;
1905                call inputs_$next_statement_nolist;
1906                go to label_200;
1907           end;
1908           else go to label_3300;
1909 
1910 
1911 
1912 /*  possible phase error, print flags, loc, and value.  */
1913 
1914 label_3200:
1915 
1916           if (pc = tpc) then go to label_3210;
1917           prntp = 1;
1918           pc = tpc;
1919 
1920 label_3210:
1921 
1922           call prwrd_$prwrd_ (spc + fixed (glpl_words (curlc + 3).left, 18), value, eb_data_$ib6);
1923           go to label_3040;
1924 
1925 /*  printer for no-valued pseudo-operations, print flags and loc.  */
1926 
1927 label_3300:
1928 
1929           call prwrd_$prwrd_ (spc + fixed (glpl_words (curlc + 3).left, 18), 0, ibb);
1930           go to label_3015;
1931 
1932 
1933      end pass2_;