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 108 parama equ 686 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 nuline 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 nuline 167 s pgctr 168 ccb nuline,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 333,out 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 240 one equ 679 241 gm equ 680 242 ltorg* 243 org 679 244 dcw @1}@ group mark in 680 245 xfr 0 246 job 1401 Fortran arith and relocatable routines 5059c 247 * 248 sfx b 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 qfunct 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 qfunct 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 517 job 1401 Fortran function common deck 50533 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 586 end