 101           job  1401 Fortran  format package                           5054a
 102           ctl  645 11
 103           sfx  q
 104 110       dcw  @formatpak@
 105 x1        equ  089
 106 x2        equ  094
 107 x3        equ  099
 108 parama    equ  686
 109 monter    equ  700
 110 tclear    equ  710
 111 montor    equ  769
 112 startr    equ  934
 113           org  startr
 114 fomat     sw   gmwm,format
 115           bce  tpsys,montor,n      tape or card system
 116 cdsys     bce  cdlio,parama&10,l   l#limited i/o
 117 sklio     r
 118           bce  ntest,68,b
 119           b    sklio
 120 ntest     bce  skfio,parama&10,x        x#no i/o
 121           r    040
 122 cwfio     cw   gmk
 123           c    parama&4,@01@
 124           bu   atest
 125           lca  @n@,cwmks
 126 atest     bce  cdaf,parama&10,a         a#a format
 127 skaio     r
 128           bce  exita,68,b
 129           b    skaio
 130 cdlio     r    040
 131 cwlio     cw   gpwdmk
 132 skfio     r
 133           bce  atest,68,b
 134           b    skfio
 135 cdaf      r    040
 136 cwaf      cw   gm54d
 137           b    exita
 138 tpsys     bce  tplio,parama&10,l
 139 skpl      rtw  1,gmwm
 140           ber  tper
 141           bce  skpf,parama&10,x
 142 fulio     rtw  1,format
 143           ber  tper
 144           c    parama&4,@01@
 145           bu   tstaf
 146           lca  @n@,cwmks
 147 tstaf     bce  tpaf,parama&10,a
 148 skpaf     rtw  1,gmwm
 149           ber  tper
 150 exita     fendxc,,,,,,gmwm,replace 2
 151 tplio     rtw  1,format
 152           ber  tper
 153 skpf      rtw  1,gmwm
 154           ber  tper
 155           b    skpaf
 156 tpaf      rtw  1,abegn
 157           ber  tper
 158           b    exita
 159 tper      sbr  bback&3
 160           ma   @i8g@,bback&3
 161           bsp  1
 162           h    3333,3333
 163 bback     b    0
 164           ltorg*
 165 gmwm      dcw  @}@                group mark
 166           xfr  fomat              next comes lio, then full i/o
 167           job  object time format                                     5054b
 168           org  1697
 169 start     sbr  x1
 170           sw   gpwdmk
 171           cw   0&x1
 172           mcw  x3,savx3#3         save x3
 173           lca  @001@,x3
 174           bwz  wrtap,0&x1,s       go to write tape on zone.
 175           mcw  @r@,io4&7          set read tape D modifier
 176 rdtap     mcw  6&x1,loc#3
 177 io1       mcw  loc,io12&6
 178 io12      bce  ret,000,.          . is end of list, return
 179           ma   @006@,loc
 180           mcw  loc,io15&3
 181 io15      mcw  000,addr#6         addr is loc of data addr
 182           sw   addr-2
 183           ma   @001@,addr         addr is now loc of data addr &1
 184           mcw  addr,io2&3
 185 io2       mcw  000,savch#1        save char after data area
 186           mcw  addr,io3&6
 187 io3       lca  gpwdmk,000         move gp mk wd mk to data addr &1
 188           mcw  addr-3,io4&6       move first char addr of data
 189           mn   0&x1,io4&3         move tape no.
 190           s    count#1,count      clear read-error counter
 191           mz   @a@,io4&5
 192 io4       rtw  1,000
 193           bef  rwt78
 194           ber  rwt31
 195           mcw  addr,io5&6
 196 io5       mcw  savch,000          return char after data area
 197           ma   @001@,loc          step to next variable in list
 198           cw   addr-2
 199           b    io1
 200 ret       mcw  savx3,x3           restore x3
 201           sw   0&x1
 202           b    7&x1
 203 wrtap     mcw  @w@,io4&7          set write tape D modifier
 204           b    rdtap
 205 rwt31     bce  rwt77,count,i      test read-error counter
 206           mn   io4&3,*&4
 207              ub%u0                backspace -- typo "%Uo" in orig.
 208           bce  rwt41,io4&7,w
 209           a    @1@,count          increase read-error counter
 210           b    io4
 211 rwt41     mn   io4&3,*&4
 212              ue%u0                skip and erase -- typo %Uo again
 213           b    io4
 214 rwt77     h    *-6,777            tape-error
 215 rwt78     h    *-6,888            end-of-file
 216           ltorg*
 217           dcw  @ @
 218 gpwdmk    dcw  @}@                group mark
 219           xfr  cwlio
 220           job  object time format                                     5054c
 221           org  1697
 222 format    sbr  x1
 223           mlc  0&x1,fmtzon        save i/o code
 224           mlc  *-6,io
 225           sbr  fmtxt&3, 7&x1           store exit from format routn
 226           mcw  6&x1,list&6
 227           za   *-6,pctr     set scale factor to zero
 228           cw   insw#1
 229           sw   gmk
 230           mcw  3&x1, xl2               mv addr of spec to x2
 231           sbr  x3, 200                 initilze wkarea ctr to lft
 232           sbr  tumuch#3,334
 233           bce  readc, 0&x1, &          read card
 234           bce  punch, 0&x1, -          punch card
 235           bce  print, 0&x1, *          print line
 236           bwz  rditp, 0&x1, k          read input tape
 237           bwz  wt2,0&x1,b         write output tape
 238           sbr  x2,rdrtb                set retrn for read tape
 239           cs   332                     clear wrk area for read tape
 240           cs                           and write tape
 241           cs
 242           sbr  x3,100                  set wkarea to 100
 243           mlc  ell,io
 244 loop2     sw   0&x3
 245           b    getad
 246           bwz  rditp,fmtzon,2          exit if read tape
 247           sbr  buckt,100
 248 mvagn     mlc  0&x1,0&x3
 249           sar  x2
 250           b    sbrx3
 251           bw   *&5,1&x2
 252           b    mvagn
 253           b    ckovf                   go ck if we are past 332
 254           sbr  outpt&3,tpcmnd
 255           b    loop2                   go get nxt addrs of data
 256 out       b    ckovf                   go ck if we are past 332
 257           mlcwa0&x3,0&x1               mv data frm wrkarea to strge
 258           b    getad                   go get nxt addr of data
 259 rdrtn     b    sbrx3
 260 rdrtb     bw   out,1&x3
 261           b    rdrtn                   no brnch to step ctr
 262 fmain     sbr  outpt&3                 retrn frm rd,pch,prt,rd-wtp
 263           mlc  x3,buckt#3
 264           b    0&x2                    go process accrdng to format
 265 getad     sbr  gtxt&3
 266           mlc  x2,save2&6              free x2 for list routine
 267           bw   alrdy,lkhed
 268 list         t oblist
 269 mlbox     dcw  #3
 270           sbr  x2                 end of oblst, array adres
 271 rmvzn     mz   nozn,x1-1
 272           bce  ntray,x1,.         entire array for write tape
 273           bce  undun,x1,           blank
 274 save2     sbr  x2, xxx                 restore x2
 275 gtxt      b    xxx
 276 undun     bw   fmtxt,insw
 277           c    buckt,x3
 278           bu   ndlin
 279           b    fmtxt
 280 alrdy     cw   lkhed
 281           mlc  save1,x1
 282           b    rmvzn
 283 ntray     mlc  2&x2,x3                 mv lft addr of array-1 to x3
 284           mlc  5&x2,x1                 mv right addr of array to x1
 285           mlc  1&x1,gmkhd#1            save char at righthand addr
 286           bw   *&5,1&x1                plus one and replace by gmk
 287           cw   gmksw#1                 for reading or writing from
 288 ell       mlcwagmk,1&x1
 289           b    sbrx3
 290           sbr  x2,arrtn                set return from i/o routine
 291           bwz  rditp,fmtzon,2          go read tap e entire array
 292           b    tpcmnd
 293 arrtn     mlc  gmkhd,1&x1              return from read or write tp
 294           bw   fmtxt,gmksw             entire array- reset charactr
 295           cw   1&x1                    wheregmk was inserted
 296           sw   gmksw
 297 fmtxt     b    xxx                egress
 298 fmtzon    dcw  @ @
 299 sbrx3     sbr  sbrx3&14
 300           sbr  x3,1&x3
 301           b    0
 302 opnpr     sbr  x2                      entry for lft paren in frmat
 303           mn   0&x2
 304           mn
 305           mn
 306           mn
 307           sar  repeat&3
 308           mcw  2&x2, rtpa#3            mv nmbr of times routine is
 309           sbr  last1&3,3&x2
 310           b    decra                   to be executed to hld area
 311 clspr     sbr  x2                      entry for right paren frm
 312 decra     s    one,rtpa
 313           bm   0&x2, rtpa              have finished this set of
 314 last1     b    xxx
 315 ndlin     sbr  x2                      entry for / in format routin
 316           mlc  buckt,x3
 317 outpt     b    xxx
 318 eoj1      bw   nopsw,insw
 319           c    buckt,x3
 320           bu   ndlin
 321 nopsw     mlc  list&6,*&7
 322           bce  nopbr,0,,
 323           mlc  list&6,*&7
 324              t oblist
 325 ejbox     dcw  #3
 326           bce  fmtxt,x1,
 327           mlc  ejbox,mlbox
 328           mlc  x1,save1#3
 329           sw   lkhed
 330 nopbr     bw   ndlin,insw              go get new rcd if input
 331 repeat    b    xxx
 332 scale     sbr  x2
 333           za   2&x2,pctr               save scaling factor
 334           b    3&x2                    return to format spec
 335 pctr      dcw  &000
 336 hollr     sbr  x2
 337 testh     bw   holin,insw
 338 hlout     mlc  0&x2,0&x3
 339 holin     mlc  0&x3,0&x2
 340           b    sbrx3
 341           sbr  x2,1&x2
 342           bw   *&5,0&x2
 343           b    testh
 344           b    ckovf
 345           b    0&x2
 346 getw      sbr  x2
 347           mcw  3&x2, rptb#3
 348 dcrpb     s    one,rptb
 349           bwz  gtrtn,rptb,b
 350           bce  7&x2,0&x2,i
 351           bce  7&x2,0&x2,a
 352           b    10&x2
 353 gtrtn     b    getad
 354           afixws,fixwd
 355 efntn     afltwsw,fltwd,-1
 356           bw   inefi, insw
 357           cs   24
 358           sw   0&x3
 359           mn
 360           sbr  x3
 361           sbr  joe4&3,2&x3
 362           sbr  fins&3
 363           sw   001
 364           bce  inotn, 0&x2, i
 365           bce  aout,0&x2,a
 366 efout     bfltwmlc,@0|0@,fltwd
 367           mcw
 368           sbr  xl1
 369           sw   0&x1
 370           a    wd, xl3
 371           sbr  fins-1,2&x3
 372           mlc  @0.0@
 373           sw   2&x3
 374           bce  efti,1&x1,0
 375           bfltwbwz,fovfl,fltwd,-2,2
 376 efti      bce  *&12,0&x2,e
 377           bfltwa,pctr,fltwd
 378           b    *&8
 379           bfltws,pctr,fltwd
 380           afltwmlns,fltwd,,econ
 381           mn
 382           afltwmlc,fltwd
 383           bce  ftyp,0&x2,f
 384           c    econ,zero4-2
 385           be   *&9
 386           bwz  *&8,econ-2,k
 387           mlzs nozn,econ-2
 388           bfltwza,pctr,fltwd
 389 upx1      afltwmlns,fltwd,,*&8
 390           mn
 391           sbr  x1, xxx&x1
 392           za   837,point     change if arith reassembled
 393           s    doprt,point
 394           bfltwc,point,fltwd
 395           bh   integ
 396           b    ok1
 397 fovfl     mlc  @ x @,2&x3
 398           mlc
 399           sbr  x3,2&x3
 400           sbr  finsi-1
 401           a    d, x3
 402           b    cwmks
 403 ftyp      bm   negx,econ-2
 404           c    wd, econ
 405           bl   upx1
 406           b    fovfl
 407 integ     s    23
 408           afixwmcm,fixwd,&1,001
 409           mlc  zero4
 410           mz
 411           mlc  econ,x1
 412           mlc  zero4-3
 413           mlc  gmk,3&x1
 414           b    ok1
 415 negx      mz   nozn,0&x1
 416           c    d,econ
 417           bu   brhi
 418           afixwc,fixwd,&1,five
 419 brhi      bh   mvdat
 420 ok1       afltwmlzs,fltwd,-2,@0|0@
 421           b    mvdat
 422 ckovf     sbr  ovfex&3
 423           c    tumuch,x3
 424           bl   ovfex
 425           nop  3700
 426           h
 427 ovfex     b    xxx
 428 inotn     bfixwmlc,@0|0@,fixwd
 429           a    w, xl3
 430           mcw  w, xl1
 431           afixwza,fixwd,,@0|0@
 432           b    sbrx3
 433 mvdat     mcs  0&x1,0&x3
 434           sbr  save&6
 435           mlns 0&x1,0&x3
 436           sbr  mcs&3,0&x3
 437           sbr  finsi-1
 438 joe4      sw   xxx
 439           bwz  back,0&x1,k
 440           b    save
 441 back      bce  exit,0&x3,       blank
 442           sbr  x3
 443           bw   save,1&x3       no room for sign
 444           b    back
 445 exit      mlzs minus,0&x3
 446           sw   1&x3
 447           sbr  finsi-1,1&x3
 448 save      sbr  x3,111   dummy address
 449           bce  fins,0&x2,i
 450           a    d,x3
 451           bce  jumpf,0&x2,f
 452           mlns 0&x3
 453           mlns
 454           mlns
 455           mlns
 456           sbr  x3
 457 jumpf     sbr  ovr1&6,1&x3
 458           s    1&x3
 459           mlns
 460           sar  x3
 461           bce  mdig,0&x2,e
 462           bwz  mdig,econ-2,b
 463           c    d,econ
 464           bh   ovr1
 465           a    econ,x3
 466 mdig      bce  ovr1,3&x1,}      gmk
 467           mlns 1&x1,2&x3
 468           sbr  x1,1&x1
 469           bwz  ovr1,2&x3,b
 470           sbr  x3
 471           b    mdig
 472 ovr1      sbr  x3,xxx
 473           bav  *&1
 474           a    econ-3,0&x3
 475           mlc  nozn,0&x3
 476           bce  cwmks-5,0&x2,f
 477           sbr  x3,4&x3
 478           mlns 0&x3
 479           mcw  econ
 480           mz
 481           mcw
 482           bav  arrav
 483 cwmks     afixwcw,fixwd
 484           cw   xxx
 485 fins      cw   000
 486           cw   xxx
 487 finsi     afixwsw,fixwd,&1
 488           b    ckovf
 489           b    dcrpb
 490 arrav     mlc  fins-1,x1
 491           mlzs nozn,0&x1
 492           mlc
 493           a
 494           bav  ovr9s
 495 mcs       mcs  0
 496           b    cwmks
 497 ovr9s     mn   0&x1
 498           c
 499           mn
 500           sbr  x1
 501           c    fins&3,x1
 502           bl   clear
 503           sw   0&x1
 504           mlc  1&x1,0&x1
 505           cw
 506           mcw  one,1&x1
 507           b    cwmks
 508 clear     mlc  1&x3,0&x3
 509           mlc
 510           mlc
 511           mlc  @ x @,3&x1
 512           b    cwmks
 513           dcw  1
 514           dcw  @.@
 515 nozn      dcw  @ @
 516 zero4     dcw  0000
 517 ini       mlc  x1,x3
 518           mlzs zaflt,*&8
 519           bfixwmlns,@0?0@,fixwd,&1
 520           za
 521           mlc  urzro&6,x1
 522           afixwmlcwa,fixwd,,@0|0@
 523           b    mrwm
 524 hltgo     nop  4002
 525           h
 526 rditp     sw   insw
 527 rd2       cs   332
 528           cs
 529           b    tpcmnd
 530 cmbck     bef  hltgo
 531           bce  tpcmnd,12&x3,}      gm
 532           chain12
 533           b    fmain
 534           b    rd2
 535 wtm       mlns fmtzon,*&4
 536           wtm  0
 537           nop  4003
 538           h
 539 wt2       cs   332
 540           cs
 541           b    fmain
 542 tpcmnd    mlns fmtzon,io&3
 543           mlc  @r@,io&7
 544           za   @r@,point
 545           bw   svgmk,insw
 546           mlc  @w@,io&7
 547           a    &41,point
 548 svgmk     mlcwagmk,333
 549 io        rt   0,0&x3
 550           mlcwaformat,333
 551           ber  tperr
 552           bce  cmbck,io&7,r
 553           bef  wtm
 554           b    wt2
 555 print     cs   333
 556           cs
 557           b    fmain
 558 przro     bce  doprt,200,          blank
 559           bce  space, 200, 0
 560           mn   200, *&2
 561           cc   0
 562 doprt     w
 563           bcv  *&5
 564           b    print
 565           ccb  print,1
 566 space     ccb  doprt,j
 567 punch     mlc  @281@,tumuch
 568           cs   fmain,285
 569           sw   200
 570           lca  279,180
 571           p
 572           ssb  punch,4
 573 readc     cs   80
 574           mlc  @281@,tumuch
 575           sw   1, insw
 576 one       r
 577           lca  80,279
 578           ssb  fmain,1
 579           b    readc
 580 tperr     mlns fmtzon,bsptp&3
 581           mlns fmtzon,skp&3
 582 bsptp     bsp  0
 583           bce  *&6,io&7,r
 584 skp       skp  0
 585           s    one,point
 586           bwz  svgmk,point,b
 587           nop  1111
 588           h
 589           b    tpcmnd
 590           dcw  @e@
 591           dcw  @ @
 592 econ      dcw  00
 593 inefi     sw   0&x3
 594           mlc  x1,urzro&6
 595           mlc  x3,x1
 596           a    wd,x1
 597           bce  outq,0&x2,i
 598           bce  outqa,0&x2,a
 599           a    d,x1
 600 outq      sw   0&x1
 601           sbr  mrwm&3,0&x1
 602           afltws,fltwd
 603           s
 604 scnbl     bce  blank, 0&x3,          blank
 605           mlzs minus,zaflt
 606           bce  kill,0&x3,-
 607           bce  kill,0&x3,@
 608 minus     zs   zaflt
 609           bce  kill,0&x3,&
 610           b    mv2wk
 611 blank     bw   urzro-8,1&x3
 612           b    sbrx3
 613           b    scnbl
 614 kill      sw   1&x3
 615           b    sbrx3
 616 mv2wk     bce  ini, 0&x2, i
 617           bfixwsbr,089,fixwd,-1
 618           bfltwmlzs,nozn,fltwd,-2
 619           cw   sigsw#1,swb#1
 620           cw   swa#1
 621           s    xpn
 622           bce  abegn,0&x2,a
 623           b    lewp2
 624 pynt1     sbr  point,0&x3
 625           sw   swa
 626           bw   lewp, sigsw        q. data not fractional
 627           sbr  point, 1&x3
 628 lewp      bw   ovr,1&x3
 629           bce  ovr,1&x3,           blank
 630           b    sbrx3
 631 lewp2     bce  pynt1,0&x3,.
 632           c    0&x3,zero4-3
 633           bl   mvdig
 634           bh   qftyp
 635           bw   mvdig, sigsw       q. significant zero
 636           b    lewp
 637 qftyp     bce  fhlt,0&x2,f
 638           sbr  end,4&x3
 639           mlzs plus,zaexp
 640           bce  proce, 0&x3, e
 641 zond      mz   0&x3, zaexp
 642           fbceqgrab, 0&x3, &,-
 643 fhlt      nop  1121                    error halt  data is wrong
 644           h                            mode
 645 plus      b    fhlt
 646 proce     bwz  here,1&x3,2
 647           b    sbrx3
 648           b    zond
 649 here      bce  *&5,1&x3,           blank
 650           b    *&5
 651           b    sbrx3
 652 grab      sw   1&x3
 653 mv2wm     bw   zaexp, 2&x3
 654           bce  zaexp,2&x3,         blank
 655           sbr  x3
 656 zaexp     za   1&x3, xpn
 657           b    zaflt
 658 ovr       bce  fhlt, 0&x2, e
 659           sbr  end, 1&x3
 660 zaflt     afltwza,fltwd,-2
 661           bw   *&5, sigsw
 662           b    urzro
 663           bw   noswt, swa         a. actual decimal pt. in data
 664           s    d, end
 665           za   end, point
 666 noswt     s    point, msd
 667           a    pctr,xpn
 668           zs   msd
 669           a    msd,xpn
 670           bfltwza,xpn,fltwd
 671           bce  ini,0&x2,i
 672 urzro     afltwmlc,fltwd,,xxx
 673           lca
 674           mlc  mrwm&3,x3
 675 mrwm      cw   xxx
 676           b    finsi
 677 mvdig     bw   *&12, sigsw
 678           sbr  msd, 0&x3
 679           sw   sigsw
 680           bw   lewp, swb
 681           mn   0&x3, 2&x1
 682           sbr  x1
 683           sw   swb
 684           bce  lewp,4&x1,}          gmk
 685           cw   swb
 686           b    lewp
 687 xpn       dcw  #3
 688 end       dcw  #3
 689 msd       dcw  #3
 690 point     dcw  #3
 691 five      dcw  @5@
 692 lkhed     dc   #1
 693           ltorg*
 594 gmk       dcw  @}@                  group mark
 695 w         equ  6&x2
 696 wd        equ  6&x2
 697 d         equ  9&x2
 698 xxx       equ  0
 699 xl1       equ  089
 700 xl2       equ  094
 701 xl3       equ  099
 702 oblist    equ  912
 703 cexit     equ  988
 704           xfr  cwfio
 705           job  a format                                               5054d
 706           org  4280
 707 abegn     bw   *&12,sigsw
 708           sbr  msd,0&x3
 709           sw   sigsw
 710           bw   lewpa,swb
 711           mn   0&x3,2&x1
 712           mz   0&x3,2&x1
 713           sbr  x1
 714           sw   swb
 715           bce  lewpa,4&x1,}          group mark
 716           cw   swb
 717 lewpa     bw   ovra,1&x3
 718           b    sbrx3
 719           b    abegn
 720 ovra      sbr  end,1&x3
 721           mcw  urzro&6,nexta&6
 722 nexta     mcw  0,0
 723           lca
 724           mlc  mrwm&3,x3
 725           b    finsi
 726 outqa     bfltwmcw,blk3,fltwd
 727           bfltwmcw,blk20,fltwd,-2
 728           sw   0&x1
 729           sbr  mrwm&3,0&x1
 730           b    mv2wk
 731 aout      mcw  efout&6,nexa&6
 732 nexa      mcw  0,0
 733           mcw
 734           sbr  x1
 735           sbr  tempx1#3,1&x1
 736           sbr  tempx3#3,0&x3
 737           ma   6&x2,tempx3
 738           sbr  temp32,1&x3
 739           mcw  nexa&6,tfltwd#3
 740           ma   @i9h@,tfltwd
 741 movnum    mn   1&x1,2&x3
 742           mz   1&x1,2&x3
 743           c    temp32,tempx3
 744           be   fini1
 745           c    tempx1,tfltwd
 746           be   fini1
 747           ma   @001@,tempx1
 748           ma   @001@,temp32
 749           sbr  x1,1&x1
 750           sbr  x3,1&x3
 751           b    movnum
 752 fini1     sbr  fins&7,0&x3
 753           mcw  tempx3,x3
 754           sbr  x3,2&x3
 755           b    fins
 756 blk3      dcw  #3
 757 blk20     dcw  #20
 758 temp32    dcw  @   @
 759           ltorg*
 760 gm54d     dcw  @}@                group mark
 761           xfr  cwaf
 762 *
 763 **        place preceding cards between phases 53 and 55
 764 *
 765           end
