 101 273       job  1401 Fortran system   version three                    50003
 102           ctl  645 11
 103           org  111
 104 xdoad1    dcw  #1
 105 xdoad2    dcw  #1
 106 xdoad3    dcw  #1
 107 xdoini    dcw  #1
 108 xoblst    dcw  #1
 109 xdosbs    dcw  #1
 110 xcomf1    dcw  #1
 111 xsinfu    dcw  #1
 112 xlogfn    dcw  #1
 113 xxpntl    dcw  #1
 114 xatanf    dcw  #1
 115 xabsva    dcw  #1
 116 xnegtf    dcw  #1
 117 xfixfu    dcw  #1
 118 xfltfu    dcw  #1
 119 xsqrtf    dcw  #1
 120 xuser1    dcw  #1
 121 xuser2    dcw  #1
 122 xuser3    dcw  #1
 123 xuser4    dcw  #1
 124 xuser5    dcw  #1
 125 xuser6    dcw  #1
 126 xuser7    dcw  #1
 127 xuser8    dcw  #1
 128 xuser9    dcw  #1
 129 xusr10    dcw  #1
 130 xusr11    dcw  #1
 131 xusr12    dcw  #1
 132 xlinkf    dcw  #1
 133 ndtabl    equ  *&1
 134 oneadr    dcw  #3                  Address of constant one
 135 adtbll    dcw  #3                  NXBTM for STNUM TWO & RESORT 4
 136 bsauce    dcw  #3                  Bottom of object for RESORT
 137 gnstmz    dcw  #3                  Total No of DO-generated stmts
 138 period    dcw  #3                  Address of period (no list)
 139 xexpon    dcw  #3                 Address of constant .1
 140 plusdf    dcw  #3         (PARAMA&2)-CONLST#16000s comp. of MACFLS
 141 macfls    dcw  #3         Compile time adr.&MACFLS#OBJ. time adr.
 142           org  181
 143 intstz    dcw  #3                 Total number of input statements
 144 gogogo    equ  *                  Address of first executable stmt
 145 failsw    dc   #1                 Cripple GO condition switch
 146 xlinkw    dcw  #1                 Load XLINK switch
 147 gotofn    dcw  #3                 Addr of func select routine
 148 subscr    dcw  #3                 Objt time addr of DOSBS func
 149 conlst    dcw  #3                  Adr. of pos. imm. before arrays
 150 funcsw    dc   #1
 151           org  196
 152           dcw  @V3M0@
 153           job  1401 Fortran  Snapshot routine                         50003
 154           sfx  7
 155 xxx       equ  0
 156 xl1       equ  089
 157 089       dcw  000
 158 xl3       equ  099
 159 099       dcw  000
 160           org  333
 161           sbr  prtxt&3
 162           sbr  hldxt&6
 163           mcw  @000@,linct-2
 164           mcw  xl3, hld32&6
 165           mcw  xl1, hld31&6
 166           sbr  xl1, 1
 167           sbr  xl3, 202
 168           cs   332
 169           cs
 170           mcw  110,210
 171           bss  only,f
 172           cc   1
 173           mcw  094,250
 174 hldxt     sbr  216,xxx
 175 hld32     sbr  256,xxx
 176 hld31     sbr  244,xxx
 177           w
 178           cc   k
 179           za   &2,pgctr#2
 180 nuline    cs   332
 181           cs
 182           cc   j
 183           mcw  linct,306
 184           mcw
 185           sbr  mvhed&6
 186           mcw  @9@, ctr-1
 187 mvhed     mcw  ctr-1,xxx
 188           mcw  head
 189           sbr  mvhed&6
 190           a    @i0@, ctr#2
 191           bwz  mvhed, ctr-1, 2
 192           a    &1,linct-2
 193           w
 194 loop      sw   0&x3
 195           mcw  0&x1,0&x3
 196           bw   cmpab,0&x1
 197           cw   0&x3
 198 cmpab     c    xl1,parama&2
 199           bu   cpl
 200           w
 201           wm
 202 rstrx     mcw  hld31&6,xl1
 203           mcw  hld32&6,xl3
 204           cs   332
 205           cs
 206           bss  *&5,g
 207           b    prtxt
 208           h
 209 prtxt     b    0
 210 cpl       sbr  xl1, 1&x1
 211           bce  inc, xl3-2, 2
 212           sbr  xl3, 201
 213           w
 214           wm
 215           a    &1,pgctr
 216           c    pgctr,&15
 217           bu   nuline
 218           s    pgctr
 219           ccb  nuline,1
 220 only      mcw  @executed@,220
 221           w    rstrx
 222 inc       a    &1,xl3
 223           b    loop
 224 head      dcw  @9........@
 225           dcw  @9-@
 226 linct     dcw  00000
 227           ltorg*
 228           job  1401 Fortran  System monitor and parameter card        50013
 229           sfx  a
 230 prmcd     da   1x19
 231 param          6
 232 monter    mcw  bclear-2,cclear-2
 233 aclear    cs   0
 234           sbr  tclear
 235           c    tclear,cclear
 236           bu   aclear
 237           sw   lod&4
 238           mcw  tclear,lod&6
 239           cw   lod&4
 240 ck        c    lod&6,bclear#3
 241           be   montor
 242 lod       lca  @ @,0                         blank
 243           sbr  lod&6
 244           b    ck
 245 tclear    equ  aclear&3
 246 *Restrictions on clear routine
 247 *              1. Must clear at least one century
 248 *              2. Cannot clear above 4k
 249 montor    r    040
 250 nine      mcw  &9,rdcnt
 251 initap    rtw  1,xbegin
 252           ber  errtp
 253 initxt    b    xbegin
 254 errtp     bsp  1
 255           s    &1,rdcnt#1
 256           bwz  initap,rdcnt,B
 257           h    3333,3333
 258           b    nine
 259 cclear    dcw  999
 260           ltorg*
 261 xbegin    equ  *&1
 262           job  1401 Fortran  Loader phase                             50023
 263           fbegnloader,xl1,r,xl2,r,xl3,r,a
 264 start     bce  *&8,1,                        blank
 265           mcw  @n@,montor
 266           cs   080
 267           sw   1,gm
 268           sw   81,84
 269           cs   332
 270           cs
 271           r
 272           lca  19,prmcd&18
 273           c    prmcd&4,@param@
 274           bu   noprm
 275           sw   073
 276           sw   006,007
 277           sw   param
 278           mcw  80,param-1
 279           cs   0                              determine top of
 280           sbr  larry#3                         machine
 281           mcw  param&2,dum3#3
 282           b    unpak
 283           mcw  dum5#5,wk5
 284           mcw  larry,dum3
 285           b    unpak
 286           mcw  dum5,wk51
 287           a    &1,wk5
 288           a    &1,wk51
 289           cs   332
 290           cs
 291           messg@start of Fortran compilation@,28,1,j
 292           mcw  wk5,231
 293           mcw  @machine size specified is @
 294           w
 295           cs   235
 296           mcw  wk51,228
 297           mcw  @actual machine size is @
 298           bce  exit,param&9,t
 299           w
 300           c    wk51#5,wk5#5
 301           bh   mserr
 302           c    wk5,@03900@
 303           bl   exit
 304           messg@machine size error@,18,j
 305           b    l2prm
 306 mserr     mcw  @specified is greater than actual machine size.@,267
 307           mcw  @error - machine size @
 308           w
 309 l2prm     mcw  larry,param&2
 310 exit      mcw  param&2,clr&3
 311 clr       cs   0
 312           sbr  clr&3
 313           c    clr&3,&sysgm
 314           bu   clr
 315           r
 316           mz   *-006,work&76
 317           mz   *-006,abit&007
 318           mz   *-6,abit2&7
 319           mz   *-6,char-1
 320           mcw  number,work&003
 321           mcw  param&002,dummy&003
 322 dummy     cw   0000
 323           sbr  store&006
 324 move      bw   mvipt,endsw
 325           bce  scanr,001,:                   5-8
 326 prmsg     messg@message 1-system does not follow end card@,70,1,1
 327           h    *-3
 328 mvipt     mcw  0072,work&075
 329           mcw
 330           mcw
 331           bce  scanr,work&004,:               5-8
 332 tovl      bin  prthd,    carriage overflow test - initialized
 333 m2prt     cs   300
 334           cs
 335           mcw  0072,0283
 336           mcw  006,215
 337           bce  cmnt,work&4,c
 338 fstnu     b    new
 339           bce  new,work&009,0
 340           bce  new,work&009,
 341           a    &1,ctucd
 342           bce  *&8,ctucd-1,0
 343           mcw  @continue cd err@,300
 344           w
 345           mcw  inilz1,sel&003
 346 sel       mcw  0000,fixed
 347           sw   sel&001
 348           a    one,sel&003
 349           cw   sel&001
 350 sw1       nop  cklhc
 351           bce  sel,fixed,                    blank
 352           mcw  fixed,*&8
 353           bce  abit,char,0
 354           chain5
 355 store     mcw  fixed,0000
 356           sbr  store&006
 357 incto     a    &1,total#5
 358           c    store&6,&ldrnd
 359           be   quit
 360 hsw       bce  hollr,fixed,h
 361 hsw2      nop  @b@,hsw
 362 cmpar     c    sel&003,inilz1
 363 swtch2    bin  sel,/
 364           sw   store&004
 365 jump      mcw  store&006,xl2
 366           cw   store&004
 367           mcw  n,jump
 368           mcw  n,swtch2
 369           a    ten,count
 370           bce  tstnd,count-1,5
 371           sw   endsw
 372           bwz  sel,count-001,2
 373           mcw  b,swtch2
 374 remove    mcw  0&x2,out
 375           c    format,out
 376           bu   sel
 377           mcw  @b@,hsw
 378           mcw  0&x3,work6#6
 379           mcw  @f@,work6-3
 380           mcw  work6,0&x3
 381           b    sel
 382 slash     mcw  @@@,fixed
 383           b    store
 384 new       mcw  @n@,fstnu
 385           a    &1,stmno#3
 386           mcw  @n@,hsw
 387           mcw  @n@,hsw2
 388           mcw  5,211
 389           s    ctucd#2
 309           mcw  @n@,sw1
 391           mcs  stmno,203
 392           w
 393           sw   store&004
 394           mcw  store&006,loadgm&006
 395           cw   store&4
 396           mcw  m,jump
 397 loadgm    lca  gm,0000
 398           sbr  xl3
 399           sbr  store&006
 400           mcw  mark,work&009
 401           mcw  b,swtch2
 402           mcw  two,count
 403           mcw  inilz2,sel&003
 404           b    sel
 405 tstnd     c    0&x2,@dne@
 406           bu   sel
 407           cw   endsw#1
 408           b    sel
 409 atsgn     mcw  @-@,fixed
 410           b    store
 411 abit      bce  input,fixed,                  abit
 412           bce  input,fixed,|
 413           bce  slash,fixed,/
 414           bce  atsgn,fixed,@
 415           mcw  @*@,300
 416           mcw  kproc
 417           mcw  fixed#1
 418           b    store
 419 hollr     mcw  store&6,xl1
 420           mcw  @n@,hsw
 421           mcw  @n@,hsw2
 422           mcw  @b@,sw1
 423           mcw  4&x1,work3#3
 424           bce  *&9,work3-1,@
 425           bwz  myb2,work3-1,2
 426           mcw  work3-2,work3
 427           mcw  @00@
 428           b    cmpar
 429 myb2      bce  *&9,work3,@
 430           bwz  istri,work3,2
 431           mcw  work3-2,work3
 432           mcw  @0@,work3-2
 433           b    cmpar
 434 istri     mcw  work3,sav1#1
 435           mcw  work3-2,work3
 436           mcw  sav1,work3-2
 437           b    cmpar
 438 unpak     sbr  pkxt&3
 439           unpakdum3,dum5
 440 pkxt      b    000
 441 abit2     equ  *&1
 442 cklhc     bce  input,fixed,
 443           s    &1,work3
 444           c    work3,&000
 445           bu   store
 446           mcw  @m@,hsw2
 447           mcw  n,sw1
 448           mcw  sel&3,xl1
 449           c    0&x1,@,@
 450           be   store
 451           mcw  store&6,*&7
 452           mcw  0,0
 453           mcw  @,@
 454           sbr  store&6
 455           a    &1,total
 446           b    incto
 457           b    store
 458 scanr     mcw  store&6,xl1
 459           lca  gm,0&x1
 460           sbr  xl1
 461           cc   1
 462           cs   332
 463           cs
 464           mcs  total,205
 465           mcw  @input characters@,222
 466           w
 467           cc   j
 468           mcw  stmno,intstz
 469           lca  @ }POTS:R000@,0&x1            g-m,5-8
 470           sbr  xl1
 471           sw   2&x1
 472           a    &1,intstz
 473           bce  *&5,ldrnd,                    blank
 474           b    quit
 475           sbr  tclear,sysgm
 476           sbr  bclear,xbegin
 477           bss  333,c
 478           lca  @scanner@,110
 479           cs   080
 480           sw   1,40
 481           sw   47,54
 482           sw   61,68
 483           sw   72
 484           bce  monter,montor,n         tape system
 485           r
 486           c    7,@scanner@
 487           be   monter
 488           b    prmsg
 489 quit      fquit
 490 prthd     cc   1
 491           mcw  @@@,tovl&4
 492           cs   299
 493           a    one,pgno#003
 494           mcs  pgno,299
 495           mcw  @   page @,295
 496           mcw  080
 497           w
 498           cs   299
 499           mcw  kfsm,234
 500           w
 501           cc   j
 502           b    m2prt
 503 noprm     messg@message 3 - no parameter card@,70,1,1
 504           bce  *&6,montor,1
 505           rwd  1
 506           h    *-3
 507 cmnt      mcw  blnk3#3,203
 508           mcw  005,211
 509           w
 510 input     blc  scanr
 511           r
 512           b    move
 513 char      dcw  @$@/|  @                      last two a-bit,blank
 514 kfsm      dcw  @ seq   stmnt      FORTRAN STATEMENT@
 515           dcw  @ @
 516 work      ds   01
 517           ds   76
 518 count     dcw  #2
 519 inilz1    dsa  &work&010
 520 inilz2    dsa  &work
 521 one       dcw  @1@
 522 b         dc   @b@
 523 two       dc   @20@
 524 out       dcw  @       @
 525 format    dcw  @%tamrof@
 526 n         dc   @n@
 527 gm        dc   @}@                           group mark
 528 number    dcw  @000r@
 529 mark      dcw  @:@                           5-8
 530 ten       dcw  @10@
 531 m         dc   @m@
 532 kproc     dcw  @ processed @
 533           ltorg*
 534           org  *&x00
 535           org  *-1
 536 sysgm     dcw  @}@            work and system group mark
 537 ldrnd     equ  *&1
 538           xfr  start
 539           job  1401 Fortran  Scanner phase                            50033
 540 110       dcw  @:@                           5-8 first card
 541           fbegnscanner,x1,r,,,,,b
 542           org  xbegin
 543 start     mcw  parama&2,dummy&6
 544           sw   parama&3,parama&5
 545           bce  *&5,parama&4,                 blank
 546           b    *&8
 547           mcw  @05@,parama&4
 548           bce  *&5,parama&6,                 blank
 549           b    *&8
 550           mcw  @08@,parama&6
 551           c    parama&4,@01@
 552           bh   rdxer
 553           c    parama&4,@20@
 554           bl   rdxer
 555 ckcmt     c    parama&6,@20@
 556           bl   mnter
 557           c    parama&6,@02@
 558           bh   mnter
 559 prdx      cs   332
 560           cs
 561           mcw  @modulus is@,210
 562           mcs  parama&4,213
 563           w
 564           cs   299
 565           mcw  @mantissa is@,211
 566           mcs  parama&6,214
 567           w
 568           cc   j
 569 dummy     bce  dummy,0000,0
 570           bce
 571           sbr  marty&6
 572           sbr  remv&003
 573 remv      lca  0000,work
 574           sar  remv&003
 575           mcw  nmbr,work
 576           a    one,nmbr
 577           bce  replce,work-3,f
 578           sbr  twlv58&6,work-4
 579           sbr  first,work-5
 580 twlv58    bce  arith1,work-4,:               5-8   undefined char..
 581           sbr  twlv58&006
 582           sbr  lenny&006
 583 lenny     bce  lenny,0000,
 584           sbr  first
 585           b    twlv58
 586 arith1    mcw  first,test1&006
 587           mcw  first,test2&006
 588 test1     bce  encode,0000,}                 group mark
 589           bce
 590           sbr  test1&6
 591 test2     bce  arith2,0000,#
 592           bce
 593           sbr  test2&6
 594           b    test1
 595 arith2    sw   test1&004
 596           mcw  test1&006,sel&003
 597           cw   test1&004
 598 sel       mcw  0000,fixed
 599           sar  sel&003
 600           bce  ckfun, fixed,%
 601           bce  ckfun, fixed,}                group mark
 602           bce  encode,fixed,,
 603           b    sel
 604 encode    mcw  first,grab10&003
 605 grab10    mcw  0000,front
 606           sw   front
 607           sw
 608           mcw  front,scfb&007
 609 scfb      bce  store1,code,                  column 39 modified
 610           chain3
 611           mcw  front-001,auniq&007
 612 auniq     bce  store2,code-004,              column 39 modified
 613           chain4
 614           sw   work-003
 615           b    easy
 616 store1    c    front-2,@esn@            sense light
 617           be   sense
 618           mcw  front,work-003
 619           b    clear
 620 sense     mcw  @j@,work-3
 621           b    clear
 622 store2    mcw  front-001,work-003
 623           bce  *&5,auniq&7,n
 624           b    clear
 625           c    front-2,@elifd@
 626           be   clear
 627           mcw  @/@,work-3
 628 clear     cw   front
 629           cw
 630 replce    cw   work-003
 631 marty     lca  work,0000
 632           sbr  marty&006
 633           sbr  end&006
 634           sbr  083
 635 end       bce  relokt,0000,
 636           b    remv
 637 ckfun     mcw  test2&6,x1
 638           bce  mayfn,1&x1,)
 639           bce
 640           b    replce
 641 mayfn     bce  ndfnd,2&x1,%
 642           sbr  x1
 643           b    mayfn
 644 ndfnd     bce  probf,3&x1,f
 645           b    replce
 646 probf     bce  replce,6&x1,:                 5-8
 647           bce
 648           bce
 649           mcw  @R@,work-3
 650           sw   funcsw
 651           b    replce
 652 easy      cw   front
 653           cw
 654           c    front,snse                         if sense switch
 655           bin  do,/
 656           bce  light,front-8,L
 657           mcw  const,work-003
 658           b    replce
 659 light     mcw  @k@,work-3
 660           b    replce
 661 rdxer     messg@error 42 - modulus@,18,,j
 662           mcw  @05@,parama&4
 663           b    ckcmt
 664 mnter     messg@error 43 - mantissa@,19,,j
 665           mcw  @08@,parama&6
 666           b    prdx
 667 do        bce  put1,front,d                       d for do
 668           bce  put2,front-002,%                   3rd paren if
 669           bce  put3,front-004,%                   5th paren go to
 670           bce  put4,front,g                       g for go to
 671           bce  put5,front,p                       p fo print
 672           bwz  put6,front-004,2                   5th numerl readn
 673           bce  put7,front-005,d                   6th d for rewind
 674           mcw  one,work-003
 675           mn   front-005,work-003
 676           b    replce
 677 put1      mcw  const-001,work-003
 678           b    replce
 679 put2      mcw  const-002,work-003
 680           b    replce
 681 put3      mcw  const-003,work-003
 682           b    replce
 683 put4      mcw  const-004,work-003
 684           b    replce
 685 put5      mcw  const-005,work-003
 686           b    replce
 687 put6      mcw  const-006,work-003
 688           b    replce
 689 put7      mcw  const-007,work-003
 690           b    replce
 691 relokt    fendxc,,,,beginc,,clrfct,sorter one
 692           dcw  @ @                           blank
 693           dcw  @ @
 694           org  *&693
 695 work      ds   01
 696 nmbr      dcw  @001@
 697 one       dcw  @1@
 698 first     dcw  #3
 699 fixed     dcw  #1
 700 front     dcw  #10
 701 code      dc   @qinuabfcs@
 702 snse      dcw  @esnes%fi@
 703 const     dc   @zlpgtedw@
 704           ltorg*
 705           org  *&x00
 706 clrfct    equ  *
 707           dcw  @}@                           system group mark
 708           xfr  start
 709           job  1401 Fortran  sorter phase one                         50043
 710           fbegnsorter one,xl1,r,xl2,r,xl3,r,c,xxxx
 711           org  xbegin
 712 table     da   40x3,c
 713           org  *&x00
 714           ds   6
 715 zone      dcw  @2skb@
 716 begin     cs   clrfct
 717           chain8
 718 start     mcw  083,xl3
 719           mcm  2&x3                          get last statement
 720           mcw                                 number
 721           sbr  xl3
 722           mcw  0&x3,work3#3
 723           za   work3,hold5#5                 multiply by three
 724           a    hold5
 725           a    work3,hold5
 726           s    &2,hold5
 727           mcw  hold5,hld5a#5
 728           mcw  @16000@,hold5
 729           s    hld5a,hold5
 730           bav  *&1
 731 sub       a    &96,hold5-3                   compute new address
 732           bav  sub
 733           mn   hold5-3,*&4
 734           mz   zone,hold5-2
 735           mcw  083,xl1
 736           mcw  xl1,nop&3
 737           mcw  hold5,xl2
 738           mz   @j@,nop&2
 739 nop       nop  xxxx
 740           sar  xl2
 741           unpakxl2,hold5
 742           c    hold5,@02900@
 743           bl   move
 744           fquit
 745 move      mcw  xl2,083
 746           mcm  0&x1
 747           sar  xl1
 748           fendxc,,,start,nustm,start,sysmk,sort 2
 749           dcw  0
 750           ltorg*
 751 sysmk     dcw  @}@                           system group mark
 752           xfr  begin
 753           job  1401 Fortran  sorter phase two                         50053
 754 110       dcw  @sort 2@
 755           org  start
 756 nustm     mcw  xl1,xl3
 757           sw   gm2
 758           mcm  0&x1
 759           mn
 760           mn
 761           sar  xl1
 762           lca  0&x1, hold-3
 763           mcm  0&x1
 764           sar  xl1
 765           mcm  0&x3,0&x2
 766           sbr  xl2
 767           lca  hold,1&x2
 768           s    xl3&1
 769           mcw  0&x2,hold6#6
 770           mn   hold6-5, xl3
 771           mcw  xl3,save3
 772           a    xl3
 773           a    save3,xl3
 774           bwz  cntu,hold6-5, 2
 775           a    &30,xl3
 776           bwz  cntu,hold6-5, s
 777           a    &30,xl3
 778           bwz  cntu,hold6-5, k
 779           a    &30,xl3
 780 cntu      mcw  table&2&x3,1&x2               insert table entry
 781           lca  gm2,2&x2
 782           sbr  table&2&x3
 783           mcm  2&x2
 784           sar  xl2
 785           c    xl2,parama&2
 786           bu   nustm
 787           fendxc,gm2,,,,,end-1,sort 3
 788           dcw  0
 789 gm2       dc   @}@                           g-m
 790           org  *&700
 791 hold      dc   #3
 792           org  *&x00
 793 eotwo     equ  *&1
 794           ltorg*
 795           dcw  @}@                           system group mark
 796           xfr  nustm
 797           job  1401 Fortran  sorter phase 3                           50063
 798 110       dcw  @sort 3@
 799 x1        equ  089
 800 x2        equ  094
 801           org  start
 802 again     mcw  083,xl3
 803           sw   gm
 804           sbr  xl1,end-1
 805           sw   end
 806           mn   0&x3
 807           lca  gm
 808           sbr  pick&6
 809           sbr  tbegin#3,list
 810 nutyp     mcw  tbegin,xl3                    get list entry
 811           mcw  0&x3,xl3
 812           sar  tbegin
 813           bce  eoj,xl3,x
 814           mcw  table&2&x3,xl3                get table entry
 815           bce  nutyp,xl3,                    any of this type
 816 pick      mcw  0&x3,xxxx                     pickup statement
 817           sar  xl2
 818           bce  aok1,1&x2,}                   can it fit   g-m
 819           b    pack
 820 aok1      sbr  xl2,2&x2
 821 back5     mcm  0&x2
 822           sbr  sbr6&6
 823           mcm  0&x2,1&x1
 824           sbr  x1
 825           mn   0&x1
 826           sbr  x1
 827 sbr6      sbr  x2,0
 828           bce  back5,0&x1,|
 829           sbr  x1,1&x1
 830           cw   paksw
 831           mn   0&x1
 832           chain3
 833           sar  xl1
 834           lca  gm,0&x1
 835           sbr  083
 836           sbr  xl1
 837 pmov1     mcm  1&x1
 838           mn
 839           sar  xl1
 840           bce  pmov1,0&x1,|
 841           mn   0&x3
 842           chain5
 843           sar  xl3
 844           mn   0&x1
 845           lca  3&x3
 846           mcw  @#@,0&x3
 847 pmov2     mcm  2&x3
 848           mn
 849           mn
 850           sar  xl3
 851           bce  pmov2,1&x3,|
 852           bce  nutyp,0&x3,
 853           mcw  0&x3,xl3
 854           b    pick
 855 pack      bw   cerr,paksw
 856           sw   paksw
 857           mcw  parama&2,xl2
 858           mn   0&x2
 859           sar  xl2
 860           mcw  xl2,xl3
 861 loop1     lca  0&x2,0&x3
 862           sar  xl2
 863           mcw  0&x3,work9#9
 864           bce  done,work9-6,#
 865           lca  0&x3,0&x3
 866           sar  xl3
 867 done      c    pick&6,xl2
 868           bu   loop1
 869           mcw  xl3,pick&6
 870           mcw  xl3,xl2
 871           mz   xl3,all92
 872           mz
 873           mcw
 874           mz   xl1,all9
 875           mz
 876           mcw
 877           c    all9,all92
 878           be   zadd
 879 cleer     cs   0&x3
 880           sbr  xl3
 881           c    xl3,all9
 882           bu   cleer
 883 zadd      za   &39,save3
 884           s    xl3&1
 885 muve      mcw  blnk3#3,table&2&x3
 886           s    &1,save3
 887           bm   exit,save3
 888           a    &3,xl3
 889           b    muve
 890 exit      mcm  1&x2
 891           mn
 892           sar  xl2
 893           bce  exit,0&x2,|
 894           sbr  xl2,1&x2
 895           s    xl3&1
 896           c    0&x2
 897           sar  *&4
 898           mcw  0,work9
 899           mn   work9-6,xl3
 900           mcw  xl3,save3
 901           a    xl3
 902           a    save3,xl3
 903           bwz  cnt,work9-6,2
 904           a    &30,xl3
 905           bwz  cnt,work9-6,s
 906           a    &30,xl3
 907           bwz  cnt,work9-6,k
 908           a    &30,xl3
 909 cnt       mn   0&x2
 910           mn
 911           mcw  table&2&x3
 912           c    0&x2
 913           sar  table&2&x3
 914           c    xl2,parama&2
 915           bu   exit
 916           mcw  tbegin,xl3
 917           nop  3&x3
 918           sar  tbegin
 919           b    nutyp
 920 eoj       fendxc,gm,,xbegin,xbegin,xbegin,save3,group mark
 921 cerr      fquit
 922           dcw  @xxx@
 923           dcw  117                           I dimension
 924           dcw  084                           Q equivalence
 925           dcw  108                           F format
 926           dcw  009                           3 write tape
 927           dcw  003                           1 read tape
 928           dcw  018                           6 write output tape
 929           dcw  081                           p print
 930           dcw  042                           u pnch
 931           dcw  015                           5 read input tape
 932           dcw  069                           l read
 933           dcw  087                           r arith
 934           dcw  105                           e if
 935           dcw  027                           9 function stmts
 936           dcw  096                           b backspace
 937           dcw  057                           z rewind
 938           dcw  075                           n end of file
 939           dcw  039                           t computed go to
 940           dcw  111                           g go to
 941           dcw  036                           s stop
 942           dcw  093                           a pause
 943           dcw  063                           j sense light
 944           dcw  066                           k if sense light
 945           dcw  048                           w if sense switch
 946           dcw  099                           c continue
 947 list      dcw  102                           d do
 948 all9      dcw  999
 949 all92     dcw  999
 950 gm        dc   @}@                           group mark
 951 paksw     dc   0
 952           ltorg*
 953           org  eotwo&1
 954 save3     dcw  #3
 955           org  orgvbi&x00                    varbl one longest
 956 end       equ  *&1
 957           dcw  @}@                           system group mark
 958           xfr  again
 959           job  1401 Fortran  insert group phase                       50073
 960           fbegngroup mark,x1,r,x2,r,,,d
 961           org  xbegin
 962 start     mcw  083,x1
 963           sw   gm
 964 loop1     bce  rplce,0&x1,:        5-8
 965 btest     bce  eoj,0&x1,            blank
 966           bce  ckfmt,0&x1,}          group mark
 967           sbr  x1
 968           b    loop1
 969 rplce     lca  gm, 0&x1          insert gm/wm
 970           sbr  x1
 971           c    0&x1
 972           sar  x1
 973           b    loop1
 974 ckfmt     mcw  0&x1,hold5#5
 975           bce  isfmt,hold5-4,f
 976           mcw  @b@,btest
 977 bump      mn   0&x1
 978           sbr  x1
 979           b    loop1
 980 isfmt     mcw  @n@,btest
 981           b    bump
 982 eoj       mcw  parama&2,x2
 983           mz   083,all9
 984           mz
 985           mcw
 986 clear     cs   0&x2
 987           sbr  x2
 988           c    x2,all9
 989           bu   clear
 990 cmpar     c    083,x2
 991           be   fxprm
 992           mcw  blank#1,0&x2
 993           cw   0&x2
 994           sbr  x2
 995           b    cmpar
 996 fxprm     sw   parama&3
 997           a    blank,parama&6
 998           c    parama&4,@00@
 999           bu   *&8
