DataMuseum.dk

top - download

    Length: 8569 (0x2179)
    Types: TextFile
    Names: »RULE078.PAS«

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

TextFile

{$O+,F+}\r
unit rule078;\r
interface\r
uses pscplm,sthunit,sthcom,sthp34,mpaunit,p3cmmn,p3math,p3rw;\r
\r
\r
PROCEDURE push_struc_value\r
(\r
total_size: WORD;\r
VAR\r
st_label_addr: st_address;\r
st_typeaddr: st_address;\r
cnst_used: BOOLEAN\r
);\r
\r
(* tog *)PROCEDURE store_const_area(remove:boolean);\r
\r
PROCEDURE sca_fill\r
(\r
src_size: WORD;\r
src: Ptr_sca_max_string\r
);\r
\r
Procedure sca_Integer(int : LongInt);\r
\r
procedure sca_duplicate_bytes(amount: word);\r
\r
\r
procedure sca_copy_structured_constant(const_addr: st_address;\r
                                       elem_size : word);\r
\r
procedure sca_put_byte(byte_nr: integer; byte_val: byte);\r
\r
implementation\r
(* ------------------------------------------------------------------------\r
Pass2Code:\r
-.\r
Pass3Code:\r
-.\r
Symbol Table:\r
-.\r
\r
===========================================================================\r
\r
Error Messages and Warnings:\r
-.\r
External Dependencies:\r
sca_chainhead (defined in PASS3CMMN.INC)\r
sca_end_chain (defined in PASS3CMMN.INC)\r
sca_end_cntxt (defined in PASS3CMMN.INC)\r
sca_current_frgmnt (defined in PASS3CMMN.INC)\r
sca_current_byte (defined in PASS3CMMN.INC)\r
sca_current_bit (defined in PASS3CMMN.INC)\r
-.\r
External Effects:\r
sca_chainhead (defined in PASS3CMMN.INC)\r
sca_end_chain (defined in PASS3CMMN.INC)\r
sca_end_cntxt (defined in PASS3CMMN.INC)\r
sca_current_frgmnt (defined in PASS3CMMN.INC)\r
sca_current_byte (defined in PASS3CMMN.INC)\r
sca_current_bit (defined in PASS3CMMN.INC)\r
-.\r
Comments:\r
-.\r
Outstanding:\r
Only structured values if the value is constant.\r
-.\r
------------------------------------------------------------------------ *)\r
\r
(* $SUBTITLE('------------ PROCEDURE push_struc_value') *)\r
PROCEDURE push_struc_value\r
(\r
total_size: WORD;\r
VAR\r
st_label_addr: st_address;\r
st_typeaddr: st_address;\r
cnst_used: BOOLEAN\r
);\r
\r
VAR\r
st_addr: st_address;\r
st_ptr: st_elemptr;\r
\r
BEGIN\r
\r
st_reserve(total_size, st_addr, st_ptr);\r
\r
st_ptr^.used:= cnst_used;\r
\r
st_declaration(clabel, anonymousname, st_label_addr, st_ptr);\r
\r
IF equal_addr(sca_chainhead, st_stopaddr) THEN\r
sca_chainhead:= st_addr\r
else\r
begin\r
st_get(sca_end_chain, st_ptr);\r
st_ptr^.strucchain:= st_addr;\r
end;\r
\r
sca_end_chain:= st_addr;\r
sca_current_frgmnt:= st_addr;\r
sca_current_byte:= 0;\r
sca_total_bytes:= 0;\r
sca_current_bit:= 0;\r
\r
st_get(sca_current_frgmnt, st_ptr);\r
st_ptr^.st_const_label:= st_label_addr;\r
st_ptr^.typeref:= st_typeaddr;\r
\r
END; (* - PROCEDURE push_struc_value - *)\r
\r
(* $SUBTITLE('------------ PROCEDURE store_const_area') *)\r
PROCEDURE store_const_area(remove:boolean);\r
\r
VAR\r
st_addr: st_address;\r
st_ptr: st_elemptr;\r
\r
BEGIN\r
\r
st_addr:= sca_chainhead;\r
\r
WHILE NOT equal_addr(st_addr, st_stopaddr) DO\r
BEGIN\r
\r
st_get(st_addr, st_ptr);\r
\r
IF st_ptr^.used THEN\r
begin\r
store_code_symbol(cconstdecl, st_addr);\r
st_ptr^.used:= false;\r
end;\r
st_addr:= st_ptr^.strucchain\r
\r
END; (* while *)\r
\r
if remove then\r
begin\r
sca_end_chain:= sca_end_cntxt;\r
if not equal_addr(sca_end_chain, st_stopaddr) then\r
begin\r
st_get(sca_end_chain, st_ptr);\r
st_ptr^.strucchain:= st_stopaddr; (* remove non context constants *)\r
end\r
else\r
sca_chainhead:= st_stopaddr; (* reset strucchain *)\r
end;\r
\r
END (* - PROCEDURE store_const_area - *);\r
\r
(* $SUBTITLE('------------ PROCEDURE sca_fill') *)\r
PROCEDURE sca_fill\r
(\r
src_size: WORD;\r
src: ptr_sca_max_string\r
);\r
\r
VAR\r
src_offset: WORD;\r
st_ptr: st_elemptr;\r
\r
BEGIN\r
\r
src_offset:= 0;\r
\r
st_get(sca_current_frgmnt, st_ptr);\r
\r
while src_size>src_offset do\r
begin\r
\r
src_offset:= src_offset + 1;\r
IF sca_current_byte<st_ptr^.st_size THEN\r
sca_current_byte:= sca_current_byte + 1\r
ELSE\r
BEGIN\r
if equal_addr(st_ptr^.listref, st_stopaddr) then\r
begin\r
errormsg(this_pass, e_too_many_elems);\r
sca_total_bytes:= sca_total_bytes-st_ptr^.st_size;\r
end\r
else\r
sca_current_frgmnt:= st_ptr^.listref;\r
st_get(sca_current_frgmnt, st_ptr);\r
sca_current_byte:= 1;\r
END;\r
\r
st_ptr^.data_area[ sca_current_byte ]:= src^[ src_offset ];\r
\r
end; (* while size>offset *)\r
\r
sca_total_bytes:= sca_total_bytes+src_size;\r
\r
END (* - PROCEDURE sca_fill - *);\r
\r
Procedure sca_Integer(int : LongInt);\r
VAR i : integer;\r
BEGIN\r
  IF Computer = RC3502 THEN\r
    BEGIN\r
      i := int;\r
      i := swap(i);\r
      sca_fill(wordsize, ptr_sca_max_string(@i));\r
    END\r
  ELSE\r
  sca_fill(wordsize, ptr_sca_max_string(@int));\r
