begin external routine spec define(string (255) s) external routine spec clear(string (255) s) external routine spec imp80(string (255) s) external routine spec nrstrg(string name s) external integer fn spec exist(string (255) s) external routine spec prompt(string (255) s) integer star hit, k, x string (255) line, aa, bb, rtname, s on event 9 start ; ->eof; finish prompt("Text file to be processed:") cycle nrstrg(s) if exist(s)#0 then exit else start printstring("File:".s." does not exist or no access") newline finish repeat printstring("The file may contain lines * routine ident on next line ** end-of-routine *** end-of-file") newline printstring("Or give name of routine (CR if file contains routine-ident(s))") newline prompt("Name of routine to be created: ") nrstrg(rtname) define("39,".s) define("40,T#TEXT") selectinput(39) selectoutput(40) if rtname#"" start printstring("%routine ".rtname) newline star hit=1 finish else star hit=0 cycle nrstrg(line) if star hit=0 and line#"*" start select output(0) newline printstring( c "Required %external routine name(s) should be preceeded by ""*"", and the file shoul".c "d end with ""**""") newline stop finish star hit=1 ! Fix up single quotes to double if line->aa.("""").bb start k=1 cycle exit if k>length(line) if charno(line, k)='"' start length(line)=length(line)+1 for x=length(line), -1, k+2 cycle charno(line, x)=charno(line, x-1) repeat charno(line, k+1)='"' k=k+1 finish k=k+1 repeat finish if line="*" start nrstrg(line) rtname=line printstring("%routine ".line) newline continue finish if line="**" start newline printstring("%end {".rtname."}") newline rtname="" continue finish if line="***" start printstring("%endoffile") newline exit finish printstring("printstring(""".line." "");") repeat eof: if rtname#"" start newline printstring("%end {".rtname."}") newline finish selectoutput(0) selectinput(0) closestream(39) closestream(40) clear("39,40") printstring("IMP routine in file T#TEXT") newline stop printstring("Source: from ".s." IMP in T#TEXT Object: T#TEXTY") newline imp80("T#TEXT,T#TEXTY") end of program