⟦27c25e0dd⟧

TextFileVerbose

job jaba 1 600 time 11 0 area 10 perm disc 300 2 temp disc 1000 size 130000
mode list.yes

(platon1pasc = edit platon1pas
if ok.no
finis
i pass1codes
platon1pasc = edit platon1pasc
if ok.no
finis
i xcomplaton
nplat1pasc = edit platon1pasc
if ok.no
finis
clear temp platon1pasc
rename nplat1pasc.platon1pasc
if ok.yes
(tables = set 0
tables = platvalue platontable
i valinsert80
nplat1pasc = edit platon1pasc tables 
if ok.no 
finis
end
clear temp tables platon1pasc
rename nplat1pasc. platon1pasc
)
pascal80 = set 100
scope user pascal80
if ok.no
finis
head cpu
pascal80 = pascal platon1pasc  survey.yes codesize.6000
if ok.no
finis
lookupprog pascal80
if ok.no
finis
c = list complaton count.boss
finis output.no
platon1list = indent platon1pasc mark lc
if ok.no 
finis
clear temp platon1pasc
udlist = cross platon1list
if ok.no
finis
convert udlist
finis

)
m e

; page 1
l./stringmax=100/, r/100/alfalength/,
l./chbufmax=200/, r/200/300/,
l./version='/, d, i/
version = 'pascal80     version 1981.05.14';
pass1_version = 309;
/, p-1,


l./maxnameheads=1000/, r/1000/1500/,




;page 6

