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 @V3M4@ v3m4 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 6751 mn front-5,tnmbr&7 v3m4 6752tnmbr bce replce,@6531@,0 v3m4 6573 chain3 v3m4 6754 mn @9@,work-3 v3m4 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 8724* mlzs acchi&x3,nsign wasn't actually done v3m4 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 dcw #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 30754 bce badst,0&x1,} gm v3m4 30764 mn 0&x1 v3m4 30774 sar x1 v3m4 30784 b grab1 v3m4 30794 bce badst,0&x1,} gm v3m4 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 30911 sw mktst&1 v3m4 30912 mlc take&3,mktst&3 v3m4 30913 cw mktst&1 v3m4 30914mktst mlc 0,test v3m4 30915 b take,test5-5,: 5-8 v3m4 30916 mlc @:@,test5-5 5-8 v3m4 30917 b badst v3m4 30918test5 dcw @: @ 5-8, blank.... v3m4 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 34224 bm teste,wctr v3m4 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 * 34651teste bce einpt, 5&x2, e v3m4 34652 b ersig v3m4 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 42894lgm mcw blnk#3,tuno-3 v3m4 42904 lca gm1,0&x3 v3m4 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 43744 fbceqnustm,code-3,r,e v3m4 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 56354 bwz tstzn,mxtmp,2 v3m4 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 56531tstzn bwz blwup,mxtmp-2,2 v3m4 56532 b gobak v3m4 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 64971 b *&15 v3m4 64972cntu2 sbr x1,1&x1 v3m4 64973 mlc @b@,symbl&7 v3m4 6498 bwz *&5,0&x1,2 duz replc tbl need updating 6499 b chnge 6500 bwz symbl,2&x1,2 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 66974add1 ma @001@,x2 v3m4 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 67544 bh mad v3m4 67545 b wrdmv v3m4 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 68114dolr bce ru68,0&x2,> 6-8 punch v3m4 68124 bce fnd,0&x2,$ v3m4 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 69064start b adjx3 v3m4 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 69111adjx3 bwz ckx3,x3,2 v3m4 69112 b exit3 v3m4 69113ckx3 bwz chgx3,x3-2,s v3m4 69114 b exit3 v3m4 69115chgx3 sbr x3,2000 v3m4 69116 b exit3 v3m4 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 sfx / 386 delta equ acchi-200 7095 110 dcw @]]]]]@ all 11-5-8 first card of package 391 job 1401 Fortran object time do 50533 392 sfx a 393 x1 equ 089 394 x2 equ 94 395 x3 equ 099 396 org 2000 397 do1 sbr exitl 398 sbr x2 399 sbr x2,4&x2 400 b initl&4 401 initl equ *&74 402 exitl equ *&123 403 xfr 0 404 org 2000 405 do2 sbr x2 406 mcw 11&x2,do3&6 407 mcw 408 mcw 5&x2,limt&3 409 mcw 11&x2,sbix&3 410 mcw 14&x2,testl&3 411 sbr exdo3&3,15&x2 412 do3 equ *&1 413 limt equ *&8 414 sbix equ *&15 415 testl equ *&22 416 exdo3 equ *&30 417 xfr 0 418 org 2000 419 a 0,0 420 bfixwza,000,fixword 421 bfixws,000,fixword 422 bfixwbwz,000,fixword,,k 423 b 0 424 xfr 0 425 job 1401 Fortran initialization of do loops for do,list 50533 426 org 2000 427 initil sbr exitel&3 428 mcw 2&x2,*&4 429 * note - address of fixword initialized by later pass 430 bfixwza,000,fixword 431 mcw 8&x2,*&4 432 bfixws,000,fixword 433 mcw 11&x2,*&7 434 afixwlca,fixword,,000 435 exitel b 000 436 ltorg* 437 xfr 0 438 job 1401 Fortran object time list 50533 439 org 2000 440 objlst sbr x2 441 sbr bstan&6,2&x2 442 sbr xtlst&3,3&x2 443 mcw 2&x2,adlst#3 444 xyz mcw adlst,x2 445 bw smple,0&x2 446 bce array,0&x2,, 447 bce subscb,0&x2,$ 448 bce indx1,0&x2,% begin of do-type 449 bce indx4,0&x2,) end of innermost do 450 bce indx2,0&x2,# end of outer do-type 451 mcw blank#3,x1 end of list 452 bstan mcw adlst,0 453 xtlst b 0 454 ray dcw @xxxxxx@ 455 smple mcw 2&x2,x1 456 sbr adlst,3&x2 457 b bstan 458 array mz 2136,*&8 fmtzon change on reasm of obj format 459 bce noswt,@2s@,2 460 bce 461 bwz inray,ray-4,2 462 mcw 6&x2,ray 463 mn parama&4,sbrlt&6 464 mn 465 bwz *&9,ray-4,k 466 mn parama&6,sbrlt&6 467 mn 468 mz *-4,ray-4 469 inray mcw ray-3,x1 470 sbrlt sbr x1,0&x1 471 mcw x1,ray-3 472 c ray,ray-3 473 bu bstan 474 mz *-6,ray-4 475 b dun1 476 noswt mcw 6&x2,ray 477 mcw @.@,x1 478 dun1 sbr adlst,7&x2 479 b bstan 480 subscb t dosbsc 481 mz *-4,x1-1 482 mcw x2,adlst 483 b bstan 484 indx1 sbr x2,1&x2 485 t doinit 486 mn 0&x2 487 sbr x2 488 b setup 489 indx2 mcw 3&x2,x2 490 setup mcw 12&x2,indx3&6 491 mcw 492 mcw 6&x2,limit&3 493 mcw 12&x2,subix&3 494 sbr lparn#3,0&x2 save addr of left paren 495 indx4 mcw lparn,x2 set x2 to addr of left paren 496 indx3 a 0,0 497 * note - address of fixword iniitialized by later phase of compiler 498 limit bfixwza,000,fixword 499 subix bfixws,000,fixword 500 * important note - the operand -satfy- in the following macro 501 * will not be coded as relocatable by the relocatable 502 * condensing routine. This is due to the fact that the 503 * condenser does not recognize dc or dcw statements as having 504 * relocatable operands. It is necessary to manually zone the 505 * set word mark instruction with and 11-punch to cause 506 * relocation. 507 bfixwbwz,satfy,fixword,,k 508 sbr adlst,16&x2 509 b xyz 510 satfy mcw 15&x2,adlst 511 b xyz 512 ltorg* 513 xfr 0 514 job 1401 Fortran object time subscripts 50533 515 org 2000 516 otsub sbr exits&3 517 mcw 3&x2,aaa#3 518 s prod#5 519 bav *&1 520 sbr1 mcw 9&x2,lca&3 521 mcw 6&x2,za&3 522 za za 000,workbb#5 523 lca lca 000,bfeel-6 524 m workbb,bfeel#11 525 a bfeel,prod 526 c prod-3,@15@ 527 bl ohalt 528 bce pack,10&x2,$ 529 sbr x2,6&x2 530 b sbr1 531 pack a &96,prod-3 532 bav pack 533 mz prod-4,prod 534 za prod-2,x1&1 535 mz zones-99&x1,prod-2 536 mcw prod,x1 537 mcw x1,sbr&6 538 mz zones-2,sbr&5 539 mcw aaa,x1 540 sbr sbr x1,0&x1 compute address 541 mz aaa-1,x1-1 542 sbr x2,11&x2 543 exits b 000 544 ohalt nop 2002 545 h 546 b ohalt 547 zones dcw @2skb@ 548 ltorg* 549 xfr 0 517 job 1401 Fortran function common deck 50533 sfx / 518 * Insert before sin-cos deck 519 org 2000 520 * 521 110 dcw @_____@ all 11-7-8 522 * 523 * variable length divide 524 * 525 divid sbr dvxt&3 526 mcw acchi&x3,spot 527 mn 528 lca &0 529 s &0,spot-1&x2 530 d 0&x1,spot 531 mn spot-1&x2,acchi&x3 532 mcw 533 mn 534 sar x1 535 dvxt b xxx 536 * 537 * power series calculation 538 * 539 calc sbr calxt&3 540 cw logm1,logm2 541 calc1 s top&1&X3 clear series accumulator 542 cw acchi&1 543 cw 544 sw 545 s x2&2 546 sbr x2,spot 547 calcl mcs spot 548 sw 0&x1 549 bce finis,0&x2, 550 mz spot&1,1&x2 551 a 1&x2,top&1&x3 add term to series accumulation 552 a dec,x2&1 553 c x2,x1 554 bh finis 555 a upby,ncon 556 a ncon,nctr 557 nop xxx,spot&1 558 logm1 za normally part of nop 559 m acchi&x3,spot&4&x3 560 mz spot&4&x3,spot&5 561 nop spot&5,xxx 562 logm2 za normally part of nop 563 d nctr,4&x1 564 b calcl 565 finis sw acchi&1 566 calxt b xxx 567 * 568 str1 s acchi&x3 569 mn &1,acchi&1 570 mz twtch,acchi&x3 571 mz calc,twtch 572 za &1,exp 573 b clrx 574 * 575 * common constants 576 * 577 ln10 equ * 578 dcw 23025850929940456840179 579 upby dcw #1 580 ncon dcw #3 581 nctr dcw #3 582 dec dcw #3 583 twtch dcw @A@ 584 * loader 585 ex divid 550 job 1401 Floating point sine - cosine subroutine 50533 551 sfx / 553 org 2000 554 * 555 trigf bce cosf,code,c 556 sinf be strze sine 0 # 0 557 mz acchi&x3,za1 sine -x # -sine x 558 b sncs 559 cosf be str1 cosine 0 # 1 560 mz &1,za1 cos -x # cos x 561 sncs mcw @ @,box 562 za exp,expb 563 s &1,exp 564 bm small,exp 565 a &2,exp 566 s x3,exp 567 bwz arglg,exp,b 568 za expb,exp 569 sbr x1,piov2&x3 reduce argument 570 za exp&1,x2&1 571 b divid divide argument by pi/2 572 za 1&x1,x2&1 573 sub4 s &40,x2&1 determine quadrant in which 574 bwz sub4,x2&1,b angle is located and whether 575 bce *&8,code,c sine or cosine function is to 576 sbr x2,1&x2 577 mz zonz&x2,nsign 578 mn zonz&x2,box#1 579 s dec dec # 0 580 s exp 581 bce cos,box,2 582 * 583 * sine initialization 584 * 585 sine za acchi&x3,top&1&x3 586 b sqrx 587 za top&1&x3,spot-1 first term # x 588 za spot&1 589 zs &2,ncon ncon # -2 590 * 591 * general initialization for series evaluation 592 * 593 scgen za &8,upby upby # &8 594 s nctr nctr # 8 595 b calc 596 * 597 * prepare fields for normalization 598 * 599 za1 za nsign 600 sbr x2,top&x3 601 b nmlz1 602 * 603 * cosine initialization 604 * 605 cos b sqrx 606 mn &1,0&x1 first term # 1 607 zs &6,ncon ncon # -6 608 s exp 609 b scgen 610 * 611 * square argument 612 * 613 sqrx sbr sqrxt&3 614 mcw acchi&x3,spot 615 sbr x1 616 lca @0@ 617 m acchi&x3,spot&1&x3 618 zs spot&2,acchi&x3 change to -% x squared ) 619 s spot&1 620 sqrxt b xxx 621 * 622 * small values of x 623 * 624 small a x3,exp 625 bm tstfc,exp 626 za expb,exp 627 mz acchi&x3,acchi-1&x3 shift contents of acchi&x3 628 za acchi-1&x3,acchi&x3 one position right 629 a expb 630 zs expb&1,dec dec # 20*exp 631 mz &1,nsign 632 bce cos,code,c 633 b sine 634 tstfc bce str1,code,c 635 za expb,exp 636 b clrwk 637 arglg b ermsg 638 dcw @scl@ 639 b strze 640 * 641 zonz equ * 642 dcw @akjba@ 643 * 644 piov2 equ * 645 dcw 1570796326794896619231 646 ex trigf 647 job 1401 floating point natural logarithm 50533 648 * 649 org 2000 650 * 651 logf mz acchi&x3,basez 652 logf2 be log99 653 bm loger, acchi&x3 q. negative argument 654 logf1 c spot-2,acchi&x3 655 sar x1 656 sw 0&x1 657 mn &1, 2&x1 set up constant one 658 * for fastest rate of convergence, place arg between .32 and 3.2 659 c acchi&2,@31@ 660 bh noshf 661 za acchi-1&x3,acchi&x3 662 a &1, exp shift dec point 1 to left 663 * 664 noshf s acchi&x3, spot-1 compute 1-x 665 zs spot-1,lzone correct sign 666 s &1, exp shift dec point 1 to right 667 a &1, acchi&1 compute x&1 668 s &0, spot&x3 create quotient field 669 d acchi&x3, spot-1 compute u # x-1 / x&1 670 lca spot-1, hold 671 m hold, spot&1&x3 compute u **2 672 za spot-1, acchi&x3 673 za hold, spot&1 674 za linit,dec dec set to 0 675 za nctr set to 1 676 za ncon set to 2 677 za upby set to 0 678 sw logm1,logm2 679 sbr logm1-4,hold 680 sbr logm2-1 681 sbr calxt&3,logrt 682 b calc1 683 logrt a top&1&x3 double result 684 mz lzone, top&x3 get proper sign 685 za ln10&1&x3,spot-2 686 m exp, spot&2 compute n * log10 687 a top&x3, spot&2 add n * log10 to result 688 sbr x2, spot&2 689 s expb 690 b mvzon 691 * 692 loger bw *&8,4&x2 693 b ermsg 694 dcw @lnn@ 695 mz linit,acchi&x3 make sign plus and find 696 b logf1 log of absolute value 697 log99 bw power,4&x2 698 b ermsg 699 dcw @lnz@ 700 mz -0,acchi&x3 give large neg number as result 701 b str99 702 power cw zrosw 703 b str1 704 * 705 dcw &0 upby 706 dcw &2 ncon 707 dcw &1 nctr 708 linit dcw &0 dec 709 hold dcw #26 710 lzone dcw #1 711 ex logf 712 job 1401 Fortran floating point exponential 50533 713 * 714 org 2000 715 * 716 expf mz one,nsign 717 mn xpnum,*&8 718 bce outm1,@02468@,0 719 chain4 720 mz basez,nsign 721 mn @8@,xpnum 722 outm1 bw runml,zrosw 723 sw zrosw base is zero 724 zs acchi&x3 725 bu qsign branch if arg not zero 726 b ermsg 727 dcw @ztz@ zero to zero power 728 petty mz nsign,twtch 729 b str1 730 runml be petty 731 nrml za exp,expb 732 s one,expb 733 bm sml,expb branch if exp less or # to zero 734 s three,expb 735 bm reduc,expb branch if exp greater than zero 736 * and less than four 737 * 738 * determine whether exponent overflow or underflow 739 * 740 qsign bm strze,acchi&x3 branch if argument negative 741 b ermsg exponent overflow 742 dcw @eof@ 743 b str99 744 * 745 * exponent # &1, &2, or &3 746 * 747 reduc sbr x1,ln10&x3 store address of divisor 748 za exp&1,x2&1 749 b divid 750 c 0&x1,thc99 751 bl qsign branch if quot greater than 99 752 za 0&x1,exp 753 mz acchi&x3,exp 754 * 755 * prepare fields for series calculation 756 * 757 s dec 758 fterm c spot,acchi&x3 set up term development area 759 sar x1 760 sw 0&x1 761 s spot&1 clear term development area 762 mn one,0&x1 first term # 1 763 za thc99-2,nctr set nctr # zero 764 za set ncon # 1 765 za set upby # zero 766 b calc 767 * 768 * prepare fields for normalizing 769 * 770 mz top&1&x3,top&x3 771 sbr x2,top&x3 772 b nmlz1 773 * 774 * exponents less or # to zero 775 * 776 sml a x3,expb 777 bm petty,expb branch if -e greater than precision 778 zs exp&1,dec set dec # e 779 s exp 780 mz acchi&x3,acchi-1&x3 set up series multiplier 781 za acchi-1&x3,acchi&x3 782 b fterm 783 dcw 0 784 one dcw &1 785 thc99 dcw &099 786 three dcw &3 787 ex expf 788 job 1401 floating point arctangent 50533 789 * 790 org 2000 791 * 792 case1 be strze 793 mz &1,initl 794 za acchi-1&x3,acchi&x3 795 s dec 796 s top&1&x3 797 c spot-2,acchi&x3 798 sar x1 799 sw 0&x1 800 za @0?@,spot&x3 801 mcw @0?@,expb 802 mn exp,expb 803 mn 804 c expb,@0?@ 805 be zerex 806 s x3,expb 807 bm test,expb 808 bm case2,exp 809 b case7 810 case2 mcw acchi&x3,top&x3 811 a &1,exp 812 b sign 813 case7 s exp 814 addpi2 a piov4&1&x3,top&1&x3 815 addpi4 a piov4&1&x3,top&1&x3 816 sign sbr x2,top&x3 817 b nmlz1 818 test bm case3,exp 819 mn &1,2&x1 820 shift za spot-1&x3,spot&x3 821 s &1,exp 822 c exp,@0?@ 823 bl shift 824 d acchi&x3,spot-1 825 c 2&x1,@042@ 826 bh case6 827 zs initl 828 mcw spot-3,acchi&x3 829 za @0?@,spot&x3 830 b case4 831 case6 sbr calxt&3,addpi2 832 zs initl 833 b mltply 834 case3 sbr calxt&3,sign 835 za exp,expb 836 a expb 837 zs expb&1,dec 838 mcw acchi&x3,spot-3 839 b mltply 840 zerex c acchi&3,@042@ 841 bh case3 842 case4 sbr calxt&3,addpi4 843 zs initl 844 mn &1,2&x1 845 s acchi&x3,spot-1 846 a &1,acchi&1 847 a @0?@,spot&x3 848 d acchi&x3,spot-1 849 mltply lca spot-1,holdd 850 m holdd,spot&2&x3 851 zs spot-1,acchi&x3 852 initl za holdd 853 za holdd,spot&1 854 za &2,ncon 855 s upby 856 za &1,nctr 857 sw logm1,logm2 858 sbr logm1-4,holdd 859 sbr logm2-1 860 b calc1 861 piov4 equ *&1 862 dcw @078539816339744830961566@ 863 holdd dcw #24 864 ex case1 865 job 1401 absolute value - negate subroutine 50533 866 * 867 org 2000 868 absvl mz *&1,acchi&x3 negate absolute value of argument 869 ex absvl 870 * 871 org 2000 872 negf zs acchi&x3 873 b clrwk 874 ex negf 875 job float to fix conversion 50533 876 * 877 org 2000 878 * 879 fixf sw fixsw 880 sbr x1,0&x3 881 mcw parama&4,*&7 882 sbr x3,000 883 s &1,exp 884 bm strze,exp store zero if char of arg less than 1 885 za exp&1,x2&1 886 c x1,x2 887 bl expls 888 s x1&1,x2&1 889 c x3,x2 890 bh strze 891 s spot&1&x2 892 za acchi&x1,spot 893 mz spot,spot&1&x2 894 za spot&1&x2,acchi&x3 store fixpt numbers modulo k 895 b clrwk 896 expls mz acchi&x1,acchi&1&x2 add only integer places 897 lca acchi&1&x2,spot 898 za spot,acchi&x3 899 b clrwk 900 ex fixf 901 job fix to float conversion 50533 902 * 903 org 2000 904 * 905 flot cw fixsw 906 bw *&5,4&x2 907 b *&8 908 mn acchi&x3,xpnum 909 sbr x2,spot 910 lca acchi&x3 911 mcw parama&6,*&7 912 sbr x3,000 913 za x3,expb 914 b mvzon 915 ex flot 916 job 1401 floating point square root 50533 917 * 918 org 2000 919 * 920 sqrtf bm qerr,acchi&x3 branch if argument negative 921 mn acchi&x3,top&21&x3 922 mcw 923 sw 924 sbr x1 925 lca &1,top initialize subtrahend 926 sbr x2 927 za exp&1,acchi&4 determine exponent of root 928 a &1, acchi&3 929 m &50,acchi&6 930 mn acchi&4, exp 931 mn 932 bce cksgn,acchi&5,0 933 sbr x1,1&x1 934 b qstrt 935 cksgn bwz qstrt,exp,b 936 a &1,exp 937 qstrt s acchi&x3 938 qrtn s &11,2&x2 adjust subtrahend 939 sw 21&x2 940 cw 941 sbr x2, 1&x2 942 zs &1, cntr#1 943 qloop a &1,cntr compute result digits 944 a &2,1&x2 increase subtrahend 945 s 1&x2,2&x1 do odd-integer subtractions 946 bwz qloop, 2&x1, b 947 a 1&x2, 2&x1 948 mn cntr, delta&x2 949 sbr x1, 2&x1 950 bwz qrtn, delta&x2, 2 951 b clrwk 952 qerr b ermsg 953 dcw @sqn@ 954 mz &1,acchi&x3 955 cs acchi-1 956 b sqrtf&8 957 ex sqrtf 958 job 1401 fortran user functions 50533 959 sfx a 960 org 2000 961 dcw @user function 1 goes here@ 962 xfr 0 963 org 2000 964 dcw @user function 2 goes here@ 965 xfr 0 966 org 2000 967 dcw @user function 3 goes here@ 968 xfr 0 969 org 2000 970 dcw @user function 4 goes here@ 971 xfr 0 972 org 2000 973 dcw @user function 5 goes here@ 974 xfr 0 975 org 2000 976 dcw @user function 6 goes here@ 977 xfr 0 978 org 2000 979 dcw @user function 7 goes here@ 980 xfr 0 981 org 2000 982 dcw @user function 8 goes here@ 983 xfr 0 984 org 2000 985 dcw @user function 9 goes here@ 986 xfr 0 987 org 2000 988 dcw @user function 10 goes here@ 989 xfr 0 990 org 2000 991 dcw @user function 11 goes here@ 992 xfr 0 993 org 2000 994 dcw @user function 12 goes here@ 995 xfr 0 996 job 1401 Fortran relocatable xlinkf 50533 997 org 2000 998 rstart mcw clrcon,359 chang on reasm of fixed xlink 999 b 337 1000 clrcon dcw #3 1001 ex rstart 1002 job 1401 Fortran function branch routine 50533 1003 org 2000 1004 t sinfun,4&x2,s 1005 xfr 0 1006 org 2000 1007 t sinfun,4&x2,C 1008 xfr 0 1009 org 2000 1010 t logfun,4&x2,g 1011 xfr 0 1012 org 2000 1013 t xpnetl,4&x2,e 1014 xfr 0 1015 org 2000 1016 t atanfn,4&x2,t 1017 xfr 0 1018 org 2000 1019 t absval,4&x2,a 1020 xfr 0 1021 org 2000 1022 t negtfn,4&x2,n 1023 xfr 0 1024 org 2000 1025 t fixfun,4&x2,x 1026 xfr 0 1027 org 2000 1028 t fltfun,4&x2,f 1029 xfr 0 1030 org 2000 1031 t sqrtfn,4&x2,q 1032 xfr 0 1033 org 2000 1034 t yuser1,4&x2,r 1035 xfr 0 1036 org 2000 1037 t yuser2,4&x2,u 1038 xfr 0 1039 org 2000 1040 t yuser3,4&x2,p 1041 xfr 0 1042 org 2000 1043 t yuser4,4&x2,w 1044 xfr 0 1045 org 2000 1046 t yuser5,4&x2,y 1047 xfr 0 1048 org 2000 1049 t yuser6,4&x2,z 1050 xfr 0 1051 org 2000 1052 t yuser7,4&x2,j 1053 xfr 0 1054 org 2000 1055 t yuser8,4&x2,k 1056 xfr 0 1057 org 2000 1058 t yuser9,4&x2,l 1059 xfr 0 1060 org 2000 1061 t yusr10,4&x2,m 1062 xfr 0 1063 org 2000 1064 t yusr11,4&x2,d 1065 xfr 0 1066 org 2000 1067 t yusr12,4&x2,h 1068 xfr 0 1069 org 2000 1070 t xlinks,4&x2,i 1071 xfr 0 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 101 job 1401 Fortran format package 5054a 102 ctl 645 11 103 sfx ; 104 110 dcw @formatpak@ 105 x1 equ 089 106 x2 equ 094 107 x3 equ 099 113 org startr 114 fomat sw gmwm,formaq 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,formaq 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,formaq 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 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 1981 bef rwt78 v3m4 1982 ma @001@,loc v3m4 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 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 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 formaq 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 fromm 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 5061 lca @10@,2&x1 v3m4 5062 cw 1&x1 v3m4 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 mlcwaformaq,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 6031 bfltwmlzs,nozn,fltwd,-2 v3m4 6032scnbl mlzs plus4,zaflt v3m4 6044 bce blank, 0&x3, blank v3m4 6054 bce minus,0&x3,- v3m4 6064 bce minus,0&x3,@ 4-8 v3m4 608 zs zaflt v3m4 609 bce kill,0&x3,& 610 b mv2wk 611 blank bw urzro-8,1&x3 612 b sbrx3 613 b scnbl 6131minus zs zaflt v3m4 614 kill sw 1&x3 6154plus4 b sbrx3 v3m4 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 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 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@ 74364 dcw @,008015,022026,030037,044,049,053034@ v3m4 7437 cs1a dc @,035036N00001026@ v3m4 7438 cs2xa dcw @L068116,105106,110117B101/I9I@ 7439 cs2a dc @H029NNNC029056B026/B001/0991,001/001117I0?@ v3m4 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 b pchcd v3m4 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 101 job 1401 Fortran Snapshot routine 5059a 102 ctl 644 11 103 sfx _ 104 xxx equ 0 105 xl1 equ 089 106 xl2 equ 094 107 xl3 equ 099 109 org 333 110 sbr prtxt&3 111 sbr hldxt&6 112 mcw @000@,linct-2 113 mcw xl3, hld32&6 114 mcw xl1, hld31&6 115 sbr xl1, 1 116 sbr xl3, 202 117 cs 332 118 cs 119 nop 110,210 120 bss only,f 121 cc 1 122 mcw 094,250 123 hldxt sbr 216,xxx 124 hld32 sbr 256,xxx 125 hld31 sbr 244,xxx 126 w 127 cc k 128 za &2,pgctr#2 129 nulin cs 332 130 cs 131 cc j 132 mcw linct,306 133 mcw 134 sbr mvhed&6 135 mcw @9@, ctr-1 136 mvhed mcw ctr-1,xxx 137 mcw head 138 sbr mvhed&6 139 a @i0@, ctr#2 140 bwz mvhed, ctr-1, 2 141 a &1,linct-2 142 w 143 loop sw 0&x3 144 mcw 0&x1,0&x3 145 bw cmpab,0&x1 146 cw 0&x3 147 cmpab c xl1,parama&2 148 bu cpl 149 w 150 wm 151 rstrx mcw hld31&6,xl1 152 mcw hld32&6,xl3 153 cs 332 154 cs 155 bss *&5,g 156 b prtxt 157 h 158 prtxt h 0 159 cpl sbr xl1, 1&x1 160 bce inc, xl3-2, 2 161 sbr xl3, 201 162 w 163 wm 164 a &1,pgctr 165 c pgctr,&15 166 bu nulin 167 s pgctr 168 ccb nulin,1 169 only mcw @executed@,220 170 w rstrx 171 inc a &1,xl3 172 b loop 173 head dcw @9........@ 174 dcw @9-@ 175 linct dcw 00000 176 ltorg* 177 xfr 0 178 job 1401 Fortran fixed xlink routine 5059b 179 org 333 180 h 333 181 start mcw 86,xl2 x2 follows b700 182 cs 80 183 bce array,0&x2,$ 184 clear cs 000 185 sbr adr3 186 c adr3,@699@ 187 bu clear 188 sw acchi-5&x3 189 mz acchi&x3,field 190 c field,acchi&x3 191 be cards 192 bm getm,acchi&x3 193 mz zero,acchi&x3 194 c 699,acchi&x3 195 be getm 196 sw 22 197 mcw gm,22 198 serch rt 1,1 199 bef out 200 c 10,@lib@ 201 bu serch 202 c 17,acchi&x3 203 be t1 254 b serch 205 out nop cards 206 mcw tperm,out v3m4 207 rwd 1 208 b serch 209 t1 lca zeros,101 210 lca zeros 211 lca zeros 212 rtw 1,333 213 ber err 214 mcw zero,ctrr 215 sbr tperm-1,t2 216 t2 rtw 1,700 217 ber err 218 tboot b 000 from libed 219 err a one,ctrr 220 bce tperm,ctrr,9 221 bsp 1 222 b t1 223 tperm h tperm 224 array mcw 3&x2,adr3 225 mz zero,adr3-1 226 b clear 227 cards sw 1 228 r 229 bce 1,1,, 230 b cards 231 getm rwd 1 232 rtw 1,1 233 b 1 execute monitor program 234 adr3 equ clear&3 235 field dcw @000000@ 236 zeros equ field-1 237 zero equ zeros-4 238 ctrr equ zeros 239 acchi equ 279 242 ltorg* 243 org 679 244 one dcw 1 2441gm dc @}@ group mark in 680 245 xfr 0 246 job 1401 Fortran arith and relocatable routines 5059c 247 * 248 sfx ^ 249 * 250 xinitxl1,xl2,xl3,,,,xxxx 251 * 252 xnmbr 253 * 254 wkzon equ 200 255 top equ wkzon&1 256 spot equ wkzon&50 257 acchi equ wkzon&79 258 * 259 org 700 260 * 261 * arithmetic routine monitor 262 * 263 aritf sbr x2 264 sbr 086 store first location of arith string 265 sbr stmnm&6 266 arith mcw 2&x2, x1 267 sar algrt&6 268 sbbr1 sbr brwhr&6 269 bce stsub,0&x2,$ check for subscripted store location 270 sbr out2&6,0&x1 271 cs wkzon&103 clear work area 272 cs 273 cs 274 lca @0@, acchi&1 275 clrx s x1&2 276 algrt sbr xl2, xxx 277 c 4&x2, @#@ 278 mcw 4&x2, signf 279 sw top 280 exit bl qfunc 281 sbr ngbmp&6,4&x2 282 bce opdsc,5&x2,$ check for subscripted operand 283 mcw 7&x2, xl1 284 sar algrt&6 285 sbbr2 bwz xsize,x1-1,k branch if fixpt computation 286 bwz xsize,x1-1,s 287 * 288 * float arithmetic 289 * 290 fsize sbr x3,xxx store float size 291 cw fixsw#1 292 mcw 0&x1,expb store exponent 293 sar xl1 294 mcw 0&x1,spot initialize work area 295 sbr xl2 296 lca @0@ 297 ngbmp bw *&8,0 298 mz spot, nsign 299 s @0@,spot&2&x3 300 c 1&x2, @0@ 301 a xl3, xl2 302 bce fdiv,code,/ branch for division 303 bce fmpy,code,* branch for multiplication - 304 * 305 * floating add / subtract 306 * 307 s signf 308 signf za nsign 309 bce nuval,acchi&1,0 br, if 1st operand of computation 310 be clrwk 311 s expb,exp 312 za exp&1,xl1&1 313 c xl3,xl1 314 bm rtn1,exp 315 bh chgex br if prev result to be retained in wk acc 316 a exp,expb 317 za spot,spot&x1 initialize work area 318 za xl3&1,xl1&1 319 ascom mz nsign,0&x2 320 a acchi&x1,0&x2 321 mvzon mz 0&x2,nsign 322 nuval za expb,exp 323 * 324 * normalize 325 * 326 nmlz1 mcw rcdmk,1&x2 327 mz 328 mz 329 a 330 mn 331 sbr xl1 332 s acchi&2&x3 333 nloop bce strze,2&x1,| 334 sbr xl1 335 bce nloop, 1&x1, 0 336 mcm 1&x1, acchi&1 337 s xl3, xl2 398 cw 339 cw 340 s 341 s xl1,exp 342 nsign za acchi&x3 move proper sign to work accumulator 343 sw 344 bce clrwk,exp-2,0 345 bm strze,exp branch on exponent underflow 346 * 347 * exponent overflow due to normalization 348 * 349 b ermsg 350 dcw @nof@ 351 * 352 * store nines in work accumulator and exp on exponent ovfl 353 * 354 str99 za &99,exp 355 mn &99,acchi&x3 356 mcw 357 mcw acchi-1&x3 358 clrwk cs acchi-1 359 b clrx 360 * 361 * store zero in work accumulator 362 * 363 strze s exp 364 s acchi&x3 365 b clrwk 366 * 367 * division by zero attempted 368 * 369 dverr b ermsg 370 dcw @dze@ 371 b str99 372 * 373 rtn1 bh nuval branch to store new value in wk acc 374 s xl3&1,xl1&1 initialize index registers 375 mz acchi&x3,acchi&x1 initialize work accumulator 376 b ascom 377 * 378 chgex a expb,exp 379 b clrwk 380 * 381 * subscripted variables 332 * 383 opdsc sbr x2,5&x2 384 stsub b xxx 385 mn 0&x2 386 mn 387 mn 388 mn 389 sar algrt&6 390 brwhr bce sbbr1,xxx,$ 391 b sbbr2 392 * 393 * floating divide 394 * 395 fdiv be dverr 396 mn acchi&x3, 1&x2 397 mcw 398 mn 399 d 0&x1, spot&1 400 zs expb 401 b ndmdv 402 * 403 * floating multiply 404 * 405 fmpy m acchi&x3, spot&1&x3 406 sbr x2,3&x2 407 s &2,exp 408 ndmdv a expb, exp 409 mz acchi&x3, *&1 410 za nsign 411 b nmlz1 412 * 413 * exit routine 414 * 415 qfunc bce out1,4&x2,| br if contents of wk acc to be stored 416 sbr algrt&6,1&x2 417 c acchi&1,@0@ 418 b xxx branch to function selection routine 419 out1 bce out2,acchi&1,0 420 bw out2,fixsw 421 bw finst,4&x2 branch if final storage of comp 422 sbr x3,2&x3 423 mvexp mcm exp-1,acchi-1&x3 424 out2 lca acchi&x3,xxx 425 bw 5&x2,4&x2 br to prog mainline if end of arith str 426 sar xl2 427 b arith 428 * 429 * rounding for final storage 430 * 431 finst a &5,acchi-1&x3 482 bwz rdovf,acchi&1,s 433 zonmv mz acchi&x3,acchi-2&x3 434 b mvexp 435 rdovf a &1,exp 436 bce nornd,exp-2,1 437 s acchi&x3 438 lca @1@,acchi&1 439 b zonmv 440 * 441 * no rounding if exponent overflow would occur 442 * 443 nornd mn &99,acchi&x3 444 mcw 445 mcw acchi-1&x3 446 s &1,exp 447 b zonmv 448 * 449 * print error message 450 * 451 ermsg sbr strx2&6 452 cs top&1&x3 453 sbr rinx2&6,0&x3 454 strx2 sbr x3,xxx 455 mcw 2&x3,top&11 456 stmnm sbr top&16,xxx 457 w 458 sw top 459 sbr ermxt&3,3&x3 460 rinx2 sbr x3,xxx 461 ermxt b xxx 462 * 463 * fixed point entry 464 * 465 xsize sbr x3,xxx store fix-size 466 sw fixsw 467 * 468 fixpt mcs 0&x1, spot 469 bce xdiv, code, / 470 bce xmpy, code, * 471 * 472 * fixed add / subtract 473 * 474 bwz subtr, code, k q. subtract 475 a 0&x1, acchi&x3 476 addrt za acchi&x3 477 b clrwk 478 * 479 subtr s 0&x1, acchi&x3 480 b addrt 481 * 482 * fixed multiply 483 * 484 xmpy lca 0&x1, spot 485 m acchi&x3, spot&1&x3 486 mcw spot&1&x3, acchi&x3 487 b clrwk 488 * 489 * fixed divide 490 * 491 xdiv bce dverr, spot, 492 mcw 0&x1,spot&x3 493 mn 494 sbr mvqut&3 495 lca acchi&x3 496 za acchi&x3, spot&x3 497 d 0&x1, spot&1 498 mvqut mcw spot-1,acchi&x3 499 b clrwk 500 * 501 dcw 000 502 rcdmk dcw @|@ 503 dcw 0 504 exp dcw 000 505 dc @|@ 506 expb dcw 00 507 dc 0 508 code equ signf 509 zrosw equ *&1 510 basez equ *&1 511 xpnum dcw @8@ 512 ltorg* 513 ds 1 514 dcw @0@ 515 dc @}@ system group mark 516 xfr 0 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 end1 v3m4 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 wp&25,end2 v3m4 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 tperm,out v3m4 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 101 013 job 1401 Fortran arith and relocatable routines 50633 103 * 104 sfx / 105 * 106 xinitxl1,xl2,xl3,,,,xxxx 107 * 108 xnmbr 109 * 110 wkzon equ 200 111 top equ wkzon&1 112 spot equ wkzon&50 113 acchi equ wkzon&79 114 * 115 org 700 116 * 117 * arithmetic routine monitor 118 * 119 aritf sbr x2 120 sbr 086 store first location of arith string 121 sbr stmnm&6 122 arith mcw 2&x2, x1 123 sar algrt&6 124 sbbr1 sbr brwhr&6 125 bce stsub,0&x2,$ check for subscripted store location 126 sbr out2&6,0&x1 127 cs wkzon&103 clear work area 128 cs 129 cs 130 lca @0@, acchi&1 131 clrx s x1&2 132 algrt sbr xl2, xxx 133 c 4&x2, @#@ 134 mcw 4&x2, signf 135 sw top 136 exit bl qfunc 137 sbr ngbmp&6,4&x2 138 bce opdsc,5&x2,$ check for subscripted operand 139 mcw 7&x2, xl1 140 sar algrt&6 141 sbbr2 bwz xsize,x1-1,k branch if fixpt computation 142 bwz xsize,x1-1,s 143 * 144 * float arithmetic 145 * 146 fsize sbr x3,xxx store float size 147 cw fixsw#1 148 mcw 0&x1,expb store exponent 149 sar xl1 150 mcw 0&x1,spot initialize work area 151 sbr xl2 152 lca @0@ 153 ngbmp bw *&8,0 154 mz spot, nsign 155 s @0@,spot&2&x3 156 c 1&x2, @0@ 157 a xl3, xl2 158 bce fdiv,code,/ branch for division 159 bce fmpy,code,* branch for multiplication - 160 * 161 * floating add / subtract 162 * 163 s signf 164 signf za nsign 165 bce nuval,acchi&1,0 br, if 1st operand of computation 166 be clrwk 167 s expb,exp 168 za exp&1,xl1&1 169 c xl3,xl1 170 bm rtn1,exp 171 bh chgex br if prev result to be retained in wk acc 172 a exp,expb 173 za spot,spot&x1 initialize work area 174 za xl3&1,xl1&1 175 ascom mz nsign,0&x2 176 a acchi&x1,0&x2 177 mvzon mz 0&x2,nsign 178 nuval za expb,exp 179 * 180 * normalize 181 * 182 nmlz1 mcw rcdmk,1&x2 183 mz 184 mz 185 a 186 mn 187 sbr xl1 188 s acchi&2&x3 189 nloop bce strze,2&x1,| 190 sbr xl1 191 bce nloop, 1&x1, 0 192 mcm 1&x1, acchi&1 193 s xl3, xl2 194 cw 195 cw 196 s 197 s xl1,exp 198 nsign za acchi&x3 move proper sign to work accumulator 199 sw 200 bce clrwk,exp-2,0 201 bm strze,exp branch on exponent underflow 202 * 203 * exponent overflow due to normalization 204 * 205 b ermsg 206 dcw @nof@ 207 * 208 * store nines in work accumulator and exp on exponent ovfl 209 * 210 str99 za &99,exp 211 mn &99,acchi&x3 212 mcw 213 mcw acchi-1&x3 214 clrwk cs acchi-1 215 b clrx 216 * 217 * store zero in work accumulator 218 * 219 strze s exp 220 s acchi&x3 221 b clrwk 222 * 223 * division by zero attempted 224 * 225 dverr b ermsg 226 dcw @dze@ 227 b str99 228 * 229 rtn1 bh nuval branch to store new value in wk acc 230 s xl3&1,xl1&1 initialize index registers 231 mz acchi&x3,acchi&x1 initialize work accumulator 232 b ascom 233 * 234 chgex a expb,exp 235 b clrwk 236 * 237 * subscripted variables 238 * 239 opdsc sbr x2,5&x2 240 stsub b xxx 241 mn 0&x2 242 mn 243 mn 244 mn 245 sar algrt&6 246 brwhr bce sbbr1,xxx,$ 247 b sbbr2 248 * 249 * floating divide 250 * 251 fdiv be dverr 252 mn acchi&x3, 1&x2 253 mcw 254 mn 255 d 0&x1, spot&1 256 zs expb 257 b ndmdv 258 * 259 * floating multiply 260 * 261 fmpy m acchi&x3, spot&1&x3 262 sbr x2,3&x2 263 s &2,exp 264 ndmdv a expb, exp 265 mz acchi&x3, *&1 266 za nsign 267 b nmlz1 268 * 269 * exit routine 270 * 271 qfunc bce out1,4&x2,| br if contents of wk acc to be stored 272 sbr algrt&6,1&x2 273 c acchi&1,@0@ 274 b xxx branch to function selection routine 275 out1 bce out2,acchi&1,0 276 bw out2,fixsw 277 bw finst,4&x2 branch if final storage of comp 278 sbr x3,2&x3 279 mvexp mcm exp-1,acchi-1&x3 280 out2 lca acchi&x3,xxx 281 bw 5&x2,4&x2 br to prog mainline if end of arith str 282 sar xl2 283 b arith 284 * 285 * rounding for final storage 286 * 287 finst a &5,acchi-1&x3 288 bwz rdovf,acchi&1,s 289 zonmv mz acchi&x3,acchi-2&x3 290 b mvexp 291 rdovf a &1,exp 292 bce nornd,exp-2,1 293 s acchi&x3 294 lca @1@,acchi&1 295 b zonmv 296 * 297 * no rounding if exponent overflow would occur 298 * 299 nornd mn &99,acchi&x3 300 mcw 301 mcw acchi-1&x3 302 s &1,exp 303 b zonmv 304 * 305 * print error message 306 * 307 ermsg sbr strx2&6 308 cs top&1&x3 309 sbr rinx2&6,0&x3 310 strx2 sbr x3,xxx 311 mcw 2&x3,top&11 312 stmnm sbr top&16,xxx 313 w 314 sw top 315 sbr ermxt&3,3&x3 316 rinx2 sbr x3,xxx 317 ermxt b xxx 318 * 319 * fixed point entry 320 * 321 xsize sbr x3,xxx store fix-size 322 sw fixsw 323 * 324 fixpt mcs 0&x1, spot 325 bce xdiv, code, / 326 bce xmpy, code, * 327 * 328 * fixed add / subtract 329 * 330 bwz subtr, code, k q. subtract 331 a 0&x1, acchi&x3 332 addrt za acchi&x3 333 b clrwk 334 * 335 subtr s 0&x1, acchi&x3 336 b addrt 337 * 338 * fixed multiply 339 * 340 xmpy lca 0&x1, spot 341 m acchi&x3, spot&1&x3 342 mcw spot&1&x3, acchi&x3 343 b clrwk 344 * 345 * fixed divide 346 * 347 xdiv bce dverr, spot, 348 mcw 0&x1,spot&x3 349 mn 350 sbr mvqut&3 351 lca acchi&x3 352 za acchi&x3, spot&x3 353 d 0&x1, spot&1 354 mvqut mcw spot-1,acchi&x3 355 b clrwk 356 * 357 dcw 000 358 rcdmk dcw @|@ 359 dcw 0 360 exp dcw 000 361 dc @|@ 362 expb dcw 00 363 dc 0 364 code equ signf 365 zrosw equ *&1 366 basez equ *&1 367 xpnum dcw @8@ 368 ltorg* 369 ds 1 370 dcw @0@ 371 dc @}@ system group mark sfx 6 7828 end init the deed is done