DataMuseum.dk

top - download

    Length: 2969 (0xb99)
    Types: TextFile
    Names: »RULE077.PAS«

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

TextFile

{$O+,F+}\r
unit rule077;\r
interface\r
uses pscplm,sthunit,sthcom,sthp34,mpaunit,p3cmmn,p3rw,p3math;\r
PROCEDURE load_unsigned_constant\r
	((*			   Call				   Return				   *)\r
	VAR\r
		i_code				:	codes;\r
	VAR\r
		value				:	WORD	(*              - according to kind *)\r
	)\r
;\r
\r
\r
implementation\r
(* $SUBTITLE('------------ PROCEDURE load_unsigned_constant') *)\r
PROCEDURE load_unsigned_constant\r
( (* Call Return *)\r
VAR\r
i_code : codes;\r
VAR\r
value : WORD (* - despite type *)\r
);\r
\r
(* ------------------------------------------------------------------------\r
Pass2Code: 77\r
\r
Pass3Code: 77\r
\r
Symbol Table: 77\r
-.\r
===========================================================================\r
\r
Error Messages and Warnings:\r
e_iliteral_range\r
e_wliteral_range\r
e_bliteral_range\r
e_radix\r
e_token\r
-.\r
External Dependencies:\r
rule_test_set (defined in PASS3CMMN.INC)\r
-.\r
External Effects\r
rule_test_set (defined in PASS3CMMN.INC)\r
-.\r
Stack Appetite:\r
-.\r
Comments:\r
INTEGER value = 32768 is accepted temporarily and tested in Rule066.\r
-.\r
Outstanding:\r
-.\r
------------------------------------------------------------------------ *)\r
\r
(*#BEGINTEST\r
CONST\r
version_number = 005;\r
this_rule = 077;\r
(*ENDTEST#*)\r
\r
VAR\r
e_literal_limit ,\r
\r
string_lth ,\r
\r
max_value ,\r
base_char ,\r
base ,\r
dummy ,\r
digit : WORD;\r
\r
(*#BEGINTEST\r
rule_test : BOOLEAN;\r
(*ENDTEST#*)\r
\r
BEGIN\r
\r
(*#BEGINTEST\r
rule_test := i_code IN rule_test_set;\r
\r
IF rule_test THEN\r
WRITELN\r
(\r
testoutput, ' Begin Rule ', this_rule:3,\r
' V', version_number:3, '/ ', WORD( i_code ):3, ' U CNST'\r
);\r
(*ENDTEST#*)\r
\r
CASE i_code OF\r
cinteger:\r
BEGIN\r
\r
e_literal_limit := e_iliteral_range;\r
max_value := max_word;  (* ny rtp hha rtp86_minint *)\r
\r
END;\r
\r
cword:\r
BEGIN\r
\r
e_literal_limit := e_wliteral_range;\r
max_value := max_word\r
\r
END;\r
\r
cbyte:\r
BEGIN\r
\r
e_literal_limit := e_bliteral_range;\r
max_value := maxbyte\r
\r
END;\r
\r
(*OTHERWISE*) ELSE\r
pass3_error( e_token, WORD( i_code ) )\r
\r
END;\r
\r
load_arg_3( string_lth, dummy, base_char );\r
\r
string_lth := string_lth - 2;\r
\r
IF base_char = WORD( 'b' ) THEN\r
base := 2\r
ELSE\r
\r
IF base_char = WORD( 'o' ) THEN\r
base := 8\r
ELSE\r
\r
IF base_char = WORD( 'd' ) THEN\r
base := 10\r
ELSE\r
\r
IF base_char = WORD( 'h' ) THEN\r
base := 16\r
ELSE\r
\r
fatal_error( this_pass, e_radix );\r
\r
value := 0;\r
\r
REPEAT\r
\r
load_arg_1( digit );\r
string_lth := string_lth - 1;\r
\r
IF CHR( digit ) IN [ '0' .. '9' ] THEN\r
digit := digit - ord( '0' )\r
ELSE\r
\r
digit := digit - ord( 'a' ) + 10;\r
\r
IF wmul_ovflw( value, base ) OR wadd_ovflw( value, digit ) OR ( max_value < value ) THEN\r
BEGIN\r
\r
errormsg( this_pass, e_literal_limit );\r
\r
IF ( 0 < string_lth ) THEN\r
skip( string_lth );\r
\r
string_lth := 0\r
\r
END\r
\r
UNTIL ( string_lth = 0 );\r
\r
(*#BEGINTEST\r
IF rule_test THEN\r
WRITELN\r
(\r
testoutput, ' - End Rule ', this_rule:3,\r
' V', version_number:3, '/ ', WORD( i_code ):3,\r
' U VAL ', value:5\r
);\r
(*ENDTEST#*) \r
\r
END (* - PROCEDURE load_unsigned_constant - *);\r
END.\r
«eof»