1000           mcw  @05@,parama&4
1001           c    parama&6,@00@
1002           bu   eophs
1003           mcw  @08@,parama&6
1004 eophs     fendxc,gm,,,,,sys1,squoze
1005 all9      dcw  999
1006 gm        dc   @}@                           group mark
1007           ltorg*
1008 sys1      dcw  @}@                           system group mark
1009           xfr  start
1010           job  1401 Fortran  squoze phase                             50083
1011           fbegnsquoze,xl1,r,xl2,r,xl3,r,e,xxxx
1012 x1        equ  xl1
1013 x2        equ  xl2
1014 stloc     equ  083
1015           org  xbegin
1016 begin     mcw  stloc,xl2                     initialize index locs
1017           mcw  stloc,xl1                      with start address
1018 nustm     mcw  0&x1,stmno#3                  save statement number
1019           mcw  0&x1,hold4#4
1020           bce  arith,hold4-3,r
1021           bce  endcd,hold4-3,/
1022 byp       bce  lod,hold4-3,x
1023           mz   hold4-3,byp&7
1024           mn   hold4-3,byp&7
1025           mn   hold4-3,hold1#1       generate table entry
1026           za   hold1,hold3#3                  address
1027           a    hold3
1028           a    hold1,hold3
1029           mz   blank#1,hold3
1030           lca  &table-3,rtrev&3
1031           a    hold3,rtrev&3
1032           mz   hold4-3,rtrev&2
1033           cw   rtrev&1
1034           mcw  xl2,holdx#8                   save index locs 1 & 2
1035           mcw
1036           mcm  data,xl1-2                    retrieve table entry
1037 rtrev     mcw  xxxx,xl3
1038           mcw  holdx,xl2
1039           mcw
1040 lod       mvdwnx1,x2
1041           c    0&x1,0&x3                     check statement name
1042           sar  xl1
1043           bu   error
1044 shift     mvdwnx1,x2
1045 ckdon     bce  done,0&x1,                    blank check for eoj
1046           b    nustm
1047 done      cs   0&x2
1048           cs
1049           fendxc,,,,initlf,,sys1,dimen1
1050 error     ftmsg1,undeterminable statement,stmno,25
1051 pmov3     mcm  2&x2
1052           mn
1053           mn
1054           sar  xl2
1055           bce  pmov3,1&x2,|
1056           c    0&x1
1057           sar  xl1
1058           b    ckdon
1059 arith     lca  0&x1,0&x2
1060           sar  xl1
1061           lca  0&x2,0&x2
1062           sbr  xl2
1063           b    shift
1064 endcd     c    0&x1
1065           c
1066           sar  xl1
1067           b    ckdon                         / end
1068 table     dcw  rdtap                         1 read tape
1069           dcw  xxxx                          2
1070           dcw  wrtap                         3 write tape
1071           dcw  xxxx                          4
1072           dcw  rditp                         5 read input tape
1073           dcw  wtotp                         6 write output tape
1074           dcw  xxxx                          7
1075           dcw  xxxx                          8
1076           dcw  blank                         9 function statements
1077           dcw  xxxx                          /
1078           dcw  stop                          s stop
1079           dcw  cgoto                         t computed go to
1080           dcw  punch                         u punch
1081           dcw  xxxx                          v
1082           dcw  ifssw                         w if sense switch
1083           dcw  xxxx                          x
1084           dcw  xxxx                          y
1085           dcw  rwd                           z rewind
1086           dcw  senlt                         j sense light
1087           dcw  ifsl                          k if sense light
1088           dcw  read                          l read
1089           dcw  xxxx                          m
1090           dcw  eof                           n end of file
1091           dcw  xxxx                          o
1092           dcw  print                         p print
1093           dcw  equiv                         q equivalence
1094           dcw  xxxx                          r arithmetic
1095           dcw  pause                         a pause
1096           dcw  bsp                           b backspace
1097           dcw  cntu                          c continue
1098           dcw  do                            d do
1099           dcw  if                            e if
1100           dcw  frmat                         f format
1101           dcw  goto                          g go to
1102           dcw  xxxx                          h
1103           dcw  dmsn                          i dimension
1104 goto      dcw  @otog@
1105 cgoto     dcw  @%otog@
1106 if        dcw  @fi@
1107 ifssw     dcw  @hctiwsesnes%fi@
1108 pause     dcw  @esuap@
1109 stop      dcw  @pots@
1110 do        dcw  @od@
1111 cntu      dcw  @eunitnoc@
1112 frmat     dcw  @%tamrof@
1113 read      dcw  @daer@
1114 rditp     dcw  @epattupnidaer@
1115 punch     dcw  @hcnup@
1116 print     dcw  @tnirp@
1117 wtotp     dcw  @epattuptuoetirw@
1118 rdtap     dcw  @epatdaer@
1119 wrtap     dcw  @epatetirw@
1120 eof       dcw  @elifdne@
1121 rwd       dcw  @dniwer@
1122 bsp       dcw  @ecapskcab@
1123 dmsn      dcw  @noisnemid@
1124 equiv     dcw  @ecnelaviuqe@
1125 ifsl      dcw  @thgilesnes%fi@
1126 senlt     dcw  @thgilesnes@
1127 data      equ  *&1
1128           dcw  @0270005400081|@
1129           ltorg*
1130 sys1      dcw  @}@                           system group mark
1131           xfr  begin
1132           job  1401 Fortran dimension phase one                       50093
1133           fbegndimen 1,x1,,x2,r,x3,r,f
1134           org  xbegin
1135 compat    dcw  0
1136 initl     sw   gm
1137           mcw  83,x1
1138           a    blank#1,parama&6
1139           mcw  parama&6,hold#2
1140           a    &2,hold
1141           c    parama&4,hold
1142           bu   *&5
1143           cw   compat
1144           lca  gm,1&x1
1145           lca  parama&2,x2
1146           mn   0000&x2
1147           mn
1148           mcw  @ @                           blank
1149           sbr  x2
1150 start     mcw  blank,001             b op initialized
1151           mcw  @<@,2&x1           12-6-8
1152           nop  2&x1
1153           sar  start&6
1154           lca  0&x1,work
1155           sar  x1
1156           sbr  x3
1157           bce  cknod,work,                   blank
1158           bce  dimen,work-3,i
1159           bce  byp,work-3,/
1160           b    cknod
1161 dimen     bce  name,000&x1,%       left paren
1162           fbceqsyner,0&x1,,,),}      12-7-8
1163           sbr  x1
1164           b    dimen
1165 name      sw   dimsw
1166           mn   0&x1
1167           sar  x1
1168           sw   002&x1
1169           mcw  x2,hex2#3
1170 *    test to see if array was previously defined
1171           bw   ok,dsw#1
1172 uniq      mcm  1&x2
1173           sar  x2
1174           bce  ok,0&x2,      blank
1175 get       mcm  2&x2
1176           mn
1177           mn
1178           sbr  x2
1179           bce  get,1&x2,|
1180 comp      c    0&x2,0&x3      rest v. new
1181           sar  x2
1182           bu   uniq
1183 *    can get equal compare if a field longer than b field
1184           bwz  multy,1&x2,1
1185           b    uniq
1186 ok        mcw  hex2,x2
1187           lca  gm,000&x2
1188           lca  000&x3
1189           lca  pred
1190           sbr  x2
1191           mcw  pred,x3        pred initially blank  
1192           bce  *&5,x3,                       blank  
1193           b    *&8
1194           a    blank,x3
1195           lca  @   @,000&x2
1196           lca  @   @
1197           sbr  006&x3
1198           sbr  pred
1199           lca  @     @
1200           sbr  x2
1201 reset     fflip0&x1,mn,x1,x3,,,,,),}         group mark
1202           bce  syner,1&x1,}                  12-7-8
1203           lca  001&x3,000&x2
1204           sbr  x2
1205           bce  reset,1&x1,,
1206           mcw  start&6,x3
1207           bce  *&5,0&x3,<          12-6-8
1208           b    fail
1209           cw   dsw
1210 ckgm      bce  next,0&x1,}          12-7-8
1211           b                    last char of dimen might be ,
1212           bce  *&5,0&x1,,
1213           b    syner
1214           mn   000&x1
1215           sar  x1
1216           sbr  x3
1217           b    dimen
1218 next      c    0&x1
1219           sar  x1
1220           b    start
1221 multy     cs   332
1222           cs
1223           sw   failsw
1224           mcw  @error 2 - doubly defined array@,230
1225           mcw  comp&6,x2
1226           fflip0&x3,232,x3,x2,incl,wm
1227           w
1228           forms
1229 lozsc     bce  ctul,0&x1,)
1230           sbr  x1
1231           bce  syner,1&x1,}      12-7-8
1232           b    lozsc
1233 ctul      mn   0&x1
1234           sar  x1
1235           mcw  hex2,x2
1236           b    ckgm
1237 syner     ftmsg3,dimension syntax,work,17
1238           mcw  hex2,x2
1239           bce  start,1&x1,}                  12-7-8
1240 byp       c    0&x1
1241           sar  x1
1242           b    start
1243 cknod     bw   out,dimsw
1244           lca  gm,0&x2
1245           lca  @:@                           5-8
1246           lca  blnk3#3
1247           lca  blnk3
1248           lca  blnk3
1249           lca  blank5#5
1250           lca  @10@
1251           sbr  x2
1252 out       nop  002&x1
1253           mcm
1254           mcw
1255           sar  x1
1256           mcw  006,086
1257           fendxc,gm,,xbegin&1,initlg,xbegin&1,sys1,equiv one
1258 fail      fquit
1259           dcw  0
1260 work      dc   #10
1261 gm        dc   @}@        12-7-8
1262 pred      dcw  #3
1263 mn        dcw  #1
2164           dc   #4
1265 dimsw     dc   #1
1266           ltorg*
1267 sys1      dcw  @}@                           system group mark
1268           xfr  initl
1269           job  1401 Fortran   equivalence phase one                   50103
1270           fbegnequiv one,x1,,x2,,x3,r,g
1271           org  xbegin&1
1272 first     equ  086
1273 gm        dc   @}@                           12-7-8
1274 work      dc   #10
1275 dress     dcw  #3
1276 champ     dcw  #5
1277           dc   #3
1278 tally     dcw  #5
1279           dc   #3
1280 accum     dcw  #5
1281 hex3      dc   #3
1282           dc   #1
1283 space     dcw  #1
1284           dc   #4
1285 syner     ftmsg4,equivalence syntax,work,19
1286           c    0&x1
1287           sar  x1
1288           b    start
1289 loop      fbceqname,0&x1,,,%,)
1290           bce  syner,0&x1,}                 g-m
1291           sbr  x1
1292           b    loop
1293 name      sw   001&x1
1294           mcw  dress,x2        dress equals &table-2
1295 find      bce  cksim,2&x2,                   blank
1296 get       mcm  2&x2
1297           mn
1298           mn
1299           sar  x2
1300           bce  get,1&x2,|
1301 comp      c    000,000&x2                    equiv v. table
1302           sar  x3
1303           bu   find
1304 a3        bwz  isin,1&x3,1
1305           b    find
1306 initl     mn   000&x2
1307           sar  dress
1308           sbr  hex3
1309           sw   gm
1310           bw   *&8,compat
1311           mcw  @B@,cmpsw
1312           mcw  x1,save1
1313           mcw  @<@,2&x1                      12-6-8
1314           sbr  klobr&6,2&x1
1315 get2      mcm  2&x2
1316           mn
1317           mn
1318           sar  x2
1319           bce  get2,1&x2,|
1320           c    0&x2
1321           chain3
1322           sar  pred#3
1323 start     lca  000&x1,work
1324           sar  x1
1325 a1        bce  out1,work,                    blank
1326           bce  ckprn,work-3,q
1327 a2        b    out1
1328 ckprn     bce  isequ,0&x1,%
1329           b    syner
1330 isequ     sw   fxsw#1,fltsw#1
1331 equiv     mn   000&x1
1332           sar  x1
1333           sbr  comp&3
1334 cmpsw     nop  loop
1335 svorg     equ  *&1
1336           mn   0&x1,tst1&7
1337           mz   0&x1,tst1&7
1338 tst1      bce  fixed,@ijklmn@,x
1339           chain5
1340           cw   fltsw
1341           b    *&5
1342 fixed     cw   fxsw
1343           bw   loop,fltsw
1344           bwz
1345           ftmsg5,illegal equivalence mixing,work,27
1346           sw   fxsw,fltsw
1347           b    loop
1348 cksim     mcw  x1,x3
1349           bce  err,0&x1,%
1350           mcw  dress,x2
1351           lca  gm,1&x2
1352           sbr  x2
1353           mcw  comp&3,x3
1354           lca  0&x3,0&x2
1355           sbr  x2
1356           mcw  pred,x3
1357           lca  pred,0&x2
1358           lca  blnk5-2
1359           lca  blnk5-2
1360           sbr  pred
1361           sbr  x2
1362           lca  blnk5#5,0&x2
1363           lca  @1@
1364           sbr  x2
1365           mcw  pred,6&x3
1366           bce  newcd,086,
1367 oldcd     mn   0&x2
1368           sar  dress
1369 klobr     bce  bstar,0,<                     12-6-8
1370           fquit
1371 newcd     mcw  pred,086        equiv with no dimen stmt
1372           b    oldcd
1373 bstar     bce  *&5,0&x1,)
1374           b    eqbx1
1375           sw   fxsw,fltsw
1376 eqbx1     mn   0&x1
1377           sbr  x1
1378           sbr  comp&3
1379           bce  ctu4,0&x1,,
1380           bce  bstar,0&x1,}           group mark
1381           bce  start,1&x1,}               12-7-8
1382           b    cmpsw
1383 err       cs   299
1384           mcw  x3,x1
1385           mcw  x2,hex2#3
1386           fflip0&x1,248,x1,x2,,,%
1387           mcw  hex2,x2
1388           sw   failsw
1389           mn   work,240
1390           chain2
1391           mcw  @error 6 - undefined array, statement @
1392           forms
1393           w
1394 scan2     mn   0&x1
1395           sar  x1
1396           bce  ctu4,0&x1,)
1397           fbceqsyner,0&x1,%,}               close paren, gm
1398           bce  scan2,0&x1,,
1399           bwz  scan2,0&x1,2
1400           b    syner
1401 ctu4      mn   0&x1
1402           sar  x1
1403           b    bstar
1404 isin      bce  scan2,0&x1,%
1405           b    bstar
1406 out1      sbr  a1&3,out
1407           sbr  a2&3,out
1408           sbr  find&3,notin
1409           sbr  a3&3,found
1410           mcw  dress,hex3
1411           mcw  save1#3,x1
1412           mcw  @b@,cmpsw
1413           mcw  @n@,isequ
1414           fendxc,,,svorg,start,svorg,sys1,equiv two
1415           ltorg*
1416 sys1      dcw  @}@                           system group mark
1417           xfr  initl
1418           job  1401 Fortran  equivalence phase 2                      50113
1419 110       dcw  @equiv two@
1420           org  svorg
1421 found     lca  @00000@,tally
1422           nop  000&x2
1423           mcw
1424           mcw
1425           mcw
1426           mcw
1427           sar  x2
1428           bav  *&1
1429           s    erctr#3
1430 nest      bce  nomo,001&x2,   blank
1431           a    000&x2,tally
1432           mcw  003&x2,x2
1433           a    &1,erctr
1434           bav  msg
1435           b    nest
1436 nomo      mcw  x2,tally&3
1437           bce  turn,000&x1,%
1438           a    @1@,tally
1439 fight     mcw  hex3,x3
1440           lca  champ,accum
1441           s    tally,accum
1442           bwz  chump,accum,k
1443           lca  tally&3,000&x3
1444           sbr  hex3
1445 anymo     bce  equiv,000&x1,,     comma
1446           bce  bpdwn,0&x1,)
1447           b    syner
1448 bpdwn     mn   0&x1
1449           mn
1450           sar  hex1#3
1451           mcw  hex3,x3
1452           lca  @$@,000&x3
1453           mcw  dress,x3
1454 main      bce  done,000&x3,$
1455           mcw  0&x3,hold3#3
1456           c    champ&3,hold3
1457           be   oops1
1458 gt1       mcw  0&x3,x2
1459           sar  hex3
1460           bce  *&5,0&x2,                     blank
1461           b    oops2
1462 pull1     mcw  9&x2,x1
1463 lower     mcw  006&x2,x3      after tail of new follower
1464           bce  last,x3,       blank
1465           bce  last,001&x3,   blank
1466           sbr  x2             tail of new follower
1467           b    lower
1468 last      bce  *&8,x3,        blank
1469           mcw  x1,9&x3
1470           bce  inish,x1,         blank
1471           mcw  x3,6&x1
1472 link      mcw  champ&3,x1        head of leader
1473           mcw  006&x1,006&x2
1474           mcw  6&x1,x3
1475           mcw  x2,9&x3
1476           mcw  hex3,x3
1477           mcw  003&x3,x2         head of new follower
1478           mcw  x2,006&x1
1479           mcw  x1,9&x2
1480           mcw  champ&3,003&x2
1481           mcw
1482           s    000&x3,000&x2
1483           sar  x3
1484           bw   main,errsw
1485           sw   errsw
1486           c    0&x2, save5
1487           be   isred
1488           b    qverr
1489           b    main
1490 isred     b    rdmsg
1491           b    main
1492 turn      fflip0&x1,space-1,x1,x3,,,)
1493           a    001&x3,tally
1494           b    fight
1495 chump     bce  cinch,champ,   blank
1496           lca  champ&3,000&x3
1497           sbr  hex3
1498 cinch     mcw  tally&3,champ&3
1499           b    anymo
1500 done      mcw  hex1,x1
1501           lca  @     @,champ
1502           mcw  dress,hex3
1503           bce  isequ,1&x1,,
1504           bce  start,1&x1,}                  g-m
1505           b    syner
1506 inish     mcw  x3,first
1507           b    link
1508 out       mcw  dress,x3
1509           mcw  gm, 001&x3
1510           mcm  5&x1
1511           mn
1512           mn
1513           sar  x1
1514           fendxc,gm,,xbegin,xbegin,xbegin,sys2,dimen two
1515 notin     bce  ctu3,0&x1,)
1516           sbr  x1
1517           b    notin
1518 ctu3      mn   0&x1
1519           sar  x1
1520           b    equiv
1521 oops1     mcw  0&x3, x2
1522           sar  x2
1523           c    0&x2, champ
1524           be   redun
1525           b    qverr
1526           b    gt1
1527 redun     b    rdmsg
1528           b    gt1
1529 qverr     sbr  qvxt&3
1530           ftmsg7,illegal equivalence,work,20
1531 qvxt      b    0
1532 rdmsg     sbr  rdxt&3
1533           ftmsg8,redundant equivalence,work,22
1534 rdxt      b    0
1535 msg       messg@correct errors indicated and restart@,70,l,1
1536           h    *-3
1537 oops2     mcw  0&x2, save5#5
1538           cw   errsw#1
1539           b    pull1
1540           ltorg*
1541 sys2      dcw  @}@                           system group mark
1542           xfr  start
1543           job  1401 Fortran   dimension phase two                     50123
1544           fbegndimen two,x1,,x2,r,x3,,h
1545 param     equ  parama
1546           org  xbegin
1547 tstio     bce  initl,param&10,    blank
1548           sbr  x2,aform
1549           bce  move,param&10,a
1550           sbr  x2,limio
1551           bce  move,param&10,l
1552           sbr  x2,noio
1553           bce  move,param&10,x
1554 initl     mcw  x3,083    address of table-1
1555           a    &2,param&6
1556           sw   gm
1557           lca  gm,001&x3
1558           bce  nix,086,            blank, no dimension
1559           mcw  086,x3    address of lowest array
1560 start     s    accum#6
1561           mcw  006&x3,link#3
1562           bce  leadr,001&x3,       blank
1563           mcw  003&x3,x2      address of leader in x2
1564           za   000&x3,prod
1565           m    005&x2,prod&3
1566           a    000&x2,prod&3
1567           mcw  prod&3,000&x3
1568 pack      mcw  000&x3,accum
1569           sar  x3
1570           s    &1,accum
1571           mcw  x3,x2
1572 loop3     mcm  2&x2
1573           mn
1574           mn
1575           sar  x2
1576           bce  loop3,1&x2,|
1577           mcw  0&x2,box#1
1578           mcw  box,*&8
1579           bce  fix1,@ijklmn@,0
1580           chain5
1581           a    parama&6,accum
1582 ctu3      mcw  accum,14&x3
1583           mcw  accum-3,x2
1584           a    x2
1585           mz   zones&x2,012&x3
1586           mz   zones&1&x2,014&x3
1587           za   @0@,prod
1588           mcw  000&x3,prod
1589           mcw  blank
1590           sbr  mplr&6
1591           nop  000&x3
1592           mcw
1593           sar  x2
1594           bce  nocol,000&x2,}       12-7-8, initl sets in dress&1
1595 mplr      mcw  000&x2,000
1596           m    000&x3,prod
1597 nocol     lca  @   @,008&x3
1598           mcw  x1,hold1#3
1599           mcw  14&x3,x1
1600           mcw  box,*&8
1601           bce  fixed,@ijklmn@,0
1602           chain5
1603           m    param&6,prod&3
1604           mz   @a@,007&x3
1605           mcw  param&6,010&x3
1606 bump      mz   7&x3,13&x3
1607           mcw  hold1,x1
1608           s    10&x3,accum
1609           a    prod&3,accum
1610           fpackaccum,8&x3,x2
1611           a    &1,accum
1612           s    accum,count
1613           bwz  alter,count,k
1614           a    accum,count
1615 test      bce  out,link,        blank
1616           mcw  link,x3
1617           b    start
1618 fix1      a    parama&4,accum
1619           b    ctu3
1620 leadr     mcw  count,000&x3
1621           b    pack
1622 alter     mcw  accum,count
1623           b    test
1624 fixed     m    param&4,prod&3
1625           mz   @j@,007&x3
1626           mcw  param&4,010&x3
1627           b    bump
1628 out       unpakparam&2,reloc
1629           s    count,reloc
1630           s    &1,reloc
1631           bwz  tubig,reloc,k
1632           fpackreloc,adjst,x2
1633           mcw  nxtop,conlst
1634           ma   adjst,conlst
1635           b    skipf
1636 tubig     bw   skipf,lgsw
1637           cs   332
1638           cs
1639           mlc  @message 2 - object program too large@,270
1640           w
1641           sw   failsw,lgsw
1642           s    reloc
1643 nix       mcw  param&2,conlst
1644 skipf     mcw  nxtop,086
1645 *dump array table
1646           cc   l
1647           forms
1648           cs   332
1649           cs
1650           mcw  @storage assignment-arrays & equated variables@,247
1651           w
1652           cc   j
1653           mcw  083,x3
1654 loopa     nop  10&x3
1655           mcm
1656           sar  x3
1657           cs   299
1658 tsdun     bce  nodun,0&x3,|
1659           bce
1660           mn   0&x3
1661           mn
1662           sar  x3
1663           bce  noray,0&x3,:                  5-8
1664           fflip0&x3,201,x3,x2,inc,wm
1665           c    0&x3
1666           chain3
1667           sar  x2
1668           a    reloc,5&x2
1669           ma   adjst,8&x2
1670           ma   adjst,14&x2
1671           mcs  5&x2,218
1672           mcw  8&x2,234
1673           mz   blank,233
1674           sw   220
1675           unpak8&x2,224
1676           mcw  @-@,219
1677           fpack5&x2,230,x2
1678           forms
1679           w
1680           cs   299
1681           mcm  1&x3
1682           sar  x3
1683           bce  eoj,0&x3,                     blank
1684           b    loopa
1685 nodun     mcm  0&x3
1686           sbr  x3
1687           b    tsdun
1688 noray     messg@no arrays@,9
1689 eoj       cc   l
1690           fendxe,gm,,,,,sys2,varbl1
1691 move      mcw  0&x2,nxtop
1692           mcw
1693           b    initl
1694 count     dcw  04280                         change
1695 nxtop     dsa  4279                           on
1696           dcw  04617                           reassembly
1697 aform     dsa  4616                             of
1698           dcw  02016                             object
1699 limio     dsa  2015                               time
1700           dcw  01697                               format
1701 noio      dsa  1696                                 packages
1702 reloc     dcw  00000
1703 adjst     dsa  000
1704 gm        dc   @}@                           g-m
1705 prod      dcw  #6
1706           dc   #3
1707 lgsw      dc   #1
1708 blank     dcw  #01
1709           org  *
               ltorg*    WVS: Autocoder shouldn't load incld at org
1710 sys2      dcw  @}@            system and work group mark
1711           xfr  tstio
1712           job  1401 Fortran  variables phase one                      50133
1713           fbegnvarbl 1,x1,,x2,r,x3,r,i
1714           org  xbegin
1715 * replace array names in source program with addresses,
1716 * process subscripts
1717 * mark simple variables with a delta for varbl, phase 2
1718 initl     mcw  083,x2
1719           mcw  x2,dress#3
1720           sw   gm
1721 start     bce  out,000&x1,    blank
1722           lca  000&x1,work#10
1723           sar  x1
1724           sbr  x3
1725           lca  work,000&x2
1726           sbr  x2
1727           bce  fmat,code-3,f
1728           sw   work-3
1729           mcw  code-3,*&8
1730           bce  list,@3l5up61@,0    d-char modified
1731           chain6
1732           mcw  @n@,swcha
1733           mcw  @n@,swchb
1734 * search for alpha character which might be variable name
1735 find      mcw  000&x1,box#1
1736           sar  x1
1737           bwz  find,box,2     no zone, numerics and equals
1738 swcha     nop  rtpar
1739 mdify     mcw  box,*&8
1740           bce  find,@@*-&.%),@,0      d char modified
1741           chain7
1742           bce  ckxpn,box,e     may be exponent
1743           bce  sw1,box,}       group mark
1744           mcw  2&x1,box2#1
1745           mcw  box2,*&8
1746           bce  sw1,mrkrs,0                 @*&-,#%) and gm
1747           chain8
1748           bce  sw1,code-3,d                 do stmt
1749 vserr     fmesg9,variable syntax,code,16
1750           bw   syn2r,syn2s
1751           sbr  x1,1&x1
1752           sw   errsw
1753           b    limit
1754 rtna      lca  @0?0@,0&x2                    0,12-0,0
1755           sbr  x2
1756           sbr  x3,1&x1
1757           sbr  x1
1758           b    botm
1759 sw1       sw   1&x1
1760 *shift all but variable
1761           lca  00&x3,000&x2        slide one extra char
1762           sbr  x2                  necess. if 1st char is alpha
1763           cw   001&x1
1764           sbr  x3,1&x1
1765           sbr  klobr&6,2&x1
1766           mcw  @;@                           11-6-8
1767           bce  nomo,box,}      group mark
1768           za   &1,count#2
1769 *  scan to bottom of  variable
1770 limit     mcw  000&x1,box
1771           sar  x1
1772           mcw  box,*&8
1773           bce  look,mrkrs,0                     @*&-,#%) and gm
1774           chain8
1775           a    &1,count
1776           b    limit
1777 look      bw   rtnb,ervbl
1778           bw   rtna,errsw
1779           sw   002&x1
1780           sar  hex1#3
1781 tlu       mcw  dress,x1       address of array table
1782           bce  equal,box,#    equal
1783 *determine if variable is an array name
1784 loop      bce  notin,002&x1,       blank
1785 mcm2      mcm  2&x1
1786           mn
1787           mn
1788           sar  x1
1789           bce  mcm2,1&x1,|
1790           c    000&x3,00&x1
1791           bu   loop
1792           c    000&x1,000&x3
1793           bu   loop
1794 * move x1 pointer to hi address of variable
1795           c    0&x1
1796           chain3
1797           sar  x1
1798 *   check to see if there are any subscripts
1799           bw   sbray,subsw
1800           bce  sbscr,box,%    left paren
1801 swchb     nop  array
1802 tuno      lca  9&x1,1&x2
1803           sbr  x2
1804 resto     mcw  hex1,x1
1805           b    botm
1806 array     lca  9&x1,1&x2
1807           lca  3&x1
1808           sbr  x2
1809           cw   4&x2
1810           b    resto
1811 notin     mcw  hex1,x1
1812           bw   lod2,subsw
1813           bce  rufn,box,%
1814           lca  @ _@,1&x2                     blank,delta 11-7-8
1815           sbr  x2
1816 slide     lca  000&x3,001&x2
1817           sbr  x2
1818           cw   001&x2
1819           s    &2,count
1820           bwz  load1,count,k      b-zone
1821 botm      cw   001&x1
1822           sar  x3
1823 botm2     cw   1&x2
1824           cw   fewsw,errsw
1825           cw   tusw
1826 klobr     bce  find,0,;                      11-6-8
1827           mcw  @$@,x1
1828           b    out
1829 *  if @subscripted@ variable not function then error
1830 rufn      bce  slide,1&x1,f
1831           ftmsg6,undefined array,code,16
1832           lca  @%000@,1&x2
1833           sbr  x2
1834           mz   vzone,3&x2
1835 skloz     bce  fndlz,0&x1,)
1836           bce  nomo1,0&x1,}                  gm
1837           sbr  x1
1838           b    skloz
1839 fndlz     mn   0&x1
1840           sar  x1
1841           b    botm2
1842 *  process subscripts
1843 sbscr     za   00&x1,accum#6
1844           sar  x3
1845           sw   vblsw
1846           za   000&x3,rows#5
1847           za   005&x1,wordl
1848           s    &1,accum
1849           mz   8&x1,vzone#1
1850           mcw  hex1,x1
1851           lca  @ $@,001&x2
1852           sbr  x2
1853           mn   000&x1
1854           sar  x1
1855           sbr  x3
1856 split     bwz  const,000&x1,2      no zone
1857 *  process variable suscripts
1858           sbr  x1,2&x1
1859           lca  @*1@,000&x1
1860           b    const
1861 delta     lca  @ _@,001&x2    11-7-8  delta
1862           sbr  x2
1863 feed      mcw  000&x1,box
1864           sar  x1
1865           mcw  box,*&8
1866           bce  xpand,@-&),@,0
1867           b
1868           b
1869           b
1870           b    feed
1871 xpand     sw   2&x1
1872           sw
1873           sar  hex1
1874           sw   subsw
1875           b    tlu
1876 sbray     lca  9&x1,2&x2
1877           sbr  x2
1878           cw   1&x2
1879           mn
1880           sar  x2
1881           b    ldcom
1882 lod2      lca  000&x3,001&x2
1883           lca
1884           sbr  x2
1885           cw   2&x2
1886 ldcom     mcw  hex1,x1
1887           cw   2&x1
1888           bce  load2,003&x2,_      delta  11-7-8
1889           lca  @ ,@,1&x2                     blank comma
1890           sbr  x2
1891           cw   subsw
1892           bce  putc,box,,          comma
1893           bce  phew,box,)          rt paren
1894           mz   box,wordl
1895 copy      mcw  x1,x3
1896           b    split
1897 *flip constant
1898 const     sbr  x3,verse-2
1899 turn      mcw  000&x1,box
1900           sar  x1
1901           mcw  box,002&x3
1902           sbr  x3
1903           bwz  turn,000&x1,2       no zone
1904           sbr  x1
1905           m    wordl,007&x3        switch c, since wordl modified
1906           bce  varbl,001&x1,*      asterisk
1907           a    007&x3,accum
1908           bce  phew,1&x1,)
1909           bce  putc,1&x1,,
1910           sw   syn2s
1911           b    vserr
1912 syn2r     cw   syn2s
1913           sw   ervbl
1914           b    limit
1915 rtnb      cw   ervbl
1916 *  end of process subscript
1917 phew      nop  accum-7
1918           sar  x3
1919           sw   fewsw
1920           b    norml
1921 ldolr     lca  @$@,0&x2
1922           sbr  x2
1923           mz   vzone,3&x2
1924           b    botm
1925 *  process variable subscript
1926 varbl     cw   1&x1,vblsw#1
1927           b    norml
1928           lca  @ *@,000&x2         blank, asterisk
1929           sbr  x2
1930           cw   001&x2
1931           mcw  x1,x3
1932           b    delta
1933 norml     sbr  exit&3
1934 x3and     equ  007&x3
1935 subtr     s    &16000,x3and
1936           bwz  subtr,x3and,b    ab zone
1937 add       a    &16000,x3and
1938           bwz  add,x3and,k      b zone
1939           bw   alcon,fewsw
1940 get       sbr  x3,1&x3
1941           bce  get,002&x3,0     zero
1942           sbr  x2,1&x2
1943           lca  blnk6#6
1944 twist     mcw  002&x3,box
1945           sar  x3
1946           mcw  box,000&x2
1947           sbr  x2
1948           bwz  twist,001&x3,2       no zone
1949           mz   blank,1&x2
1950 exit      b    00
1951 out       fendxc,,,,phse2p,,orgvb-1,varbl two
1952 list      mcw  @b@,swcha
1953           mcw  @b@,swchb
1954           mcw  code-3,*&8
1955           bce  tu,@1356@,0
1956           chain3
1957           b    find
1958 tu        sw   tusw
1959           b    find
1960 rtpar     bce  putb,box,)     rt paren
1961           b    mdify
1962 putb      mcw  @b@,swchb
1963           b    mdify
1964 nomo1     mn   0&x2
1965           sar  x2
1966 nomo      lca  gm,001&x2
1967           b    start
1968 equal     mcw  @n@,swchb
1969           b    loop
1970 load2     lca  blnk2,1&x2
1971           sbr  x2
1972           b    ldcom
1973 load1     lca  blank,0&x2
1974           sbr  x2
1975           cw   001&x2
1976           b    botm
1977 ckxpn     bce  sw1,2&x1,#
1978           bce  sw1,2&x1,@
1979           bwz  find,2&x1,2
1980           bce  find,2&x1,.
1981           b    sw1
1982 alcon     mcw  7&x3,hold5#5
1983           fpackhold5,work3,x3
1984           bce  *&8,2&x2,,
1985           sbr  x2,1&x2
1986           lca  work3,1&x2
1987           sbr  x2
1988           cw   1&x2
1989           mz   vzone,2&x2
1990           bw   botm,vblsw
1991           b    ldolr
1992 putc      mz   *-4,wordl
1993           m    rows,wordl&6
1994           mcm  wordl&2,wordl-4      rows*wordl in wordl %2 dimens)
1995           s    wordl,accum
1996           b    copy
1997 fmat      lca  0&x1,0&x2
1998           sbr  x2
1999           c    0&x1
2000           sar  x1
2001           b    start
2002 mrkrs     dcw  @#,}*@&-%)@                     equals,comma,gr mark
2003 syn2s     dc   #1
2004 subsw     dc   #1
2005 errsw     dc   #1
2006 verse     dcw  #1
2007           dc   #49
2008 gm        dc   @}@                             g-m
2009 kerr      dcw  @error @
2010 kvstm     dcw  @ variable, statement @
2011 wordl     dcw  #5
2012           dc   #6
2013           dc   @|@   record mark
2014 work3     dcw  #3
2015 fewsw     dc   #1
2016 tusw      dc   #1
2017 ervbl     dc   #1
2018           org  *
               ltorg*    WVS: Autocoder shouldn't load incld at org