l./systemparamno:integer;(*ref/, i/
program_name : alfa; (* name of called program, pascal80 or pascalz80 *)
/,


l./programlist,/, i/
remember_list,           (* remember 'programlist' across std environment *)
/,


l./dimension_count/, i/

current_export_kind : codes; (* the kind of an export object *)

/,


l./lastnamehead,(*last used name head/, l1, i/
alias_name,   (* remember name node for alias name *)
/,





; page 18-19
l./begin(*predef environment/,
l./standardnames('EXCEPTION/, r/;/;

emitcode(cendstandards);
/,



; page 20
l./procedure readcall;/,
l./codesize='codesi/, i/
codelist = 'codelist';
/,
l./includ='incl/, i/
stack_size = 'stack';
pascalz80 = 'pascalz80   ';
z80_lib = 'lib ';
z80_abs = 'abs ';
z80_index = 'index';
z80_short = 'short';
/,
l./a,codefile/, r/name,/name, envfilename,/,
l./param:(list_/, r/)/,
codelist_param, stack_param, index_param, abs_param, lib_param, short_param)/,
l./(*skip name platon/, r/platon/of compiler/,

; page 21
l./end;(*checkcall/, i/
i := system( systemparamno - 1, int, program_name); (* read compiler name *)
if program_name = pascalz80 then
envfilename := 'z80envir' 
else
envfilename := 'platonenv';
/,



l./inputfile:=false;end;/, i/
programlist := remember_list;
/,


l./if a = survey then/, l1, i/
else if a = stack_size then param := stack_param
else if a = codelist then param := codelist_param
else if a = z80_lib then param := lib_param
else if a = z80_abs then param := abs_param
else if a = z80_index then param := index_param
else if a = z80_short then param := short_param
/,

; page 22
l./list_program:iflength/, l./programlist:=a=yes/,
r/programlist:=a=yes/
begin
programlist := a = yes;
remember_list := programlist;
end/,

l./surveyinfo:if length<>10/, d, i/
surveyinfo: begin
/, l./else/, d, l./if(a=yes/, r/(/(length = 10) and ((/, r/no)/no))/,
l./begin/, d 2, i/
int := ord( a = yes );
/,
l./cnocode,1/, r/1/int/,
l./cnocode,1/, r/1/int/,
l./end;/, d, r/a=yes/int >= 1;/,
l./end/, d1, i/
end;
/,


; page 23
l./spacing_param:/, i/
lib_param: (* z80 library information *)
if length <> 10 then error
else
for i := 1 to alfalength div 2 do
begin
emit(coption, 5, 80 + i, cnocode );
emit(cnocode, ord( a [ i * 2 - 1 ] ) * 256 +
              ord( a [ i * 2     ] ), nill, cnocode);
end; (* output lib file name *)


stack_param: (* rc3502 default create size *)
if length <> 4 then error
else (* generate option 5, 10, int  *)
begin
emit( coption, 5, 10, cnocode );
emit( cnocode, int, nill, cnocode );
end;


abs_param: if length <> 10 then error
else
if (a = yes) or (a = no) then
begin
if a = yes then
begin
emit(coption, 6, 8, cnocode); (* for z80 pass6 *)
emit(cnocode, 1, nill, cnocode);
end;
end
else error;


index_param: if length <> 10 then error
else
if (a = yes) or (a = no) then
begin
emit(coption, 4, 9, cnocode); (* for z80 pass4 *)
emit(cnocode, ord( a = yes ), nill, cnocode);
end
else error;


short_param: if length <> 10 then error
else
if (a = yes) or (a = no) then
begin
emit(coption, 5, 11, cnocode); (* for z80 pass5 *)
emit(cnocode, ord( a= yes ), nill, cnocode);
emit(coption, 6, 13, cnocode); (* for lambda pass6 *)
emit(cnocode, ord( a = yes ), nill, cnocode);
end
else error;


codelist_param:
if length <> 10 then error
else
if (a=yes) or (a = no) then
begin
emit( coption, 5, 4, cnocode ); (* generate pass5-comments *)
emit( cnocode, 1 - ord( a = yes ), nill, cnocode );
emit( coption, 6, 1, cnocode ); (* generate code listing in pass6 if yes *)
emit( cnocode, ord( a = yes ), nill, cnocode );
end
else error;


/,

l./'platonenv'/, r/'platonenv'/envfilename/,


l./open(input,source/, i/
if read_env_flag then
programlist := false; (* do not list standard environment *)
/,

; page 24
l./procedure initialize;/,
l./programlist:=false;/, l1, i/
remember_list := programlist;
/,





; page 25
l./before_standard_defs :=true;/, l1, i/

(* ourput version number as option( 0, 1, pass1_version )  *)
emit(coption, 0, 1, cnocode);
emit(cnocode, pass1_version, nill, cnocode);

/,
 
 
l./procedure code(oldtop,newtop/,
l./procedure getstring(sy/,
l./if sy>=0/, i/
str := blank;
/,
l./str[j]:=chbuf/, r/:=/:= convch [/, r/;/ ] ;/,





; page 26
l./function readname:/,
l./:=chbuf[chbufindex];/, r/:=/:= convch [/, r/;/ ] ;/,

l./procedure errorsection;/,
l./procedure literals(/, i/
\f


procedure export_section;
(* section 3 *)

var
length : integer;
str : string; (* pack the export kind into str *)

begin

case prod of

301:  (* <export def> ::= <export name> = <export kind> <simple variable>
                          <semicolons>                                     *)
(*  code: export(kind)  *)
emitcode( current_export_kind );

302:  (* <export kind> ::= name *)
(* code: export  *)
(* action : remember the kind *)
begin

emitcode( cexport );

getstring ( 1, 1, str, length );

if str = 'VALUE' then current_export_kind := cexportvalue
else
if str = 'DISP' then current_export_kind := cexportdisp
else
if str = 'SIZE' then current_export_kind := cexportsize
else
if str = 'ADDRESS' then current_export_kind := cexportaddr
else
if str = 'OFFSET' then current_export_kind := cexportoffset
else
begin
markerror( 104 ); (* export kind expected (value, disp, size, address, or offset )  *)
current_export_kind := cexportsize;
end;

end; (* 302 *)

end; (* case *)

end; (* export section *)

\f


/,


l./procedure literals(/, r/;convert:boolean//,



l./404:/,
l./end;(*case/, i/

405:  (* <export name> ::= name  *)
codekind := ctext;
/,


l./if(convert or(/, d, i/
if (prod = 404) and ((ord_char >= ord('A')) and (ord_char <= ord(']'))) then
/,



; page 29
l./procedure typedefinition;/,

; page 30
l./609:/, d./end;/, i/

609:  (* <type> ::= <external type> <type>   *)
(* code: endexttype  *)
codeword := cendexttype;
/,

l./610:(*<record type/, 
l1, r/endlevel //,
l./emitcode(cendlevel/, d,


; page 31
l./end;(*case 601../, i/

615:  (* <array type> ::= <array start> <type> <component type>  *)
(* code: endarray  *)
begin
for stepvar := 1 to dimension_count do
emitcode(cendarray);
codeword := cendarray;
end;
/,


l./(prod<=608/, r/=608/ 610/,


l./624:(*<record>/,
l1, r/beginlevel //,


; page 32
l./626:/, 
l./end;(*case/, i/

627:  (* <external type> ::= external  *)
(* code: newtype exttype  *)
codeword := cexttype;
/,


l./end(*start scalar/, r/end/end;/,
l./else if(*record*)prod=624/, d,


; page 33
l./633:(*<name colon/, d./searchname(name));end;/,




; page 37
l./816:(*<term>::=<term/, i/

815:  (* <simple expression> ::= <simple expression> xor <term> *)
(* code: xor *)
codeword1 := cxor;
/,






; page 44
l./948:(*<channel do>/, i/

943:  (* <with variable> ::= <variable> <as> <local name>  *)
(* code: nolocaltype  *)
codeword := cnolocaltype;
/,




; page 46
l./procedure emitroutinedecl/,
l./literals(401/ , r/,true(*covnert to small letters*)//,

l./1002:/, i/
1001:  (* <spix name> ::= name   *)
(* action: pick up name and remember name head in   alias name     *)
alias_name := readname;

/,

l./1006:(*/, i/

1004:  (* <procedure name> ::= <spix name> = name *)
(* code: declaration declare,    nb: name literal is name but spix is
from  spix name  !!  *)
emitroutinedecl( cprocedure, alias_name );
/,

; page 47
l./(*<actual parameter> ::=<namecolon><type>*)/, d./type specification*)/,

l./1009:(*<declarations>/, r/decl start/begin level/,
l./1010:/, r/decl start/begin level/,





; page49
l./procedure functiondeclaration/,
l./end;(*case/, i/
1103:  (* <function name> ::= <spix name> = name   *)
(* code: declaration declare,  nb: the literal is  name but the
spix is that of spix name  !! *)
emitroutinedecl( cfunction, alias_name );

/,


; page 51
l./procedure processdeclaration/,
l./1303:(*/, r/process declaration/body list/,
l1, d,

; page 52
l./1307:(*<prefix/, r/<declarations/
<begin level> <routine declaration/,

l./code:endprefix/, r/code:/code: endlevel/,
l./emitcode(cendprefix/, r/code(/(cendlevel, nill, nill, /,


l./1311:/, l./code:endinclude beginlevel/, r/beginlevel//,
l./emit(cendinclude,/, d, i/
emitcode( cendinclude );
/,




l./end;(*case*)/, i/

1312:  (* <body elem> ::= <begin level> <process declaration>  *)
       (*               ! <begin level> <prefix declaration >  *)
       (*               ! <begin level> <process declaration> <semicolons> *)
       (*               ! <begin level> <prefix declaration> <semicolons> *)
(* code: endlevel *)
emitcode(cendlevel);
/,




; page 53
l./begin(*code*)/,
l./2,3:;/, d, i/

2 : ; (* not used *)

3: export_section;
/,



l./literals(prod/, r/,false(*do not convert literals to small letters*)//,


; page 54
l./procedure parser;/,
l./symbmax=223/, r/223/232/,
l./prodmax/, r/278/293/,
l./lrmax=1077/, r/1077/1131/,
l./lxmax=185/, r/185/186/,
l./combegin/, r/77/78/,



; page 59
l./procedure skipcomment/,
l./optvalue:=0;/, l1, r/100)/10000 )/,



; page 60
l./if passnr=1 thenbegincaseoptnrof/, l./1:/,
r/:/: begin
/, l./programlist:=/, r/;/;
remember_list := programlist;
end;/,



; page 66
l./procedure special_code(oldtop,newtop/,
l./code:.literal/, l./endcode/,r/code/code
.     endlevel/,

; page 67
l./emitcode(cendcode);/,
r/)/, nill, nill, cendlevel)/,
r/code//,




; page 72
l./close(spixtable)/, i/
if nametable_dump then
for i := 0 to hashtablesize do
begin
linenumber := 0;
lastnamehead := namehashtable [ i ];
writeln(spixtable,  nl, ' entry number ', i : 1 , nl );
while lastnamehead <> nill do
with nameheads [ lastnamehead ] do
begin
linenumber := linenumber + 1;
writeln(spixtable,linenumber, spix, namenodes [ start ] . namepart : 14 );
lastnamehead := next;
end; (* with *)
end; (* for ... *)

/,


f
«eof»
DataMuseum.dk

RC3500

⟦27c25e0dd⟧ TextFileVerbose

Derivation

TextFileVerbose
