### File: convert.t2

1 0  ; convert.t2
2 0  ;--------------------------------------------------------------------
3 0  ; flpt->integer conversions, round is called by int := flpt
4 0  ; while entier is standard procedure
5 0  ; difference is round rounds to nearest integer, entier rounds towards down
6 0  =6899
7 6899  Round::;
8 6899  Round:;
10 6899+ Entier:;
11 6899+0400015 sto Link1   ;save value
12 6900 0075133 and W6747   ;=511 mask off exponent @6900
13 6900+0560015 o27 Link1   ;remove from value
14 6901 0135134 sub W6748   ;=257 @6901
15 6901+1135370 jn .1   ;got to be less than 1.0
16 6902 0175135 bus W6749   ;=36 @6902
17 6902+1020013 jn IntOflo   ;will overflow integer range
18 6903 1000067200001 exa Link1/sra 1;ok, shift right by exp @6903
19 6904 1015212 jmp CkoRet   ;check oflo and return @6904
20 6904+ ;
21 6904+ .1:;
22 6904+0600015 lod Link1   ;small value, just get sign
23 6905 1200046 sra 38   ;shift right to get 0 or -1 @6905
24 6905+1015212 jmp CkoRet   ;and return it
25 6906  ;--------------------------------------------------------------------
26 6906  ; divide two integers
27 6906  ; problem is that Algol divide doesn't match hardware if either
28 6906  ; argument is negative. make both arguments positive, noting
29 6906  ; original sign, then adjust result afterwards
30 6906  ;
31 6906  Div::;
32 6906  Div:;
33 6906 0600016 lod arg1   ;divisor @6906
34 6906+1040013 jz IntOflo   ;trap divide by zero
35 6907 1135374 jn .1   ; @6907
36 6907+0600015 lod Link1   ;get dividend
37 6908 1115375 jmp .2   ; @6908
38 6908+ ;
39 6908+ .1:;
40 6908+0420016 stn arg1   ;complement divisor
41 6909 0620015 lcs Link1   ;complement dividend also @6909
42 6909+ .2:;
43 6909+0020000 neg 0   ;complement dividend
44 6910 1135375 jn .2   ;make it positive @6910
45 6910+1200046 sra 38   ;shift into AR
46 6911 1340016 div arg1   ;divide @6911
47 6911+0200015 exa Link1   ;swap with dividend
48 6912 1135401 jn .3   ;negative? @6912
50 6913 1015212 jmp CkoRet   ;and return, checking oflo @6913
51 6913+ ;
52 6913+ .3:;
54 6914 1015212 jmp CkoRet   ;and return that @6914
55 6914+ ;
56 6914+0000000 o00 0   ;
57 6915  ;--------------------------------------------------------------------
58 6915  ; IPower, raise number to integer power
59 6915  ;
60 6915  IPower::;
61 6915  IPower:;
62 6915 0600015 lod Link1   ;get number @6915
63 6915+1155423 jz .7   ;answer will be zero
64 6916 0555121 cls W6737   ;clear flag @6916
65 6916+1220000 srl 0   ;clear AR
66 6917 0615136 lod FP1.0   ;initial factor @6917
67 6917+0415120 sto W6736   ;save it
68 6918 0600016 lod arg1   ;get power @6918
69 6918+1155422 jz .5   ;zero, return 1.0
70 6919 1035410 jn .1   ;negative, invert @6919
71 6919+1015411 jmp .2   ;positive, normal
72 6920  ;
73 6920  .1:;
74 6920 0455121 inc W6737   ;bump flag @6920
75 6920+0620016 lcs arg1   ;complement power
76 6921  .2:;
77 6921 0600016 lod arg1   ;get power @6921
78 6921+1200001 sra 1   ;divide by 2
79 6922 0400016 sto arg1   ;and save @6922
80 6922+1360000 ara 0   ;get remainder
81 6923 1055415 jz .3   ;zero, ignore @6923
82 6923+0615120 lod W6736   ;get factor
83 6924 1460015 fmu Link1   ;multiply by number @6924
84 6924+0415120 sto W6736   ;and save
85 6925  .3:;
86 6925 0600016 lod arg1   ;load power @6925
87 6925+1055420 jz .4   ;zero, finished
89 6926+1460015 fmu Link1   ;square it
90 6927 0400015 sto Link1   ;and save it @6927
91 6927+1015411 jmp .2   ;repeat loop
92 6928  ;
93 6928  .4:;
94 6928 0615121 lod W6737   ;finished, test flag @6928
95 6928+1155422 jz .5   ;zero, done
96 6929 0615136 lod FP1.0   ;need to take reciprocal @6929
97 6929+1515120 fdv W6736   ;divide 1.0 by result
98 6930 1015423 jmp .6   ;and return that @6930
99 6930+ ;
100 6930+ .5:;
101 6930+0615120 lod W6736   ;reload result
102 6931  .6:;
103 6931 1015212 jmp CkoRet   ;and exit, checking overflow @6931
104 6931+ ;
105 6931+ .7:;
106 6931+0600016 lod arg1   ;get power
107 6932 1040013 jz IntOflo   ;overflow if zero?? @6932
108 6932+1115370 jmp Round.1   ;round
109 6933  ;--------------------------------------------------------------------
110 6933  ; return sign(arg1) -1, 0, +1
111 6933  ;
112 6933  Sign:;
113 6933 0600016 lod arg1   ;get argument @6933
114 6933+1135427 jn SignNeg   ;negative, return -1
115 6934 1040052 jz retlnk1   ;zero, return 0 @6934
116 6934+0040000 o02 0   ;=1
117 6935 1000052 jmp retlnk1   ;positive, return +1 @6935
118 6935+ ;
119 6935+ SignNeg:;
120 6935+0040000 o02 0   ;=1
121 6936 0020000 neg 0   ;negate it @6936
122 6936+1000052 jmp retlnk1   ;and return