2019 code      equ  work
2020 blank     equ  blnk6-5
2021 blnk2     equ  blnk6-4
2022           dcw  @}@                           system group mark
2023 orgvb     equ  *&1
2024           xfr  initl
2025           job  1401 fortran  variables phase two                      50143
2026 * moves the source program up to sauce and computes parameters for
2027 * the randomizer in varbl. phase 3
2028           fbegnvarbl two,x1,r,x2,,x3,r,p
2029 sauce     equ  saucek
2030           org  xbegin
2031 base      dcw  #3
2032 max       dcw  #4
2033           dc   #1
2034 uplim     dcw  #3
2035 nxbtm     equ  083
2036 phse2     mcw  nxbtm,x3
2037           bce  fquit,x1,$
2038           sbr  nomo#3,2&x3
2039           mcw  x2,x3
2040 clr1      cs   000&x3
2041           sbr  x3
2042           c    x3,&sauce-1
2043           bu   clr1
2044           sbr  x1,sauce-1
2045 *  shift source program up to compiler program
2046           movupx2,x1,nomo,all,|
2047           cw   0&x2
2048           cw
2049           sbr  base,2&x1
2050           mn   two9,base
2051           mn
2052           mcw  parama&2,x3
2053           mn   000&x3
2054           sw
2055           sar  nxbtm
2056           sbr  x3
2057 *  clear balance of core
2058 clr2      cs   000&x3
2059           sbr  x3
2060           c    x3,base
2061           bu   clr2
2062           mcw  @<@,0&x3                      12-6-8
2063 *  divide rest of core for tables   ratio 3 to 7
2064           mcw  nxbtm,loc
2065           b    unpak
2066           mcw  num#5,max&1
2067           mcw  base,loc
2068           b    unpak
2069           s    num,max&1
2070           a    max,accum#6
2071           a    accum
2072           a    max,accum       3*max in accum
2073 *  1/10 of nxbtm-base in max
2074           a    num,accum
2075           mcw  accum-3,x3
2076           a    x3
2077           mz   zones&x3,accum-2
2078           mz   zones&1&x3,accum
2079           mcw  accum,x3
2080           sw   002&x3
2081           mcw  @<@      12-6-8
2082           sbr  uplim
2083           mcw  x1,x2
2084           mn   0&x2
2085           sar  x1
2086           fendxc,,,work5j-4,phse3j,work5j,sys2,varbl tri
2087 fquit     fquit
2088 unpak     sbr  exit&3
2089           mn   loc,num
2090           mn
2091           mn
2092           mcw
2093           mz   loc,two9
2094           mz   loc-2,two9-1
2095           nop  zones-3
2096           sar  x3
2097 comp      c    004&x3,two9
2098           sar  x3
2099           a    &1,num-3
2100           bu   comp
2101           mz   blank#1,num-3
2102 exit      b    000
2103 loc       dcw  @0j   @
2104 two9      dcw  @99@
2105 zones     dc   @9@
2106           dc   @9z9r9i99zzzrziz9rzrrrir9iziriii@
2107           ltorg*
2108           ltorg*
2109 sys2      dcw  @}@                           system group mark
2110           xfr  phse2
2111           job  1401 fortran   variables  phase three                  50153
2112           fbegnvarbl tri,x1,,x2,,x3,r,j
2113 * defines variables in source program
2114           org  xbegin
2115 base      ds   3
2116 max       ds   4
2117 uplim     ds   4
2118 nxtop     equ  086
2119 nxbtm     equ  083
2120 work5     dcw  #5
2121 save2     dcw  #3
2122 phse3     messg@storage assignment - simple variables@,37,l,j
2123           mcw  @ @,saucek-1                  blank
2124           mcw  x2,save2
2125           unpaknxtop,work5
2126           fendxc,,,phse3,,phse3,saucek-1,varbl quad
2127           ltorg*
2128           dcw  @}@                           system group mark
2129           xfr  phse3
2130           job  1401 fortran   variables phase four                    50163
2131 110       dcw  @varbl quad@
2132           org  phse3
2133 begin     mcw  base,bump&3
2134           mz   @s@,bump&2
2135           sw   gm
2136           cw   isfsw
2137 start     bce  out,000&x1,                    blank
2138           mcw  000&x1,code#4
2139           lca  000&x1,work#10
2140           sar  x1
2141           sbr  x3
2142           lca  work,000&x2
2143           sbr  x2
2144           bce  pass,code-3,/                  bad statement
2145           bce  pass,code-3,f
2146           mcw  @01@,fnctr#2
2147 *  determine if in run one of run two
2148 swche     b    test
2149 find2     bce  seek,000&x1,_                  delta 11-7-8
2150           chain5
2151           bce  pass,000&x1,}       group mark
2152           chain5
2153           sbr  x1
2154           b    find2
2155 seek      bce  found,000&x1,_                 delta 11-7-8
2156           sbr  x1
2157           b    seek
2158 found     sw   001&x1
2159           cw                                  dummy
2160           cw                                  dummy
2161           cw                                  dummy
2162           sar  x1
2163           bce  copy,004&x1,}     group mk, first char may be delta
2164           lca  000&x3,000&x2
2165           sbr  x2
2166           cw   001&x2
2167 copy      sbr  x3,2&x1
2168 *  scan for ending character
2169 limit     mcw  000&x1,box#1
2170           sar  x1
2171           mcw  box,*&8
2172           bce  randm,@@}#*-&),@,0       at,12-7-8  etc
2173           chain7
2174           b    limit
2175 randm     bce  swchf,box,#      equal
2176           bce  *&5,2&x1,]                  11-5-8  funct stmt
2177           b    *&5
2178           sw   isfsw#1
2179 swcha     nop  botm
2180 *  randomizing variable name
2181 mixup     sw   002&x1
2182           za   000&x3,mod#4
2183           a    004&x1,mod
2184           mz   @    @,mod
2185           mz
2186           mz
2187           mcw                              3 digit no. in mod
2188 subtr     s    max,mod
2189           bwz  subtr,mod,b
2190           a    max,mod
2191           mz   @ @,mod                     blank
2192           mcw  x2,hex2#8
2193           mcw                              stores x1 in hex1
2194           mcw  mod,x1
2195           a    x1
2196           a    mod,x1
2197 *  get table 1 address
2198 bump      nop  000
2199           sar  x1                          tagged by A-bit
2200           mcw  @n@,ovflw
2201 chain     bce  new,000&x1,   blank  varbl not yet endountered
2202           bce  ovflw,000&x1,<   12-6-8
2203 *  see if defined already
2204           mcw  000&x1,x2
2205           sar  x1
2206           c    000&x3,000&x2
2207           bu   chain
2208           c    000&x2,000&x3
2209           sar  swchc&3
2210           bu   chain
2211 swchc     mn   0
2212           sar  send&3
2213 restr     mcw  hex2,x2
2214           mcw
2215 send      lca  000,000&x2
2216           sbr  x2
2217           cw   001&x2
2218           sbr  x3,1&x1
2219           sbr  x1
2220 gobak     b    find1     operand set to find2 for run2
2221 new       mcw  nxbtm,x2
2222           mcw  nxbtm,000&x1
2223           mcw  000&x3,000&x2
2224           sbr  x2
2225 *  check to see if there is room for address
2226           bce  full,000&x2,<                  12-6-8
2227           chain4
2228           sw   000&x3
2229           mcw  000&x3,*&8
2230           bce  fixed,@ijklmn@,0
2231           chain5
2232           mz   @A@,vzone#1
2233           bw   funst,isfsw
2234           a    parama&6,work5
2235 pack      c    work5,&16000
2236           bh   pack2
2237           bw   pack2,lgsw
2238           cs   332
2239           cs
2240           mlc  @message 2 - object program too large@,270
2241           w
2242           sw   failsw,lgsw
2243 pack2     mcw  work5,hold5#5
2244           mcw  x3,hold8#8
2245           mcw
2246           fpackhold5,nxtop,x2
2247           mcw  nxtop,adrss#3
2248 rtn2      cw   0&x3
2249           cs   299
2250           fflip0&x3,201,x3,x2,inc,wm
2251           mcw  hold8,x3
2252           mcw
2253           mcw  nxtop,227
2254           mcs  work5,219
2255           bw   swix2,isfsw
2256           w
2257           forms
2258 swix2     sw   1&x2
2259           lca  gm
2260           sbr  send&3
2261           lca  adrss
2262           sbr  nxbtm
2263           sbr  x2
2264           bce  *&5,code-3,d
2265           b    *&5
2266           cw   4&x2
2267           mz   vzone,2&x2
2268           cw   isfsw
2269           b    restr
2270 funst     mcw  fnctr,adrss
2271           mcw  @]@                          11-5-8
2272           a    &1,fnctr
2273           b    rtn2
2274 test      fbceqinput,code-3,1,5,l
2275           mcw  @b@,swcha
2276           mcw  @n@,swchb
2277           mcw  @n@,swchf
2278           mcw  @n@,swchg
2279 find1     bce  found,000&x1,_               delta   11-7-8
2280 swchb     nop  rtpar,000&x1,)               rt paren
2281 swchg     nop  dolr1,000&x1,$    dollar, a-operand also modified
2282 done      bce  pass,000&x1,}                group mark
2283           sbr  x1
2284           b    find1
2285 input     mcw  @n@,swcha
2286           mcw  @b@,swchb
2287           mcw  @m@,swchf
2288           mcw  @b@,swchg
2289           b    find1
2290 rtpar     mcw  @n@,swcha
2291           b    done
2292 swchf     nop  @b@,swchb
2293           mcw  @b@,swcha
2294           b    mixup
2295 undef     cs   299
2296           sw   failsw
2297           mcw  @error 10 - undefined variable @,230
2298           fflip0&x3,231,x3,x1,inc,wm
2299           mn   code,255
2300           mn
2301           mn
2302           mcw  @statement @
2303           w
2304           forms
2305           sbr  send&3,zeroz
2306           bwz  ckfix,231,k
2307 zna       mz   @a@,zeroz-1
2308           b    restr
2309 ckfix     sw   231
2310           mcw  231,*&8
2311           bce  zna,@opqr@,       initialized
2312           chain3
2313           mz   @k@,zeroz-1
2314           b    restr
2315 ovflw     nop  full
2316           mcw  @b@,ovflw
2317           mcw  uplim,x1
2318           b    chain
2319 dolr1     sbr  swchg&3,dolr2
2320           mcw  @b@,swcha
2321           b    done
2322 dolr2     sbr  swchg&3,dolr1
2323           mcw  @n@,swcha
2324           b    done
2325 fixed     mz   @j@,vzone
2326           bw   funst,isfsw
2327           a    parama&4,work5
2328           b    pack
2329 out       mlc  save2,x1
2330           cs   0&x2
2331           cs
2332           sbr  tclear,sys4
2333 swchd     nop  dun
2334           sw   gm
2335           mcw  @b@,swchd
2336           mcw  @)@,swchc
2337           mcw  @n@,swche
2338           mcw  @n@,swcha
2339           sbr  chain&3,undef
2340           sbr  gobak&3,find2
2341           cs   0&x2
2342           sbr  x2,1&x1
2343           sbr  save2
2344           cc   j
2345           b    start
2346 dun       bss  333,c
2347           mcw  @varblquin@,110
3448           b    montor
2349 pass      mvdwnx3,x2
2350           mcw  x3,x1
2351           b    start
2352 botm      sbr  x1,1&x1
2353           sbr  x3,1&x3
2354           b    find1
2355 full      fquit
2356 zeroz     dcw  @000@
2357 lgsw      dc   #1
2358           org  *
               ltorg*    WVS: Autocoder shouldn't load incld at org
2359 gm        dc   @}@                 g-m
2360           dc   @     @      space for fancy scan
2361 sys4      dcw  @}@          work and system group mark
2362           xfr  begin
2363           job  1401 fortran   variables phase five                    50173
2364 110       dcw  @varbl quin@
2365           org  phse3
2366 ckref     cc   j
2367           mcw  x1,keep2#3
2368           mcw  parama&2,x2
2369 scan      bce  isgm,0&x2,}                   12-7-8
2370           sbr  x2
2371           c    x2,nxbtm
2372           bu   scan
2373           mcw  keep2,x1
2374           fendxd,,,xbegin,xbegin,xbegin,saucek-2,const one
2375 isgm      bw   unref,0&x2
2376           mn   0&x2
2377           sbr  x2
2378           b    scan
2379 unref     cs   299
2380           mcw  @error 11 - unreferenced variable @,233
2381           mcw  x2,x3
2382 nopr      nop  1&x3
2383           sar  x3
2384           bw   flip,2&x3
2385           b    nopr
2386 flip      fflip1&x3,234,x3,x1,incl,wm
2387           w
2388           forms
2389           mn   0&x2
2390           sar  x2
2391           b    scan
2392           ltorg*
2393           dcw  @}@                      system group mark
2394           xfr  ckref
2395           job  1401 fortran   constant phase one                      50183
2396           fbegnconst one,x1,,x2,r,x3,r,k
2397           org  xbegin
2398 track     equ  200
2399 nxbtm     equ  083
2400 initl     cs   track&99
2401           sw   gm
2402           sw   track
2403           mcw  parama&2,x2
2404           mn   000&x2
2405           mn
2406           sar  x2
2407           sbr  nxbtm
2408           lca  gm, 1&x2
2409 start     bce  out,000&x1,    blank
2410           mcw  000&x1,code#4
2411           lca  000&x1,work#10
2412           sar  x1
2413           sbr  hex3#3
2414           sbr  kill#3,0&x2
2415           lca  work,000&x2
2416           sbr  x2
2417           mcw  code-3,*&8
2418           bce  tryit,@upl3165der@,0
2419           chain9
2420           mvdwnx1,x2
2421           b    start
2422 tryit     sbr  x3,table-4
2423           mcw  code-3,scan&7
2424 scan      bce  setup,004&x3,0      d-char modified
2425           sbr  x3
2426           b    scan
2427 setup     mcw  006&x3,cntrl#2
2428           mcw  cntrl-1,test2&7
2429 test1     bce  guts,cntrl,2
2430           a    @1@,cntrl
2431 test2     bce  bump1,0&x1,0
2432           bce  guts,0&x1,}                   gm
2433           sbr  x1
2434           b    test2
2435 bump1     mn   0&x1
2436           sar  x1
2437           b    test1
2438 guts      bwz  maybe,000&x1,3   number,equal sign,word mk
2439           sbr  x1
2440           bce  subsc,1&x1,$
2441           b    guts
2442 maybe     bce  pass,000&x1,}       12-7-8
2443           sbr  x1
2444           bce  guts,001&x1,#
2445           bce  guts,1&x1,@
2446           mcw  002&x1,box&1
2447           mcw
2448           mcw
2449           sar  x1
2450           mcw  box&1,*&8
2451           bce  rucon,@)}@.#%$,*-&@,0         rt paren,group mark
2452           chain10
2453           bce  pass,1&x1,}                   gm
2454 bmpx1     sbr  x1,1&x1
2455           b    guts
2456 subsc     nop  sub2
2457           mcw  @b@,subsc
2458           mcw  blank,subsw&4
2459           b    guts
2460 sub2      mcw  @n@,subsc
2461           mcw  @/@,subsw&4
2462           b    guts
2463 rucon     bce  bakup,3&x1,.
2464           mcw  box-1,*&8
2465           bce  bmpx1,@?abcdefghi!jklmnopqr@,0      &zero,- zero
2466           chain19
2467           bce  ckif,3&x1,)
2468 set       sw   003&x1
2469           mcw  hex3,x3
2470           lca  000&x3,000&x2
2471           sbr  x2
2472           mcw  @<@,3&x1                         12-6-8
2473           sbr  klobr&6,3&x1
2474           cw   001&x2
2475           lca  @_@,000&x2          11-7-8
2476           sbr  x2
2477           cw   001&x2
2478           cw   oddsw
2479           s    xpont#2
2480           s    count#3
2481           s    total
2482           mcw  @,@,stodd
2483           mcw  @n@,swchx
2484           mcw  @b@,swchz
2485           sbr  swcha&3,a
2486           sbr  swchs&3,s
2487           sbr  x1,2&x1
2488 norml     mcw  000&x1,box
2489           sar  x1
2490 swchx     nop  &1,xpont
2491           a    &1,total#3
2492 swchz     bce  norml,box,0     passes by leading zeros
2493           bce  swchs,box,.
2494           bce  swcha,swchz,b      branches on first signif char
2495           a    &1,count
2496 test      bce  cnlft,box,#
2497           bce  *&9,box,@
2498           bwz  norml,box,2    no zone
2499 cr        c    swcha&3,nopad
2500 *  decimal point sends the address of nop to swcha&3
2501 *  cannot use address constant
2502           bu   fixed
2503           bwz  mark,xpont,b
2504           a    &1,xpont
2505 mark      sw   002&x1
2506           bce  oddbl,2&x1,.
2507 cktal     bce  tail,box,e
2508 float     c    total,&01
2509           nop  syntx
2510           nop
2511           c    count,&000
2512           bu   rtlft
2513 ldzer     lca  @?0?@,0&x2          12-0,0,12-0
2414           sbr  x2
2515           cw   001&x2
2516           b    botm2
2517 rtlft     mcw  x1,hex1#3
2518           bw   *&8,oddsw
2519           lca  000&x3,001&x3
2520           mcw  right#3,x1
2521           mcw  parama&6,presz#2
2522           a    &2,presz
2523           sbr  x3,track-2
2524           sw   track
2525 twist     mcw  000&x1,box
2526           sar  x1
2527           mcw  box,002&x3
2528           sbr  x3
2529           bwz  phew,001&x1,1       word mark
2530           s    &1,presz
2531           c    presz,&00
2532           bu   twist
2533 phew      sbr  x3,1&x3
2534 phew1     bce  *&5,0&x3,0
2535           b    xeunt
2536           mn   0&x3
2537           sar  x3
2538           b    phew1
2539 xeunt     mn   0&x3
2540           sar  x3
2541           mcw  xpont,3&x3
2542           mz   @a@,1&x3
2543           lca  003&x3,000&x2
2544           sbr  x2
2545           b    botm
2546 cnlft     cs   332
2547           cs
2548           sw   failsw
2549           mn   code,256
2550           chain2
2551           mcw  @equal sign, statement @
2552           mcw  @error 41 - constant left side of @
2553           w
2554           forms
2555           mcw  kill,x2
2556           mcw  blank#1,0&x2
2557           c    0&x1
2558           sar  x1
2559           b    start
2560 syntx     ftmsg44,constant syntax,code,17
2561           b    ldzer
2562 oddbl     mcw  @0@,2&x1
2563           sw   oddsw#1
2564           b    cktal
2565 tail      za   &0,bump#2
2566           bwz  flip,000&x1,2       no zone
2567           mz   000&x1,bump
2568 *                            zone respectively
2569           sar  x1
2570 flip      mn   000&x1
2571           sar  x1
2572           c    0&x1,@z@
2573           bl   units               numeric, two digit expon
2574           mn   001&x1,bump
2575           b    bumpr
2576 units     mn   001&x1,bump-1
2577           mn   000&x1,bump
2578           sar  x1
2579 bumpr     a    bump,xpont
2580           mn   0&x1
2581           sar  x1
2582           b    float
2583 fixed     c    count,&000
2584           bu   lftrt
2585           lca  @ 0@,000&x2      blank, zero
2586           sbr  x2
2587           cw   001&x2
2588           b    botm2
2589 lftrt     mcw  x1,hex1
2590           mcw  right,x3
2591           sw   0&x3
2592           sbr  x3,track&99
2593           mcw  parama&4,presz
2594 turn      mcw  002&x1,box
2595           sar  x1
2596           mcw  box,000&x3
2597           sbr  x3
2598           bwz  wow,001&x1,1       word mark
2599           s    &1,presz
2600           c    presz,&00
2601 subsw     bu   turn
2602 wow       sw   001&x3
2603           lca  track&99,000&x2
2604           sbr  x2
2605           cw   001&x3
2606           c    count,&001
2607           bu   botm
2608           cw   001&x2
2609           lca  @ @,000&x2     blank
2610           sbr  x2
2611 botm      cw   001&x2
2612           mcw  hex1,x1
2613 botm2     sbr  x1,1&x1
2614           sbr  hex3
2615 klobr     bce  guts,0,<                      12-6-8
2616           fquit
2617 out       fendxc,gm,,,phse2o,,sys1,const two
2618 ckif      bce  pass,code-3,e
2619           b    set
2620 pass      mcw  hex3,x3
2621           mvdwnx3,x2
2622           mcw  x3,x1
2623           b    start
2624 bakup     sbr  x1,1&x1
2625           b    set
2626 swchs     mcw  @s@,swchx
2627           mcw  nopad,swcha&3
2628           mcw  x1,x3
2629 stodd     sw   oddsw
2630           b    norml
2631 swcha     mcw  @a@,swchx
2632           mcw  nopad,swchs&3
2633           mcw  @n@,swchz
2634           sbr  right,1&x1
2635           mcw  @n@,stodd
2636           b    test
2637 table     equ  *&1
2638           dcw  @r 2e 2d#1l,15,0u,1p,16,01,13,1@
2639 a         dcw  @a@
2640 s         dcw  @s@
2641 nopad     dcw  &@n@
2642           dcw  @ @         blank
2643 box       dcw  @ @      blank
2644           dcw  @ @     blank
2645 gm        dc   @}@                          group mark
2646           ltorg*
2647 sys1      dcw  @}@                           system group mark
2648           org  *&x00
2649 sauce     equ  *&1
2650           xfr  initl
2651           job  1401 fortran  constant phase two                       50193
2652           fbegnconst two,x1,r,x2,,x3,r,o
2653           org  xbegin
2654 nxbtm     equ  083
2655 nomo      equ  parama&2
2656 base      dcw  #3
2657 max       dcw  #4
2658           dc   #1
2659 uplim     dcw  #3
2660 phse2     mcw  x2, x3
2661           sw   gm2
2662 clr1      cs   000&x3
2663           sbr  x3
2664           c    x3,&sauce-1
2665           bu   clr1
2666           sbr  x1,sauce-1
2667 *  shift source program up to compiler program
2668           movupx2,x1,nomo,all,|
2669           cw   0&x2
2670           cw
2671           sbr  base,1&x1
2672           mn   two9,base
2673           mn
2674           mcw  nxbtm,x3
2675 *  clear balance of core
2676 clr2      cs   000&x3
2677           sbr  x3
2678           c    x3,base
2679           bu   clr2
2680           mcw  @<@,0&x3                    12-6-8
2681 *  divide rest of core for tables   ratio 3 to 7
2682           mcw  nxbtm,loc
2683           b    unpak
2684           mcw  num#5,max&1
2685           mcw  base,loc
2686           b    unpak
2687           s    num,max&1
2688           a    max,accum#6
2689           a    accum
2690           a    max,accum       3*max in accum
2691 * 1/10 of nxbtm-base in max
2692           a    num,accum
2693           mcw  accum-3,x3
2694           a    x3
2695           mz   zon19&x3,accum-2
2696           mz   zon19&1&x3,accum
2697           mcw  accum,x3
2698           sw   002&x3
2699           mcw  @<@      12-6-8
2700           sbr  uplim
2701           mcw  x1,x2
2702           mn   0&x2
2703           sar  x1
2704           mcw  nxbtm,x3
2705           lca  gm2,1&x3
2706           cs   299
2707           mcw  parama&6,x3
2708           mcw  @0@
2709           sw   200
2710           mcw  nxbtm,ldflt&6
2711 ldflt     lca  199&x3,0
2712           sbr  nxbtm
2713           sbr  lodx&6
2714           mn   parama&4,x3
2715           mn
2716 lodx      lca  199&x3,0
2717           sbr  x3
2718           sbr  oneadr
2719           lca  @1@,0&x3
2720           sbr  xexpon
2721           lca  @a0?@               0,12-0
2722           sbr  nxbtm
2723           fendxc,gm2,,phse2,,phse2,sys2,const tri
2724 unpak     sbr  exit&3
2725           mn   loc,num
2726           mn
2727           mn
2728           mcw
2729           mz   loc,two9
2730           mz   loc-2,two9-1
2731           nop  zon19-3
2732           sar  x3
2733 comp      c    004&x3,two9
2734           sar  x3
2735           a    &1,num-3
2736           bu   comp
2737           mz   @ @,num-3
2738 exit      b    000
2739 loc       dcw  @0j   @
2740 two9      dcw  @99@
2741 gm2       dc   @}@
2742 zon19     dc   @9@
2743           dc   @9z9r9i99zzzrziz9rzrrrir9iziriii@
2744           ltorg*
2745 sys2      dcw  @}@                           system group mark
2746           xfr  phse2
2747           job  1401 fortran  constant phase three                     50203
2748 110       dcw  @const tri@
2749           org  phse2
2750 * defines normalized constants in sauce
2751 *              calculating amount by which object time addresses of
2752 *              constants, formats, and lists must be reduced
2753 *              (via MA instructions)  because of array storage
2754 *              plusdf is used in phases 24,26&50
2755 *              macfls is used in phases 20,24,25,26,&50
2756 phse3     unpakparama&2,wk5
2757           mcw  x2,savx2#3         save x2
2758           unpakconlst,cnls5
2759           s    cnls5#5,wk5#5
2760           c    @0000?@,wk5                  plus zero
2761           be   rsx2
2762           fpackwk5,plusdf,x2
2763           mcw  @16000@,mcfl5#5
2764           s    wk5,mcfl5
2765           fpackmcfl5,macfls,x2
2766 rsx2      mcw  savx2,x2            restore x2
2767           ma   macfls,oneadr
2768           ma   macfls,xexpon
2769           mcw  base,bump&3
2770           mz   @s@,bump&2
2771           mcw  x2,hex1#3
2772           mcw  @ @,sauce-1    blank, may not be necessary
2773 start     bce  out,000&x1,    blank
2774           mcw  000&x1,code#4
2775           lca  000&x1,work#10
2776           sar  x1
2777           sbr  x3
2778           lca  work,000&x2
2779           sbr  x2
2780           bce  pass,code-3,/
2781 find      bce  seek,000&x1,_       delta   11-7-8
2782           chain5
2783           bce  pass,000&x1,}       group mark
2784           chain5
2785           sbr  x1
2786           b    find
2787 seek      bce  found,000&x1,_      delta   11-7-8
2788           sbr  x1
2789           b    seek
2790 found     sw   001&x1
2791           cw
2792           cw
2793           cw
2794           sar  x1
2795           bce  copy, 004&x1,}      group mk, first char may be dlta
2796           lca  000&x3,000&x2
2797           sbr  x2
2798           cw   001&x2
2799 copy      sbr  x3,2&x1
2800 limit     mcw  000&x1,box#1
2801           sar  x1
2802           mcw  box,*&8
2803           bce  randm,@#}@*-&)$,@,0             equal, gm
2804           chain8
2805           b    limit
2806 randm     sw   002&x1
2807           za   000&x3,mod#4
2808           a    004&x1,mod
2809           bce  squoz,002&x1,        blank, 1 char fixed pt. num
2810 strip     mz   @    @,mod
2811           mz
2812           mz
2813           mcw            3 digit no. in mod
2814 subtr     s    max,mod
2815           bwz  subtr,mod,b
2816           a    max,mod
2817           mz   @ @,mod        blank
2818           mcw  x2,hex2#8
2819           mcw                 stores x1
2820           mcw  mod,x1
2821           a    x1
2822           a    mod,x1
2823 bump      nop  000       base & 3*mod in x1, table 1 entry address
2824           sar  x1
2825           mcw  @n@,ovflw
2826 chain     bce  new,000&x1,    blank, const not yet encountered
2827           bce  ovflw,000&x1,<      12-6-8
2828           mcw  000&x1,x2
2829           sar  x1
2830           c    000&x3,000&x2
2831           bu   chain
2832           c    000&x2,000&x3
2833           bu   chain
2834 restr     mcw  x2,temp#3
2835           mcw  temp,temp2    compute correct constant addrs. before
2836           ma   macfls,temp   putting them in arithmetic strings.
2837           mcw  hex2,x2
2838           mcw
2839           lca  temp,0&x2
2840           sbr  x2
2841           cw   001&x2
2842           mcw  temp2#3,*&7
2843           bwz  fixed,0,2
2844           mz   @ @,002&x2                    blank
2845 botm      sbr  x1,1&x1
2846           sbr  x3
2847           b    find
2848 new       mcw  nxbtm,x2
2849           mcw  nxbtm,000&x1
2850           mcw  000&x3,000&x2
2851           sbr  x1
2852           sbr  nxbtm
2853           bce  full,000&x1,<      12-6-8
2854           sw   001&x1
2855           b    restr
2856 ovflw     nop  full
2857           mcw  @s@,ovflw
2858           mcw  uplim,x1
2859           b    chain
2860 fixed     mz   *-6,2&x2
2861           b    botm
2862 squoz     sw   003&x1
2863           b    strip
2864 full      fquit
2865 pass      mvdwnx3,x2
2866           mcw  x3,x1
2867           b    start
2868 out       mcw  hex1,x1
2869           cs   332
2870           cs
2871           mcw  @constants located from @,223
2872           unpaknxbtm,wk51
2873           s    wk5,wk51
2874           mz   @ @,wk51            remove sign
2875           a    &1,wk51#5
2876           mcw  nxbtm,x3
2877           ma   macfls,x3
2878           sbr  x3,1&x3
2879           mcw  conlst,247
2880           mcw  @-@
2881           mcw  x3
2882           mcw  @   @
2883           mcw  cnls5
2884           mcw  @ to @
2885           mcw  wk51
2886           cc   j
2887           w
2888           cc   j
2889           forms
2890           fendxd,,,xbegin,xbegin,xbegin,sauce-2,subscr
2891           org  *
               ltorg*    WVS: Autocoder shouldn't load incld at org
