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, the "init_link" pseudo,
  22      and joining to the symbol section.
  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: ext_entry,
  26      oct_unal, and dec_unal.
  27   4) change(88-03-21,JRGray), approve(88-08-05,MCR7952),
  28      audit(88-09-30,WAAnderson), install(88-10-17,MR12.2-1169):
  29      Changed for symbol table support. Add labels for 12 new pseudos that are
  30      ignored in pass1.
  31                                                    END HISTORY COMMENTS */
  32 
  33 
  34 pass1_:
  35      procedure(decor,target_value,no_target_given,first_time_thru); /* decor is initialized and passed from alm_6180_ ;
  36                                                        target_value, no_target_given come from alm_ via alm_6180_ */
  37 
  38                     /*
  39                        pass1 is the first pass of the Multics assembler .
  40 
  41                        pass1 is primarily concerned with assigning symbol definitions
  42                        so that pass2 of the assembler can generate the binary output.
  43                        pass1 causes several tables to be generated and maintained,
  44                        including the assignment table (for internal symbols) and
  45                        the external name table, segment name table, trap word
  46                        table, link table, literal table, etc. no collation tape
  47                        is written, but the pc at the end of each statement is
  48                        recorded in a list for comparison in pass2, any discrepancy
  49                        is a phase error.
  50                        multiple location counters added
  51                        by J. D. Mills, 1 June 1967.
  52 
  53 
  54           Modified to support *heap links by R Gray and W Anderson on 2/05/86.
  55           Modified for changes to decor processing requested by MTR 175  on 3/25/81 by EBush.
  56           Modified to implement -target on 2/5/81 by EBush.
  57           Modified for decor processing 12/30/80 by E Bush
  58           Modified for macro processing 3/23/77 by Noel I. Morris
  59           Modified for prelinking on 06/15/75 by Eugene E Wiatrowski
  60           Modified 740905 by PG and ARD to extend ACC/ACI/BCI to 167/168/252 characters.
  61           Modified on 07/28/73 at 23:48:28 by R F Mabee.
  62           by RFM in June 1973 to add EIS instructions including multi-word operands.
  63           by RFM on 9 November 1972 to avoid reserving space for text entry sequence in old object format.
  64           by RFM on 21 July 1972 to fix R error on call to internal symbol.
  65           by RFM on 21 March 1972 for new object segment format.
  66           by RFM on 4 March to add new call/save/return operators.
  67           by RHG on 2 June 1971 to suppress "N" flag for undefined op code (should be "O")
  68           by RHG on 2 April 1971 to make rem=null if there was a label
  69                                  to allow "bss ,exp" with no label specified
  70           by RHG on 17 Sept 1970 for new listing package
  71           by RHG on 7 August 1970 at 0545 for new sthead (name pseudo-op)
  72           by NA on July 14, 1970 at 1710 for the proper use of search_return
  73                               and to call expevl_ as a function not a regular subroutine
  74                         */
  75 
  76 /* "Common" variables initialized in eb_data_ */
  77 
  78 
  79 %include varcom;
  80 %include concom;
  81 %include erflgs;
  82 %include codtab;
  83 %include sthedr;
  84 %include mxpro;
  85 %include lstcom;
  86 %include labarg;
  87 %include alm_lc;
  88 %include alm_options;
  89 %include alm_data;
  90 /*^L*/
  91 /* EXTERNAL ENTRIES CALLED BY PASS1 */
  92 
  93  dcl                getid_              ext entry,
  94                     getid_$getnam       ext entry,
  95                     inputs_$next        ext entry,
  96                     inputs_$next_statement        ext entry,
  97                     inputs_$nxtnb       ext entry,
  98                     utils_$pckflg       ext entry ( fixed bin (26) ),
  99                     alm_include_file_$pass1 ext entry,
 100                     alm_include_file_$insert ext entry (ptr, fixed bin (26), fixed bin (26)),
 101                     alm_include_file_$pop ext entry,
 102                     inputs_$get_ptr ext entry (ptr, fixed bin (26), fixed bin (26), bit (1) aligned),
 103                     mexp_               ext entry (char (*), fixed bin (26), fixed bin(17), bit(1), bit(1)),
 104                     mexp_$define_macro  ext entry (char (*)),
 105                     oplook_$reset       ext entry,
 106                     oplook_$redefine    ext entry,
 107                     getid_$setid        ext entry ( fixed bin (26)),
 108                     glpl_$slwrd         ext entry ( fixed bin (26), fixed bin (26), fixed bin (26)),
 109                     glpl_$storl         ext entry ( fixed bin (26), fixed bin (26)),
 110                     glpl_$storr         ext entry ( fixed bin (26), fixed bin (26)),
 111                     system_type_        ext entry ( char(*), char(*), fixed bin, fixed bin(35));
 112 
 113 /* EXTERNAL FUNCTIONS CALLED BY PASS1 */
 114 
 115  dcl      (         ascevl_$accevl      ext entry (fixed bin (26)),
 116                     ascevl_$acievl      ext entry (fixed bin (26)),
 117                     ascevl_$ac4evl      ext entry (fixed bin (26)),
 118                     ascevl_$bcdevl      ext entry (fixed bin (26)),
 119                     expevl_             ext entry ( fixed bin (26), fixed bin (26), fixed bin (26)),
 120                     lstman_$blkasn      ext entry ( fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26)),
 121                     glpl_$cwrd          ext entry ( fixed bin (26)),
 122                     glpl_$glwrd         ext entry ( fixed bin (26), fixed bin(26)),
 123                     decevl_             ext entry ( fixed bin (26), fixed bin (26))) returns (fixed bin (26));
 124 dcl       (         utils_$exadrs       ext entry ( fixed bin (26), fixed bin (26)),
 125                     lstman_$lnkasn      ext entry ( fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26)),
 126                     lstman_$outasn      ext entry ( fixed bin (26), fixed bin (26), fixed bin (26)),
 127                     utils_$ls ext entry (fixed bin (26), fixed bin (26)),
 128                     utils_$rs           ext entry ( fixed bin (26), fixed bin (26)),
 129                     lstman_$namasn      ext entry ( fixed bin (26)),
 130                     utils_$nswrds       ext entry ( fixed bin )) returns (fixed bin (26));
 131 dcl       (         octevl_             ext entry ( fixed bin (26)),
 132                     oplook_$oplook_     ext entry ( fixed bin (26), fixed bin (26)),
 133                     glpl_$setblk        ext entry ( fixed bin (26), fixed bin (26) ),
 134                     table_              ext entry ( fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26),
 135                                                     fixed bin (26)),
 136                     lstman_$trpasn      ext entry ( fixed bin (26), fixed bin (26)),
 137                     varevl_             ext entry ( fixed bin (26), fixed bin (26), fixed bin (26), fixed bin (26),
 138                                                     fixed bin (26), fixed bin (26)),
 139                     vfdevl_$vfdcnt      ext entry ( fixed bin (26), fixed bin (26))
 140                               ) returns ( fixed bin (26));
 141 
 142 
 143 
 144 /* AUTOMATIC VARIABLES USED BY PASS1 */
 145  dcl      (binop, flags, i, iaddr, iflag, itype, iwhat, j, junk, k, link, mul, n, newrho, nwrds, option,
 146           basno, value, b29, admod, pcblk (3), class, type, xnlnk, ptrcal, ptrarg, trplnk, blklnk, symlnk,
 147           rslts (42), newval, oldval, tbss, tderr, stat_or_link ) fixed bin (26);
 148 dcl       label_flag          bit (1) aligned;
 149 dcl       end_statement_flag  bit (1) aligned;
 150 dcl       dup_ptr ptr init (null ()),
 151           temp_ptr ptr,
 152           dup_count fixed bin (26),
 153           dup_start fixed bin (26),
 154           dup_string (0:262143) char (1) unal based (dup_ptr);
 155 dcl       operand    char(32) varying;
 156 dcl       canonical_operand char(24);
 157 dcl       code      fixed bin(35);
 158 dcl       (stkclst, stkctop) fixed bin(26);                 /* used to remember stackframe sizes */
 159 dcl       ext_entry_count fixed bin;
 160 dcl       remember_sym(8) fixed bin(26);          /* used to remember sym */
 161 
 162 /* LABEL VARIABLE */
 163  dcl      search_return label local;
 164 
 165  dcl      static_in_linkage bit(1) initial("0"b);
 166 
 167 
 168 
 169 
 170 
 171 /* EXTERNAL DATA USED BY PASS1 */
 172  dcl      (eb_data_$itext, eb_data_$ilink, eb_data_$isym, eb_data_$istatic, eb_data_$idefs, eb_data_$ioff, eb_data_$ion,
 173           eb_data_$nertls, eb_data_$nmxcal, eb_data_$nmxclb, eb_data_$nmxsav, eb_data_$nretls,
 174           eb_data_$nslcal, eb_data_$nslsav,
 175           eb_data_$new_nslcal, eb_data_$new_nslsav, eb_data_$new_nretls, eb_data_$short_nretls,
 176           eb_data_$new_nentls, eb_data_$short_nslcal, eb_data_$new_ngetlp,
 177           eb_data_$atext2 (2), eb_data_$alink2 (2), eb_data_$asym2 (2), eb_data_$astatic2 (2), eb_data_$asystem2 (2),
 178           eb_data_$adef2 (2),
 179           eb_data_$tsym, eb_data_$atext (2), eb_data_$alink (2), eb_data_$asym (2), eb_data_$asys (2), eb_data_$aheap(2),
 180           eb_data_$astat (2)) ext fixed bin (26);
 181 
 182  dcl      eb_data_$separate_static ext bit(1);
 183 dcl       eb_data_$entrybound_bit ext bit(1);
 184 dcl       eb_data_$macro_depth fixed bin (26) ext;
 185 
 186 
 187 /* PARAMETERS */
 188 
 189 dcl       decor fixed bin(35); /* passed from alm_6180_ */
 190 dcl       target_value fixed bin(17); /* ditto */
 191 dcl       (no_target_given,first_time_thru) bit(1); /* likewise */
 192 
 193 
 194 
 195 /* OVERLAY FOR SETTING HALF WORDS */
 196 
 197  dcl      1 word based aligned,
 198             2 (left,right) bit (18) unaligned;
 199 
 200  dcl      1 glpl_words (0:262143) based (eb_data_$lavptr) aligned,
 201             2 left bit (18) unaligned,
 202             2 right bit (18) unaligned;
 203 
 204  dcl      1 acc aligned based,
 205             2 length bit (9) unaligned,
 206             2 string char (32) unaligned;
 207 
 208  dcl      eb_data_$lavptr external pointer;
 209  dcl      eb_data_$per_process_static_sw fixed bin external;
 210 
 211 
 212 
 213 /* entry to subroutine, set up variables before main loop. */
 214 
 215 
 216 label_100:
 217           pc = 0;
 218           labarg = 0;
 219           tfirstreftrap = 0;
 220           ext_entry_count = 0;
 221           eb_data_$separate_static,
 222           eb_data_$entrybound_bit,
 223           static_in_linkage = "0"b;
 224 
 225 
 226 
 227 /* Initialize system location counters. */
 228 
 229           junk = table_ (iassgn, lctext (1), 0, fmlcrf, iaddr);
 230           ulclst, ulcend, curlc, lptext = iaddr;
 231 
 232           junk = table_ (iassgn, lcst (1), 0, fmlcrf, iaddr);
 233           call glpl_$storr (iaddr+2, ulclst);
 234           call glpl_$storl (ulclst+2, iaddr);
 235           ulclst, lpst = iaddr;
 236           call glpl_$storr (lpst+4, eb_data_$isym);
 237 
 238           junk = table_ (iassgn, lcdefs (1), 0, fmlcrf, iaddr);
 239           tlclst, dlclst, lpdefs = iaddr;
 240 
 241           junk = table_ (iassgn, lclit (1), 0, fmlcrf, iaddr);
 242           call glpl_$storr (iaddr+2, tlclst);
 243           call glpl_$storl (tlclst+2, iaddr);
 244           tlclst, lplit = iaddr;
 245           call glpl_$storl (lplit+4, 2);
 246 
 247           junk = table_ (iassgn, lcentries (1), 0, fmlcrf, iaddr);
 248           call glpl_$storr (iaddr + 2, tlclst);
 249           call glpl_$storl (tlclst + 2, iaddr);
 250           tlclst, lpentries = iaddr;
 251 
 252           junk = table_ (iassgn, lccall (1), 0, fmlcrf, iaddr);
 253           call glpl_$storr (iaddr+2, tlclst);
 254           call glpl_$storl (tlclst+2, iaddr);
 255           tlclst, lpcall = iaddr;
 256 
 257           junk = table_ (iassgn, lctv (1), 0, fmlcrf, iaddr);
 258           call glpl_$storr (iaddr+2, tlclst);
 259           call glpl_$storl (tlclst+2, iaddr);
 260           tlclst, lptv = iaddr;
 261 
 262           junk = table_ (iassgn, lcsect (1), 0, fmlcrf, iaddr);
 263           llclst, lpsect = iaddr;
 264           call glpl_$slwrd (lpsect+4, 2, eb_data_$ilink);
 265 
 266           junk = table_ (iassgn, lchead (1), 0, fmlcrf, iaddr);
 267           call glpl_$storr (iaddr+2, llclst);
 268           call glpl_$storl (llclst+2, iaddr);
 269           llclst, lphead = iaddr;
 270           call glpl_$storr (lphead+4, eb_data_$ilink);
 271 
 272           junk = table_ (iassgn, lcrst (1), 0, fmlcrf, iaddr);
 273           slclst, lprst = iaddr;
 274           call glpl_$storr (lprst+4, eb_data_$isym);
 275 
 276           junk = table_ (iassgn, lcrlk (1), 0, fmlcrf, iaddr);
 277           call glpl_$storr (iaddr+2, slclst);
 278           call glpl_$storl (slclst+2, iaddr);
 279           slclst, lprlk = iaddr;
 280           call glpl_$storr (lprlk+4, eb_data_$isym);
 281 
 282           junk = table_ (iassgn, lcrtx (1), 0, fmlcrf, iaddr);
 283           call glpl_$storr (iaddr+2, slclst);
 284           call glpl_$storl (slclst+2, iaddr);
 285           slclst, lprtx = iaddr;
 286           call glpl_$storr (lprtx+4, eb_data_$isym);
 287 
 288           /* make stackframe_size list */
 289           stkctop = glpl_$setblk(0, 1);
 290           stkclst = stkctop;
 291 
 292           binlin = 1;
 293           call oplook_$reset;
 294 
 295 /* main loop re-entry, assign any symbols in location field. */
 296 
 297 label_200:
 298           label_flag = "0"b;
 299 label_210:
 300           spc = pc;
 301           brk (1) = isp;
 302           call getid_;
 303           if (brk (1) ^= icol) then goto label_300;
 304           if (eb_data_$tsym ^= 0) then junk = table_ (iassgn,sym (1),spc,flocrf,curlc);
 305           label_flag = "1"b;
 306           goto label_210;
 307 
 308 /* get operator and test for pseudo-operation. */
 309 
 310 label_300:
 311           if sym (1) ^= 0 then goto label_302;
 312           if brk (1) = inl then goto label_870;
 313           if brk (1) = iquot then goto label_870;
 314 label_302:
 315           binop = oplook_$oplook_ ( iflag, itype );
 316           if iflag ^= 0 then do;
 317                call mexp_ (substr (addr (sym (1)) -> acc.string, 1, bin (addr (sym (1)) -> acc.length, 9)), iflag, target_value, no_target_given,first_time_thru);
 318                if iflag ^= 0 then go to label_3200;
 319                else go to label_3030;
 320           end;
 321           if (brk (1) = isp /*iht ditto*/         |         brk (1) =inl /* icr and isc ditto*/ )  then goto label_305;
 322 
 323 /* then there is an error in this statement. */
 324           goto label_3200;
 325 
 326 label_305:
 327 
 328           goto label_vector (itype);
 329 
 330 
 331 /* control group of pseudo operations. */
 332 
 333 /* end card, simply return to caller of pass1.
 334    reset inhibit flag for pass2 first. */
 335 
 336 
 337 label_vector (1):             /* end */
 338 label_450:
 339           tinhib = 0;                                       /* FALSE */
 340 
 341 /* check for lpst at head of unjoined lc list. if there, move
 342    to head of symbol segment lc list. */
 343           if (ulclst ^= lpst) then goto label_460;
 344           ulclst = fixed (glpl_words (ulclst + 2).right, 18);
 345           if (ulclst ^= 0) then call glpl_$storl (ulclst + 2,0);
 346           call glpl_$storr (lpst + 2,slclst);
 347           call glpl_$storl (slclst + 2,lpst);
 348           slclst = lpst;
 349 
 350 /* set up system location counter maximum lengths for
 351    absolutizing in postp1. */
 352 
 353 label_460:
 354 
 355           if (tprot ^= 0 ) then call glpl_$storr (lptv + 3,tvlth);
 356           if (tcall ^= 0 ) then call glpl_$storr (lpcall + 3,eb_data_$nslcal + 1);
 357 
 358 /* length of header is 8. */
 359           call glpl_$storr (lphead + 3, 8);
 360 
 361 /* Likewise update entry count into entries section. */
 362           if tnewobject ^= 0 then call glpl_$storr (lpentries + 3, (tvlth - ext_entry_count) * eb_data_$new_nentls);
 363                     /* ext_entry already adjusts text section length */
 364 
 365           /* remember amount of stack space currently allocated */
 366           call glpl_$slwrd(stkclst, stkc, 0);
 367           stkc = stkctop;     /* stkc is used to transmit top of stkclst to pass2 */
 368 
 369 /* save the current value of pc in curlc. */
 370           call glpl_$storr (curlc + 1,pc);
 371 
 372           return;
 373 
 374 
 375 /* include statement, use new source file. */
 376 
 377 label_vector (50):            /* include */
 378 label_include:
 379           if dup_ptr ^= null () then go to label_3100;
 380           call getid_ ();
 381           if eb_data_$tsym = 0 then goto label_3100;
 382           call inputs_$next_statement ();
 383           call alm_include_file_$pass1 ();
 384           goto label_200;
 385 
 386 /* use pseudo-operation, use new location counter. */
 387 
 388 label_vector (2):             /* use */
 389 label_500:
 390           call getid_;
 391           if ( eb_data_$tsym = 0) then goto label_3100;
 392 
 393 /* save current value of old location counter. */
 394           call glpl_$storr (curlc + 1,pc);
 395 
 396 /* use new lc as the current lc. */
 397           if (table_ (iserch,sym (1),pc,fmlcrf,curlc) ^= 0) then goto label_3010;
 398 
 399 
 400 /* not found so initialize a new location counter. */
 401           pc = 0;
 402           junk = table_ (iassgn,sym (1),pc,fmlcrf,curlc);
 403 
 404 
 405 /* put new lc at end of ulclst. no problems with empty
 406    list since list initialized with some system lc's. */
 407           call glpl_$storr (ulcend + 2,curlc);
 408           call glpl_$storl (curlc + 2,ulcend);
 409           ulcend = curlc;
 410           goto label_3010;
 411 
 412 /* org pseudo-operation. set the pc to the value of the expression. */
 413 
 414 label_vector (3):             /* org */
 415 label_525:
 416           if varevl_ (invrvl,basno,value,admod,b29,iaddr) = 0 then goto label_3110;
 417           if (iaddr ^= 0) then goto label_3300;
 418           if pc > fixed (glpl_words (curlc + 3).right, 18) then call glpl_$storr (curlc + 3, pc);
 419           pc = value;
 420           goto label_3010;
 421 
 422 /* join pseudo-op. move lc nodes from unjoined
 423    lc list to one of the joined lc lists. */
 424 
 425 label_vector (4):             /* join */
 426 label_550:
 427           call inputs_$nxtnb;
 428           if (brk (1) ^= islash) then goto label_3100;
 429 
 430 label_555:
 431           call getid_;
 432           if (brk (1) ^= islash | eb_data_$tsym = 0) then goto label_3100;
 433           if (sym (1) = eb_data_$atext2 (1) & sym (2) = eb_data_$atext2 (2)) then goto label_565;
 434           if (sym (1) = eb_data_$alink2 (1) & sym (2) = eb_data_$alink2 (2))
 435              then do;
 436                   static_in_linkage = "1"b;
 437                   goto label_570;
 438                   end;
 439           if (sym (1) = eb_data_$asym2 (1) & sym (2) = eb_data_$asym2 (2)) then goto label_575;
 440           if (sym (1) = eb_data_$astatic2 (1) & sym (2) = eb_data_$astatic2 (2))
 441              then do;
 442                   eb_data_$separate_static = "1"b;
 443                   goto label_570;
 444                   end;
 445           if (sym (1) = eb_data_$adef2 (1) & sym (2) = eb_data_$adef2 (2)) then goto label_593;
 446 
 447           prntu = 1;                                        /* TRUE */
 448 
 449 label_560:
 450           call inputs_$next;
 451           if (brk (1) = islash) then goto label_555; /* parse join */
 452           if (brk (1) = isp | brk (1) = inl) then goto label_3020; /* next statement */
 453           goto label_560;
 454 
 455 /* join text location counters. */
 456 
 457 label_565:
 458           call getid_;
 459           search_return = label_566;
 460           goto label_580;
 461 
 462 label_566:
 463           if (iaddr = 0) then goto label_569;
 464           call glpl_$storr (iaddr + 4,eb_data_$itext);
 465           call glpl_$storl (iaddr + 2, fixed (glpl_words (lptv + 2).left, 18));
 466           call glpl_$storr (iaddr + 2,lptv);
 467           if (tlclst ^= lptv) then goto label_567;
 468           tlclst = iaddr;
 469           goto label_568;
 470 
 471 label_567:
 472 
 473           call glpl_$storr (fixed (glpl_words (lptv + 2).left, 18) + 2, iaddr);
 474 
 475 label_568:
 476 
 477           call glpl_$storl (lptv + 2,iaddr);
 478 
 479 label_569:
 480           if (brk (1) = icomma) then goto label_565;
 481           if (brk (1) = islash) then goto label_555; /* parse join */
 482           goto label_3020; /* next statement */
 483 
 484 /* join link location counters. */
 485 
 486 label_570:
 487           call getid_;
 488           search_return = label_571;
 489           goto label_580;
 490 
 491 label_571:
 492           if (iaddr = 0) then goto label_574;
 493           if eb_data_$separate_static
 494              then stat_or_link = eb_data_$istatic;
 495              else stat_or_link = eb_data_$ilink;
 496           call glpl_$storr (iaddr + 4,stat_or_link);
 497           call glpl_$storl (iaddr + 2, fixed (glpl_words (lpsect + 2).left, 18));
 498           call glpl_$storr (iaddr + 2,lpsect);
 499 
 500 /* since lphead is alsays left of lpsect we
 501    do not need to test for llclst = lpsect. */
 502           call glpl_$storr (fixed (glpl_words (lpsect + 2).left, 18) + 2, iaddr);
 503           call glpl_$storl (lpsect + 2,iaddr);
 504 
 505 label_574:
 506           if (brk (1) = icomma) then goto label_570;
 507           if (brk (1) = islash) then goto label_555; /* parse join */
 508           goto label_3020; /* next statement */
 509 
 510 /* join symbol location counters. */
 511 
 512 label_575:
 513           call getid_;
 514           search_return = label_576;
 515           goto label_580;
 516 
 517 label_576:
 518           if (iaddr = 0) then goto label_579;
 519           call glpl_$storr (iaddr + 4,eb_data_$isym);
 520           call glpl_$storl (iaddr + 2, fixed (glpl_words (lprtx + 2).left, 18));
 521           call glpl_$storr (iaddr + 2,lprtx);
 522           if (slclst ^= lprtx) then goto label_577;
 523           slclst = iaddr;
 524           goto label_578;
 525 
 526 label_577:
 527 
 528           call glpl_$storr (fixed (glpl_words (lprtx + 2).left, 18) + 2, iaddr);
 529 
 530 label_578:
 531 
 532           call glpl_$storl (lprtx + 2,iaddr);
 533 
 534 label_579:
 535           if (brk (1) = icomma) then goto label_575;
 536           if (brk (1) = islash) then goto label_555; /* parse join */
 537           goto label_3020; /* next statement */
 538 
 539 /* join definition location counters. */
 540 
 541 label_593:
 542           call getid_;
 543           search_return = label_594;
 544           goto label_580;
 545 
 546 label_594:
 547           if (iaddr = 0) then goto label_597;
 548           call glpl_$storr (iaddr + 4,eb_data_$idefs);
 549           call glpl_$storl (iaddr + 2, fixed (glpl_words (lpdefs + 2).left, 18));
 550           call glpl_$storr (iaddr + 2,lpdefs);
 551           if (dlclst ^= lpdefs) then goto label_595;
 552           dlclst = iaddr;
 553           goto label_596;
 554 
 555 label_595:
 556 
 557           call glpl_$storr (fixed (glpl_words (lpdefs + 2).left, 18) + 2, iaddr);
 558 
 559 label_596:
 560 
 561           call glpl_$storl (lpdefs + 2,iaddr);
 562 
 563 label_597:
 564           if (brk (1) = icomma) then goto label_593;
 565           if (brk (1) = islash) then goto label_555; /* parse join */
 566           goto label_3020; /* next statement */
 567                                         /* internal routine to search for a lc on the
 568                                            unjoined location counter list. if found it is
 569                                            disconnected from ulclst and a ptr (iaddr) to
 570                                            it is returned. if not found iaddr = 1; TRUE, and prntu = 1; TRUE. */
 571 
 572 label_580:
 573           j = ulclst;
 574           if table_ (iserch, sym (1), junk, fmlcrf, i) = 0 then goto label_583;
 575 
 576 label_582:
 577           if (j ^= 0) then goto label_584;
 578 label_583:
 579           prntu = 1;                                        /* TRUE */
 580           iaddr = 0;
 581           goto search_return;
 582 
 583 label_584:
 584           if j ^= i then goto label_592;
 585 
 586           iaddr = j;
 587           if (iaddr = ulcend) then ulcend = fixed (glpl_words (iaddr + 2).left, 18);
 588           if (j ^= ulclst) then goto label_588;
 589           ulclst = fixed (glpl_words (j + 2).right, 18);
 590           goto label_590;
 591 
 592 label_588:
 593 
 594           call glpl_$storr (fixed (glpl_words (j + 2).left, 18) + 2, fixed (glpl_words (j + 2).right, 18));
 595 
 596 label_590:
 597 
 598           if fixed (glpl_words (j + 2).right, 18) = 0 then goto search_return;
 599           call glpl_$storl (fixed (glpl_words (j + 2).right, 18) + 2, fixed (glpl_words (j + 2).left, 18));
 600           goto search_return;
 601 
 602 
 603 label_592:
 604           j = fixed (glpl_words (j + 2).right, 18);
 605           goto label_582;
 606 
 607 /* even pseudo-operation, force pc to even location. */
 608 
 609 label_vector (5):             /* even */
 610 label_600:
 611           pc = spc + mod (spc,2);
 612           iflag = 2;
 613           goto label_690;
 614 
 615 /* odd pseudo-operation, force pc to odd location. */
 616 
 617 label_vector (6):             /* odd */
 618 label_630:
 619           pc = spc + mod (spc + 1,2);
 620           iflag = 2;
 621           goto label_690;
 622 
 623 /* eight pseudo-operation, force pc to zero mod eight. */
 624 
 625 label_vector (7):             /* eight */
 626 label_660:
 627           pc = 8*divide ( (spc + 7),8,26,0);                /* originally ==> pc = 8* ( (spc+7)/8); */
 628           iflag = 8;
 629           goto label_690;
 630 
 631 /* sixty-four pseudo-operation. set the pc to zero mod 64. */
 632 
 633 label_vector (8):             /* sixtyfour */
 634 label_680:
 635           pc = 64*divide ( (spc + 63),64,26,0);             /* originally ==> pc = 64* ( (spc+63)/64); */
 636           iflag = 64;
 637 
 638 label_690:
 639           oldval = fixed (glpl_words (curlc + 4).left, 18);
 640           newval = iflag;
 641           if (oldval = 0) then goto label_699;
 642           if (mod (newval,oldval) = 0) then goto label_699;
 643           newval = oldval;
 644           if (mod (newval,iflag) = 0) then goto label_699;
 645           newval = oldval*iflag;
 646 
 647 label_699:
 648           call glpl_$storl (curlc + 4,newval);
 649           goto label_3010;
 650 
 651 /* movdef pseudo-operation. move the definitions to the link segment */
 652 
 653 label_vector (11):            /* movdef */
 654 label_755:
 655           tmvdef = 1;                                       /* TRUE */
 656           tnewobject = 0;                                   /* Can't move defs in new format. */
 657           goto label_3010;
 658 
 659 
 660 
 661 /* decor pseudo-operation:  claims that all intructions are compatible with the decor named by its operand */
 662 
 663 label_vector (62):             /* decor */
 664 label_decor:
 665           call getid_;
 666           operand = substr(addr(sym(1)) -> acc.string,1,bin(addr(sym(1)) -> acc.length,9));
 667           call system_type_((operand),canonical_operand,(0),code);
 668           if code ^=0
 669               then prntf = 1;
 670           else do;
 671                        /* a match is assured in this following lookup routine
 672                         only if the operand names supplied to alm_table_tool
 673                         (when it created the "data1" array) are a subset of
 674                         the canonical strings for system_type_. Alm_table_tool
 675                         will check for this correspondence for you. */
 676 
 677 
 678                     do n = 1 to hbound(data1.decor,1) while(rtrim(canonical_operand) ^= data1.decor(n).name);
 679                     end;
 680                     decor = data1.decor(n).number;
 681                end;
 682 
 683           goto label_3010;
 684 
 685 
 686 /* error pseudo-operation, sets fatal error flag, causing "Translation failed" message. */
 687 
 688 label_vector (63):            /* error */
 689 label_error:
 690           tfatal = 3;         /* severity 3 error */
 691           goto label_3010;
 692 
 693 
 694 /* firstref pseudo-operation, specifies trap procedure on first entry reference. */
 695 
 696 label_vector (48):            /* firstref */
 697 label_firstref:
 698           if tfirstreftrap ^= 0 then prntm = 1;
 699           tfirstreftrap = 1;
 700           if varevl_ (ixvrvl, basno, value, admod, b29, iaddr) = 0 then goto label_3120;
 701           if b29 = 0 then value = lstman_$lnkasn (myblk, value, admod, iaddr);
 702           first_ref_trap_proc_linkno = value;
 703           if brk (1) = ilpar then do;
 704                     if varevl_ (ixvrvl, basno, value, admod, b29, iaddr) = 0 then goto label_3120;
 705                     if b29 = 0 then value = lstman_$lnkasn (myblk, value, admod, iaddr);
 706                     first_ref_trap_arg_linkno = value;
 707                     if brk (1) ^= irpar then goto label_3100;
 708                     end;
 709           else first_ref_trap_arg_linkno = 0;
 710           goto label_3010;
 711 
 712 /* inhibit pseudo-operation, set inhibit mode on or off. */
 713 
 714 label_vector (12):            /* inhibit */
 715 label_760:
 716           call getid_;
 717           if ( eb_data_$tsym = 0) then goto label_765;
 718           if (sym (1) = eb_data_$ion) then goto label_770;
 719           if (sym (1) = eb_data_$ioff) then goto label_775;
 720           goto label_3010;
 721 
 722 
 723 label_765:
 724           tinhib = 1 - tinhib;          /* tinhib = ^tinhib */
 725           goto label_3010;
 726 
 727 
 728 label_770:
 729           tinhib = 1;                                       /* TRUE */
 730           goto label_3010;
 731 
 732 
 733 label_775:
 734           tinhib = 0;                                       /* FALSE */
 735           goto label_3010;
 736 
 737 /* name pseudo-operation, record the name of this segment. */
 738 
 739 label_vector (14):            /* name */
 740 label_820:
 741           if (mynam ^= 0) then goto label_3100;
 742           call getid_$getnam;
 743           if ( eb_data_$tsym = 0) then goto label_3100;
 744           sthedr_$seg_name = substr (addr (sym (1)) -> acc.string, 1, fixed (addr (sym (1)) -> acc.length, 9));
 745           goto label_3010;
 746 
 747 /* null pseudo-operation, do nothing. */
 748 
 749 label_vector (15):            /* null */
 750 label_850:
 751           goto label_3010;
 752 
 753 /* rem pseudo-operation, same as null, if there was a label on the statement */
 754 
 755 label_vector (16):            /* rem */
 756 label_870:
 757           if label_flag then goto label_850;
 758           call inputs_$next_statement;
 759           goto label_200;
 760 
 761 
 762 /* symbol defining pseudo-operations. */
 763 
 764 /* basref pseudo-operation, define external symbols. */
 765 
 766 
 767 label_vector (17):            /* basref */
 768 label_900:
 769           if ( eb_data_$tsym = 0) then goto label_910;
 770           if (table_ (iserch,sym (1),value,clbas,junk) ^= 0) then goto label_915;
 771           do i = 1 to 8;                                    /* To label_905 */
 772                if (sym (1) ^= symbas (i)) then goto label_905;
 773                value = i-1;
 774                goto label_915;
 775 
 776 label_905:
 777           end;                                              /* the do-group */
 778           if (table_ (iserch,sym (1),basno,clint,junk) ^= 0) then goto label_915;
 779           goto label_3130;
 780 
 781 
 782 label_910:
 783           if (varevl_ (invrvp,basno,value,admod,b29,iaddr) = 0) then goto label_3120;
 784           if (iaddr ^= 0) then goto label_3300;
 785 
 786 
 787 label_915:
 788           link = utils_$exadrs (value,0);
 789           type = 2;
 790           class = fbasrf;
 791 
 792 /* re-entry from segref pseudo-operation. */
 793 
 794 label_920:
 795           call getid_;
 796           xnlnk = lstman_$namasn (sym (1));
 797 
 798 label_930:
 799           ptrcal = 0;
 800           ptrarg = 0;
 801           trplnk = 0;
 802           tderr = 0;                                        /* FALSE */
 803           if (brk (1) ^= ilpar) then goto label_970;
 804           if (varevl_ (ixvrvl,basno,ptrcal,admod,b29,iaddr) ^= 0) then goto label_935;
 805           if (tprot = 1 & b29 = 0) then tvlth = tvlth + 1;
 806           tderr = 1;                                        /* TRUE */
 807           goto label_945;
 808 
 809 label_935:
 810           if (b29 ^= 0) then goto label_945;
 811           if (tprot = 1 ) then goto label_940;
 812           ptrcal = lstman_$lnkasn (myblk,ptrcal,admod,iaddr);
 813           goto label_945;
 814 
 815 label_940:
 816 
 817           tvlth = tvlth + 1;
 818           tderr = 1;                                        /* TRUE */
 819 
 820 label_945:
 821           if (brk (1) ^= ilpar) then goto label_960;
 822           if (varevl_ (ixvrvl,basno,ptrarg,admod,b29,iaddr) ^= 0) then goto label_950;
 823           tderr = 1;                                        /* TRUE */
 824           goto label_955;
 825 
 826 label_950:
 827 
 828           if (b29 = 0) then ptrarg = lstman_$lnkasn (myblk,ptrarg,admod,iaddr);
 829 
 830 
 831 label_955:
 832           if (brk (1) = irpar) then call inputs_$next;
 833 
 834 
 835 label_960:
 836           if (brk (1) = irpar) then goto label_965;
 837           tderr = 1;                                        /* TRUE */
 838           goto label_980;
 839 
 840 
 841 label_965:
 842           call inputs_$next;
 843           if (tderr = 1) then goto label_980;
 844           trplnk = lstman_$trpasn (ptrcal,ptrarg);
 845 
 846 label_970:
 847           junk = table_ (iassgn, fixed (glpl_words (xnlnk).left, 18), lstman_$blkasn (type, link, xnlnk, trplnk),
 848                                                                       class, junk);
 849 
 850 
 851 label_980:
 852           if (brk (1) = icomma) then goto label_920;
 853           goto label_3010;
 854 
 855 /* bool pseudo-operation, assign boolean equivalence to symbol. */
 856 
 857 label_vector (18):            /* bool */
 858 label_1000:
 859           call getid_$setid (symlnk);
 860           if (brk (1) ^= icomma | symlnk = 0) then goto label_3100;
 861           if (varevl_ (ibvrvl,basno,value,admod,b29,iaddr) = 0) then goto label_3120;
 862           if (iaddr ^= 0) then goto label_3300;
 863           junk = table_ (iassgn,symlnk,value,fbolrf,junk);
 864           goto label_3010;
 865 
 866 /* equ pseudo-operation, assign arithmetic equivalence to symbol. */
 867 
 868 label_vector (19):            /* equ */
 869 label_1100:
 870           call getid_$setid (symlnk);
 871           if (brk (1) ^= icomma | symlnk = 0) then goto label_3100;
 872 
 873 label_1110:
 874           if (varevl_ (invrvl,basno,value,admod,b29,iaddr) = 0) then goto label_3120;
 875           class = flocrf;
 876           if (iaddr = 0) then class = fequrf;
 877           junk = table_ (iassgn,symlnk,value,class,iaddr);
 878           goto label_3010;
 879 
 880 /* link pseudo-operation, define link number of external reference. */
 881 
 882 label_vector (20):            /* link */
 883 label_1200:
 884           call getid_$setid (symlnk);
 885           if (brk (1) ^= icomma | symlnk = 0) then goto label_3100;
 886           if (varevl_ (ixvrvl,basno,value,admod,b29,iaddr) = 0) then goto label_3120;
 887           if (b29 = 0) then value = lstman_$lnkasn (myblk,value,admod,iaddr);
 888           junk = table_ (iassgn,symlnk,value,flocrf,lpsect);
 889           goto label_3010;
 890 
 891                     /* associate init info with link */
 892 label_vector (65):            /* init_link */
 893           goto label_3010;    /* skip in pass1 */
 894 
 895 /* set pseudo-operation, assign resettable_ equ type symbol. */
 896 
 897 label_vector (21):            /* set */
 898 label_1250:
 899           call getid_$setid (symlnk);
 900           if (brk (1) ^= icomma | symlnk = 0) then goto label_3100;
 901           if (varevl_ (invrvl,basno,value,admod,b29,iaddr) = 0) then goto label_3120;
 902           if (iaddr ^= 0) then goto label_3300;
 903           junk = table_ (iassgn,symlnk,value,fsetrf,junk);
 904           goto label_3010;
 905 
 906 /* segref pseudo-operation, define external symbols with pointers. */
 907 
 908 label_vector (22):            /* segref */
 909 label_1300:
 910           call getid_$getnam;
 911           if (brk (1) ^= icomma) then goto label_3100;
 912           class = fsegrf;
 913           if (sym (1) ^= eb_data_$atext (1) | sym (2) ^= eb_data_$atext (2)) then goto label_1310;
 914           type = 5;
 915           link = 0;
 916           goto label_920;
 917 
 918 label_1310:
 919           if (sym (1) ^= eb_data_$alink (1) | sym (2) ^= eb_data_$alink (2)) then goto label_1320;
 920           type = 5;
 921           link = 1;
 922           goto label_920;
 923 
 924 label_1320:
 925           if (sym (1) ^= eb_data_$asym (1) | sym (2) ^= eb_data_$asym (2)) then goto label_1330;
 926           type = 5;
 927           link = 2;
 928           goto label_920;
 929 
 930 label_1330:
 931           if (sym (1) ^= eb_data_$astat (1) | sym (2) ^= eb_data_$astat (2)) then goto label_1340;
 932           type = 5;
 933           link = 4;
 934           goto label_920;
 935 
 936 label_1340:
 937           if (sym (1) ^= eb_data_$asys (1) | sym (2) ^= eb_data_$asys (2)) then goto label_1350;
 938           type = 5;
 939           link = 5;
 940           goto label_920;
 941 
 942 label_1350:
 943           if (sym (1) ^= eb_data_$aheap (1) | sym (2) ^= eb_data_$aheap (2)) then goto label_1360;
 944           type = 5;
 945           link = 6;
 946           goto label_920;
 947 
 948 label_1360:
 949           type = 4;
 950           link = lstman_$namasn (sym (1));
 951           goto label_920;
 952 
 953 /* temp and tempd pseudo-operations, define symbols in stack. */
 954 
 955 label_vector (23):            /* temp */
 956 label_1400:
 957           mul = 1;
 958           goto label_1510;
 959 
 960 
 961 label_vector (24):            /* tempd */
 962 label_1500:
 963           mul = 2;
 964           stkc = stkc + mod (stkc,2);
 965           goto label_1510;
 966 
 967 
 968 label_vector (25):            /* temp8 */
 969 label_1505:
 970           mul = 8;
 971           stkc = 8*divide ( (stkc + 7),8,26,0);             /* originally ==> stkc = 8* ( (stkc + 7)/8); */
 972 
 973 
 974 label_1510:
 975           call getid_$setid (symlnk);
 976           if (symlnk ^= 0) then goto label_1520;
 977           prntf = 1;                                        /* TRUE */
 978           goto label_1550;
 979 
 980 label_1520:
 981           value = 1;
 982           if (brk (1) ^= ilpar) then goto label_1540;
 983           if (varevl_ (invrvp,basno,value,admod,b29,iaddr) = 0) then goto label_1525;
 984           if (iaddr = 0) then goto label_1530;
 985           prntr = 1;                                        /* TRUE */
 986 
 987 label_1525:
 988           prnts = 1;                                        /* TRUE */
 989           goto label_1550;
 990 
 991 label_1530:
 992           if (brk (1) = irpar) then call inputs_$next;
 993 
 994 label_1540:
 995           if (table_ (iassgn,symlnk,stkc,fstkrf,junk) = 0) then prnts = 1; /* TRUE */
 996           stkc = stkc + value*mul;
 997 
 998 label_1550:
 999           if (brk (1) = icomma) then goto label_1510;
