{#name getarg} procedure getarg(var arg:stringarray); var i:integer; name:stringtype; comline:string[127] absolute $80; function get_name:boolean; begin while (comline[i] =' ') and (i<=length(comline)) do i:=i+1; name:=''; while (comline[i]<>' ') and (i<=length(comline)) do begin name:=name+comline[i]; i:=i+1 end; get_name:=length(name)>0 end; begin i:=1; arg.number:=0; while get_name and (arg.numbername_length then begin writeln(l,': too long name'); error:=true end else s:=l; skip end; begin line:=line+eos; number:=string_.number; i:=1; skip; extract(s); if s='NAME' then command:=namesym else if s='EXTERNAL' then command:=externalsym else if s='SCAN' then command:=scansym else command:=nosym; while line[i]<>eos do begin number:=number+1; if number<=max_name then extract(string_.name[number]) else begin writeln('table overflow'); halt end end; interpret:=command end; {#name set_string} {#external get,interpret} procedure set_string(sym:symbol; var string_:stringarray); var number,pointer:integer; line:linetype; begin string_.number:=0; pointer:=1; while pointer0) and (command=externalsym) then external_.number:=number; if command=namesym then if external_.name[number]=name then index:=pointer else exit:=index>0 end; if index=0 then begin writeln(name,' is not found'); error:=true end end; {#name expand} {#external get_external} {$A-} procedure expand(external_:stringarray; var p:link); var i,index:integer; external_next:stringarray; begin for i:=1 to external_.number do begin get_external(index,external_.name[i],external_next); expand(external_next,p); p:=p^.next; p^.name :=external_.name[i]; p^.index:=index end; new(p^.next) end; {$A+} {#name make_table} {#external expand} procedure make_table(var external_:stringarray); var p:link; begin p:=root; expand(external_,p); p^.next:=nil end; {#name condense} procedure condense; var p,q:link; name:stringtype; begin p:=root; while p^.next<>nil do begin p:=p^.next; name:=p^.name; q:=p; while q^.next<>nil do if q^.next^.name=name then q^.next:=q^.next^.next else q:=q^.next end end; {#name write_lib} {#external interpret} procedure write_lib(var filename,name:stringtype); var find:boolean; s_:stringarray; number:integer; line:linetype; function check:boolean; begin if pos('{#',line)=1 then check:=interpret(line,s_,number)=namesym else check:=false end; begin assign(infile,filename); reset(infile); find:=false; s_.number:=0; while not eof(infile) and not find do begin readln(infile,line); if check then find:=name=s_.name[number] end; while not eof(infile) and find do begin writeln(outfile,line); readln(infile,line); find:=not check end; if find then writeln(outfile,line); close(infile) end; {#name make_library} {#external write_lib} procedure make_library; var p:link; i:integer; begin writeln('making ',outfile_name); assign(outfile,outfile_name); rewrite(outfile); p:=root; while p^.next<>nil do begin p:=p^.next; i:=0; while p^.index>bufindex[i] do i:=i+1; write_lib(scan_.name[i],p^.name) end; close(outfile) end;