DataMuseum.dk

top - download

    Length: 11868 (0x2e5c)
    Types: TextFile
    Names: »P3CMMN.PAS«

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

TextFile

unit p3cmmn;\r
interface\r
uses pscplm,mpaunit,sthunit;\r
\r
CONST\r
this_pass = pass3;\r
pass3_version = 500;\r
\r
(* ------------------------------------------------------------------------\r
- temporary declarations:\r
------------------------------------------------------------------------ *)\r
rtp86_minint = $8000;\r
rtp86_long_minint= -32768; (* 16 bit minint in 32 bits *)\r
maxbyte = 255;\r
maxchar = maxbyte;\r
\r
(* ------------------------------------------------------------------------\r
------ end temporary.\r
------------------------------------------------------------------------ *)\r
\r
(* ------------------------------------------------------------------------\r
------------------------------------------------------------------------ *)\r
address_size = 4;\r
VAR semaphore_size : Integer;\r
\r
(* ------------------------------------------------------------------------\r
------------------------------------------------------------------------ *)\r
program_descr_size : integer; (* 34 *)\r
CONST\r
process_descr_size = 100;\r
pi3_appetite = 1000;\r
activation_record_length = 0;\r
VAR\r
static_link_size,\r
\r
local_return_appetite ,\r
global_return_appetite : byte;\r
CONST\r
(* ------------------------------------------------------------------------\r
------------------------------------------------------------------------ *)\r
var_param_size = address_size;\r
inspect_param_size = address_size;\r
\r
lf_shared_param_size = address_size;\r
VAR gf_shared_param_size : Integer;\r
shared_var_size : Integer;\r
\r
(* ------------------------------------------------------------------------\r
------------------------------------------------------------------------ *)\r
dope_size_subrange,\r
dope_size_array,\r
dope_size_set: byte;\r
CONST\r
(* pass3 error messages *)\r
\r
(* - in Literals and in Constant Expressions (001..015) - *)\r
\r
e_iliteral_range = $00001; (* Value of INTEGER Literal exceed 32768 *)\r
e_wliteral_range = $00002; (* Value of WORD Literal exceed 65535 *)\r
e_bliteral_range = $00003; (* Value of BYTE Literal exceed 255 *)\r
\r
e_zero_divide = $00004;    (* Compile-Time division by zero detected in constant expression *)\r
e_zero_modulo = $00005;    (* Compile-Time modulo by zero detected in constant expression *)\r
e_divide_ovflow = $00006;  (* Compile-Time overflow detected in INTEGER division *)\r
e_modulo_ovflow = $00007;  (* Compile-Time overflow detected in INTEGER modulo *)\r
e_iadd_ovflw = $00008;     (* Compile-Time overflow detected in INTEGER addition *)\r
e_isub_ovflw = $00009;     (* Compile-Time overflow detected in INTEGER subtraction *)\r
e_imul_ovflw = $0000A;     (* Compile-Time overflow detected in INTEGER multiplication *)\r
\r
e_overflow = $0000D;       (* Overflow detected in constant expression *)\r
e_range = $0000E;          (* Constant expression out of range *)\r
e_index_expression=$0000F; (* Index expression out of bounds *)\r
\r
(* - size errors and address overflow (016..047) - *)\r
\r
e_array_size = $00010;     (* Size of ARRAY exceed 64Kb - 1 *)\r
e_record_size = $00011;    (* Size of RECORD exceed 64Kb - 1 *)\r
e_record_level = $00012;   (* Too many nested RECORD declarations *)\r
\r
e_gf_frame_size = $00014;  (* Size of global frame exceed 64Kb - 1 *)\r
e_display_vector = $00015; (* Size of display vector exceed 64Kb - 1 *)\r
e_lf_frame_size = $00016;  (* Size of local frame exceed 64Kb - 1 *)\r
e_frame_size = $00017;     (* Size of frame exceed 64Kb - 1 *)\r
e_eval_appetite = $00018;  (* Expression evaluation appetite exceed 64Kb - 1 *)\r
e_create_size = $00019;    (* Default create size of program exceed 64Kb - 1 *)\r
e_param_size = $00020;     (* Appetite of formal parameters exceed 64Kb - 1 *)\r
e_param_appetite = $00022; (* Appetite of formal parameters exceed 64Kb - 1 *)\r
e_param_count = $00023;    (* Too many formal parameters *)\r
\r
\r
(* - Special checks (048..063) - *)\r
\r
e_subrange = $00031;       (* Lower bound of subrange is greater than upper bound *)\r
e_case_label = $00032;     (* Case labels are not distinct *)\r
e_with_variable = $00033; (* Size of locally declared WITH variable exceed size of with object *)\r
e_too_many_elems= $00034;  (* too many elements in structure *)\r
e_wrong_number_of_elems= $0035; (* wrong number of elements in structure *)\r
e_not_constant_expr= $0036;(* object not constant *)\r
e_ill_set_op= $0037;       (* illegal SET operation *)\r
\r
e_string_size = $00038;    (* Length of STRING exceed 255 characters *)\r
e_irregular = $00039;      (* Illegal use of irregular element *)\r
e_char_value = $0003C;     (* Value of CHAR exceed 255 *)\r
\r
e_radix = $0003D;          (* Radix is not 'b', 'o', 'd' or 'h' *)\r
\r
e_simpleconst = $0003E;    (* This use of a simple constant not implemented *)\r
e_tempvar = $0003F;        (* An address transfer parameter in a program call *)\r
                           (* must be global *)\r
