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

⟦7a0b92dba⟧ TextFile

    Length: 8523 (0x214b)
    Types: TextFile
    Names: »RTP.PAS«

Derivation

└─⟦a2a9e188c⟧ Bits:30010526 DVBS1.SW2114.src.2.6-4 RTP Compiler Source SW2104+SW2114 Disk 1 92.02.03 HEJ HHA
    └─⟦this⟧ »RTP\RTP.PAS« 
└─⟦fd2665794⟧ Bits:30010523 DVBS1.SW2114.src.2.6-1 RTP compiler source SW2104+SW2114 Disk#1 30/1-92 HHA
    └─⟦this⟧ »RTP\RTP.PAS«

TextFile

(*$M 12000,1000,600000*)\r
program rtp;\r
{$F+}\r
  (***********************************************************************)\r
  (*  version  date     author  changes                                  *)\r
  (*  3.0      89.04.01 hha     first rel in turbo                       *)\r
  (*  3.1      89.06.14 hha     open files as read only                  *)\r
  (*  4.0      89.08.01 hha     common lang.                             *)\r
  (* ------------------------------------------------------------------- *)\r
  (*  2.5      91.03.26 ebk     Newid for Transputers changed            *)\r
  (*                            from T414 to T414,T425,T800              *)\r
  (*                            Codeoutputfile has extension TAH         *)\r
  (*  2.6      91.12.01 hha     Error in pass2 in connection with forward*)\r
  (*                            and local reference                      *)\r
  (*                            Error in the codegeneration for target = *)\r
  (*                            RC3502 when using empty case statement   *)\r
  (*                            Error in the linetable when more then one*)\r
  (*                            routine (target = rc3502)                *)\r
  (*                            dopevector for alfa only dump when used  *)\r
  (*                            as open familiy type                     *)\r
  (*                            Error in the codegeneration for target = *)\r
  (*                            rc5000 when using packed fields as value *)\r
  (*                            parameter                                *)\r
  (*                            New switches and new values for switches *)\r
  (***********************************************************************)\r
\r
uses overlay, pscplm, files, mpaunit, rtp86mpa, rtp86p0, rtp86p1\r
    ,rtp86p2,rtp86p3\r
{$IFNDEF NOPASS4}\r
    ,rtp86p4\r
{$IFNDEF RTP86}\r
    ,rtp35p4,rtp50p4\r
{$ENDIF}\r
{$ENDIF}\r
{$IFDEF P4_3502}\r
   ,rtp35p4\r
{$ENDIF}\r
   ,list;\r
{$O rtp86p0}\r
{$O rtp86p1}\r
{$O rtp86p2}\r
{$O rtp86p3}\r
{$O list}\r
\r
{$O p1code}\r
{$O sthp2}\r
{$O sthp1}\r
{$O p2code}\r
\r
{$IFDEF NOPASS4}\r
{$O vmmunit}\r
{$O nthunit}\r
{$O sthint}\r
{$O sthcom}\r
{$O mpaunit}\r
{$O rtp86mpa}\r
{$O rtp86rmx}\r
{$O files}\r
{$O vmmdump}\r
\r
{$ENDIF}\r
(**)\r
{$O sthp34}\r
{$O rule066}\r
{$O rule010}\r
{$O rule018}\r
{$O rule004}\r
{$O rule005}\r
{$O rule008}\r
{$O rule015}\r
{$O rule016}\r
{$O rule037}\r
{$O rule077}\r
{$O rule078}\r
{$O p3rw}\r
{$O p3addr}\r
{$O p3math}\r
\r
{$IFNDEF NOPASS4}\r
{$O rtp86p4}\r
{$O p4code}\r
{$O p4evalst}\r
{$O p4}\r
{$O p486bool}\r
{$O p4regadm}\r
{$O p486stat}\r
{$O p4estopr}\r
\r
{$IFNDEF RTP86}\r
{$O rtp50p4}\r
{$O p450code}\r
{$O p450bool}\r
{$O p450stat}\r
{$O p450eopr}\r
\r
{$O rtp35p4}\r
{$O p435bool}\r
{$O p435eopr}\r
{$O p435stat}\r
{$O p435code}\r
{$ENDIF}\r
{$ENDIF}\r
\r
{$IFDEF P4_3502}\r
{$O p4evalst}\r
{$O p435bool}\r
{$O p435eopr}\r
{$O rtp35p4}\r
{$O p435stat}\r
{$O p435code}\r
{$ENDIF}\r
\r
\r
\r
procedure testmempool(testwh: boolean);\r
begin\r
  writeln;\r
  writeln(' Memory: ', memavail, ' Max: ', maxavail);\r
  writeln;\r
