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