2892           dcw  @}@                           system group mark
2893           org  tamaxt&x00
2894 sauce     equ  *&1
2895           xfr  phse3
2896           job  1401 fortran  subscripts phase                         50213
2897           fbegnsubscr,x1,,x2,,x3,r,w
2898           org  xbegin
2899 *  squeeze addresses between $ signs together, error check
2900 initl     cs   0&x2
2901           cs
2902           sbr  x2,1&x1
2903           sbr  hex1#3
2904 start     bce  out,000&x1,      blank
2905           mcw  000&x1,code#4
2906           b    slide          x2 initially greater than x1
2907           bce  pass,code-3,/
2908           bce  pass,code-3,f
2909 find      bce  seek,000&x1,$
2910           chain5
2911           bwz  fnish,000&x1,1      word mk
2912           chain5
2913           sbr  x1
2914           b    find
2915 seek      bce  found,000&x1,$
2916           sbr  x1
2917           b    seek
2918 found     sw   000&x1
2919           b    send
2920           mn   000&x1
2921           sar  x1
2922           b    drop4
2923 squoz     sw   2&x1
2924           b    send
2925           b    drop4
2926           bwz  cpar,3&x1,s
2927           bwz  cpar,3&x1,k
2928           ftmsg12,floating point subscript,code,26
2929 cpar      sw   2&x1
2930           b    send
2931           b    drop4
2932           c    001&x1,@$@
2933           bu   squoz
2934           sw   001&x1
2935           b    send
2936           mcw  x1,x3
2937           b    find
2938 slide     sbr  exsld&3
2939           mvdwnx1,x2
2940           mcw  x1,x3
2941 exsld     b    000
2942 drop4     sbr  exdrp&3
2943           mcw  x1,x3
2944           mn   0&x1
2945           chain3
2946           sbr  x1
2947 exdrp     b    000
2948 fnish     mcw  x3,x1
2949 pass      b    slide
2950           b    start
2951 out       mcw  hex1,x1
2952           fendxc,,,,,,sys1,stnum one
2953 send      sbr  exsnd&3
2954           lca  000&x3,000&x2
2955           sbr  x2
2956           cw   001&x2
2957 exsnd     b    000
2958           ltorg*
2959 sys1      dcw  @}@                           system group mark
2960           xfr  initl
2961           job  1401 Fortran   statement number phase one              50223
2962           fbegnstnum one,x1,,x2,,x3,r,m
2963           org  xbegin
2964 nxbtm     equ  083
2965 initl     cs   0&x2
2966           mcw  nxbtm,x2
2967           sw   gm               from the bottom
2968           lca  gm,000&x2
2969           sbr  x2
2970 start     bce  out,000&x1,       blank
2971           lca  000&x1,work1#10
2972           sar  x1
2973           cw   001&x1
2974           sw   work1-3
2975           lca  work1,000&x2
2976           sbr  x2
2977           cw   001&x2
2978           bwz  label,work1-4,2        no zone
2979 top       lca  gm,000&x2
2980           sbr  x2
2981           mcw  work1-3,test&7
2982 test      bce  worry,@wt65upldegk@,0
2983           chain10
2984           bce  kill,work1-3,/
2985 botm      mvdwnx1,x2
2986           b    start
2987 kill      c    0&x1
2988           sar  x1
2989           mcm  4&x2
2990           mn
2991           mn
2992           sar  x2
2993           b    start
2994 label     lca  work1-4,state#6
2995           sbr  x3
2996           sw   002&x3
2997           b    alpha
2998           b    top
2999 worry     b    ifexp,work1-3,e
3000           bce  do,work1-3,d
3001           bce  inout,work1-3,5
3002           bce  inout,work1-3,6
3003           bce  pute,work1-3,t
3004           bce  sense,work1-3,w
3005           bce  sense,work1-3,k
3006           b    grab1
3007           b    botm
3008 pute      b    grab1
3009           bce  over,000&x1,)        rt paren
3010           bce  syner,0&x1,}                   gm
3011           sbr  x1
3012           b    pute
3013 over      mn   000&x1
3014           sar  x1
3015           b    botm
3016 inout     mcw  x1,load&3
3017 find      bce  tpnam,000&x1,,       comma
3018           bce  syner,0&x1,}                   gm
3019           sbr  x1
3020           b    find
3021 tpnam     sw   001&x1
3022           mn
3023           sar  x1
3024           b    grab1
3025 load      lca  000,000&x2
3026           sbr  x2
3027           cw   001&x2
3028           b    botm
3029 sense     mcw  x1,load&3
3030 find2     bce  witch,000&x1,)       rt paren
3031           bce  syner,0&x1,}                   gm
3032           sbr  x1
3033           b    find2
3034 witch     sw   001&x1
3035           mn
3036           sar  x1
3037           b    grab1
3038           mn   000&x1
3039           sar  x1
3040           bce  syner,0&x1,}                   gm
3041           b    grab1
3042 comma     lca  @,@,000&x2
3043           sbr  x2
3044           cw   001&x2
3045           b    load
3046 do        mcw  x1,x3
3047 varbl     bce  back2,0&x3,#
3048           sbr  x3
3049           b    varbl
3050 back2     mcw  3&x3,svzn#1
3051           mcw  @,@,3&x3
3052           sbr  hex3#3,3&x3
3053           b    grab1
3054           c    hex3,x1
3055           bu   syner
3056           mcw  svzn,0&x1
3057           lca  @,@,000&x2
3058           sbr  x2
3059           cw   001&x2
3060           b    botm
3061 ifexp     mcw  x1,load&3
3062 rtpar     bce  nozo,000&x1,)
3063           bce  syner,0&x1,}                   gm
3064           sbr  x1
3065           b    rtpar
3066 nozo      mn   000&x1
3067           sar  x1
3068           bwz  yeah,000&x1,2        no zone
3069           b    rtpar
3070 yeah      bce  rtpar,0&x1,@
3071           sw   1&x1
3072           b    grab1
3073           mn   000&x1
3074           sar  x1
3075           bce  syner,0&x1,}                   gm
3076           b    grab1
3077           mn   000&x1
3078           sar  x1
3079           bce  syner,0&x1,}                   gm
3080           b    grab1
3081           b    comma
3082 grab1     sbr  exit2&3
3083           mcw  x1,take&3
3084           bwz  loop,000&x1,2        no zone
3085           b    badst
3086 loop      mn   000&x1
3087           sar  x1
3088           bwz  loop,000&x1,2         no zone
3089           fbceqsetwm,0&x1,,,},)                 comma,gm
3090           b    badst
3091 setwm     sw   1&x1
3092 take      lca  000,state
3093           cw   001&x1
3094           b    alpha
3095 exit2     b    000
3096 alpha     sbr  exit1&3
3097           lca  six0,place
3098           c    six0,state
3099           bu   norm
3100           b    set3
3101 norm      sbr  x3,state&1
3102 zero      mn   000&x3
3103           sar  x3
3104           bce  zero,000&x3,0
3105           mcw  000&x3,place
3106           mcw  @1@
3107 set3      sw   place-1
3108           cw
3109           sw
3110           cw
3111           sw
3112           s    @5050@,place
3113           s
3114           bwz  try2,place,k        b-bit
3115           a    @1@,place-5
3116 try2      bwz  strip,place-2,k     b-bit
3117           a    @2@,place-5
3118 strip     mz   @z z z @,place      set up for gener
3119           chain5
3120           mcw  x1,hex1
3121           mcw  &table-49,x1
3122           mcw  &place,x3
3123 cool      mcw  000&x3,gener&3
3124           sar  x3
3125 gener     mcw  000,box    modified and indexed by x1
3126           lca  box,000&x2
3127           sbr  x2
3128           cw   001&x2
3129           bwz  cool,000&x3,2  no zone
3130           mcw  hex1,x1
3131 exit1     b    000
3132 syner     ftmsg13,statement number syntax,work1,25
3133           bw   pmov,badsw
3134           b    err
3135 badst     sw   badsw
3136           b    syner
3137 pmov      mcm  1&x2
3138           mn
3139           sar  x2
3140           bce  pmov,0&x2,|
3141           cw   badsw
3142 err       mcm  4&x2
3143           mn
3144           mn
3145           sar  x2
3146           c    0&x1
3147           sar  x1
3148           b    start
3149 out       fendxc,,,,tamrof,,tamr1t,tamrof one
3150           dcw  @ @
3151 gm        dc   @}@                           g-m
3152           dc   @.@
3153 place     dcw  @      @
3154 box       dcw  @ @
3155 hex1      dcw  @   @
3156 badsw     dc   #1
3157 table     dc   @.")&$*-%#@?abcdefghi!jklmnopqr_/stuvwxyz0123456789@
3158           dc   @.@
3159 six0      dcw  @000000@
3160 *              & is 12-0 punch, - 11-0 punch   .,0-7-8  r,11-7-8
3161 *              no comma, record mark, or group mark in table
3162           ltorg*
3163           dcw  @}@                           system group mark
3164           xfr  initl
3165           job  1401 Fortran   tamrof phase one  format specs          50233
3166           fbegntamrof one,x1,r,x2,,x3,r,t,xxx
3167 *
3168 nxbtm     equ  83
3169 *
3170           org  xbegin
3171 klobr     fquit
3172 ckbit     dcw  @;@   11-6-8
3173 hex3      dcw  #3
3174 code      dcw  #4
3175 *                                          error message routine
3176 *
3177 error     equ  206
3178 prntn     equ  250
3179 *
3180 getst     sbr  gstxt&3
3181           forms
3182           cs   332
3183           cs
3184           sw   failsw
3185           mn   code,prntn
3186           chain2
3187           mcw  @statement  @
3188           mcw  @error@, error-1
3189 gstxt     b    xxx
3190 *
3191           ltorg*
3192 *
3193 tamrof    cs   1&x2
3194           sbr  x1
3195           sw   gm1
3196 clr       cs   0&x1
3197           sbr  x1
3198           c    x1, &tamr1
3199           bu   clr
3200           lca  gm1, tamax&1
3201           sbr  x1, tamax&2
3202           sbr  x2, 2&x2
3203           mcw  @.@, 96
3204           sw   iosw#1
3205 chknd     mcw  nxbtm, x3
3206           sbr  x3, 1&x3
3207           c    x3,x2
3208           be   fini
3209           cw   dblsw#1
3210           mn   0&x2
3211           sar  x3
3212           mcw  ckbit
3213 mvup2     movupx2,x1,,,|
3214           bw   both,dblsw
3215           sw   dblsw
3216           b    mvup2
3217 both      mn   0&x1
3218           mn
3219           sar  x3
3220           sbr  mkfmt&6
3221           mcw  0&x3, code
3222           sar  x3
3223           b    ckfmt, code-3, f
3224           mcw  code-3, *&8
3225           bce  yesio, @56ulp@, x
3226           chain4
3227           b    chknd
3228 fini      mn   0&x1
3229           mn
3230           sar  x1
3231           mcw  lstio, x2
3232           mcw  nxbtm, x3
3233           mcw  @ @, 0&x3
3234           mcw  0&x3
3235           mcw  ckbit, 0&x3
3236           fendxc,gm1,,tamrof,,tamrof,tamax,tamrof 2
3237 *
3238 yesio     mz   @a@, 3&x3
3239           cw   iosw
3240           mn   0&x1
3241           mn
3242           sar  lstio#3
3243           b    chknd
3244 *
3245 ckfmt     mcw  @ @, 96
3246           bw   unref, iosw
3247           bce  unref, 0&x3,}       gmwm
3248           mcw  0&x3, fbox#3
3249           mcw  lstio, x3
3250 ruio      bwz  iotyp, 0&x3, b
3251           bwz
3252 unref     ftmsg14,unreferenced format,code,21,nofail
3253 mkfmt     mz   @a@, xxx
3254           b    chknd
3255 iotyp     c    0&x3
3256           sar  x3
3257           c    0&x3, fbox
3258           be   chknd
3259           c    0&x3
3260           sar  x3
3261           b    ruio
3262 *
3263           ltorg*
3264 gm1       dcw  @}@                            system and work gm
3265           org  *&x00
3266 tamr1     equ  *
3267           xfr  tamrof
3268           job  1401 Fortran   tamrof two                              50243
3269 110       dcw  @tamrof 2@
3270 *
3271 xl2       equ  x2
3272 xl3       equ  x3
3273           org  tamrof
3274 *
3275 phse2     bce  end2, 96, .
3276           mcw  x2, iobgn&6
3277 retrn     sbr  x2, 2&x1
3278           lca  @ @
3279           mcw  0&x1, code
3280           bce  mor, code-3, f
3281 end2      fendxc,gm2,,xbegin,phse1x,xbegin,sys2,listr1
3282 mor       c    0&x1
3283           sar  x1
3284           sbr  compl&6
3285           mcw  4&x1, fmtno#3
3286           sw   sw1#1
3287           cw   parsw#1
3288           za   &1, nctr
3289           bce  ersig, 0&x1, )     q. first char right paren
3290           mcw  x2,scnbx#3
3291           b    bgin
3292 *
3293 compl     sbr  x1, xxx
3294 setn      za   &1, nctr#3
3295 comrt     bce  rtpar,0&x1, )
3296           sbr  compl&6
3297           bce  lfpar, 0&x1,%
3298           fbceqarit, 0&x1,i,f,e
3299           bce  arit,0&x1,a
3300           fbceqpget, 0&x1, &,-
3301           bce  slash,0&x1,@
3302           c    0&x1, @z@
3303           bl   mv2n
3304           bl   putn
3305           bw   ersig, sw1
3306           bce  hnot, 0&x1, h
3307           sbr  x1
3308           bce  xnot, 1&x1, x
3309           bce  pnot, 1&x1, p
3310 *
3311 ersig     b    getst
3312           mcw  @15 - format syntax@,error&17
3313 errwt     w
3314           mz   @a@,code
3315           b    finis
3316 *
3317 xnot      sw   8&x2
3318           sbr  x2
3319           lca  kx
3320           mn   nctr, 0&x2
3321           mn
3322           mn
3323           b    mknd
3324 *
3325 hnot      sw   5&x2
3326           cw
3327           sbr  x2
3328           lca  kh, 1&x2
3329           s    &1, nctr
3330           bm   ersig, nctr
3331           mn   0&x1
3332           sar  x1
3333 flip      mn   0&x1, 2&x2
3334           sbr  x2
3335           mz   0&x1, 1&x2
3336           sar  x1
3337           sbr  compl&6
3338           cw   2&x2
3339           s    &1, nctr
3340           bce  hlerr,0&x1,}          gm
3341           bwz  flip, nctr, b
3342 bx2b2     sbr  x2,1&x2
3343           b    mknd
3344 hlerr     b    getst
3345           mcw  @45 - hollerith count@,error &25
3346           w    bx2b2
3347 *
3348 pget      mz   0&x1, nctr
3349           sar  x1
3350           b    mv2n
3351           c    x3,@020@
3352           bl   ersig
3353           mn   x3, nctr
3354           mn
3355           c    0&x1, @p@
3356           sar  compl&6
3357           sbr  x1
3358           bu   ersig
3359 *
3360 pnot      sbr  x2, 7&x2
3361           lca  nctr
3362           lca  kp
3363           b    mknd
3364 *
3365 lfpar     bw   parer, parsw
3366           sw   parsw
3367 bgin      sw   8&x2
3368           sbr  x2
3369           cw   urfsw
3370           lca  nctr,0&x2
3371           lca  kleft
3372 set1      sw   sw1
3373           b    compl
3374 *
3375 rtpar     mn   0&x1
3376           sar  compl&6
3377           sbr  *&7
3378           bce  eostm, xxx, }     gmwm
3379           bw   parok, parsw
3380 parer     b    getst
3381           mcw  @16 - parenthesis error@,error&22
3382           b    errwt
3383 *
3384 parok     cw   parsw
3385           sw   5&x2
3386           sbr  x2
3387           lca  krite
3388           mn   0&x1
3389           sar  x1
3390           b    mknd
3391 *
3392 eostm     cw   5&x2
3393           sbr  x2
3394           lca  keoj
3395           bw   parer, parsw
3396           b    finis
3397 *
3398 slash     bw   *&5,sw1
3399           b    ersig
3400           sw   5&x2
3401           sbr  x2
3402           lca  kline
3403           b    compl
3404 *
3405 arit      sw   5&x2
3406           lca  karit
3407 mvrpt     lca  nctr,8&x2
3408           mcw  0&x1
3409           sar  x1
3410           b    mv2n
3411           za   xl3, wctr#3
3412           sw   iexit&4
3413           bce  clri, 5&x2, f
3314           fbceqnosub, 5&x2, i, a
3315           s    &4, wctr
3316 clri      cw   iexit&4
3417           c    0&x1, @.@
3418           sar  x1
3419           bu   ersig
3420           b    mv2n
3421           s    xl3, wctr
3422           bm   einpt,wctr
3423 nosub     bce  *&8, 5&x2, f
3424           a    &4, x3
3425 here      sbr  x2,11&x2
3426           mz   *-4,wctr
3427           lca  wctr,0&x2
3428 iexit     bce  ckzro, *-7, c
3429           sbr  xl2, 3&x2
3430           lca  xl3
3431 ckzro     bm   ersig,wctr
3432 mknd      sw   sw1
3433 lk4cm     c    0&x1,@,@
3434           sar  compl&6
3435           sbr  x1
3436           be   lk4cm
3437           sbr  x1,1&x1
3438           b    setn
3439 einpt     a    xl3,wctr
3440           a    @4@,wctr
3441           mn   wctr,xl3
3442           mn
3443           mn
3444           mcw  @000@,wctr
3445           b    here
3446 *
3447 mv2n      sbr  mv2xt&3
3448           s    xl3&1
3449           c    0&x1, @0@
3450           bh   ersig
3451 mvdig     mn   0&x1, xl3
3452           sar  x1
3453           c    0&x1, @0@
3454           bh   chkn
3455           c    xl3,@133@
3456           bl   ersig
3457           mn   xl3-1, xl3-2
3458           mn   xl3, xl3-1
3459           b    mvdig
3460 *
3461 chkn      c    @134@, xl3
3462           bh   ersig
3463           be   ersig
3464 mv2xt     b    xxx
3465 *
     *teste    bce  einpt, 5&x2, e
     *         b    ersig
3466 *
3467 putn      za   xl3, nctr
3468           sw   bceq&7
3469           mcw  0&x1, bceq&7
3470           cw   bceq&7, sw1
3471 bceq      bce  comrt, @paxhife%@, x
3472           chain7
3473           b    ersig
3474 *
3475 finis     mcw  nxbtm, x3
3476           bwz  setx2, code, b
3477           c    0&x3,ckbit
3478           bu   klobr
3479 mvdwn     lca  0&x2,0&x3
3480           sar  x2
3481           c    0&x3
3482           sar  x3
3483           cw   1&x2
3484           c    x2,scnbx
3485           bu   mvdwn
3486           sbr  hex3, 0&x3
3487           cw   0&x2
3488           cw
3489           mcw
3490           sar  x2
3491           cw   1&x2
3492           bw   mv2gm,urfsw
3493           bce  mv2gm,iobgn&5,               blank
3494 iobgn     sbr  x2, xxx
3495           cw   refsw#1
3496           sbr  mvadr&6, 1&x3
3497 repls     mn   0&x2
3498           chain2
3499           sar  x3
3500           mn   0&x3, *&15
3501           mz   0&x3, *&8
3502           bce  iowk, @56ulp@, x
3503           chain4
3504           bw   ndrpl, refsw
3505           b    getst
3506           mcw  @17 - doubly defined format@,error&26
3507           w
3508           b    fbad
3509 ndrpl     mcw  hex3, x3
3510           bwz  fbad, code, b
3511 fokay     mcw  x3, nxbtm
3512           mcw  ckbit, 0&x3
3513 mv2gm     c    0&x1
3514           sar  x1
3515           b    retrn
3516 setx2     mcw  x2, x3
3517           sw   urfsw#1
3518           b    mvdwn
3519 fbad      mcw  nxbtm, x3
3520           lca  @.@,0&x3
3521           sbr  x3
3522           b    fokay
3523 iowk      c    0&x3
3524           sar  x2
3525           bwz  *&5, 2&x3, b
3526           b    noswt
3527           c    0&x2, fmtno
3528           bu   noswt
3529           sw   refsw
3530           ma   macfls,mvadr&6
3531 mvadr     sbr  0&x2, xxx
3532           mz   @ @, 2&x3
3533           ma   plusdf,mvadr&6
3534 noswt     c    0&x2
3535           sar  x2
3536           b    repls
3537 *
3538 kh        dcw  @bl28@  hollr  change if obj format reassembled
3539 kx        dcw  @h0990&0@
3540 kleft     dcw  @bj52@  openr  change if obj format reassembled
3541 krite     dcw  @bj85@  clspr  change if obj format reassembled
3542 kline     dcw  @bk08@  ndlin  change if obj format reassembled
3543 karit     dcw  @bl85@  getw   change if obj format reassembled
3544 keoj      dcw  @bk23@  eoj1   change if obj format reassembled
3545 kp        dcw  @bl10@  scale  change if obj format reassembled
3546           ltorg*
3547           org  *&x00
3548           org  *-1
3549 sys2      dcw  @}@                           system group mark
3550 tamax     dcw  #1
3551           xfr  phse2
3552           job  1401 Fortran  lists phase one                          50253
3553           fbegnlistr1,x1,,x2,r,x3,r,x
3554 nxbtm     equ  083
3555 *  checks for duplicate lists
3556           org  xbegin
3557 code      dcw  #4
3558 abotm     dcw  #3
3559 phse1     mcw  x1,abotm
3560           mcw  nxbtm,x2
3561           lca  @.@,0&x2
3562           cw   0&x2
3563           sbr  nxbtm
3564           sbr  period,0&x2
3565           ma   macfls,period
3566 start     bce  dun,000&x1,      blank
3567           mcw  000&x1,code
3568           mcw  x1,alter&6
3569           mcw  code-3,*&8
3570           bce  list,@5613lup@,0
3571           chain6
3572           b    dun
3573 list      c    000&x1
3574           sar  x1
3575           b    comma
3576           cw   xdoini
3577           bce  next1,parama&10,l
3578           cw   xoblst
3579 next1     sw   000&x1
3580           sar  x1
3581           mcw  abotm,x3
3582 rudup     c    0&x3
3583           c
3584           sar  x3
3585           bce  rudup,1&x3,}                  gm
3586           c    x1,x3
3587           bu   comp
3588 pass      c    000&x1
3589           sar  x1
3590           b    start
3591 comp      c    000&x1,000&x3
3592           bu   reset
3593           c    000&x3,000&x1
3594           bu   reset
3595           bwz  wrong,0&x1,1
3596           bwz
3597           bwz
3598           lca  x3,000&x1
3599           sbr  x1
3600           b    pass
3601 reset     c    000&x3
3602           sar  x3
3603           bce  rudup,1&x3,}                  gm
3604           b    reset
3605 comma     sbr  excma&3
3606 ckng      bw   pass,0&x1
3607 excma     bce  000,000&x1,,
3608           sbr  x1
3609           b    ckng
3610 wrong     ftmsg18,list syntax,code,13
3611           mcw  @/@,code-3
3612 alter     mcw  code,000
3613           b    pass
3614 dun       sw   000&x1
3615           mcw  abotm,x1
3616           fendxc,,,phse1,,phse1,sys1,listr two
3617           ltorg*
3618 sys1      dcw  @}@                           system group mark
3619           xfr  phse1
3620           job  1401 Fortran  lists phase two                          50263
3621 *  reorders, squeezes, error checks, and stores list
3622 110       dcw  @listr two@
3623           org  phse1
3624 phse2     mcw  nxbtm,x2
3625 go        bwz  out,000&x1,1
3626           mcw  x2,hex2#3
3627           mcw  000&x1,code
3628           mcw  x1,emasq&6
3629           c    000&x1
3630           sar  x1
3631           sbr  x3
3632 slip      c    0&x3
3633           sar  x3
3634           bce  *&5,1&x3,}         gm
3635           b    slip
3636           sbr  nxguy&6,0&x3
3637           c    000&x1
3638           c
3639           sar  hex1#3
3640           bce  hex1x,0&x1,,
3641           chain6
3642           b    cktyp
3643 hex1x     mcw  hex1,x1
3644           bce  new,001&x1,}     group mk
3645           mcw  003&x1,x3        duplicates were chained
3646           bwz  error,001&x3,1     duplicate was bad statement
3647           lca  001&x3,004&x1
3648           cw
3649           b    nxguy
3650 new       bce  cklst,2&x3,,     allow last char of comma
3651           sbr  x3
3652 sndpt     lca  @.@,000&x2
3653           sbr  x2
3654           cw   001&x2
3655           s    count#1
3656 main      sbr  x3,001&x3
3657           bce  rtpar,000&x3,)
3658           bce  dollr,000&x3,$
3659           b    ruadr
3660           lca  adrss,000&x2
3661           sbr  x2
3662           bce  ckwmk,0&x3,,
3663           bce  lfpar,0&x3,%
3664           b    ruadr
3665           lca  adrss,000&x2
3666           lca  @,@
3667           sbr  x2
3668           cw   5&x2
3669           cw   001&x2
3670           mz   3&x2,svzn#1
3671           mcw  x1,sv1#3
3672           za   parama&4,hold5
3673           bwz  dun2,3&x2,k
3674           mcw  parama&6,hold5#5
3675 dun2      s    &16000,hold5
3676           fpackhold5,hold3,x1
3677           mcw  hold3#3,x1
3678           mcw  4&x2,sbr4&6
3679           mz   *-6,sbr4&5
3680 sbr4      sbr  4&x2,0
3681           mz   svzn,3&x2
3682           mcw  sv1,x1
3683           mz   *-4,6&x2
3684 cklfp     bce  lfpar,0&x3,%
3685 ckcom     c    000&x3,@,@
3686           bu   error
3687 ckwmk     bwz  fnliz,000&x3,1      word mk
3688           b    main
3689 rtpar     bce  setup,count,?      plus zero
3690 puts      mcw  x1,save1#3
3691           lca  @.@,000&x1
3692           sbr  x1
3693           a    &1,count
3694           bce  error,count,d     allow for nest three deep
3695           b    putmi
3696           c    000&x3,@,@
3697           bu   error
3698           b    putmi
3699           bce  putmi,000&x3,,
3700           c    000&x3,@#@
3701           bu   error
3702           b    putmi
3703           sbr  000&x1,001&x2
3704           cw   000&x1
3705           cw
3706           sw
3707           sar  x1
3708           mcw  x3,hex3#3
3709           mn   000&x3
3710           sar  x3
3711 loopy     bce  inner,002&x3,%     lfpar
3712           bce  outer,002&x3,)       rtpar
3713           bwz  error,002&x3,1
3714           sbr  x3
3715           b    loopy
3716 inner     lca  @)@,000&x2
3717           sbr  x2
3718           cw   001&x2
3719           b    restr
3720 outer     lca  @#   @,000&x2    3 blanks
3721           sbr  x2
3722           sw   002&x2
3723           cw
3724 restr     mcw  hex3,x3
3725           b    ckcom
3726 lfpar     s    &1,count
3727           bwz  error,count,k
3728           ma   macfls,3&x1
3729           lca  003&x1,000&x2
3730           lca  6&x1
3731           sbr  x2
3732           bce  m3is1,013&x1,.
3733           lca  015&x1,000&x2
3734           sbr  x2
3735 sndm2     lca  012&x1,000&x2
3736           lca
3737           lca  @%@
3738           sbr  x2
3739           cw   001&x2
3740 swtch     nop  swoff
3741           mcw  003&x1,x1
3742           mn   000&x1
3743           sar  x1
3744           ma   plusdf,x1
3745           ma   macfls,x2
3746           sbr  0&x1,1&x2
3747           ma   plusdf,x2
3748 bump      sbr  x3,001&x3
3749           mcw  save1,x1
3750           b    cklfp
3751 swoff     mcw  @n@,swtch
3752           b    bump
3753 m3is1     lca  adone,000&x2      obj time addr of fix pt one
3754           sbr  x2
3755           b    sndm2
3756 setup     sbr  x1,space#48
3757           mcw  @b@,swtch
3758           b    puts
3759 putmi     sbr  expmi&3
3760           sbr  x3,001&x3
3761           b    ruadr
3762           lca  adrss,000&x1
3763           sbr  x1
3764           mz   *-4,2&x1
3765           bwz  error,000&x3,1
3766 expmi     b    000
3767 fnliz     c    count,@?@            plus zero
3768           bu   error
3769           cw   000&x3
3770           cw
3771           sw
3772           sar  x3
3773           sbr  003&x3,001&x2
3774           ma   macfls,3&x3
3775           b    nxguy
3776 dollr     sw   0&x3
3777           sar  x3
3778           sbr  cw&3,1&x3
3779 loop      bce  ndolr,2&x3,$
3780           sbr  x3
3781           b    loop
3782 ndolr     lca  2&x3,0&x2
3783           sbr  x2
3784           cw   1&x2
3785           sbr  x3,3&x3
3786 cw        cw   0
3787           b    cklfp
3788 cklst     bwz  rmvcm,2&x3,1
3789           sbr  x3,2&x3
3790           b    sndpt
3791 rmvcm     sw   3&x3
3792           cw
3793 cktyp     fbceqerror,code-3,1,3
3794           b    emasq
3795 ruadr     sbr  exrua&3
3796           mn   002&x3,exruk&7
3797           b    ruok
3798           mn   001&x3,exruk&7
3799           b    ruok
3800           mn   000&x3,exruk&7
3801           b    ruok
3802           mcw  002&x3,adrss#3
3803           sbr  x3,003&x3
3804 exrua     b    000
3805 ruok      sbr  exruk&3
3806 exruk     bce  000,@0123456789@,0
3807           chain9
3808           b    error
3809 error     ftmsg47,bad list,code,10
3810           mcw  @/@,code-3
3811 emasq     mcw  code,000
3812           mcw  hex2,x2
3813 nxguy     sbr  x1,0
3814           b    go
3815 out       mcw  abotm,x1
3816           fendxc,,,,,,sys2,listr tri
3817           org  *
               ltorg*    WVS: Autocoder shouldn't load incld at org
