       5059ABC-53B.s                                                                                                 5059ABC-53B-v3m4.s
       =============                                                                                                 ==================
    1:  101           job  1401 Fortran  Snapshot routine                         5059a                           1:   101           job  1401 Fortran  Snapshot routine                         5059a
    2:  102           ctl  644 11                                                                                 2:   102           ctl  644 11
    3:  103           sfx  #                                                                                      3:   103           sfx  #
    4:  104 xxx       equ  0                                                                                      4:   104 xxx       equ  0
    5:  105 xl1       equ  089                                                                                    5:   105 xl1       equ  089
    6:  106 xl2       equ  094                                                                                    6:   106 xl2       equ  094
    7:  107 xl3       equ  099                                                                                    7:   107 xl3       equ  099
    8:  108 parama    equ  686                                                                                    8:   108 parama    equ  686
    9:  109           org  333                                                                                    9:   109           org  333
   10:  110           sbr  prtxt&3                                                                               10:   110           sbr  prtxt&3
   11:  111           sbr  hldxt&6                                                                               11:   111           sbr  hldxt&6
   12:  112           mcw  @000@,linct-2                                                                         12:   112           mcw  @000@,linct-2
   13:  113           mcw  xl3, hld32&6                                                                          13:   113           mcw  xl3, hld32&6
   14:  114           mcw  xl1, hld31&6                                                                          14:   114           mcw  xl1, hld31&6
   15:  115           sbr  xl1, 1                                                                                15:   115           sbr  xl1, 1
   16:  116           sbr  xl3, 202                                                                              16:   116           sbr  xl3, 202
   17:  117           cs   332                                                                                   17:   117           cs   332
   18:  118           cs                                                                                         18:   118           cs
   19:  119           nop  110,210                                                                               19:   119           nop  110,210
   20:  120           bss  only,f                                                                                20:   120           bss  only,f
   21:  121           cc   1                                                                                     21:   121           cc   1
   22:  122           mcw  094,250                                                                               22:   122           mcw  094,250
   23:  123 hldxt     sbr  216,xxx                                                                               23:   123 hldxt     sbr  216,xxx
   24:  124 hld32     sbr  256,xxx                                                                               24:   124 hld32     sbr  256,xxx
   25:  125 hld31     sbr  244,xxx                                                                               25:   125 hld31     sbr  244,xxx
   26:  126           w                                                                                          26:   126           w
   27:  127           cc   k                                                                                     27:   127           cc   k
   28:  128           za   &2,pgctr#2                                                                            28:   128           za   &2,pgctr#2
   29:  129 nuline    cs   332                                                                                   29:   129 nuline    cs   332
   30:  130           cs                                                                                         30:   130           cs
   31:  131           cc   j                                                                                     31:   131           cc   j
   32:  132           mcw  linct,306                                                                             32:   132           mcw  linct,306
   33:  133           mcw                                                                                        33:   133           mcw
   34:  134           sbr  mvhed&6                                                                               34:   134           sbr  mvhed&6
   35:  135           mcw  @9@, ctr-1                                                                            35:   135           mcw  @9@, ctr-1
   36:  136 mvhed     mcw  ctr-1,xxx                                                                             36:   136 mvhed     mcw  ctr-1,xxx
   37:  137           mcw  head                                                                                  37:   137           mcw  head
   38:  138           sbr  mvhed&6                                                                               38:   138           sbr  mvhed&6
   39:  139           a    @i0@, ctr#2                                                                           39:   139           a    @i0@, ctr#2
   40:  140           bwz  mvhed, ctr-1, 2                                                                       40:   140           bwz  mvhed, ctr-1, 2
   41:  141           a    &1,linct-2                                                                            41:   141           a    &1,linct-2
   42:  142           w                                                                                          42:   142           w
   43:  143 loop      sw   0&x3                                                                                  43:   143 loop      sw   0&x3
   44:  144           mcw  0&x1,0&x3                                                                             44:   144           mcw  0&x1,0&x3
   45:  145           bw   cmpab,0&x1                                                                            45:   145           bw   cmpab,0&x1
   46:  146           cw   0&x3                                                                                  46:   146           cw   0&x3
   47:  147 cmpab     c    xl1,parama&2                                                                          47:   147 cmpab     c    xl1,parama&2
   48:  148           bu   cpl                                                                                   48:   148           bu   cpl
   49:  149           w                                                                                          49:   149           w
   50:  150           wm                                                                                         50:   150           wm
   51:  151 rstrx     mcw  hld31&6,xl1                                                                           51:   151 rstrx     mcw  hld31&6,xl1
   52:  152           mcw  hld32&6,xl3                                                                           52:   152           mcw  hld32&6,xl3
   53:  153           cs   332                                                                                   53:   153           cs   332
   54:  154           cs                                                                                         54:   154           cs
   55:  155           bss  *&5,g                                                                                 55:   155           bss  *&5,g
   56:  156           b    prtxt                                                                                 56:   156           b    prtxt
   57:  157           h                                                                                          57:   157           h
   58:  158 prtxt     h    0                                                                                     58:   158 prtxt     h    0
   59:  159 cpl       sbr  xl1, 1&x1                                                                             59:   159 cpl       sbr  xl1, 1&x1
   60:  160           bce  inc, xl3-2, 2                                                                         60:   160           bce  inc, xl3-2, 2
   61:  161           sbr  xl3, 201                                                                              61:   161           sbr  xl3, 201
   62:  162           w                                                                                          62:   162           w
   63:  163           wm                                                                                         63:   163           wm
   64:  164           a    &1,pgctr                                                                              64:   164           a    &1,pgctr
   65:  165           c    pgctr,&15                                                                             65:   165           c    pgctr,&15
   66:  166           bu   nuline                                                                                66:   166           bu   nuline
   67:  167           s    pgctr                                                                                 67:   167           s    pgctr
   68:  168           ccb  nuline,1                                                                              68:   168           ccb  nuline,1
   69:  169 only      mcw  @executed@,220                                                                        69:   169 only      mcw  @executed@,220
   70:  170           w    rstrx                                                                                 70:   170           w    rstrx
   71:  171 inc       a    &1,xl3                                                                                71:   171 inc       a    &1,xl3
   72:  172           b    loop                                                                                  72:   172           b    loop
   73:  173 head      dcw  @9........@                                                                           73:   173 head      dcw  @9........@
   74:  174           dcw  @9-@                                                                                  74:   174           dcw  @9-@
   75:  175 linct     dcw  00000                                                                                 75:   175 linct     dcw  00000
   76:  176           ltorg*                                                                                     76:   176           ltorg*
   77:  177           xfr  0                                                                                     77:   177           xfr  0
   78:  178           job  1401 Fortran fixed xlink routine                       5059b                          78:   178           job  1401 Fortran fixed xlink routine                       5059b
   79:  179           org  333                                                                                   79:   179           org  333
   80:  180           h    333                                                                                   80:   180           h    333
   81:  181 start     mcw  86,xl2             x2 follows b700                                                    81:   181 start     mcw  86,xl2             x2 follows b700
   82:  182           cs   80                                                                                    82:   182           cs   80
   83:  183           bce  array,0&x2,$                                                                          83:   183           bce  array,0&x2,$
   84:  184 clear     cs   000                                                                                   84:   184 clear     cs   000
   85:  185           sbr  adr3                                                                                  85:   185           sbr  adr3
   86:  186           c    adr3,@699@                                                                            86:   186           c    adr3,@699@
   87:  187           bu   clear                                                                                 87:   187           bu   clear
   88:  188           sw   acchi-5&x3                                                                            88:   188           sw   acchi-5&x3
   89:  189           mz   acchi&x3,field                                                                        89:   189           mz   acchi&x3,field
   90:  190           c    field,acchi&x3                                                                        90:   190           c    field,acchi&x3
   91:  191           be   cards                                                                                 91:   191           be   cards
   92:  192           bm   getm,acchi&x3                                                                         92:   192           bm   getm,acchi&x3
   93:  193           mz   zero,acchi&x3                                                                         93:   193           mz   zero,acchi&x3
   94:  194           c    699,acchi&x3                                                                          94:   194           c    699,acchi&x3
   95:  195           be   getm                                                                                  95:   195           be   getm
   96:  196           sw   22                                                                                    96:   196           sw   22
   97:  197           mcw  gm,22                                                                                 97:   197           mcw  gm,22
   98:  198 serch     rt   1,1                                                                                   98:   198 serch     rt   1,1
   99:  199           bef  out                                                                                   99:   199           bef  out
  100:  200           c    10,@lib@                                                                             100:   200           c    10,@lib@
  101:  201           bu   serch                                                                                101:   201           bu   serch
  102:  202           c    17,acchi&x3                                                                          102:   202           c    17,acchi&x3
  103:  203           be   t1                                                                                   103:   203           be   t1
  104:  254           b    serch                                                                                104:   254           b    serch
  105:  205 out       nop  cards                                                                                105:   205 out       nop  cards
  106:  206           mcw  333,out                                                                           |  106:   206           mcw  tperm,out                                       v3m4
  107:  207           rwd  1                                                                                    107:   207           rwd  1
  108:  208           b    serch                                                                                108:   208           b    serch
  109:  209 t1        lca  zeros,101                                                                            109:   209 t1        lca  zeros,101
  110:  210           lca  zeros                                                                                110:   210           lca  zeros
  111:  211           lca  zeros                                                                                111:   211           lca  zeros
  112:  212           rtw  1,333                                                                                112:   212           rtw  1,333
  113:  213           ber  err                                                                                  113:   213           ber  err
  114:  214           mcw  zero,ctrr                                                                            114:   214           mcw  zero,ctrr
  115:  215           sbr  tperm-1,t2                                                                           115:   215           sbr  tperm-1,t2
  116:  216 t2        rtw  1,700                                                                                116:   216 t2        rtw  1,700
  117:  217           ber  err                                                                                  117:   217           ber  err
  118:  218 tboot     b    000                from libed                                                        118:   218 tboot     b    000                from libed
  119:  219 err       a    one,ctrr                                                                             119:   219 err       a    one,ctrr
  120:  220           bce  tperm,ctrr,9                                                                         120:   220           bce  tperm,ctrr,9
  121:  221           bsp  1                                                                                    121:   221           bsp  1
  122:  222           b    t1                                                                                   122:   222           b    t1
  123:  223 tperm     h    tperm                                                                                123:   223 tperm     h    tperm
  124:  224 array     mcw  3&x2,adr3                                                                            124:   224 array     mcw  3&x2,adr3
  125:  225           mz   zero,adr3-1                                                                          125:   225           mz   zero,adr3-1
  126:  226           b    clear                                                                                126:   226           b    clear
  127:  227 cards     sw   1                                                                                    127:   227 cards     sw   1
  128:  228           r                                                                                         128:   228           r
  129:  229           bce  1,1,,                                                                                129:   229           bce  1,1,,
  130:  230           b    cards                                                                                130:   230           b    cards
  131:  231 getm      rwd  1                                                                                    131:   231 getm      rwd  1
  132:  232           rtw  1,1                                                                                  132:   232           rtw  1,1
  133:  233           b    1        execute monitor program                                                     133:   233           b    1        execute monitor program
  134:  234 adr3      equ  clear&3                                                                              134:   234 adr3      equ  clear&3
  135:  235 field     dcw  @000000@                                                                             135:   235 field     dcw  @000000@
  136:  236 zeros     equ  field-1                                                                              136:   236 zeros     equ  field-1
  137:  237 zero      equ  zeros-4                                                                              137:   237 zero      equ  zeros-4
  138:  238 ctrr      equ  zeros                                                                                138:   238 ctrr      equ  zeros
  139:  239 acchi     equ  279                                                                                  139:   239 acchi     equ  279
  140:  240 one       equ  679                                                                                  140:   240 one       equ  679
  141:  241 gm        equ  680                                                                                  141:   241 gm        equ  680
  142:  242           ltorg*                                                                                    142:   242           ltorg*
  143:  243           org  679                                                                                  143:   243           org  679
  144:  244           dcw  @1}@                group mark in 680                                                144:   244           dcw  @1}@                group mark in 680
  145:  245           xfr  0                                                                                    145:   245           xfr  0
  146:  246           job  1401  Fortran arith and relocatable routines           5059c                         146:   246           job  1401  Fortran arith and relocatable routines           5059c
  147:  247 *                                                                                                   147:   247 *
  148:  248           sfx  b                                                                                    148:   248           sfx  b
  149:  249 *                                                                                                   149:   249 *
  150:  250           xinitxl1,xl2,xl3,,,,xxxx                                                                  150:   250           xinitxl1,xl2,xl3,,,,xxxx
  151:  251 *                                                                                                   151:   251 *
  152:  252           xnmbr                                                                                     152:   252           xnmbr
  153:  253 *                                                                                                   153:   253 *
  154:  254 wkzon     equ  200                                                                                  154:   254 wkzon     equ  200
  155:  255 top       equ  wkzon&1                                                                              155:   255 top       equ  wkzon&1
  156:  256 spot      equ  wkzon&50                                                                             156:   256 spot      equ  wkzon&50
  157:  257 acchi     equ  wkzon&79                                                                             157:   257 acchi     equ  wkzon&79
  158:  258 *                                                                                                   158:   258 *
  159:  259           org  700                                                                                  159:   259           org  700
  160:  260 *                                                                                                   160:   260 *
  161:  261 *                      arithmetic  routine  monitor                                                 161:   261 *                      arithmetic  routine  monitor
  162:  262 *                                                                                                   162:   262 *
  163:  263 aritf     sbr  x2                                                                                   163:   263 aritf     sbr  x2
  164:  264           sbr  086            store first location of arith string                                  164:   264           sbr  086            store first location of arith string
  165:  265           sbr  stmnm&6                                                                              165:   265           sbr  stmnm&6
  166:  266 arith     mcw  2&x2, x1                                                                             166:   266 arith     mcw  2&x2, x1
  167:  267           sar  algrt&6                                                                              167:   267           sar  algrt&6
  168:  268 sbbr1     sbr  brwhr&6                                                                              168:   268 sbbr1     sbr  brwhr&6
  169:  269           bce  stsub,0&x2,$   check for subscripted store location                                  169:   269           bce  stsub,0&x2,$   check for subscripted store location
  170:  270           sbr  out2&6,0&x1                                                                          170:   270           sbr  out2&6,0&x1
  171:  271           cs   wkzon&103      clear work area                                                       171:   271           cs   wkzon&103      clear work area
  172:  272           cs                                                                                        172:   272           cs
  173:  273           cs                                                                                        173:   273           cs
  174:  274           lca  @0@, acchi&1                                                                         174:   274           lca  @0@, acchi&1
  175:  275 clrx      s    x1&2                                                                                 175:   275 clrx      s    x1&2
  176:  276 algrt     sbr  xl2, xxx                                                                             176:   276 algrt     sbr  xl2, xxx
  177:  277           c    4&x2, @#@                                                                            177:   277           c    4&x2, @#@
  178:  278           mcw  4&x2, signf                                                                          178:   278           mcw  4&x2, signf
  179:  279           sw   top                                                                                  179:   279           sw   top
  180:  280 exit      bl   qfunct                                                                               180:   280 exit      bl   qfunct
  181:  281           sbr  ngbmp&6,4&x2                                                                         181:   281           sbr  ngbmp&6,4&x2
  182:  282           bce  opdsc,5&x2,$   check for subscripted operand                                         182:   282           bce  opdsc,5&x2,$   check for subscripted operand
  183:  283           mcw  7&x2, xl1                                                                            183:   283           mcw  7&x2, xl1
  184:  284           sar  algrt&6                                                                              184:   284           sar  algrt&6
  185:  285 sbbr2     bwz  xsize,x1-1,k   branch if fixpt computation                                           185:   285 sbbr2     bwz  xsize,x1-1,k   branch if fixpt computation
  186:  286           bwz  xsize,x1-1,s                                                                         186:   286           bwz  xsize,x1-1,s
  187:  287 *                                                                                                   187:   287 *
  188:  288 *                               float arithmetic                                                    188:   288 *                               float arithmetic
  189:  289 *                                                                                                   189:   289 *
  190:  290 fsize     sbr  x3,xxx         store float size                                                      190:   290 fsize     sbr  x3,xxx         store float size
  191:  291           cw   fixsw#1                                                                              191:   291           cw   fixsw#1
  192:  292           mcw  0&x1,expb      store exponent                                                        192:   292           mcw  0&x1,expb      store exponent
  193:  293           sar  xl1                                                                                  193:   293           sar  xl1
  194:  294           mcw  0&x1,spot      initialize work area                                                  194:   294           mcw  0&x1,spot      initialize work area
  195:  295           sbr  xl2                                                                                  195:   295           sbr  xl2
  196:  296           lca  @0@                                                                                  196:   296           lca  @0@
  197:  297 ngbmp     bw   *&8,0                                                                                197:   297 ngbmp     bw   *&8,0
  198:  298           mz   spot, nsign                                                                          198:   298           mz   spot, nsign
  199:  299           s    @0@,spot&2&x3                                                                        199:   299           s    @0@,spot&2&x3
  200:  300           c    1&x2, @0@                                                                            200:   300           c    1&x2, @0@
  201:  301           a    xl3, xl2                                                                             201:   301           a    xl3, xl2
  202:  302           bce  fdiv,code,/    branch for division                                                   202:   302           bce  fdiv,code,/    branch for division
  203:  303           bce  fmpy,code,*    branch for multiplication -                                           203:   303           bce  fmpy,code,*    branch for multiplication -
  204:  304 *                                                                                                   204:   304 *
  205:  305 *                                floating add / subtract                                            205:   305 *                                floating add / subtract
  206:  306 *                                                                                                   206:   306 *
  207:  307           s    signf                                                                                207:   307           s    signf
  208:  308 signf     za   nsign                                                                                208:   308 signf     za   nsign
  209:  309           bce  nuval,acchi&1,0    br, if 1st operand of computation                                 209:   309           bce  nuval,acchi&1,0    br, if 1st operand of computation
  210:  310           be   clrwk                                                                                210:   310           be   clrwk
  211:  311           s    expb,exp                                                                             211:   311           s    expb,exp
  212:  312           za   exp&1,xl1&1                                                                          212:   312           za   exp&1,xl1&1
  213:  313           c    xl3,xl1                                                                              213:   313           c    xl3,xl1
  214:  314           bm   rtn1,exp                                                                             214:   314           bm   rtn1,exp
  215:  315           bh   chgex    br if prev result to be retained in wk acc                                  215:   315           bh   chgex    br if prev result to be retained in wk acc
  216:  316           a    exp,expb                                                                             216:   316           a    exp,expb
  217:  317           za   spot,spot&x1   initialize work area                                                  217:   317           za   spot,spot&x1   initialize work area
  218:  318           za   xl3&1,xl1&1                                                                          218:   318           za   xl3&1,xl1&1
  219:  319 ascom     mz   nsign,0&x2                                                                           219:   319 ascom     mz   nsign,0&x2
  220:  320           a    acchi&x1,0&x2                                                                        220:   320           a    acchi&x1,0&x2
  221:  321 mvzon     mz   0&x2,nsign                                                                           221:   321 mvzon     mz   0&x2,nsign
  222:  322 nuval     za   expb,exp                                                                             222:   322 nuval     za   expb,exp
  223:  323 *                                                                                                   223:   323 *
  224:  324 *                                normalize                                                          224:   324 *                                normalize
  225:  325 *                                                                                                   225:   325 *
  226:  326 nmlz1     mcw  rcdmk,1&x2                                                                           226:   326 nmlz1     mcw  rcdmk,1&x2
  227:  327           mz                                                                                        227:   327           mz
  228:  328           mz                                                                                        228:   328           mz
  229:  329           a                                                                                         229:   329           a
  230:  330           mn                                                                                        230:   330           mn
  231:  331           sbr  xl1                                                                                  231:   331           sbr  xl1
  232:  332           s    acchi&2&x3                                                                           232:   332           s    acchi&2&x3
  233:  333 nloop     bce  strze,2&x1,|                                                                         233:   333 nloop     bce  strze,2&x1,|
  234:  334           sbr  xl1                                                                                  234:   334           sbr  xl1
  235:  335           bce  nloop, 1&x1, 0                                                                       235:   335           bce  nloop, 1&x1, 0
  236:  336           mcm  1&x1, acchi&1                                                                        236:   336           mcm  1&x1, acchi&1
  237:  337           s    xl3, xl2                                                                             237:   337           s    xl3, xl2
  238:  398           cw                                                                                        238:   398           cw
  239:  339           cw                                                                                        239:   339           cw
  240:  340           s                                                                                         240:   340           s
  241:  341           s    xl1,exp                                                                              241:   341           s    xl1,exp
  242:  342 nsign     za   acchi&x3       move proper sign to work accumulator                                  242:   342 nsign     za   acchi&x3       move proper sign to work accumulator
  243:  343           sw                                                                                        243:   343           sw
  244:  344           bce  clrwk,exp-2,0                                                                        244:   344           bce  clrwk,exp-2,0
  245:  345           bm   strze,exp      branch on exponent underflow                                          245:   345           bm   strze,exp      branch on exponent underflow
  246:  346 *                                                                                                   246:   346 *
  247:  347 *                      exponent overflow due to normalization                                       247:   347 *                      exponent overflow due to normalization
  248:  348 *                                                                                                   248:   348 *
  249:  349           b    ermsg                                                                                249:   349           b    ermsg
  250:  350           dcw  @nof@                                                                                250:   350           dcw  @nof@
  251:  351 *                                                                                                   251:   351 *
  252:  352 * store  nines  in  work  accumulator  and  exp  on exponent  ovfl                                  252:   352 * store  nines  in  work  accumulator  and  exp  on exponent  ovfl
  253:  353 *                                                                                                   253:   353 *
  254:  354 str99     za   &99,exp                                                                              254:   354 str99     za   &99,exp
  255:  355           mn   &99,acchi&x3                                                                         255:   355           mn   &99,acchi&x3
  256:  356           mcw                                                                                       256:   356           mcw
  257:  357           mcw  acchi-1&x3                                                                           257:   357           mcw  acchi-1&x3
  258:  358 clrwk     cs   acchi-1                                                                              258:   358 clrwk     cs   acchi-1
  259:  359           b    clrx                                                                                 259:   359           b    clrx
  260:  360 *                                                                                                   260:   360 *
  261:  361 *                       store  zero  in  work  accumulator                                          261:   361 *                       store  zero  in  work  accumulator
  262:  362 *                                                                                                   262:   362 *
  263:  363 strze     s    exp                                                                                  263:   363 strze     s    exp
  264:  364           s    acchi&x3                                                                             264:   364           s    acchi&x3
  265:  365           b    clrwk                                                                                265:   365           b    clrwk
  266:  366 *                                                                                                   266:   366 *
  267:  367 *                       division  by  zero  attempted                                               267:   367 *                       division  by  zero  attempted
  268:  368 *                                                                                                   268:   368 *
  269:  369 dverr     b    ermsg                                                                                269:   369 dverr     b    ermsg
  270:  370           dcw  @dze@                                                                                270:   370           dcw  @dze@
  271:  371           b    str99                                                                                271:   371           b    str99
  272:  372 *                                                                                                   272:   372 *
  273:  373 rtn1      bh   nuval          branch to store new value in wk acc                                   273:   373 rtn1      bh   nuval          branch to store new value in wk acc
  274:  374           s    xl3&1,xl1&1    initialize index registers                                            274:   374           s    xl3&1,xl1&1    initialize index registers
  275:  375           mz   acchi&x3,acchi&x1   initialize work accumulator                                      275:   375           mz   acchi&x3,acchi&x1   initialize work accumulator
  276:  376           b    ascom                                                                                276:   376           b    ascom
  277:  377 *                                                                                                   277:   377 *
  278:  378 chgex     a    expb,exp                                                                             278:   378 chgex     a    expb,exp
  279:  379           b    clrwk                                                                                279:   379           b    clrwk
  280:  380 *                                                                                                   280:   380 *
  281:  381 *                        subscripted  variables                                                     281:   381 *                        subscripted  variables
  282:  332 *                                                                                                   282:   332 *
  283:  383 opdsc     sbr  x2,5&x2                                                                              283:   383 opdsc     sbr  x2,5&x2
  284:  384 stsub     b    xxx                                                                                  284:   384 stsub     b    xxx
  285:  385           mn   0&x2                                                                                 285:   385           mn   0&x2
  286:  386           mn                                                                                        286:   386           mn
  287:  387           mn                                                                                        287:   387           mn
  288:  388           mn                                                                                        288:   388           mn
  289:  389           sar  algrt&6                                                                              289:   389           sar  algrt&6
  290:  390 brwhr     bce  sbbr1,xxx,$                                                                          290:   390 brwhr     bce  sbbr1,xxx,$
  291:  391           b    sbbr2                                                                                291:   391           b    sbbr2
  292:  392 *                                                                                                   292:   392 *
  293:  393 *                                  floating divide                                                  293:   393 *                                  floating divide
  294:  394 *                                                                                                   294:   394 *
  295:  395 fdiv      be   dverr                                                                                295:   395 fdiv      be   dverr
  296:  396           mn   acchi&x3, 1&x2                                                                       296:   396           mn   acchi&x3, 1&x2
  297:  397           mcw                                                                                       297:   397           mcw
  298:  398           mn                                                                                        298:   398           mn
  299:  399           d    0&x1, spot&1                                                                         299:   399           d    0&x1, spot&1
  300:  400           zs   expb                                                                                 300:   400           zs   expb
  301:  401           b    ndmdv                                                                                301:   401           b    ndmdv
  302:  402 *                                                                                                   302:   402 *
  303:  403 *                                  floating multiply                                                303:   403 *                                  floating multiply
  304:  404 *                                                                                                   304:   404 *
  305:  405 fmpy      m    acchi&x3, spot&1&x3                                                                  305:   405 fmpy      m    acchi&x3, spot&1&x3
  306:  406           sbr  x2,3&x2                                                                              306:   406           sbr  x2,3&x2
  307:  407           s    &2,exp                                                                               307:   407           s    &2,exp
  308:  408 ndmdv     a    expb, exp                                                                            308:   408 ndmdv     a    expb, exp
  309:  409           mz   acchi&x3, *&1                                                                        309:   409           mz   acchi&x3, *&1
  310:  410           za   nsign                                                                                310:   410           za   nsign
  311:  411           b    nmlz1                                                                                311:   411           b    nmlz1
  312:  412 *                                                                                                   312:   412 *
  313:  413 *                                  exit routine                                                     313:   413 *                                  exit routine
  314:  414 *                                                                                                   314:   414 *
  315:  415 qfunct    bce  out1,4&x2,|    br if contents of wk acc to be stored                                 315:   415 qfunct    bce  out1,4&x2,|    br if contents of wk acc to be stored
  316:  416           sbr  algrt&6,1&x2                                                                         316:   416           sbr  algrt&6,1&x2
  317:  417           c    acchi&1,@0@                                                                          317:   417           c    acchi&1,@0@
  318:  418           b    xxx            branch to function selection routine                                  318:   418           b    xxx            branch to function selection routine
  319:  419 out1      bce  out2,acchi&1,0                                                                       319:   419 out1      bce  out2,acchi&1,0
  320:  420           bw   out2,fixsw                                                                           320:   420           bw   out2,fixsw
  321:  421           bw   finst,4&x2     branch if final storage of comp                                       321:   421           bw   finst,4&x2     branch if final storage of comp
  322:  422           sbr  x3,2&x3                                                                              322:   422           sbr  x3,2&x3
  323:  423 mvexp     mcm  exp-1,acchi-1&x3                                                                     323:   423 mvexp     mcm  exp-1,acchi-1&x3
  324:  424 out2      lca  acchi&x3,xxx                                                                         324:   424 out2      lca  acchi&x3,xxx
  325:  425           bw   5&x2,4&x2   br to prog mainline if end of arith str                                  325:   425           bw   5&x2,4&x2   br to prog mainline if end of arith str
  326:  426           sar  xl2                                                                                  326:   426           sar  xl2
  327:  427           b    arith                                                                                327:   427           b    arith
  328:  428 *                                                                                                   328:   428 *
  329:  429 *                 rounding  for  final  storage                                                     329:   429 *                 rounding  for  final  storage
  330:  430 *                                                                                                   330:   430 *
  331:  431 finst     a    &5,acchi-1&x3                                                                        331:   431 finst     a    &5,acchi-1&x3
  332:  482           bwz  rdovf,acchi&1,s                                                                      332:   482           bwz  rdovf,acchi&1,s
  333:  433 zonmv     mz   acchi&x3,acchi-2&x3                                                                  333:   433 zonmv     mz   acchi&x3,acchi-2&x3
  334:  434           b    mvexp                                                                                334:   434           b    mvexp
  335:  435 rdovf     a    &1,exp                                                                               335:   435 rdovf     a    &1,exp
  336:  436           bce  nornd,exp-2,1                                                                        336:   436           bce  nornd,exp-2,1
  337:  437           s    acchi&x3                                                                             337:   437           s    acchi&x3
  338:  438           lca  @1@,acchi&1                                                                          338:   438           lca  @1@,acchi&1
  339:  439           b    zonmv                                                                                339:   439           b    zonmv
  340:  440 *                                                                                                   340:   440 *
  341:  441 *             no  rounding  if  exponent  overflow  would  occur                                    341:   441 *             no  rounding  if  exponent  overflow  would  occur
  342:  442 *                                                                                                   342:   442 *
  343:  443 nornd     mn   &99,acchi&x3                                                                         343:   443 nornd     mn   &99,acchi&x3
  344:  444           mcw                                                                                       344:   444           mcw
  345:  445           mcw  acchi-1&x3                                                                           345:   445           mcw  acchi-1&x3
  346:  446           s    &1,exp                                                                               346:   446           s    &1,exp
  347:  447           b    zonmv                                                                                347:   447           b    zonmv
  348:  448 *                                                                                                   348:   448 *
  349:  449 *                      print  error  message                                                        349:   449 *                      print  error  message
  350:  450 *                                                                                                   350:   450 *
  351:  451 ermsg     sbr  strx2&6                                                                              351:   451 ermsg     sbr  strx2&6
  352:  452           cs   top&1&x3                                                                             352:   452           cs   top&1&x3
  353:  453           sbr  rinx2&6,0&x3                                                                         353:   453           sbr  rinx2&6,0&x3
  354:  454 strx2     sbr  x3,xxx                                                                               354:   454 strx2     sbr  x3,xxx
  355:  455           mcw  2&x3,top&11                                                                          355:   455           mcw  2&x3,top&11
  356:  456 stmnm     sbr  top&16,xxx                                                                           356:   456 stmnm     sbr  top&16,xxx
  357:  457           w                                                                                         357:   457           w
  358:  458           sw   top                                                                                  358:   458           sw   top
  359:  459           sbr  ermxt&3,3&x3                                                                         359:   459           sbr  ermxt&3,3&x3
  360:  460 rinx2     sbr  x3,xxx                                                                               360:   460 rinx2     sbr  x3,xxx
  361:  461 ermxt     b    xxx                                                                                  361:   461 ermxt     b    xxx
  362:  462 *                                                                                                   362:   462 *
  363:  463 *                                fixed point entry                                                  363:   463 *                                fixed point entry
  364:  464 *                                                                                                   364:   464 *
  365:  465 xsize     sbr  x3,xxx         store fix-size                                                        365:   465 xsize     sbr  x3,xxx         store fix-size
  366:  466           sw   fixsw                                                                                366:   466           sw   fixsw
  367:  467 *                                                                                                   367:   467 *
  368:  468 fixpt     mcs  0&x1, spot                                                                           368:   468 fixpt     mcs  0&x1, spot
  369:  469           bce  xdiv, code, /                                                                        369:   469           bce  xdiv, code, /
  370:  470           bce  xmpy, code, *                                                                        370:   470           bce  xmpy, code, *
  371:  471 *                                                                                                   371:   471 *
  372:  472 *                                fixed add / subtract                                               372:   472 *                                fixed add / subtract
  373:  473 *                                                                                                   373:   473 *
  374:  474           bwz  subtr, code, k     q. subtract                                                       374:   474           bwz  subtr, code, k     q. subtract
  375:  475           a    0&x1, acchi&x3                                                                       375:   475           a    0&x1, acchi&x3
  376:  476 addrt     za   acchi&x3                                                                             376:   476 addrt     za   acchi&x3
  377:  477           b    clrwk                                                                                377:   477           b    clrwk
  378:  478 *                                                                                                   378:   478 *
  379:  479 subtr     s    0&x1, acchi&x3                                                                       379:   479 subtr     s    0&x1, acchi&x3
  380:  480           b    addrt                                                                                380:   480           b    addrt
  381:  481 *                                                                                                   381:   481 *
  382:  482 *                                fixed multiply                                                     382:   482 *                                fixed multiply
  383:  483 *                                                                                                   383:   483 *
  384:  484 xmpy      lca  0&x1, spot                                                                           384:   484 xmpy      lca  0&x1, spot
  385:  485           m    acchi&x3, spot&1&x3                                                                  385:   485           m    acchi&x3, spot&1&x3
  386:  486           mcw  spot&1&x3, acchi&x3                                                                  386:   486           mcw  spot&1&x3, acchi&x3
  387:  487           b    clrwk                                                                                387:   487           b    clrwk
  388:  488 *                                                                                                   388:   488 *
  389:  489 *                                fixed divide                                                       389:   489 *                                fixed divide
  390:  490 *                                                                                                   390:   490 *
  391:  491 xdiv      bce  dverr, spot,                                                                         391:   491 xdiv      bce  dverr, spot,
  392:  492           mcw  0&x1,spot&x3                                                                         392:   492           mcw  0&x1,spot&x3
  393:  493           mn                                                                                        393:   493           mn
  394:  494           sbr  mvqut&3                                                                              394:   494           sbr  mvqut&3
  395:  495           lca  acchi&x3                                                                             395:   495           lca  acchi&x3
  396:  496           za   acchi&x3, spot&x3                                                                    396:   496           za   acchi&x3, spot&x3
  397:  497           d    0&x1, spot&1                                                                         397:   497           d    0&x1, spot&1
  398:  498 mvqut     mcw  spot-1,acchi&x3                                                                      398:   498 mvqut     mcw  spot-1,acchi&x3
  399:  499           b    clrwk                                                                                399:   499           b    clrwk
  400:  500 *                                                                                                   400:   500 *
  401:  501           dcw  000                                                                                  401:   501           dcw  000
  402:  502 rcdmk     dcw  @|@                                                                                  402:   502 rcdmk     dcw  @|@
  403:  503           dcw  0                                                                                    403:   503           dcw  0
  404:  504 exp       dcw  000                                                                                  404:   504 exp       dcw  000
  405:  505           dc   @|@                                                                                  405:   505           dc   @|@
  406:  506 expb      dcw  00                                                                                   406:   506 expb      dcw  00
  407:  507           dc   0                                                                                    407:   507           dc   0
  408:  508 code      equ  signf                                                                                408:   508 code      equ  signf
  409:  509 zrosw     equ  *&1                                                                                  409:   509 zrosw     equ  *&1
  410:  510 basez     equ  *&1                                                                                  410:   510 basez     equ  *&1
  411:  511 xpnum     dcw  @8@                                                                                  411:   511 xpnum     dcw  @8@
  412:  512           ltorg                                                                                     412:   512           ltorg
  413:  513           ds   1                                                                                    413:   513           ds   1
  414:  514           dcw  @0@                                                                                  414:   514           dcw  @0@
  415:  515           dc   @}@               system group mark                                                  415:   515           dc   @}@               system group mark
  416:  516           xfr  0                                                                                    416:   516           xfr  0
  417:  517           job  1401  Fortran  function  common  deck                  50533                         417:   517           job  1401  Fortran  function  common  deck                  50533
  418:  518 *             Insert before sin-cos deck                                                            418:   518 *             Insert before sin-cos deck
  419:  519           org  2000                                                                                 419:   519           org  2000
  420:  520 *                                                                                                   420:   520 *
  421:  521 110       dcw  @_____@             all 11-7-8                                                       421:   521 110       dcw  @_____@             all 11-7-8
  422:  522 *                                                                                                   422:   522 *
  423:  523 *                        variable  length  divide                                                   423:   523 *                        variable  length  divide
  424:  524 *                                                                                                   424:   524 *
  425:  525 divid     sbr  dvxt&3                                                                               425:   525 divid     sbr  dvxt&3
  426:  526           mcw  acchi&x3,spot                                                                        426:   526           mcw  acchi&x3,spot
  427:  527           mn                                                                                        427:   527           mn
  428:  528           lca  &0                                                                                   428:   528           lca  &0
  429:  529           s    &0,spot-1&x2                                                                         429:   529           s    &0,spot-1&x2
  430:  530           d    0&x1,spot                                                                            430:   530           d    0&x1,spot
  431:  531           mn   spot-1&x2,acchi&x3                                                                   431:   531           mn   spot-1&x2,acchi&x3
  432:  532           mcw                                                                                       432:   532           mcw
  433:  533           mn                                                                                        433:   533           mn
  434:  534           sar  x1                                                                                   434:   534           sar  x1
  435:  535 dvxt      b    xxx                                                                                  435:   535 dvxt      b    xxx
  436:  536 *                                                                                                   436:   536 *
  437:  537 *                        power  series  calculation                                                 437:   537 *                        power  series  calculation
  438:  538 *                                                                                                   438:   538 *
  439:  539 calc      sbr  calxt&3                                                                              439:   539 calc      sbr  calxt&3
  440:  540           cw   logm1,logm2                                                                          440:   540           cw   logm1,logm2
  441:  541 calc1     s    top&1&X3            clear series accumulator                                         441:   541 calc1     s    top&1&X3            clear series accumulator
  442:  542           cw   acchi&1                                                                              442:   542           cw   acchi&1
  443:  543           cw                                                                                        443:   543           cw
  444:  544           sw                                                                                        444:   544           sw
  445:  545           s    x2&2                                                                                 445:   545           s    x2&2
  446:  546           sbr  x2,spot                                                                              446:   546           sbr  x2,spot
  447:  547 calcl     mcs  spot                                                                                 447:   547 calcl     mcs  spot
  448:  548           sw   0&x1                                                                                 448:   548           sw   0&x1
  449:  549           bce  finis,0&x2,                                                                          449:   549           bce  finis,0&x2,
  450:  550           mz   spot&1,1&x2                                                                          450:   550           mz   spot&1,1&x2
  451:  551           a    1&x2,top&1&x3       add term to series accumulation                                  451:   551           a    1&x2,top&1&x3       add term to series accumulation
  452:  552           a    dec,x2&1                                                                             452:   552           a    dec,x2&1
  453:  553           c    x2,x1                                                                                453:   553           c    x2,x1
  454:  554           bh   finis                                                                                454:   554           bh   finis
  455:  555           a    upby,ncon                                                                            455:   555           a    upby,ncon
  456:  556           a    ncon,nctr                                                                            456:   556           a    ncon,nctr
  457:  557           nop  xxx,spot&1                                                                           457:   557           nop  xxx,spot&1
  458:  558 logm1     za                       normally part of nop                                             458:   558 logm1     za                       normally part of nop
  459:  559           m    acchi&x3,spot&4&x3                                                                   459:   559           m    acchi&x3,spot&4&x3
  460:  560           mz   spot&4&x3,spot&5                                                                     460:   560           mz   spot&4&x3,spot&5
  461:  561           nop  spot&5,xxx                                                                           461:   561           nop  spot&5,xxx
  462:  562 logm2     za                       normally part of nop                                             462:   562 logm2     za                       normally part of nop
  463:  563           d    nctr,4&x1                                                                            463:   563           d    nctr,4&x1
  464:  564           b    calcl                                                                                464:   564           b    calcl
  465:  565 finis     sw   acchi&1                                                                              465:   565 finis     sw   acchi&1
  466:  566 calxt     b    xxx                                                                                  466:   566 calxt     b    xxx
  467:  567 *                                                                                                   467:   567 *
  468:  568 str1      s    acchi&x3                                                                             468:   568 str1      s    acchi&x3
  469:  569           mn   &1,acchi&1                                                                           469:   569           mn   &1,acchi&1
  470:  570           mz   twtch,acchi&x3                                                                       470:   570           mz   twtch,acchi&x3
  471:  571           mz   calc,twtch                                                                           471:   571           mz   calc,twtch
  472:  572           za   &1,exp                                                                               472:   572           za   &1,exp
  473:  573           b    clrx                                                                                 473:   573           b    clrx
  474:  574 *                                                                                                   474:   574 *
  475:  575 *                        common constants                                                           475:   575 *                        common constants
  476:  576 *                                                                                                   476:   576 *
  477:  577 ln10      equ  *                                                                                    477:   577 ln10      equ  *
  478:  578           dcw  23025850929940456840179                                                              478:   578           dcw  23025850929940456840179
  479:  579 upby      dcw  #1                                                                                   479:   579 upby      dcw  #1
  480:  580 ncon      dcw  #3                                                                                   480:   580 ncon      dcw  #3
  481:  581 nctr      dcw  #3                                                                                   481:   581 nctr      dcw  #3
  482:  582 dec       dcw  #3                                                                                   482:   582 dec       dcw  #3
  483:  583 twtch     dcw  @A@                                                                                  483:   583 twtch     dcw  @A@
  484:  584 *                            loader                                                                 484:   584 *                            loader
  485:  585           ex   divid                                                                                485:   585           ex   divid
  486:  586           end                                                                                       486:   586           end
