!***********************************************************************
!*
!* BCPL compiler steering routines
!*
!* Version E1.11
!*
!* Copyright R.D. Eager University of Kent MCMLXXXIV
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* External references
!*
!***********************************************************************
!
externalroutine compile(string(255) s,string(32) entry, integername flag)
end
externalintegermap comreg(integer n)
owninteger i
result == i
end
externalstring(255)function failuremessage(integer mess)
result = "FAILURE: ".itos(mess, 0)
end
externalintegerfunction return code
result = 0
end
externalroutine setfname(string(40) file)
end
!
externalintegerfunction icl9cezbcplx(string(255) parms)
result = 0
end
!
!
!***********************************************************************
!*
!* S H U F F L E
!*
!* This routine:
!* a) Moves any keyword parameters out of the first four parameter
!* positions
!* b) Puts the first four parameters into CPARMS (for COMPILE)
!* c) Puts the rest of the parameters into S (for passing over
!* via COMREG(9))
!*
!***********************************************************************
!
routine shuffle(string(*)name s,cparms)
integer i
string(255) work1,work2
string(255)array p(1:4)
!
if s = "?" then start; ! Handle this specially
cparms = ".IN,.NULL,.NULL,.NULL"; ! Never used really
else
for i = 1,1,4 cycle
p(i) = ""; ! Initialise
repeat
!
s <- s.","
for i = 1,1,4 cycle
exit unless s -> p(i).(",").s
repeat
!
cycle i = 1,1,4
if p(i) -> work1.("=").work2 then start
s = p(i).",".s
p(i) = ""
finish
repeat
!
cparms = p(1).",".p(2).",".p(3).",".p(4)
finish
end; ! of shuffle
!
!
!***********************************************************************
!*
!* B C P L
!*
!***********************************************************************
!
externalroutine bcpl(string(255) parms)
integer flag
string(255) cparms,auxparms
!
setfname("")
shuffle(parms,cparms)
auxparms = parms; ! Make copy, to ensure string is word-aligned
comreg(9) = addr(auxparms); ! Picked up by compiler
!
compile(cparms,"ICL9CEZBCPL1",flag)
flag = return code
flag = 0 if flag = -1; ! INT:A
if 0 # flag < 1000 then start
newline
printstring("BCPL fails -".failuremessage(flag))
finish
end; ! of bcpl
!
!
!***********************************************************************
!*
!* B C P L C G E N
!*
!***********************************************************************
!
externalroutine bcplcgen(string(255) parms)
integer flag
string(255) cparms,auxparms
!
setfname("")
shuffle(parms,cparms)
auxparms = parms; ! Make copy, to ensure string is word-aligned
comreg(9) = addr(auxparms); ! Picked up by codegenerator
!
compile(cparms,"ICL9CEZBCPL2",flag)
flag = return code
flag = 0 if flag = -1; ! INT:A
if 0 # flag < 1000 then start
newline
printstring("BCPLCGEN fails -".failuremessage(flag))
finish
end; ! of bcplcgen
!
!
!***********************************************************************
!*
!* B C P L V
!*
!***********************************************************************
!
externalroutine bcplv(string(255) parms)
integer flag
string(255) cparms,auxparms
!
setfname("")
shuffle(parms,cparms)
auxparms = parms; ! Make copy, to ensure string is word-aligned
comreg(9) = addr(auxparms); ! Picked up by codegenerator
!
compile(cparms,"ICL9CEZBCPLV",flag)
flag = return code
flag = 0 if flag = -1; ! INT:A
if 0 # flag < 1000 then start
newline
printstring("BCPLV fails -".failuremessage(flag))
finish
end; ! of bcplv
!
!
!***********************************************************************
!*
!* B C P L W
!*
!***********************************************************************
!
externalroutine bcplw(string(255) parms)
integer flag
string(255) cparms,auxparms
!
setfname("")
shuffle(parms,cparms)
auxparms = parms; ! Make copy, to ensure string is word-aligned
comreg(9) = addr(auxparms); ! Picked up by codegenerator
!
compile(cparms,"ICL9CEZBCPLW",flag)
flag = return code
flag = 0 if flag = -1; ! INT:A
if 0 # flag < 1000 then start
newline
printstring("BCPLW fails -".failuremessage(flag))
finish
end; ! of bcplw
!
!
!***********************************************************************
!*
!* B C P L Z
!*
!***********************************************************************
!
externalroutine bcplz(string(255) parms)
integer flag
string(255) cparms,auxparms
!
setfname("")
shuffle(parms,cparms)
auxparms = parms; ! Make copy, to ensure string is word-aligned
comreg(9) = addr(auxparms); ! Picked up by codegenerator
!
compile(cparms,"ICL9CEZBCPLZ",flag)
flag = return code
flag = 0 if flag = -1; ! INT:A
if 0 # flag < 1000 then start
newline
printstring("BCPLZ fails -".failuremessage(flag))
finish
end; ! of bcplz
!
!
!***********************************************************************
!*
!* B C P L R
!*
!***********************************************************************
!
externalroutine bcplr(string(255) parms)
integer flag
string(255) cparms,auxparms
!
setfname("")
shuffle(parms,cparms)
auxparms = parms; ! Make copy, to ensure string is word-aligned
comreg(9) = addr(auxparms); ! Picked up by codegenerator
!
compile(cparms,"ICL9CEZBCPLR",flag)
flag = return code
flag = 0 if flag = -1; ! INT:A
if 0 # flag < 1000 then start
newline
printstring("BCPLR fails -".failuremessage(flag))
finish
end; ! of bcplr
!
!
!***********************************************************************
!*
!* B C P L Q
!*
!***********************************************************************
!
externalroutine bcplq(string(255) parms)
integer flag
string(255) cparms,auxparms
!
setfname("")
shuffle(parms,cparms)
auxparms = parms; ! Make copy, to ensure string is word-aligned
comreg(9) = addr(auxparms); ! Picked up by codegenerator
!
compile(cparms,"ICL9CEZBCPLQ",flag)
flag = return code
flag = 0 if flag = -1; ! INT:A
if 0 # flag < 1000 then start
newline
printstring("BCPLQ fails -".failuremessage(flag))
finish
end; ! of bcplq
!
!
!***********************************************************************
!*
!* B C P L X R E F
!*
!***********************************************************************
!
externalroutine bcplxref(string(255) parms)
integer flag
!
setfname("")
flag = icl9cezbcplx(parms)
flag = 0 if flag = -1; ! INT:A
if 0 # flag < 1000 then start
newline
printstring("BCPLXREF fails -".failuremessage(flag))
finish
end; ! of bcplxref
begin
bcpl("")
end
endoffile