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