1 | |
1 fortran package | |
1 source code | |
1 | |
blr 1945 1950 entry power subr total reservation | |
regp1951 1960 read band 1947 - 1999, 0000 | |
blr 1961 1968 entry built-in subr (54 words) | |
blr 1969 1976 entry func subr | |
regj1977 1986 punch band | |
blr 1987 1987 | |
regw1988 1998 storage band | |
1 | |
1 save index registers | |
1 | |
ezzzastdezzzx | |
ldd 8005 | |
stdezzia | |
ldd 8006 | |
stdezzib | |
ldd 8007 | |
stdezzic ezzzx | |
1 | |
1 restore saved index registers and return to erthx | |
1 | |
ezzzblddezzia | |
raa 8001 | |
lddezzib | |
rab 8001 | |
lddezzic | |
rac 8001 erthx | |
ezzzx 00 0000 0000 | |
ezzia 00 0000 0000 | |
ezzib 00 0000 0000 | |
ezzic 00 0000 0000 | |
1 | |
1 overflow checking | |
1 | |
e00aabov 8001 | |
hlt 0100 8001 alarm arithmetic overflow | |
1 | |
1 (l) fixed point <- (u) float | |
1 | |
e00thstderthx float upper | |
srt 0002 to fix lower | |
stuartha save mantissa | |
ram 8002 test exp | |
slon51 store zero | |
bmiad1 if less than | |
slon10 51 alarm | |
bmi ad3 if grtr than | |
srt 0004 60 | |
aloonet | |
lddad2a modify | |
sdaad2 shift | |
ralartha | |
slt 0002 ad2 | |
ad1 ral 8003 erthx store zero | |
ad2 srt 0000 erthx shift const | |
ad2a srt 0000 erthx | |
ad3 ldderthx | |
hlt 0501 8001 alarm float >= 10e10 thus cannot be converted to fix | |
n10 10 0000 0000 | |
n51 51 0000 0000 | |
onet 00 0001 0000 | |
erthx 00 0000 0000 | |
artha 00 0000 0000 | |
1 | |
1 (u) and (acc) float <- (l) fixed point | |
1 | |
e00afstdartha float to up | |
ldd e00ae and acc | |
stuacc artha | |
1 | |
1 (u) float <- (l) fixed point | |
1 | |
e00aestderthx float to up | |
rau 8002 ae0 only | |
ae0 sct 0000 normalize | |
stlarthb | |
bovad1 zero check | |
ral 8003 | |
srd 0002 round for | |
slt 0002 placing exp | |
nzu ae6 check round | |
ldd 8003 overflow | |
srt 0001 | |
alo 8001 ae6 | |
ae6 bmiae2 insert | |
aloaj3 ae5 exponent | |
ae2 sloaj3 ae5 | |
ae5 sloarthb | |
rau 8002 erthx | |
aj3 00 0000 0060 | |
arthb 00 0000 0000 | |
1 | |
1 punch card | |
1 | |
e00arstderthx punch out | |
lddj0008 | |
siaj0008 store stmnt | |
lddonet | |
sdanvars and nvars to pch | |
slo 8001 if stmt zero | |
nzear3 punch if | |
ral 8000 8000 is neg | |
bmiar3 erthx else exit | |
ar3 lddar3a ar5 init pch card | |
ar3a ralnvars dec nvars | |
sloonet | |
bmiar8 test word | |
stlnvars count | |
alo 8002 get nword addr | |
ralw0002 in lower | |
lddnword | |
sdanword store num of words to punch | |
slt 0004 | |
lddadwrd | |
sdaadwrd ar4 store addr of word to punch | |
ar4 ralnpch is card full | |
sloarn7 | |
bmiar4a | |
pchj0001 yes punch and | |
lddar4a ar5 call init card | |
ar4a ralnpch incr no of | |
aloonet punched words npch | |
stlnpch | |
raladwrd indr adwrd | |
aloonet | |
stladwrd | |
sloonet | |
alo 8002 get adwrd | |
raly0000 contents | |
stldatwd store in datwd | |
raudatld | |
alonpch store at | |
alo 8003 j0000 plus | |
stdj0000 npch | |
ralnword decr var nwords | |
sloonet to be punched | |
nze ar3a | |
bmiar3a | |
stlnword ar4 | |
ar5 stdar5x sub init pch card | |
ralj0008 incr card | |
aloonet number | |
stlj0008 | |
stunpch card with zero | |
stdj0001 punched words | |
stdj0002 set punch | |
stdj0003 band to | |
stdj0004 zeroes | |
stdj0005 | |
stdj0006 | |
stdj0007 ar5x | |
ar8 pchj0001 erthx punch | |
onet 00 0001 0000 | |
arn7 00 0007 0000 | |
j0008 00 0000 0000 card counter | |
j0010 80 0000 0080 control cnst | |
ar5x 00 0000 0000 exit for sub init pch card | |
nvars 00 0000 0000 num of vars to pch | |
nword 00 0000 0000 num of words per var to pch | |
adwrd 00 0000 0000 addr of word to pch | |
npch 00 0000 0000 num of words punched in chard | |
datwd 00 0000 0000 data word to be punched | |
1 | |
1 read card | |
1 | |
e00aqstderthx read in | |
lddonet | |
sdanvars nvars to read | |
stunpch aq3a init to zero | |
aq3a ralnvars dec nvars | |
sloonet | |
bmierthx exit if zero | |
stlnvars | |
alo 8002 get nword addr | |
ralw0002 in lower | |
lddnword | |
sdanword store num of words to rd | |
slt 0004 | |
lddadwrd | |
sdaadwrd aq4 store addr of word to rd | |
aq4 ralnpch check if should rd new card | |
nzeaq4a | |
rcdp0001 yes read card | |
lddarn7 | |
stdnpch aq4a | |
aq4a ralnpch decr no of available | |
sloonet punched words npch in read card | |
stlnpch | |
ralarn7 | |
slonpch get word at | |
alo 8002 p0000 plus | |
lddp0000 npch in dist | |
stddatwd store it in datwd | |
raudatld | |
aloadwrd incr adwrd | |
aloonet | |
stladwrd | |
sloonet | |
alo 8003 set adwrd | |
stdy0000 contents from upper | |
ralnword decr var nwords | |
sloonet to be read | |
nze aq3a | |
bmiaq3a | |
stlnword aq4 | |
onet 00 0001 0000 | |
datldldddatwd 8002 load card word into dist and jump to lower | |
1 | |
1 alarm if try to use a not defined subroutine | |
1 | |
e00akhlt 9010 8001 alarm fix ** fix undef | |
e00alhlt 9011 8001 alarm float ** fix undef | |
e00lqhlt 9302 8001 alarm float ** float undef | |
e00abhlt 9001 8001 alarm logf undef | |
e00achlt 9002 8001 alarm expf undef | |
e00lohlt 9300 8001 alarm lnf undef | |
e00lphlt 9301 8001 alarm expnf undef | |
e00avhlt 9021 8001 alarm cosf undef | |
e00awhlt 9022 8001 alarm sinf undef | |
e00axhlt 9023 8001 alarm sqrtf undef | |
e00ayhlt 9024 8001 alarm absf undef | |
e00azhlt 9025 8001 alarm intf undef | |
e00bahlt 9026 8001 alarm maxf undef | |
ezztyhlt 9099 8001 alarm function arg is fix but should be float | |
1 | |
1 start of subroutines | |
1 | |
1 | |
1 (l) and (acc) fixed <- (l) fixed ** (acc) fixed | |
1 | |
e00akstderthx power fix fix. m ** p | |
stlartha ak1 m is argmnt | |
ak1 ramacc p equals | |
stlarthb abval power | |
ralone h is result | |
stlarthc ak3 init to one | |
ak3 rauarthb p is gtst | |
mpyn50 intgr in | |
stuarthb p over two | |
ral 8002 is remainder | |
nze ak5 zero | |
rauarthc if not h is | |
mpyartha h times m | |
nzuak12 | |
stlarthc ak5 | |
ak5 rauarthb | |
nzu ak6 is p zero | |
rauartha if not | |
mpy 8001 m equals | |
nzuak12 | |
stlartha ak3 m squared | |
ak6 rauacc is power neg | |
bmi ak7 if so is h | |
ramarthc zero | |
nze ak8 if not is h | |
sloone one | |
nzeak10 ak7 | |
ak7 ralarthc ak11 exhibit h | |
ak10 ral 8003 ak11 | |
ak11 stlacc erthx | |
ak12 ldderthx | |
hlt 0003 8001 alarm overflow. fix**fix results in value >= 10e10 | |
ak8 ldderthx | |
hlt 0010 8001 alarm zero raised to neg | |
n50 50 0000 0000 | |
one 00 0000 0001 | |
arthc 00 0000 0000 | |
1 | |
1 (u) and (acc) float <- (u) float ** (acc) fixed | |
1 | |
e00alstderthx power float fix. m ** p | |
stuartha al1 m is argmnt | |
al1 ramacc p equals | |
stlarthb abval power | |
ralfp1 h is result | |
stlarthc al3 init to float one | |
al3 rauarthb p is gtst | |
mpyn50 intgr in | |
stuarthb p over two | |
ral 8002 is remainder | |
nze al5 zero | |
rauarthc if not h is | |
fmpartha h times m | |
boval12 | |
stuarthc al5 | |
al5 rauarthb | |
nzu al6 is p zero | |
rauartha if not | |
fmp 8001 m equals | |
boval12 | |
stuartha al3 m squared | |
al6 rauacc is power neg | |
bmi al7 if so is h | |
ramarthc zero | |
nze al8 if not calc | |
raufp1 h reciprocal | |
fdvarthc al11 | |
al7 rauarthc al11 exhibit h | |
al11 stuacc erthx | |
al12 ldderthx | |
hlt 0049 8001 alarm overflow. float**fix results in value >= 10e49 | |
al8 ldderthx | |
hlt 0011 8001 alarm zero raised to neg | |
n50 50 0000 0000 | |
fp1 10 0000 0051 | |
1 | |
1 (u) float <- 10 ** (u) float | |
1 | |
e00acstderthx exponential | |
nze ac5 is argument | |
nzu ezzty alarm function arg is fix but should be float | |
srt 0002 zero | |
stuarthc if not let | |
rsm 8002 n be mantsa | |
alon52 x be power | |
bmiac4 is x grtr | |
slt 0001 than ten | |
nzuac5 or less than | |
srt 0005 minus eight | |
aloac6 if x within | |
stlarthb bounds gen | |
rauarthc int and | |
srt 0006 arthb fract parts | |
n52 52 0000 0000 of argument | |
ac6 srt 0000 is arg neg | |
bmiac8 if so int is | |
stuarthb ac1 int minus 1 | |
ac8 supone and fract is | |
stuarthb fract plus 1 | |
ral 8002 | |
alon999 ac1 | |
ac1 stlarthc arthc is frac part | |
rau 8002 arthb is int part | |
mpyac18 generate | |
rau 8003 | |
aupac17 polynomial | |
mpyarthc | |
rau 8003 approximation | |
aupac16 | |
mpyarthc | |
rau 8003 for | |
aupac15 | |
mpyarthc exponential | |
rau 8003 | |
aupac14 | |
mpyarthc | |
rau 8003 | |
aupac13 | |
mpyarthc | |
rau 8003 | |
aupac12 | |
mpyarthc square | |
rau 8003 result | |
aupn10 scale and | |
mpy 8003 float then | |
srt 0001 exit | |
stuartha | |
rauac19 | |
auparthb | |
bmiac20 | |
srt 0002 | |
nzuac21 | |
aupartha | |
srt 0008 ac20 | |
ac4 ralarthc | |
bmi ac21 | |
rau 8003 erthx result zero | |
ac5 raufp1 erthx result 1 because argmnt is zero | |
ac20 rau 8002 erthx result in upper | |
ac21 ldderthx | |
hlt 0049 8001 alarm overflow. 10**float results in value >= 10e49 | |
ac12 11 5129 2776 | |
ac13 06 6273 0884 | |
ac14 02 5439 3575 | |
ac15 00 7295 1737 | |
ac16 00 1742 1120 | |
ac17 00 0255 4918 | |
ac18 00 0093 2643 | |
ac19 00 0000 0051 | |
n999 99 9999 9999 | |
n10 10 0000 0000 | |
one 00 0000 0001 | |
fp1 10 0000 0051 | |
arthc 00 0000 0000 | |
1 | |
1 (u) float <- log 10 (u) float | |
1 | |
e00abnze ab10 if log arg zero | |
nzu ezzty alarm function arg is fix but should be float | |
bmiab10 or neg alarm | |
stderthx | |
srt 0002 | |
stlarthb store power | |
rau 8003 form z | |
aupab1 equal arg | |
stuarthc minus root | |
supab2 ten over arg | |
dvrarthc plus root | |
stlartha ten | |
rau 8002 | |
mpy 8001 z square | |
stuarthc | |
rau 8003 generate | |
mpyab7 | |
rau 8003 polynomial | |
aupab6 | |
mpyarthc approximatn | |
rau 8003 | |
aupab5 | |
mpyarthc | |
rau 8003 | |
aupab4 | |
mpyarthc | |
rau 8003 | |
aupab3 | |
mpyartha | |
ral 8003 | |
alon50 | |
srt 0002 | |
aloarthb add power | |
slon50 | |
srd 0002 round | |
rau 8002 | |
sct 0000 normalize | |
bovab12 | |
bmi ab13 | |
supab9 ab11 adjust | |
ab11 sup 8002 ab12 power | |
ab12 rau 8003 | |
fsbfp1 erthx | |
ab13 aupab9 ab11 | |
ab10 hlt 0001 8001 alarm log (zero or negavive) | |
ab1 00 3162 2780 | |
ab2 00 6324 5560 | |
ab3 86 8591 7180 | |
ab4 28 9335 5240 | |
ab5 17 7522 0710 | |
ab6 09 4376 4760 | |
ab7 19 1337 7140 | |
n50 50 0000 0000 | |
fp1 10 0000 0051 | |
ab9 00 0000 0054 | |
arthc 00 0000 0000 | |
1 | |
1 (u) and (acc) float <- (u) float ** (acc) float | |
1 u**acc = 10**(log10(u)*acc) | |
1 = exp(log10(u)*acc) | |
1 | |
e00lqstdlq1 | |
ldd e00ab log 10 (u) | |
fmpacc mult by acc | |
lddlq1 e00ac 10 ** u | |
lq1 00 0000 0000 | |
1 | |
1 (u) float <- log e (u) float | |
1 ln(u) = log(u) / log(e) | |
1 log10(e)=0.4342944819 | |
1 | |
e00lostdlq1 | |
ldd e00ab log 10 (u) | |
fdvloge lq1 div by log(e) const | |
lq1 00 0000 0000 | |
loge 43 4294 4850 | |
1 | |
1 (u) float <- e ** (u) float | |
1 expn(u) = e ** u = exp(log10(e)*u) | |
1 e=2.71828182846 | |
1 | |
e00lpstdlq1 | |
fmploge mult by log(e) const | |
lddlq1 e00ac 10 ** u | |
lq1 00 0000 0000 | |
loge 43 4294 4850 | |
1 | |
1 (u) float <- absolute value (u) float | |
1 | |
e00aynze 8001 exit if zero | |
nzu ezzty alarm function arg is fix but should be float | |
stderthx | |
ram 8003 remove sgn | |
rau 8002 erthx result in upper and exit | |
1 | |
1 (u) float <- integer part (u) float | |
1 | |
e00aznze 8001 exit if zero | |
nzu ezzty alarm function arg is fix but should be float | |
stderthx | |
stuarthc save arg | |
srt 0002 exp in lower | |
stuartha mant in h | |
rsm 8002 make exp neg | |
alon57 | |
bmiaz4 big num so no fract part to remove | |
alon01 | |
slt 0001 | |
nzuaz5 small num so no int part | |
srt 0005 set as right | |
aloaz6 shifts to do | |
stlarthb | |
rauartha arthb | |
n57 57 0000 0000 | |
n01 01 0000 0000 | |
az6 srt 0000 | |
rau 8003 ae0 go to fix to float conversion routine | |
az5 rau 8002 | |
rau 8002 erthx return zero | |
az4 rauarthc erthx return the arg unchanged | |
1 | |
1 (u) float <- max (float, float, ...) | |
1 should have two or more float parameters | |
1 | |
e00bastderthx | |
stuartha arg is max | |
ralerthx ba0 | |
ba0 sloba10 | |
bmiba9 no more args | |
ralerthx set arg addr | |
lddba1 to be read | |
sdaba1 ba1 | |
ba1 rau 0000 read arg | |
stuarthb | |
fsbartha is grtr than | |
bmiba2 current result | |
rauarthb yes store as | |
stuartha ba2 new result | |
ba2 ralerthx select next | |
sloonet arg | |
stlerthx ba0 | |
ba9 rauartha erthx result in upper | |
ba10 00p0000 0000 fist arg addr | |
1 | |
1 (u) float <- square root (u) float | |
1 | |
e00axnze 8001 exit if zero | |
nzu ezzty alarm function arg is fix but should be float | |
bmiax1 alarm sqrt(neg) | |
stderthx | |
srt 0002 | |
nzu ax2 test for zro | |
slon01 convert fortransit exp (1.0=1e51) to it exp (1.0=1e50) | |
stlarthb break up exp | |
ral 8003 and mantissa | |
slt 0002 calculate | |
stlartha initial x | |
aupone ax3 | |
ax4 rauartha calculate | |
dvrarthc next x | |
slo 8001 value | |
nze ax5 | |
bmi ax5 test for end | |
alo 8001 | |
alo 8001 ax3 | |
ax3 dvrtwo recycle | |
stlarthc ax4 | |
ax5 ralarthb modify | |
alon49 exponent | |
srt 0008 | |
divtwo | |
alo 8003 | |
stlarthb test even or | |
nzu ax6 odd exp | |
rauarthc exp odd | |
srt 0001 | |
mpyax11 mpy by sqrt | |
srd 0010 ax7 of 10 | |
ax7 slt 0002 | |
aloarthb | |
aloone exp 50 to 51 | |
rau 8002 erthx go to exit | |
ax6 ralarthc exp even | |
srd 0002 ax7 | |
ax2 rau 8003 erthx result zero | |
ax1 hlt 0012 8001 alarm sqrt with negative argument | |
one 00 0000 0001 constants | |
two 00 0000 0002 | |
n49 49 0000 0000 | |
ax11 03 1622 7766 | |
1 | |
1 (u) float <- cosinus (u) float (arg in radians: cos(pi/2) = 0) | |
1 | |
e00avstderthx av0 | |
av0 nze av4 cos(0) is one | |
nzu ezzty alarm function arg is fix but should be float | |
srt 0002 argument | |
stuartha alarm if pwr | |
rsm 8002 overscale | |
alon01 convert fortransit exp (1.0=1e51) to it exp (1.0=1e50) | |
alon57 cosx equals | |
bmiav2 one if pwr | |
sloav3 underscale | |
bmi av4 | |
srt 0004 | |
aloav5 | |
stlav6 | |
rauartha form | |
mpyav7 av6 fractional | |
av6 hltav6 av23 and intgrl | |
av23 stlarthc parts | |
rau 8003 | |
mpyn50 form s as | |
stlarthb one minus | |
rsmarthc twice abval | |
sml 8001 of fractnl | |
alon999 part | |
rau 8002 | |
stuartha | |
mpy 8001 form sine | |
stuarthc | |
rauav16 polynomial | |
mpyarthc approximator | |
rau 8003 | |
aupav15 | |
mpyarthc | |
rau 8003 | |
aupav14 | |
mpyarthc | |
rau 8003 | |
aupav13 | |
mpyarthc | |
srt 0001 | |
rau 8003 | |
auppih equals one | |
mpyartha | |
sct 0000 | |
bovav19 | |
stlartha | |
ral 8003 round | |
srt 0002 and | |
stlarthc adjust | |
rsuartha power | |
srt 0002 | |
bmi av25 | |
sup 8003 | |
alon50 av24 | |
av24 auparthc | |
slt 0002 av22 | |
av22 stuartha determine | |
rauarthb sign of | |
nzu av20 result | |
rslartha av26 | |
av20 ralartha av26 | |
av25 sup 8003 | |
slon50 av24 | |
av2 rauarthb overscale | |
ldderthx display | |
hlt 0013 8001 alarm radian arg too big | |
av26 rau 8002 | |
bmiav27 | |
aupone erthx | |
av27 supone erthx | |
av4 ralav21 av26 cosx is one | |
av19 ral 8002 cosx is zero | |
slo 8001 av26 | |
av17 rauav21 av22 cosx is plus | |
av3 11 0000 0000 or minus 1 | |
av5 srd 0011 av23 | |
av7 31 8309 8862 | |
pih 15 7079 6327 pi / 2 integer | |
-av13 64 5963 7111 | |
av14 07 9689 6793 | |
-av15 00 4673 7656 | |
av16 00 0151 4842 | |
av21 10 0000 0050 | |
n999 99 9999 9999 | |
n50 50 0000 0000 | |
one 00 0000 0001 | |
n01 01 0000 0000 | |
n57 57 0000 0000 | |
1 | |
1 (u) float <- sinus (u) float (arg in radians: sin(pi/2) = 1) | |
1 | |
e00awnze 8001 sin(0) is zero | |
nzu ezzty alarm function arg is fix but should be float | |
stderthx | |
stuartha | |
raufpih | |
fsbartha av0 sin a = cos(pi/2 - a) | |
fpih 15 7079 6351 pi / 2 float | |
1 | |
1 end of fortran package | |
1 |