DataMuseum.dk

Presents historical artifacts from the history of:

DANOSI

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DANOSI

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - download

⟦c70c2eed4⟧ TextFile

    Length: 16407 (0x4017)
    Types: TextFile
    Names: »P3MATH.PAS«

Derivation

└─⟦02956c927⟧ Bits:30010510 DVBS1.SW2114.src.2.14-1 SW2114 REAL #1/4 TIME PASCAL SOURCE REL 2.14
    └─⟦this⟧ »RTP\P3MATH.PAS« 
└─⟦4f587ad96⟧ Bits:30010518 DVBS1.SW2114.src.2.7-1 SW2114 1/4 Real Time Pascal 2.7 92.06.16
    └─⟦this⟧ »RTP\P3MATH.PAS« 
└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
    └─⟦this⟧ »RTP\P3MATH.PAS« 
└─⟦b607d6035⟧ Bits:30010532 RTP compiler Source 1 2.14 26/9(?)-92 DVBS1.SW2114.src.2.14-8
    └─⟦this⟧ »P3MATH.PAS« 
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
    └─⟦this⟧ »RTP\P3MATH.PAS«

TextFile

{$O+,F+}\r
unit P3MATH;\r
interface\r
uses pscplm,sthunit,sthcom,sthp34,mpaunit,p3cmmn;\r
\r
FUNCTION rtp86_wmap\r
(operand : INTEGER) : WORD;\r
\r
FUNCTION rtp86_imap\r
(operand : WORD) : INTEGER;\r
\r
FUNCTION winc_ovflw\r
(VAR\r
wdst : WORD) : BOOLEAN;\r
\r
FUNCTION wadd_ovflw\r
(VAR\r
wdst : WORD;\r
wsrc : WORD) : BOOLEAN;\r
\r
FUNCTION wdec_ovflw\r
(VAR\r
wdst : WORD) : BOOLEAN;\r
\r
FUNCTION wsub_ovflw\r
(VAR\r
wdst : WORD;\r
wsrc : WORD) : BOOLEAN;\r
\r
FUNCTION wmul_ovflw\r
(VAR\r
wdst : WORD;\r
wsrc : WORD) : BOOLEAN;\r
FUNCTION rtp86_ilt\r
(operand1 ,\r
operand2 : WORD) : BOOLEAN;\r
\r
PROCEDURE rtp86_iusub\r
(VAR\r
operand1 : INTEGER);\r
\r
PROCEDURE rtp86_iadd\r
( \r
VAR\r
operand1 ,\r
operand2 : INTEGER);\r
\r
PROCEDURE rtp86_isub\r
(VAR\r
operand1 ,\r
operand2 : INTEGER);\r
\r
PROCEDURE rtp86_imul\r
(VAR\r
operand1 ,\r
operand2 : INTEGER);\r
\r
PROCEDURE rtp86_idiv\r
(VAR\r
operand1 ,\r
operand2 : INTEGER);\r
\r
PROCEDURE rtp86_imod\r
(VAR\r
operand1 ,\r
operand2 : INTEGER);\r
\r
FUNCTION rtp86_wnot\r
(operand : WORD) : WORD;\r
\r
FUNCTION rtp86_wor\r
(operand1 ,\r
operand2 : WORD) : WORD;\r
\r
FUNCTION rtp86_wxor\r
(operand1 ,\r
operand2 : WORD) : WORD;\r
\r
FUNCTION rtp86_wdiv\r
(operand1 ,\r
operand2 : WORD) : WORD;\r
\r
FUNCTION rtp86_wmod\r
(operand1 ,\r
operand2 : WORD) : WORD;\r
\r
FUNCTION rtp86_wand\r
(operand1 ,\r
operand2 : WORD) : WORD;\r
\r
FUNCTION rtp86_wshift\r
(operand : WORD;\r
count : INTEGER) : WORD;\r
\r
FUNCTION rtp86_bnot\r
(operand : WORD) : WORD;\r
\r
(* not used \r
FUNCTION rtp86_band\r
(operand1 ,\r
operand2 : WORD) : WORD;\r
*)\r
\r
FUNCTION rtp86_bor\r
(operand1 ,\r
operand2 : WORD) : WORD;\r
\r
FUNCTION rtp86_bshift\r
(operand : WORD;\r
count : INTEGER) : WORD;\r
\r
FUNCTION range_error\r
(st_symbol : st_address;\r
value : WORD) : BOOLEAN;\r
\r
FUNCTION rtp86_wadd\r
(w1 ,\r
w2 : WORD) : WORD;\r
\r
FUNCTION rtp86_wsub\r
(w1 ,\r
w2 : WORD) : WORD;\r
\r
FUNCTION rtp86_wmul\r
(w1 ,\r
w2 : WORD) : WORD;\r
\r
FUNCTION rtp86_badd\r
(w1 ,\r
w2 : WORD) : WORD;\r
\r
FUNCTION rtp86_bsub\r
(w1 ,\r
w2 : WORD) : WORD;\r
\r
FUNCTION rtp86_bmul\r
(w1 ,\r
w2 : WORD) : WORD;\r
\r
(* not used\r
FUNCTION rtp86_succ\r
(upper_limit ,\r
operand : WORD) : WORD;\r
*)\r
\r
(* not used \r
FUNCTION rtp86_pred\r
(lower_limit ,\r
operand : WORD) : WORD;\r
*)\r
\r
FUNCTION rtp86_abs\r
(operand : WORD) : WORD;\r
\r
(* not used\r
FUNCTION rtp86_typesize\r
(type_symbol : st_address;\r
VAR\r
type_size : WORD) : BOOLEAN;\r
*)\r
(* not used\r
FUNCTION rtp86_varsize\r
(var_symbol : st_address;\r
VAR\r
var_size : WORD) : BOOLEAN;\r
*)\r
\r
Implementation\r
(* ------------------------------------------------------------------------\r
Error Messages and Warnings:\r
e_zero_divide\r
e_zero_modulo\r
e_divide_ovflw\r
e_modulo_ovflw\r
e_iadd_ovflw\r
e_isub_ovflw\r
e_imul_ovflw\r
e_st_inconsistency\r
-.\r
External Dependencies:\r
access_check (defined in PASS3CMMN.INC)\r
range_check (defined in PASS3CMMN.INC)\r
index_check (defined in PASS3CMMN.INC)\r
overflow_check (defined in PASS3CMMN.INC)\r
-.\r
External Effects:\r
-.\r
Comments:\r
CAUTION! This module must be compiled with the NOCHECK option.\r
-.\r
Outstanding:\r
-.\r
------------------------------------------------------------------------ *)\r
\r
(* $NOCHECK *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wmap') *)\r
FUNCTION rtp86_wmap\r
(\r
operand : INTEGER\r
) : WORD;\r
\r
BEGIN\r
\r
IF operand<0 THEN\r
rtp86_wmap:= max_word+operand+1\r
ELSE\r
\r
rtp86_wmap:= operand\r
\r
END; (* procedure rtp86_wmap *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_imap') *)\r
FUNCTION rtp86_imap\r
(\r
operand : WORD\r
) : INTEGER;\r
\r
BEGIN\r
\r
IF maxint<operand THEN\r
rtp86_imap :=-(max_word-operand+1)\r
ELSE\r
\r
rtp86_imap:= operand\r
\r
END; (* procedure rtp86_imap *)\r
\r
(* $SUBTITLE('------------ PROCEDURE winc_ovflw') *)\r
FUNCTION winc_ovflw\r
(\r
VAR\r
wdst : WORD\r
) : BOOLEAN;\r
\r
BEGIN\r
\r
winc_ovflw:= max_word=wdst;\r
\r
wdst:= wdst+1\r
\r
END; (* function winc_ovflw *)\r
\r
(* $SUBTITLE('------------ PROCEDURE wadd_ovflw') *)\r
FUNCTION wadd_ovflw\r
(\r
VAR\r
wdst : WORD;\r
wsrc : WORD\r
) : BOOLEAN;\r
\r
BEGIN\r
\r
wadd_ovflw:= max_word-wdst<wsrc;\r
\r
wdst:= wdst+wsrc;\r
\r
END; (* function wadd_ovflw *)\r
\r
(* $SUBTITLE('------------ PROCEDURE wdec_ovflw') *)\r
FUNCTION wdec_ovflw\r
(\r
VAR\r
wdst : WORD\r
) : BOOLEAN;\r
\r
BEGIN\r
\r
wdec_ovflw:= 0=wdst;\r
\r
wdst:= wdst-1;\r
\r
END; (* function wdec_ovflw *)\r
\r
(* $SUBTITLE('------------ PROCEDURE wsub_ovflw') *)\r
FUNCTION wsub_ovflw\r
(\r
VAR\r
wdst : WORD;\r
wsrc : WORD\r
) : BOOLEAN;\r
\r
BEGIN\r
\r
wsub_ovflw:= wdst<wsrc;\r
\r
wdst:= wdst-wsrc;\r
\r
END; (* function wsub_ovflw *)\r
\r
(* $SUBTITLE('------------ PROCEDURE wmul_ovflw') *)\r
FUNCTION wmul_ovflw\r
(\r
VAR\r
wdst : WORD;\r
wsrc : WORD\r
) : BOOLEAN;\r
\r
BEGIN\r
\r
IF wsrc<>0 THEN\r
wmul_ovflw:= (max_word DIV wsrc)<wdst\r
ELSE\r
\r
wmul_ovflw:= false;\r
\r
wdst:= wdst*wsrc;\r
\r
END; (* function wmul_ovflw *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_ilt') *)\r
FUNCTION rtp86_ilt\r
(\r
operand1 ,\r
(*<*)\r
operand2 : WORD\r
) : BOOLEAN;\r
\r
BEGIN\r
\r
\r
IF maxint<operand1 THEN\r
BEGIN\r
\r
IF maxint<operand2 THEN (*-both negative-*)\r
rtp86_ilt:= operand1<operand2\r
ELSE (*-negative less than positive-*)\r
\r
rtp86_ilt:= true\r
\r
END\r
ELSE\r
\r
BEGIN\r
\r
IF maxint<operand2 THEN (*-positive greater than negative-*)\r
rtp86_ilt:= false\r
ELSE (*-both positive-*)\r
\r
rtp86_ilt:= operand1<operand2;\r
\r
END;\r
\r
END; (* function rtp86_ilt *)\r
\r
(* $SUBTITLE('------------ PROCEDURE rtp86_iusub') *)\r
PROCEDURE rtp86_iusub\r
(\r
VAR\r
operand1 : INTEGER\r
);\r
\r
BEGIN\r
\r
IF overflow_check THEN\r
IF operand1=rtp86_minint THEN\r
errormsg(this_pass, e_isub_ovflw);\r
\r
operand1 :=-operand1;\r
\r
END; (* PROCEDURE rtp86_iusub *)\r
\r
(* $SUBTITLE('------------ PROCEDURE rtp86_iadd') *)\r
PROCEDURE rtp86_iadd\r
(\r
VAR\r
operand1 ,\r
(*+*)\r
operand2 : INTEGER\r
);\r
var\r
res: longint;\r
\r
BEGIN\r
\r
IF overflow_check THEN\r
begin\r
res:= operand1;\r
res:= res+operand2;\r
if (res>maxint) or (res<rtp86_long_minint) then\r
errormsg(this_pass, e_iadd_ovflw);\r
end; (* overflow check *)\r
\r
operand1:= operand1+operand2;\r
\r
END; (* PROCEDURE rtp86_iadd *)\r
\r
(* $SUBTITLE('------------ PROCEDURE rtp86_isub') *)\r
PROCEDURE rtp86_isub\r
(\r
VAR\r
operand1 ,\r
(*-*)\r
operand2 : INTEGER\r
);\r
var\r
res: longint;\r
\r
BEGIN\r
\r
IF overflow_check THEN\r
begin\r
res:= operand1;\r
res:= res-operand2;\r
if (res>maxint) or (res<rtp86_long_minint) then\r
errormsg(this_pass, e_isub_ovflw);\r
end; (* overflow check *)\r
\r
operand1:= operand1-operand2;\r
\r
END; (* PROCEDURE rtp86_isub *)\r
\r
(* $SUBTITLE('------------ PROCEDURE rtp86_imul') *)\r
PROCEDURE rtp86_imul\r
(\r
VAR\r
operand1 ,\r
(***)\r
operand2 : INTEGER\r
);\r
var\r
res: longint;\r
\r
BEGIN\r
\r
IF overflow_check THEN\r
begin\r
res:= operand1;\r
res:= res*operand2;\r
if (res>maxint) or (res<rtp86_long_minint) then\r
errormsg(this_pass, e_imul_ovflw);\r
end; (* overflow check *)\r
\r
operand1:= operand1*operand2;\r
\r
END; (* PROCEDURE rtp86_imul *)\r
\r
(* $SUBTITLE('------------ PROCEDURE rtp86_idiv') *)\r
PROCEDURE rtp86_idiv\r
(\r
VAR\r
operand1 ,\r
(* DIV *)\r
operand2 : INTEGER\r
);\r
var\r
res: longint;\r
\r
BEGIN\r
\r
IF operand2<>0 THEN\r
BEGIN\r
\r
IF overflow_check THEN\r
begin\r
res:= operand1;\r
res:= res div operand2;\r
if res>maxint then\r
errormsg(this_pass, e_divide_ovflow);\r
end; (* overflow check *)\r
\r
operand1:= operand1 DIV operand2\r
\r
END\r
ELSE\r
\r
errormsg(this_pass, e_zero_divide);\r
\r
END; (* PROCEDURE rtp86_idiv *)\r
(* $SUBTITLE('------------ PROCEDURE rtp86_imod') *)\r
PROCEDURE rtp86_imod\r
(\r
VAR\r
operand1 ,\r
(* MOD *)\r
operand2 : INTEGER\r
);\r
var\r
res: longint;\r
\r
BEGIN\r
\r
IF operand2<>0 THEN\r
BEGIN\r
\r
IF overflow_check THEN\r
begin\r
res:= operand1;\r
res:= res mod operand2;\r
if res>maxint then\r
errormsg(this_pass, e_modulo_ovflow);\r
end; (* overflow check *)\r
\r
operand1:= operand1 MOD operand2\r
\r
END\r
ELSE\r
\r
errormsg(this_pass, e_zero_modulo);\r
\r
END; (* PROCEDURE rtp86_imod *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wnot') *)\r
FUNCTION rtp86_wnot\r
(\r
operand : WORD\r
) : WORD;\r
\r
VAR\r
word1 ,\r
word2 : RECORD CASE boolean OF\r
false : (bits : SET OF 0..15);\r
true : (result: WORD)\r
END;\r
\r
BEGIN\r
\r
word1.result:= operand;\r
word2.result:= max_word;\r
\r
word1.bits:= word2.bits-word1.bits;\r
\r
rtp86_wnot:= word1.result;\r
\r
END; (* function rtp86_wnot *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wor') *)\r
FUNCTION rtp86_wor\r
(\r
operand1 ,\r
(* OR *)\r
operand2 : WORD\r
) : WORD;\r
\r
VAR\r
word1 ,\r
word2 : RECORD CASE boolean OF\r
false : (bits : SET OF 0..15);\r
true : (result: WORD)\r
END;\r
\r
BEGIN\r
\r
word1.result:= operand1;\r
word2.result:= operand2;\r
\r
word1.bits:= word1.bits+word2.bits;\r
\r
rtp86_wor:= word1.result;\r
\r
END; (* function rtp86_wor *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wxor') *)\r
FUNCTION rtp86_wxor\r
(\r
operand1 ,\r
(* XOR *)\r
operand2 : WORD\r
) : WORD;\r
\r
VAR\r
word1 ,\r
word2 : RECORD CASE boolean OF\r
false : (bits : SET OF 0..15);\r
true : (result: WORD)\r
END;\r
\r
BEGIN\r
\r
word1.result:= operand1;\r
word2.result:= operand2;\r
\r
word1.bits:= (word1.bits-word2.bits)+(word2.bits -word1.bits);\r
\r
rtp86_wxor:= word1.result;\r
\r
END; (* function rtp86_wxor *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wdiv') *)\r
FUNCTION rtp86_wdiv\r
(\r
operand1 ,\r
(* DIV *)\r
operand2 : WORD\r
) : WORD;\r
\r
BEGIN\r
\r
IF operand2<>0 THEN\r
rtp86_wdiv:= operand1 DIV operand2\r
ELSE\r
\r
errormsg(this_pass, e_zero_divide);\r
\r
END; (* function rtp86_wdiv *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wmod') *)\r
FUNCTION rtp86_wmod\r
(\r
operand1 ,\r
(* MOD *)\r
operand2 : WORD\r
) : WORD;\r
\r
BEGIN\r
\r
IF operand2<>0 THEN\r
rtp86_wmod:= operand1 MOD operand2\r
ELSE\r
\r
errormsg(this_pass, e_zero_divide);\r
\r
END; (* function rtp86_wmod *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wand') *)\r
FUNCTION rtp86_wand\r
(\r
operand1 ,\r
(* AND *)\r
operand2 : WORD\r
) : WORD;\r
\r
VAR\r
word1 ,\r
word2 : RECORD CASE boolean OF\r
false : (bits : SET OF 0..15);\r
true : (result: WORD)\r
END;\r
\r
BEGIN\r
\r
word1.result:= operand1;\r
word2.result:= operand2;\r
\r
word1.bits:= word1.bits*word2.bits;\r
\r
rtp86_wand:= word1.result;\r
\r
END; (* function rtp86_wand *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wshift') *)\r
FUNCTION rtp86_wshift\r
(\r
operand : WORD;\r
count : INTEGER\r
) : WORD;\r
\r
BEGIN\r
\r
IF 0<count THEN\r
WHILE count<>0 DO\r
BEGIN\r
\r
operand:= operand*2;\r
count:= count-1\r
\r
END\r
ELSE\r
\r
WHILE count<>0 DO\r
BEGIN\r
\r
operand:= operand DIV 2;\r
count:= count+1\r
\r
END;\r
\r
rtp86_wshift:= operand;\r
\r
END; (* function rtp86_wshift *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_bnot') *)\r
FUNCTION rtp86_bnot\r
(\r
operand : WORD\r
) : WORD;\r
\r
VAR\r
word1 ,\r
word2 : RECORD CASE boolean OF\r
false : (bits : SET OF 0..15);\r
true : (result: WORD)\r
END;\r
\r
BEGIN\r
\r
word1.result:= operand;\r
word2.result:= maxbyte;\r
\r
word1.bits:= word2.bits-word1.bits;\r
\r
rtp86_bnot:= word1.result;\r
\r
END; (* function rtp86_bnot *)\r
\r
(* not used $SUBTITLE('------------ FUNCTION rtp86_band')\r
(* not used FUNCTION rtp86_band\r
(* not used (\r
(* not used operand1 ,\r
(* not used (* AND *)\r
(* not used operand2 : WORD\r
(* not used ) : WORD;\r
(* not used \r
(* not used VAR\r
(* not used word1 ,\r
(* not used word2 : RECORD CASE boolean OF\r
(* not used false : (bits : SET OF 0..15);\r
(* not used true : (result: WORD)\r
(* not used END;\r
(* not used \r
(* not used BEGIN\r
(* not used \r
(* not used word1.result:= operand1;\r
(* not used word2.result:= operand2;\r
(* not used \r
(* not used word1.bits:= (word1.bits*word2.bits)-[ 8..15 ];\r
(* not used \r
(* not used rtp86_band:= word1.result\r
(* not used \r
(* not used END; (* function rtp86_band *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_bor') *)\r
FUNCTION rtp86_bor\r
(\r
operand1 ,\r
(* OR *)\r
operand2 : WORD\r
) : WORD;\r
\r
VAR\r
word1 ,\r
word2 : RECORD CASE boolean OF\r
false : (bits : SET OF 0..15);\r
true : (result: WORD)\r
END;\r
\r
BEGIN\r
\r
word1.result:= operand1;\r
word2.result:= operand2;\r
\r
word1.bits:= (word1.bits+word2.bits)-[ 8..15 ];\r
\r
rtp86_bor:= word1.result;\r
\r
END; (* function rtp86_bor *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_bshift') *)\r
FUNCTION rtp86_bshift\r
(\r
operand : WORD;\r
count : INTEGER\r
) : WORD;\r
\r
BEGIN\r
\r
IF 0<count THEN\r
begin\r
WHILE count<>0 DO\r
BEGIN\r
operand:= operand*2;\r
count:= count-1\r
end;\r
operand:= operand mod (maxbyte+1);\r
END\r
ELSE\r
WHILE count<>0 DO\r
BEGIN\r
operand:= operand DIV 2;\r
count:= count+1\r
END;\r
\r
rtp86_bshift:= operand;\r
\r
END; (* function rtp86_bshift *)\r
\r
(* $SUBTITLE('------------ FUNCTION range_error') *)\r
FUNCTION range_error\r
(\r
st_symbol : st_address; (*-of defining type-*)\r
value : WORD\r
) : BOOLEAN;\r
\r
VAR\r
st_ptr : st_elemptr;\r
\r
BEGIN (* only for static types !!!!! *)\r
st_retrieve(st_symbol, st_ptr);\r
\r
if st_ptr^.st_kind=csubrange then\r
range_error:= rtp86_ilt(value, st_ptr^.subr_low) OR\r
rtp86_ilt(st_ptr^.subr_high, value)\r
else\r
range_error:= false;\r
\r
END; (* function check_range *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wadd') *)\r
FUNCTION rtp86_wadd\r
(\r
w1 ,\r
w2 : WORD\r
) : WORD;\r
\r
BEGIN\r
\r
rtp86_wadd:= w1+w2;\r
\r
END; (* function rtp86_wadd *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wsub') *)\r
FUNCTION rtp86_wsub\r
(\r
w1 ,\r
w2 : WORD\r
) : WORD;\r
\r
BEGIN\r
\r
rtp86_wsub:= w1-w2;\r
\r
END; (* function rtp86_wsub *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_wmul') *)\r
FUNCTION rtp86_wmul\r
(\r
w1 ,\r
w2 : WORD\r
) : WORD;\r
\r
BEGIN\r
\r
rtp86_wmul:= w1*w2;\r
\r
END; (* function rtp86_wmul *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_badd') *)\r
FUNCTION rtp86_badd\r
(\r
w1 ,\r
w2 : WORD\r
) : WORD;\r
\r
BEGIN\r
\r
IF (maxbyte-w1)<w2 THEN\r
rtp86_badd:= w2-(maxbyte+1-w1)\r
ELSE\r
\r
rtp86_badd:= w1+w2;\r
\r
END; (* function rtp86_badd *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_bsub')*)\r
FUNCTION rtp86_bsub\r
(\r
w1 ,\r
w2 : WORD\r
) : WORD;\r
\r
BEGIN\r
\r
IF w1<w2 THEN\r
rtp86_bsub:=  maxbyte-(w2-w1)+1\r
ELSE\r
\r
rtp86_bsub:= w1-w2;\r
\r
END; (* function rtp86_bsub *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_bmul') *)\r
FUNCTION rtp86_bmul\r
(\r
w1 ,\r
w2 : WORD\r
) : WORD;\r
\r
VAR\r
step_var ,\r
temp : WORD;\r
\r
BEGIN\r
\r
temp:= 0;\r
\r
IF w1<w2 THEN\r
FOR step_var:= 1 TO w1 DO\r
temp:= rtp86_badd(temp, w2)\r
ELSE\r
\r
FOR step_var:= 1 TO w2 DO\r
temp:= rtp86_badd(temp, w1);\r
\r
rtp86_bmul:= temp\r
\r
END; (* function rtp86_bmul *)\r
\r
(* not used $SUBTITLE('------------ FUNCTION rtp86_succ')\r
(* not used FUNCTION rtp86_succ\r
(* not used (\r
(* not used upper_limit ,\r
(* not used operand : WORD\r
(* not used ) : WORD;\r
(* not used \r
(* not used BEGIN\r
(* not used \r
(* not used IF operand<upper_limit THEN\r
(* not used rtp86_succ:= operand+1\r
(* not used ELSE\r
(* not used \r
(* not used BEGIN\r
(* not used \r
(* not used rtp86_succ:= operand;\r
(* not used errormsg(this_pass, e_overflow)\r
(* not used \r
(* not used END\r
(* not used \r
(* not used END; (* function rtp86_succ *)\r
\r
(* not used $SUBTITLE('------------ FUNCTION rtp86_pred')\r
(* not used FUNCTION rtp86_pred\r
(* not used (\r
(* not used lower_limit ,\r
(* not used operand : WORD\r
(* not used ) : WORD;\r
(* not used \r
(* not used BEGIN\r
(* not used \r
(* not used IF lower_limit<operand THEN\r
(* not used rtp86_pred:= operand-1\r
(* not used ELSE\r
(* not used \r
(* not used BEGIN\r
(* not used \r
(* not used rtp86_pred:= operand;\r
(* not used errormsg(this_pass, e_overflow)\r
(* not used \r
(* not used END\r
(* not used \r
(* not used END; (* function rtp86_pred *)\r
\r
(* $SUBTITLE('------------ FUNCTION rtp86_abs') *)\r
FUNCTION rtp86_abs\r
(\r
operand : WORD\r
) : WORD;\r
\r
BEGIN\r
\r
IF maxint<operand THEN\r
rtp86_abs:= max_word-operand+1\r
ELSE\r
\r
rtp86_abs:= operand\r
\r
END; (* function rtp86_abs *)\r
\r
(* not used $SUBTITLE('------------ FUNCTION rtp86_typesize')\r
(* not used FUNCTION rtp86_typesize\r
(* not used (\r
(* not used type_symbol : st_address;\r
(* not used VAR\r
(* not used type_size : WORD\r
(* not used ) : BOOLEAN;\r
(* not used \r
(* not used VAR\r
(* not used st_ptr : st_elemptr;\r
(* not used \r
(* not used BEGIN\r
(* not used \r
(* not used st_retrieve(type_symbol, st_ptr);\r
(* not used \r
(* not used type_size:= st_ptr^.st_size;\r
(* not used rtp86_typesize:= (st_ptr^.type_mode=stat)\r
(* not used \r
(* not used END; (* function rtp86_typesize *)\r
\r
(* not used $SUBTITLE('------------ FUNCTION rtp86_varsize')\r
(* not used FUNCTION rtp86_varsize\r
(* not used (\r
(* not used var_symbol : st_address;\r
(* not used VAR\r
(* not used var_size : WORD\r
(* not used ) : BOOLEAN;\r
(* not used \r
(* not used VAR\r
(* not used st_ptr : st_elemptr;\r
(* not used \r
(* not used BEGIN\r
(* not used \r
(* not used st_retrieve(var_symbol, st_ptr);\r
(* not used st_retrieve(st_ptr^.typeref, st_ptr);\r
(* not used \r
(* not used var_size:= st_ptr^.st_size;\r
(* not used rtp86_varsize:= st_ptr^.type_mode=stat\r
(* not used \r
(* not used END; (* function rtp86_varsize *)\r
END.\r