
######natbcpl/sysb/blib.b#
//.(c)..Copyright:..Martin.Richards..29.May.2004#0A
#0A/*#0A03/07/07#0AAdded.codewrch.to.write.extended
.characters.using.UTF8.or#0AGB2312#2E.Added.%#23.su
bstitution.item.in.writef.to.invoke.it#2E.Note.that
#0A*xU,.*xG,.*#23hhhh,.*#23#23hhhhhhhh.and.*#23dddd
.escapes.have.been.added.to#0ABCPL.string.and.chara
cter.constants#2E#0A#0A29/6/02#0ARenamed.IOLIB.as.D
LIB.(the.system.Dependent.LIBrary)#2E.Put.system#0A
independent.code.in.BLIB.and.the.rest.in.DLIB#2E#0A
#0A24/4/04#0AMade.many.changed.to.make.BLIB.more.co
mpatible.between.Cintpos.and#0Asingle.threaded.Cint
code.BCPL#2E#0A#0A21/3/2003#0AMake.instrcount(f,a,b
,#2E#2E#2E).set.result2.to.result.of.f(a,b,c,#2E#2E
#2E#2E)#0A#0A10/7/2000#0AChanged.the.definition.of.
mkobj.to.take.up.to.11.initialisation#0Aarguments#2E
.See.bcplprogs/objdemo#2Eb#0A#0A28/2/2000#0AAdded.f
unction.instrcount(f,a,b,c,e,f,r,g,h,i,j,k)#0Awhich
.returns.the.number.of.cintcode.instructions.execut
ed#0Awhen.calling.f(a,b,#2E#2E#2E)#2E#0A#0A30/4/199
6#0AAdded.function.flush()#0Awith.corresponding.cha
nge.in.cintsys#2Ec#0A#0A7/6/1996#0ADefined.mkobj(up
b,.fns,.a,.b).for.use.in.object.oriented.programmin
g#2E#0ASee.bcplprogs/objdemo#2Eb..(args.a.and.b.add
ed.30.March.1999)#2E#0A*/#0A#0ASECTION."BLIB"#0A#0A
GET."libhdr"#0A#0ALET.stop(code).BE#0A{.//.Return.t
o.the.CLI.with.a.return.code#2E#0A..//.It.must.be.c
alled.from.the.command's.coroutine,#0A..//.not.an.i
nner.coroutine#2E#0A..returncode.:#3D.code#0A..cowa
it(code)#0A}#0A#0ALET.clihook(stackupb).#3D.VALOF#0A
{.LET.v.#3D.VEC.rtn_upb#0A..rootnode.:#3D.v#0A..FOR
.i.#3D.0.TO.rtn_upb.DO.rootnode!i.:#3D.0#0A#0A..cur
rentdir.:#3D.0#0A..selectoutput(findoutput("**"))#0A
..selectinput(findinput("**"))#0A#0A..//.The.native
.code.command.arguments.are.automatically#0A..//.pr
epended.to.stdin#2E.This.is.done.in.sardch.in.dosys
.of.sysc/clib#2Ec#0A#0A..currco.:#3D.@stackupb-3-6.
.........//.Initialise.the.coroutine.environment#0A
..colist.:#3D.currco#0A..currco!co_pptr...:#3D.0#0A
..currco!co_parent.:#3D.-1..//.Mark.as.root.corouti
ne#2E#0A..currco!co_list...:#3D.0#0A#0A..currco!co_
fn...:#3D.clihook......//.fn#0A..currco!co_size.:#3D
.stackupb.....//.stackupb.(first.arg.of.clihook)#0A
..currco!5.......:#3D.0............//.c#0A#0A..RESU
LTIS.start(0)#0A}#0A#0AAND.intflag().#3D.sys(Sys_in
tflag)..//.Returns.TRUE.if.user.interrupt#0A#0AAND.
abort(code).#3D.sys(Sys_quit,.code)#0A#0AAND.level(
p3).#3D.(@p3)!-3#0A#0AAND.longjump(lev,.lab).BE.{.L
ET.p.#3D.@lev.-.3;.p!0,.p!1.:#3D.lev,.lab.}#0A#0AAN
D.sardch()...#3D.sys(Sys_sardch)#0A#0AAND.sawrch(ch
).#3D.sys(Sys_sawrch,ch)#0A#0A//.Set.the.timeout.fi
eld#0A//.msecs>0...The.stream.timeout.value.in.mill
i-seconds#0A//.msecs#3D0...No.timeout.value.(the.de
fault)#0A//.msecs<0...Only.perform.non.blocking.ope
rations.on.the.stream#0A//.On.a.timeout.(on.TCP.str
eams)#0A//.act#3D.0....Repeat.the.current.operation
#0A//.act#3D-1....Make.timeout.have.the.effect.of.E
OF#0A//.act#3D-2....Return.timeoutch#0AAND.settimeo
ut(scb,.msecs,.act).BE#0A{.scb!scb_timeout.:#3D.mse
cs#0A..scb!scb_timeoutact.:#3D.act#0A}#0A#0A//.Just
.set.the.timeoutact.field#0AAND.settimeoutact(scb,.
act).BE.scb!scb_timeoutact.:#3D.act#0A#0AAND.rdch()
.#3D.VALOF#0A//.Returns.the.next.byte.from.the.curr
ently.selected.input.stream,#0A//.but.ignores.CR#2E
#0A//.If.the.buffer.is.empty,.it.calls.replenish.to
.attempt.to.refill.it#2E#0A//.It.aborts.186.if.no.i
nput.stream.is.selected#2E#0A{.LET.pos.#3D.cis!scb_
pos.//.Position.of.next.byte#0A#0A..UNLESS.cis.DO.a
bort(186)#0A..IF.pos<cis!scb_end.DO.{.LET.ch.#3D.ci
s!scb_buf%pos#0A..........................cis!scb_p
os.:#3D.pos+1#0A..........................IF.ch#3D'
*c'.LOOP.//.Ignore.CR#0A..........................R
ESULTIS.ch#0A........................}#0A..//.No.by
te.available,.so.attempt.to.replenish.the.buffer#0A
..//.If.replenish.returns.FALSE,.no.chars.were.plac
ed.in.the.buffer#0A..//.and.the.reason.why.not.is.p
laced.in.result2.as.follows#0A..//....result2.#3D.-
1....end.of.file#0A..//....result2.#3D.-2....timeou
t#0A..//....result2.#3D.-3....polling.and.no.charac
ters.available#2E#0A..//....result2.#3D.code..error
.code#0A..UNTIL.replenish(cis).DO#0A..{.IF.result2#3D
-2.DO#0A....{.LET.act.#3D.cis!scb_timeoutact.//.Loo
k.at.timeout.action#0A......IF.act#3D-2.RESULTIS.ti
meoutch#0A......IF.act#3D-1.RESULTIS.endstreamch#0A
......LOOP..//.Try.replenishing.again#0A....}#0A...
.RESULTIS.result2<0.->.result2,.endstreamch#0A..}#0A
..//.Successful.replenishment.so.try.rdch.again#0A.
.//.There.will.be.at.least.one.character.in.the.buf
fer#0A}.REPEAT#0A#0AAND.binrdch().#3D.VALOF#0A//.Sa
me.as.rdch.but.does.not.ignore.CR#2E#0A{.LET.pos.#3D
.cis!scb_pos.//.Position.of.next.byte#0A#0A..UNLESS
.cis.DO.abort(186)#0A..IF.pos<cis!scb_end.DO.{.LET.
ch.#3D.cis!scb_buf%pos#0A..........................
cis!scb_pos.:#3D.pos+1#0A..........................
RESULTIS.ch#0A........................}#0A..//.No.b
yte.available,.so.attempt.to.replenish.the.buffer#0A
..//.If.replenish.returns.FALSE,.no.chars.were.plac
ed.in.the.buffer#0A..//.and.the.reason.why.not.is.p
laced.in.result2.as.follows#0A..//....result2.#3D.-
1....end.of.file#0A..//....result2.#3D.-2....timeou
t#0A..//....result2.#3D.-3....polling.and.no.charac
ters.available#2E#0A..//....result2.#3D.code..error
.code#0A..UNTIL.replenish(cis).DO#0A..{.IF.result2#3D
-2.DO#0A....{.LET.act.#3D.cis!scb_timeoutact.//.Loo
k.at.timeout.action#0A......IF.act#3D-2.RESULTIS.ti
meoutch#0A......IF.act#3D-1.RESULTIS.endstreamch#0A
......LOOP..//.Try.replenishing.again#0A....}#0A...
.RESULTIS.result2<0.->.result2,.endstreamch#0A..}#0A
..//.Successful.replenishment.so.try.rdch.again#0A.
.//.There.will.be.at.least.one.ch.in.the.buffer#0A}
.REPEAT#0A#0AAND.unrdch().#3D.VALOF#0A//.Attempt.to
.step.input.back.by.one.byte.position#2E#0A//.It.re
turns:.TRUE.if.successful,.and#0A//.............FAL
SE.otherwise#0A//.After.a.call.of.rdch().it.will.al
ways.be.successful.at.least.once#2E#0A//.It.aborts:
.186.if.not.input.stream,.is.selected#2E#0A{.LET.po
s.#3D.cis!scb_pos#0A..UNLESS.cis.DO.abort(186)#0A..
IF.pos<#3D0.RESULTIS.FALSE.//.Cannot.UNRDCH.past.or
igin#2E#0A..cis!scb_pos.:#3D.pos-1#0A..RESULTIS.TRU
E#0A}#0A#0AAND.wrch(ch).#3D.VALOF#0A//.wrch(ch).wri
tes.ch.to.the.current.output.stream#2E#0A//.It.retu
rns.TRUE.if.successful,.FALSE.otherwise#0A//.It.abo
rts:.187.if.no.stream.is.selected#0A//............1
89.on.depletion.failure#2E#0A{.LET.pos.#3D.cos!scb_
pos#0A#0A..//.If.the.buffer.is.full.try.to.deplete.
it#2E#0A..IF.pos.>#3D.cos!scb_bufend.DO#0A..{.UNLES
S.deplete(cos).RESULTIS.FALSE#0A....UNLESS.cos!scb_
buf..RESULTIS.TRUE.//.Must.be.writing.to.NIL:#0A...
.pos.:#3D.cos!scb_pos#0A..}#0A#0A..//.Pack.the.char
acter.and.advance.pos#2E#0A..cos!scb_buf%pos.:#3D.c
h#0A..pos.:#3D.pos+1#0A..cos!scb_pos.:#3D.pos#0A../
/.Advance.end.of.valid.data.pointer,.if.necessary#0A
..IF.cos!scb_end.<.pos.DO.cos!scb_end.:#3D.pos#0A..
cos!scb_write.:#3D.TRUE.//.Set.flag.to.indicate.the
.buffer.has.changed#2E#0A#0A..UNLESS.cos!scb_type<0
.&.ch<'*s'.RESULTIS.TRUE.//.Normal.return#0A#0A..//
.The.stream.is.interactive.and.ch.is.a.control.char
acter#2E#0A#0A..IF.ch#3D'*n'.DO..wrch('*c')..//.Fid
dle.for.Cygwin#0A#0A..//.Call.deplete.at.the.end.of
.each.interactive.line#2E#0A..IF.ch#3D'*n'.|.ch#3D'
*p'.RESULTIS.deplete(cos)#0A..RESULTIS.TRUE#0A}#0A#0A
AND.binwrch(ch).#3D.wrch(ch.|.256)#0A#0AAND.codewrc
h(code).BE#0A{.//.This.(misleadingly).writes.either
.a.Unicode.character.in#0A..//.UTF-8.format.or.a.co
de.in.GB2312.format#2E#0A..//.A.special.(negative).
value.to.select.the.current.encoding#0A..//.to.be.u
sed.on.the.currently.selected.output.stream.(cos)#2E
#0A#0A..IF.code<0.DO#0A..{.//.Set.the.encoding.for.
the.currently.selected#0A....//.output.stream#2E#0A
....cos!scb_encoding.:#3D.code.//.UTF8.(#3D-1).or.G
B2312.(#3D-2)#0A....RETURN#0A..}#0A..//.Select.UTF8
.unless.GB2312.explicitly.specified.in.the.SCB#2E#0A
..TEST.cos!scb_encoding#3DGB2312#0A..THEN.gb2312wrc
h(code)#0A..ELSE.utf8wrch(code)#0A}#0A#0AAND.gb2312
wrch(code).BE#0A{.//.I.believe.the.encoding.is.as.f
ollows:#0A..//.code.#3D.0.-.127.#3D>.code#0A..//.co
de.#3D.xxyy....#3D>.<xx.+.160>.<yy.+.160>#0A..//...
................eg.4566.#3D>.<45+160>.<66+160>.or.C
D.E2#0A..//.Note.that.the.row.encoding.(CD).is.writ
ten.first,.followed#0A..//.by.the.column#2E#0A..TES
T.code<#3D127#0A..THEN.{.wrch(code)#0A//sawritef(".
gb2312:.%x4.#3D>.%x2*n",.code,.code)#0A.......}#0A.
.ELSE.{.LET.hi.#3D.code../..100.+.160.//.Row.encodi
ng#0A.........LET.lo.#3D.code.MOD.100.+.160.//.Colu
mn.encoding#0A.........wrch(hi)#0A.........wrch(lo)
#0A//sawritef(".gb2312:.%x4.#3D>.%x2.%x2*n",.code,.
hi,.lo)#0A.......}#0A}#0A#0AAND.utf8wrch(code).BE#0A
{.//.Write.a.Unicode.character.in.RTF-8.format#0A..
IF.code<#3D#23x7F.DO#0A..{.wrch(code)..............
.....//.0xxxxxxx#0A....RETURN#0A..}#0A..IF.code<#3D
#23x7FF.DO#0A..{.wrch(#23b1100_0000+(code>>6))..//.
110xxxxx#0A....wrch(#23x80+(.code....&#23x3F))..//.
10xxxxxx#0A....RETURN#0A..}#0A..IF.code<#3D#23xFFFF
.DO#0A..{.wrch(#23b1110_0000+(code>>12)).//.1110xxx
x#0A....wrch(#23x80+((code>>6)&#23x3F))..//.10xxxxx
x#0A....wrch(#23x80+(.code....&#23x3F))..//.10xxxxx
x#0A....RETURN#0A..}#0A..IF.code<#3D#23x1F_FFFF.DO#0A
..{.wrch(#23b1111_0000+(code>>18)).//.11110xxx#0A..
..wrch(#23x80+((code>>12)&#23x3F)).//.10xxxxxx#0A..
..wrch(#23x80+((code>>6)&#23x3F))..//.10xxxxxx#0A..
..wrch(#23x80+(.code....&#23x3F))..//.10xxxxxx#0A..
..RETURN#0A..}#0A..IF.code<#3D#23x3FF_FFFF.DO#0A..{
.wrch(#23b1111_1000+(code>>24)).//.111110xx#0A....w
rch(#23x80+((code>>18)&#23x3F)).//.10xxxxxx#0A....w
rch(#23x80+((code>>12)&#23x3F)).//.10xxxxxx#0A....w
rch(#23x80+((code>>6)&#23x3F))..//.10xxxxxx#0A....w
rch(#23x80+(.code....&#23x3F))..//.10xxxxxx#0A....R
ETURN#0A..}#0A..IF.code<#3D#23x7FFF_FFFF.DO#0A..{.w
rch(#23b1111_1100+(code>>30)).//.1111110x#0A....wrc
h(#23x80+((code>>24)&#23x3F)).//.10xxxxxx#0A....wrc
h(#23x80+((code>>18)&#23x3F)).//.10xxxxxx#0A....wrc
h(#23x80+((code>>12)&#23x3F)).//.10xxxxxx#0A....wrc
h(#23x80+((code>>.6)&#23x3F)).//.10xxxxxx#0A....wrc
h(#23x80+(.code.....&#23x3F)).//.10xxxxxx#0A....RET
URN#0A..}#0A#0A..//.Bad.Unicode.character#0A..write
f("#23%x4#23",.code)#0A}#0A#0AAND.readwords(vector,
.count).#3D.VALOF#0A{.LET.i,.lim.#3D.0,.count*bytes
perword#0A//sawritef("BLIB.co#3D%n:.readwords.count
#3D%n.scb#3D%n.block#3D%n.pos#3D%n*n",#0A//........
..currco,.count,.cis,.cis!scb_block,.cis!scb_pos)#0A
#0A..IF.count<#3D0.RESULTIS.0#0A#0A..{.LET.pos.#3D.
cis!scb_pos.//.Position.of.next.byte#0A....AND.end.
#3D.cis!scb_end.//.Position.past.last.byte#0A....AN
D.buf.#3D.cis!scb_buf.//.Byte.buffer.--.replenish.m
ight.change.buf#0A#0A....WHILE.pos.<.end.DO....//.C
opy.bytes.--.more.needed#0A....{.//.At.least.one.by
te.available.and.needed#0A......vector%i.:#3D.buf%p
os.......//.Copy.it#0A......i,.pos.:#3D.i+1,.pos+1#0A
......IF.i<lim.LOOP............//.More.byte(s).need
ed#0A......//.Successful.completion#0A......cis!scb
_pos.:#3D.pos#0A......RESULTIS.count#0A....}#0A#0A.
...cis!scb_pos.:#3D.pos#0A#0A....//.No.byte.availab
le,.so.attempt.to.replenish.the.buffer#0A....UNLESS
.replenish(cis).RESULTIS.i/bytesperword#0A....//.Su
ccessful.replenishment.so.copy.some.more.bytes#0A..
..//.There.will.be.at.least.one.byte.in.the.buffer#0A
..}.REPEAT#0A}#0A#0AAND.writewords(vector,.count).#3D
.VALOF#0A{.LET.i,.len.#3D.0,.count*bytesperword.//.
Length.in.bytes#0A#0A//sawritef("BLIB.co#3D%n:.writ
ewords.count#3D%n.scb#3D%n.block#3D%n.pos#3D%n*n",#0A
//..........currco,.count,.cos,.cos!scb_block,.cos!
scb_pos)#0A#0A..IF.len<#3D0.RESULTIS.FALSE#0A#0A..{
.LET.pos....#3D.cos!scb_pos#0A....AND.bufend.#3D.co
s!scb_bufend#0A....AND.buf....#3D.cos!scb_buf#0A#0A
....//.If.the.buffer.is.full.try.to.deplete.it#2E#0A
....WHILE.pos.<.bufend.DO#0A....{.//.There.is.a.byt
e.available.and.room.in.the.buffer#0A......buf%pos.
:#3D.vector%i....//.so.copy.it#0A......i,.pos.:#3D.
i+1,.pos+1#0A......IF.i<len.LOOP..........//.Loop.i
f.another.byte.available#0A#0A......cos!scb_pos.:#3D
.pos.....//.Update.SCB.and.return.successfully#0A..
....//.Advance.end.of.valid.data,.if.necessary#0A..
....IF.cos!scb_end.<.pos.DO.cos!scb_end.:#3D.pos#0A
......cos!scb_write.:#3D.TRUE.//.At.least.one.byte.
has.been.written#0A#0A......RESULTIS.TRUE#0A....}#0A
#0A....//.The.buffer.is.full.so.update.the.SCB.and.
deplete#0A....cos!scb_pos.:#3D.pos#0A....//.Advance
.end.of.valid.data,.if.necessary#0A....IF.cos!scb_e
nd.<.pos.DO.cos!scb_end.:#3D.pos#0A....IF.i>0.DO.co
s!scb_write.:#3D.TRUE.//.TRUE.if.at.least.one.byte.
has.been.written#0A#0A....UNLESS.deplete(cos).RESUL
TIS.FALSE#0A..}.REPEAT#0A}#0A#0A//.get_record.retur
ns.TRUE.if.successful#0A//.it.returns.FALSE.if.eof.
is.encountered.before.the.whole.record#0A//.has.bee
n.read#2E#0A//.MR.29/7/02:.First.record.of.a.file.h
as.record.number.0#0AAND.get_record.(vector,.recno,
.scb).#3D.VALOF#0A{.LET.i...#3D.0..............//.P
osition.of.next.byte.to.put.in.vector#2E#0A..LET.le
n.#3D.scb!scb_reclen.//.Length.of.the.record.in.byt
es#2E#0A#0A..IF.len<#3D0.RESULTIS.FALSE.//.Fail,.no
.record.length.specified#2E#0A#0A//sawritef("BLIB.c
o#3D%n:.get_record.recno#3D%n.reclen#3D%n.blk#3D%n.
pos#3D%n.end#3D%n*n",#0A//...currco,.recno,.scb!scb
_reclen,.scb!scb_block,.scb!scb_pos,.scb!scb_end)#0A
..recordpoint(scb,.recno)#0A#0A//sawritef("BLIB:.ge
t_record.recno#3D%n.reclen#3D%n.pos#3D%n.end#3D%n*n
",#0A//...........recno,.scb!scb_reclen,.scb!scb_po
s,.scb!scb_end)#0A#0A#0A..{.//.Start.of.reading.loo
p#0A....LET.pos.#3D.scb!scb_pos.//.Position.of.next
.byte#0A....AND.end.#3D.scb!scb_end.//.Position.pas
t.last.byte#0A....AND.buf.#3D.scb!scb_buf.//.Byte.b
uffer.--.replenish.might.change.buf#0A#0A....WHILE.
pos.<.end.DO....//.Copy.bytes.--.more.needed#0A....
{.//.At.least.one.byte.needed#0A......vector%i.:#3D
.buf%pos#0A//sawritef("BLIB.co#3D%n:.get_record.byt
e#3D%x2*n",.currco,.vector%i)#0A......i,.pos.:#3D.i
+1,.pos+1#0A......IF.i<len.LOOP.......//.More.byte(
s).needed#0A......//.Successful.completion#0A......
scb!scb_pos.:#3D.pos#0A//sawritef("BLIB.co#3D%n:.ge
t_record.recno#3D%n.len#3D%n.successful*n",#0A//...
.......currco,.recno,.len)#0A......RESULTIS.TRUE#0A
....}#0A#0A....scb!scb_pos.:#3D.pos#0A#0A....//.No.
byte.available,.so.attempt.to.replenish.the.buffer#0A
....UNLESS.replenish(scb).DO#0A....{#0A//sawritef("
BLIB.co#3D%n:.get_record.recno#3D%n.len#3D%n.hit.eo
f.at.%n*n",#0A//..........currco,.recno,.len,.i)#0A
......RESULTIS.FALSE..//.Failure.due.to.eof,.timeou
t,.error.etc#0A....}#0A....//.Successful.replenishm
ent.so.copy.some.more.bytes#0A....//.There.will.sti
ll.be.at.least.one.byte.in.the.buffer#0A..}.REPEAT#0A
}#0A#0A//.MR.29/7/02:.The.first.record.of.a.file.ha
s.number.0.(not.1)#0A//.Returns.TRUE.if.successful#0A
//.Returns.FALSE,.otherwise#2E#0AAND.put_record(vec
tor,.recno,.scb).#3D.VALOF#0A{.LET.i,.len.#3D.0,.sc
b!scb_reclen#0A#0A..UNLESS.scb!scb_id#3Did_inoutscb
.DO#0A..{.sawritef("BLIB.co#3D%n:.put_record.id.not
.inout*n",.currco)#0A....abort(999)#0A....RESULTIS.
FALSE#0A..}#0A#0A..IF.len<#3D0.RESULTIS.FALSE.//.Er
ror.--.no.record.length#0A#0A//sawritef("BLIB:.put_
record.recno#3D%n.reclen#3D%n.blk#3D%n.pos#3D%n.end
#3D%n*n",#0A//...........recno,.scb!scb_reclen,.scb
!scb_block,.scb!scb_pos,.scb!scb_end)#0A..UNLESS.re
cordpoint(scb,.recno).RESULTIS.FALSE#0A//sawritef("
BLIB:.put_record.recno#3D%n.reclen#3D%n.blk#3D%n.po
s#3D%n.end#3D%n*n",#0A//...........recno,.scb!scb_r
eclen,.scb!scb_block,.scb!scb_pos,.scb!scb_end)#0A/
/abort(2222)#0A..{.LET.pos....#3D.scb!scb_pos#0A...
.AND.bufend.#3D.scb!scb_bufend#0A....AND.buf....#3D
.scb!scb_buf#0A#0A....//.If.the.buffer.is.full.try.
to.deplete.it#2E#0A....WHILE.pos.<.bufend.DO#0A....
{.//.There.is.a.byte.available.and.room.in.the.buff
er#0A......buf%pos.:#3D.vector%i....//.so.copy.it#0A
......i,.pos.:#3D.i+1,.pos+1#0A......scb!scb_write.
:#3D.TRUE..//.At.least.one.byte.has.been.written#0A
......IF.i<len.LOOP..........//.Loop.if.another.byt
e.available#0A#0A......scb!scb_pos.:#3D.pos.....//.
Update.SCB.and.return.successfully#0A......//.Advan
ce.end.of.valid.data,.if.necessary#0A......IF.scb!s
cb_end.<.pos.DO.scb!scb_end.:#3D.pos#0A//......scb!
scb_write.:#3D.TRUE.//.At.least.one.byte.has.been.w
ritten#0A#0A......RESULTIS.TRUE.........//.Successf
ul.completion#0A....}#0A#0A....//.The.buffer.is.ful
l.so.update.the.SCB.and.deplete#0A....scb!scb_pos.:
#3D.pos#0A....//.Advance.end.of.valid.data,.if.nece
ssary#0A....IF.scb!scb_end.<.pos.DO.scb!scb_end.:#3D
.pos#0A//..IF.i>0.DO.scb!scb_write.:#3D.TRUE.//.if.
at.least.one.byte.has.been.written#0A#0A....UNLESS.
deplete(scb).RESULTIS.FALSE#0A..}.REPEAT#0A}#0A#0A/
/.replenish(scb).returns:#0A//...TRUE..............
..Successful.replenishment,.at.least.one.ch.read#0A
//...FALSE.result2.#3D.-1..End.of.file,.no.chars.re
ad.....//.MR.15/4/03#0A//...FALSE.result2.#3D.-2..T
imeout,.no.chars.read.--.none.yet.available#0A//...
FALSE.result2.#3D.-3..Polling,.no.chars.read.--.non
e.available#0A//...FALSE.result2.......Error.code#0A
#0AAND.replenish(scb).#3D.VALOF#0A{.LET.rdfn.#3D.sc
b!scb_rdfn#0A..result2.:#3D.-1#0A..//.The.condition
.scb!scb_end<0.indicates.that.the.stream.is.exhaust
ed#0A..UNLESS.scb!scb_end>#3D0.&.rdfn.&.rdfn(scb).R
ESULTIS.FALSE#0A..RESULTIS.TRUE#0A}#0A#0A//.deplete
(scb).returns:#0A//...TRUE..Successful.depletion,.o
r#0A//...FALSE.otherwise#2E#0A//.It.aborts:.187.if.
scb.is.not.a.suitable.stream#2E#0A#0AAND.deplete(sc
b).#3D.VALOF#0A{.LET.wrfn.#3D.scb!scb_wrfn.#0A..IF.
scb!scb_end<0.RESULTIS.FALSE.///.?????.result2#0A..
UNLESS.wrfn.DO.abort(187)#0A//sawritef("BLIB:.deple
te.calling.wrfn(%n)*n",.scb)#0A..RESULTIS.wrfn(scb)
#0A}#0A#0AAND.findinput....(string).......#3D..find
stream(string,.id_inscb,....0)#0A#0AAND.pathfindinp
ut(string,.path).#3D..findstream(string,.id_inscb,.
path)#0A#0AAND.findoutput...(string).......#3D..fin
dstream(string,.id_outscb,...0)#0A#0AAND.findinoutp
ut.(string).......#3D..findstream(string,.id_inouts
cb,.0)#0A#0AAND.findupdate...(string).......#3D..fi
ndstream(string,.id_inoutscb,.0)#0A#0AAND.selectinp
ut(scb).BE.//.scb#3D0.is.occasionally.used#0A{.UNLE
SS.scb#3D0.|.scb!scb_id#3Did_inscb.|.scb!scb_id#3Di
d_inoutscb.DO.abort(186)#0A..cis.:#3D.scb#0A}#0A#0A
AND.selectoutput(scb).BE.//.scb#3D0.is.occasionally
.used#0A{.UNLESS.scb#3D0.|.scb!scb_id#3Did_outscb.|
.scb!scb_id#3Did_inoutscb.DO.abort(187)#0A..cos.:#3D
.scb#0A}#0A#0AAND.endread().BE.endstream(cis)#0A#0A
AND.endwrite().BE.endstream(cos)#0A#0AAND.endstream
(scb).BE.TEST.scb>0#0ATHEN.{.LET.endfn.#3D.scb!scb_
endfn#0A.......LET.res2.#3D.result2#0A.......IF.end
fn.DO.endfn(scb)#0A.......freevec(scb)#0A.......IF.
cis.#3D.scb.DO.cis.:#3D.0#0A.......IF.cos.#3D.scb.D
O.cos.:#3D.0#0A#0A.......result2.:#3D.res2#0A.....}
#0AELSE.IF.scb<0.DO.//.Safety.check#0A.....{.sawrit
ef("*nBLIB:.endstream.given.negative.scb#3D%n*n",.s
cb)#0A.......abort(999)#0A.....}#0A#0AAND.input().#3D
.cis#0A#0AAND.output().#3D.cos#0A#0AAND.readn().#3D
.VALOF#0A{.LET.sum,.ch,.neg.#3D.0,.0,.FALSE#0A#0A..
{.ch.:#3D.rdch()#0A....IF.'0'<#3Dch<#3D'9'.BREAK#0A
....SWITCHON.ch.INTO#0A....{.DEFAULT:...unrdch()#0A
.................result2.:#3D.-1#0A................
.RESULTIS.0#0A......CASE.'*s':#0A......CASE.'*t':#0A
......CASE.'*n':.LOOP#0A#0A......CASE.'-':..neg.:#3D
.TRUE#0A......CASE.'+':..ch.:#3D.rdch()#0A.........
........BREAK#0A....}#0A..}.REPEAT#0A#0A..WHILE.'0'
<#3Dch<#3D'9'.DO#0A..{.sum.:#3D.10.*.sum.+.ch.-.'0'
#0A....ch.:#3D.rdch()#0A..}#0A..IF.neg.DO.sum.:#3D.
-sum#0A..unrdch()#0A..result2.:#3D.0#0A..RESULTIS.s
um#0A}#0A#0AAND.newline().BE.wrch('*n')#0A#0AAND.ne
wpage().BE.wrch('*p')#0A#0AAND.writed(n,.d).BE.writ
edz(n,.d,.FALSE)#0A#0AAND.writez(n,.d).BE.writedz(n
,.d,.TRUE)#0A#0AAND.writedz(n,.d,.zeroes).BE#0A{.LE
T.t.#3D.VEC.10#0A..LET.i.#3D.0#0A..LET.k.#3D.-n#0A#0A
..IF.n<0.DO.{.d.:#3D.d.-.1;.k.:#3D.n.}#0A#0A..{.t!i
.:#3D.-(k.REM.10)#0A....k...:#3D.k/10#0A....i...:#3D
.i.+.1#0A..}.REPEATWHILE.k#0A#0A..IF.n<0.&.zeroes.D
O.wrch('-')#0A..FOR.j.#3D.i+1.TO.d.DO.wrch(zeroes.-
>.'0',.'*s')#0A..IF.(n<0).&.~zeroes.DO.wrch('-')#0A
..FOR.j.#3D.i-1.TO.0.BY.-1.DO.wrch(t!j+'0')#0A}#0A#0A
AND.writen(n).BE.writed(n,.0)#0A#0AAND.writehex(n,.
d).BE.#0A{.IF.d>1.DO.writehex(n>>4,.d-1)#0A..wrch((
n&15)!TABLE.'0','1','2','3','4','5','6','7',#0A....
................'8','9','A','B','C','D','E','F')#0A
}#0A#0AAND.writeoct(n,.d).BE#0A{.IF.d.>.1.DO.writeo
ct(n>>3,.d-1)#0A..wrch((n&7)+'0')#0A}#0A#0AAND.writ
ebin(n,.d).BE#0A{.IF.d.>.1.DO.writebin(n>>1,.d-1)#0A
..wrch((n&1)+'0')#0A}#0A#0AAND.writes(s).BE#0A{.//.
UNLESS.0.<.s.<.rootnode!rtn_memsize.DO.s.:#3D."#23#23
Bad.string#23#23"#0A..FOR.i.#3D.1.TO.s%0.DO.wrch(s%
i)#0A}#0A#0AAND.writet(s,.d).BE#0A{.writes(s)#0A..F
OR.i.#3D.1.TO.d-s%0.DO.wrch('*s')#0A}#0A#0AAND.writ
eu(n,.d).BE#0A{.LET.m.#3D.(n>>1)/5#0A..IF.m.DO.{.wr
ited(m,.d-1);.d.:#3D.1.}#0A..writed(n-m*10,.d)#0A}#0A
#0A#0A/*#0A........The.following.routines.provide.a
nd.extended.version.of.writef#2E#0AThey.support.the
.following.extra.substitution.items:#0A#0A........1
#2E.%F...-.Takes.next.argument.as.a.writef.format.s
tring.and#0A................calls.writef.recursivel
y.using.the.remaining.arguments#2E#0A..............
..The.argument.pointer.is.positioned.to.the.next.av
ailable#0A................argument.on.return#2E#0A#0A
........2#2E.%M...-.The.next.argument.is.taken.as.a
.message.number.and.processed#0A................as.
for.%F.above#2E.The.message.format.string.is.looked
.up.by#0A................get_text(messno,.str,.upb)
.where.str.is.a.vector.local.to#0A................w
ritef.to.hold.the.message.string#2E.This.is.provide
d.to.easy#0A................the.generation.of.messa
ges.in.different.languages#2E#0A#0A........3#2E.%+.
..-.The.argument.pointer.is.incremented.by.1#2E#0A#0A
........4#2E.%-...-.The.argument.pointer.is.decreme
nted.by.1#2E#0A#0A........5#2E.%P...-.Plural.format
ion#2E.The.singular.form.is.use.if.and.only.if#0A..
..............the.next.argument.is.one#2E.So.that.t
he.argument.can.be.used#0A................twice.it.
is.normal.to.preceed.or.follow.the.%P.item.with.%-#2E
#0A................There.are.two.forms.as.follows:#0A
#0A................a#2E.%Pc..-.The.character.c.is.o
utput.if.the.the.next.argument#0A..................
......not.one#2E#0A#0A................b#2E.%P\singu
lar\plural\..-.The.appropriate.text.is.printed,#0A.
.......................skipping.the.other#2E.The.'\
'.chars.are.not.printed#2E#0A#0AExample:.FOR.count.
#3D.0.TO.2.DO#0A............writef("There.%p\.is\ar
e\.%-%n.thing%-%ps#2E*n",.count)#0Aoutputs:#0A.....
....There.are.0.things#2E#0A.........There.is..1.th
ing#2E#0A.........There.are.2.things#2E#0A#0A......
..6#2E.%nOp..eg.%12I.as.an.alternative.to.%IB#0A...
..............where.n.is.a.decimal.number.and.Op.is
.a.format.letter#0A.................expecting.a.fie
ld.width#2E.If.n.is.given.it.specifies.the#0A......
...........field.width.otherwise.it.is.specified,.a
s.before,.by.the#0A.................single.characte
r.(0-9,.A-Z).following.Op#2E#0A#0A........7#2E.%n#2E
md..eg.%8#2E2d#0A..................print.a.fixed.po
int.scaled.decimal.number.in.a.field#0A............
......width.of.n.with.m.digits.after.the.decimal.po
int#2E.For#0A..................example.writef("%8#2E
2d",.1234567).would.output:.12345#2E67#0A..........
........and.....writef("%8#2E0d",.1234567).would.ou
tput:..1234567#0A#0A........8#2E.%#23.....Write.the
.next.argument.using.codewrch,.ie.convert.the#0A...
...............next.argument.to.UTF-8.format#2E#0A*
/#0A#0A//.The.following.version.of.writef.is.new.--
.MR.21/1/04#0A///*#0A#0A//.get_textblib.and.get_tex
t.have.the.same.global.variable.number#0AAND.get_te
xtblib(n,.str,.upb).#3D.VALOF..//.Default.definitio
n.of.get_text#0A...................................
....//.This.is.normally.overridden.#0A.............
..........................//.by.get_text,.defined.e
lsewhere#2E#0A{.LET.s.#3D."<mess:%-%n>"#0A..IF.upb>
s%0.DO.upb.:#3D.s%0#0A..str%0.:#3D.upb#0A..FOR.i.#3D
.1.TO.upb.DO.str%i.:#3D.s%i#0A..RESULTIS.str#0A}#0A
#0AAND.writef(format,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,
p,q,r,s,t,u,v,w,x,y,z).BE#0A{.LET.nextarg.#3D.@a#0A
..write_format(format,.@nextarg)#0A}#0A#0AAND.sawri
tef(format,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,
u,v,w,x,y,z).BE#0A{.LET.nextarg.#3D.@a#0A..LET.wch,
.rch.#3D.wrch,.rdch#0A..wrch,.rdch.:#3D.sawrch,.sar
dch#0A..write_format(format,.@nextarg)#0A..wrch,.rd
ch.:#3D.wch,.rch#0A}#0A#0AAND.write_format(format,.
lvnextarg).BE#0A{.//.writef.and.sawritef.must.prese
rve.result2#0A..LET.res2.#3D.result2#0A#0A..//UNLES
S.0.<.format.<.rootnode!rtn_memsize.DO.format.:#3D.
"#23#23Bad.format#23#23"#0A#0A..FOR.p.#3D.1.TO.form
at%0.DO#0A..{.LET.k,.type,.f,.n,.m,.arg.#3D.format%
p,.?,.?,.?,.?,.?#0A....LET.widthgiven.#3D.FALSE#0A.
...UNLESS.k#3D'%'.DO.{.wrch(k);.LOOP.}#0A#0A....//.
Deal.with.a.substitution.item#0A....p.:#3D.p.+.1#0A
....type,.arg,.n,.m.:#3D.format%p,.!!lvnextarg,.0,.
0#0A#0Asw:.SWITCHON.capitalch(type).INTO#0A....{.DE
FAULT:....wrch(type)#0A..................LOOP#0A#0A
......CASE.'0':CASE.'1':CASE.'2':CASE.'3':CASE.'4':
#0A......CASE.'5':CASE.'6':CASE.'7':CASE.'8':CASE.'
9':#0A..................{.n.:#3D.10*n.+.type.-.'0'#0A
....................p.:#3D.p+1#0A..................
..type.:#3D.format%p#0A....................widthgiv
en.:#3D.TRUE#0A..................}.REPEATWHILE.'0'<
#3Dtype<#3D'9'#0A..................IF.type#3D'#2E'.
DO#0A..................{.p.:#3D.p+1#0A.............
.......type.:#3D.format%p#0A....................WHI
LE.'0'<#3Dtype<#3D'9'.DO#0A....................{.m.
:#3D.10*m.+.type.-.'0'#0A......................p.:#3D
.p+1#0A......................type.:#3D.format%p#0A.
...................}#0A..................}#0A......
............GOTO.sw#0A#0A......CASE.'D':...IF.m.DO#0A
..................{.//.Write.a.number.of.the.form.n
nn#2Enn#0A....................LET.scale.#3D.1#0A...
.................FOR.i.#3D.1.TO.m.DO.scale.:#3D.sca
le.*.10#0A....................writed(arg/scale,.n-1
-m)#0A....................wrch('#2E')#0A...........
.........writez(.ABS.arg.REM.scale,.m)#0A..........
..........!lvnextarg.:#3D.!lvnextarg.+.1#0A........
............LOOP#0A..................}#0A..........
........f.:#3D.writed;....GOTO.getarg#0A#0A#0A.....
.CASE.'S':...f.:#3D.writes;....GOTO.noargs#0A......
CASE.'T':...f.:#3D.writet;....GOTO.getarg#0A......C
ASE.'C':...f.:#3D.wrch;......GOTO.noargs#0A......CA
SE.'#23':...f.:#3D.codewrch;...GOTO.noargs#0A......
CASE.'O':...f.:#3D.writeoct;..GOTO.getarg#0A......C
ASE.'X':...f.:#3D.writehex;..GOTO.getarg#0A......CA
SE.'I':...f.:#3D.writed;....GOTO.getarg#0A......CAS
E.'N':...f.:#3D.writen;....GOTO.noargs#0A......CASE
.'U':...f.:#3D.writeu;....GOTO.getarg#0A......CASE.
'Z':...f.:#3D.writez;....GOTO.getarg#0A......CASE.'
B':...f.:#3D.writebin;..GOTO.getarg#0A#0A....getarg
:.......UNLESS.widthgiven.DO#0A..................{.
p.:#3D.p.+.1#0A....................n.:#3D.capitalch
(format%p)#0A....................n.:#3D.'0'.<#3D.n.
<#3D.'9'.->.n.-.'0',.10.+.n.-.'A'#0A...............
...}#0A#0A....noargs:.......f(arg,.n)#0A...........
.......!lvnextarg.:#3D.!lvnextarg.+.1#0A...........
.......LOOP#0A#0A......CASE.'$':#0A......CASE.'+':.
..!lvnextarg.:#3D.!lvnextarg.+.1#0A................
..LOOP#0A#0A......CASE.'-':...!lvnextarg.:#3D.!lvne
xtarg.-.1#0A..................LOOP#0A#0A......CASE.
'M':.{.LET.buf.#3D.VEC.256/bytesperword#0A.........
.........!lvnextarg.:#3D.!lvnextarg.+.1#0A.........
.........UNLESS.get_text(arg,.buf,.256/bytesperword
).DO#0A....................buf.:#3D."<<mess:%-%n>>"
..//.No.message.text#0A..................write_form
at(buf,.lvnextarg)#0A..................LOOP#0A.....
...........}#0A#0A......CASE.'F':...!lvnextarg.:#3D
.!lvnextarg.+.1#0A..................write_format(ar
g,.lvnextarg)#0A..................LOOP#0A#0A......C
ASE.'P':.{.LET.plural.#3D.arg.~#3D.1#0A............
......!lvnextarg.:#3D.!lvnextarg.+.1#0A............
......p.:#3D.p+1#0A..................type.:#3D.form
at%p#0A..................IF.type.#3D.'\'.DO#0A.....
.............{.//.Deal.with.%P\singular\plural\.ite
m#0A....................LET.skipping.#3D.plural#0A.
...................p.:#3D.p.+.1#0A.................
...UNTIL.p.>.format%0.DO#0A....................{.LE
T.ch.#3D.format%p#0A......................TEST.ch.#3D
.'\'.THEN.{.skipping.:#3D.~skipping#0A.............
..............................IF.skipping.#3D.plura
l.BREAK#0A.........................................
}#0A....................................ELSE.UNLESS
.skipping.DO.wrch(ch)#0A......................p.:#3D
.p.+.1#0A....................}#0A..................
..LOOP#0A..................}#0A#0A.................
.//.Deal.with.simple.%Pc.items#0A..................
IF.plural.DO.wrch(type)#0A..................LOOP#0A
................}#0A....}.//.End.of.SWITCHON.#2E#2E
#2E#0A..}.//.End.of.FOR.p.#3D.#2E#2E#2E#0A#0A..resu
lt2.:#3D.res2#0A}#0A#0ALET.randno(upb).#3D.VALOF../
/.return.a.random.number.in.the.range.1.to.upb#0A{.
randseed.:#3D.randseed*2147001325.+.715136305#0A..R
ESULTIS.(ABS(randseed/3)).REM.upb.+.1#0A}#0A#0AAND.
setseed(newseed).#3D.VALOF.//.Added.by.MR.20/01/200
0#0A{.LET.oldseed.#3D.randseed#0A..randseed.:#3D.ne
wseed#0A..RESULTIS.oldseed#0A}#0A#0A//.muldiv.is.no
w.implemented.in.SYSLIB.using.the.MDIV.instruction#0A
//.NO.--.MDIV.sometimes.causes.a.floating.point.exc
eption#0AAND.muldiv(a,.b,.c).#3D.sys(Sys_muldiv,.a,
.b,.c)#0A#0AAND.unpackstring(s,.v).BE.FOR.i.#3D.s%0
.TO.0.BY.-1.DO.v!i.:#3D.s%i#0A#0AAND.packstring(v,.
s).#3D.VALOF#0A{.LET.n.#3D.v!0.&.255#0A..LET.size.#3D
.n/bytesperword#0A..FOR.i.#3D.0.TO.n.DO.s%i.:#3D.v!
i#0A..FOR.i.#3D.n+1.TO.(size+1)*bytesperword-1.DO.s
%i.:#3D.0#0A..RESULTIS.size#0A}#0A#0AAND.capitalch(
ch).#3D.'a'.<#3D.ch.<#3D.'z'.->.ch.+.'A'.-.'a',.ch#0A
#0AAND.compch(ch1,.ch2).#3D.capitalch(ch1).-.capita
lch(ch2)#0A#0AAND.compstring(s1,.s2).#3D.VALOF#0A{.
LET.lens1,.lens2.#3D.s1%0,.s2%0#0A..LET.smaller.#3D
.lens1.<.lens2.->.s1,.s2#0A..FOR.i.#3D.1.TO.smaller
%0.DO#0A..{.LET.res.#3D.compch(s1%i,.s2%i)#0A....IF
.res.RESULTIS.res#0A..}#0A..IF.lens1.#3D.lens2.RESU
LTIS.0#0A..RESULTIS.smaller.#3D.s1.->.-1,.1#0A}#0A#0A
AND.str2numb(s).#3D.VALOF.//.Deprecated#0A{.LET.a.#3D
.0#0A..FOR.i.#3D.1.TO.s%0.DO.{.LET.dig.#3D.s%i.-.'0
'#0A........................IF.0<#3Ddig<#3D9.DO.a.:
#3D.10*a.+.dig#0A......................}#0A..RESULT
IS.s%1#3D'-'.->.-a,.a#0A}#0A#0AAND.getkey(keys,.i,.
keyword).#3D.VALOF#0A{.LET.len.#3D.keys%0#0A..LET.n
.#3D.0#0A..LET.p.#3D.1#0A#0A..UNTIL.p>len.DO#0A..{.
UNLESS.i.BREAK#0A....IF.keys%p#3D','.DO.i.:#3D.i-1#0A
....p.:#3D.p+1#0A..}#0A#0A..WHILE.p.<#3D.len.DO#0A.
.{.LET.ch.#3D.keys%p#0A....IF.ch#3D'/'.|.ch#3D'#3D'
.|.ch#3D','.BREAK#0A....n.:#3D.n.+.1#0A....keyword%
n.:#3D.keys%p#0A....p.:#3D.p.+.1#0A..}#0A#0A..keywo
rd%0.:#3D.n#0A..RESULTIS.keyword#0A}#0A#0A/*.rdargs
.provides.the.programmer.with.the.facility.to.read#0A
...arguments.from.the.currently.selected.input.and.
store.them.in.a#0A...vector.as.shown.below:#0A#0A..
........................|----------|#0A............
..............|address1..|#0A......................
....|__________|#0A..........................|.TRUE
.....|<-.logic.switch.value#0A.....................
.....|__________|.#0A..........................|add
ress2..|#0A..........................|----------|#0A
..........................|item1.....|#0A..........
................|__________|#0A....................
......|item2.....|#0A..........................|___
_______|#0A#0AThe.possible.key.qualifiers.are:#0A#0A
../k...keyed....--.argument.requires.the.keyword#0A
../p...prompted.--.prompt.will.be.displayed..(This.
option.may.be.scrapped)#0A../a...required.--.if.thi
s.argument.is.not.entered.an.error.will.follow#0A..
/n...numeric..--.argument.has.to.be.a.number#0A../s
...switch...--.exact.switch.word.has.to.be.entered.
for.TRUE#0A*/..#0A#0AAND.rdargs(keys,.argv,.size).#3D
.VALOF#0A{.MANIFEST#0A..{.required....#3D.1........
..........//..1.../A#0A....keyed.......#3D.1.<<.1..
...........//..2.../K#0A....switch......#3D.1.<<.2.
............//..4.../S#0A....prompt......#3D.1.<<.3
.............//..8.../P#0A....number......#3D.1.<<.
4.............//.16.../N#0A....control.....#3D.(num
ber.<<.1).-.1..//.31...All.the.flags#0A..}#0A#0A..L
ET.w........#3D.argv.//.w.is.a.moving.positional.po
inter.of.the.argv.vector#0A..LET.numbargs.#3D.?#0A.
.LET.status...#3D.TRUE...//.Set.to.FALSE.when.an.er
ror.is.encountered#0A..LET.keyword..#3D.VEC.30#0A#0A
..!w.:#3D.0#0A#0A////////////////.A.BIT.MAP.REPRESE
NTING.THE.KEY.QUALIFIERS.IS.///////////////#0A/////
//////////..PUT.INTO.THE.TOP.LOCATIONS.OF.THE.VECTO
R.....///////////////.#0A#0A..//.A.typical.key.stri
ng.is:."FROM#3DDATA/A,TO/K,VAL/K/N,T#3DTRACE/S"#0A.
.FOR.p.#3D.1.TO.keys%0.DO#0A..{.LET.kch.#3D.keys%p#0A
#0A....IF.kch.#3D.'/'.DO#0A....{.LET.c.#3D.capitalc
h(keys%(p+1))#0A......IF.c.#3D.'A'.DO.!w.:#3D.!w.|.
required#0A......IF.c.#3D.'K'.DO.!w.:#3D.!w.|.keyed
#0A......IF.c.#3D.'S'.DO.!w.:#3D.!w.|.switch#0A....
..IF.c.#3D.'P'.DO.!w.:#3D.!w.|.prompt#0A......IF.c.
#3D.'N'.DO.!w.:#3D.!w.|.number#0A....}#0A#0A....IF.
kch.#3D.','.DO#0A....{.w.:#3D.w.+.1#0A......!w.:#3D
.0#0A....}#0A..}#0A#0A..w.:#3D.w.+.1#0A..numbargs.:
#3D.w.-.argv..//.as.deduced.from.the.keys.string#0A
#0A#0A/////////////////////////////////////////////
///////////////////////////#0A/////////////////////
///.BEGINNING.OF.REPEAT.LOOP.//////////////////////
#0A////////////////////////////////////////////////
////////////////////////#0A#0A..{.LET.argno.#3D.-1#0A
....LET.wsize.#3D.size.-.(w.-.argv).//.Number.of.wo
rds.remaining.in.argv#0A....LET.itemtype.#3D.rditem
(w,.wsize)#0A//sawritef("BLIB:.rdargs..itemtype#3D%
n*n",.itemtype)#0A....clear_words(keyword,.31)#0A#0A
....SWITCHON.itemtype.INTO#0A....{.DEFAULT:.//.Unkn
own.item.type#0Aerr:#0A.............{.LET.ch.#3D.?#0A
//sawritef("BLIB:.rdargs.error.--.skipping.to.end.o
f.line*n")#0A...............unrdch()...//.MR.14/7/0
3#0A...............ch.:#3D.rdch().REPEATUNTIL.ch#3D
'*n'.|#0A........................................ch
#3D';'..|#0A.......................................
.ch#3Dendstreamch#0A#0A...............result2.:#3D.
120..//.Fault:.Argument.line.#0A...................
............//.invalid.or.too.long#0A..............
.RESULTIS.0......//.Error.result#0A.............}#0A
#0A......CASE.0:..//.endstreamch#0A......CASE.3:../
/.newline#0A......CASE.4:..//.semicolon#0A//.These.
item.types.mark.the.end.of.the.argument.list#2E#0A#0A
//.Now.check.for.prompted.arguments#2E#0A#0A.......
........FOR.i.#3D.0.TO.numbargs.-1.IF.0<#3Dargv!i<#3D
control.DO#0A...............{.//.Unset.argument.fou
nd#0A.................LET.a.#3D.argv!i#0A#0A.......
..........IF.status.&.((a.&.prompt).~#3D.0).DO#0A..
...............{.//.if.ok.so.far.&.prompted#0A.....
..............IF.cis!scb_type.#3D.scbt_console.&#0A
......................cos!scb_type.#3D.scbt_console
.DO#0A...................{.writes(getkey(keys,.i,.k
eyword))#0A.....................UNLESS.(a.&.switch)
.#3D.0.DO.writes(".(yes/no)")#0A...................
..writes(".>.").//.write.prompt#0A.................
....deplete(cos).//.MR.13/1/03#0A#0A...............
......itemtype.:#3D.rditem(w,.wsize)#0A............
.........SWITCHON.itemtype.INTO#0A.................
....{.CASE.1:.//.Unquoted.item#0A..................
.....CASE.2:.//.Quoted.item#0A//writef("*nvalue#3D%
s*n",.w)#0A...............................IF.(a.&.s
witch).~#3D.0.DO#0A...............................{
.IF.compstring(w,."yes").#3D.0.DO#0A...............
..................{.argv!i.:#3D.TRUE#0A............
.......................LOOP.//.Find.next.uset.argum
ent#0A.................................}#0A........
.........................IF.compstring(w,."no").#3D
.0.DO#0A.................................{.argv!i.:
#3D.FALSE#0A...................................LOOP
.//.Find.next.uset.argument#0A.....................
............}#0A...............................}#0A
#0A...............................IF.(a.&.number).~
#3D.0.DO#0A...............................{.argv!i.
:#3D.w...//.numeric#0A.............................
....IF.string_to_number(w).DO#0A...................
..............{.!w.:#3D.result2#0A.................
..................w..:#3D.w.+.1#0A.................
..................LOOP.//.Find.next.uset.argument#0A
.................................}#0A..............
...................status.:#3D.FALSE#0A............
.....................argv!i.:#3D.0#0A..............
...................LOOP.//.Find.next.uset.argument#0A
...............................}#0A#0A.............
..................//.Non.switch.non.numeric.argumen
t#0A//writef("*nargv!%n.#3D.%s..non.switch/num*n",.
i,.w)#0A...............................argv!i.:#3D.
w#0A...............................w.:#3D.w.+.w%0/b
ytesperword.+.1#0A...............................ws
ize.:#3D.size.-.(w.-.argv).....#0A.................
..............LOOP.//.Find.next.unset.argument#0A#0A
.......................CASE.0:#0A..................
.....CASE.3:#0A.......................CASE.4:#0Awri
tef("BLIB:.rdargs:.case.0,.3.or.4.reached*n")#0A...
............................ENDCASE#0A#0A..........
.............DEFAULT:#0A...........................
....status.:#3D.FALSE#0A...........................
....LOOP#0A.....................}#0A...............
....}#0A.................}#0A......................
......#0A.................TEST.(a.&.required).#3D.0
..//.final.check.for.required#0A.................TH
EN.argv!i.:#3D.0.........//.argument.-.clear.memory
#0A.................ELSE.status.:#3D.FALSE.....//.i
f.no.input.made.and.not.#0A........................
..................//.required#0A...............}.//
.End.of.for-loop#0A#0A...............UNLESS.status.
GOTO.err#0A...............result2.:#3D.0#0A........
.......FOR.i.#3D.0.TO.numbargs-1.IF.argv!i.DO.resul
t2.:#3D.result2.+.1#0A...............//.result2.#3D
.number.of.args.given#0A//...............writef("*n
itemtype#3D%n.calling.rdch().#3D>.'%c'*n",.itemtype
,.rdch())#0A//...............writef("*nreturning.rd
ch().#3D>.'%c'*n",.rdch())#0A...............RESULTI
S.w#0A#0A.....CASE.1:...//.Ordinary.item#0A........
.......//.notice.that.the.CASE.1.and.CASE.2.section
s.will#0A...............//.both.be.executed.consecu
tively.for.any.input.other.#0A...............//.the
n.items.in.quotes#0A#0A...............argno.:#3D.fi
ndarg(keys,.w)#0A//writef("Ordinary.item.%s..argno#3D
%n*n",.w,.argno)#0A#0A...............TEST.argno.>#3D
.0#0A...............THEN.{.UNLESS.0.<#3D.argv!argno
.<#3D.control.GOTO.err#0A#0A......................I
F.(argv!argno.&.switch).~#3D.0.DO#0A...............
.......{.argv!argno.:#3D.-1#0A.....................
...LOOP#0A......................}#0A#0A............
..........{.LET.item.#3D.rditem(w,.wsize)#0A#0A....
....................IF.item.#3D.5.DO.item.:#3D.rdit
em(w,.wsize).//.Skip.'#3D'#0A#0A...................
.....IF.item.<#3D.0.|.item#3D3.|.item#3D4.|.item#3D
5.GOTO.err#0A......................}#0A............
........}#0A#0A...............ELSE.TEST.rdch().#3D.
'*n'.&.compstring("?",.w).#3D.0#0A.................
...THEN.{.writef("%s:.",.keys)#0A..................
.........deplete(cos).//.MR.13/1/03#0A.............
..............ENDCASE#0A.........................}#0A
....................ELSE.unrdch()#0A#0A//.Deliberat
e.missing.'ENDCASE'#0A#0A............CASE.2:.//.ite
m.was.not.a.keyword.or.was.put.in.quotes#0A........
........IF.argno.<.0.DO......//.find.first.non-keye
d,.non-switch#0A..................FOR.i.#3D.0.TO.nu
mbargs.-.1.DO#0A....................IF.0.<#3D.argv!
i.<#3D.control.&#0A.......................(argv!i.&
.switch).#3D.0..&#0A.......................(argv!i.
&.keyed)..#3D.0..DO.#0A....................{.argno.
:#3D.i#0A......................BREAK#0A............
........}#0A#0A//.The.FOR-loop.below.the.CASE.2.end
s.here#0A#0A................UNLESS.argno.>#3D.0.DO#0A
................{.//.keyword.is.not.recognized#0A..
................GOTO.err.....//.MR.27/3/03#0A......
............status.:#3D.FALSE#0A..................L
OOP#0A................}#0A#0A................UNLESS
.0.<#3D.argv!argno.<#3D.control.GOTO.err#0A#0A//.Th
is.part.of.the.module.is.always.executed.if.the.ent
ered.argument.was#0A//.found.to.be.valid;.an.addres
s.from.vector.is.stored.in.the.top.half#0A//.of.the
.vector.argv#0A#0A................{.LET.a.#3D.argv!
argno#0A#0A..................IF.(a.&.number).~#3D.0
.DO#0A..................{.IF.string_to_number(w).DO
.//.check.if.the#0A....................{.argv!argno
.:#3D.w#0A......................!w.:#3D.result2....
.......//.expected.numeric.input#0A................
......w..:#3D.w.+.1.............//.can.be.string.co
nverted#0A......................LOOP#0A............
........}#0A#0A....................//.Number.cannot
.be.converted#0A....................status.:#3D.FAL
SE#0A....................argv!argno.:#3D.0#0A......
..............LOOP#0A..................}#0A#0A.....
.............//.Store.ordinary.argument.value#0A...
...............argv!argno.:#3D.w#0A................
..w.:#3D.w.+.w%0/bytesperword.+.1#0A...............
...LOOP#0A................}#0A....}.//.End.of.main.
switch#0A..}.REPEAT#0A}#0A#0A//.Read.an.item.from.c
urrent.input.stream#0A#0A//.returns.-1....error,.in
put.too.long.or.unmatched.quote#0A//..........0....
endstreamch............***.MR.change.11/12/92#0A//.
.........1....unquoted.item#0A//..........2....quot
ed.item#0A//..........3....*n.....................*
**.MR.change.11/12/92#0A//..........4....;.........
.............***.MR.change.11/12/92#0A//..........5
....#3D......................***.MR.change.12/07/03
#0A#0A//.When.an.unquoted.item.is.read.its.terminat
ing.character.is#0A//.unrdch-ed.so.that.it.can.be.r
ead.again.by.the.next.call.of.rdch#2E#0A//.All.item
s.other.items,.namely.strings,.newline,.';',.'#3D'.
and#0A//.endstreamch,.are.self.terminating.and.so.d
o.not.need.unrdch#0A//.to.be.called#2E#0A#0AAND.rdi
tem(v,.upb).#3D.VALOF#0A{.LET.p,.pmax.#3D.0,.(upb+1
)*bytesperword-1#0A..//.With.bytesperword#3D4#0A../
/.upb#3D0.#3D>.pmax#3D3#0A..//.upb#3D1.#3D>.pmax#3D
7#0A..//.#2E#2E#2E#0A..LET.ch,.quoted.#3D.rdch(),.F
ALSE#0A#0A..FOR.i.#3D.0.TO.upb.DO.v!i.:#3D.0#0A#0A/
/sawritef("*nrditem.first.ch.#3D.'%c'*n",.ch)#0A#0A
..//.Skip.over.white.space#2E#0A..WHILE.ch#3D'*s'.|
.ch#3D'*t'.|.ch#3D'*c'DO.ch.:#3D.rdch().#0A#0A..IF.
ch#3Dendstreamch.RESULTIS..0...//.EOF#0A..IF.ch#3D'
*n'........RESULTIS..3...//.'*n'#0A..IF.ch#3D';'...
......RESULTIS..4...//.';'#0A..IF.ch#3D'#3D'.......
..RESULTIS..5...//.'#3D'#0A#0A..IF.ch#3D'"'.DO.{.ch
.:#3D..rdch()#0A.................IF.ch#3D'*c'.LOOP#0A
.................IF.ch#3D'*n'.|.ch#3Dendstreamch.RE
SULTIS.-1.//.Error#0A.................IF.ch#3D'"'.R
ESULTIS.2.//.Found.a.quoted.string#2E#0A...........
......IF.ch#3D'**'.DO.{.ch.:#3D.rdch()#0A..........
.......................IF.capitalch(ch)#3D'N'..DO.c
h.:#3D.'*n'#0A.................................IF.c
apitalch(ch)#3D'*"'.DO.ch.:#3D.'*"'.//.MR.8/1/03#0A
...............................}#0A................
.p.:#3D.p+1#0A.................IF.p>pmax.RESULTIS.-
1.//.Error#0A.................v%0,.v%p.:#3D.p,.ch#0A
...............}.REPEAT#0A#0A..//.Copy.chars.of.an.
unquoted.item.into.v#0A..UNTIL.ch#3D'*n'.|.ch#3D'*s
'.|.ch#3D'*t'.|.ch#3D';'.|.ch#3D'#3D'.|.ch#3Dendstr
eamch.DO#0A..{.p.:#3D.p+1#0A....IF.p>pmax.RESULTIS.
-1..............//.Error#0A....v%0,.v%p.:#3D.p,.ch#0A
....ch.:#3D.rdch().REPEATWHILE.ch#3D'*c'#0A..}#0A..
//.Unrdch.its.terminating.character#0A#0A//sawritef
("rditem.returning.type.1.%s,.ch#3D%x2.'%c'*n",.v,.
ch,.ch)#0A..UNLESS.ch#3Dendstreamch.DO.unrdch()#0A.
.RESULTIS.1............................//.Unquoted.
item#0A}#0A#0AAND.findarg(keys,.w).#3D.VALOF#0A{.MA
NIFEST.{.matching.#3D.0;.skipping.#3D.1.}#0A..LET.s
tate,.wp,.argno.#3D.matching,.0,.0#0A..FOR.i.#3D.1.
TO.keys%0.DO#0A..{.LET.kch#3Dkeys%i#0A....IF.state#3D
matching.DO#0A....{.IF.(kch#3D'#3D'.|.kch#3D'/'.|.k
ch#3D',').&.wp#3Dw%0.DO#0A........RESULTIS.argno#0A
......wp.:#3D.wp.+.1#0A......UNLESS.compch(kch,.w%w
p).#3D.0.DO.state.:#3D.skipping#0A....}#0A....IF.kc
h#3D','.|.kch#3D'#3D'.DO.state,.wp.:#3D.matching,.0
#0A....IF.kch.#3D.','.DO.argno.:#3D.argno.+.1#0A..}
#0A..IF.state.#3D.matching.&.wp.#3D.w%0.RESULTIS.ar
gno#0A..RESULTIS.-1#0A}#0A#0AAND.createco(fn,.size)
.#3D.VALOF#0A{.LET.c.#3D.getvec(size+6)#0A..UNLESS.
c.RESULTIS.0#0A..FOR.i.#3D.6.TO.size+6.DO.c!i.:#3D.
stackword#0A#0A..//.Using.P.to.denote.the.current.s
tack.frame#0A..//.pointer,.the.following.assumption
s.are.made:#0A..//..P!0,.P!1,.P!2.contain.the.retur
n.link.information#0A..//..P!3...is.the.variable.fn
#0A..//..P!4...is.the.variable.size#0A..//..P!5...i
s.the.variable.c#0A#0A..//.Now.make.the.vector.c.in
to.a.valid.BCPL#0A..//.stack.frame.containg.copies.
of.fn,.size#0A..//.and.c.in.the.same.relative.posit
ions#2E#0A..//.Other.locations.in.the.new.stack.fra
me.#0A..//.are.used.for.other.purposes#2E#0A..c!0.:
#3D.c<<B2Wsh.//.resumption.point#0A..c!1.:#3D.currc
o...//.parent.link#0A..c!2.:#3D.colist...//.colist.
chain#0A..c!3.:#3D.fn.......//.the.main.function#0A
..c!4.:#3D.size.....//.the.coroutine.size#0A..c!5.:
#3D.c........//.the.new.coroutine.pointer#0A#0A..co
list.:#3D.c..//.insert.into.the.list.of.coroutines#0A
#0A..changeco(0,.c)#0A#0A..//.Execution.now.continu
es.with.the.P.pointer.set.to.c<<B2Wsh,#0A..//.and.s
o..the.vector.c.becomes.the.current.stack.frame#2E#0A
..//.The.compiler.will.have.generated.code.on#0A../
/.the.assumption.that.fn.and.c.are.the.third.and.fi
fth#0A..//.words.of.the.stack.frame,.and,.since.c!3
.and.c!5#0A..//.were.initialised.to.fn.and.c,.the.f
ollowing.repeated#0A..//.statement.will.have.the.ef
fect.(naively).expected#2E#0A..//.Note.that.the.fir
st.call.of.cowait.causes.a.return#0A..//.from.creat
eco.with.result.c#2E#0A#0A..c.:#3D.fn(cowait(c)).RE
PEAT#0A}#0A#0AAND.deleteco(cptr).#3D.VALOF#0A{.LET.
a.#3D.@colist#0A#0A..{.LET.co.#3D.!a#0A....UNLESS.c
o.DO#0A....{.sawritef("BLIB.co#3D%n:.cannot.deletec
o.%n.--.not.found*n",#0A.........currco,.cptr)#0A..
....abort(112)#0A......RESULTIS.FALSE#0A....}#0A...
.IF.co#3Dcptr.BREAK#0A....a.:#3D.@.co!co_list#0A..}
.REPEAT#0A#0A..IF.cptr!co_parent.DO#0A..{.sawritef(
"BLIB.co#3D%n:.cannot.deleteco.%n.--.has.a.parent*n
",#0A.......currco,.cptr)#0A....abort(112)#0A....RE
SULTIS.FALSE#0A..}#0A#0A..!a.:#3D.cptr!co_list.....
.//.Remove.the.coroutine.from.colist#2E#0A..freevec
(cptr)...........//.Free.the.coroutine.stack#2E#0A.
.RESULTIS.TRUE#0A}#0A#0AAND.callco(cptr,.a).#3D.VAL
OF#0A{.IF.cptr!co_parent.DO.abort(110)#0A..cptr!co_
parent.:#3D.currco#0A..RESULTIS.changeco(a,.cptr)#0A
}#0A#0AAND.resumeco(cptr,.a).#3D.VALOF#0A{.LET.pare
nt.#3D.currco!co_parent#0A..currco!co_parent.:#3D.0
#0A..IF.cptr!co_parent.DO.abort(111)#0A..cptr!co_pa
rent.:#3D.parent#0A..RESULTIS.changeco(a,.cptr)#0A}
#0A#0AAND.cowait(a).#3D.VALOF#0A{.LET.parent.#3D.cu
rrco!co_parent#0A..currco!co_parent.:#3D.0#0A..RESU
LTIS.changeco(a,.parent)#0A}#0A#0AAND.initco(fn,.si
ze,.a,.b,.c,.d,.e,.f,.g,.h,.i,.j,.k).#3D.VALOF#0A{.
LET.cptr.#3D.createco(fn,.size)#0A..IF.cptr.DO.call
co(cptr,.@a)#0A..RESULTIS.cptr#0A}#0A#0A/*......res
.:#3D.startco(body,.arg,.stsize)#0A#0A........The.r
outine.'body'.is.created.as.a.coroutine.with.a.stac
ksize.'stsize'#0A........and.'arg'.passed.as.an.arg
ument#2E..The.result.is.the.stackbase.of#0A........
the.coroutine#2E#0A*/#0A#0AAND.startco(body,.arg,.s
tsize).#3D.VALOF#0A{.LET.newco.#3D.createco(body,.s
tsize)#0A//sawritef("BLIB:.callco(%n,%n)*n",.newco,
.arg)#0A...IF.newco.DO.callco(newco,.arg)#0A...RESU
LTIS.newco#0A}#0A#0A//.object.making.function#0AAND
.mkobj(upb,.fns,.a,.b,.c,.d,.e,.f,.g,.h,.i,.j,.k).#3D
.VALOF#0A{.LET.obj.#3D.getvec(upb)#0A..UNLESS.obj#3D
0.DO#0A..{.!obj.:#3D.fns#0A....InitObj#23(obj,.@a).
//.Send.the.InitObj.message.to.the.object#0A..}#0A.
.RESULTIS.obj#0A}#0A#0AAND.instrcount(fn,.a,b,c,d,e
,f,g,h,i,j,k).#3D.VALOF#0A{.LET.res.#3D.0#0A..LET.c
ount.#3D.sys(Sys_setcount,.maxint)..//.Set.count.re
gister.to.maxint#0A..result2.:#3D.fn(a,b,c,d,e,f,g,
h,i,j,k)#0A..res.:#3D.sys(Sys_setcount,.count).....
...//.Restore.previous.value#0A....................
...........//.returning.the.modified.count#0A..RESU
LTIS.maxint.-.res.-.32...//.Correct.for.overhead#0A
}#0A#0AAND.datstring(v).#3D.VALOF#0A{.LET.datv.#3D.
VEC.2#0A..datstamp(datv)#0A..dat_to_strings(datv,.v
)#0A..RESULTIS.v#0A}#0A#0AAND.dat_to_strings(datv,.
v).#3D.VALOF#0A#0A//.Returns.v.containing.3.strings
.representing.the#0A//.time.and.date.given.in.datv,
.where#0A//.datv!0.#3D.days,.datv!1.#3D.mins,.datv!
2.#3D.ticks#2E#0A//.On.return,.v.contains.a.the.dat
e.in.the.form#0A//.DD-MMM-YY,.v+5.contains.the.time
.in.the.format#0A//.HH:MM:SS,.and.V+10.contains.the
.day.of.the.week#2E#0A//.Vector.v.should.have.an.up
perbound.of.14#0A//.If.the.date.is.unset.(days.#3D.
0).then.the.strings#0A//.are.all.set.to."<unset>"#0A
#0A{.LET.days,..mins,..ticks.#3D.datv!0,.datv!1,.da
tv!2#0A..LET.datestr,.timestr,.dowstr.#3D.v,.v+5,.v
+10#0A..LET.dayofweek.#3D.days.REM.7#0A..LET.dowtem
p.#3D.?#0A..LET.year.#3D.1978.//.Cintpos.base.year#0A
..LET.month.#3D.1#0A..LET.hours,.secs.#3D.?,.?#0A..
LET.monthtab.....#3D.TABLE...0,.31,.59,.90,120,151,
#0A...........................181,212,243,273,304,3
34,365#0A..LET.leapmonthtab.#3D.TABLE...0,.31,.60,.
91,121,152,#0A...........................182,213,24
4,274,305,335,366#0A..LET.mchars.#3D."JanFebMarAprM
ayJunJulAugSepOctNovDec"#0A..LET.mcharbase.#3D.?#0A
..LET.mtable.#3D.?#0A#0A//sawritef("BLIB:.dat_to_st
ring:.entered*n")#0A#0A..//.Deal.with.case.of.unset
.date#0A..IF.days.#3D.0.DO#0A..{.LET.unset.#3D."<un
set>"#0A....FOR.z.#3D.0.TO.unset%0.DO.#0A....{.LET.
c.#3D.unset%z#0A......datestr%z.:#3D.c#0A......time
str%z.:#3D.c#0A......dowstr%z..:#3D.c#0A....}#0A...
.RESULTIS.v#0A..}#0A#0A..days.:#3D.days.+.1#0A..FOR
.j#3D0.TO.9.DO.datestr%j.:#3D."DD-MMM-YY"%j#0A..FOR
.j#3D0.TO.8.DO.timestr%j.:#3D."HH:MM:SS"%j#0A#0A../
/.Construct.date#0A#0A..{.//.Loop.to.get.year#0A...
.LET.yearlen.#3D.isleap(year).->.366,.365#0A....IF.
0.<.days.<#3D.yearlen.BREAK#0A....days,.year.:#3D.d
ays.-.yearlen,.year.+.1#0A..}.REPEAT#0A#0A..datestr
%8.:#3D.year/10.REM.10.+.'0'#0A..datestr%9.:#3D.yea
r....REM.10.+.'0'#0A.#0A..//.Find.month#0A..mtable.
:#3D.isleap(year).->.leapmonthtab,.monthtab#0A#0A..
{.IF.days.<#3D.mtable.!.month.BREAK#0A....month.:#3D
.month.+.1#0A..}.REPEAT#0A#0A..mcharbase.:#3D.month
*3.-.2#0A..FOR.j#3D0.TO.2.DO.datestr%(4+j).:#3D.mch
ars.%.(mcharbase.+.j)#0A..days.:#3D.days.-.mtable.!
.(month.-.1)#0A..datestr%1.:#3D.days/10.+.'0'#0A..d
atestr%2.:#3D.days.REM.10.+.'0'#0A#0A..//.Construct
.time#0A#0A..hours.:#3D.mins/60#0A..mins.:#3D.mins.
REM.60#0A#0A..//.treat.ticks.as.unsigned.integers#0A
..secs.:#3D.(ticks>>1)./.(tickspersecond>>1)#0A#0A.
.timestr%1.:#3D.hours/10.+.'0'#0A..timestr%2.:#3D.h
ours.REM.10.+.'0'#0A..timestr%4.:#3D.mins/10.+.'0'#0A
..timestr%5.:#3D.mins.REM.10.+.'0'#0A..timestr%7.:#3D
.secs/10.REM.10.+.'0'#0A..timestr%8.:#3D.secs.REM.1
0.+.'0'#0A#0A..//.Get.day.of.week#0A....#0A..dowtem
p.:#3D.VALOF.SWITCHON.dayofweek.INTO#0A......{.CASE
.0:.RESULTIS."Sunday"#0A........CASE.1:.RESULTIS."M
onday"#0A........CASE.2:.RESULTIS."Tuesday"#0A.....
...CASE.3:.RESULTIS."Wednesday"#0A........CASE.4:.R
ESULTIS."Thursday"#0A........CASE.5:.RESULTIS."Frid
ay"#0A........CASE.6:.RESULTIS."Saturday"#0A......}
#0A#0A..FOR.j.#3D.0.TO.dowtemp%0.DO.dowstr%j.:#3D.d
owtemp%j#0A#0A..RESULTIS.v#0A}#0A#0AAND.isleap(year
).#3D.year.REM.400.#3D.0.->.TRUE,#0A...............
....year.REM.100.#3D.0.->.FALSE,#0A................
...year.REM...4.#3D.0.->.TRUE,#0A..................
.....................FALSE#0A#0AAND.testbit(bitno,.
bitvec).#3D.VALOF#0A//.This.function.returns.a.non.
zero.value.if.the.specified.bit.in#0A//.bitvec.is.a
.one,.otherwise.it.returns.zero#2E#0A//.Bits.are.nu
mbered.from.zero.starting.at.the.least.significant.
bit#0A//.of.bitvec!0#2E#0A//.bitvec!0.holds.bits.0.
to.bitsperword-1#0A//.bitvec!1.holds.bits.bitsperwo
rd.to.2*bitsperword-1#0A//.etc#0A{.LET.i.#3D.bitno.
./..bitsperword#0A..AND.s.#3D.bitno.REM.bitsperword
#0A..RESULTIS.bitvec!i.&.(1<<s)#0A}#0A#0AAND.setbit
(bitno,.bitvec,.state).#3D.VALOF#0A//.This.function
.sets.the.specified.bit.in.bitvec.to.1.or.0.dependi
ng#0A//.on.whether.state.is.TRUE.or.FALSE,.respecti
vely#2E.It.returns.a#0A//.non-zero.value.if.the.pre
vious.setting.of.the.bit.was.a.one,.otherwise#0A//.
it.returns.zero#2E.See.testbit.above#2E#0A{.LET.i.#3D
.bitno../..bitsperword#0A..AND.s.#3D.bitno.REM.bits
perword#0A..LET.mask.#3D.1.<<.s#0A..LET.oldstate.#3D
.bitvec!i.&.mask#0A..TEST.state.THEN.bitvec!i.:#3D.
bitvec!i.|..mask#0A.............ELSE.bitvec!i.:#3D.
bitvec!i.&.~mask#0A..RESULTIS.oldstate#0A}#0A#0AAND
.string_to_number(s).#3D.VALOF#0A//.Return.TRUE.if.
OK.with.value.in.result2#0A//........FALSE.and.resu
lt2#3D0.if.s.is.not.a.number#0A//.Example.strings:.
#0A//...'A'#0A//..123....-99....+63#0A//..#23377...
-#23x7FF.+#23b1011011.#0A{.LET.p,.len.#3D.1,.s%0#0A
..LET.neg,.radix.#3D.FALSE,.10#0A..LET.ch.#3D.?#0A#0A
..result2.:#3D.0#0A..UNLESS.len.RESULTIS.FALSE#0A..
ch.:#3D.capitalch(s%p)#0A..IF.ch.#3D.'*''.&.len.#3D
.3.&.s%3.#3D.'*''.DO#0A..{.result2.:#3D.s%2#0A....R
ESULTIS.TRUE#0A..}#0A#0A..IF.ch.#3D.'+'.|.ch.#3D.'-
'.DO#0A..{.neg.:#3D.ch.#3D.'-'#0A....IF.p.#3D.len.R
ESULTIS.TRUE#0A....p.:#3D.p.+.1#0A....ch.:#3D.capit
alch(s%p)#0A..}#0A..IF.ch.#3D.'#23'.DO#0A..{.radix.
:#3D.8#0A....IF.p.#3D.len.RESULTIS.TRUE#0A....p.:#3D
.p.+.1#0A....ch.:#3D.capitalch(s%p)#0A....IF.ch.#3D
.'O'.|.ch.#3D.'X'.|.ch.#3D.'B'.DO#0A....{.IF.ch.#3D
.'X'.DO.radix.:#3D.16#0A......IF.ch.#3D.'B'.DO.radi
x.:#3D.2#0A......IF.p.#3D.len.RESULTIS.TRUE#0A.....
.p.:#3D.p.+.1#0A......ch.:#3D.capitalch(s%p)#0A....
}#0A..}#0A..{.LET.n.#3D.'0'.<#3D.ch.<#3D.'9'.->.ch.
-.'0',#0A............'A'.<#3D.ch.<#3D.'Z'.->.ch.-.'
A'.+.10,.1000#0A....UNLESS.n.<.radix.RESULTIS.FALSE
#0A....result2.:#3D.result2.*.radix.+.n#0A....p.:#3D
.p.+.1#0A....IF.p.>.len.BREAK#0A....ch.:#3D.capital
ch(s%p)#0A..}.REPEAT#0A#0A..IF.neg.DO.result2.:#3D.
-result2#0A..RESULTIS.TRUE#0A}#0A#0AAND.string_to_d
at().#3D.VALOF#0A{.sawritef("function.string_to_dat
.not.implemented.(BLIB)*n")#0A..RESULTIS.0#0A}#0A#0A
//.Get.the.ith.element.of.vector.v.of.16-bit.unsign
ed.words#0AAND.getword(v,.i).#3D.VALOF#0A{.LET.j.#3D
.i+i#0A..LET.res.#3D.v%j.+.(v%(j+1)<<8)..//.Assumes
.little.ender.m/c.??????????#0A..RESULTIS.res#0A}#0A
#0A//.Store.least.sig.16.bits.of.w.in.the.ith.eleme
nt.of.vector.v.of.16-bit.words#0AAND.putword(v,.i,.
w).BE....//.store.16.bit.word#0A{.LET.j.#3D.i+i#0A.
.v%j,.v%(j+1).:#3D.w,.w>>8..//.Assumes.little.ender
.m/c..?????????????#0A}#0A#0AAND.copystring(from,.t
o).BE#0A..FOR.i.#3D.0.TO.from%0.DO.to%i.:#3D.from%i
#0A#0AAND.copy_words(from,.to,.n).BE#0A..FOR.i.#3D.
0.TO.n-1.DO.to!i.:#3D.from!i#0A#0AAND.clear_words(v
,.n).BE#0A..FOR.i.#3D.0.TO.n-1.DO.v!i.:#3D.0#0A#0AA
ND.copy_bytes(fromlen,.from,.fillch,.tolen,.to).#3D
.VALOF#0A//.This.is.an.implementation.of.the.VAX.MO
VC5.instruction#0A//.for.copying.bytes#2E#0A{.LET.n
.#3D.fromlen#0A..//.from.and.to.are.byte.addresses!
!!!!#0A..IF.n>tolen.DO.n.:#3D.tolen#0A..//.This.cod
e.need.checking!!!!!#0A..FOR.i.#3D.0.TO.n-1.DO.0%(t
o+i).:#3D.0%(from+i)#0A..FOR.i.#3D.n.TO.tolen-1.DO.
0%(to+i).:#3D.fillch#0A..RESULTIS.fromlen-n.//.Numb
er.of.non.copied.characters#0A}#0A#0A#0A#0AAND.getv
ec(upb).#3D.VALOF#0A{.IF.upb<0.DO#0A..{.sawritef("B
LIB:.getvec(%n).called*n",.upb)#0A....abort(1000)#0A
..}#0A..RESULTIS.sys(Sys_getvec,.upb)#0A}#0A#0AAND.
freevec(ptr).BE.IF.ptr.UNLESS.sys(Sys_freevec,.ptr)
.DO#0A{.sawritef("BLIB.co#3D%n:.freevec.failure,.pt
r#3D%n*n",.currco,.ptr)#0A..abort(999)#0A}#0A#0AAND
.loadseg(name).#3D.sys(Sys_loadseg,.name)#0A#0AAND.
globin(segl).#3D.sys(Sys_globin,.segl)#0A#0AAND.unl
oadseg(segl).BE.sys(Sys_unloadseg,.segl)#0A#0AAND.c
allseg(file,.arg1,.arg2,.arg3,.arg4).#3D.VALOF#0A{.
LET.res.#3D.0#0A..LET.seg.#3D.loadseg(file)#0A..LET
.s.#3D.start#0A//sawritef("BLIB:.callseg.%s.entered
*n",.file)#0A#0A..TEST.seg.&.globin(seg)#0A..THEN.r
es.:#3D.start(arg1,.arg2,.arg3,.arg4)#0A..ELSE.{.sa
writef("BLIB:.Unable.to.callseg.%s.seg#3D%n*n",.fil
e,.seg)#0A.........abort(999)#0A.........start.:#3D
.s#0A.........RESULTIS.0#0A.......}#0A..unloadseg(s
eg)#0A..start.:#3D.s#0A..RESULTIS.res#0A}#0A#0AAND.
deletefile(name).#3D.sys(Sys_deletefile,.name)#0A#0A
AND.renamefile(fromname,.toname).#3D.sys(Sys_rename
file,.fromname,.toname)#0A#0AAND.setlogname(logname
,.logvalue).#3D.VALOF#0A{.LET.a.#3D.@rootnode!rtn_e
nvlist#0A#0A..//.First.delete.current.entry.if.it.e
xists#2E#0A..{.LET.p.#3D.!a#0A....UNLESS.p.BREAK#0A
....IF.compstring(logname,.p!1)#3D0.DO#0A....{.!a.:
#3D.!p#0A......freevec(p)#0A......BREAK#0A....}#0A.
...a.:#3D.p#0A..}.REPEAT#0A#0A..IF.logvalue.DO.//.I
nsert.new.entry#0A..{.LET.upb1.#3D.logname%0../.byt
esperword#0A....LET.upb2.#3D.logvalue%0./.bytesperw
ord#0A....LET.p.#3D.getvec(4.+.upb1.+.upb2).//.3.+.
upb1+1.+.upb2+1.-.1#0A....LET.s1.#3D.p.+.3#0A....LE
T.s2.#3D.s1.+.upb1.+.1#0A....UNLESS.p.RESULTIS.0#0A
....FOR.i.#3D.0.TO.upb1.DO.s1!i.:#3D.logname!i#0A..
..FOR.i.#3D.0.TO.upb2.DO.s2!i.:#3D.logvalue!i#0A...
.p!1,.p!2.:#3D.s1,.s2#0A....!p.:#3D.rootnode!rtn_en
vlist#0A....rootnode!rtn_envlist.:#3D.p#0A....RESUL
TIS.p#0A..}#0A#0A//sawritef("BLIB:.not.adding.%s*n"
,.logname)#0A..RESULTIS.0#0A}#0A#0AAND.getlogname(l
ogname).#3D.VALOF#0A{.LET.p.#3D.rootnode!rtn_envlis
t#0A..WHILE.p.DO#0A..{.IF.compstring(logname,.p!1)#3D
0.RESULTIS.p!2#0A....p.:#3D.!p#0A..}#0A..RESULTIS.0
#0A}#0A#0A//.Example.calls.of.splitname.give.the.fo
llowing.results#0A#0A//.splitname(prefix,.':',."TCP
:shep:9000",..1).#3D>..5,.prefix#3D"TCP"#0A//.split
name(prefix,.':',."TCP:shep:9000",..5).#3D>.10,.pre
fix#3D"shep"#0A//.splitname(prefix,.':',."TCP::9000
",......5).#3D>..6,.prefix#3D""#0A//.splitname(pref
ix,.':',."TCP:shep",.......5).#3D>..0,.prefix#3D"sh
ep"#0A//.splitname(prefix,.':',."TCP:shep:",......5
).#3D>.10,.prefix#3D"shep"#0A//.splitname(prefix,.'
:',."TCP:shep:",.....10).#3D>..0,.prefix#3D""#0A//.
splitname(prefix,.':',."TCP:shep:9000",.10).#3D>..0
,.prefix#3D"9000"#0A#0AAND.splitname(prefix,.ch,.st
ring,.ptr).#3D.VALOF#0A{.LET.len.#3D.string%0#0A..L
ET.res,.pos.#3D.0,.0#0A#0A..WHILE.ptr<#3Dlen.DO#0A.
.{.LET.k.#3D.string%ptr#0A....IF.k#3Dch.DO.{.prefix
%0.:#3D.pos;.RESULTIS..ptr+1.}#0A....pos,.ptr.:#3D.
pos+1,.ptr+1#0A....prefix%pos.:#3D.k.#0A..}#0A..pre
fix%0.:#3D.pos#0A..RESULTIS.0#0A}#0A#0A//.Not.used#0A
AND.open_for_output(name,.recsiz,.maxrec).#3D.VALOF
#0A{.sawritef("DLIB:.open_for_output(%s,%n,%n).call
ed*n",.name,.recsiz,.maxrec).#0A..RESULTIS.findstre
am(name,.id_outscb,.recsiz.<<.2,.maxrec)#0A}#0A#0AA
ND.open_for_input(name).#3D.findstream(name,.id_ins
cb,.0)#0A#0AAND.open_for_update(name).#3D.findstrea
m(name,.id_inoutscb,.0)#0A#0AAND.setrecordlength(sc
b,.length).#3D.VALOF..//.length.is.in.bytes.--.MR.1
2/7/04#0A{.LET.old.#3D.scb!scb_reclen#0A..scb!scb_r
eclen.:#3D.length.//.in.bytes#0A..RESULTIS.old#0A}#0A
#0AAND.recordnote(scb).#3D.VALOF.//.The.first.recor
d.has.number.0#0A//.Returns.the.record.number.corre
sponding.to.the.current.position#0A//.........of.th
e.stream#2E#0A//.Returns.-1.if.the.stream.is.not.su
itable#2E#0A{.LET.blkno.#3D.scb!scb_block....//.The
.blocksize.is.the.buffer.size.in.bytes#0A..AND.recl
en.#3D.scb!scb_reclen..//.in.bytes#0A..IF.blkno>#3D
0.&.reclen>0.DO.//.Modified.by.MR.12/7/04#0A..{.LET
.recno.#3D.muldiv(blkno,.scb!scb_bufend,.reclen)#0A
....RESULTIS.recno.+.(result2.+.scb!scb_pos)/reclen
..//.MR.12/2/04#0A..}#0A..sawritef("BLIB:.recordnot
e:.result.-1*n")#0A..RESULTIS.-1...//.MR.26/7/04#0A
}#0A#0AAND.recordpoint(scb,.recno).#3D.VALOF#0A//.M
R.28/7/02:.The.first.record.of.a.file.has.number.0#0A
//.Returns.TRUE.if.successful#0A//.Returns.FALSE,.o
therwise#2E#0A{.LET.pvec.#3D.VEC.1#0A..LET.type.#3D
.scb!scb_type#0A..UNLESS.type#3Dscbt_file.|.type#3D
scbt_ram.DO#0A..{.sawritef("FLIB.recordpoint:.only.
works.on.a.disc.or.RAM.file*n")#0A....abort(999)#0A
....RESULTIS.FALSE#0A..}#0A..IF.recno<0.DO...//.The
.first.record.has.number.0#0A..{.sawritef("DLIB:.re
cordpoint.recno#3D%n*n",.recno)#0A....abort(1000)#0A
....recno.:#3D.0#0A..}#0A//sawritef("DLIB:.recordpo
int:.muldiv(%n,%n,%n)*n",#0A//..........scb!scb_rec
len,.recno,.scb!scb_bufend)#0A//abort(1000)#0A..pve
c!0.:#3D.muldiv(scb!scb_reclen,.recno,.scb!scb_bufe
nd).//.MR.29/7/02#0A..pvec!1.:#3D.result2#0A//sawri
tef("DLIB:.recordpoint:.recno.%n.#3D>.%n.%n*n",#0A/
/..........recno,.pvec!0,.pvec!1)#0A//abort(1000)#0A
//IF.pvec!0>2.DO.abort(8888)#0A..RESULTIS.point(scb
,.pvec)#0A}#0A#0A//.Position.an.inout.stream.to.its
.end#0A//.This.should.be.removed#2E#0AAND.appendstr
eam(scb).#3D.VALOF.//?????????????????????????????#0A
$(..LET.lblock.#3D.scb!scb_lblock#0A....LET.ldata.#3D
.scb!scb_ldata#0A....LET.pvec.#3D.VEC.1#0A//sawrite
f("DLIB:.appendstream.called*n");.abort(999)#0A....
UNLESS.scb!scb_id#3Did_inoutscb.RESULTIS.FALSE#0A..
..IF.scb!scb_block#3Dlblock.&.scb!scb_end>ldata.DO#0A
........ldata.:#3D.scb!scb_end#0A....pvec!0,.pvec!1
.:#3D.lblock,.ldata#0A....UNLESS.point(scb,.pvec).R
ESULTIS.FALSE#0A//....scb!scb_pos.:#3D.scb!scb_end#0A
....RESULTIS.TRUE#0A}#0A#0A//.Position.to.start.of.
stream#0AAND.rewindstream(scb).#3D.VALOF.//.MR.17/3
/02#0A{.LET.pvec.#3D.VEC.1#0A..pvec!0,.pvec!1.:#3D.
0,.0......//.MR.6/8/02#0A..RESULTIS.point(scb,.pvec
)#0A}#0A#0A//.Advance.stream.position.by.n.words#0A
AND.stepstream(scb,.n).#3D.VALOF#0A{.LET.pvec.#3D.V
EC.1#0A..LET.bytes,.len.#3D.n.*.bytesperword,.scb!s
cb_bufend#0A..LET.blocks.#3D.bytes./.len#0A..bytes.
:#3D.bytes.REM.len#0A..note(scb,.pvec)#0A..pvec!1.:
#3D.pvec!1.+.bytes#0A..IF.pvec!1.<.0...DO.pvec!0,.p
vec!1.:#3D.pvec!0.-.1,.pvec!1.+.len#0A..IF.pvec!1.>
.len.DO.pvec!0,.pvec!1.:#3D.pvec!0.+.1,.pvec!1.-.le
n#0A..pvec!0.:#3D.pvec!0.+.blocks#0A..RESULTIS.pvec
!0.<.1.->.FALSE,.point(scb,.pvec)#0A}#0A#0A//.Creat
e.a.RAM.stream.for.input.and.output.using.the.given
#0A//.vector,.v,.with.upper.bound.upb.as.the.buffer
,.and.end.is#0A//.the.byte.subscript.of.the.end.of.
valid.data#2E#0AAND.mkramstream(buf,.bufend,.end).#3D
.VALOF#0A{.LET.scb.#3D.getvec(scb_upb)#0A..UNLESS.s
cb.RESULTIS.0#0A..FOR.i.#3D.0.TO.scb_upb.DO.scb!i.:
#3D.0#0A..scb!scb_id......:#3D.id_inoutscb#0A..scb!
scb_type....:#3D.scbt_ram#0A..scb!scb_buf.....:#3D.
buf#0A..scb!scb_end.....:#3D.end.....//.End.of.vali
d.data#0A..scb!scb_rdfn....:#3D.falsefn.//.No.read#0A
..scb!scb_wrfn....:#3D.falsefn.//.or.write.function
s#0A..scb!scb_endfn...:#3D.ramendfn#0A..scb!scb_buf
end..:#3D.bufend..//.Length.in.bytes#0A..scb!scb_wr
ite...:#3D.FALSE...//.No.data.waiting.to.be.written
#0A..scb!scb_ldata...:#3D.end.....//.Number.of.byte
s.in.the.last.(only).block#0A..RESULTIS.scb#0A}#0A#0A
AND.falsefn().#3D.FALSE#0A#0AAND.ramendfn(scb).#3D.
TRUE.//.Always.successful#0A#0AAND.freeobj(obj).BE.
freevec(obj)#0A#0AAND.copydir(dir).#3D.VALOF#0A{.LE
T.v.#3D.getvec((dir%0)/bytesperword)#0A..IF.v.FOR.i
.#3D.0.TO.dir%0.DO.v%i.:#3D.dir%i#0A//sawritef("BLI
B:.copydir.called*n")#0A//abort(999)#0A..RESULTIS.v
#0A}#0A#0A//.Write.the.specified.number.of.records.
of.zeroes.to.the.opened.file#0AAND.setbulk(scb,.no_
records).#3D.VALOF#0A{.LET.oldout.#3D.output()#0A..
LET.n.#3D.no_records.....*.//.Number.of.bytes.to.wr
ite#0A..........scb!scb_reclen#0A..MANIFEST.{.bytes
.#3D.2048;.words#3Dbytes/bytesperword.}#0A..LET.v.#3D
.VEC.words#0A//sawritef("BLIB:.setbulk:.clearing.v!
0.to.v!%n*n",.words-1)#0A..FOR.p.#3D.@v!0.TO.@v!wor
ds-1.DO.!p.:#3D.0#0A#0A..rewindstream(scb)#0A..sele
ctoutput(scb)#0A..//.Used.writewords.to.write.2048.
bytes.at.a.time#0A//sawritef("BLIB:.setbulk:.writin
g.%n.bytes.to.file*n",.n)#0A..WHILE.n>#3Dbytes.DO.{
.writewords(v,.words);.n.:#3D.n-bytes.}#0A..//.and.
then.write.the.few.remaining.bytes,.if.any#2E#0A//s
awritef("BLIB:.setbulk:.writing.the.remaining.%n.by
tes.to.file*n",.n)#0A..FOR.i.#3D.1.TO.n.DO.binwrch(
0)#0A..rewindstream(scb)#0A..selectoutput(oldout)#0A
..RESULTIS.TRUE#0A}#0A#0AAND.datstamp(v).#3D.VALOF#0A
{.LET.tv....#3D.VEC.5#0A..LET.days..#3D.0#0A..LET.m
ins..#3D.0#0A..LET.secs..#3D.0#0A..LET.msecs.#3D.0#0A
.#0A..MANIFEST.{.secsperday.#3D.60*60*24.}#0A#0A..s
ys(Sys_ftime,.tv)#0A#0A..secs..:#3D.tv!1.-.2922*sec
sperday..//.Change.from.Unix.to.Tripos.epoc#0A..mse
cs.:#3D.tv!2#0A..//.secs.#3D.(unsigned).seconds.sin
ce.00:00:00.on.1.Jan.1978#0A..//.****.It.will.ovefl
ow.on.06:28:15.Friday.6.Feb.2114.****#0A..//.secs.:
#3D.#23xFFFFFFFF..//.Corresponds.to.06:28:15.Friday
.6.Feb.2114#0A#0A..//.secsperday*10000.#3D.864_000_
000#0A..//.The.following.loop.will.never.do.more.th
an.3.iterations#0A..WHILE.secs<0.DO.{.//.To.avoid.o
verflow.problems#0A....secs,.days.:#3D.secs-secsper
day*10000,.days+10000#0A....//sawritef("days#3D%n*n
",.days)#0A..}#0A..days..:#3D.days.+.secs./.secsper
day#0A..secs..:#3D.secs.REM.secsperday#0A..mins..:#3D
.secs./.60#0A..secs..:#3D.secs.REM.60#0A..msecs.:#3D
.secs*1000.+.msecs#0A#0A..v!0.:#3D.days#0A..v!1.:#3D
.mins#0A..v!2.:#3D.msecs.*.tickspersecond./.1000#0A
..RESULTIS.0#0A}#0A#0A

######natbcpl/sysb/dlib.b#
//.This.is.DLIB.(system.dependent.library).for.sing
le.threaded#0A//.Cintcode.BCPL#0A#0A//.It.contains.
functions.that.have.different.definitions.in.Cintpo
s#0A#0A/*#0AChange.log#0A#0A9/11/06#0AChange.treatm
ent.of.RUBOUT.(#23x7F)#0A#0A*/#0A#0ASECTION."DLIB"#0A
#0AGET."libhdr"#0A#0AMANIFEST.{#0A..char_bs.#3D.8#0A
..buflen..#3D.4096.//.Must.equal.the.block.size#0A}
#0A#0ALET.findstream(name,.id,.path).#3D.VALOF.//.M
R.8/5/03#0A{.LET.console.#3D.compstring("**",.name)
#3D0#0A..LET.scb.#3D.?#0A..LET.res.#3D.0#0A..LET.pr
efix.#3D.VEC.31#0A#0A//TEST.path#0A//THEN.sawritef(
"DLIB:.findstream(%s,.%n,.%s)*n",.name,.id,.path)#0A
//ELSE.sawritef("DLIB:.findstream(%s,.%n,.0)*n",.na
me,.id)#0A//sawritef("DLIB:.currentdir#3D%n*n",.cur
rentdir)#0A#0A..IF.console.DO#0A..{.IF.id#3Did_insc
b.&.rootnode!rtn_keyboard.RESULTIS.rootnode!rtn_key
board#0A....IF.id#3Did_outscb.&.rootnode!rtn_screen
..RESULTIS.rootnode!rtn_screen#0A..}.#0A#0A..scb.:#3D
.getvec(scb_upb)#0A..UNLESS.scb.RESULTIS.0#0A#0A..F
OR.i.#3D.0.TO.scb_upb.DO.scb!i.:#3D.0#0A#0A..scb!sc
b_id......:#3D.id#0A..scb!scb_rdfn....:#3D.0#0A..sc
b!scb_wrfn....:#3D.0#0A..scb!scb_endfn...:#3D.0#0A#0A
..//.Copy.(truncated).stream.name.into.the.scb#0A..
{.LET.len.#3D.name%0#0A....LET.scbname.#3D.@scb!scb
_name#0A....LET.maxlen.#3D.scb_maxnamelen#0A....IF.
len>scb_maxnamelen.DO.len.:#3D.scb_maxnamelen#0A...
.FOR.i.#3D.1.TO.len.DO.scbname%i.:#3D.name%i#0A....
scbname%0.:#3D.len#0A..}#0A#0A..IF.console.DO#0A..{
.//.Console.stream#0A....LET.buf.#3D.getvec(4095/by
tesperword).//.Room.for.4096.bytes#0A....UNLESS.buf
.DO.{.freevec(scb);.RESULTIS.0.}#0A....scb!scb_type
....:#3D.scbt_console#0A....scb!scb_buf.....:#3D.bu
f#0A....scb!scb_bufend..:#3D.4096#0A#0A....IF.id#3D
id_inscb.DO#0A....{.scb!scb_rdfn...:#3D.cnslrdfn.//
.fn.to.replenish.current.buffer#0A......rootnode!rt
n_keyboard.:#3D.scb#0A......RESULTIS.scb#0A....}#0A
....IF.id#3Did_outscb.DO#0A....{.scb!scb_wrfn...:#3D
.cnslwrfn.//.fn.to.output.current.buffer#0A......ro
otnode!rtn_screen.:#3D.scb#0A......RESULTIS.scb#0A.
...}#0A....freevec(scb)#0A....RESULTIS.0#0A..}#0A#0A
..splitname(prefix,.':',.name,.1)#0A..IF.compstring
(prefix,."NIL")#3D0.DO#0A..{.//.On.reading.always.g
ive.eof#0A....//.On.writing.always.throws.away.the.
data#0A....scb!scb_wrfn....:#3D.nilrdfn#0A....scb!s
cb_endfn...:#3D.nilwrfn#0A//sawritef("DLIB:.Opening
.stream.to/from.NIL:*n")#0A....RESULTIS.scb.#0A..}#0A
#0A..IF.compstring(prefix,."TCP")#3D0.|.compstring(
prefix,."NET")#3D0.DO#0A..{.sawritef("TCP.connectio
ns.not.yet.available*n")#0A....freevec(scb)#0A....R
ESULTIS.0#0A..}#0A#0A..//.Open.a.file.stream#0A//sa
writef("DLIB:.%s.must.be.a.file*n",.name)#0A#0A..IF
.id#3Did_inscb....&.fh0findinput...(scb,.name,.path
).RESULTIS.scb#0A..IF.id#3Did_outscb...&.fh0findout
put..(scb,.name).......RESULTIS.scb#0A..IF.id#3Did_
inoutscb.&.fh0findinoutput(scb,.name).......RESULTI
S.scb#0A#0A..freevec(scb)#0A..RESULTIS.0#0A}#0A#0AA
ND.nilrdfn(scb).#3D.FALSE#0A#0AAND.nilwrfn(scb).#3D
.VALOF#0A{.scb!scb_pos.:#3D.0.//.Throw.away.the.buf
fer.contents.(if.any)#0A..RESULTIS.TRUE#0A}#0A#0AAN
D.cnslrdfn(scb).#3D.VALOF#0A{.LET.buf,.p.#3D.scb!sc
b_buf,.0#0A#0A//sawritef("DLIB:.cnslrdfn:.scb#3D%n*
n",.scb)#0A..{.LET.ch.#3D.sys(Sys_sardch)#0A....SWI
TCHON.ch.INTO#0A....{.DEFAULT:..........buf%p.:#3D.
ch#0A........................p.:#3D.p+1#0A.........
...............IF.p<4096.LOOP#0A...................
.....BREAK#0A#0A......CASE.endstreamch:.IF.p.BREAK#0A
........................//.No.characters.in.the.buf
fer#0A........................result2.:#3D.endstrea
mch.//.#3D-1#0A........................RESULTIS.FAL
SE#0A#0A......CASE.'*n':........buf%p.:#3D.ch#0A...
.....................p.:#3D.p+1#0A.................
.......BREAK#0A#0A......CASE.#23x7F:........//.Rubo
ut#0A........................sys(Sys_sawrch,.char_b
s)#0A........................sys(Sys_sawrch,.'.')..
...//.MR.9/11/06#0A........................sys(Sys_
sawrch,.char_bs)#0A......CASE.char_bs:.....IF.p>0.D
O.p.:#3D.p-1#0A........................sys(Sys_sawr
ch,.'.')#0A........................sys(Sys_sawrch,.
char_bs)#0A........................LOOP#0A....}#0A.
.}.REPEAT#0A//sawritef("DLIB:.cnslrdfn:.line.read*n
")#0A//FOR.i.#3D.0.TO.p-1.DO.sawrch(buf%i)#0A..scb!
scb_pos,.scb!scb_end.:#3D.0,.p#0A..RESULTIS.TRUE#0A
}#0A#0AAND.cnslwrfn(scb).#3D.VALOF#0A{.LET.buf.#3D.
scb!scb_buf#0A//sawritef("DLIB:.cnslwrfn(%n).called
*n",.scb)#0A//sawritef("DLIB:.cnslwrfn:.buf#3D%n.po
s#3D%n.end#3D%n*n",#0A//..........scb!scb_buf,.scb!
scb_pos,.scb!scb_end)#0A#0A..FOR.i.#3D.0.TO.scb!scb
_pos-1.DO.sys(Sys_sawrch,.buf%i)#0A..scb!scb_pos.:#3D
.0#0A..scb!scb_end.:#3D.0..//.No.valid.data#0A..RES
ULTIS.TRUE#0A}#0A#0AAND.flush().#3D.VALOF#0A{.IF.co
s#3D0.|.cos!scb_id~#3Did_outscb.DO.abort(187)#0A..R
ESULTIS.fh0wrfn(cos)#0A}..#0A#0AAND.getremipaddr(sc
b).#3D.VALOF#0A{#0Asawritef("DLIB:.getremipaddr.not
.yet.available*n")#0ARESULTIS.0#0A...UNLESS.scb!scb
_type#3Dscbt_tcp.|.scb!scb_type#3Dscbt_net.DO#0A..{
.result2.:#3D.0#0A....RESULTIS.0#0A..}#0A..RESULTIS
.0.//sendpkt(-1,.scb!scb_task,.Action_getremipaddr,
.0,0,.scb)#0A}#0A#0AAND.relfilename(name).#3D.VALOF
#0A{.//.Absolute.file.names.are.(eg):#0A..//.."/abc
"...."\xyz"..."pqr:vuw"#0A..LET.len.#3D.name%0#0A..
UNLESS.len.RESULTIS.TRUE#0A..IF.name%1#3D'/'.|.name
%1#3D'\'.RESULTIS.FALSE#0A..FOR.i.#3D.1.TO.len.IF.n
ame%i#3D':'.RESULTIS.FALSE#0A..RESULTIS.TRUE#0A}#0A
#0AAND.trfilename(name,.filename).BE#0A{.LET.p.#3D.
0#0A#0A//IF.currentdir.DO#0A//...sawritef("DLIB:.tr
filename:.name#3D%s.currentdir#3D%n*n",.name,.curre
ntdir)#0A#0A..IF.currentdir.&.relfilename(name).DO#0A
..{.LET.len.#3D.currentdir%0#0A....LET.lastch.#3D.c
urrentdir%len#0A....IF.lastch#3D'/'.|.lastch#3D':'.
DO.len.:#3D.len-1#0A....IF.len.DO#0A....{.FOR.i.#3D
.1.TO.len.DO.{.p.:#3D..p+1;.filename%p.:#3D.current
dir%i.}#0A......p.:#3D.p+1#0A......filename%p.:#3D.
'/'#0A....}#0A..}#0A..FOR.i.#3D.1.TO.name%0.DO.{.p.
:#3D..p+1;.filename%p.:#3D.name%i.}#0A..filename%0.
:#3D.p#0A..FOR.i.#3D.1.TO.p.IF.filename%i#3D':'.DO.
filename%i.:#3D.'/'#0A//TEST.currentdir#0A//THEN.sa
writef("DLIB:.trfilename.%s.%s.#3D>.%s*n",.currentd
ir,.name,.filename)#0A//ELSE.sawritef("DLIB:.trfile
name.%s.#3D>.%s*n",.name,.filename)#0A}#0A#0AAND.fh
0findinput(scb,.name,.path).#3D.VALOF#0A//.Returns.
TRUE...if.successful#0A//.Returns.FALSE,.result2#3D
100..Can't.open.file#0A//................result2#3D
101..Can't.allocate.buffer#0A{.LET.fp,.buf.#3D.0,.0
#0A..LET.filesize.#3D.0#0A..LET.filename.#3D.VEC.50
#0A..trfilename(name,.filename)#0A#0A//sawritef("DL
IB:.fh0findinput.calling.sys_openread.%s.%s*n",#0A/
/..........filename,.path->path,"null")#0A..//.Open
.the.file.for.input#0A..fp.:#3D.sys(Sys_openread,.f
ilename,.path)..//.MR.8/5/03#0A..UNLESS.fp.DO#0A..{
#0A//sawritef("DLIB:.fh0findinput.sys_openread.%s.f
ailed*n",.filename)#0A....result2.:#3D.100#0A....RE
SULTIS.FALSE#0A..}#0A#0A//sawritef("DLIB:.%s.opened
*n",.filename)#0A..filesize.:#3Dsys(Sys_filesize,.f
p)#0A//sawritef("DLIB:.filesize#3D%n*n",.filesize)#0A
#0A..//.allocate.a.buffer#0A..buf.:#3D.getvec(bufle
n/bytesperword)#0A..UNLESS.buf.DO#0A..{.sys(Sys_clo
se,.fp).//.First.close.the.file#0A....result2.:#3D.
101#0A....RESULTIS.0#0A..}#0A//sawritef("DLIB:.fh0f
indinput.scb.%n.fp.%n.buf.%n*n",.scb,.fp,.buf)#0A..
..#0A..scb!scb_type....:#3D.scbt_file#0A..scb!scb_t
ask....:#3D.0#0A..scb!scb_buf.....:#3D.buf#0A..scb!
scb_rdfn....:#3D.fh0rdfn#0A..scb!scb_wrfn....:#3D.0
.......//.An.input.stream.cannot.be.depleted#0A..sc
b!scb_endfn...:#3D.fh0endfn#0A..scb!scb_fd......:#3D
.fp#0A..scb!scb_bufend..:#3D.buflen#0A..scb!scb_wri
te...:#3D.FALSE...//.No.data.waiting.to.be.written#0A
..scb!scb_blength.:#3D.buflen..//.MR.15/3/02#0A..sc
b!scb_block...:#3D.0.......//.MR.29/7/02#0A..scb!sc
b_lblock..:#3D.filesize/buflen.//+.1..//.MR.16/4/02
.MR.29/7/02#0A..scb!scb_ldata...:#3D.filesize.REM.b
uflen..//.MR.16/4/02#0A//sawritef("fh0findinput:.lb
lock#3D%n*n",.scb!scb_lblock)#0A#0A..//.Initialise.
the.buffer.by.reading.the.first.block#0A..fh0getbuf
(scb)#0A..RESULTIS.scb#0A}#0A#0AAND.fh0findoutput(s
cb,.name).#3D.VALOF#0A//.Returns.TRUE...if.successf
ul#0A//.Returns.FALSE,.result2#3D100..Can't.open.fi
le#0A//................result2#3D101..Can't.allocat
e.buffer#0A{.LET.fp,.buf.#3D.0,.0#0A..LET.filename.
#3D.VEC.50#0A..trfilename(name,.filename)#0A#0A..//
.Open.the.file.for.output#0A..fp.:#3D.sys(Sys_openw
rite,.filename)#0A..UNLESS.fp.DO#0A..{.result2.:#3D
.100#0A....RESULTIS.FALSE#0A..}#0A#0A..//.allocate.
a.buffer#0A..buf.:#3D.getvec(buflen/bytesperword)#0A
..UNLESS.buf.DO#0A..{.sys(Sys_close,.fp).//.First.c
lose.the.file#0A....result2.:#3D.101#0A....RESULTIS
.FALSE#0A..}#0A#0A//sawritef("DLIB:.fh0findoutput.s
cb.%n..%n..buf.%n*n",.scb,.fp,.buf)#0A#0A..scb!scb_
type....:#3D.scbt_file#0A..scb!scb_task....:#3D.0#0A
..scb!scb_buf.....:#3D.buf#0A..scb!scb_rdfn....:#3D
.0.......//.Can't.replenish.output.streams#0A..scb!
scb_wrfn....:#3D.fh0wrfn#0A..scb!scb_endfn...:#3D.f
h0endfn#0A..scb!scb_fd......:#3D.fp#0A..scb!scb_buf
end..:#3D.buflen#0A..scb!scb_write...:#3D.FALSE.../
/.No.data.waiting.to.be.written#0A..scb!scb_blength
.:#3D.buflen#0A..scb!scb_block...:#3D.0.......//.MR
.29/7/02#0A..scb!scb_lblock..:#3D.0.......//.This.i
s.an.empty.file.currently,.MR.29/7/02#0A..scb!scb_l
data...:#3D.0#0A//sawritef("fh0findoutput:.lblock#3D
%n*n",.scb!scb_lblock)#0A#0A..scb!scb_pos.....:#3D.
0.......//.The.buffer.has.no.valid.data.initially#0A
..scb!scb_end.....:#3D.0#0A#0A..result2.:#3D.0#0A..
RESULTIS.TRUE#0A}#0A#0AAND.fh0findinoutput(scb,.nam
e).#3D.VALOF#0A//.Returns.TRUE...if.successful#0A//
.Returns.FALSE,.result2#3D100..Can't.open.file#0A//
................result2#3D101..Can't.allocate.buffe
r#0A{.LET.fp,.buf,.res1,.res2.#3D.0,.0,.1,.0#0A..LE
T.filesize.#3D.0#0A..LET.filename.#3D.VEC.50#0A..tr
filename(name,.filename)#0A#0A..//.open.the.file.fo
r.input.and.output#0A..fp.:#3D.sys(Sys_openreadwrit
e,.filename)#0A//sawritef("DLIB:.open.%s.in.inout.m
ode.#3D>.%n*n",.filename,.fp)#0A..UNLESS.fp.DO#0A..
{.result2.:#3D.100#0A....RESULTIS.FALSE#0A..}#0A#0A
..filesize.:#3Dsys(Sys_filesize,.fp)#0A//sawritef("
BLIB:.filesize#3D%n*n",.filesize)#0A#0A..//.allocat
e.a.buffer#0A..buf.:#3D.getvec(buflen/bytesperword)
#0A..UNLESS.buf.DO#0A..{.sys(Sys_close,.fp).//.Firs
t.close.the.file#0A....result2.:#3D.101#0A....RESUL
TIS.FALSE#0A..}#0A//sawritef("DLIB:.buflen.#3D.%n*n
",.buflen)#0A//sawritef("DLIB:.fh0findinoutput.scb.
%n..%n..buf.%n*n",.scb,.fp,.buf)#0A#0A..scb!scb_typ
e....:#3D.scbt_file#0A..scb!scb_buf.....:#3D.buf#0A
..scb!scb_rdfn....:#3D.fh0rdfn#0A..scb!scb_wrfn....
:#3D.fh0wrfn#0A..scb!scb_endfn...:#3D.fh0endfn#0A..
scb!scb_fd......:#3D.fp#0A..scb!scb_bufend..:#3D.bu
flen#0A..scb!scb_write...:#3D.FALSE...//.No.data.wa
iting.to.be.written#0A..scb!scb_blength.:#3D.buflen
..//.MR.15/3/02#0A..scb!scb_block...:#3D.0.//1.MR.2
9/7/02#0A..scb!scb_lblock..:#3D.filesize/buflen.//+
.1..//.MR.16/4/02.MR.29/7/02#0A..scb!scb_ldata...:#3D
.filesize.REM.buflen..//.MR.16/4/02#0A//sawritef("f
h0findinoutput:.lblock#3D%n*n",.scb!scb_lblock)#0A#0A
..//.Initialise.the.buffer.by.reading.the.first.blo
ck#0A..UNLESS.fh0getbuf(scb).DO#0A..{.//.Failed.to.
fill.the.buffer.with.data#0A....sawritef("DLIB:.fh0
getbuf(%n).failed*n",.scb)#0A....RESULTIS.FALSE#0A.
.}#0A..res2.:#3D.result2#0A..RESULTIS.TRUE#0A}#0A#0A
AND.fh0falsefn(scb)..#3D.FALSE#0A#0A#0AAND.fh0rdfn(
scb)..#3D.VALOF#0A//.This.is.only.used.for.disc.fil
es#2E.The.field.end.will.equal#0A//.buflen.for.all.
blocks.except.possibly.the.last.one#2E#0A//.If.the.
buffer.contains.data.from.the.last.block.and.pos#3D
end,#0A//.then.EOF.has.been.reached#2E.If.pos#3Dend
.data.from.the.next.block#0A//.must.be.read#2E.But.
the.current.block.will.first.have.to.be#0A//.writte
n.to.disc,.if.the.write.field.is.TRUE#2E#0A//.Retur
ns.TRUE,..if.successful#2E.There.will.be.valid.data
.between#0A//................pos.and.end.in.the.buf
fer#2E#0A//.Returns.FALSE,.result2#3D-1.on.EOF#0A//
.........FALSE,.result2#3Derrorcode,.otherwise#2E#0A
{.LET.block,.lblock.#3D.scb!scb_block,.scb!scb_lblo
ck#0A..LET.pos,...end....#3D.scb!scb_pos,...scb!scb
_end#0A//sawritef("DLIB:.fh0readfn.scb.%n.pos.%n.en
d.%n*n",.scb,.pos,.end)#0A//sawritef("DLIB:.fh0read
fn.block.%n.lblock.%n*n",.block,.lblock)#0A..IF.pos
<end......RESULTIS.TRUE..//.Data.still.available.in
.current.buffer#0A..IF.block#3Dlblock.DO.{.result2.
:#3D.-1;.RESULTIS.FALSE.}.//.End-of-file#0A#0A..IF.
scb!scb_write.DO.fh0putbuf(scb)..//.Write.block.if.
necessary#0A#0A..IF.end>#3Dbuflen.DO.block.:#3D.blo
ck+1..//.Advance.block.if.necessary#0A..scb!scb_blo
ck,.scb!scb_pos.:#3D.block,.0#0A//sawritef("DLIB:.f
h0rdfn.block.%n.pos.%n.end.%n*n",.scb!scb_block,.po
s,.end)#0A#0A..UNLESS.fh0getbuf(scb).DO#0A..{.sawri
tef("DLIB:.fh0getbuf(%n).failed*n",.scb)#0A....RESU
LTIS.FALSE..//.Read.data.into.the.buffer#0A..}#0A#0A
..//.Safety.check#0A..end.:#3D.scb!scb_end#0A..UNLE
SS.end#3Dbuflen.|.lblock.#3D.scb!scb_block.DO#0A..{
.sawritef("DLIB:.fh0rdfn.block#3D%n.lblock#3D%n.pos
#3D%n.end#3D%n*n",#0A..............scb!scb_block,.l
block,.scb!scb_pos,.end)#0A....abort(9999)#0A..}#0A
..#0A..RESULTIS.TRUE..............//.The.buffer.is.
not.empty#0A}..#0A...#0AAND.fh0wrfn(scb).#3D.VALOF#0A
//.Write.the.current.buffer.to.file,.if.the.write.f
lag.is.set#0A//.Return.TRUE,.if.successful#0A//.Ret
urn.FALSE.otherwise#2E#0A{.LET.block,.lblock.#3D.sc
b!scb_block,.scb!scb_lblock#0A..LET.pos,.end.#3D.sc
b!scb_pos,.scb!scb_end#0A..LET.len.#3D.?#0A//sawrit
ef("DLIB:.fh0wrfn.scb.%n.pos.%n.end.%n*n",.scb,.pos
,.end)#0A//sawritef("DLIB:.fh0wrfn.block.%n.lblock.
%n*n",.block,.lblock)#0A..IF.scb!scb_write.DO.//.Wr
ite.current.block.if.necessary#0A....UNLESS.fh0putb
uf(scb).RESULTIS.FALSE#0A#0A//..IF.pos<scb!scb_bufe
nd.DO#0A//sawritef("DLIB:.return0.from.fh0wrfn.bloc
k#3D%n.lblock#3D%n.pos#3D%n.end#3D%n*n",#0A//......
....scb!scb_block,.scb!scb_lblock,.pos,.end)#0A#0A.
.IF.pos.<.scb!scb_bufend.RESULTIS.TRUE..//.Still.ro
om.in.the.buffer#0A..//.Move.to.next.block#0A..bloc
k.:#3D.block+1#0A..scb!scb_block,.scb!scb_pos,.scb!
scb_end.:#3D.block,.0,.0#0A..IF.block>lblock.DO#0A.
.{.scb!scb_lblock.:#3D.block....//.Last.block.is.em
pty#0A//sawritef("DLIB:.return1.from.fh0wrfn.block#3D
%n.lblock#3D%n.pos#3D%n.end#3D%n*n",#0A//..........
scb!scb_block,.scb!scb_lblock,.pos,.end)#0A....RESU
LTIS.TRUE#0A..}#0A#0A..IF.scb!scb_id#3Did_inoutscb.
UNLESS.fh0getbuf(scb).DO#0A..{.sawritef("DLIB:.fh0w
rfn.getbuf.failed.block#3D%n.lblock#3D%n.pos#3D%n.e
nd#3D%n*n",#0A..............scb!scb_block,.scb!scb_
lblock,.pos,.end)#0A....abort(1102)#0A..}#0A#0A//sa
writef("DLIB:.return2.from.fh0wrfn.block#3D%n.lbloc
k#3D%n.pos#3D%n.end#3D%n*n",#0A//..........scb!scb_
block,.scb!scb_lblock,.pos,.end)#0A#0A..RESULTIS.TR
UE#0A}..#0A#0A...#0AAND.fh0endfn(scb).#3D.VALOF#0A/
/.Write.the.buffer,.if.necessary,.and.free.it#2E#0A
//.Close.the.file#2E#0A//.Return.TRUE,.if.successfu
l#0A//.Return.FALSE.otherwise#2E#0A{#0A//sawritef("
DLIB:.fh0endfn.scb.%n,.write.flag#3D%n*n",.scb,.scb
!scb_write)#0A//sawritef("DLIB:.fh0endfn.pos#3D%n.e
nd#3D%n*n",.scb!scb_pos,.scb!scb_end)#0A..IF.scb!sc
b_write.UNLESS.fh0putbuf(scb).RESULTIS.FALSE#0A//sa
writef("DLIB:.fh0endfn.freeing.buf#3D%n*n",.scb!scb
_buf)#0A..freevec(scb!scb_buf)#0A..RESULTIS.sys(Sys
_close,.scb!scb_fd)#0A}#0A#0A//.Result.TRUE:.posv.c
ontains.the.stream.block.and.pos#0A//.......FALSE:.
scb.was.not.a.file.or.RAM.stream#0AAND.note(scb,.po
sv).#3D.VALOF#0A{.LET.type.#3D.scb!scb_type#0A..UNL
ESS.type#3Dscbt_file.|.type#3Dscbt_ram.RESULTIS.FAL
SE#0A..posv!0.:#3D.scb!scb_block#0A..posv!1.:#3D.sc
b!scb_pos#0A//sawritef("DLIB:.note.#3D>.%n.%n*n",.p
osv!0,.posv!1)#0A..RESULTIS.TRUE#0A}#0A#0A//.Set.th
e.stream.position.to.that.specified.in.posv#2E..If.
the#0A//.new.position.is.in.a.different.block.the.b
uffer.may.have.to#0A//.be.written.out.and.new.data.
read.in#2E#0A//.It.returns.TRUE.if.successful,.even
.if.positioned.just.after.the#0A//.last.block.of.th
e.file,.ie.block#3Dlblock+1.and.pos#3Dend#3D0#2E#0A
//.It.returns.FALSE,.otherwise#2E.Possibly.because.
the.stream.is.not#0A//.pointable.or.the.posv.is.out
.of.range#2E#0AAND.point(scb,.posv).#3D.VALOF#0A{.L
ET.blkno..#3D.posv!0#0A..LET.pos....#3D.posv!1#0A..
LET.id.....#3D.scb!scb_id#0A..LET.block..#3D.scb!sc
b_block...//.Current.block.number#0A..LET.lblock.#3D
.scb!scb_lblock..//.Last.block.number.of.the.stream
#0A..LET.end....#3D.scb!scb_end#0A..LET.type...#3D.
scb!scb_type#0A//sawritef("DLIB:.point.posv!0#3D%n.
posv!1#3D%n*n",.posv!0,.posv!1)#0A#0A//sawritef("DL
IB:.point.block#3D%n.lblock#3D%n.blkno#3D%n.pos#3D%
n.end#3D%n*n",#0A//...............block,.lblock,..b
lkno,.pos,.end)#0A#0A...//.The.stream.must.be.a.rea
dable.disc.or.RAM.file#0A..UNLESS.(type#3Dscbt_file
.|.type#3Dscbt_ram).&#0A.........(id#3Did_inscb.|.i
d#3Did_inoutscb).RESULTIS.FALSE#0A#0A..IF.pos#3D0.&
.blkno#3Dlblock+1.DO.blkno,.pos.:#3D.lblock,.buflen
#0A.#0A//sawritef("DLIB:.point.block#3D%n.lblock#3D
%n.blkno#3D%n.pos#3D%n.end#3D%n*n",#0A//...........
....block,.lblock,..blkno,.pos,.end)#0A#0A//..IF.bl
kno<#3D0.DO.blkno,.pos.:#3D.0,.0.//.Cannot.position
.before.start.of.file#0A#0A..//.Safety.check#0A..//
.Make.sure.the.position.is.within.the.file#0A..IF.b
lkno<0.|.#0A.....blkno>lblock.|#0A.....blkno#3Dlblo
ck.&.pos.>.(block#3Dlblock.->.end,.scb!scb_ldata)..
DO#0A..{.sawritef("DLIB:.point.beyond.end.of.file,.
blkno#3D%n.pos#3D%n*n",.blkno,.pos)#0A....sawritef(
"block#3D%n.end#3D%n.lblock#3D%n.posv#3D(%n,%n)*n",
#0A..............block,.end,.lblock,.posv!0,.posv!1
)#0A....abort(999)#0A....RESULTIS.FALSE#0A..}#0A#0A
..IF.blkno#3Dblock.DO#0A..{.//.The.new.position.is.
in.the.current.block#0A....scb!scb_block.:#3D.blkno
#0A....scb!scb_pos...:#3D.pos#0A//sawritef("DLIB:.p
oint.setting.scb.block#3D%n.pos#3D%n*n",.blkno,.pos
)#0A....RESULTIS.TRUE.//.Success#0A..}#0A#0A..//.Th
e.move.is.to.a.different.block,.so.must.read.a.bloc
k#0A..//.but.first.check.if.the.current.block.must.
be.written#0A..IF.scb!scb_write.DO#0A..{.//sawritef
("DLIB:.point.write.block.%n*n",.scb!scb_block).#0A
....UNLESS.fh0putbuf(scb).DO.abort(5003)#0A..}#0A#0A
..scb!scb_block.:#3D.blkno..//.Set.the.new.position
#0A.#0A//sawritef("DLIB:.point.read.block.%n*n",.bl
kno)#0A#0A..UNLESS.fh0getbuf(scb).DO#0A..{.sawritef
("DLIB:.point.fh0getbuf.failed.block.%n.#3D>.%n*n",
.blkno,.end)#0A....abort(5004)#0A....RESULTIS.FALSE
#0A..}#0A#0A..//.Safety.check#0A..UNLESS.scb!scb_en
d#3Dbuflen.|#0A.........blkno#3Dlblock.&.end>#3Dscb
!scb_ldata.DO#0A..{.sawritef("DLIB.point:.safety.ch
eck.failed*n")#0A....sawritef("DLIB.point:.blkno.%n
.pos.%n*n",.blkno,.pos)#0A....sawritef("DLIB.point:
.end.%n.buflen.%n*n",.scb!scb_end,.buflen)#0A....sa
writef("DLIB.point:.block.%n.lblock.%n*n",.blkno,.l
block)#0A....sawritef("DLIB.point:.end.%n.ldata.%n*
n",.end,.scb!scb_ldata)#0A....abort(5005)#0A..}#0A#0A
..scb!scb_pos...:#3D.pos..//.Set.the.desired.offset
#0A#0A//sawritef("DLIB:.point(#2E#2E).#3D>.TRUE,.bl
kno.%n.pos.%n*n",.blkno,.pos)#0A..RESULTIS.TRUE#0A}
#0A#0AAND.fh0putbuf(scb).#3D.VALOF#0A//.This.is.onl
y.used.on.disc.file.streams.and.is.only.called.when
#0A//.the.write.field.is.TRUE#2E.It.writes.the.buff
er.to.file#2E#0A//.The.file.is.positioned.before.th
e.write#2E.If.the.last.block#0A//.is.being.written.
ldata.is.set.to.end.and.this.number.of.bytes.writte
n#0A//.to.disc#2E.(For.all.other.blocks.end#3Dbufle
n#2E)#0A//.Returns.TRUE,.if.successful,.having.set.
the.write.field.to.FALSE#2E#0A//.Returns.FALSE,.oth
erwise#2E#0A{.LET.end....#3D.scb!scb_end....//.Numb
er.of.bytes.of.valid.data.in.buf#0A..LET.block..#3D
.scb!scb_block#0A..LET.fd.....#3D.scb!scb_fd#0A..LE
T.offset.#3D.buflen*block...//.File.offset.of.buffe
r's.first.byte.MR.29/7/02#0A#0A..IF.end<#3D0.DO#0A.
.{.//.Nothing.in.the.buffer.to.write,.probably.a.mi
stake#2E#0A....//sawritef("DLIB:.fh0putbuf,.end#3D%
n*n",.end)#0A....scb!scb_write.:#3D.FALSE#0A....RES
ULTIS.TRUE#0A..}#0A#0A..//.The.size.of.a.file.can.o
nly.change.when.writing.its.last.block#0A..//.so.ld
ata.only.needs.correcting.when.this.happens#0A..IF.
block.#3D.scb!scb_lblock.DO.scb!scb_ldata.:#3D.end#0A
#0A//sawritef("DLIB:.putbuf.seeking.offset.%n.(bloc
k.%n)*n",.offset,.block)#0A..UNLESS.sys(Sys_seek,.f
d,.offset).RESULTIS.FALSE#0A#0A//sawritef("DLIB:.pu
tbuf.write.%n.bytes.at.offset.%n*n",.end,.offset)#0A
..IF.sys(Sys_write,.fd,.scb!scb_buf,.end).<.0#0A...
.RESULTIS.FALSE#0A..scb!scb_write.:#3D.FALSE.//.The
.buffer.has.been.written.successfully#0A..RESULTIS.
TRUE#0A}#0A#0A//.fh0getbuf.reads.a.block.into.the.s
cb's.buffer#2E#0A//.Returns.TRUE.if.successful#0A//
......having.set.pos#3D0.and.end.to.the.end.of.vali
d.data#0A//.Returns.FALSE,.otherwise#2E#0A#0AAND.fh
0getbuf(scb).#3D.VALOF#0A{.LET.fd......#3D.scb!scb_
fd#0A..LET.block...#3D.scb!scb_block#0A..LET.offset
..#3D.buflen*block....//.MR.29/7/02#0A..LET.end....
.#3D.?.#0A#0A//sawritef("DLIB:.fh0getbuf.seeking.st
art.of.block.%n.(offset.%n)*n",#0A//............blo
ck,.offset)#0A..UNLESS.sys(Sys_seek,.fd,.offset).RE
SULTIS.FALSE#0A//sawritef("DLIB:.fh0getbuf.file.pos
ition.now.%n*n",.sys(Sys_tell,.fd))#0A#0A//sawritef
("DLIB:.fh0getbuf.reading.block.%n.offset#3D%n*n",.
block,.offset)#0A..end.:#3D.sys(Sys_read,.fd,.scb!s
cb_buf,.buflen)#0A//sawritef("DLIB:.fh0getbuf.read.
#3D>.%n*n",.end)#0A//sawritef("DLIB:.fh0getbuf.bloc
k#3D%n.lblock#3D%n.ldata#3D%n*n",#0A//.............
..block,.scb!scb_lblock,.scb!scb_ldata)#0A..IF.end<
0.RESULTIS.FALSE.//.Unable.to.read#0A..scb!scb_pos,
.scb!scb_end.:#3D.0,.end.#0A..RESULTIS.TRUE#0A}#0A#0A
#0A

######+#
