begin ; ! PRINT: Print files on a nominated printer
option "-nocheck-nodiag"
! Adapted from EFTP
! JHB 14/11/86 put in a banner
! FRED 28/11/86 put large trailer on CITOH
! JHB 22/06/87 delete ":"'s from hierarchic filenames
! RWT 15/10/87 suppress duplicate seq0 packets after connect
! AJS 13/11/87 Reinstated OP and added LW16
! RWT 16/11/87 Slight mods to make it work under Mouse
include "inc:util.imp"
include "inc:fs.imp"
include "inc:fsutil.imp"
constinteger bel=7
!Filename stuff
constinteger maxnodes = 4
conststring (7)array nodename(1:maxnodes) = "Vax","Alpha","Bravo","Charlie"
constintegerarray nodenum(1:maxnodes) = 16_72,16_14,16_15,16_1B
recordformat slotf(integer portno,nodeno,userno)
recordformat filef(integer nodeno,xno,record (slotf)name slot,
string (31)node,path,file,record (filef)name next)
constinteger minslot=7,maxslot=9
record (slotf)array slot(1:maxslot)
owninteger timeout = 15000 ;!Milliseconds - Ether timeout.
ownstring (25) printdesc = "Machine Halls"
constinteger mh = 0, op = 1, lw16 = 2
routine fail
printsymbol(bel)
signal 15
end
! Miscellaneous string operations
predicate eq(string (*)name a,b) {A full, B partial}
! True iff string B is a leading substring of A.
! Case not significant.
integer i,m,n
falseunless length(a)>=length(b)
for i = 1,1,length(b) cycle
m = charno(a,i); n = charno(b,i)
m = m!32 and n = n!32 if 'a'<=n!32<='z'
falseunless m=n
repeat
true
end
integerfn htoi(string (*)name s,integername p)
! Return the integer value of the hex number, if any, starting at
! charno(P,S), advancing P past any digits actually processed.
integer k,n = 0
cycle
result = n if p>length(s)
k = charno(s,p)
k = k!32 if 'A'<=k<='F'
if 'a'<=k<='f' start
k = k-'a'+10
elseif '0'<=k<='9'
k = k-'0'
finishelseresult = n
n = n<<4+k; p = p+1
repeat
end
string (255) fn fullfilename(record (filef)name r)
string (255) s
if r_node="" then s = "" else s = substring(r_node, 1, 1)."::"
s=s.r_path.r_file
result =s
end
! Ether primitives
predicate gotack(integer port)
! Wait for ACK and return TRUE.
! Return FALSE if fed up waiting.
integer bit,deadline,c
bit = 1<<port
cycle
deadline = cputime+timeout
cycle
if ack&bit#0 start
trueif nak&bit=0
nak = nak!!bit
false
finish
repeatuntil cputime>deadline
prompt(" No response - shall I persevere?:")
readsymbol(c) until c&16_5f = 'N' or c&16_5f = 'Y'
false if c&16_5f = 'N'
timeout = timeout*2
repeat
end
predicate gotdtx(integer port)
! Wait for DTX and TRUE. FALSE when fed up
integer bit,deadline
bit = 1<<port
deadline = cputime+timeout
cycle
trueif dtx&bit#0
repeatuntil cputime>deadline
false
end
routine check connection(integer lsap)
string (255)s
bytename b == length(s)
routine part1
b = 3; b[1] = 'M'; b[2] = '0'; b[3] = nl
etherwrite(lsap,b[1],b)
unless gotack(lsap) start
printstring("No 1st ack"); newline; return
finish
unless gotdtx(lsap) start
printstring("Timeout waiting for 1st response"); newline; return
finish
b = etherread(lsap,b[1],255)
b = 3; b[1] = 'G'; b[2] = '0'; b[3] = nl
etherwrite(lsap,b[1],b)
unless gotack(lsap) start
printstring("No 2nd ack"); newline; return
finish
unless gotdtx(lsap) start
printstring("Timeout waiting for 2nd response"); newline; return
finish
b = etherread(lsap,b[1],255)
returnunless b[1]='-'
cycle
unless gotdtx(lsap) start
printstring("Timeout waiting for extra response"); newline; return
finish
b = etherread(lsap,b[1],255)
repeatuntil b[1]#'-'
printstring("Duplicate packet ignored"); newline
end
routine part2
returnif dtx&1=0
b = etherread(0,b[1],255)
printstring("Duplicate connect response ignored"); newline
end
part1
part2
end
routine connect(integer port,node)
! Establish a connection between local port PORT
! and network server NODE providing facility 2 (Filestore)
string (127)reply
integer i
byte facility
{printstring("Attempting to connect port "); phex2(port)
{printstring(" to node "); phex2(node); newline
facility = 2
etheropen(port,node<<8)
etherwrite(port,facility,1)
unless gotack(port) start
printstring("Node "); phex2(node)
printstring(" not acknowledging connect request")
etherclose(port)
newline
fail
finish
unless gotdtx(port) start
printstring("Node "); phex2(node)
printstring(" not responding to connect request")
etherclose(port)
newline
fail
finish
length(reply) = etherread(port,charno(reply,1),127)
i = charno(reply,length(reply))
unless i=nl and length(reply)=2 and charno(reply,1)>'0' start
printstring("Cannot connect to node "); phex2(node)
printstring(": ".reply)
etherclose(port)
newline unless i=nl
fail
finish
i = charno(reply,1)-'0'
etheropen(port,node<<8+i)
{printstring("Local port "); phex2(port); printstring(" connected to node ")
{phex2(node); printstring(" port "); phex2(i); newline
check connection(port)
end
routine disconnect(record (slotf)name s)
byte eot = 12
onevent 15 start
return
finish
returnif s_nodeno=-1
{printstring("Attempting to disconnect port "); phex2(s_portno)
{printstring(" from node "); phex2(s_nodeno); newline
etherwrite(s_portno,eot,1)
if gotack(s_portno) start
!! printstring("Disconnected port "); phex2(s_portno)
!! printstring(" from node "); phex2(s_nodeno)
else
printstring("Cannot disconnect port "); phex2(s_portno)
printstring(" from node "); phex2(s_nodeno)
printstring(" - Nak")
fail
finish
etherclose(s_portno)
s_nodeno = -1
end
! Filestore primitives
routine open(integer mode,record (filef)name f, integername size)
! Open a filestore file. Mode should be 'S' for reading, 'T' for writing.
record (slotf)name s
integer pos,pad
string (127)cr
s == f_slot
cr = tostring(mode).tostring(s_userno+'0').f_path.f_file.tostring(nl)
etherwrite(s_portno,charno(cr,1),length(cr))
unless gotack(s_portno) start
printline("Open: Nak")
fail
finish
unless gotdtx(s_portno) start
printline("Open: no response")
fail
finish
length(cr) = etherread(s_portno,charno(cr,1),127)
unless length(cr)>0 and charno(cr,1)>'0' start
printstring("Open: ".cr)
newline unless charno(cr,length(cr))=nl
fail
finish
pos = 1
f_xno = hdx to i(cr, pos)
if mode = 'S' start ;!Read
size = hdx to i(cr, pos) ;!in blocks
pad = hdx to i(cr, pos)
size = size<<9 - pad ;!Bytes
finish
{phex2(f_xno); space; write(size, 5); space
end
routine close(record (filef)name f)
record (slotf)name s
string (127)cr
onevent 15 start
return
finish
returnif f_xno=0
s == f_slot
cr = "K".tostring(f_xno+'0').tostring(nl)
etherwrite(s_portno,charno(cr,1),3)
unless gotack(s_portno) start
printline("Close: Nak")
fail
finish
unless gotdtx(s_portno) start
printline("Close: no response")
fail
finish
length(cr) = etherread(s_portno,charno(cr,1),127)
unless cr=tostring(nl) start
printstring("Close: ".cr)
newline unless charno(cr,length(cr))=nl
finish
f_xno = 0
end
integerfn readblock(record (filef)name f,integer address)
record (slotf)name s
string (3)c
integer count,pos,size,char
onevent 15 start
result = -1
finish
s == f_slot
c = "X".tostring(f_xno+'0').tostring(nl)
etherwrite(s_portno,charno(c,1),3)
unless gotack(s_portno) start
printline("Readblock: Nak"); fail
finish
unless gotdtx(s_portno) start
printline("Readblock: Timeout"); fail
finish
count = etherread(s_portno,byteinteger(address),999)
pos = address; size = 0
if byteinteger(pos)<'0' start
printstring("Readblock: ")
cycle
char = byteinteger(pos); pos = pos+1; printsymbol(char)
count = count-1
repeatuntil char=nl or count<=0
newline unless char=nl; fail
finish
cycle
char = byteinteger(pos)-'0'; pos = pos+1
exitif char<0
size = size<<4+char
repeat
unless size+pos-address=count start
printline("Readblock: dubious size"); fail
finish
count = size
while count>0 cycle
count = count-1; byteinteger(address) = byteinteger(pos)
address = address+1; pos = pos+1
repeat
result = size
end
predicate writeblock(record (filef)name f,integer address,size)
integer save1,save2
record (slotf)name s
string (127)cr
onevent 15 start
false
finish
save1 = integer(address-4); save2 = integer(address-8)
byteinteger(address-1) = nl
byteinteger(address-2) = size&15+'0'
byteinteger(address-3) = size>>4+'0'
byteinteger(address-4) = f_xno+'0'
byteinteger(address-5) = 'Y'
s == f_slot
etherwrite(s_portno,byteinteger(address-5),size+5)
integer(address-4) = save1; integer(address-8) = save2
unless gotack(s_portno) start
printstring(" Writeblock: Nak"); false
finish
unless gotdtx(s_portno) start
printstring(" Writeblock: Timeout"); false
finish
length(cr) = etherread(s_portno,charno(cr,1),127)
trueif cr = tostring(nl)
printstring(" Writeblock: ".cr); newline unless charno(cr,length(cr))=nl
false
end
constinteger banlines = 4
routine readin(record (filef)name file,integername start,len,c
string (*) name header,banner,trailer)
string (255) junk1,junk2
integer pos,dif,i,l,j
routine pack(integer n)
byteinteger(pos)=n; pos=pos+1; len=len+1
end
onevent 15 start
dispose(start) if pos # 0; start = 0; len = -1; return
finish
len = 0; pos = 0
open('S',file, len)
!File + header + (banner+newline)*banlines + trailer + (2 newlines if banner)
!+ maybe a terminating newline and a newpage after the banner
l = len+length(header)+length(trailer)+banlines*(length(banner)+1)+2
pos = heapget(l)
start = pos; len = 0
for i=1,1,length(header) cycle
pack(charno(header,i))
repeat
if banner # "" start
for i=1,1,banlines cycle
for j=1,1,length(banner) cycle
pack(charno(banner,j))
repeat
pack(nl)
repeat
pack(nl); pack(nl)
!If it's a .LIS file assume it is page-based and throw a newpage.
pack(12) and l=l+1 if file_file -> junk1.(".lis")
finish
cycle
dif = readblock(file,pos)
if dif<0 start
close(file); dispose(start); start = 0; len = -1; return
finish
pos = pos+dif
len = len+dif
repeatuntil dif#512
close(file)
pack(nl) if byteinteger(pos - 1) # NL; !?
for i=1,1,length(trailer) cycle
pack(charno(trailer,i))
repeat
{phex(len); space
end
owninteger lastcpu = 0
routine delay(integer msec)
!Wait till at least MSEC milliseconds since last delay
while cputime <= lastcpu+msec cycle ; repeat
lastcpu = cputime
end
predicate writeout(record (filef)name file,integer pos,length)
onevent 15 start
false
finish
false unless length>0
open('T',file, length)
while length>=512 cycle
delay(250)
false unless writeblock(file,pos,512)
pos = pos+512; length = length-512
repeat
unless length=0 start
false unless writeblock(file,pos,length)
finish
close(file)
true
end
routine transfer(record (filef)name source,dest, c
string (255) header,banner,trailer)
! Copy one file
integer ad,len
onevent 15 start
heapput(ad) unless ad = 0; return
finish
ad = 0
printstring(fullfilename(source)); space
readin(source,ad,len,header,banner,trailer)
if len<0 start
printline("- failed to read it")
else
printstring("- ")
if writeout(dest,ad,len) start
printline("Queued for ".printdesc." printer")
heapput(ad)
else
printline("Failed to write it")
finish
finish
end
routine processfilename(record (filef)name r)
string (255)s,n,d,f
record (slotf)name sl
integer i
s = r_file
if length(s)>=2 and substring(s,1,2)="::" start
s = substring(s,3,length(s))
n = s and s = "" unless s -> n.(":").s
finishelse n = ""
s = substring(s,2,length(s)) if length(s)>=1 and charno(s,1)=':'
if s -> d.("]").f start
d = d."]"
elseif s -> d.(":").f
d = d.":"
else
d = ""; f = s
finish
r = 0
r_node = n
r_path = d
r_file = f
unless n="" start
for i = 1,1,maxnodes cycle
if eq(nodename(i),n) start
r_node = nodename(i)
r_nodeno = nodenum(i); ->ref
finish
repeat
i = 1; r_nodeno = htoi(n,i)
if i<=length(n) start
printline("Unknown node `".n."`")
r_node = ""
finish
finish
ref:
!Plug in the slot through which node R_NODENO may be referenced.
for i = 1,1,maxslot cycle
sl == slot(i)
r_slot == sl andreturnif sl_nodeno=r_nodeno
repeat
if r_nodeno=0 start
printline("Default node now meaningless"); fail
finish
i = minslot
cycle
if i>maxslot start
printline("No local port"); fail
finish
sl == slot(i); exitif sl_nodeno=-1
i = i+1
repeat
sl_nodeno = r_nodeno
connect(i,r_nodeno)
r_slot == sl
end
routine shutdown
record (filef)name reconnect
record (slotf)name s
integer i
for i = minslot,1,maxslot cycle
s == slot(i)
continueif s_nodeno=0
disconnect(s)
repeat
end
routine initialise
record (slotf)name sl
integer i
for i=1,1,maxslot cycle
sl == slot(i)
sl_portno = i; sl_nodeno = -1; sl_userno = 0
repeat
sl == slot(lsap{was fsport})
sl_nodeno = 0; sl_userno = userno
end
string (7)function fsname(integer a)
result = "A::" if a = 16_14
result = "B::" if a = 16_15
result = "C::" if a = 16_1B
result = "MET::" if a = 16_44
result = "VAX::" if a = 16_72
result = ""
end
routine tart up(string (*)name text)
integer i, cap
cap = 1
for i = 1, 1, length(text) cycle
if 'a'<=charno(text, i)<='z' start
charno(text, i) = charno(text, i)-'a'+'A' unless cap=0
cap = 0
elseif 'A'<=charno(text, i)<='Z'
charno(text, i) = charno(text, i)-'A'+'a' if cap = 0
cap = 0
else
cap = 1
finish
repeat
end
routine process banner(string (255) text, string (*)name dest,
integer width, integername nlines)
const byte integer array strength(0:127) = c
255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,
255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,
255,63,7,31,31,31,31,7,15,15,31,31,63,31,63,127,
1,1,1,1,1,1,1,1,1,1,127,127,31,31,31,63,
31,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,15,31,15,31,3,
7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,15,31,15,31,255
integer i, j, k, l, cs, st, old length
routine blanks(integer n)
integer i
return if n<1
dest = dest." " for i = 1, 1, n
end
j = 1
cycle
old length = length(dest)
j = j+1 while j<=length(text) and strength(charno(text, j)&127)>128
exit if j>length(text)
i = j+|width|-1
if i<length(text) start
l = i
unless strength(charno(text, i+1)&127)>128 start
st = 0
for k = i, -1, j+1 cycle
cs = strength(charno(text, k)&127)
exit if st>128 and cs<st
if cs<128 and cs>st start
l = k
st = cs
elseif cs>128 and cs>=st
l = k-1
st = cs
finish
repeat
finish
else
l = length(text)
finish
blanks((j-width-l-1)//2) if width<0
dest = dest.substring(text, j, l)
dest = dest.to string(nl) unless length(dest)-old length=|width|
nlines = nlines+1
j = l+1
repeat
end
routine print(string (255)file, byteinteger printer, cpi, lpi, dq, banner)
conststring (1) array cpitab(0:3) = " ","!","""","#"
conststring (1) array lpitab(0:3) = " ","!","""","#"
conststring (1) array dqtab (0:1) = " ",""""
record (filef)s,d
record (filef)name list
string (255)curd,curu,header,trailer,banstring,junk1,junk2,fname
integer len, i
string (1) esc = tostring(16_1B)
string (31) fn citoh(integer cpi, lpi, dq)
string (31) s
s = esc."?#".dqtab(dq)
s = s.esc."?""".cpitab(cpi)
s = s.esc."?!".lpitab(lpi)
s = s."
"
result = s
end
string (9)fn niceify(string (255)s)
string (255)fore,aft
s = fore.(".").aft while s -> fore.(":").aft
s = substring(s,length(s)-8,length(s)) if length(s)>9
result = s
end
header=""; trailer = ""; banstring=""
s_file = file
processfilename(s)
curd = niceify(current directory)
curu = niceify(current user)
if printer = op start
d_file = "::vax:s1:[opspool]".curd
printdesc = "Block O/P"
elseif printer = lw16
d_file = "::vax:s1:[lw16spool]".curd
printdesc = "Lw16"
elseif printer = mh
d_file = "::bravo:lp:!".curd
printdesc = "Machine Halls"
header = citoh(cpi, lpi, dq)
if banner=1 start
len = 0
trailer = ""
process banner(datetime, trailer, -16, len)
! process banner(current user, trailer, -16, len)
process banner(fs name(rdte).curu, trailer, -16, len)
fname = fullfilename(s)
fname = curd.":".fname unless fname -> junk1.(":")
tart up(fname)
process banner(fname, trailer, -16, len)
trailer = trailer.esc."0 ".esc."1 ".citoh(1, 2, 0)
trailer = to string(nl).trailer for i = len, 1, 5
trailer = to string(12).citoh(3, 2, 0).esc."0'".esc."1'". c
"^^^^^^^^^^^^^^^^^^ the end of ^^".trailer
banner = 0
else
trailer = citoh(1, 2, 0)
finish
else
! printline("Unknown printer - printing to O/P") {Yugh - should stop}
! d_file = "::vax:dra3:[opspool]".current directory
! printdesc = "Block O/P"
printline("Unknown printer - try OP, MH, or LW16")
stop
finish
if d_file -> d_file.("_") start ; finish
!VAX doesn't like usernumbers with subs
!!d_file = junk1.junk2 %while d_file -> junk1.(":").junk2
!!!Filestore "B" doesn't like hierarchic names with ":" s
processfilename(d)
if banner = 1 start ;! banner: Username, date, time
banstring = "*** ".current directory
banstring = banstring." " while length(banstring) < c
54-length(fullfilename(s))
banstring = banstring.fullfilename(s)." ".date." ".time." ***"
finishelse banstring = ""
transfer(s,d,header,banstring,trailer)
end
routine do print(string (255) thisbit)
string (255) p
byteinteger printer, cpi, lpi, dq, banner
printer = mh; cpi=1; lpi=2; dq=0; banner=1
define param("File -- File to be printed", p, pam nodefault)
! define enum param("MHprinter,OPprinter -- Machine Halls or Block O/P", printer, 0)
define enum param("MH,OP,LW16 -- Machine Halls, Block O/P, or Lw16",
printer, 0)
define enum param("c10,c12,c13,c17 -- Characters per inch", cpi, 0)
define enum param("DP,LQ -- Document quality", dq, 0)
define enum param("l3,l4,l6,l8 -- Lines per inch", lpi, 0)
define enum param("NUll,LIne,PAge -- Banner", banner, 0)
process parameters(thisbit)
print(p, printer, cpi, lpi, dq, banner)
shutdown
end
routine main program
ownstring (255) param = "",thisbit=""
onevent 0,3,9,15 start
unless event_event=15 start
printline(" Aborted - ".event_message.itos(event_sub, 4))
shutdown
finish
return
finish
param = cliparam
while param -> thisbit.(",").param cycle
do print(thisbit)
repeat
do print(param)
end
initialise
main program
endofprogram