3818 sys2      dcw  @}@                           system group mark
3819 adone     equ  oneadr
3820           xfr  phse2
3821           job  1401 Fortran   lists phase three                       50273
3822 110       dcw  @listr tri@
3823 *    moves down program
3824           org  phse2
3825 phse3     mcw  x2,nxbtm
3826           sw   gm
3827           lca  gm,0&x2
3828           sbr  x2
3829 begin     bwz  nolst,000&x1,1
3830           b    slide
3831           b    slide
3832           bce  begin,1&x2,}                  gm
3833           cw   001&x2
3834           c    0&x1
3835           sar  x1
3836           sbr  x1,001&x1
3837           b    slide
3838           b    begin
3839 nolst     cw   000&x1
3840 rudun     bce  exph3,000&x1,         blank
3841           b    slide
3842           b    slide
3843           b    rudun
3844 slide     sbr  exsld&3
3845           mvdwnx1,x2
3846 exsld     b    000
3847 exph3     fendxd,,,xbegin,phse2n,xbegin,sys3,stnum2
3848           dcw  @ @       blank
3849 gm        dc   @}@                           group mark
3850           ltorg*
3851 sys3      dcw  @}@                           system group mark
3852           xfr  phse3
3853           job  1401 Fortran   statement number definer two            50283
3854           fbegnstnum two,x1,,x2,,x3,r,n
3855           org  xbegin
3856 base      dcw  #3
3857 max       dcw  #4
3858           dc   #2
3859 uplim     dcw  #3
3860 nomo      dcw  #3
3861 mvup      sbr  exmvp&3
3862           movupx2,x1,nomo,all,|
3863           mn   000&x1
3864           sar  x1
3865           sbr  x2
3866 exmvp     b    000
3867 nxbtm     equ  083
3868 phse2     mcw  nxbtm,x3
3869           sbr  nomo,1&x3
3870           mcw  x2,x3
3871 clr1      cs   000&x3
3872           sbr  x3
3873           c    x3,&sauce-1
3874           bu   clr1
3875           sbr  x1,sauce-1
3876 *  shift source program up to compiler program
3877           b    mvup
3878           sbr  base,5&x1
3879           mn   two9,base
3880           mn
3881           mcw  nxbtm,x3
3882 *  clear balance of core
3883 clr2      cs   000&x3
3884           sbr  x3
3885           c    x3,base
3886           bu   clr2
3887           mcw  @<@,0&x3                  12-6-8
3888 *  divide rest of core for tables   ratio 3 to 7
3889           mcw  nxbtm,loc
3890           b    unpak
3891           mcw  num#5,max&2
3892           mcw  base,loc
3893           b    unpak
3894           s    num,max&2
3895           a    max&2
3896           a    max&2
3897           a    max&2
3898           a    max&2
3899           a    max,accum#6
3900           a    accum
3901           a    max,accum        3*max in accum
3902           a    num,accum
3903           mcw  accum-3,x3
3904           a    x3
3905           mz   zones&x3,accum-2
3906           mz   zones&1&x3,accum
3907           mcw  accum,x3
3908           sw   002&x3
3909           mcw  @<@       12-6-8
3910           sbr  uplim
3911           fendxc,,,phse2,phse3,phse2,sauce-1,stnum tri
3912 unpak     sbr  exit&3
3913           mn   loc,num
3914           mn
3915           mn
3916           mcw
3917           mz   loc,two9
3918           mz   loc-2,two9-1
3919           sbr  x3,zones-3
3920 comp      c    004&x3,two9
3921           sar  x3
3922           a    &1,num-3
3923           bu   comp
3924           mz   @ @,num-3
3925 exit      b    0
3926 loc       dcw  @0j   @
3927 two9      dcw  @99@
3928 zones     dc   @9@
3929           dc   @9z9r9i99zzzrziz9rzrrrir9iziriii@
3930           ltorg*
3931           dcw  @}@                           system group mark
3932           xfr  phse2
3933           job  1401 Fortran   statement number phase three            50293
3934 110       dcw  @stnum tri@
3935           org  phse2
3936 slide     sbr  exsld&3
3937           mvdwnx1,x2
3938 exsld     b    000
3939 randm     sbr  exrdm&3
3940           mcw  000&x1,alph
3941           sar  hex1
3942           mn   alph,mod
3943           chain3     blank in alph-3 implies 3 digit no. in mod
3944 subtr     s    max,mod
3945           bwz  subtr,mod,b
3946           a    max,mod
3947           mz   *-4,mod
3948           mcw  mod,x1
3949           a    x1
3950           a    mod,x1
3951 bump      nop  000      initialized by phse3
3952           sar  x1
3953 exrdm     b    000
3954           dcw  #1
3955 alph      dcw  #3
3956 hex1      dcw  #3
3957 mod       dcw  #4
3958 code      dcw  #4
3959 next      dcw  #3
3960 full      fquit
3961 out       mcw  save1,x1
3962           fendxc,,,phse3,,phse3,sys3,stnum 4
3963 save1     dcw  #3
3964           ltorg*
3965 phse3     mcw  nxbtm,next
3966           mcw  nxbtm,adtbll
3967           mcw  base,bump&3
3968           mz   @s@,bump&2
3969           sbr  nomo,2&x2
3970           mcw  x1,save1
3971 rucgt     mcw  000&x1,code
3972           bce  cgoto,code-3,t
3973           mcw  @b@,swch
3974           mcw  next,nxbtm
3975           c    x1,x2
3976           be   *&5
3977           b    mvup
3978 norml     bce  out,000&x1,     blank
3979           mcw  000&x1,code
3980           b    slide
3981           mcw  code-3,*&8
3982           bce  worry,@wtdegk@,0
3983           chain5
3984 btmnl     b    slide
3985           b    norml
3986 worry     b    randm
3987           b    chain
3988           mcw  x3,000&x2
3989           sbr  x2
3990           mcw  hex1,x1
3991           bce  btmnl,000&x1,}        group mk
3992           bce  btmnl,000&x1,,
3993           b    worry
3994 cgoto     c    0&x1
3995           mn
3996           sar  x3
3997           s    count#3
3998 rtlft     mn   000&x3
3999           mn
4000           mn
4001           sar  x3
4002           a    @1@,count
4003           bce  fork,001&x3,,
4004           b    rtlft
4005 fork      s    &11,count
4006           bwz  big,count,b     plus
4007           b    slide
4008 btmcg     b    slide
4009           b    rucgt
4010 big       mn   000&x1
4011           mn
4012           mn
4013           mcw  @h@
4014           b    slide
4015           mcw  x3,hex3#3
4016           mn   000&x3
4017           mn
4018           sar  x1
4019           a    &9,count
4020 loop      sbr  x1,6&x1
4021           b    randm
4022           b    chain
4023           mcw  hex1,x1
4024           bce  headr,004&x1,}        group mk
4025           b    loop
4026 headr     mcw  next,000&x2
4027           mcw  count
4028           sbr  x2
4029           mcw  hex3,x1
4030           b    btmcg
4031 chain     sbr  exchn&3
4032           mcw  @n@,ovflw
4033 again     mcw  000&x1,x3
4034           sar  x1
4035           bce  new,003&x1,      blank
4036           bce  ovflw,003&x1,<     12-6-8   alter stnum phse 1
4037           c    000&x3,alph
4038           bu   again
4039 swch      nop  exchn
4040           mcw  next,000&x3
4041           sbr  x3
4042           mz   @ A@,002&x3     blank 
4043           cw     dummy on A-oper, effective on B-oper
4044 new       lca  next,003&x1
4045           mcw  next,x3
4046           bce  full,000&x3,<      12-6-8
4047           b
4048           b
4049           lca  alph,000&x3
4050           sbr  next
4051 exchn     b    000
4052 ovflw     nop  full
4053           mcw  @b@,ovflw
4054           mcw  uplim,x1
4055           b    again
4056           ltorg*
4057 sys3      dcw  @}@                           system group mark
4058           org  ndrith&x00
4059           org  *-5
4060           dcw  #5
4061 sauce     equ  *&1
4062           xfr  phse3
4063           job  1401 Fortran   statement number phase four             50303
4064 110       dcw  @stnum for@
4065           org  phse3
4066 phse4     lca  @ @,000&x2      blank
4067           sw   gm
4068           mcw  x1,x2
4069 start     bce  out1,0&x1,                     blank
4070           mcw  000&x1,code
4071           sar  x1
4072           bce  nonum,000&x1,}     group  mk
4073           b    randm
4074           mcw  @n@,wrap
4075 nothr     mcw  000&x1,x3
4076           sar  x1
4077           bwz  notyt,001&x1,1       word mk
4078           bce  wrap,003&x1,<        12-6-8
4079           bce  unref,1&x1,                    blank
4080           c    003&x1,alph
4081           bu   nothr
4082           b    multy
4083 notyt     c    000&x3,alph
4084           bu   nothr
4085           mz   code-1,zone#1
4086           mz   *-4,code-1
4087           mcw  code,000&x3
4088           sbr  x3
4089           cw   001&x3
4090           mcw  003&x1,code
4091           mz   zone,code-1
4092           mcw  alph,003&x1
4093           cw   001&x1
4094 hex2x     mcw  hex1,x1
4095 botm      sbr  x1,4&x1
4096           mcw  code
4097           b    slide
4098           b    slide
4099           b    start
4100 wrap      nop  unref
4101           mcw  @b@,wrap
4102           mcw  uplim,x1
4103           b    nothr
4104 unref     ftmsg19,unreferenced stmt number,code,26,nofail
4105           b    prnum
4106 multy     ftmsg20,doubly defined stmt,code,21
4107           b    hex2x
4108 out1      mcw  next,x3
4109           lca  gm,0&x3
4110           sbr  x3
4111           sbr  bsauce
4112           cs   0&x2
4113           mcw  save1,x1
4114           sw   0&x2
4115           fendxc,gm,,xbegin,xbegin,xbegin,sys4,stnum 5
4116 prnum     mcw  hex1,x1
4117 nonum     bce  psudo,code-3,d
4118           b    botm
4119 psudo     mcw  next,x3
4120           mcw  code,000&x3
4121           sbr  x3
4122           bce  full,000&x3,<     12-6-8
4123           mcw  next,code
4124           sbr  next,1&x3
4125           b    botm
4126           ltorg*
4127 gm        dc   @}@               gm
4128 sys4      dcw  @}@                           system group mark
4129           xfr  phse4
4130           job  1401 Fortran   statement number phase five             50313
4131           fbegnstnum 5,x1,,x2,r,x3,,l
4132           org  xbegin
4133 initl     mcw  x3,hex3#3
4134           mcw  x1,hex1#3
4135           c    0&x3
4136           sar  x3
4137           cw   1&x3
4138           mcw  adtbl,x2
4139           c    000&x2
4140           sar  x2
4141           c    x2,hex3
4142           be   out
4143           mcw  adtbl,cgbtm#3
4144 start     bwz  out,000&x1,1
4145           mcw  000&x1,code#4
4146           c    000&x1
4147           sar  x1
4148           mcw  @   @,count#3
4149           bce  worry,code-3,h
4150           mcw  code-3,*&8
4151           bce  rubad,@twedgk@,0        check
4152           chain5
4153 skip      c    000&x1
4154           sar  x1
4155           b    start
4156 worry     mcw  cgbtm,x3
4157 ckext     c    000&x1,x3
4158           be   thru
4159           mn   000&x3
4160           mn
4161           mn
4162           sar  x3
4163           sbr  x2
4164 chain     bwz  add1,001&x2,1
4165           bwz  ckext,002&x2,2
4166           mcw  003&x2,x2
4167           mz   @ @,x2-1       blank
4168           mn   000&x2
4169           mn
4170           mn
4171           sar  x2
4172           b    chain
4173 thru      mcw  x3,cgbtm
4174 dun       bce  skip,count,      blank
4175           bwz  *&5,code,2
4176           b    zone
4177           bwz  print,code-2,2
4178 zone      mcw  code,x3
4179           mcw  000&x3,code
4180 print     cs   299
4181           sw   failsw
4182           mcw  @error 21 -@,210
4183           mcw  @undefined statement numbers, statement@,253
4184           mn   code,257
4185           mn
4186           mn
4187           mcs  count,214
4188           c    count,@001@
4189           bu   *&8
4190           mcw  @, @,243
4191           w
4192           forms
4193           b    skip
4194 add1      a    @1@,count
4195           b    ckext
4196 rubad     bwz  dun,000&x1,1
4197           bce  dun,000&x1,,
4198           mcw  000&x1,x3
4199           sar  x1
4200           mn   000&x3
4201           mn
4202           sar  x3
4203           bwz  plus1,000&x3,1
4204           b    rubad
4205 plus1     a    @1@,count
4206           b    rubad
4207 out       mcw  hex1,x1
4208           mcw  hex3,x3
4209           fendxe,,,,,,sys5,i/o one
4210           ltorg*
4211 sys5      dcw  @}@                           system group mark
4212           xfr  initl
4213           job  1401 Fortran  input/output phase one                   50323
4214           fbegni/o one,x1,,x2,r,x3,,9
4215           org  xbegin
4216 begin     sw   gm1
4217 start     bce  out2,0&x1,                    blank
4218           lca  0&x1,code#5
4219           cw   xtpsw
4220           sw   code-3
4221           mcw  code-3,*&8
4222           bce  iotyp,@1356lpu@,0
4223           chain6
4224 out2      sbr  x1,1&x1
4225           mz   x3,all9
4226           mz
4227           mcw
4228           mz   x1,all91
4229           mz
4230           mcw
4231           c    all9,all91
4232           be   sngl
4233 clr       cs   0&x3
4234           sbr  clr&3
4235           c    clr&3,all91
4236           bu   clr
4237 sngl      mcw  all91,x2
4238 back3     c    x2,x1
4239           be   out3
4240           lca  blank,0&x2
4241           cw   0&x2
4242           sar  x2
4243           b    back3
4244 out3      mn   0&x1
4245           sar  x1
4246           fendxc,gm1,,,,,sys1,arith one
4247 iotyp     sw   code-2
4248           mcw  @<@,2&x1                   12-6-8
4249           sbr  klobr&6,2&x1
4250           c    0&x1
4251           sar  x1
4252           lca  code,0&x3
4253           lca  gm1
4254           sbr  x3
4255           cw   2&x3
4256           bwz  nofmt,code-1,b
4257           fbceqdolst,code-3,1,3
4258           fbceqdospc,code-3,l,p,u
4259           mcw  0&x1,spec
4260           sar  x1
4261 dolst     mcw  0&x1,tuno
4262           sar  x1
4263           mcw  0&x1,tuno-3
4264           bce  actl,tuno-4,}               gm
4265           bce  actl,tuno-1,}               gm
4266           mn   @1@,tape
4267           bce  othr2,tuno-3,}              gm
4268 xxx       mcw  0&x1,list
4269           sar  x1
4270 retrn     lca  list,0&x3
4271           sbr  x3
4272           lca  spec,0&x3
4273           sbr  x3
4274           lca  tape,0&x3
4275           lca  branch
4276           sbr  x3
4277           fbceqtlgm,code-3,l,p,u,1
4278           mz   @s@,5&x3
4279           bce  tlgm,code-3,3
4280           mz   @k@,5&x3
4281           bce  tlgm,code-3,5
4282           mz   @b@,5&x3
4283 tlgm      bw   lgm,xtpsw
4284           bwz  lgm,tuno-1,2
4285           mcw  tuno,mask1-3
4286           mz   blank,mask1-4
4287           lca  mask1,0&x3
4288           sbr  x3
4289           mcw  blnk#3,tuno
4290 lgm       lca  gm1,0&x3
4291           sbr  x3
4292           c    0&x1
4293           sar  x1
4294 klobr     bce  start,0,<                    12-6-8
4295           fquit
4296 actl      mn   tuno,tape#1
4297           sw   xtpsw
4298           bce  other,tuno-1,}               gm
4299           sbr  x1,2&x1
4300           b    xxx
4301 other     sbr  x1,1&x1
4302 othr2     mcw  period,list
4303           b    retrn
4304 nofmt     mz   blank#1,3&x3
4305           mcw  4&x3,adr#3
4306           bwz  *&5,adr,2
4307           b    gtadr
4308           bwz  err,adr-2,2
4309 gtadr     mcw  adr,*&4
4310           mcw  0,adr
4311 err       ftmsg22,undefined format,adr,18
4312           mz   *-4,code-1
4313           b    dolst
4314 dospc     mcw  0&x1,spec
4315           sar  x1
4316           mcw  period,list
4317           bce  here,0&x1,}                  gm
4318           mcw  0&x1,list
4319           sar  x1
4320 here      mcw  @&@,tape
4321           bce  setp,code-3,l
4322           mcw  @-@,tape
4323           bce  setp,code-3,u
4324           mcw  @*@,tape
4325 setp      sw   xtpsw#1
4326           b    retrn
4327 all9      dcw  999
4328 all91     dcw  999
4329 mask1     dcw  @dxxx0?5@           plus zero
4330 gm1       dc   @}@            group mark
4331 branch    dcw  @bw97@         change on reassm of obj format
4332           dcw  #4
4333 tuno      dcw  #3
4334 list      dcw  000
4335 spec      dcw  000
4336           ltorg*
4337 sys1      dcw  @}@                           system group mark
4338           xfr  begin
4339           job  arith phase one                                        50333
4340           fbegnarith 1, x1,,x2,r,x3,,<       12-6-8 suffix
4341           org  xbegin
4342 *
4343 * arith phase one error checking algorithm
4344 *
4345 *                   previous character
4346 *
4347 *              opnd  &*/.    -  gm   f%   #  %   )   neg
4348 *
4349 *         &     ok    dd    dd  ls  kl   kl  kl  ok   dd
4350 *     c   -     ok    dd    dd  ls  ng   ng  ng  ok   dd
4351 *   c h   */    ok    dd    dd  ls  sy   sy  sy  ok   dd
4352 *   u a   #     ok    a2    a2  ls  a2   a2  a2  a2   a2
4353 *   r r   %     sy    ok    ok  ls  ok   ok  ok  sy   ok
4354 *   r a   )     ok    sy    sy  ls  a2   sy  a2  ok   sy
4355 *   e c   gm    ok    sy    sy  ls  a2   sy  sy  ok  sy
4356 *   n t   .     ok    dd    dd  ls  sy   sy  sy  ok  dd
4357 *   t e   neg   --    --    --  ls  ok   ok  ok  --  dd
4358 *     r   f%    sy    ok    ok  ls  ok   ok  ok  sy  ok
4359 *         oprnd --    ok    ok  ls  ok   ok  ok  sy  ok
4360 *
4361 *  ok-  valid
4362 *  dd-  double operators
4363 *  sy-  syntax error
4364 *  a2-  error noted in arith phase two
4365 *  ls-  left side invalid
4366 *  ng-  generate negate function
4367 *  ---  syntactically inadmissible
4368 *  kl-  delete unary plus operator
4369 *
4370 *
4371 start     sbr  nomo,2&x3
4372           sw   gm1
4373           mcw  0&x1,code
4374           fbceqdocod,code-3,r,e
4375           mcw  @.@,x2
4376           b    fendx
4377 nustm     mcw  0&x1,code#4
4378           sbr  kill#3,0&x3
4379           fbceqdocod,code-3,r,e
4380           mcw  nomo#3,x2
4381 fendx     fendxc,,,,,,sysgm,arith two
4382 docod     mvdwnx1,x3
4383           bwz  *&5, code,2
4384           b    indir
4385           bwz  main,code-2,2
4386 indir     mcw  code,x2
4387           mn   0&x2,code
4388           mn
4389           mn
4390 main      c    0&x1
4391           sar  next#3
4392           bce  artyp,code-3,r
4393           c    0&x1,blk10#10
4394           sar  x1
4395           sw   1&x1
4396           lca  10&x1,0&x3
4397           sar  x1
4398           c    0&x3
4399           sar  x3
4400           cw   1&x1,1&x3
4401           lca  gm1
4402           lca  @#<99@              12-6-8
4403           sbr  x3
4404           cw   1&x3,5&x3
4405           sbr  last,0&x1
4406           b    loop3
4407 artyp     sbr  x2,1&x1
4408           bce  cdint,0&x1,#
4409           sbr  last#3,0&x1
4410 eqscn     bce  goteq,0&x1,#
4411           bce  cdint,0&x1,}        g-m
4412           sbr  x1
4413           b    eqscn
4414 goteq     b    mesur
4415 loop1     mn   0&x1
4416           sar  x1
4417 loop3     sbr  x2,1&x1
4418           sbr  funbx#3
4419 loop2     mn   0&x1,tst1&7
4420           mz   0&x1,tst1&7
4421           sar  x1
4422 tst1      bce  gotop,@&-@*#%)}@,0            g-m
4423           chain7
4424           b    loop2
4425 gotop     sbr  x1,1&x1
4426           bce  ckng,0&x1,-
4427           bce  ckfun,0&x1,%
4428           bce  ckxp,0&x1,*
4429           bce  plus,0&x1,&
4430           bce  div,0&x1,@
4431           bce  loop1,0&x1,#
4432           bce  close,0&x1,)
4433           mn   1&x1,ckgm&7        ergo group mark
4434           mz   1&x1,ckgm&7
4435 ckgm      bce  syner,@&-*@.#,@,0
4436           chain6
4437           bce  eostm,1&x1,
4438           bce  eostm,1&x1,%
4439           bce  eostm,1&x1,)
4440           b    mesur
4441 eostm     mcw  last,x2
4442           lca  0&x2,0&x3
4443           sbr  x3
4444           mcw  next,x1
4445           b    nustm
4446 close     mlc  0&x1,box#2
4447           mlc  box-1,*&8
4448           bce  clzok,@&*@-})@,0            g-m,)
4449           chain5
4450           bce  clzok,box-1,#
4451           b    syner
4452 clzok     mn   1&x1,clsck&7
4453           mz   1&x1,clsck&7
4454 clsck     bce  syner,@&-*.@ %,@,0
4455           chain7
4456           bce  loop1,1&x1,#
4457           bce  loop1,1&x1,)
4458           b    mesur
4459           b    loop1
4460 ckxp      mcw  0&x1,box2#2
4461           bce  isxp,box2-1,*
4462 div       fbceqsyner,1&x1,#,%
4463           bce  syner,1&x1,
4464 div2      mn   1&x1,divck&7
4465           mz   1&x1,divck&7
4466 divck     bce  dblop,@&-@*.,@,0
4467           chain5
4468           bce  loop1,1&x1,)
4469           b    mesur
4470           b    loop1
4471 isxp      mn   0&x1
4472           mn
4473           sar  x1
4474           mcw  @.@,2&x1
4475           lca  0&x1
4476           sbr  x1,2&x1
4477           b    div
4478 plus      fbceqsquoz,1&x1,#,%
4479           bce  squoz,1&x1,
4480           b    div2
4481 squoz     mn   0&x1
4482           sar  x1
4483           lca  0&x1,1&x1
4484           sbr  x1,1&x1
4485           b    loop3
4486 ckng      fbceqnegat,1&x1,#,%
4487           bce  negat,1&x1,
4488           b    div2
4489 negat     mcw  @,@,0&x1
4490           cw   xnegtf
4491           b    loop1
4492 ckfun     bce  isfun,1&x1,f
4493           mn   1&x1,opnck&7
4494           mz   1&x1,opnck&7
4495 opnck     bce  loop1,@&-*@ #%,.@,0
4496           chain8
4497           b    syner
4498 isfun     mcw  x2,hex2#3
4499           mcw  funbx,x2
4500           mn   0&x2
4501           sar  x2
4502           sw   0&x1
4503           sbr  funbx,2&x1
4504           c    funbx,x2
4505           be   syner
4506           sbr  funbx,3&x1
4507           c    funbx,x2
4508           be   syner
4509           mcw  x3,hex3#3
4510           mcw  x1,hex1#3
4511           sbr  x1,xsinfu
4512           sbr  x3,ftbl1-1
4513 fscan     bce  nofun,0&x3,*
4514           sbr  x3
4515           c    0&x3,0&x2
4516           be   gotfn
4517           c    0&x3
4518           sar  x3
4519           sbr  x1,1&x1
4520           b    fscan
4521 nofun     ftmsg29,undefined function name,code,25
4522           b    zonch
4523 comfn     cw   xcomf1
4524           b    mov
4525 cosin     cw   xsinfu
4526           b    comfn
4527 absvl     cw   xabsva,xnegtf
4528           b    mov
4529 gotfn     sw   1&x3
4530           bce  cosin,1&x3,c
4531           bce  absvl,1&x3,a
4532           cw   0&x1
4533           mcw  1&x3,*&8
4534           bce  comfn,@sgect@,0
4535           chain4
4536 mov       bce  keepx,0&x2,x
4537           mcw  1&x3,0&x2
4538           mcw  blnk1#1
4539           sbr  x2
4540           mcw  hex3,x3
4541           mcw  hex1,x1
4542           cw   0&x1
4543           sar  x1
4544           lca  0&x1,0&x2
4545           sbr  x1,0&x2
4546           b    loop3
4547 keepx     mn   0&x2
4548           sar  x2
4549           b    mov&8
4550 cdint     ftmsg23,coding unintelligible,code,23
4551 zonch     mcw  kill,x3
4552           mcw  next,x1
4553           b    nustm
4554 mesur     sbr  mesxt&3
4555           bce  subsc,1&x1,$
4556           sbr  mesbx#3,4&x1
4557 mescm     c    mesbx,x2
4558 mesxt     be   0
4559           ftmsg25,left side invalid,code,19
4560           b    zonch
4561 syner     ftmsg27,arithmetic syntax error,code,25
4562           b    zonch
4563 gm1       dc   @}@        g-m
4564 dblop     ftmsg31,double operators,code,18
4565           b    zonch
4566 subsc     sbr  mesbx,12&x1
4567           bce  mescm,11&x1,$
4568           sbr  mesbx,18&x1
4569           b    mescm
4570 *
4571 *              table of fortran functions
4572 *
4573           dcw  @*@             signals end of table
4574 *
4575           dcw  @   %fsocc@
4576           dcw  @  %fsbaxa@
4577           dcw  @ %fknilxi@
4578 *                          user functions
4579           dcw  @        h@    user fn 12
4580           dcw  @        d@    user fn 11
4581           dcw  @        m@    user fn 10
4582           dcw  @        l@    user fn  9
4583           dcw  @        k@    user fn  8
4584           dcw  @        j@    user fn  7
4585           dcw  @        z@    user fn  6
4586           dcw  @        y@    user fn  5
4587           dcw  @        w@    user fn  4
4588           dcw  @        p@    user fn  3
4589           dcw  @        u@    user fn  2
4590           dcw  @        r@    user fn  1
4591           dcw  @  %ftrqsq@
4592           dcw  @ %ftaolff@
4593           dcw  @  %fxifxx@
4594           dcw  #9
4595           dcw  @   %fsbaa@
4596           dcw  @  %fnatat@
4597           dcw  @   %fpxee@
4598           dcw  @   %fgolg@
4599           dcw  @   %fniss@
4600 ftbl1     dcw  #1
4601           ltorg*
4602 sysgm     dcw  @}@        system group mark
4603           xfr  start
4604           job  arith phase two                                        50343
4605           fbegnarith 2,x1,,x2,,x3,,0
4606           org  xbegin
4607 initl     bce  out,x2,.
4608           sw   gm
4609           mcw  x2,nomo#3
4610           sbr  x3,2&x3
4611           sbr  x1,2&x1
4612           mcw  x1,x2
4613 clr1      mn   x2,tail#2
4614           mn
4615           c    tail,@00@
4616           be   sto
4617           cw   0&x2
4618           sbr  x2,1&x2
4619           b    clr1
4620 sto       mn   0&x2
4621           sar  last#3
4622           mn   0&x3
4623           sar  x2
4624 clr2      c    x2,last
4625           be   mvup
4626           cs   0&x2
4627           sbr  x2
4628           b    clr2
4629 mvup      movupx3,x1,nomo,all,|
4630           mn   0&x1
4631           sar  x1
4632           mn   0&x3
4633           sbr  nxbtm#3
4634           bce  start,0&x3,}        group mk
4635           sbr  x3
4636           lca  gm
4637           sbr  nxbtm
4638           mcw  x3,nomo
4639 start     mcw  nxbtm,hex2#3
4640           mcw  0&x1,x3
4641           bwz  *&5,x3,2
4642           b    *&9
4643           bwz  *&8,x3-2,2
4644           mcw  0&x3,x3
4645           mcw  x3,code#3
4646           mcw  blnks,cntr
4647           mcw  @]@,40&x1        11-5-8
4648           sbr  klobr&6,40&x1
4649           b    mvdwn
4650           bce  if,2&x1,e
4651           c    2&x1,@r@
4652           bu   dun
4653 arith     mcw  x1,x3
4654           sbr  tukit&3,0&x1
4655           c    0&x3
4656           sar  next#3
4657           b    getlf
4658 klobr     bce  cntrl,0,]        11-5-8
4659           fquit
4660 if        mcw  x1,x3
4661 rucom     bce  pass,0&x3,,
4662           sbr  x3
4663           b    rucom
4664 pass      mn   0&x3
4665           sw
4666           b    mvdwn
4667           b    arith
4668 mvdwn     sbr  exmvd&3
4669           mcw  nxbtm,x2
4670           lca  0&x1,0&x2
4671           sbr  nxbtm
4672           c    0&x1
4673           sar  x1
4674 exmvd     b    0
4675 getlf     sbr  exgtl&3
4676           bce  sbscr,0&x3,$
4677 loop      mcw  0&x3,philf
4678           sar  x3
4679           mcw  philf,*&8
4680           bce  exgtl,ops,0
4681           chain10
4682           b    loop
4683 exgtl     b    0
4684 sbscr     c    0&x3,blnks#12
4685           sar  x3
4686           bce  exgtl,2&x3,$
4687           c    0&x3,blnks-6
4688           sar  x3
4689           b    exgtl
4690 cntrl     mcw  1&x3,philf#1
4691           mcw  1&x1,phirt#1
4692           mcw  phirt,ckop&7
4693           mcw  blnks,units#3
4694           b    gtnum
4695           mn   num#1,units-1
4696           mcw  philf,ckop&7
4697           b    gtnum
4698           mn   num,units
4699           mcw  units,x2
4700           mn   matrx&x2,x2
4701           mcw  blnks
4702           bwz  err5,x2,s
4703           a    x2
4704           a    x2
4705           b    *&1&x2
4706           b    skip
4707           b    paren
4708           b    force
4709           b    eoj
4710           b    neg
4711           b    fun
4712           b    err1
4713           b    err2
4714           b    err3
4715           b    err4
4716 gtnum     sbr  ckop&3
4717           bce  gotum,ckop&7,-
4718 nish      s    num
4719           mcw  &ops,ckop&6
4720 ckop      bce  0,0,0
4721           sbr  ckop&6
4722           a    @1@,num
4723           b    ckop
4724 gotum     mcw  @&@,ckop&7
4725           b    nish
4726 gntmp     sbr  exgtp&3
4727           a    @1@,cntr#3
4728           mz   cntr-1,temp
4729           mn   cntr,temp
4730           mn
4731 exgtp     b    0
4732 skip      mcw  x3,x1
4733           b    getlf
4734           b    cntrl
4735 paren     sw   2&x3
4736           lca  0&x1,1&x1
4737           cw   3&x3
4738           cw
4739           lca  0&x3,2&x3
4740           sbr  x1,1&x1
4741           sbr  x3,1&x3
4742           b    cntrl
4743 force     mcw  nxbtm,x2
4744           mz   4&x3,zone#1
4745           bce  *&8,2&x3,$
4746           mz   3&x3,zone
4747           sw   2&x3
4748           lca  0&x1,0&x2
4749           sbr  x2
4750           cw   1&x2
4751           sw   2&x1
4752           sw
4753           lca  1&x1,0&x2
4754           sbr  x2
4755           sbr  nxbtm
4756           cw   1&x2
4757           bce  sbvrt,2&x1,$
4758           lca  4&x1,0&x2
4759           sbr  nxbtm
4760           mz   3&x1,temp-1
4761           sar  x1
4762 fnish     b    gntmp
4763           lca  temp,2&x1
4764           lca  1&x3
4765           cw   0&x1
4766           mn
4767           sar  x3
4768           sbr  x1,2&x1
4769           bwz  ruint,temp-1,s
4770           bwz  ruint,temp-1,k
4771           bwz  klobr,zone,2
4772           bwz  klobr,zone,b
4773           bce  klobr,phirt,.
4774           b    err46
4775 ruint     bwz  klobr,zone,s
4776           bwz  klobr,zone,k
4777 err46     ftmsg46,mixing in arith,code,17
4778           b    kill
4779 sbvrt     sbr  x2,10&x1
4780           bce  send,2&x2,$
4781           sbr  x2,6&x2
4782 send      mcw  nxbtm,*&7
4783           lca  2&x2,0
4784           sbr  nxbtm
4785           mz   4&x1,temp-1
4786           mcw  x2,x1
4787           b    fnish
4788 neg       mcw  @n@,1&x1
4789           mz   4&x3,temp-1
4790           bce  funy,2&x3,$
4791           mz   3&x3,temp-1
4792           b    funy
4793 fun       mcw  3&x1,type#2
4794           bce  fxmod,3&x1,x
4795           mz   *-4,temp-1
4796 ckusr     sw   2&x1
4797           mcw  2&x1,*&8
4798           bce  okay,@rupwyzkjlmdh@,0
4799           chain11
4800           mz   4&x3,zone
4801           bce  *&8,2&x3,$
4802           mz   3&x3,zone
4803           bce  rufix,2&x1,f
4804           bce  rufix,2&x1,i
4805           c    type,@ax@
4806           be   rufix
4807           bwz  err6,zone,s
4808           bwz  err6,zone,k
4809 okay      mcw  2&x1,1&x1
4810           mcw  @%@,2&x1
4811           cw   2&x1
4812 funy      mcw  nxbtm,x2
4813           sw   2&x3
4814           lca  1&x1,0&x2
4815           sbr  nxbtm
4816           b    gntmp
4817           lca  temp,1&x1
4818           lca  1&x3
4819           mn   0&x1
4820           cw
4821           mn
4822           sar  x3
4823           sbr  x1,1&x1
4824           b    klobr
4825 fxmod     mz   *-6,temp-1
4826           lca  2&x1,3&x1
4827           sbr  x1,1&x1
4828           sbr  x3,1&x3
4829           b    ckusr
4830 rufix     bwz  okay,zone,s
4831           bwz  okay,zone,k
4832 err6      cs   332
4833           cs
4834           sw   failsw
4835           mn   code,224&37
4836           mn
4837           mn
4838           mcw  bgmsg
4839           w
4840           bcv  *&5
4841           b    *&3
4842           cc   1
4843           b    kill
4844 err5      ftmsg24,system error,code,14
4845           b    kill
4846 err4      ftmsg26,excess of # signs,code,19
4847           b    kill
4848 err3      ftmsg32,multiple exponent,code,19
4849           b    kill
4850 err2      ftmsg16,parenthesis error,code,19
4851           b    kill
4852 err1      ftmsg25,left side invalid,code,19
4853 kill      mcw  hex2,nxbtm
4854           b    reset
4855 eoj       mcw  nxbtm,x2
4856           sw   2&x3
4857           lca  0&x1,0&x2
4858           lca  @#@
4859           sbr  x2
4860           cw   2&x2
4861           cw
4862           sw   2&x1
4863 tukit     lca  0,0&x2
4864           lca  gm
4865           sbr  nxbtm
4866 reset     mcw  next,x1
4867           b    start
4868 dun       sbr  x1,5&x1
4869           mcw  nxbtm,x3
4870           sbr  x2,5&x3
4871           mcw  nomo,x3
4872 out       fendxc,,,,,,sysgm,arith tri
4873           dcw  @<@        delta   12-6-8
4874 temp      dc   @  @      blanks
4875 gm        dc   @}@      group mk
4876           dcw  @error 28 - incorrect mode of function argument, st@
4877 bgmsg     dc   @atement @
4878           dcw  @-@
4879 ops       dcw  @, .@&}#%)*@        plus, g-m, equal
4880 matrx     equ  *&1
4881           dc   @220922200sssssssssss010970000007093000006660s66666@
4882           dc   @020922000s220922200s220922280s0509700000440944400s@
4883 *
4884 *
4885 *    arith algorithm
4886 *
4887 *
4888 *
4889 *                      phi left
4890 *
4891 *                                 -
4892 *             *   )   %   #  gm   &   /  **  f%  ng
4893 *
4894 *   p     *   2   2   0   9   2   2   2   0   0   s
4895 *   h     )   s   s   s   s   s   s   s   s   s   s
4896 *   i     %   0   1   0   9   7   0   0   0   0   0
4897 *         #   0   7   0   9   3   0   0   0   0   0
4898 *   r    gm   6   6   6   0   s   6   6   6   6   6
4899 *   i    -&   0   2   0   9   2   2   0   0   0   s
4900 *   g     /   2   2   0   9   2   2   2   0   0   s
4901 *   h   .**   2   2   0   9   2   2   2   8   0   s
4902 *   t    f%   0   5   0   9   7   0   0   0   0   0
4903 *       ,ng   4   4   0   9   4   4   4   0   0   s
4904 *
4905 *
4906 *          0  skip to next op
4907 *          1  delete parens
4908 *          2  force binary op
4909 *          3  eoj
4910 *          4  negate fn
4911 *          5  other fn
4912 *          6  left side invalid
4913 *          7  paren error
4914 *          8  double exponentiation
4915 *          9  multiple # signs
4916 *          s  compiler error
4917 *
4918 *
4919           ltorg*
4920 sysgm     dcw  @}@      system group mk
4921           xfr  initl
4922           job  arith phase three                                      50353
4923           sfx  [         12-5-8
4924 110       dcw  @arith 3@
4925           org  xbegin
4926 start     fendxc,,,,,,sysgm,arith 4
4927           org  *&200
4928           ltorg*
4929 sysgm     dcw  @}@           system gm
4930           xfr  start
4931           job  arith phase four                                       50363
4932           fbegnarith 4,  x1,,x2,,x3,,7
4933           org  xbegin
4934 *  start - initialization
4935 start     bce  fendx,x2,.
4936           sw   gm1
4937           sbr  savx3#3,0&x3
4938           sbr  x1,1&x1
4939           sbr  x2,1&x2
4940 *  start of every statement
4941 nustm     s    tblr
4942           c    x2, savx3
4943           be   fendx
4944           mcw  blk4,maxdl
4945           sbr  hex1#3,0&x1
4946 *  start of every delta string
4947 blkop     mcw  blk4, hldop#1
4948 cwprt     cw   prtsw
4949           b    fix          x2 at high order minus one
4950           bce  delt1,left-2,<    12-6-8    x2 at units pos
4951 ckdl2     bce  delt2,right-2,<   12-6-8
4952           bce  outpt,1&x2,}      gm
4953           bw   big,prtsw
4954 add3      a    @i99@,curdl#3
4955           mcw  curdl,x3
4956           bce  add3,table&x3,1
4957           b    blkop
4958 *   delta is left operand
4959 delt1     bce  ckdl2,op,#
4960           bce  tuf,op,.
4961           b    cvtdl
4962           dcw  left
4963 d2        b    getdl             cvt3 has delta no of sought temp
4964           mn   &1,table&x1       mark delta deleted
4965           lca  0&x3,hld35#35
4966           sar  x1
4967 *   delete temp
4968 cmp3      c    x1,x2
4969           be   hlft
4970           mvdwnx1,x3
4971           b    cmp3
4972 *  x1 # x2 units posn of temp to be optimized
4973 * x3 # units of insertion of optimized temp
4974 *  insert temp in string
4975 hlft      c    0&x2
4976           sar  x1               x1 at hi ord of old temp
4977           bw   cw2,prtsw
4978 ckrt      bce  nort,right,*
4979           bce  fst1,op,#
4980           lca  right,0&x3
4981           sbr  x3
4982           cw   1&x3
4983 nort      lca  op,0&x3
4984           sbr  x3
4985           cw   1&x3
4986           lca  hld35,0&x3
4987           sbr  x3
4988           sbr  x2               x2 noa at new loc of temp
4989 *   shift rest of statement
4990 load2     lca  0&x1,0&x3
4991           sar  x1
4992           c    0&x3
4993           sar  x3
4994           bce  *&5,1&x1,}    gm
4995           b    load2
4996           b    blkop
4997 *   delta is right operand
4998 delt2     bce  *&5,hldop,       blank
4999           b    canu
5000           bce  first,op,#
5001           fbceqcomut,op,&,*
5002           bce  negat,op,-
5003           b    cknd
5004 comut     lca  left,hld35
5005           lca  right,left
5006           lca  hld35,right
5007           b    delt1
5008 negat     bw   kwm,prtsw
5009           lca  left,0&x2
5010           lca  @&@
5011           sbr  x2
5012           cw   2&x2,xnegtf
5013 neg3      lca  right,left
5014           lca  @***@,right
5015           mcw  @n@,op
5016           cw   xnegtf
5017           sw   prtsw
5018           b    delt1
5019 *   in the middle of partially optimized temp
5020 big       bce  tuf,right,*
5021           mcw  op,bce1&7
5022 bce1      bce  maybe,@&-*@@, 0
5023           chain3
5024 tuf       bw   *&5,prtsw
5025           b    add3
5026           b    kwm
5027 tuf2      bw   adjst,2&x2
5028           sbr  x2
5029           b    tuf2
5030 adjst     sbr  x2,1&x2
5031           bce  outpt,1&x2,}          gm
5032           b    add3
5033 kwm       sbr  kwmxt&3
5034           cw   1&x2
5035 kwmxt     b    0
5036 maybe     bce  *&5,hldop,            blank
5037           b    adnl
5038           mcw  op,hldop
5039 mesur     cw   1&x2
5040           lca  right,0&x2
5041           sbr  x2
5042           cw   midsw#1
5043           sbr  cw5&3,1&x2
5044           b    cwprt
5045 adnl      fbceqhope,hldop,&,-
5046           fbceqmesur,op,*,/
5047           b    tuf
5048 hope      fbceqmesur,op,&,-
5049           b    tuf
5050 *  delta found in middle of large string
5051 canu      mcw  op,*&8
5052           bce  swap,hldop,0
5053           fbceqhope2,hldop,&,-
5054 cknd      bce  outpt,1&x2,}          gm
5055           bw   tuf,prtsw
5056           bw   add3,1&x2
5057           b    tuf
5058 hope2     fbceqswap,op,&,-
5059           b    cknd
5060 *  shift middle delta to front of string
5061 swap      bce  tuf,op,@
5062           bw   kwm,prtsw
5063           c    0&x2,blk4
5064           sar  x3
5065           mcw  0&x3,0&x2
5066           sbr  x2
5067           bce  neg2,op,-
5068           mcw  op,0&x2
5069           mcw  right
5070           c    0&x2
5071           sbr  x2                  ??? SAR ???
5072           b    blkop
5073 neg2      lca  @&@,0&x2
5074           sbr  x2
5075           sw   prtsw
5076           b    neg3
5077 first     b    cvtdl
5078           dcw  right
5079           mcw  right,maxdl#3
5080           mcw  cvt3,curdl
5081           a    &1,curdl
5082           b    d2
5083 fst1      lca  hld35,0&x3
5084           sbr  x2
5085           lca  op
5086           sbr  x3
5087           cw   1&x3
5088           lca  left,0&x3
5089           lca  gm1
5090           b    blkop
5091 *  all optimization has taken place - output statement
5092 outpt     mcw  hex1,x1
5093           sbr  hex2#3,0&x2
5094           bce  noptm,2&x2,,       if statement
5095           bce  noptm,maxdl-2,<    12-6-8
5096           bce  noptm,0&x2,$
5097           bce  noptm,bop,$
5098           bwz  ckfix,bop-1,k
5099           bwz  noptm,aop-1,k
5100           bwz  noptm,aop-1,s
5101           b    optm
5102 ckfix     bwz  noptm,aop-1,2
5103           bwz  noptm,aop-1,b
5104 *  generate inline coding
5105 optm      b    noptm
5106           lca  bop
5107           lca  aop
5108           lca  @l@
5109           sbr  x3
5110           cw   2&x3,5&x3
5111           mz   *-4,3&x3
5112           mz   *-4,6&x3
5113           sbr  x1,6&x1
5114           lca  6&x2
5115           lca
5116           sbr  x2,6&x2
5117           b    nustm
5118 *  cannot generate inline coding
5119 noptm     mcw  @01@,maxdl
5120           mcw  @001@,x3
5121           mcw  @01@,dl2#2
5122           sbr  x1,4&x1
5123           lca  @b700@
5124 ckzro     bce  prodl,table&x3,0
5125 decr      a    &1,dl2
5126           mcw  dl2,maxdl
5127           mz   dl2-1,maxdl
5128           a    &1,x3
5129           sw   prtsw
5130           b    ckzro
5131 prodl     lca  @#@,4&x1
5132           lca  maxdl
5133           cw   4&x1
5134           c    0&x1,@b700@
5135           be   *&5
5136           cw   1&x1
5137           lca  gm1,1&x2
5138 cx2       c    0&x2
5139           sar  x2
5140           bce  kwm2,0&x2,#
5141           bce  sub3,1&x2,$
5142           mz   2&x2,2&x1
5143 bmpx1     sbr  x1,4&x1
5144 *  string to output area
5145 pmov      mcm  1&x2,1&x1
5146           mn
5147           sbr  x1
5148           mcm  1&x2
5149           mn
5150           sar  x2
5151           bce  pmov,0&x2,|
5152           c    0&x2
5153           sar  x2
5154           mcw  x3,hex3#3
5155           mcw  @|@,0&x1
5156           lca  0&x2
5157           sbr  x3
5158           cw   0&x1,1&x3
5159           c    0&x2
5160           sar  x3
5161           bce  eostr,0&x3,}          gm
5162           sbr  x2,0&x3
5163           mcw  hex3,x3
5164           b    decr
5165 kwm2      cw   1&x2
5166           b    cx2
5167 sub3      mz   3&x2,2&x1
5168           b    bmpx1
5169 *  all of statement to output area
5170 eostr     c    0&x1,blk4#4
5171           sar  x1
5172           lca  @|@,0&x1
5173           mcw  0&x2
5174           mcw  hex2,x2
5175           bw   docod,6&x2
5176           sw   3&x2
5177           sbr  x1,9&x1
5178           lca  11&x2
5179           sbr  x2,11&x2
5180 docod     sbr  x1,6&x1
5181           lca  6&x2
5182           lca
5183           sbr  x2,6&x2
5184           b    nustm
5185 gm1       dc   @}@          g-m
5186 table     da   1x332,c
5187 tblr      equ  *
5188 *  gets operand left, operator, operand right
5189 fix       sbr  fixt&3
5190           bce  sub1,1&x2,$
5191           lca  3&x2,left#18
5192           mcw  4&x2,op#1
5193           sbr  x2,4&x2
5194           bw   *&5,midsw
5195 cw5       cw   0
5196           sw   midsw
5197           bw   unary,1&x2
5198           sw   1&x2
5199           sbr  cw&3,1&x2
5200           mn   0&x2,bce3&7
5201           mz   0&x2,bce3&7
5202 bce3      bce  istwo,@&-*@.#@,0
5203           chain5
5204           sw   prtsw
5205 unary     lca  @***@,right
5206           b    fixt
5207 istwo     bce  sub1,1&x2,$
5208           lca  3&x2,right#18
5209           sbr  x2,3&x2
5210           bw   cw,1&x2
5211           sw   1&x2,prtsw
5212 cw        cw   0
5213 fixt      b    0
5214 sub1      sbr  subxt&3
5215           sbr  x2,8&x2
5216           bce  subxt,3&x2,$
5217           sbr  x2,6&x2
5218 subxt     b    0
5219 *  converts any delta number to three characters
5220 cvtdl     sbr  x1
5221           sbr  cvtxt&3,3&x1
5222           mcw  2&x1,x1
5223           mn   0&x1,cvt3#3
5224           mn
5225           mcw  @0@
5226           bwz  cvtxt,0&x1,2
5227           a    &100,cvt3
5228           bwz  cvtxt,0&x1,s
5229           a    &100,cvt3
5230           bwz  cvtxt,0&x1,k
5231           a    &100,cvt3
5232 cvtxt     b    0
5233 *  finds temp to be optimized
5234 getdl     sbr  gdlxt&3
5235           sbr  x3,0&x2
5236           mcw  curdl,x1          x1 has current delta
5237           bw   getwm,prtsw
5238 cmp2      c    x1,cvt3
5239 gdlxt     be   0
5240           bce  add1,table&x1,1
5241           a    @i99@,x1
5242 getwm     bw   gotwm,2&x3
5243           sbr  x3
5244           b    getwm
5245 gotwm     sbr  x3,1&x3
5246           b    cmp2
5247 add1      a    @i99@,x1
5248           b    cmp2
5249 cw2       cw   1&x3
5250           b    ckrt
5251 prtsw     dc   #1
5252 fendx     fendxc,,,,,,sysgm,  arith 5
5253           ltorg*
5254 aop       equ  right
5255 bop       equ  left
5256 sysgm     dcw  @}@           system group mark
5257           org  *&50
5258 ndrith    equ  *
5259           xfr  start
5260           job  arith phase five                                       50373
5261           fbegnarith 5,x1,,x2,,x3,,y
5262           org  xbegin
5263 start     bce  noari,x2,.
5264           c    0&x2
5265           sar  x2
5266           sbr  savx3#3
5267           c    0&x1
5268           sar  x1
5269 *  beginning of processing of each statement
5270 nustm     mcw  0&x1,code
5271           mcw
5272           bce  mvdwn,code-3,e
5273           bce  *&5,code-3,r
5274           b    fendx
5275 mvdwn     mvdwnx1,x2
5276           lca  1&x2,2&x2
5277           sbr  x2
5278           cw   modsw#1
5279           bce  iftyp,2&x1,e
5280 ckxf      mvdwnx1,x2
5281           sbr  x3,0&x1
5282           sbr  hex3#3
5283           bce  eostr,0&x1,}       gm
5284 *  generate fix or float function if left side and right
5285 *     side are not of same mode
5286 next      mn   0&x3,bce5&7
5287           mz   0&x3,bce5&7
5288           sar  x3
5289 bce5      bce  gotsq,@&-@*.#@,0
5290           chain5
5291           b    next
5292 gotsq     bce  worry,1&x3,.
5293           mz   4&x3,opmd#1
5294           bce  sub5,2&x3,$
5295           mz   3&x3,opmd
5296 bmp4      sbr  x3,4&x3
5297 cmp5      c    x3,hex3
5298           be   scneq
5299           sbr  x3,1&x3
5300           fbceqmodch,0&x3,f,x
5301           b    cmp5
5302 modch     bw   cw1,modsw
5303           sw   modsw
5304           b    cmp5
5305 cw1       cw   modsw
5306           b    cmp5
5307 worry     sbr  bmpum&6,0&x3
5308           bce  grief,0&x3,$
5309           sbr  x3
5310 sndum     mz   0&x3,opmd
5311 bmpum     sbr  x3,0
5312           bce  sub5,2&x3,$
5313           b    bmp4
5314 grief     c    0&x3,blk8
5315           sar  x3
5316           bce  sndum,0&x3,$          dummy
5317           b               dummy
5318           b
5319           c    0&x3,blk6
5320           sar  x3
5321           b    sndum
5322 sub5      sbr  x3,12&x3
5323           bce  cmp5,0&x3,$
5324           sbr  x3,6&x3
5325           b    cmp5
5326 scneq     bce  goteq,0&x3,#
5327           sbr  x3
5328           b    scneq
5329 goteq     mcw  0&x3,hld18#18
5330           bce  sub1,hld18-1,$
5331           mz   hld18-2,fstmd#1
5332 nowop     bwz  ckfix,fstmd,s
5333           bwz  ckfix,fstmd,k
5334           bwz  ckswf,opmd,2
5335           bwz  ckswf,opmd,b
5336           bw   nocvt,modsw
5337 mkflt     mcw  @f@,0&x2
5338           sbr  x2
5339           cw   1&x2,xfltfu
5340           b    nocvt
5341 ckswf     bw   mkflt,modsw
5342           b    nocvt
5343 ckswx     bw   mkfix,modsw
5344           b    nocvt
5345 ckfix     bwz  ckswx,opmd,s
5346           bwz  ckswx,opmd,k
5347           bw   nocvt,modsw
5348 mkfix     mcw  @x@,0&x2
5349           sbr  x2
5350           cw   1&x2,xfixfu
5351 scan      equ  *&1
5352 nocvt     sbr  x3,0&x1
5353 scan2     bce  expn,0&x1,.
5354           bce  div,0&x1,@
5355           bce  eostr,0&x1,}          gm
5356           sbr  x1
5357           b    scan2
5358 *  end of statement routine
5359 eostr     mvdwnx3,x2
5360           bce  *&5,1&x3,}            gm
5361           b    eostr
5362           sbr  x1,0&x3
5363           b    nustm
5364 *  substitute / for @ as divide symbol
5365 div       mcw  @/@,0&x1
5366           sbr  x1
5367           b    scan2
5368 fendx     sbr  x1,5&x1
5369           mcw  savx3,x3
5370           sbr  x3,2&x3
5371 noari     fendxc,,,,,,sysgm,arith6
5372 *  generate if exits
5373 iftyp     c    0&x1
5374           sar  x1
5375           mcw  9&x1,minus
5376           mcw  6&x1,zero
5377           mcw  3&x1,plus
5378           mz   @k@,minus-1
5379           mz   @k@,zero-1
5380           mz   @k@,plus-1
5381           mcw  plus,else&3
5382           lca  blk20#20,hld20
5383           sbr  x3,hld20-20
5384           c    plus,zero
5385           be   pz
5386           c    zero,minus
5387           be   mkpls
5388           sbr  x3,8&x3
5389           mcw  ifzro
5390           mcw
5391           lca
5392           c    plus,minus
5393           be   mvls
5394 mkpls     sbr  x3,8&x3
5395           mcw  ifpls
5396           mcw
5397           lca
5398           mcw  minus,else&3
5399 mvls      mcw  x3,hex3
5400           bwz  *&5,code,2
5401           b    *&9
5402           bwz  lsadd,code-2,2
5403           mcw  code,x3
5404           mcw  0&x3,code
5405 lsadd     a    &1,code
5406           mcw  else&3,x3
5407           c    0&x3,code
5408           mcw  hex3,x3
5409           be   nobr
5410 all3      sbr  x3,4&x3
5411           mcw  else&3
5412           lca
5413 nobr      mvdwnx3,x2
5414           bce  ckxf,0&x3,|
5415           b    nobr
5416 pz        c    plus,minus
5417           be   all3
5418           sbr  x3,8&x3
5419           mcw  ifmns
5420           mcw
5421           lca
5422           b    mvls
5423 *  process exponentiation
5424 expn      sw   1&x1
5425           bce  xsub,1&x1,$
5426           lca  3&x1,xpon#17
5427           mz   2&x1,xpmod#1
5428           sbr  hex31#3,3&x1
5429           c    hex31,x3
5430           be   skip
5431           sw   4&x1
5432 mvbal     mvdwnx3,x2
5433           cw   1&x2
5434 skip      c    0&x1,blk4#4
5435           sar  x1
5436           bce  bsub,3&x1,$
5437           mz   2&x1,bmod#1
5438           sw   1&x1
5439 load      lca  3&x1,base#17
5440           sar  x1
5441           bwz  fixxp,xpmod,s
5442           bwz  fixxp,xpmod,k
5443           cw   xlogfn,xxpntl
5444           cw   xcomf1
5445 *  process floating exponentiation
5446           bwz  flt,bmod,2
5447           bwz  flt,bmod,b
5448           bwz  *&5,code,2
5449           b    *&9
5450           bwz  ftmsg,code-2,2
5451           mcw  code,x3
5452           mcw  0&x3,code
5453 ftmsg     ftmsg30,fix to float power,code,20
5454 flt       lca  @e@,0&x2
5455           lca  xpon
5456           lca  @g*@
5457           sbr  x2
5458           cw   3&x2,1&x1
5459           lca  base,0&x2
5460           sbr  x2
5461           cw   1&x2
5462           b    scan
5463 *  process fixed point exponentiation
5464 fixxp     bwz  sweat,xpmod,k
5465           bce  sweat,xpon-2,<    12-6-8
5466           mcw  xpon,x3
5467           ma   plusdf,x3
5468           c    @3@,0&x3
5469           bh   sweat
5470           lca  base,0&x2
5471           lca  @*@
5472           sbr  x2
5473           sbr  sav2#3
5474           cw   1&x2,2&x2
5475           lca  base,0&x2
5476           sbr  x2
5477           cw   1&x2
5478           bce  huh,0&x3,0
5479           bce  huh2,0&x3,1
5480           bce  scan,0&x3,2
5481           lca  @*@,0&x2
5482           sbr  x2
5483           cw   1&x2
5484           lca  base,0&x2
5485           sbr  x2
5486           cw   1&x2
5487           b    scan
5488 huh       mcw  sav2,x3
5489           mcw  @/@,1&x3
5490           b    scan
5491 huh2      mcw  sav2,x2
5492           sbr  x2,1&x2
5493           b    scan
5494 sweat     cw   xlogfn,xxpntl
5495           cw   xcomf1,xfltfu
5496           bwz  ctu1,bmod,2
5497           bwz  ctu1,bmod,b
5498           lca  @x@,0&x2
5499           sbr  x2
5500           cw   0&x2,xfixfu
5501           lca  xexpon,0&x2
5502           lca  @&@
5503           sbr  x2
5504           cw   2&x2
5505 ctu1      lca  @e@,0&x2
5506           lca  @f*<4?@          f,*,12-6-8,4,12-0
5507           lca  xpon
5508           sbr  x2
5509           cw   1&x2
5510           c    0&x1,blk4
5511           sar  x3
5512           bce  fsub,3&x3,$
5513 swm       sw   1&x3
5514           mvdwnx1,x2
5515           cw   1&x2
5516           lca  @g|@
5517           sbr  x2
5518           bwz  bsflt,bmod,2
5519           bwz  bsflt,bmod,b
5520           lca  @f@,0&x2
5521           sbr  x2
5522 bsflt     lca  base,0&x2
5523           lca  @<4?#@
5524           sbr  x2
5525           cw   5&x2
5526           c    0&x1,@b700@
5527           be   scan
5528           cw   1&x2
5529           b    scan
5530           dcw  @|@
5531 hld20     dcw  #20
5532 else      b
5533           dcw  #3
5534           bwz
5535 plus      dcw  #3
5536           dsa  277&x3
5537 ifpls     dc   @b@
5538           bce
5539 zero      dcw  #3
5540           dsa  280
5541 ifzro     dc   @0@
5542           bwz
5543 minus     dcw  #3
5544           dsa  277&x3
5545 ifmns     dc   @k@
5546 xsub      mz   3&x1,xpmod
5547           sbr  x1,11&x1
5548           bce  gotsb,0&x1,$
5549           sbr  x1,6&x1
5550 gotsb     c    x1,x3
5551           be   *&5
5552           sw   1&x1
5553           lca  0&x1,xpon
5554           sar  x1
5555           be   skip
5556           b    mvbal
5557 bsub      c    0&x1,blk8#8
5558           sar  x3
5559           bce  gtsub,1&x3,$
5560           c    0&x3,blk6
5561           sar  x3
5562 gtsub     mz   3&x3,bmod
5563           sw   1&x3
5564           b    load
5565 fsub      c    0&x3,blk8
5566           sar  x3
5567           bce  swm,1&x3,$
5568           c    0&x3,blk6#6
5569           sar  x3
5570           b    swm
5571 sub1      mz   hld18-9,fstmd
5572           bce  nowop,hld18-11,$
5573           mz   hld18-15,fstmd
5574           b    nowop
5575           dcw  #1
5576 code      dcw  #3
5577           ltorg*
5578 sysgm     dcw  @}@           system group mark
5579           xfr  start
5580           job  Fortran arith phase six                                50383
5581           fbegnarith six,x1,,x2,,x3,,s
5582 nxtop     equ  086
5583           org  xbegin
5584 inish     bce  fendx,x2,.
5585           sbr  hex2#3,0&x2
5586           mn   0&x3
5587           mn
5588           sar  nomo#3
5589           sbr  hex1#3,0&x1
5590           mcw  nxtop,mxtmp
5591           mcw  parama&6,tmpsz#3
5592           mn   &0,tmpsz-2
5593           a    &2,tmpsz
5594           c    tmpsz,parama&4
5595           bl   start
5596           mcw  parama&4,tmpsz
5597 start     c    x2,nomo
5598           be   dun
5599           mcw  table&165,table&164
5600 getum     bce  gotum,2&x2,<        delta   12-6-8
5601           sbr  x2
5602           bce  nxguy,1&x2,}        gm
5603           b    getum
5604 gotum     mn   4&x2,dlval#3
5605           mn
5606           mcw  @0@
5607           bwz  bmpum,4&x2,2
5608           a    &100,dlval
5609           bwz  bmpum,4&x2,s
5610           a    &100,dlval
5611           bwz  bmpum,4&x2,k
5612           a    &100,dlval
5613 bmpum     mcw  dlval,x3
5614           a    x3
5615           a    dlval,x3
5616           bce  assgn,5&x2,#
5617           mcw  matrx-1&x3,x1
5618           mcw  @|@,table-1&x1
5619           b    cmpad
5620 assgn     mcm  table
5621           sar  x1
5622           ma   -table,x1
5623           mcw  *-6,table-1&x1
5624           mcw  x1,matrx-1&x3
5625 cmpad     za   x1,accum-4
5626           m    tmpsz,accum#7
5627           sw   accum-4
5628           fpackaccum,4&x2,x3
5629           cw   accum-4
5630           ma   nxtop,4&x2
5631           c    x1,hytest#3
5632           bh   gobak
5633           mcw  x1,hytest
5634           mcw  4&x2,mxtmp#3
5635           bwz  blwup,mxtmp,2
5636 gobak     sbr  x2,3&x2
5637           b    getum
5638 nxguy     sbr  x2,4&x2
5639           b    start
5640 dun       mcw  hex2,x3
5641           mcw  hex1,x1
5642           c    0&x1
5643           c
5644           sar  x1
5645           mcw  mxtmp,nxtop
5646 fendx     fendxd,,,,,,sys6,i/o two
5647 blwup     bw   gobak,lgsw
5648           cs   332
5649           cs
5650           mlc  @message 2 - object program too large@,270
5651           w
5652           sw   failsw,lgsw
5653           b    gobak
5654 matrx     da   1x1023
5655 table     da   1x165,|
5656 lgsw      dc   #1
5657           org  *
               ltorg*    WVS: Autocoder shouldn't load incld at org