END;\r
procedure sca_duplicate_bytes(amount: word);\r
(* duplicate the 'amount' last bytes of current structure *)\r
var\r
step, start_index: word;\r
start_segment: st_address;\r
st_source_ptr,\r
st_dest_ptr: st_elemptr;\r
\r
begin\r
(* general algorithm without optimizations in case of source and destination\r
on same fragment *)\r
\r
(* retrieve source fragment *)\r
if sca_current_byte>=amount then\r
begin\r
start_segment:= sca_current_frgmnt;\r
start_index:= sca_current_byte-amount+1;\r
st_retrieve(start_segment, st_source_ptr);\r
end\r
else\r
begin (* traverse the structure until source fragment is reached *)\r
start_segment:= sca_end_chain; (* start of current structure *)\r
start_index:= sca_total_bytes-amount+1;\r
st_retrieve(start_segment, st_source_ptr);\r
while start_index>st_source_ptr^.st_size do\r
with st_source_ptr^ do\r
begin\r
start_segment:= listref;\r
start_index:= start_index-st_size;\r
st_retrieve(start_segment, st_source_ptr);\r
end;\r
end;\r
st_lock(st_source_ptr);\r
st_get(sca_current_frgmnt, st_dest_ptr);\r
st_lock(st_dest_ptr);\r
for step:= 1 to amount do\r
begin\r
if sca_current_byte<st_dest_ptr^.st_size then\r
sca_current_byte:= sca_current_byte+1\r
else\r
begin\r
st_unlock(st_dest_ptr);\r
if equal_addr(st_dest_ptr^.listref, st_stopaddr) then\r
begin\r
errormsg(this_pass, e_too_many_elems);\r
sca_total_bytes:= sca_total_bytes-st_dest_ptr^.st_size;\r
end\r
else\r
sca_current_frgmnt:= st_dest_ptr^.listref;\r
sca_current_byte:= 1;\r
st_get(sca_current_frgmnt, st_dest_ptr);\r
st_lock(st_dest_ptr);\r
end;\r
\r
st_dest_ptr^.data_area[ sca_current_byte ]:= st_source_ptr^.data_area[ start_index];\r
\r
if start_index<st_source_ptr^.st_size then\r
start_index:= start_index+1\r
else\r
begin\r
st_unlock(st_source_ptr);\r
start_segment:= st_source_ptr^.listref;\r
start_index:= 1;\r
st_get(start_segment, st_source_ptr);\r
st_lock(st_source_ptr);\r
end;\r
end; (* for *)\r
st_unlock(st_dest_ptr);\r
st_unlock(st_source_ptr);\r
sca_total_bytes:= sca_total_bytes+amount;\r
\r
end; (* duplicate_bytes *)\r
\r
procedure sca_copy_structured_constant(const_addr: st_address;\r
                                       elem_size : word);\r
