 101 001       job  1401 Fortran - relocatable condenser - phase 96        50963
 102           ctl  645 11
 103 *
 104 * equates used by the program
 105 *
 106 initap    equ  %u0
 107 systap    equ  %u1
 108 origtp    equ  %u4
 109 worktp    equ  %u5
 110 fixfrm    equ  0
 111 ststmt    equ  fixfrm&5
 112 count     equ  fixfrm&7
 113 labadd    equ  fixfrm&61
 114 supadd    equ  fixfrm&66
 115 op        equ  fixfrm&67
 116 aop       equ  fixfrm&70
 117 bop       equ  fixfrm&73
 118 dmod      equ  fixfrm&74
 119 type      equ  fixfrm&75
 120 alter     equ  fixfrm&80
 121 xxxx      equ  0
 122 print     equ  200
 123 lab       equ  print&19
 124 opcode    equ  print&25
 125 oprand    equ  print&78
 126 ct        equ  print&84
 127 locn      equ  print&90
 128 inop      equ  print&93
 129 inaop     equ  print&97
 130 inbop     equ  print&101
 131 indmod    equ  print&103
 132 cardno    equ  print&114
 133 punch     equ  100
 134 zone      equ  189
 135           xinitxr1,xr2,xr3
 136 189       dcw  @2skb@
 137 *
 138 * initialization routine
 139 *
 140           org  333
 141 ssop      cs   332
 142           cs
 143           cs   180
 144           rwd  origtp
 145           rwd  worktp
 146           sw   punch&72,punch&76
 147           a    &4,punch&75
 148           b    readog
 149 *
 150 * check for job card
 151 *
 152           c    mnemon-2,@job@
 153           bu   ckctl
 154           lca  @}@,181
 155           rt   worktp,180
 156           mcw  image&80,punch&80
 157           b    readog
 158 *
 159 * check for control card
 160 *
 161 ckctl     c    mnemon-2,@ctl@
 162           mcw  image&30,ctlsav#10
 163           be   tstsiz
 164           mcw  @3@,prosiz
 165           b    tstsiz&4
 166 *
 167 * test processor machine size
 168 *
 169 tstsiz    b    readog
 170           c    prosiz,@4@
 171           bh   getman
 172           c    prosiz,@6@
 173           bl   getman
 174           mcw  @400@,kblkng
 175           bce  getman,prosiz,4
 176           a    @400@,kblkng
 177 *
 178 * setup & get main program
 179 *
 180 getman    bsp  origtp
 181           sw   fixfrm&1,fixfrm&6
 182           sw   fixfrm&8,fixfrm&14
 183           sw   fixfrm&23,fixfrm&57
 184           sw   fixfrm&62,fixfrm&67
 185           sw   fixfrm&68,fixfrm&71
 186           sw   fixfrm&74
 187           mcw  kblkng,holda-1
 188           lca  @L0     ,      ,      ,      1   @,punch&71
 189           cw   wmsw#1
 190           b    get
 191           b    setup
 192 *
 193 * tape redundancy routine
 194 *
 195 tperr     sbr  xr2
 196           sbr  redxt&3
 197           mz   plus9,xr2
 198           mcw  4000-10&x2,tpinst&7
 199           mn   tpinst&7,bsp1&3
 200           mcw  tpinst&7,inst2&7
 201 bsp1      bsp  initap
 202           bce  wrtred,tpinst&7,w
 203           mcw  plus9,readct
 204 tpinst    rt   initap,xxxx
 205           ber  rdrerr
 206 redxt     b    xxxx
 207 rdrerr    mn   tpinst&3,bsp2&3
 208 bsp2      bsp  initap
 209           s    plus1,readct
 210           bwz  tpinst,readct,b
 211           mn   tpinst&3,tphalt&6
 212 tphalt    h    xxxx,790
 213           mcw  tpinst&7,*&8
 214           rt   initap,xxxx
 215           bss  bsp1,e
 216           h    xxxx,712
 217           b    redxt
 218 wrtred    skp  systap
 219           bce  subctr,wrtctr-1,5
 220           a    plus1,wrtctr
 221 inst2     wt   initap,xxxx
 222           ber  bsp1
 223           b    redxt
 224 subctr    s    wrtctr
 225           mn   tpinst&3,*&7
 226           h    xxxx,760
 227           b    inst2
 228 plus9     dcw  &9
 229 plus1     dcw  &1
 230 readct    dcw  #1
 231 wrtctr    dcw  #2
 232 *
 233 * begin main line program
 234 *
 235 setup     cs   print&132
 236           cs
 237 getorg    b    readog
 238 *
 239 * determine type
 240 *
 241 analwk    sw   typesw#1
 242           sw   relsw
 243           mn   type,typea#1
 244           bce  bypass,type,%
 245           bce  bypass,type,8
 246           bce  bypass,type,I
 247           bce  prowrk,alter,
 248 analog    bce  comxt,label-5,*
 249           bce  comxt,image&75,r
 250           bce  comxt&4,image&75,s
 251           bce  dojob,mnemon-4,j
 252           c    alter,altno
 253           bu   seqerr
 254           b    setfre
 255           cw   typesw
 256           bce  instr,type,
 257           mn   type,xr2
 258           a    xr2
 259           a    xr2
 260           b    *&1&x2
 261           b    da
 262           b    const
 263           b    dsa
 264           b    exend
 265           b    litout
 266           b    typerr
 267           b    bypass
 268           b    bypass
 269           b    typerr
 270           b    typerr
 271 *
 272 * comments card
 273 *
 274 comxt     b    prntln
 275           b    readog
 276           b    analog
 277 *
 278 * new job card
 279 *
 280 dojob     bw   doidt,newsw
 281           b    pnchcd
 282 doidt     mcw  image&80,punch&80
 283           b    comxt
 284 *
 285 * program generated record
 286 *
 287 prowrk    bce  xtra,type,y
 288           bce  adcon,type,s
 289           bce  litral,typea,1
 290           b    typerr
 291 *
 292 * literal greater than 30 characters
 293 *
 294 xtra      sw   print&27
 295           mcw  fixfrm&72,oprand
 296           chain5
 297           b    bypass
 298 *
 299 * adcon card
 300 *
 301 adcon     sw   print&27
 302           mcw  fixfrm&53,print&40
 303           mcw  fixfrm&16,opcode-2
 304 dsa       mcw  bop,print&95
 305           mcw  bop,holdh&3
 306           b    setadd
 307           b    setlit
 308 *
 309 * literal & area definition cards
 310 *
 311 litral    bwz  prolit,type,s
 312           bwz  dadc,fixfrm&1,b
 313           b    prolit
 314 prolit    mcw  fixfrm&53,print&57
 315           mcw  fixfrm&16,opcode-2
 316 const     b    setadd
 317           a    @00@,count
 318           c    count,@00@
 319           bl   good
 320           mz   zone-1,ststmt
 321           b    setlit
 322 good      bce  areadf,print&27,#
 323           bwz  areadf,fixfrm&4,b
 324           mcw  oprand,holddt-1
 325           bce  setlit,print&27,@
 326           bwz  unsign,print&27,2
 327           mcw  count,xr1
 328           mz   blank4,print&27&x1
 329           mz   print&27,holdh&x1
 330 setlit    b    setloc
 331           b    condns
 332 litout    b    prntln
 333           b    bypass
 334 unsign    mcw  oprand,holddt#52
 335           b    setlit
 336 areadf    bw   *&5,typesw
 337           b    setlit
 338           mcw  fixfrm&13,lab
 339           mcw  blank4-2,print&31
 340           mcw  count
 341           mcw  @#@
 342           b    setlit
 343 dadc      b    setadd
 344           b    condns
 345           cs   print&132
 346           cs
 347           b    bypass
 348 *
 349 * set condense addresses for constants
 350 *
 351 setadd    sbr  addxt&3
 352           za   labadd,loadad
 353           mcw  loadad
 354           s    count,wmaddr
 355           a    &1,wmaddr
 356 addxt     b    xxxx
 357 *
 358 * get next records
 359 *
 360 typerr    h    xxxx,770
 361 bypass    b    get
 362           bw   analwk,typesw
 363           b    getorg
 364 *
 365 * free form record to print area
 366 *
 367 setfre    sbr  freext&3
 368           mcw  label,lab
 369           mcw  mnemon,opcode
 370           mcw  opernd,oprand
 371 freext    b    xxxx
 372 *
 373 * assembled information to print area
 374 *
 375 setloc    sbr  locxt&3
 376           mcs  count,ct
 377           mn   labadd,locn
 378           mcw
 379 locxt     b    xxxx
 380 *
 381 * instruction card
 382 *
 383 instr     mcw  dmod,indmod
 384           mcw  bop,inbop
 385           mcw  aop,inaop
 386           mcw  op,inop
 387           mcw  dmod,holdh&8
 388           mcw
 389           mcw
 390           mcw
 391           cw   relsw#1
 392           mcw  @186@,relad#3
 393           s    xr3&1
 394           s
 395           s
 396 nxtadd    bce  dobop,opaddr,#
 397           bce  dobop,opaddr-2,%
 398           bce  dobop,opaddr,
 399           bwz  *&5,opaddr,2
 400           b    asksym
 401           bwz  dobop,opaddr-2,2
 402           bwz  dobop,opaddr-2,s
 403 asksym    bce  issym,opsym,@
 404           bce  issym,opsym,#
 405           bwz  qusym,opsym,2
 406 issym     a    &1,relad
 407           bce  relfin,xr2,3
 408           a    &1,relad
 409 dobop     a    &3,xr2
 410           a    &11,xr1
 411           s    xr3&1
 412           c    xr2,@003@
 413           be   nxtadd
 414           b    relfin
 415 qusym     bwz  dobop,opsym&1,2
 416           b    issym
 417 opaddr    equ  aop&x2
 418 opsym     equ  fixfrm&17&x1
 419 relfin    mcw  labadd,wmaddr#5
 420           mcw  labadd,loadad#5
 421           a    count,loadad
 422           s    &1,loadad
 423           b    setlit
 424 *
 425 * define area cards
 426 *
 427 da        bce  header,type,0
 428           mcw  supadd,wmaddr
 429           bwz  setda,type,b
 430           b    setloc
 431           b    litout
 432 setda     b    setloc
 433           b    condns
 434           b    prntln
 435 bypda     b    get
 436           bce  rptout,type,|
 437           b    getorg
 438 rptout    mcw  supadd,wmaddr
 439           b    condns
 440           cs   print&132
 441           cs
 442           b    bypda
 443 header    b    setloc
 444 nxtrpt    mn   supadd,print&97
 445           mcw
 446           mcw  labadd,wmaddr
 447           b    condns
 448           b    get
 449           c    fixfrm&16,@da @
 450           bu   pntda
 451           bce  nxtrpt,type,|
 452 pntda     b    prntln
 453           b    getorg
 454 *
 455 * ex, end cards
 456 *
 457 exend     mcw  @b@,inop
 458           mcw  @b@,holdh&1
 459           bce  setaop,type,c
 460           mcw  @/     080@,inbop
 461           mcw  @/   080@,holdh&7
 462 setaop    mcw  aop,inaop
 463           mcw  aop,holdh&4
 464           b    setloc
 465           b    condns
 466           b    prntln
 467           bce  bypass,type,c
 468           h    *-3
 469 *
 470 * condense ex, end cards
 471 *
 472 nocard    c    wmloc,awmstr
 473           be   tstend
 474           cw   newsw
 475 endrtn    bw   nocard,newsw
 476           b    pnchcd
 477 tstend    bce  excute,type,c
 478           cs   punch&71
 479           mcw  holdh&7,punch&46
 480           mcs  punch&75,cardno
 481           mcw  &lstcd,pnhxt&3
 482           b    tstpch
 483 excute    mce  wmstr,punch&71
 484           mcw  @n000000@,punch&46
 485           mcw  holdh&4,punch&71
 486           mcs  punch&75,cardno
 487           mcw  &exout,pnhxt&3
 488           b    tstpch
 489 *
 490 * punch compatibility cards
 491 *
 492 exout     cs   punch&71
 493           b    readog
 494           bsp  origtp
 495           bce  *&5,mnemon-4,j
 496           b    *&8
 497           mcw  image&80,punch&80
 498           mcw  word2,punch&39
 499           lca  word3,punch&66
 500           mcw  punch&66,punch&50
 501           p
 502           cs   punch&66
 503           a    &1,punch&75
 504           mcw  word4,punch&21
 505           mcw  word5,punch&71
 506           mcw  &outex,pnhxt&3
 507           p
 508           b    newcrd
 509 lstcd     cs   punch&80
 510           p
 511           ss   8
 512 outex     b    cndout&7
 513 word2     dcw  @,015022)024056,029036,040047,0540611001@
 514 word3     dcw  @,001008b001@
 515 word4     dcw  @,068072)063067/061039@
 516 word5     dcw  @,0010011040@
 517 *
 518 * print statements
 519 *
 520 prntln    sbr  prntxt&3
 521           cs   print&132
 522           cs
 523 prntxt    b    xxxx
 524 *
 525 * condense routine
 526 *
 527 condns    sbr  condxt&3
 528           cw   bigsw,dcsw
 529           bm   condxt,ststmt
 530           bw   pnchcd,wmsw
 531 *
 532 * process record
 533 *
 534 nxtrcd    bce  dowm,typea,0
 535           bce  endrtn,typea,3
 536           bwz  tstdc,type,b
 537 *
 538 * test room on card
 539 *
 540 tstrom    c    count,@39@
 541           bl   tstcon
 542           mcw  pnhloc,roomct#3
 543           a    count,roomct
 544           c    roomct,@039@
 545           bl   setpnh
 546           bw   rstctr,newsw#1
 547 *
 548 * test sequence
 549 *
 550           mcw  countr#5,seqct#5
 551           a    count,seqct
 552           c    loadad,seqct
 553           bu   setpnh
 554           a    count,countr
 555 *
 556 * move data to punch area
 557 *
 558 mvdata    mcw  &holdh,xr3
 559           a    count,xr3
 560           a    count,pnhloc
 561           mcw  pnhloc,xr2
 562           mcw  xxxx&x3,punch&x2
 563           cw   datasw#1
 564           bw   first,newsw
 565           bwz  cndout,type,b
 566 *
 567 * set word mark address
 568 *
 569 dowm      mcw  wmaddr,cnvadd#5
 570           b    cnvrt
 571           a    &3,wmloc
 572           mcw  wmloc,xr1
 573           mcw  cnvadd,wmaddr-2
 574           bw   mvwmad,relsw
 575           mcw  relad,*&4
 576           mz   zone,wmaddr-3
 577 mvwmad    mcw  wmaddr-2,xxxx&x1
 578           c    xr1,&wmstr-3
 579           bu   cndout
 580           sw   wmsw
 581           b    cndout
 582 rstctr    mcw  loadad,countr
 583           b    mvdata
 584 setpnh    b    pnchcd
 585           b    nxtrcd
 586 tstdc     bw   compwm,newsw
 587           b    tstrom
 588 compwm    c    wmloc,awmstr
 589           be   tstrom
 590           sw   dcsw#1
 591           b    pnchcd
 592           b    tstrom
 593 *
 594 * first data on card
 595 *
 596 first     cw   newsw
 597           bwz  prodc,type,b
 598           bw   cndout,relsw
 599           mcw  relad,*&4
 600           mz   zone,svzone#1
 601           b    cndout
 602 *
 603 * condense dc cards
 604 *
 605 prodc     mcw  @)@,punch&47
 606           mcw  wmaddr,cnvadd
 607           b    cnvrt
 608           mcw  cnvadd,wmaddr-2
 609           mcw  wmaddr-2,wmstr-15
 610           mcw  wmaddr-2
 611           a    &6,wmloc
 612           b    cndout
 613 *
 614 * convert 5 digit to 3 digit address
 615 *
 616 cnvrt     sbr  cnvxt&3
 617           bav  *&1
 618 addagn    a    &96,cnvadd-3
 619           bav  addagn
 620           mz   cnvadd-4,cnvadd
 621           mn   cnvadd-3,*&4
 622           mz   zone,cnvadd-2
 623 cnvxt     b    xxxx
 624 *
 625 * punch a card
 626 *
 627 pnchcd    sbr  pnhxt&3
 628           bw   edit,dcsw
 629           bw   edit,datasw
 630           mcw  countr,cnvadd
 631           b    cnvrt
 632           mcw  cnvadd,wmstr-21
 633           mcw  pnhloc,wmstr-24
 634           mz   svzone,wmstr-22
 635 edit      mce  wmstr,punch&71
 636           mn   @0@,punch&41
 637           mz   @ @,countr
 638           c    countr,@02000@
 639           bh   tstpch
 640           mz   zone,punch&42
 641 tstpch    p
 642 *
 643 * reset counters and switches
 644 *
 645 newcrd    a    &1,punch&75
 646           cs   punch&71
 647           lca  @l0     ,      ,      ,      1   @,punch&71
 648           sw   newsw,datasw
 649           cw   wmsw,dcsw
 650           mz   @ @,svzone
 651           mcw  @000@,pnhloc
 652           mcw  awmstr,wmloc
 653           mcw  @001001040040040040040040040@,wmstr
 654 pnhxt     b    xxxx
 655 *
 656 * constant greater than 39 characters
 657 *
 658 tstcon    bw   *&5,newsw
 659           b    pnchcd
 660           mcw  count,holdct#2
 661           mcw  loadad,countr
 662           mcw  @39@,count
 663           s    @39@,holdct
 664           s    holdct,countr
 665           mz   zone-3,holdct
 666           sw   bigsw#1
 667           mcw  wmaddr,savewm#5
 668           b    mvdata
 669 bigrn     b    pnchcd
 670           cw   bigsw
 671           mcw  holdct,count
 672           mcw  @a@,type
 673           mcw  holddt,holddt-39
 674           mcw  savewm,wmaddr
 675           a    @39@,wmaddr
 676           b    rstctr
 677 *
 678 * exit from condense routine
 679 *
 680 cndout    mcs  punch&75,cardno
 681           s    xr3&1
 682           s
 683           s
 684           bw   bigrn,bigsw
 685           mcw  blank1,holddt
 686           mcw  holddt
 687 condxt    b    xxxx
 688 *
 689 * sequence error on input records
 690 *
 691 seqerr    h    xxxx,777
 692           b    seqerr
 693 *
 694 * get record from working tape
 695 *
 696 get       sbr  workxt&3
 697           c    blkct,kblkng
 698           bu   nxtrec
 699           s    holda
 700           mcw  &input5&13,lgtck&6
 701           rt   worktp,input5
 702           b    chklgt
 703           ber  tperr
 704 nxtrec    a    &80,blkct
 705           mcw  blkct,xr3
 706           mcw  fixinp,fixfrm&80
 707           chain10
 708           s    xr3&1
 709           s
 710           s
 711 workxt    b    xxxx
 712 *
 713 * read original tape
 714 *
 715 readog    sbr  origxt&3
 716           mcw  blank1,image&21
 717           s    image&20
 718           s
 719           s
 720           s
 721           mcw  &input4&12,lgtck&6
 722           rt   origtp,input4
 723           b    chklgt
 724           ber  tperr
 725           s    xr2&1
 726 origxt    b    xxxx
 727 *
 728 * check for short records
 729 *
 730 chklgt    sbr  xr2
 731           sbr  lgtxt&3
 732           mz   @b@,xr2
 733 lgtck     bce  4000-12&x2,xxxx,
 734           chain12
 735 lgtxt     b    xxxx
 736 holda     dcw  &0000
 737 blank4    dcw  #4
 738 blkct     equ  holda-1
 739 kblkng    dcw  @080@
 740 wmloc     dsa  wmstr-21
 741 awmstr    dsa  wmstr-21
 742 pnhloc    dcw  @000@
 743 wmstr     dcw  @001001040040040040040040040@
 744           ltorg*
 745           org  3831
 746 input4    da   1x86
 747                3,5
 748 label          6,11
 749 mnemon         16,20
 750 opernd         21,72
 751 altno          81,84
 752 image     equ  input4-1
 753 fixinp    equ  image&87&x3
 754 input5    equ  fixinp&1&x0
 755 prosiz    equ  ctlsav-9
 756 blank1    equ  blank4-3
 757 holdh     equ  holddt-52
 758           end  ssop