5658 sys6      dcw  @}@        system and work group mark
5659           xfr  inish
5660           job  1401 Fortran  input/output phase two                   50393
5661           fbegni/o two,x1,,x2,r,x3,,u
5662           org  xbegin
5663 start     bce  out,0&x1,
5664           mcw  0&x1,code#4
5665           mcw  code-3,*&8
5666           bce  work,@bzn@,0                  d char initialized
5667           bce
5668           bce
5669 out       fendxc,,,,,,sys1,cgoto
5670 work      mcw  @b@,iocw
5671           mcw  @<@,2&x1                      12-6-8
5672           sbr  klobr&6,2&x1
5673           bce  ctu1,code-3,b
5674           mcw  @r@,iocw
5675           bce  ctu1,code-3,z
5676           mcw  @m@,iocw
5677 ctu1      mvdwnx1,x3
5678           lca  1&x1,2&x3
5679           sbr  x3
5680           bwz  *&5,code,2
5681           b    chng
5682           bwz  cknum,code-2,2
5683 chng      mcw  code,x2
5684           mcw  0&x2,code
5685 cknum     bce  nonum,0&x1,}                  12-7-8
5686           mn   0&x1
5687           sar  x2
5688           bce  const,0&x2,}                  12-7-8
5689 symb      mcw  @0@,tuno
5690           mcw  0&x1,mvmsk-3
5691           mcw  @d@,mvmsk-6
5692           mz   *-4,mvmsk-4
5693           cw   mvsw#1
5694 slide     c    0&x1
5695           sar  x1
5696           lca  iocw,0&x3
5697           sbr  x3                             to source
5698           bw   noint,mvsw
5699           sw   mvsw
5700           lca  mvmsk,0&x3                    load initialize
5701           sbr  x3
5702 noint     lca  1&x1,0&x3                     load gm
5703           sbr  x3
5704 klobr     bce  start,0,<                     12-6-8
5705           fquit
5706 nonum     ftmsg33,no tape unit number,code,21
5707           mcw  @0@,tuno
5708           b    symb
5709 const     mn   0&x1,tuno
5710           b    slide
5711 mvmsk     dcw  @mxxx0?4@          0,12-0,4
5712 iocw      dcw  @u%u0x@
5713 tuno      equ  iocw-1
5714           ltorg*
5715 sys1      dcw  @}@           system group mark
5716           xfr  start
5717           job  1401 Fortran  computed go to phase                     50403
5718           fbegncgoto,x1,,x2,r,x3,,.
5719           org  xbegin
5720 initl     sw   gm1,gm2
5721 start     bwz  out,0&x1,1
5722           mcw  0&x1,id#3
5723           mcw  id,mask
5724           mcw  @]@,1&x1                      11-5-8
5725           sbr  klobr&6,1&x1
5726           c    0&x1
5727           sar  x1
5728           c    2&x1,@t@
5729           bu   dun
5730 small     s    max#2
5731 loop      mn   0&x1
5732           mn
5733           mn
5734           sar  x1
5735           a    &1,max
5736           c    max,&11
5737           be   error
5738           c    0&x1,@,@
5739           bu   loop
5740           mn   0&x1
5741           sar  x1
5742           b    ruadr
5743           lca  mask,0&x3
5744           lca  trap
5745           lca
5746           lca
5747           sbr  x3
5748           sbr  x1,1&x1
5749 anymo     bw   nomo,4&x1
5750           sw   brnch-6
5751           mn   max,brnch
5752           mcw  I
5753           mcw  6&x1
5754           sar  x1
5755           cw   brnch-6
5756           mz   @k@,brnch-5
5757           mz   *-4,brnch-2
5758           lca  brnch,0&x3
5759           sbr  x3
5760           s    &1,max
5761           b    anymo
5762 nomo      lca  gm1,0&x3
5763           sbr  x3
5764 botm      c    0&x1
5765           sar  x1
5766 klobr     bce  start,0,]                     11-5-8
5767           fquit
5768 ruadr     sbr  exrua&3
5769           s    count#1
5770 ok        mn   0&x1,test&7
5771           sar  x1
5772           bce  rufix,count,b
5773           a    &1,count
5774 test      bce  ok,@0123456789@,0
5775           chain9
5776 err1      bce  error,0&x1,}                  12-7-8
5777           sbr  x1
5778           b    err1
5779 rufix     bwz  fixed,2&x1,k
5780           b    err1
5781 fixed     mz   blank#1,2&x1
5782           mcw  3&x1,i
5783           c    0&x1,gm1
5784           bu   err1
5785 exrua     b    0
5786 error     bwz  *&5,id,2
5787           b    zone
5788           bwz  print,id-2,2
5789 zone      mcw  id,x2
5790           mcw  0&x2,id
5791 print     ftmsg34,computed go to syntax,id,23
5792           b    botm
5793 gm1       dc   @}@                           gm
5794           dcw  @t@
5795           dc   xlinks              inoperative in ver 3
5796 i         dcw  #3
5797           dcw  #3                            max value of i
5798 base      dcw  #3                            base address of table
5799 gm2       dc   @}@                           gm
5800 mask      dc   #3
5801 dun       sbr  x1,5&x1
5802 out       fendxc,,,,,,syscg,gomsk
5803 brnch     dcw  @bxxxxxxa@
5804           nop  1001
5805           h
5806 trap      dcw  @biib@
5807           ltorg*
5808 syscg     dcw  @}@                           system group mark
5809           xfr  initl
5810           job  1401 Fortran  go to mask phase                         50413
5811           fbegngomsk,x1,,,,x3,,*
5812           org  xbegin
5813 start     bce  out,0&x1,                     blank
5814           mcw  0&x1,code#4
5815           bce  ctu,code-3,g
5816 out       fendxc,,,,,,sys1,stop/pause
5817 ctu       mvdwnx1,x3
5818           lca  1&x3,2&x3
5819           sbr  x3
5820           mvdwnx1,x3
5821           mcw  @b@,1&x3
5822           lca  1&x1
5823           sbr  x3
5824           mz   @k@,4&x3
5825           b    start
5826           ltorg*
5827 sys1      dcw  @}@                           system group mark
5828           xfr  start
5829           job  1401 Fortran  stop/pause phase                         50423
5830           fbegnstop/pause,x1,,x2,,x3,,3
5831           org  xbegin
5832 start     cs   299
5833 nutyp     bce  out,0&x1,                     blank
5834           mcw  0&x1,code#4
5835           fbceqdoit,code-3,a,s
5836 out       fendxc,,,,,,sys1,light
5837 doit      mcw  @<@,2&x1                      12-6-8
5838           sbr  klobr&6,2&x1
5839           mvdwnx1,x3
5840           lca  1&x3,2&x3
5841           sbr  x3
5842           bce  noad,0&x1,}                   gm
5843           cs   work
5844           fflip0&x1,lowk,x1,x2,,wm
5845           sw   lowk
5846           bce  okay2,lowk&3,                 blank
5847           mcw  msg1,222
5848           mcw  msg2,247
5849           mcw  lowk&4,228
5850           mcw  lowk&2,251
5851 okay2     bce  *&5,lowk&2,                   blank
5852           b    setup
5853           mcw  lowk&1,lowk&2
5854           mcw  @0@
5855           b    okay2
5856 noad      lca  @000@,lowk&2
5857           c    0&x1
5858           sar  x1
5859 setup     mcw  lowk&2,save3#3
5860           a    @0@,lowk&3
5861           c    lowk&2,save3
5862           be   aok
5863           bce  nuerr,201,                    blank
5864 rtn       mz   blnk3#3,251
5865           mz
5866           mz
5867           b    aok
5868 nuerr     mcw  msg1,222
5869           mcw  msg2,247
5870           mcw  lowk&2,226
5871           mcw  lowk&2,251
5872           mcw  blank,223
5873           b    rtn
5874 aok       bce  ctu,201,                      blank
5875           w
5876           forms
5877           cs   299
5878 ctu       cw   lowk
5879           bce  pause,code-3,a
5880           lca  @biib@,0&x3
5881           lca  @.@
5882           lca  lowk&2
5883           lca  1&x1
5884           sbr  x3
5885           b    klobr
5886 pause     lca  @.@,0&x3
5887           lca  lowk&2
5888           lca  1&x1
5889           sbr  x3
5890 klobr     bce  nutyp,0,<                     12-6-8
5891           fquit
5892 msg1      dcw  @error 35 - halt number@
5893 msg2      dcw  @to be displayed as@
5894           org  *&x00
5895           org  *&99
5896           dcw  @n@
5897 lowk      ds   1
5898 work      ds   98
5899           ltorg*
5900 sys1      dcw  @}@                           system group mark
5901 blank     equ  blnk3-2
5902           xfr  start
5903           job  1401 Fortran  sense light phase                        50433
5904           fbegnlight,x1,,x2,r,x3,,5
5905           org  xbegin
5906 start     bce  out,0&x1,                     blank
5907           mcw  0&x1,code#4
5908           bce  doit,code-3,j
5909 out       fendxc,,,,,,sysl,ifcond
5910 doit      mvdwnx1,x3
5911           sbr  klobr&6,1&x1
5912           mcw  @]@,1&x1                      11-5-8
5913           lca  1&x3,2&x3
5914           sbr  x3
5915           mcw  code,hold#3                   mcw  0&x2,hold
5916           bwz  *&5,hold,2
5917           b    sweat
5918           bwz  ckgm,hold-2,2
5919 sweat     mcw  hold,x2
5920           mcw  0&x2,hold
5921 ckgm      bce  bad,0&x1,}                    gm
5922           mcw  0&x1,hld2#2
5923           bce  *&5,hld2-1,}           gm
5924           b    bad
5925           mn   0&x1,*&8
5926           bce  ok,@01234@,0
5927           chain4
5928 bad       ftmsg36,illegal sense light,hold,21
5929           sbr  x3,4&x3
5930           c    0&x1
5931           sar  x1
5932           b    start
5933 ok        mz   *-4,0&x1
5934           bce  zero,0&x1,0
5935           mn   0&x1,mask1
5936           lca  mask1,0&x3
5937           sbr  x3
5938 rtn       c    0&x1
5939           sar  x1
5940           lca  1&x1,0&x3
5941           sbr  x3
5942 klobr     bce  start,0,]                     11-5-8
5943           fquit
5944 zero      lca  @,@,0&x3
5945           lca  @,082084@
5946           sbr  x3
5947           b    rtn
5948 mask1     dcw  @)080@
5949           ltorg*
5950 sysl      dcw  @}@                           system group mark
5951           xfr  start
5952           job  1401 Fortran  if %hardware) phase                      50443
5953           fbegnifcond,x1,,x2,r,x3,,4
5954           org  xbegin
5955 start     bce  out,0&x1,          blank
5956           mcw  0&x1,code
5957           mcw
5958           fbceqdoit,code-3,w,k
5959 out       fendxc,,,,,,sys1,continue
5960 doit      mcw  @<@,2&x1            12-6-8
5961           sbr  klobr&6,2&x1
5962           mvdwnx1,x3
5963           lca  1&x3,2&x3
5964           sbr  x3
5965           mcw  0&x1,on
5966           mcw
5967           sar  x1
5968           mz   @k@,on-1
5969           mz   @k@,off-1
5970           bwz  *&5,code,2
5971           b    flip
5972           bwz  ckcom,code-2,2
5973 flip      mcw  code,x2
5974           mcw  0&x2,code
5975 ckcom     b    aok
5976 kill      c    0&x1
5977           sar  x1
5978           sbr  x3,4&x3
5979           b    start
5980 aok       mn   0&x1
5981           sar  x1
5982           bce  light,code-3,k
5983           mcw  0&x1,box#1                    process if sense
5984           mcw  box,*&8                        switch
5985           bce  aok2,@0123456@,0
5986           chain6
5987           ftmsg37,illegal sense switch,code,22
5988           b    kill
5989 aok2      a    &1,box
5990           mn   box,mask1
5991           mcw  on,mask1-1
5992           mcw  off,x2
5993           mcw  0&x2,x2
5994           s    &10,x2&1
5995           c    code,x2
5996           be   noxtr
5997           mcw  off,mask2
5998           lca  mask2,0&x3
5999           lca  mask1
6000           sbr  x3
6001 retrn     c    0&x1
6002           sar  x1
6003           lca  1&x1,0&x3
6004           sbr  x3
6005 klobr     bce  start,0,<                     12-6-8
6006           fquit
6007 noxtr     lca  mask1,0&x3
6008           sbr  x3
6009           b    retrn
6010 light     mcw  0&x1,box
6011           mcw  box,*&8
6012           bce  aok3,@1234@,0
6013           chain3
6014           ftmsg36,illegal sense light,code,21
6015           b    kill
6016 aok3      mcw  @080@,work3#3
6017           a    box,work3
6018           mcw  work3,mask3-1
6019           mcw  off
6020           mcw  work3,mask4
6021           mcw  on,x2
6022           mcw  0&x2,x2
6023           s    &10,x2&1
6024           c    code,x2
6025           be   cheap
6026           mcw  on,mask2
6027           lca  mask2,0&x3
6028           lca  mask4
6029           lca  mask3
6030           sbr  x3
6031           b    retrn
6032 cheap     lca  mask4,0&x3
6033           lca  mask3
6034           sbr  x3
6035           b    retrn
6036 off       dcw  #3
6037 on        dcw  #3
6038 mask1     dcw  @b   &@
6039           dcw  #1
6040 code      dcw  #3
6041 mask2     dcw  @b   @
6042 mask3     dcw  @v      1@
6043 mask4     dcw  @,   @
6044           ltorg*
6045 sys1      dcw  @}@                           system group mark
6046           xfr  start
6047           job  1401 Fortran  continue phase                           50453
6048           fbegncontinue,x1,,,,x3,,&
6049           org  xbegin
6050 start     bce  out,0&x1,                     blank
6051           mcw  0&x1,code#4
6052           bce  isctu,code-3,c
6053 out       fendxc,,,,,,sys1,domsk
6054 isctu     mvdwnx1,x3
6055           lca  1&x1,2&x3
6056           c    0&x1
6057           sar  x1
6058           b    start
6059           ltorg*
6060 sys1      dcw  @}@                           system group mark
6061           xfr  start
6062           job  1401 Fortran  do phase                                 50463
6063           fbegndomsk,x1,,x2,r,x3,,%
6064 * do phase algorithm
6065 *
6066 *                     outer
6067 *
6068 *                   no   same  diff
6069 *          i       b xt  b xt  b xt
6070 *          n
6071 *          n   gm  t bk  t in  t bk
6072 *          e   ez  b bk  b in  b bk
6073 *          r   hd  - bk  - in  - bk
6074 *
6075           org  xbegin
6076 initl     sw   gm1,gm2
6077           sw   gm3,gm4
6078           mcw  x3,hex3#3
6079 start     bwz  out,000&x1,1
6080           mcw  @<@,2&x1                      12-6-8
6081           sbr  klobr&6,2&x1
6082           c    000&x1
6083           sar  x1
6084           c    002&x1,@d@
6085           bu   dun
6086           cw   xdoad1,xdoad2
6087           cw   xdoad3,xdoini
6088           mcw  005&x1,x2
6089           mcw  000&x2,top#3
6090           mcw  000&x1,x2
6091           sar  x1
6092           mcw  000&x2,botm#3
6093           za   top,accum#3
6094           s    botm,accum
6095           mcw  @n@,swtch
6096           bwz  err1,accum,b
6097           mcw  x1,x2
6098           mcw  @   @,exit
6099           mcw  @t@,gobak-3
6100           mcw  @b@,noapx
6101 loop      c    000&x2
6102           c
6103           sar  x2
6104           c    002&x2,@d@
6105           bu   difnt
6106           mcw  000&x2,x3
6107           c    000&x3,top
6108           bh   loop
6109           c    000&x3,botm
6110           bh   err2
6111           bce  rudif,1&x2,h
6112           mcw  @e@,1&x2
6113 rudif     bl   difnt
6114           mcw  @h@,1&x2
6115           mcw  5&x2,exit
6116 difnt     bce  mdify,4&x1,h
6117           mcw  @n@,noapx
6118           bce  mdify,4&x1,}        group mk
6119           mcw  @b@,gobak-3
6120 mdify     mcw  botm,mask
6121           sw   006&x1
6122           mcw  008&x1,mask-9
6123           mcw  008&x1,gobak
6124 cksyn     b    test
6125           dcw  @,@
6126           dcw  &i
6127           b    test
6128           dcw  @#@
6129           dcw  &m1
6130           b    test
6131           dcw  @,@
6132           dcw  &m2
6133           bwz  m3is1,000&x1,1
6134           b    test
6135           dcw  @,@
6136           dcw  &m3
6137           bwz  send,000&x1,1
6138           b    error
6139 send      mcw  hex3,x3
6140           mn   000&x1
6141           sar  x1
6142 swtch     nop  klobr
6143 noapx     nop  reg
6144           a    &1,gnstmz
6145           lca  mask,000&x3
6146           chain2
6147           sbr  x3
6148 reg       lca  gm2-1,0&x3
6149           chain8
6150           sbr  hex3
6151 klobr     bce  start,0,<                     12-6-8
6152           fquit
6153 test      sbr  x2
6154           c    000&x1,000&x2
6155           sar  x1
6156           bu   error
6157           mcw  003&x2,*&7
6158           mcw  000&x1,000
6159           s    count#1
6160 ok        a    &1,count
6161           bce  004&x2,count,d
6162           mn   000&x1,ruok&7
6163           sar  x1
6164 ruok      bce  ok,@0123456789@,0
6165           chain9
6166           b    error
6167 m3is1     mcw  oneadr,m3
6168           b    send
6169 err1      ftmsg38,illegal range of do,top,21
6170 avoid     mcw  @b@,swtch
6171           b    cksyn
6172 err2      ftmsg39,illegal nesting,top,17
6173           b    avoid
6174 error     ftmsg40,do syntax,top,11
6175           c    001&x1
6176           sar  x1
6177           b    klobr
6178 dun       sbr  x1,5&x1
6179 out       mcw  hex3,x3
6180           mn   0&x3
6181           sar  x2
6182 klear     cs   0&x2
6183           sbr  x2
6184           c    0&x2,doend
6185           bu   klear
6186           fendxe,gm1,,,beginz,,tabelz,resort 1
6187 gm1       dc   @}@        group mk
6188           dcw  @t@
6189           dc   doadr1
6190           dcw  @t@
6191           dc   doadr2
6192 m1        dcw  #3
6193 m2        dcw  #3
6194 m3        dcw  #3
6195 i         dcw  #3
6196 exit      dcw  #3
6197 gm4       dc   @}@        group mk
6198           dc   #3             xyz of internal number
6199 gm2       dc   @}@       group mk
6200           dcw  @t@
6201 gobak     dc   #3
6202 gm3       dc   @}@        group mk
6203 mask      dc   #3
6204           ltorg*
6205           dcw  @}@                           system group mark
6206           org  *&x00
6207 doend     equ  *
6208           xfr  initl
6209           job  1401 Fortran  resort phase one                         50473
6210           fbegnresort 1,x1,,x2,,x3,,z
6211           org  xbegin
6212 three     dcw  0
6213 count     dcw  000
6214 aside     dcw  000
6215 tbl1      dcw  000
6216 last      dcw  000
6217 store     dcw  000
6218 sauce     dcw  000
6219 diff      dcw  000
6220 addin     dcw  000
6221 intno     dcw  000
6222 fromx     equ  sauce
6223 wkbk1     dcw  00000
6224 wkbk2     dcw  00000
6225 area1     dcw  00000
6226 adres     equ  bsauce
6227 tbl2      dcw  000
6228 test1     dcw  0
6229 zone      dcw  99
6230 hold      dcw  @     @
6231 cnvrt     dcw  @     @
6232 table     dcw  9
6233           dc   9
6234           dcw  @z9@
6235           dcw  @r9@
6236           dcw  @i9@
6237           dcw  @9z@
6238           dcw  @zz@
6239           dcw  @rz@
6240           dcw  @iz@
6241           dcw  @9r@
6242           dcw  @zr@
6243           dcw  @rr@
6244           dcw  @ir@
6245           dcw  @9i@
6246           dcw  @zi@
6247           dcw  @ri@
6248           dcw  @ii@
6249 k5tok3    sbr  cmbck&3            convert five digit number
6250           za   cnvrt-3,x1         to three digit adres
6251           mz   @ @,x1                        blank
6252           a    x1
6253           mz   table&x1,cnvrt-2
6254           mz   table&1&x1,cnvrt
6255 cmbck     b    0000
6256 expnd     sbr  czone&10           convert three digit adres
6257           mlc  @     @,hold       to five digit number
6258           mn   cnvrt,hold
6359           mn
6260           mn
6261           mz   cnvrt,zone
6262           mz   cnvrt-2,zone-1
6263           mlc  &table&1,czone&6
6264           s    cnvrt
6265 czone     c    zone,000
6266           be   000
6267           a    @1@,hold-3
6268           sw   czone&4
6269           a    @002@,czone&6
6270           cw   czone&4
6271           b    czone
6272 imvup     sbr  here&3
6273           mn   0&x3
6274           sar  x3
6275 remck     mcm  1&x3
6276           mn
6277           sbr  x3
6278           bce  remck,0&x3,|
6279           sbr  x3,1&x3
6280 here      b    0
6281 errms     fquit
6282           ltorg*
6283 begin     sbr  sauce,0&x3
6284           sbr  x1,end
6285           sbr  tbl1              equiv to one below tbl1
6286           mlc  intst,tms3&6
6287           mz   @z@,tms3&5
6288 tms3      sbr  x1,0
6289           a    @1@,three
6290           c    three,@3@
6291           bh   tms3
6292           sbr  count,0&x1
6293           sbr  tbl2,1&x1         starting adres of tbl2
6294           mlc  @ @,three
6295           bce  *&5,gnstm,        do gen stmnts exist, tst blank
6296           b    *&27
6297           sbr  addin,1&x1
6298           sbr  cnvrt
6299           b    expnd
6300           mlc  hold,wkbk1
6301           b    room
6302           mlc  gnstm,wkbk2       starting adres of tbl2
6303           a    wkbk2             multiply by six
6304           a    wkbk2
6305           a    gnstm
6306           a    gnstm,wkbk2
6307           sbr  cnvrt,1&x1
6308           b    expnd
6309           mlc  hold,wkbk1
6310           a    wkbk2,wkbk1
6311           mlc  wkbk1,cnvrt
6312           b    k5tok3
6313           mlc  cnvrt,addin       one pos above tbl2
6314 room      mlc  sauce,cnvrt
6315           b    expnd
6316           mlc  hold,area1
6317           c    wkbk1,area1
6318           bh   *&5
6319           b    errms
6320           messg@starting address of statements@,43,1,k
6321           cs   332
6322           cs
6323           mcw  @seq@,208
6324           mcw  @starting address@,242
6325           mcw  @display@,256
6326           w
6327           cc   j
6328           cs   332
6329           cs
6330           lca  @000@,208
6331           mlc  fromx,x1
6332           sbr  x1,2&x1           gmwm1&1   top
6333           sbr  x3
6334           b    imvup
6335           mlc  x3,x2
6336           fendxc,,,begin,begin,begin,sys1,resort 2
6337           ltorg*
6338 sys1      dcw  @}@                           system group mark
6339           xfr  begin
6340           job  1401 Fortran  resort phase two                         50483
6341           org  begin
6342 110       dc   2
6343           mlc  tbl2,x3           adres of tbl2 in x3
6344           b    save
6345 init      sbr  x2,2&x2
6346           mz   x3,aside
6347           mlc  x2,x3
6248           b    imvup
6249           mlc  x3,x2             pos gmwm2&1 in x2
6250           mlc  aside,x3
6351 save      sbr  store,2&x2        pos gmwm3-1 in store
6352           bwz  *&5,0&x2,2        zone in huns pos of int no
6353           b    *&9
6354           bwz  cntnu,2&x2,2      tst for zn in unts pos of int no
6355           mlc  2&x2,x2           pckup intno from tbl put in x2
6356           mlc  0&x2,x2
6357           b    *&8
6358 cntnu     mlc  2&x2,x2           place intno in x2
6359           sbr  intno,0&x2
6360           sbr  mlply&6
6361           mz   @r@,mlply&5
6362 mlply     sbr  x2,0
6363           mlc  intno,*&14
6364           mz   @r@,*&6
6365           sbr  x2,0
6366           c    tabel&x2,@   @    test for filled table-blanks
6367           bu   gntbl
6368           mlc  x1,tabel&x2       hi ord pos of inst in tbl1
6369           b    setx1
6370 gntbl     sw   3&x3
6371           mlc  tabel&x2,5&x3     gen branch second in tbl2
6372           cw   3&x3
6373           mlc  x1,2&x3           orig inst first in tbl2
6374           mlc  @1@,test1         swtch for replc tbl
6375           sbr  tabel&x2,2&x3     low order pos of entry1, tbl2
6376           mz   @z@,tabel-1&x2    a zone in tens pos of tbl1
6377           sbr  x3,6&x3
6378 setx1     mlc  store,x2
6379           c    adres,store
6380           bu   reset
6381           bce  ctoal,test1,0
6382           mlc  @0@,test1
6383           mlc  x1,x3
6384           b    imvup
6385           mz   @z@,1&x3
6386 ctoal     mlc  addin,x2
6387           lca  @:@,0&x2           5-8 with wm above program
6388           mlc  tbl1,x3           adres one pos above table 1
6389           sbr  x3,3&x3
6390           mlc  86,cnvrt          true starting adres
6391           b    expnd
6392           mlc  hold,wkbk1
6393           sbr  cnvrt,0&x2
6394           b    expnd
6395           mlc  hold,wkbk2
6396           s    wkbk2,wkbk1
6397           bwz  *&5,wkbk1,k                 is diff neg
6398           b    *&8
6399           a    @16000@,wkbk1
6400           mlc  wkbk1,cnvrt
6401           b    k5tok3
6402           mlc  cnvrt,diff        diff bet act and fixed adres
6403           sbr  x2,1&x2           high ord adres of sorted program
6404           sbr  intst
6405           fendxc,,,,,,sys2,resort 3
6406 reset     mlc  x3,aside
6407           mlc  x1,x3
6408           b    imvup             set x1 to gmwm1&1 of nxt instr
6409           mlc  x3,x1
6410           mlc  aside,x3
6411           bce  *&15,test1,0
6412           mlc  @0@,test1
6413           mz   @z@,1&x1
6414           sbr  x1,4&x1
6415           b    init
6416           ltorg*
6417 sys2      dcw  @}@                           system group mark
6418           xfr  begin
6419           job  1401 Fortran  resort phase three                       50493
6420           org  begin
6421 110       dc   @3@
6422           sw   gmwm
6423           b    next&7
6424 next      sbr  x3,0               re-init x3
6425           sbr  last
6426           bce  adone,0&x3,        tst for blanks in tbl
6427           sbr  next&6,3&x3
6428           mn   0&x3
6429           sar  *&7
6430           bwz  case2,0,s          a zone in tens pos of tbl1
6431           mlc  0&x3,x1            place hi ord pos of inst in x1
6432           sbr  addin,0&x3
6433           mlc  x1,prep1#3         save x1
6434 space     mlc  x1,x3
6435           b    imvup
6436           mlc  x3,cnvrt
6437           b    expnd
6438           mlc  hold,area1
6439           a    @1@,area1
6440           mlc  prep1,cnvrt
6441           b    expnd
6442           mlc  hold,area2
6443           s    area2,area1        lngth of nxt inst to be moved
6444           mlc  x2,cnvrt           nxt avail pos in sorted area
6445           b    expnd
6446           mlc  hold,wkbk1
6447           b    nufrm
6448           bl   squez
6449 list      mlc  prep1,x1
6450           bce  *&12,test2,1       print stmt no, hi ord adres
6451           a    @1@,208
6452           b    addr1
6453           mlc  @0@,test2          reset indicator
6454           mlc  x3,gary&6
6455           mcw  3&x1,x3
6456           mcw  0&x3,x3
6457           sbr  3&x1,4&x3
6458           ma   diff,3&x1
6459           mcw  x1,hex1#3
6460 round     mz   *-4,9&x3
6461           mz   *-4,12&x3
6462           mz   *-4,15&x3
6463           mz   *-4,18&x3
6464           bce  outer,22&x3,       blank
6465           mcw  22&x3,x1
6466           mcw  0&x1,22&x3
6467           ma   @004@,22&x3
6468           ma   diff,22&x3
6469           mcw  0&x1,x3
6470           b    round
6471 outer     sbr  22&x3,4&x2
6472           ma   diff,22&x3
6473           mcw  hex1,x1
6474           bce  *&8,0&x1,b
6475           sbr  3&x1,doadr3
6476 gary      sbr  x3,0
6477 addr1     mcw  diff,227
6478           ma   x2,227
6479           mcw  227,x3
6480           mcw  x3,cnvrt
6481           b    expnd
6482           mcs  hold,244
6483           mcw  x3,256
6484           ma   @004@,256
6485           w
6486           forms
6587           mlc  x2,symbl-1
6488           bce  cntu2,0&x1,}        duz stmnt exist   12-7-8
6489           mn   0&x2                move statement
6490           sar  x2
6491 ctnmv     mcm  0&x1
6492           sar  strx1&6
6493           mcm  0&x1,1&x2
6494           mn
6495           sbr  x2
6496 strx1     sbr  x1,0
6497           bce  ctnmv,0&x2,|
6498           bwz  *&5,0&x1,2          duz replc tbl need updating
6499           b    chnge
6500           bwz  symbl,2&x1,2
6501           b    chnge
6502 cntu2     sbr  x1,1&x1
6503           mlc  @b@,symbl&7
6504 chnge     mlc  2&x1,x3             update replc table
6505           sbr  0&x3,0
6506 symbl     mlc  @:@,0&x1            mv symb into stmnt  5-8
6507           nop  botom               skip trawm for no stmnt
6508           mn   0&x1
6509           mn
6510           sar  x1                  gmwm2-1 of stmnt just moved
6511           mn   0&x2
6512           sar  trawm&6
6513 trawm     lca  0&x1,0&x2           transfer word marks
6514           sbr  trawm&6
6515           c    0&x1
6516           sar  x1
6517           bce  *&5,0&x1,}          12-7-8
6518           b    trawm
6519 botom     mlc  @n@,symbl&7        re-init nop branch
6520           c    last,count
6521           bu   tstcs
6522 ldsym     lca  @:@,0&x2            5-8
6523           sbr  x3
6524           fendxc,,,,,,sysgm,resort 4
6525 tstcs     bce  part2,test1,1      tst for 2nd part of gen int no
6526           b    next               sort next statement
6527 case2     mlc  0&x3,x3            low ord adres of tbl2
6528           mlc  0&x3,x1
6529           sbr  part2&10,3&x3
6530           mlc  @1@,test1
6531           b    space-14
6532 part2     mlc  @0@,test1          reset indicator
6533           mlc  0,x1
6534           mlc  part2&10,addin     prepx3 for wmtst
6535           mlc  @1@,test2
6536           b    space-7
6537 nufrm     sbr  streg&3
6538           mlc  fromx,cnvrt
6539           b    expnd
6540           mlc  hold,wkbk2
6541           s    wkbk1,wkbk2        space avail for nxt inst
6542           c    area1,wkbk2
6543 streg     b    0
6544 adone     a    @1@,208            add 1 for vanished stmnt
6545           c    last,count
6546           be   ldsym
6547           sbr  x3,3&x3
6548           sbr  last
6549           b    next&11
6550 fixit     sbr  fromx,2&x3         new gmwm1-1 if hi ord stmnt
6551 squez     mlc  fromx,x3           gmwm1-1 or hiord stmnt
6552           sbr  x3,2&x3            gmwm1&1 of hi ord stmnt
6553           b    imvup
6554           bce  fixit,0&x3,:       tst for used hi ord stmnts 5-8
6555           b    nufrm
6556           bl   loop-7
6557           b    list
6558           sbr  save1&6,0&x2
6559 loop      c    x3,parama&2
6560           be   lopp
6561           sbr  x1,3&x3            save gmwm3
6562           bce  mvagn-7,0&x1,}     12-7-8
6563 lopp      b    nufrm
6564           bl   errms
6565           b    save1
6566           sbr  x3,4&x3
6567 mvagn     b    imvup
6568           c    0&x3,@:@           search for used stmnt  5-8
6569           bu   loop
6570           sbr  hold2&6,0&x3
6571           sbr  store,2&x3
6572           sbr  x3,3&x3            tox adres in x3
6573 mvdwn     lca  0&x1,0&x3          overlay used stmnts
6574           sar  x1
6575           c    0&x3
6576           sar  x3
6577           bce  *&5,0&x1,}         12-7-8
6578           b    mvdwn
6579           mn   0&x1
6580           sar  aside
6581 hold2     sbr  x1,0
6582           bwz  *&5,1&x1,s         a zone in tens pos of inst
6583           b    *&8
6584           mlc  @1@,test3
6585           bwz  *&5,0&x1,2         tst for zn in intno st just moved
6586           b    *&9
6587           bwz  updat,2&x1,2       tst for zn in units pos
6588           mlc  2&x1,x1            adres of int no
6589           mlc  0&x1,x2            int no in x2
6590           b    *&8
6591 updat     mlc  2&x1,x2             init no in x2
6592           sbr  intno,0&x2         mult int no by 3
6593           sbr  mult&6
6594           mz   @r@,mult&5
6595 mult      sbr  x2,0
6596           mlc  intno,*&14
6597           mz   @r@,*&6
6598           sbr  x2,0               entry pos on tbl1
6599           bwz  achck,tabel-1&x2,s
6600           sbr  tabel&x2,1&x3      new hi ord pos in tbl1
6601           b    nupos&14
6602 achck     mlc  tabel&x2,x1
6603           bce  nupos,test3,1
6604           sbr  3&x1,1&x3          new hi ord pos in tbl2, entry2
6605           b    nupos&14
6606 nupos     sbr  0&x1,1&x3          new hi ord pos in tbl2, entry1
6607           mlc  @0@,test3
6608           c    aside,fromx        was whole top moved down
6609           be   rtnld
6610           mlc  aside,x1
6611           mn   0&x3
6612           mn
6613           mn
6614           sar  hold2&6
6615           sbr  x1,1&x1
6616           b    mvdwn
6617 rtnld     lca  gmwm,0&x3
6618           sbr  fromx              new gmwm1-1 of hi ord unsrt inst
6619           c    adres,store
6620           be   finis
6621           mlc  store,x3
6622           sbr  x1,1&x3
6623           sbr  x3,2&x3
6624           b    mvagn
6625 finis     b    nufrm
6626           bl   errms
6627 save1     sbr  x2,0
6628           mlc  addin,x3
6629           mlc  0&x3,prep1
6630           b    list
6631 area2     dcw  00000
6632 test2     dcw  0
6633 test3     dcw  0
6634           ltorg*
6635 gmwm      dc   @}@        work group mk
6636 sysgm     dcw  @}@       system group mk
6637           org  *&x00
6638 end       equ  *
6639 tabel     equ  end
6640           xfr  begin
6641           job  1401 Fortran  resort phase four                        5050a
6642           org  begin
6643 110       dc   4
6644           mlc  bsauce,x1
6645           sbr  x1,1&x1
6646           c    adtbll,x1
6647           be   endph
6648 const     sbr  x1,3&x1            nxt tbl entry
6649           mlc  0&x1,x2            contrnts of tbl in x2
6650           bwz  byp4,x2-1,2
6651           mcw  0&x2,0&x1
6652           b    cmp4
6653 byp4      ma   diff,x2
6654           mcw  x2,0&x1
6655 cmp4      c    x1,adtbll
6656           bu   const
6657 endph     mcw  diff,x1
6658           ma   x3,x1
6659           mcw  x1,rtr&6
6660           sbr  cnvrt,0&x3
6661           b    expnd
6662           mlc  hold,wkbk1
6663           mcw  hold,wkbk3#5
6664           mlc  diff,cnvrt
6665           b    expnd
6666           a    hold,wkbk1
6667           c    sixtn,wkbk1
6668           bl   *&8
6669           s    sixtn,wkbk1
6670           mlc  bsauce,cnvrt
6671           b    expnd
6672           c    hold,wkbk1
6673           bh   errms
6674           mz   x1,testa&7
6675           mcw  x1-2,testb&7
6676           mlc  intst,x2
6677           ma   diff,intst
6678           c    wkbk1,wkbk3
6679           bh   wmtst
6680 mvd       lca  0&x3,0&x1
6681           sar  x3
6682           c    0&x1
6683           sar  x1
6684           bce  *&5,0&x3,:         5-8
6685           b    mvd
6686 dun       cs   0&x1
6687           sbr  x1
6688           c    x1,@w99@
6689           bu   dun
6690           cw   0&x1
6691           cw
6692           cw
6693 rtr       sbr  x3,0
6694           sw   0&x1,1&x3
6695           mlc  diff,x2
6696           fendxd,,,,,,gm50a,shift cfl
6697 add1      a    &1,x2
6698 wmtst     bw   ldwrd,1&x2
6699           b    add1
6700 ldwrd     mlc  x2,x1
6701           ma   diff,x1
6702           lca  0&x2,0&x1
6703           c    x2,x3
6704           bu   add1
6705           lca  @  @,2&x3          blanks
6706           cw   1&x3
6707 testa     bwz  testb,x3,2
6708           cs   0&x3
6709           sbr  x3
6710           b    testa
6711 testb     bce  testc,x3-2,0
6712           cs   0&x3
6713           sbr  x3
6714           b    testb
6715 testc     c    x3,x1
6716           be   fin1s
6717           lca  @ @,0&x3           blank
6718           cw   0&x3
6719           sbr  x3
6720           b    testc
6721 fin1s     mcw  intst,x1
6722           ma   @i9i@,x1
6723           b    dun
6724 sixtn     dcw  @16000@
6725           ltorg*
6726 gm50a     dcw  @}@                group mark
6727           xfr  begin
6728           job  shift constants,formats,and lists                      5050b
6729 110       dcw  @shift cfl@
6730 nxbtm     equ  83
6731           org  beginz
6732           c    parama&2,conlst
6733           be   exit
6734           mcw  bsauce,x1
6735           mcw  bsauce,x2
6736           ma   macfls,x2
6737           sbr  rsx3&6,0&x3
6738           cw   cnvrt-2
6739           mcw  x2,cnvrt
6740           b    expnd
6741           mcw  hold,x25#5
6742           mcw  x3,cnvrt
6743           b    expnd
6744           mcw  hold,x35#5
6745           c    x25,x35
6746           bh   errms
6747           mcw  bsauce,cnvrt
6748           b    expnd
6749           mcw  hold,nxbtm5#5
6750           mcw  conlst,cnvrt
6751           b    expnd
6752           mcw  hold,cnlst5#5
6753           c    nxbtm5,cnlst5
6754           bl   wrdmv
6755 mad       ma   @001@,x1
6756           ma   @001@,x2
6757           bw   ldwm,0&x1
6758           cw   0&x2
6759           mn   0&x1,0&x2
6760           mz   0&x1,0&x2
6761 cwx1      cw   0&x1
6762           c    x1,conlst
6763           bu   mad
6764           mlc  conlst,x3
6765           b    tstwm
6766 ldwm      lca  0&x1,0&x2
6767           b    cwx1
6768 wrdmv     mlc  bsauce,x3
6769 tstwm     bw   manxb,1&x3         test for word markin test adr&1
6770           cw   wmsw#1
6771           sw   1&x3
6772 manxb     mcw  parama&2,x1
6773           mcw  conlst,x2
6774 load      lca  0&x1,0&x2
6775           sbr  x2
6776           sbr  x1
6777           ma   plusdf,x1
6778           c    x1,x3
6779           bu   load
6780           bw   rsx3,wmsw          branch if wm switch is on
6781           ma   macfls,x3
6782           cw   1&x3
6783 rsx3      sbr  x3,0
6784           ma   macfls,nxbtm
6785           ma   macfls,adtbll
6786           ma   macfls,bsauce
6787           mcw  parama&2,x1
6788 cx1cn     c    x1,conlst
6789           be   exit
6790           mcw  @ @,0&x1           move blanks to clear storage.
6791           cw   0&x1
6792           sbr  x1
6793           b    cx1cn
6794 exit      fendxc,,,xbegin,xbegin,,gm50c,replace 1
6795           ltorg*
6796 gm50c     dcw  @}@                group mark
6797           xfr  begin
6798           job  1401 Fortran  replace phase one                        50513
6799           fbegnreplace 1,x1,r,x2,,x3,,v
6800           org  xbegin
6801 init      mcw  x3,gary#3
6802           mcw  bsauce,*&7
6803           mcw  @>@,0            6-8 punch
6804           mcw  period,x2
6805           mcw  @>@,1600          6-8 punch
6806 scndl     bce  dolr,0&x2,$
6807           chain9
6808 ru68      bce  skgbg,0&x2,>      6-8 punch
6609           chain9
6610           sbr  x2
6811           b    scndl
6812 dolr      bce  fnd,0&x2,$
6813           sbr  x2
6814           b    dolr
6815 fnd       mn   0&x2
6816           sar  x2
6817           bce  setsw,0&x2,$
6818           chain15
6819           b    scndl
6820 setsw     cw   xdosbs
6821 dloop     mn   0&x2
6822           chain2
6823           sar  x2
6824           sw   1&x2
6825           bce  ndolr,0&x2,$
6826           mz   *-4,2&x2
6827           b    dloop
6828 ndolr     mn   0&x2
6829           sar  x2
6830           b    scndl
6831 skgbg     mcw  &test5,ru68&3
6832           mcw  x3,x2
6833           b    scndl
6834 test5     bce  exit,0&x3,         blank
6835           mcw  x3,sbr&6
6836           c    0&x3       move pointer
6837           sbr  x2
6838           sbr  x3
6839           bce  pskip,1&x3,|
6840 test2     bwz  test5,4&x2,1
6841           bwz
6842           bwz
6843           bm   replc,3&x2
6844           c    4&x2,@2g7@         change on reas. of obj arith
6845           be   test5
6846           bwz  addu,3&x2,b
6847 right     sbr  x2,3&x2
6848           b    test2
6849 addu      mcw  4&x2,x1
6850           mz   *-6,sbr&5
6851 sbr       sbr  4&x2,0
6852           b    right
6853 replc     mcw  4&x2,x1
6854           ma   macfls,x1
6855           mcw  0&x1,x1
6856           mcw  x1,4&x2
6857           b    right
6858 pskip     bw   skip,2&x3
6859           b    test5
6860 skip      c    0&x3
6861           sbr  x3
6862           c    4&x3,@b700@        change on reorigin of obj arith
6863           be   test5
6864           b    skip
6865 exit      mcw  gary,x3
6866           fendxc,,,,startr,,sys1,load 52b&c
6867           ltorg*
6868 sys1      dcw  @}@                          system group mark
6869           xfr  init
6870           job  load phase 52-sections b & c                           5052a
6871           sfx  r
6872 110       dcw  @load 52b&c@
6873           org  xbegin
6874 xlinks    dcw  #3
6875 yusr12    dcw  #3
6876 yusr11    dcw  #3
6877 yusr10    dcw  #3
6878 yuser9    dcw  #3
6879 yuser8    dcw  #3
6880 yuser7    dcw  #3
6881 yuser6    dcw  #3
6882 yuser5    dcw  #3
6883 yuser4    dcw  #3
6884 yuser3    dcw  #3
6885 yuser2    dcw  #3
6886 yuser1    dcw  #3
6887 sqrtfn    dcw  #3
6888 fltfun    dcw  #3
6889 fixfun    dcw  #3
6890 negtfn    dcw  #3
6891 absval    dcw  #3
6892 atanfn    dcw  #3
6893 xpnetl    dcw  #3
6894 logfun    dcw  #3
6895 sinfun    dcw  #3
6896 comfn1    dcw  #3
6897 dosbsc    dcw  #3
6898 oblist    dcw  @j32@   fmtxt   change if obj format reassembled
6899 doinit    dcw  #3
6900 doadr3    dcw  #3
6901 doadr2    dcw  #3
6902 doadr1    dcw  #3
6903 tblad     dcw  doadr1
6904 fixwd     dcw  #3
6905 fltwd     dcw  #3
6906 start     b    exit3
6907 ld52c     fendx,,,start,start1,,gmwm,funload c
6908           ltorg*
6909 exit3     sbr  initap&6,333
6910           sbr  bclear,exit3
6911           fendxc,,,,ld52c,,gmwm,funload b
6912           ltorg*
6913           org  1696
6914 gmwm      dcw  @}@                group mark
6915           xfr  start
6916           job  1401 Fortran  function/subroutine loader-b             5052b
6917           fbegnfunload b,x1,r,x2,r,x3,,r
6918 nxbtm     equ  83
6919           org  333
6920           h    333
6921 start1    cs   080
6922           mcw  x3,hex3
6923           sbr  x3,1&x3
6924           sw   1,40
6925           sw   47,54
6926           sw   61,68
6927           sw   72
6928           mcw  montor,read
6929           b    get
6930           mcw  nxbtm,x2
6931           mn   0&x2
6932           mn
6933           sbr  klobr&6
6934           mcw  @_@                11-7-8
6935           nop
6936 loop2     mcw  x3,nop4&3
6937           mz   @b@,nop4&2
6938           mcw  dsa,x3
5939 nop4      nop  0
5940           sar  x3
5941 get2      b    get
5942 aget2     c    005,@____@                   all 11-7-8
5943           bu   mvad
6944           mcw  x3,hxcmn#3
6945           b    get2
6946 mvad      mcw  tbad2,x1
6947 bmpt2     sbr  tbad2,1&x1
6948 cx1       c    x1,&ndtabl
6949           be   out
6950           mcw  @h@,bmpt2
6951           c    tblad,&yuser1
6952 ckusr     be   stotp
6953           mcw  tblad,x2
6954           c    0&x2
6955           sar  tblad
6956           bw   nodic,0&x1
6957 nopsw     mcw  @n@,sw1
6958 ckzn      bwz  pure,42,2
6959           mn   46,load&6
6960           chain5
6961           mz   46,load&6
6962           mn
6963           mz
6964 load      lca  0,0&x3
6965           sbr  x2
6966 sw1       nop  ctu1
6967           mcw  tblad,x1
6968           sbr  3&x1,1&x2
6969           mcw  @b@,sw1
6970 ctu1      mz   45,hldzn#1
6971           b    reloc                         field
6972           s    x1&1
6973 dowm      c    50&x1,@040@                  process subsequent
6974           be   read2                         data fields if any
6975           mcw  50&x1,setwm&3
6976           mz   @b@,setwm&2
6977           bce  setwm,setwm,)
6978           mcw  @,@,setwm
6979 setwm     sw   0&x3                         set word mark in
6980           sar  x2                            storage
6981           b    brelc
6982           nop  000
6983 gmk1      dcw  @}@                group mark
6984           xfr  ld52cr
6985           job  1401 Fortran  function/subroutine loader-c             5052c
6986 110       dcw  @funload c@
6987           org  startr
6988 brelc     mz   49&x1,hldzn
5989           b    reloc                         relocate operands
6990 adds      nop  @4@,x1
6991 adds2     a    @3@,x1
6992           bce  type1,adds,a
6993           mcw  @a@,adds
6994           mcw  @n@,adds2
6995           bce  adds,setwm,)
6996           b    dowm
6997 type1     mcw  @n@,adds
6998           mcw  @a@,adds2
6999           b    dowm
7000 read2     mcw  46,last#3
7001           mcw  @n@,adds
7002           mcw  @a@,adds2
7003           b    get
7004 ckex      bce  end,68,b
7005           bce  end,40,/
7006           b    ckzn
7007 end       mcw  last,nop3&3
7008           mz   @b@,nop3&2
7009 nop3      nop  0&x3
7010           sar  x3
7011           sbr  hex3
7012           sbr  x3,1&x3
7013 klobr     bce  loop2,0,_                     11-7-8
7014           cs   332
7015           cs
7016           cc   1
7017           mcw  @message 2 - object program too large@,270
7018           w
7019           cc   1
7020           bce  *&6,montor,1
7021           rwd  1
7022           h    *-3
7023 pure      sbr  71,read2
7024           mcw  @b@,68
7025           b    40
7026 get       sbr  getxt&3
7027           mcw  @ @,001
7028 read      r    getxt
7029 mvnin     mcw  &9,rdcnt#1
7030 rdtap     rt   1,1
7031           ber  tperr
7032 getxt     b    0
7033 tperr     bsp  1
7034           s    &1,rdcnt
7035           bwz  rdtap,rdcnt,b
7036           nop  3333
7037           h
7038           b    mvnin
7039 reloc     sbr  relxt&3
7040           bwz  relxt,hldzn,2
7041           bwz  isb,hldzn,s
7042           mcw  x3,hex3#3
7043           bwz  sw2x2,4&x2,2
7044           mcw  hxcmn,x3
7045           mz   *-4,4&x2
7046 sw2x2     ma   x3,4&x2
7067           mcw  hex3,x3
7048           bwz  relxt,hldzn,k
7049 isb       mcw  x3,hex3
7050           bwz  mcwx2,7&x2,2
7051           mcw  hxcmn,x3
7052           mz   *-4,7&x2
7053 mcwx2     ma   x3,7&x2
7054           mcw  hex3,x3
7055 relxt     b    0
7056 nodic     b    get
7057           bce  get2,40,/
7058           bce  get2,68,b
7059           b    nodic
7060 out       nop  out2
7061           mcw  @b@,out
7062           sbr  tbad2,xsinfu
7063           mcw  hex3,x2
7064           sbr  gotofn,1&x2
7065           mcw  @n@,bmpt2
7066           mcw  @n@,nopsw
7067           mcw  @b@,sw1
7068           mcw  hex3,btm#3
7069           b    aget2
7070 stotp     mcw  hex3,top#3
7071           mcw  @n@,ckusr
7072           b    ckusr&5
7073 out2      mcw  hex3,x3
7074           mcw  parama&2,x2
7075           c    0&x2
7076           sar  x2
7077           sbr  fltwd
7078           c    0&x2
7079           sar  fixwd
7080           bce  mtpx1,xlinks,        blank
7081           mcw  xlinks,x1
7082           ma   @013@,x1
7083           mlc  conlst,0&x1
7084           cw   xlinkw
7085 mtpx1     mcw  top,x1
7086           mcw  btm,x2
7087           fendx,,,start,start,,1696,reload ss
7088 dsa       dsa  -2000
7089 tbad2     dcw  xdoad1
7090 logsw     dc   #1
7091           ltorg*
7092           dcw  @}@                          system group mark
7093           xfr  start1
7094           job  1401 Fortran  Relocatable package                      50533
7095 110       dcw  @]]]]]@        all 11-5-8     first card of package
7096 *
7097 *
7098 *         relocatable package appears here in system deck
7099 *         must manually zone address in oblst to relocate
7100 *
7101 *
7102 110       dcw  @;;;;;@        all 11-6-8     last card of package
7103           job  1401 Fortran reloading snapshot                        5053r
7104           sfx  #
7105 110       dcw  @reload ss@
7106           org  startr
7107 begin     b    exit1
7108 retrn     mcw  @d@,word
7109           cw   word
7110           fendxc,,,startr,startr,,gm53s,formatpak
7111           ltorg*
7112 exit1     sbr  initap&6,333
7113           sbr  bclear,exit1
7114           sbr  initxt&3,retrn
7115           sbr  tclear,gm53s
7116           lca  @snapshot53@,110
7117           b    monter
7118           ltorg*
7119           org  1696
7120 gm53s     dcw  @}@                group mark
7121           xfr  begin
7122           job  1401 Fortran snapshot 53s                              5053s
7123 xxx       equ  0
7124 xl1       equ  089
7125 xl2       equ  094
7126 xl3       equ  099
7127           org  333
7128           sbr  prtxt&3
7129           sbr  hldxt&6
7130           mcw  @000@,linct-2
7131           mcw  xl3, hld32&6
7132           mcw  xl1, hld31&6
7133           sbr  xl1, 1
7134           sbr  xl3, 202
7135           cs   332
7136           cs
7137           mcw  110,210
7138           bss  only,f
7139           cc   1
7140           mcw  094,250
7141 hldxt     sbr  216,xxx
7142 hld32     sbr  256,xxx
7143 hld31     sbr  244,xxx
7144           w
7145           cc   k
7146           za   &2,pgctr#2
7147 nulin     cs   332
7148           cs
7149           cc   j
7150           mcw  linct,306
7151           mcw
7152           sbr  mvhed&6
7153           mcw  @9@, ctr-1
7154 mvhed     mcw  ctr-1,xxx
7155           mcw  head
7156           sbr  mvhed&6
7157           a    @i0@, ctr#2
7158           bwz  mvhed, ctr-1, 2
7159           a    &1,linct-2
7160           w
7161 loop      sw   0&x3
7162           mcw  0&x1,0&x3
7163           bw   cmpab,0&x1
7164           cw   0&x3
7165 cmpab     c    xl1,parama&2
7166           bu   cpl
7167           w
7168           wm
7169 rstrx     mcw  hld31&6,xl1
7170           mcw  hld32&6,xl3
7171           cs   332
7171           cs
7173           bss  *&5,g
7174           b    prtxt
7175           h
7176 prtxt     b    0
7177 cpl       sbr  xl1, 1&x1
7178           bce  inc, xl3-2, 2
7179           sbr  xl3, 201
7180           w
7181           wm
7182           a    &1,pgctr
7183           c    pgctr,&15
7184           bu   nulin
7185           s    pgctr
7186           ccb  nulin,1
7187 only      mcw  word,220
7188           w    rstrx
7189 inc       a    &1,xl3
7190           b    loop
7191 head      dcw  @9........@
7192           dcw  @9-@
7193 linct     dcw  00000
7194           ltorg*
7195           dcw  @execute@
7196 word      dcw  @}@                group mark in 680
7197           xfr  retrn
7198           job  1401 Fortran  replace phase two                        50553
7199           sfx  q
7200 nxtop     equ  086
7201 nxbtm     equ  083
7202 x1        equ  089
7203 x2        equ  094
7204 x3        equ  099
7205 fixwd     equ  fixwdr
7206 fltwd     equ  fltwdr
7207           org  startr
7208 init      sbr  gary#3,1&x3
7209           sw   1&x3
7210           sbr  limit#3,0&x2
7211           sbr  top#3,0&x1
7212           mcw  parama&2,x2
7213           c    0&x2
7214           c
7215           c
7216           sbr  ron&6
7217           mcw  nxtop,x2
7218           mn   0&x2
7219           sar  top2#3
7220 test5     c    x3,limit
7221 swtch     be   exita
7222           c    0&x3
7223           sbr  x2
7224           sbr  x3
7225           bce  test2,1&x3,t
7226 ckfx      mcw  4&x3,box
7227           bce  fxflt,box-2,;       11-6-8
7228           bce  fxflt,box-2,_       11-7-8
7229           bce  ron,box-2,]         11-5-8
7230           mcw  box,4&x3
7231 ckbop     mcw  7&x3,box#3
7232           bce  fxflt,box-2,;       11-6-8
7233           bce  fxflt,box-2,_       11-7-8
7234           mcw  box,7&x3
7235           b    test5
7236 test2     bce  test5,4&x3,$
7237           c    0&x3,@b700@
7238           be   test5
7239           bwz  ckfx,4&x2,1
7240           bwz
7241           bwz
7242           mcw  @b@,1&x3
7243           mcw  4&x2,x1
7244           mcw  0&x1,x1
7245           mcw  x1,4&x2
7246           b    ckfx
7247 exita     mcw  &exit,swtch&3
7248           mcw  top,x3
7249           mcw  @w96@,limit   form-1 chg on reassm of obj format
7250           b    test5
7251 exit      mcw  gary,x3
7252           sbr  x3,1&x3
7253           mz   x3,all9
7254           mz
7255           mcw
7256           mz   nxbtm,all91
7257           mz
7258           mcw
7259           c    all9,all91
7260           be   spcl
7261           mcw  nxbtm,x3
7262 cleer     cs   0&x3
7263           sbr  x3
7264           c    x3,all9
7265           bu   cleer
7266 sngl      c    x3,gary
7267           be   eoj
7268           lca  blnk#1,0&x3
7269           sbr  x3
7270           cw   1&x3
7271           b    sngl
7272 spcl      mcw  nxbtm,x3
7273           b    sngl
7274 eoj       mcw  nxbtm,x3
7275           mcw  @|@,0&x3
7276           sbr  x3
7277           mcw  @]@,0&x3                       11-5-8
7278           mcw  0&x3
7279           sbr  x3
7280           lca  blnk,2&x3
7281           lca  blnk
7282           mcw  dosbsc,subscr
7283           fendxc,,,xbegin,xbegin,xbegin,sys2,snapshot
7284 ron       sbr  4&x3,0
7285           b    ckbop
7286 fxflt     sbr  fxt&3
7287           mcw  fixwd,box2
7288           bce  *&8,box-2,_        11-7-8
7289           mcw  fltwd,box2
7290           bce  eofx,box,0
7291           bwz  postv,box,b
7292 box2      equ  x2
7293           sw   box-1
7294 loop      a    &1,box
7295           bwz  dun2,box,b
7296           mn   0&x2
7297           sar  x2
7298           b    loop
7299 dun2      cw   box-1
7300 eofx      mcw  box2,box
7301 fxt       b    0
7302 postv     mn   box,sbr&6
7303           mn
7304 sbr       sbr  box,0&x2
7305           b    fxt
7306 all9      dcw  999
7307 all91     dcw  999
7308           ltorg*
7309 sys2      dcw  @}@                           system group mark
7310           xfr  init
7311           job  1401 Fortran  snapshot phase                           50563
7312           fbegnsnapshot,x1,r,,,x3,r,8,xxx
7313           org  xbegin
7314 start     bce  *&5,parama&8,s
7315           b    rstrx
7316           bw   nogud,failsw
7317           sbr  x1,4200
7318           sbr  x3,201
7319           bce  noio,parama&10,x
7320           bce  lio,parama&10,l
7321           bce  aform,parama&10,a
7322           b    print
7323 noio      sbr  x1,1600
7324           mcw  @01600@,linct
7325           mcw  @1696@,bigms
7326           b    print
7327 lio       sbr  x1,2000
7328           mcw  @02000@,linct
7329           mcw  @2015@,bigms
7330           b    print
7331 aform     sbr  x1,4600
7332           mcw  @04600@,linct
7333           mcw  @4616@,bigms
7334 print     messg@snapshot of object program@,60,1,j
7335           messg@input/output areas located from 001-332@,39,,j
7336           messgbigms,48,,k
7337           za   &3,pgctr
7338 nulin     cs   332
7339           cs
7340           cc   j
7341           mcw  linct,311
7342           mcw
7343           mcw
7344           sbr  mvhed&6
7345           mcw  @9@,ctr-1
7346 mvhed     mcw  ctr-1,xxx
7347           mcw  head
7348           sbr  mvhed&6
7349           a    @i0@,ctr#2
7350           bwz  mvhed,ctr-1,2
7351           a    &1,linct-2
7352           w
7353 loop      sw   0&x3
7354           mcw  0&x1,0&x3
7355           bw   cmpab,0&x1
7356           cw   0&x3
7357 cmpab     c    x1,parama&2
7358           bu   cpl
7359           w
7360           wm
7361 rstrx     fendxc,,,,begin/,,sysg,condeck1
7362 nogud     messg@snapshot deferred due to input errors@,37,j
7363           forms
7364           b    rstrx
7365 cpl       sbr  x1,1&x1
7366           bce  inc,x3-2,2
7367           sbr  x3,201
7368           w
7369           wm
7370           a    &1,pgctr#2
7371           c    pgctr,&15
7372           bu   nulin
7373           s    pgctr
7374           cc   1
7375           b    nulin
7376 inc       a    &1,x3
7377           b    loop
7378 bigms     dcw  @fixed object time routines located from 333-4279@
7379 head      dcw  @9........@
7380           dcw  @9@
7381           dcw  @-area-@
7382 linct     dcw  04200
7383           ltorg*
7384 sysg      dcw  @}@                           system group mark
7385           xfr  start
7386           job  1401 Fortran  condensed deck phase one                 50573
7387           fbegncondeck1,,,,,,,/
7388 last      equ  conlst
7389           org  xbegin
7390 pchcd     sbr  pxt&3
7391           a    &1,175
7392           bss  mcw18,b
7393           p
7394 pxt       b    0
7395 mcw18     mcw  180,280
7396           mcw
7397           wp
7398           forms
7399           b    pxt
7400           ltorg*
7401 begin     bce  gotta,parama&7,p
7402           b    fendx
7403 gotta     bw   fendx,failsw
7404           lca  conlst,last
7405           cs   180
7406           sw   101
7407           mcw  parama-1,180
7408           bss  messg,b
7409           b    cddmp
7410 messg     messg@condensed deck@,60,1,j
7411           b    cddmp
7412 fendx     fendxc,,,begin,begin,begin,sys1,condeck2
7413 cddmp     lca  @0000@,175
7414           bwz  litcs,parama&2,2
7415           mcw  cs1a,152
7416           b    pchcd
7417           mcw  parama&2,cs2xa
7418           mcw  cs2a,171
7419           b    pchcd
7420           b    dobc1
7421 litcs     mcw  cs1,144
7422           b    pchcd
7423           mcw  parama&2,cs2x
7424           mcw  cs2, 170
7425           b    pchcd
7426 dobc1     mcw  bc1,171
7427           cs
7428           lca  bc2,146
7429           b    pchcd
7430           b    fendx
7431 cs1       dcw  @,008015,019026,030,034041,045,053,0570571026@
7432 cs2x      dcw  @L068112,102106,113/101099/I99@
7433 cs2       dc   @,027a070028)027b0010270b0261,001/001113I0@
7434 bc1       dcw  @,0010011040@
7435 bc2       dcw  @,008015,022029,036040,047054,061068,072/061039@
7436           dcw  @,008015,022026,030037,044,049,053053@
7437 cs1a      dc   @N000000N00001026@
7438 cs2xa     dcw  @L068116,105106,110117B101/I9I@
7439 cs2a      dc   @#071029C029056B026/B001/0991,001/001117I0?@
7440           ltorg*
7441 sys1      dcw  @}@                           system group mark
7442           xfr  begin
7443           job  1401 Fortran  condensed deck phase two                 50583
7444           fbegncondeck2,,,,,,,2
7445           org  begin/
7446 start     mcw  montor,read
7447           bw   pchts,xlinkw        branch if xlinkf switch off
7448           mcw  montor,skpss        skip snapshot
7449           sbr  tperr&15,rdtps
7450           sbr  ck4b-1,mvnss
7451 skpss     r    endss
7452 mvnss     mcw  &9,rdcnt
7453 rdtps     rt   1,1
7454           ber  tperr
7455 endss     bce  *&5,68,b
7456           b    skpss
7457           sbr  getxt&3,ck4b        11-5-8 card already read
7458           sbr  tperr&15,rdtap      restore tperr operands
7459           sbr  ck4b-1,mvnin
7460           a    &1,nbrsw
7461 pchts     bce  *&5,parama&7,p
7462           b    read
7463           bw   nopun,failsw
7464           mcw  @1040@,171
7465           mcw  @l014100,092097,081082,083084@
7466           cs
7467           lca  @00000000000000@, 114
7468           mcw  @b@,retrn
7469           nop  pchcd
7470           mcw  @1040@,171
7471           mcw  ldfmt-1
7472           cs
7473           mcw  mask,157
7474           sw   sysc2
7475           mcw  sysc2,108
7576           mcw  parama&6
7577           mcw
7578           lca
7479 retrn     nop  pchcd
7480 read      r    getxt
7481 mvnin     mcw  &9,rdcnt#1
7482 rdtap     rt   1,1
7483           ber  tperr
7484 getxt     b    once
7485 tperr     bsp  1
7486           s    &1,rdcnt
7487           bwz  rdtap,rdcnt,b
7488           nop  3333
7489           h
7490           b    mvnin
7491 ck4b      bce  fendx,68,b
7492           mcw  71,171
7493           chain5
7494           b    retrn
7495 once      sbr  getxt&3,ck4b
7496           b    read
7497 nopun     messgmessg,43,,j
7498           b    read
7499 fendx     a    &1,nbrsw#1
7500           bce  exit,nbrsw,3
7501           bce  read,nbrsw,2
7502           bw   *&5,xlinkw          branch if xlinkf switch off
7503           b    read
7504           mcw  montor,skpxl        skip xlink
7505           sbr  tperr&15,rdtpx
7506           sbr  ck4b-1,mvnxl
7507 skpxl     r    endxl
7508 mvnxl     mcw  &9,rdcnt
7509 rdtpx     rt   1,1
7510           ber  tperr
7511 endxl     bce  *&5,68,b
7512           b    skpxl
7513           sbr  tperr&15,rdtap      restore tperr operands
7514           sbr  ck4b-1,mvnin
7515           b    fendx
7516 exit      sbr  getxt&3,fend2
7517           b    read
7518 fend2     bce  fend3,retrn,n
7519           cs   171
7520           sw   101
7521           mcw  @1040@,171
7522           mcw  ldfmt-1
7523           mcw  @m002v36@,146  change on reasm of ob arith xsize&6
7524           mcw  parama&4,102
7525           b    pchcd
7526           mcw  @837@,146      change on reasm of ob arith fsize&6
7527           mcw  parama&6,102
7528           b    pchcd
7529           mcw  @3t30@,146     change on reasm of ob arith out1-1
7530           mcw  gotofn,103
7531           b    pchcd
7532           mcw  @s09@,146      change on reasm of ob arith stsub&3
7533           mcw  subscr,103
7534           b    pchcd
7535 fend3     fendxc,,,xbegin,xbegin,xbegin,sysc2,condeck3
7536           dcw  @l008@
7537           dc   parama&7
7538           dc   @,@
7539           dc   parama&3
7540           dc   parama&5
7541           dc   @,@
7542 mask      dc   parama&7
7543 messg     dcw  @condensed deck deferred due to input errors@
7544 ldfmt     dcw  @l039000,040040,040040,040040$@
7545           ltorg*
7546 sysc2     dcw  @}@                           system group mark
7547 pchcd     equ  pchcd/
7548           xfr  start
7549           job  1401 Fortran  fixed routine for condensing routine     50593
7550 110       dcw  @]]]]]@     all 11-5-8    first card
7551 *
7552 *
7553 *         copy of fixed package
7554 *         snapshot - xlink - arith
7555 *
7556 110       dcw  @;;;;;@     all 11-6-8  last card
7557           job  1401 Fortran  condensed deck phase three               50603
7558           fbegncondeck3,x1,r,x2,r,x3,r,1
7559 last      equ  conlst
7560           org  xbegin
7561 begin     mcw  gogogo,x1
7562           bce  *&5,parama&7,p
7563           b    gary
7564           bw   gary,failsw
7565 rest      sbr  wpb&3,reset
7566           mcw  con40-11,box1
7567           mcw  @146@,x3
7568           mcw  @l@,140
7569 reset     cs   139
7570           forms
7571           mcw  con40,171
7572           sw   140
7573           cs   332
7574           cs
7575           sw   101
7576           mcw  @001@,x2
7577           mcw  @1@,flip#1
7578           mcw  box1#7,153
7579           bw   skip2,skpsw
7580 move      mn   0&x1,100&x2
7581           mz   0&x1,100&x2
7582 cpar      c    last,x1
7583           be   term
7584           sbr  x1,1&x1
7585           sbr  x2,1&x2
7586           bce  skip,0&x1,]        11-5-8
7587           bw   cdful,0&x1
7588 tbkff     c    @040@,x2
7589           bl   move
7590           c    @160@,x3
7591           bl   lozng
7592           mcw  @040@,167
7593           bh   *&8
7594           mcw  @040@, 164
7595           cw   140
7596 sw        sw   000
7597           sbr  x2
7598           a    -990,x2&1
7599           mcw  239,139
7600 sbr       sbr  x1,000
7601 comma     mcw  con40-11,box1
7602           mcw  @146@,x3
7603 wp        a    @1@,cdno
7604           mn   0&x2
7605           sbr  143
7606           c    143,@000@
7607           be   end2
7608           mn   0&x1
7609           sbr  146
7610           lca  180,280
7611           lca
7612           lca
7613           bss  swlwp,b
7614 wpb       p    reset
7615 swlwp     sw   lwpb&1
7616           mcw  wpb&3,lwpb&3
7617           cw   lwpb&1
7618 lwpb      wp   reset
7619 lozng     mcw  @)@,box1-6
7620           mcw  x1,box1
7621           mcw  x1
7622           mcw  @153@,x3
7623           b    wp
7624 term      sbr  wpb&3,end1
7625           b    wp
7626 cdful     mcw  x1,sbr&6
7627           sbr  sw&3,100&x2
7628           c    @040@,x2
7629           be   comma
7630           c    @167@,x3
7631           be   comma
7632           sbr  x3,3&x3
7633           zs   flip
7634           bm   plus1,flip
7625 mcw       mcw  x1,0&x3
7636           b    move
7637 skip      sw   skpsw
7638           b    comma
7639 skip2     cw   skpsw
7640           mcm  0&x1
7641           sbr  x1
7642           bw   move,0&x1
7643           mcw  x1,153
7644           mcw  x1
7645           mcw  @)@
7646           mcw  @153@,x3
7647           b    move
7648 plus1     sbr  x3,1&x3
7649           b    mcw
7650 end1      sbr  x1,1697     format
7651           bce  end2,parama&10,x
7652           bce  lio,parama&10,l
7653           bce  aform,parama&10,a
7654 next1     sbr  cpar&3,hifmt
7655           sbr  wpb&3,reset
7656           sbr  term&6,end2
7657           b    rest
7658 lio       sbr  hifmt,2016
7659           b    next1
7660 aform     sbr  hifmt,4617
7661           b    next1
7662 end2      cs   171
7663           mcw  @080@,146
7664           mcw  gogogo
7665           lca  @/@
7666           a    @1@,cdno
7667           lca  180,280
7668           lca
7669           cs
7670           bss  wpcs,b
7671           p
7672 cs180     cs   180
7673           p
7674           ss   8
7675 gary      fendxc,,,,,,sys2,gaux one
7676 wpcs      wp   cs180
7677 hifmt     dsa  4280     change if arrays donot origin at 4280
7678 con40     dcw  @,040040,0400401040@
7679 skpsw     dc   #1
7680           ltorg*
7681           dcw  @i99@
7682 sys2      dcw  @}@                           system group mark
7683 cdno      equ  175
7684           xfr  begin
7685           job  1401 Fortran  geaux phase one                          5061a
7686           fbegngeaux 1,x1,r,,,,,6
7687           org  xbegin
7688 start     lca  blnk4#4,84                    initialize sense
7689           sw   84                             lights
7690           sw
7691           sw
7692           messg@end of compilation@,18,1
7693           mcw  gogogo,x1
7694           bw   bad,failsw
7695           messg@press start to go@,17,j
7696 out       sw   sys2
7697           lca  sys2,693
7698           bce  cdsys,montor,1
7699           bw   skpxl,xlinkw
7700           sbr  tperx&15,rtpxl
7701 rtpxl     rtw  1,333
7702           ber  tperx
7703           b    out33
7704 tperx     bsp  1
7705           h    4444,4444
7706           b    skpxl
7707 cdsys     bw   skpxc,xlinkw
7708           r    040
7709 skpxc     r
7710           bce  out2,68,b         if b, branch to read arith
7711           b    skpxc
7712 skpxl     rtw  1,sys2
7713           ber  tperx
7714 out2      bss  333,c
7715           lca  @n@,381
7716           lca  @.@,564
7717 out33     cw   680               return from loading xlink
7718           sbr  tclear,sys2
7719           sbr  initap&6,201
7720           sbr  initxt&3,201
7721           sbr  bclear,xbegin
7722           b    monter
7723 bad       messg@correct errors and recompile@,28,j
7724           b    out
7725           ltorg*
7726 sys2      dcw  @}@                           system group mark
7727           xfr  start
7728           job  1401 Fortran fixed xlink routine                       5061b
7729           sfx  #                   as in snapshots
7730           org  333
7731           h    333
7732 start     mcw  86,xl2             x2 follows b700
7733           cs   80
7734           bce  array,0&x2,$
7735 clear     cs   000
7736           sbr  adr3
7737           c    adr3,@699@
7738           bu   clear
7739           sw   acchi-5&x3
7740           mz   acchi&x3,field
7741           c    field,acchi&x3
7742           be   cards
7743           bm   getm,acchi&x3
7744           mz   zero,acchi&x3
7745           c    699,acchi&x3
7746           be   getm
7747           sw   22
7748           mcw  gm,22
7749 serch     rt   1,1
7750           bef  out
7751           c    10,@lib@
7752           bu   serch
7753           c    17,acchi&x3
7754           be   t1
7755           b    serch
7756 out       nop  cards
7757           mcw  333,out
7758           rwd  1
7759           b    serch
7760 t1        lca  zeros,101
7761           lca  zeros
7762           lca  zeros
7763           rtw  1,333
7764           ber  err
7765           mcw  zero,ctrr
7766           sbr  tperm-1,t2
7767 t2        rtw  1,700
7768           ber  err
7769 tboot     b    000                from libed
7770 err       a    one,ctrr
7771           bce  tperm,ctrr,9
7772           bsp  1
7773           b    t1
7774 tperm     h    tperm
7775 array     mcw  3&x2,adr3
7776           mz   zero,adr3-1
7777           b    clear
7778 cards     sw   1
7779           r
7780           bce  1,1,,
7781           b    cards
7782 getm      rwd  1
7783           rtw  1,1
7784           b    1        execute monitor program
7785 adr3      equ  clear&3
7786 field     dcw  @000000@
7787 zeros     equ  field-1
7788 zero      equ  zeros-4
7789 ctrr      equ  zeros
7790 acchi     equ  279
7791           ltorg*
7792           org  679
7793 one       dcw  @1@
7794 gm        dcw  @}@                 group mark in 680
7795           xfr  out336
7796           job  1401 Fortran geaux phase two                           50623
7797           sfx  6
7798 110       dcw  @geaux two@
7799           org  201
7800 yipee     bce  montor,montor,1
7801 rtp       rtw  1,monter
7802           ber  tperr
7803           rwd  1
7804 init      mcw  subscr,arsub
7805           cw   1696
7806           mcw  gotofn,func
7807           mcw  parama&4,fixsz
7808           mcw  parama&6,fltsz
7809           cc   1
7810           bw   halt,failsw
7811           mcw  gogogo,x1
7812           h    0&x1
7813 halt      h    *-3
7814 tperr     bsp  1
7815           h    3333,3333
7816           b    rtp
7817           dcw  0
7818 func      equ  1330           change on reasm of ob arith out1-1
7819 fixsz     equ  1536           change on reasm of ob arith xsize&6
7820 fltsz     equ  837            change on reasm of ob arith fsize&6
7821 arsub     equ  1209           change on reasm of ob arith stsub&3
7822           ltorg*
7823           dcw  @}@                           system group mark
7824           xfr  yipee
7825 *
7826 *         phase 63 goes here
7827 *
7828           end  init                          the deed is done