1000           goto label_3010;
1001 
1002 
1003 
1004 /* generative class of pseudo-operations. */
1005 
1006 /* acc and aci pseudo-operations, ascii code generators. */
1007 /* also bci pseudo-operation to generate 6-bit codes. */
1008 
1009 label_vector (26):            /* acc */
1010 label_1600:
1011           n = ascevl_$accevl (rslts (1));
1012           goto label_1710;
1013 
1014 label_vector (27):            /* aci */
1015 label_1700:
1016           n = ascevl_$acievl (rslts (1));
1017           goto label_1710;
1018 
1019 
1020 label_vector (13):            /* bci */
1021 label_bci:
1022           n = ascevl_$bcdevl (rslts (1));
1023           go to label_1710;
1024 
1025 
1026 label_vector (59):            /* ac4 */
1027 label_ac4:
1028           n = ascevl_$ac4evl (rslts (1));
1029 
1030 
1031 label_1710:
1032           pc = pc + n;
1033           goto label_3010;
1034 
1035 /* dec pseudo-operation, integer, fixed, and floating point. */
1036 
1037 label_vector (28):            /* dec */
1038 label_1800:
1039           n = decevl_ (rslts (1),type);
1040           if (n >= 2) then pc = pc + mod (pc,2);
1041           pc = pc + n;
1042           if (brk (1) = icomma) then goto label_1800;
1043                                                             /* verify the break character for dec pseudo-op */
1044           goto label_1920;
1045 
1046 /* dec_unal pseudo-operation, integer, fixed, and floating point unaligned. */
1047 
1048 label_vector (66):            /* dec_unal */
1049 label_1801:
1050           n = decevl_ (rslts (1),type);
1051           pc = pc + n;
1052           if (brk (1) = icomma) then goto label_1801;
1053                                                             /* verify the break character for dec pseudo-op */
1054           goto label_1920;
1055 
1056 /* oct pseudo-operation, octal number generator. */
1057 
1058 label_vector (29):            /* oct */
1059 label_1900:
1060           n = octevl_ (rslts (1));
1061           if (n >= 2) then pc = pc + mod (pc,2);
1062           pc = pc + n;
1063           if (brk (1) = icomma) then goto label_1900;
1064                                                             /* verify the break characters */
1065           goto label_1920;
1066 
1067 /* oct_unal pseudo-operation, unaligned octal number generator. */
1068 
1069 label_vector (67):            /* oct_unal */
1070 label_1901:
1071           n = octevl_ (rslts (1));
1072           pc = pc + n;
1073           if (brk (1) = icomma) then goto label_1901;
1074                                                             /* verify that the break characters for dec and oct
1075                                                                are legitimate at this point */
1076 
1077 label_1920:
1078           if ( brk (1) = inl | brk (1) = isp ) then goto label_3010;
1079           goto label_3100;
1080 
1081 /* vfd pseudo-operation, variable field data generator. */
1082 
1083 label_vector (30):            /* vfd */
1084 label_2000:
1085           pc = pc + vfdevl_$vfdcnt (rslts (1),flags);
1086           goto label_3010;
1087 
1088 /* mod pseudo-operation. force location counter mod expression. */
1089 
1090 label_vector (31):            /* mod */
1091 label_2020:
1092           call getid_;
1093           junk =  expevl_ (0,value,iaddr);                            /* 0 ==> FALSE */
1094           if (iaddr ^= 0) then prntr = 1;                   /* TRUE */
1095           iflag = value;
1096           pc = value*divide ( (spc + value-1),value,26,0);  /* originally ==> pc = value* ( (spc + value-1)/value); */
1097           goto label_690;
1098 
1099 
1100 /* storage allocating pseudo-operations. */
1101 
1102 /* bfs pseudo-operation, block followed by symbol. */
1103 
1104 label_vector (32):            /* bfs */
1105 label_2100:
1106           tbss = 0;                                         /* FALSE */
1107           goto label_2210;
1108 
1109 /* bss pseudo-operation, block started by symbol. */
1110 
1111 label_vector (33):            /* bss */
1112 label_2200:
1113           tbss = 1;                                         /* TRUE */
1114 
1115 label_2210:
1116           call getid_$setid (symlnk);
1117           if (brk (1) ^= icomma) then goto label_3100;
1118           if (varevl_ (invrvl,basno,value,admod,b29,iaddr) = 0) then goto label_3110;
1119           if (iaddr = 0) then goto label_2220;
1120           prntr = 1;                                        /* TRUE */
1121           goto label_3120;
1122 
1123 label_2220:
1124           pc = pc + value;
1125           if (b29 ^= 0 ) then goto label_3100;
1126           if symlnk = 0 then goto label_3010;               /* allow bss ,exp with no symbol specified */
1127           value = pc;
1128           if (tbss = 1) then value = spc;
1129           junk = table_ (iassgn,symlnk,value,flocrf,curlc);
1130           goto label_3010;
1131 
1132 /* zero pseudo-operation, ignore in pass1. */
1133 
1134 label_vector (34):            /* zero */
1135 label_2350:
1136           pc = spc + 1;
1137           goto label_3010;
1138 
1139 /* its and itb pseudo-operations, set pc even, and add two. */
1140 
1141 label_vector (35):            /* itb */
1142 label_2400:
1143 
1144 
1145 label_vector (36):            /* its */
1146 label_2450:
1147           pc = (spc + mod (spc,2)) + 2;
1148 
1149 /* correction here 3/12/69 */
1150           iflag = 2;
1151           goto label_690;
1152 
1153 
1154 /* subroutine linkage pseudo-operations. */
1155 
1156 /* call pseudo-operation, call subroutine with args and returns. */
1157 
1158 label_vector (37):            /* call */
1159 label_2500:
1160           junk = varevl_ (ixvrvl,basno,value,admod,b29,iaddr);
1161           prntr = 0;
1162           if (tprot = 1 & b29 ^= 0) then goto label_2510;
1163           if tnewcall ^= 0 then pc = spc + eb_data_$new_nslcal;
1164           else pc = spc + eb_data_$nslcal;
1165           goto label_3010;
1166 
1167 label_2510:
1168           junk = lstman_$outasn (spc,spc + eb_data_$nmxcal,curlc);
1169           tcall = 1;                                        /* TRUE */
1170           tstsw (1) = 1;                                    /* TRUE */
1171           tvlth = tvlth + 1;
1172           pc = spc + eb_data_$nmxcal + eb_data_$nmxclb;
1173           goto label_3010;
1174 
1175 /* short_call pseudo-operation, call without save. */
1176 
1177 label_vector (51):            /* short_call */
1178 label_short_call:
1179           pc = spc + eb_data_$short_nslcal;
1180           goto label_3010;
1181 
1182 /* entry pseudo-operation, count symbols in pass1. */
1183 
1184 label_vector (38):            /* entry */
1185 label_2600:
1186           call getid_;
1187           if ( eb_data_$tsym = 0) then goto label_3100;
1188           tvlth = tvlth + 1;
1189           if (brk (1) = icomma) then goto label_2600;
1190                                                             /* this entry statement is processed. */
1191           goto label_3010;
1192 
1193 /* ext_entry pseudo_operation Usage: ext_entry elabel,stackframe_size,clabel,dlabel,function */
1194 
1195 label_vector (64):
1196 label_2610:
1197 /* first arg, entrypoint label */
1198           call getid_;
1199           if eb_data_$tsym = 0 then goto label_3100;        /* field error */
1200 
1201           /* remember amount of stack space currently allocated */
1202           i = stkclst;
1203           stkclst = glpl_$setblk(0, 1);
1204           call glpl_$slwrd(i, stkc, stkclst);
1205 
1206           stkc = 64;          /* initial ext_entry stackframe size */
1207           ext_entry_count = ext_entry_count + 1;
1208           tvlth = tvlth + 1;
1209           pc = pc + 7;        /* leave room for entry seq and entry code */
1210           if brk(1) ^= icomma then goto label_3010;
1211 /* second arg stacksize */
1212           junk = varevl_(invrvl, basno, i, admod, b29, iaddr);
1213           if brk(1) ^= icomma then goto label_3010;
1214 /* third arg code_sequence label */
1215           call getid_;
1216           remember_sym = sym;
1217           if brk(1) = icomma then do;
1218 /* fourth argument dlabel */
1219                call getid_;
1220                if sym(1) ^= 0 then pc = pc + 1;        /* has descriptors */
1221             end;
1222           /* set value of optional internal label */
1223           if remember_sym(1) > 0 then junk = table_(iassgn, remember_sym(1), pc-6, flocrf, curlc);
1224           goto label_3010;    /* done */
1225 
1226 /* return pseudo-operation, return control to caller. */
1227 
1228 label_vector (39):            /* return */
1229 label_2700:
1230           if tnewcall ^= 0 then pc = spc + eb_data_$new_nretls;
1231           else pc = spc + eb_data_$nretls;
1232           call inputs_$nxtnb;
1233           if (brk (1) ^= iques) then goto label_3010;
1234           pc = spc + eb_data_$nertls;
1235           if (labarg ^= 0) then goto label_3010;
1236           stkc = stkc + mod (stkc,2);
1237           labarg = stkc;
1238           stkc = stkc + 4;
1239           goto label_3010;
1240 
1241 /* short_return pseudo-operation, return from entry that did no save. */
1242 
1243 label_vector (46):            /* short_return */
1244 label_short_return:
1245           if tnewcall = 0 then prnto = 1;
1246           pc = spc + eb_data_$short_nretls;
1247           goto label_3010;
1248 
1249 /* save pseudo-operation, stack setup for subroutine call. */
1250 
1251 label_vector (41):            /* save/push */
1252 label_2800:
1253           if tnewcall ^= 0 then pc = spc + eb_data_$new_nslsav;
1254           else pc = spc + eb_data_$nslsav;
1255           if (tprot = 1) then pc = pc + eb_data_$nmxsav;
1256           goto label_3010;
1257 
1258 /* segdef pseudo-operation, ignored in pass1. */
1259 
1260 label_vector (42):            /* segdef */
1261 label_2900:
1262           goto label_3010;
1263 
1264 /* setlp pseudo-op.... ignored in pass1. */
1265 
1266 label_vector (45):            /* setlp */
1267 label_2970:
1268           pc = pc + 1;
1269           goto label_3010;
1270 
1271 /* getlp pseudo-operation, calculate linkage pointer using lot (new call/save/return). */
1272 
1273 label_vector (49):            /* getlp */
1274 label_getlp:
1275           pc = spc + eb_data_$new_ngetlp;
1276           goto label_3010;
1277 
1278 label_vector (58):
1279 label_entrybound:
1280           eb_data_$entrybound_bit = "1"b;
1281           goto label_3010;
1282 
1283 label_vector (9):             /* dup */
1284 label_dup:
1285           if dup_ptr ^= null () then go to label_3120;
1286           if varevl_ (invrvl, basno, value, admod, b29, iaddr) = 0 then go to label_3120;
1287           if iaddr ^= 0 then go to label_3300;
1288           if value <= 0 then go to label_3120;
1289           dup_count = value - 1;
1290           call inputs_$next_statement;
1291           call inputs_$get_ptr (dup_ptr, dup_start, junk, end_statement_flag);
1292           go to label_3030;
1293 
1294 label_vector (10):            /* dupend */
1295 label_dupend:
1296           if dup_ptr = null () then go to label_3120;
1297           call inputs_$get_ptr (temp_ptr, i, j, end_statement_flag);
1298           if temp_ptr ^= dup_ptr then go to label_3100;
1299           i = begin_line;                         /* Really want beginning of line. */
1300           call inputs_$next_statement;
1301           if dup_count > 0 then
1302                call alm_include_file_$insert (addr (dup_string (dup_start)), i - dup_start, dup_count);
1303           dup_ptr = null ();
1304           go to label_3020;
1305 
1306 label_vector (61):
1307 label_ppstatic:
1308           eb_data_$per_process_static_sw = 1;
1309           go to label_3020;
1310 
1311 label_vector (68):  /* block */
1312 label_vector (69):  /* end_block */
1313 label_vector (70):  /* enum */
1314 label_vector (71):  /* end_enum */
1315 label_vector (72):  /* source */
1316 label_vector (73):  /* end_source */
1317 label_vector (74):  /* statement */
1318 label_vector (75):  /* structure */
1319 label_vector (76):  /* end_structure */
1320 label_vector (77):  /* symbol */
1321 label_vector (78):  /* union */
1322 label_vector (79):  /* end_union */
1323 
1324           goto label_3010;    /* ignored in pass1_ */
1325 
1326 
1327 label_vector (60):
1328 label_macro:
1329           call getid_;
1330           if eb_data_$tsym = 0 then goto label_3100;
1331           call oplook_$redefine;
1332           call inputs_$next_statement;
1333           call mexp_$define_macro (substr (addr (sym (1)) -> acc.string, 1, bin (addr (sym (1)) -> acc.length, 9)));
1334           go to label_3030;
1335 
1336 label_vector (40):
1337 label_maclist:
1338           go to label_3020;
1339 
1340 
1341 /* INSTRUCTION PROCESSING BEGINS HERE. */
1342 
1343 label_vector (52):            /* rpt, rpd, rpl */
1344 label_repeat:
1345 label_vector (53):            /* awd, swd, abd, sbd, etc. */
1346 label_eis_single:
1347 label_vector (54):            /* mvn, cmpb, ad2d, etc. */
1348 label_eis_multiple:
1349 label_vector (55):            /* desc9a, desc6a, desc4a */
1350 label_eis_desca:
1351 label_vector (56):            /* descb */
1352 label_eis_descb:
1353 label_vector (57):            /* desc9ts, desc4ls, etc. */
1354 label_eis_descn:
1355 label_vector (43):            /* eax, canx, etc. */
1356 label_get_index:
1357 label_vector (44):            /* eap, sprp, etc. */
1358 label_get_base:
1359 
1360 /* normal instructions. */
1361 
1362 label_vector (0):             /* Normal instruction. */
1363 label_3000:
1364           pc = spc + 1;
1365                                                             /* pseudo-operation re-entry to reset u flag. */
1366 
1367 label_3010:
1368           prntu = 0;                                        /* FALSE */
1369                                                             /* pseudo-operation re-entry with u flag not reset. */
1370 
1371 label_3020:
1372           call inputs_$next_statement;
1373 
1374 label_3030:
1375           pcblk (1) = utils_$ls (pc,18);
1376           call utils_$pckflg (pcblk (2));
1377           pcblk (3) = utils_$ls (curlc,18);
1378           link = glpl_$setblk (pcblk (1),3);
1379           ndpcls -> word.right = addr (link) -> word.right;
1380           ndpcls = ptr (eb_data_$lavptr,link);
1381 
1382           goto label_200;
1383 
1384 
1385 /* error return for pseudo-operations. */
1386 
1387 /* field (f) error. */
1388 
1389 label_3100:
1390           prntf = 1;                                        /* TRUE */
1391           goto label_3010;
1392 
1393 /* phase (p) error. */
1394 
1395 label_3110:
1396           prntp = 1;                                        /* TRUE */
1397           goto label_3010;
1398 
1399 /* symbol (s) definition error. */
1400 
1401 label_3120:
1402           prnts = 1;                                        /* TRUE */
1403           goto label_3010;
1404 
1405 /* undefined (u) symbol error. */
1406 
1407 label_3130:
1408           prntu = 1;                                        /* TRUE */
1409           goto label_3020;    /* next statement */
1410 
1411 
1412 /* re-entry for undefined pseudo-operations. */
1413 
1414 label_3200:
1415           prnto = 1;                                        /* TRUE */
1416           goto label_3010;
1417 
1418 /* re-entry for relocation (r) error. */
1419 
1420 label_3300:
1421           prntr = 1;                                        /* TRUE */
1422           goto label_3010;
1423 
1424      end pass1_;