(* - Pass3 capacity violations (064..079) *)\r
\r
e_expression_ovfl = $00041;(* Too complicated expression *)\r
e_stmnt_nesting = $00043;  (* Too many nested CASE, FOR and WITH statements *)\r
e_routine_nesting = $00045;(* Too many nested routine declarations *)\r
e_const_elements = $00047; (* Too many structured constants *)\r
e_const_fragments = $00048;(* Too large structured constant *)\r
e_Set_NegElem = $00049;\r
(* - external capacity problems - *)\r
\r
e_nt_overflow = $0004A;    (* No room in Name Table *)\r
e_st_overflow = $0004B;    (* No room in Symbol Table *)\r
\r
(* - Pass3 errors (097..112) - *)\r
\r
e_expression_stck= $00061; (* in Expression Stack *)\r
e_struc_const_stck=$00063; (* in Constant Area *)\r
\r
(* ------------------------------------------------------------------------\r
- PASS3 environmental errors:\r
------------------------------------------------------------------------ *)\r
e_version = $00072;        (* Bad Pass2-Pass3 combination *)\r
e_real_not_impl = $00073;  (* REAL not implemented *)\r
e_set_not_impl = $00074;   (* SET not implemented *)\r
e_implemented = $00075;    (* Not implemented *)\r
e_option = $00077;         (* Unknown option *)\r
e_option_value = $00078;   (* Illegal value of Compiler option *)\r
e_std_code = $0007A;       (* Unknown Standard Type *)\r
e_std_routine = $0007B;    (* Unknown Standard Routine *)\r
e_func_result = $0007C;\r
\r
e_st_inconsistency=$00091; (* Symbol Table inconsistency *)\r
(* 0150 Mismatch in symboltable: occoured in component init *)\r
(* 0151 Mismatch in symboltable: occoured in system init mark 1 *)\r
(* 0152 Mismatch in symboltable: occoured in system init mark 2 *)\r
(* 0153 Mismatch in symboltable: occoured in system init mark 3 *)\r
(* 0154 Mismatch in symboltable: occoured when init of shared variable *)\r
\r
(* 0253 Pass2Code misread *)\r
(* 0254 Pass2Code misread in Context List *)\r
\r
e_token = $000FF;          (* Pass2Code misread in Body *)\r
\r
e_token_001 = $00E01;      (* Pass2Code misread at Context Level *)\r
e_token_002 = $00E02;      (* Pass2Code misread at outermost level *)\r
e_token_008 = $00E08;      (* Pass2Code misread in Formal Parameters *)\r
e_token_010 = $00E10;      (* Pass2Code misread in Block *)\r
e_token_018 = $00E18;      (* Pass2Code misread in Defining Type *)\r
e_token_066 = $00E66;      (* Pass2Code misread in Expression *)\r
\r
(* ------------------------------------------------------------------------\r
------------------------------------------------------------------------ *)\r
expr_stack_size =  1024; (* TURBO *)\r
max_stmnt_nesting = 64;\r
\r
\r
TYPE\r
\r
sca_max_string = ARRAY [ 1..max_fragment ] OF BYTE;\r
ptr_sca_max_string = ^sca_max_string;\r
(* ------------------------------------------------------------------------\r
RTP86 predefined routines\r
------------------------------------------------------------------------ *)\r
\r
standard_routines = (\r
std_routine_begin ,\r
std_ord ,\r
std_chr ,\r
std_int ,\r
std_wrd ,\r
std_byt ,\r
std_abs ,\r
std_succ ,\r
std_pred ,\r
std_inc ,\r
std_dec ,\r
std_link ,\r
std_unlink ,\r
std_create ,\r
std_new,\r
{$IFNDEF RTP86}\r
std_GetBuf,\r
std_GetBufDelay,\r
std_ChainDeQueue,\r
std_ChainEnQueue,\r
std_pop,\r
std_push,\r
std_signal,\r
std_wait,\r
std_waitdelay,\r
{$ENDIF}\r
std_routine_end\r
);\r
\r
standard_routine_list = ARRAY [ standard_routines ] OF WORD;\r
std_rout_lst_ptr= ^ standard_routine_list;\r
\r
plm_string_range = 1..rtpstringmax;\r
\r
(* ------------------------------------------------------------------------\r
\r
------------------------------------------------------------------------ *)\r
\r
expr_stack_range = 1..expr_stack_size;\r
\r
expr_stck_element = RECORD\r
st_addr: st_address;\r
size_: WORD;\r
type_ ,\r
prestr,\r
precode: codes;\r
prebool: byte;\r
indvar_code: boolean; (* denoting whether an operand object is loaded immediate or indirect *)\r
former_fct: expr_stack_range;\r
\r
CASE kind: codes OF\r
\r
cadd,\r
csub,\r
cusub,\r
cmul: (\r
set_operation,\r
overflow_chk: boolean\r
);\r
\r
ceq, cne, cle, cge, cgt, clt: (comp_set, comp_string: boolean);\r
\r
csimpleconst, cnull :\r
(\r
ww_value: WORD\r
);\r
\r
cinteger :\r
(\r
ii_value: INTEGER\r
);\r
\r
cendstruc: (\r
saved_rep_offset: word\r
);\r
\r
cstrucelem:\r
(dump_setrep: boolean;\r
rep_count_offset: word);\r
\r
cstrucconst :\r
(\r
saved_arr_elems: word;\r
st_str_const_symb: st_address\r
);\r
\r
cendsetlist: (\r
set_elem_count: word;\r
);\r
\r
cendassign,\r
cendassignstring: (\r
(* TOG cpackedassignment: ( *)\r
struc_range_chk, rep_struc: boolean\r
);\r
\r
ccaddr :\r
(\r
st_strucc_symbol: st_address\r
);\r
\r
caddr :\r
(\r
st_var_symbol: st_address;\r
access_chk: boolean;\r
);\r
\r
cendprogramcall,\r
cendproccall,\r
cendfunccall: (param_size_: word);\r
\r
cindex: (index_chk: boolean;\r
index_type_symbol: st_address);\r
\r
\r
cvarparam,\r
csharedparam,\r
cinspectparam,\r
cshared,  (* shared program parameter *)\r
cvalueparam: (\r
range_chk, family_type: boolean;\r
param_type_symbol: st_address\r
);\r
\r
END;\r
\r
\r
expr_stack_descr =\r
RECORD\r
top: INTEGER;\r
last_fct: expr_stack_range;\r
const_expr: BOOLEAN; (* tells whether total expression is constant or not *)\r
last_var_index: integer; (* used for detection of constant sub expressions *)\r
max_temp_size: word;\r
case stack_size: integer of\r
0: (stck: ARRAY[ expr_stack_range ] OF expr_stck_element);\r
1: (min_stack: array [1..100] of expr_stck_element);\r
END;\r
\r
expr_stack_ptr= ^ expr_stack_descr;\r
\r
\r
(* ------------------------------------------------------------------------\r
------------------------------------------------------------------------ *)\r
\r
\r
stmnt_stack_range = 1..max_stmnt_nesting;\r
\r
(* ------------------------------------------------------------------------\r
------------------------------------------------------------------------ *)\r
\r
(*#BEGINTEST\r
rule_test_mask = SET OF codes;\r
(*ENDTEST#*)\r
\r
(* ------------------------------------------------------------------------\r
------------------------------------------------------------------------ *)\r
\r
VAR\r
current_comp_unit_number, (* used for chaining of used external routines *)\r
pass3_line ,\r
create_size: WORD;\r
\r
fam_type_declaration, (* set/reset by typdeclaration, used by defining type *)\r
\r
access_check ,\r
range_check ,\r
index_check ,\r
overflow_check: BOOLEAN;\r
\r
std_routine_list: std_rout_lst_ptr;\r
std_routine: standard_routines;\r
\r
plm_string: string;\r
plm_string_ptr: ptr_string;\r
\r
first_external, (* called external routines are chained per compilation unit *)\r
last_external, (* first/last_external denotes current chain *)\r
\r
sca_chainhead ,\r
sca_end_cntxt ,\r
sca_end_chain ,\r
\r
sca_current_frgmnt: st_address;\r
\r
sca_total_bytes,\r
sca_current_byte ,\r
sca_current_bit: WORD;\r
\r
stmnt_stck: ARRAY[ stmnt_stack_range ] OF\r
RECORD\r
code: codes;\r
offset: WORD;\r
symbol: st_address\r
END;\r
\r
dope_addr_offset: word; (* offset of the actual descriptor address,\r
seen from inside of the THUNK *)\r
\r
stmnt_stck_top: INTEGER;\r
\r
e_stck: expr_stack_ptr;\r
\r
protected_types: st_protect_type;\r
\r
(*#BEGINTEST\r
rule_test_set: rule_test_mask;\r
(*ENDTEST#*)\r
\r
\r
type addressprocedure =\r
PROCEDURE\r
(\r
VAR\r
current_offset,\r
object_offset: WORD;\r
object_size: WORD\r
);\r
\r
\r
implementation\r
\r
end.\r
«eof»