(* insert the denoted constant as the next part of the structure currently\r
being build *)\r
var\r
st_ptr,\r
st_source_ptr: st_elemptr;\r
source_val: byte;\r
step: word;\r
firsttime : boolean;\r
size : word;\r
begin\r
\r
st_get(sca_current_frgmnt, st_ptr); (* destination fragment *)\r
st_lock(st_ptr);\r
firsttime := true;\r
\r
repeat\r
st_retrieve(const_addr, st_source_ptr);\r
size := St_Source_Ptr^.St_Size;\r
\r
If FirstTime THEN\r
  BEGIN\r
    St_RetrieveType(St_Source_Ptr^.TypeRef,St_Source_Ptr);\r
    IF size > St_Source_Ptr^.St_Size THEN\r
      Size := St_Source_Ptr^.St_Size;\r
    FirstTime := false;\r
    st_retrieve(const_addr, st_source_ptr);\r
  END;\r
\r
if size > elem_size THEN\r
  BEGIN\r
    size := elem_size;\r
    elem_size := 0;\r
  END\r
else\r
  elem_size := elem_size - size;\r
\r
st_lock(st_source_ptr);\r
for step:= 1 to size do\r
begin\r
source_val:= st_source_ptr^.data_area[step];\r
\r
IF sca_current_byte<st_ptr^.st_size THEN\r
sca_current_byte:= sca_current_byte + 1\r
ELSE\r
BEGIN\r
if equal_addr(st_ptr^.listref, st_stopaddr) then\r
begin\r
errormsg(this_pass, e_too_many_elems);\r
sca_total_bytes:= sca_total_bytes-st_ptr^.st_size;\r
end\r
else\r
sca_current_frgmnt:= st_ptr^.listref;\r
st_unlock(st_ptr);\r
st_get(sca_current_frgmnt, st_ptr);\r
st_lock(st_ptr);\r
sca_current_byte:= 1;\r
END;\r
\r
st_ptr^.data_area[ sca_current_byte ]:= source_val;\r
\r
end; (* for *)\r
st_unlock(st_source_ptr);\r
sca_total_bytes:= sca_total_bytes+size;\r
const_addr:= st_source_ptr^.listref;\r
\r
until equal_addr(const_addr, st_stopaddr);\r
\r
st_unlock(st_ptr);\r
size := 0;\r
for step := 1 to elem_size do\r
      sca_fill(1, ptr_sca_max_string(@size));\r
\r
end; (* copy structured constant *)\r
\r
procedure sca_put_byte(byte_nr: integer; byte_val: byte);\r
(* inclusive or byte_val with byte number 'byte_nr' in current fragment *)\r
var\r
st_ptr: st_elemptr;\r
begin\r
st_get(sca_end_chain, st_ptr); (* start of current structure *)\r
while byte_nr>st_ptr^.st_size do\r
with st_ptr^ do\r
begin\r
byte_nr:= byte_nr-st_size;\r
st_get(listref, st_ptr);\r
end;\r
with st_ptr^ do\r
data_area[ byte_nr ]:= rtp86_bor(data_area[ byte_nr ], byte_val);\r
end; (* sca put byte *)\r
END\r
.\r
\r
«eof»