! Some *very* crude substitutes for missing library procedures
const string (1) snl = "
"
external string (30) fn imp11version
result = "VGT"
end
!%externalintegerfn shortinteger(%integer addr) ;! for testing with old compiler that doesn't support shortintegers
! %integer si
! si = integer(addr) & 16_ffff
! %if (si & 16_8000 # 0) %then si = si ! 16_ffff0000
! %result = si
!%end
include "cliparam.inc"
external routine print ch(integer n)
print symbol(n)
end
external routine read ch(integer name ch)
read symbol(ch)
end
external routine p octal(integer n)
print symbol(((n>>15) & 1) + '0')
print symbol(((n>>12) & 7) + '0')
print symbol(((n>>9) & 7) + '0')
print symbol(((n>>6) & 7) + '0')
print symbol(((n>>3) & 7) + '0')
print symbol(( n & 7) + '0')
end
external routine move alias "S#MOVE"(integer length,from,to)
integer i
! presumably a safe move is wanted
if to+length > from+length start
for i = length-1, -1, 0 cycle
byte integer(to + i) = byte integer(from + i)
repeat
else if to < from
for i = 0, 1, length-1 cycle
byte integer(to + i) = byte integer(from + i)
repeat
finish
end
external integerfn i mod(integer n)
result = -n if n < 0
result = n
end
externalroutine close stream(integer stream)
integer cur stream = input stream
select input(stream)
close input
if stream = cur stream then select input(0) else select input(cur stream)
end
include "endofinput.inc"
external predicate exists alias "S#EXIST" (string(255) filename)
integer prev
on event 9 start
print string(" - no".snl)
false
finish
print string("Does ".filename." exist?")
prev = input stream
open input(3, filename)
select input(3)
print string(" - no".snl) and c
false if end of input
close input
select input(prev)
print string(" - yes".snl)
true
end
external string (255) fn Date
result = "00/00/00"
end
external string (255) fn Time
result = "00:00:00"
end
external integerfn cpu time alias "S#CPUTIME"
own integer now = 1234
now = now + 123
result = now
end
external integer map comreg alias "S#COMREGMAP"(integer n)
own integer saved46 = 0
print string("Accessing COMREG(" . i to s(n,0) . ")" . tostring(nl)) if n # 46
result == saved46
end
external integer spec LIST
systemintegerfnspec mmap alias "mmap"(integer addrptr, integer length, integer prot, integer flags, integer fd, integer offset)
systemintegerfnspec open alias "open" (integer stringaddr, integer option, integer mode)
externalintegerfnspec errno alias "get_c_errno"
externalstring(255)fn ssfmessage
string(255) mess
systemintegerfnspec strerror alias "strerror" (integer errnum); !char *strerror(int errnum)
systemintegerfnspec strlen alias "strlen" (integer strad)
integer i, address, len
address = strerror(errno)
len = strlen(address)
charno(mess, i) = byteinteger(address+i-1) for i = 1,1,len
length(mess) = len
result = mess
end
externalroutine ssmess(integer errno)
string(255) mess
systemintegerfnspec strerror alias "strerror" (integer errnum); !char *strerror(int errnum)
systemintegerfnspec strlen alias "strlen" (integer strad)
integer i, address, len
address = strerror(errno)
len = strlen(address)
charno(mess, i) = byteinteger(address+i-1) for i = 1,1,len
length(mess) = len
printstring(mess)
end
systemintegerfnspec lseek alias "lseek" (integer fd, integer offset, integer whence)
record format rfm(integer conad,filetype,datastart,dataend,a,b,c,d)
constinteger O RDONLY = 0
constinteger SEEK END = 2
constinteger SEEK SET = 0
constinteger PROT READ = 1
constinteger MAP PRIVATE = 2
external routine connect alias "S#OLDCONNECT"(string (255) file,
integer mode,hole,prot, record (rfm) name r, integer name flag)
integer fd, flen, ignore
string (255) filename = file ; ! guarantee a writable copy
CHARNO(filename, LENGTH(filename)+1) = 0 ; ! nul-terminated C string
if 0=1 start
! confirmed that we're passing the right file name.
integer i
i = ADDR(filename)+1
cycle
integer c = byteinteger(i)
i = i+1
if 33 <= i <= 126 then printsymbol(c) elsestart
printsymbol('[');write(c,0);printsymbol(']')
finish
exit if c = 0
repeat
newline
finish
fd = open(0, O RDONLY, ADDR(filename)+1)
if fd = -1 start
flag = errno
print string("Open ".file." failed: ".ssfmessage." - ") ; write(errno,0) ; newline
return
finish
flen = lseek(fd, 0, SEEK END)
ignore = lseek(fd, 0, SEEK SET)
r_conad = mmap(0, flen, PROT READ, MAP PRIVATE, fd, 0)
r_filetype = 3 ; ! text file
! r_datastart = r_conad ;
! r_dataend = r_conad+flen ;
! r_a = ... ;
! r_b = ... ;
! r_c = ... ;
! r_d = ... ;
flag = 0 ; ! non-zero is an error
end
{%external %routine imp11(%string (255) s)
begin
string (255) s = get arg(1)
external string (6) fn spec imp11host
! %extrinsic %integer shortjumps
! %extrinsic %integer mediumjumps
! %extrinsic %integer longjumps
! %extrinsic %real stretchtime
owninteger shortjumps,mediumjumps,longjumps,stretchtime
external integer permad
! {%extrinsic}%external %integer LIST
! %external %routine %spec timeio(%string (63) file)
{X %external %string (255) %function %spec date %alias "S#DATE"
{X %external %string (255) %function %spec time %alias "S#TIME"
{X %external %long %real %function %spec cpu time %alias "S#CPUTIME"
own integer exclam= 0, info2, info3
string (63) source,object,listing,grot,x1,x2
integer flag,stats
real t0,t1,t2,t3
{X %external %integer %map %spec comreg %alias "S#COMREGMAP"(%integer n)
{X %record %format rfm(%integer conad,filetype,datastart,dataend,a,b,c,d)
external routine spec connect alias "S#OLDCONNECT"(string (255) file,
integer mode,hole,prot, record (rfm) name r, integer name flag)
string (31) ss
record (rfm) r
{X %routine define(%string (255) s)
{X %external %routine %spec emas3(%string (255) %name command,params,
{X %integer %name flag)
{X %integer flag
{X emas3("DEFINE",s,flag)
{X %end; ! Of %routine define.
{X %external %integer %function %spec exist %alias "S#EXIST"(%string %c
{X (255) file)
external routine spec destroy alias "S#DESTROY"(string (255) file,
integer name flag)
external integer fn spec pass1
external routine spec pass2
external routine spec pass3
own integer uselimit=1000, envirs=7, arrayopt=1
own integer noremember=0,nocc=0,noparams=0,nosame=0, nostatic=0
routine show date
{X %const %string (3) %array month(1:12)= "JAN", "FEB", "MAR", "APR",
const string (3) array month(0:12)= "00", "JAN", "FEB", "MAR", "APR",
"MAY", "JUN", "JUL", "AUG",
"SEP", "OCT", "NOV", "DEC"
integer n
string (15) dat,day,mon,year , TEMP
dat = date
{X dat -> day.("/").mon.("/").year
day="00" and mon="00" and year="00" unless dat -> day.("/").TEMP and TEMP -> mon.("/").year
n = (charno(mon,1)-'0')*10+charno(mon,2)-'0'
printstring(day."-".month(n)."-19".year)
end
routine try(integer name flag, string (15) key, integer value)
if grot->x1.(key).x2 start
flag = flag!value
printstring(key." set"); newline
finish
end
info2 = 0; info3 = 0
if s->source.("!").grot start
exclam = 1
try(info3,"NOSHORT",1)
try(info3,"NOROUND",2)
try(info3,"NODEFER",4)
try(info3,"NOENTRY",8)
uselimit = charno(x2,1)-'0' if grot->x1.("USE=").x2
envirs = charno(x2,1)-'0' if grot->x1.("ENVIR=").x2
try(noremember,"NOREMEMBER",1)
array opt = 0
try(array opt,"NOARRAY",1)
array opt = array opt!!1
try(nocc,"NOCC",1)
try(nosame,"NOSAME",1)
try(noparams,"NOPARAMS",1)
try(nostatic,"NOSTATIC",1)
finish
object = ""; listing = ""
source = s
{X %if s->source.("/").s %or s->source.(",").s %start
if s->source.("/").grot or s->source.(",").grot start
s=grot
object = s unless s->object.(",").listing
finish
{X s = source %unless source->s.("#").grot
s = source unless source->s.(".").grot
{X object = s."#REL" %if object=""
object = s.".rel" if object=""
{X listing = ".NULL" %if listing="" %or listing=".N"
listing = "/dev/null" if listing="" or listing=".N" or listing=".n"
s = source
{X %if exist(s)=0 %start
unless exists(s) start
{X s = s."#IMP"
s = s.".imp"
{X %if exist(s)=0 %start
unless exists(s) start
printstring(s." does not exist")
newline
return
finish
finish
source = s
ss = source
printstring("About to connect file ".ss.snl)
l1:connect(ss,0,0,0,r,flag)
if flag#0 start
printstring("
cannot connect ".ss."
")
return
finish
if r_filetype#3 start
printstring("
".ss." is not a character file
")
return
finish
printstring("About to examine prims".snl)
{X %if ss=source %then comreg(46) = r_conad %and ss = imp11host.":IMP11PRIMS" %and ->l1
if ss=source then comreg(46) = r_conad and ss = "prims.inc" and ->l1
permad = r_conad
{X define("ST4,".listing)
{X open output(4, listing)
if listing=".NULL" or listing="/dev/null" or listing=".N" or listing=".n" then open output(4, "/dev/null") else open output(4, listing)
{X LIST = 10000 %if listing=".NULL"
LIST = 10000 if listing=".NULL" or listing="/dev/null" or listing=".N" or listing=".n"
if LIST<=1 start
select output(4)
printstring("Source file: ".source)
printstring(" Compiled: ")
show date
spaces(2)
printstring(time)
newline
printstring("Object file: ".object)
newlines(2)
finish
t1 = cputime
stats = pass1
t1 = cputime-t1
selectoutput(0)
if stats>0 start
write(stats,4)
printstring(" statements compiled"); newline
->avoid if object=".NULL"
selectinput(0)
close stream(1)
close stream(4)
p2:
{X define("ST2,SS#IMP77O")
open output(2, "/tmp/imp77.o")
{X define("ST3,SS#IMP77D")
open output(3, "/tmp/imp77.d")
{X define("ST4,.OUT")
open output(4, "/dev/stdout")
t2 = cputime
pass2
t2 = cputime-t2
selectoutput(0)
close stream(2); close stream(3)
{X define("ST1,SS#IMP77O")
open input(1, "/tmp/imp77.o")
{X define("ST2,SS#IMP77D")
open input(2, "/tmp/imp77.d")
{X define("ST3,".object)
open output(3, object)
t3 = cputime
pass3
t3 = cputime-t3
avoid:
finish else start
printstring("Program contains"); write(-stats,1)
printstring(" fault")
printsymbol('s') unless stats=-1
finish
newline
select input(0); selectoutput(0)
close stream(1); closestream(2); closestream(3); closestream(4)
->closef if exclam=0 or stats<0
write(shortjumps,1); printstring(" short,")
write(mediumjumps,1); printstring(" medium, and")
write(longjumps,1); printstring(" long jumps")
newline
print real(stretch time,2,4); printstring(" seconds in STRETCH")
newline
return if t1<=0 or t2<=0 or t3<=0
t0 = t1+t2+t3
printstring("Pass1 time ="); print real(t1,2,4); printstring(" sec")
newline
printstring("Pass2 time ="); print real(t2,2,4); printstring(" sec")
newline
printstring("Pass3 time ="); print real(t3,2,4); printstring(" sec")
newline
printstring("Total time ="); print real(t1+t2+t3,2,4); printstring(" sec")
newline
stats = stats*60
write(int(stats/t1),1)
printstring(" &")
write(int(stats/t2),1)
printstring(" &")
write(int(stats/t3),1)
printstring(": ")
write(int(stats/t0),1)
printstring(" statements per minute")
newline
! timeio(source)
! timeio("IMP#INT")
! timeio("SS#IMP77O")
! timeio("SS#IMP77D")
! timeio(object)
closef:
{X %unless comreg(27)&(1<<18)#0 %start
{X destroy("SS#IMP77O",flag)
{X destroy("SS#IMP77D",flag)
{X destroy("IMP#INT",flag)
{X %finish
{%end
{%end %of %file
endofprogram