end; (** testmempool **)\r
VAR exitsave : pointer;\r
procedure myexit;\r
begin\r
\r
exitproc := exitsave;\r
if exitcode > 1 then\r
  fatal_error(systemq,exitcode);\r
\r
\r
end;\r
\r
\r
begin (*main program *)\r
\r
exitsave := exitproc;\r
exitproc := @ myexit;\r
startmemavail := memavail;\r
filemode := 0;\r
init_files;\r
\r
(*** initialize versions number **)\r
releaseno := 2;\r
versionno := 6;\r
versionsid := 'REL 2.6 ';\r
(*#BEGINTEST\r
versionsid := 'REL 3.1s';\r
(*ENDTEST#*)\r
{$IFDEF rtp86}\r
writeln(' Real Time Pascal-86 DOS, ',versionsid);\r
{$ELSE}\r
writeln(' Real Time Pascal, ',versionsid);\r
{$ENDIF}\r
(*** INITIALIZATION OF GLOBAL OPTIONS ***)\r
active_module := pass1; (*option start pass1*)\r
stop_module := pass4;   (*option stop pass4 *)\r
sourcenumber := 0;  (* no soucefile read yet *)\r
linenumber := 0;\r
elementnumber := noelement;\r
elementspix := anonymousspix;\r
test_on_co := false;\r
make_segmentation := false;\r
last_segment:= 1;\r
segment_info[1].spix:=0;\r
segment_info[1].list:=nil;\r
segment_info[1].no_of_symbol:=0;\r
make_code:=false;\r
make_set:=false;\r
mpatest := false;\r
open_errtxts := false;\r
open_parsetables := false;\r
open_openroutine := false;\r
open_comm := false;\r
open_listfile := false;\r
open_tbinfile := false;\r
open_codelist := false;\r
open_tsymfile := false;\r
open_errorfile := false;\r
fatal := false;\r
error := false;\r
warn := false;\r
firstcall_closep := false;\r
call_listh := false;\r
exit_before:=false;\r
testmemwholes := false;\r
timetest := true;\r
\r
switchcall:=nil;\r
\r
open_errortextfile;\r
\r
\r
\r
write('PARSE');\r
break_line:=false;\r
\r
\r
last_time:=0;\r
time_used:= find_time_used; (* init last_time and update current_time *)\r
starttimelow:= 0; (*current_time.system_time.word1;*)\r
starttimehigh:=0; (*current_time.system_time.word2;    *)\r
checktimelow:=0;\r
checktimehigh:=0;\r
\r
\r
(*load_overlay(pass0);\r
\r
!!! TURBO !!!\r
*)\r
         rtp86pass0;\r
\r
firstcall_closep:=true;\r
if call_options.loadcode<=1 then\r
callparams[1].filename:=call_options.loadstr;\r
\r
switchcall:=switchstart;\r
switchpoint:=switchstart;\r
while switchpoint<>nil do\r
begin\r
switchpoint^.call_value:=switchpoint^.value;\r
switchpoint:=switchpoint^.next;\r
end;\r
\r
\r
open_workfiles;\r
\r
(*#BEGINTEST - ??? overlever switches PASS0 ??\r
if mpatest then\r
test_switches;\r
(*ENDTEST#*)\r
\r
if mempooltest then\r
testmempool(testmemwholes);\r
\r
\r
if active_module>pass1 then begin\r
if not break_line then write(', ');\r
call_options.listing:=1; (* no list *)\r
survival[co1]:=true;\r
if active_module>pass2 then begin\r
survival[co2]:=true;\r
if active_module>pass3 then survival[co3]:=true;\r
end;\r
end;\r
\r
while (active_module <= stop_module) and not error do\r
begin\r
\r
open_files(active_module);\r
(* !!! TURBO !!! load_overlay(active_module);*)\r
\r
if original_testvmm >= 0 then testvmm := 0 else testvmm:= -1;\r
teststh := false;\r
testvmmupdate := false;\r
teststhsearch:= false;\r
\r
sourcenumber := 0;\r
\r
errorno := 0;\r
error := false;\r
warningno := 0;\r
warn   := false;\r
linenumber := 0;\r
elementnumber := noelement;\r
elementspix := anonymousspix;\r
\r
\r
case active_module of\r
\r
pass1: begin\r
\r
\r
if mempooltest then\r
testmempool(testmemwholes);\r
\r
if call_options.loadcode<=1 then\r
sourcenumber:=1; (* skip load environment *)\r
\r
call_listh:=true;\r
\r
rtp86pass1;\r
\r
if mempooltest then\r
testmempool(testmemwholes);\r
\r
if break_line then begin write('END PARSE'); break_line:=false; end;\r
write('(',errorno,'), ');\r
close(parsetables);\r
open_parsetables:= false;\r
end;\r
\r
pass2: begin\r
write('ANALYZE');\r
break_line:=false;\r
\r
if mempooltest then\r
testmempool(testmemwholes);\r
\r
if call_options.loadcode<=1 then\r
sourcenumber:=1; (* skip load environment *)\r
\r
rtp86pass2;\r
\r
if mempooltest then\r
testmempool(testmemwholes);\r
\r
if break_line then begin write('END ANALYZE'); break_line:=false; end;\r
write('(',errorno,'), ');\r
close(comm);\r
open_comm:= false;\r
end;\r
\r
pass3: begin\r
write('ALLOCATE');\r
break_line:=false;\r
\r
if mempooltest then\r
testmempool(testmemwholes);\r
rtp86pass3;\r
\r
if mempooltest then\r
testmempool(testmemwholes);\r
if break_line then begin write('END ALLOCATE'); break_line:=false; end;\r
write('(',errorno,'), ');\r
end;\r
\r
pass4: begin\r
write('OBJECT');\r
break_line:=false;\r
\r
if mempooltest then\r
testmempool(testmemwholes);\r
{$IFNDEF NOPASS4}\r
case computer of\r
RC5000 :\r
{$IFNDEF RTP86}\r
rtp50pass4\r
{$ENDIF}\r
;\r
RC3502 :\r
{$IFNDEF RTP86}\r
rtp35pass4\r
{$ENDIF}\r
;\r
else     rtp86pass4;\r
end;\r
{$ENDIF}\r
{$IFDEF P4_3502}\r
rtp35pass4;\r
{$ENDIF}\r
\r
if mempooltest then\r
testmempool(testmemwholes);\r
if break_line then begin write('END OBJECT'); break_line:=false; end;\r
write('(',errorno,'), ');\r
\r
close(tbinfile);\r
open_tbinfile:= false;\r
if open_tsymfile then\r
begin\r
  close(tsymfile);\r
  open_tsymfile:=false;\r
end;\r
\r
end\r
\r
else (*otherwise*);\r
end;\r
if call_options.saveafter[active_module] then\r
save_specs( false );\r
\r
while switchstart<>switchcall do\r
begin\r
  switchpoint:=switchstart;\r
  switchstart:=switchstart^.next;\r
  dispose(switchpoint);\r
end;\r
switchpoint:=switchstart;\r
while switchpoint<>nil do\r
begin\r
  switchpoint^.value:=switchpoint^.call_value;\r
  switchpoint:=switchpoint^.next;\r
end;\r
\r
if timetest then\r
begin\r
time_used := find_time_used;\r
writeln;\r
writeln(' pass',ord(active_module) : 1, ':',time_used : 6, ' sec.');\r
end;\r
\r
active_module :=succ( active_module);\r
end;\r
\r
\r
(*9999:*) if exit_before then halt(1) (* !!! TURBO !!! goto 8888 *)\r
else exit_before:=true;\r
\r
StartListhand;\r
\r
(*8888: ; (*** exit point in case of error in compilercall- ***)\r
\r
end\r
.\r
«eof»