
######natbcpl/nbsasm#
#2Ek.dir/a,file/a#0Aecho."bcpl2sial.<dir>/<file>#2E
b.to.SIAL"#0Abcpl2sial.<dir>/<file>#2Eb.to.SIAL#0Ae
cho."sial-sasm.SIAL.to.sasm/<file>#2Esasm"#0Asial-s
asm.SIAL.to.sasm/<file>#2Esasm#0A#0A

######natbcpl/nbvax#
#2Ek.dir/a,file/a#0Aecho."bcpl2sial.<dir>/<file>#2E
b.to.sial/<file>#2Esial.savesize.0"#0Abcpl2sial.<di
r>/<file>#2Eb.to.sial/<file>#2Esial.savesize.0.#0Ae
cho."sial-vax.sial/<file>#2Esial.to.vax/<file>#2Ema
r"#0Asial-vax.sial/<file>#2Esial.to.vax/<file>#2Ema
r#0A#0A

######natbcpl/sysc/bcpl.h#
/*.This.header.file.contains.machine/system.depende
nt.#23defines#0A**.These.are.dependent.on.the.-D.pa
rameter.specified.in.Makefile#2E#0A**.The.possible.
-D.parameters.are:#0A**#0A**..-DforLINUX.........fo
r.Linux#0A**..-DforVmsItanium....for.the.Itanium.un
der.VMS#0A**..-DforVmsVAX........for.the.VAX.under.
VMS#0A**..-DforALPHA.........for.DEC.Alpha.under.OS
F1.V3#2E2.17.(64.bit.wordsize)#0A*/#0A#0A/*.INT#2Eh
.is.created.by.mkint-h.(source.mkint-h#2Ec),.it.def
ines#0A**.the.macros.INT32.and.INT64#0A*/#0A#23incl
ude."INT#2Eh"#0A#0A/*.For.32-bit.implementations.--
.uncomment.the.following.*/#0A#23define.B2Wsh.2#0A#23
define.BperW.32#0A#23define.BCPLWORD.INT32#0A#0A/*.
For.64-bit.implementations.--.uncomment.the.followi
ng.*/#0A/*#0A#23define.B2Wsh.3#0A#23define.BperW.64
#0A#23define.BCPLWORD.INT64#0A*/#0A#0A/*#0A**.Cints
ys.and.cinterp.need.the.type.signed.char.but.this.i
s#0A**.not.available.on.all.implementations.of.C#2E
.On.some.the.type.char#0A**.is.signed,.and.on.some.
(in.fact.most).signed.char.is.allowed#2E#0A**.Comme
nt.out.of.the.following.definitions.of.SIGNEDCHAR#2E
.A.test.in#0A**.the.function.badimplementation.in.c
intmain#2Ec.will.determine.whether#0A**.you.have.ma
de.the.right.choice#2E#0A*/#0A#0A#23define.CHAR.uns
igned.char#0A#23define.SIGNEDCHAR.signed.char#0A/*.
#23define.SIGNEDCHAR.char.*/#0A#0A#23define.PRINTFS
.printf#0A#23define.PRINTFD.printf#0A#23define.PRIN
TF.printf#0A#23define.FILEPT.FILE*#0A#0A#23ifdef.fo
rLINUX#0A#23include.<sys/stat#2Eh>#0A#23include.<ti
me#2Eh>#0A#23define.MALLOC(n).malloc((n)<<B2Wsh)#0A
#23define.TICKS_PER_SEC.(CLOCKS_PER_SEC)#0A#23defin
e.CINTASM.cintasm#0A#23define.REMOVE.unlink#0A#23de
fine.FILE_SEP_CH.'/'#0A#23endif#0A#0A#23ifdef.forAL
PHA#0A#23include.<sys/stat#2Eh>#0A#23include.<stdli
b#2Eh>#0A#23define.MALLOC(n).malloc((n)<<B2Wsh)#0A#23
define.TICKS_PER_SEC.(CLOCKS_PER_SEC)#0A#23define.C
INTASM.cintasm#0A#23define.REMOVE.unlink#0A#23defin
e.FILE_SEP_CH.'/'#0A#23endif#0A#0A#23define.WORD.BC
PLWORD#0A#0Atypedef.WORD.*INT32pt;#0A#0A#23define.W
D.(WORD)#0A#23define.UWD.(unsigned.WORD)#0A#23defin
e.PT.(WORD.*)#0A#23define.BP.(unsigned.char.*)#0A#23
define.SBP.(SIGNEDCHAR.*)#0A#23define.HP.(unsigned.
short.*)#0A#23define.SHP.(short.*)#0A#0A#23define.G
n_sys.........3#0A#23define.Gn_currco......7#0A#23d
efine.Gn_rootnode....9#0A#23define.Gn_result2....10
#0A#0A/*.Functions.defined.in.kblib#2Ec..*/#0Aexter
n.int.Readch(void);#0Aextern.int.init_keyb(void);#0A
extern.int.close_keyb(void);#0Aextern.int.intflag(v
oid);#0A#0A/*.externals.defined.in.init*#2Ec..*/#0A
extern.WORD.stackupb;#0Aextern.WORD.gvecupb;#0Aexte
rn.void.initsections(WORD.*);#0A#0A#23define.Rtn_ta
sktab.....1L#0A#23define.Rtn_devtab......2L#0A#23de
fine.Rtn_blklist.....4L#0A#23define.Rtn_tallyv.....
.5L#0A#23define.Rtn_clkintson...6L#0A#23define.Rtn_
lastch......7L#0A#23define.Rtn_insadebug...8L#0A#0A
#23define.Rtn_clwkq......12L#0A#23define.Rtn_membas
e....13L#0A#23define.Rtn_memsize....14L#0A#23define
.Rtn_info.......15L#0A#23define.Rtn_sys........16L#0A
#23define.Rtn_boot.......17L#0A#23define.Rtn_klib..
.....18L#0A#23define.Rtn_blib.......19L#0A#23define
.Rtn_keyboard...20L#0A#23define.Rtn_screen.....21L#0A
#0A#23define.Rtn_vecstatsv..22L#0A#23define.Rtn_vec
statsvupb..23L#0A#0A#23define.Rtn_intflag....24L#0A
#23define.Rtn_dumpflag...25L#0A#23define.Rtn_envlis
t....26L#0A#23define.Rtn_abortcode..27L#0A#23define
.Rtn_context....28L#0A#23define.Rtn_lastp......29L#0A
#23define.Rtn_lastg......30L#0A#23define.Rtn_lastst
.....31L#0A#0A#23define.Rtn_idletcb....32L#0A#23def
ine.Rtn_adjclock...33L#0A#23define.Rtn_trword.....3
4L#0A#23define.Rtn_trbuf......35L#0A#23define.Rtn_d
countv....36L#0A#0A#23define.Rtn_rootvar....37L#0A#23
define.Rtn_pathvar....38L#0A#23define.Rtn_hdrsvar..
..39L#0A#23define.Rtn_scriptsvar.40L#0A#23define.Rt
n_boottrace..41L#0A#0A#23define.Rtn_upb........50L#0A
#0A/*.SYS.functions.*/#0A#0A#23define.Sys_setcount.
.....(-1)#0A#23define.Sys_quit............0#0A#23de
fine.Sys_rti.............1#0A#23define.Sys_saveregs
........2#0A#23define.Sys_setst...........3#0A#23de
fine.Sys_tracing.........4#0A#23define.Sys_watch...
........5#0A#23define.Sys_tally...........6#0A#23de
fine.Sys_interpret.......7#0A#0A#23define.Sys_sardc
h.........10#0A#23define.Sys_sawrch.........11#0A#23
define.Sys_read...........12#0A#23define.Sys_write.
.........13#0A#23define.Sys_openread.......14#0A#23
define.Sys_openwrite......15#0A#23define.Sys_close.
.........16#0A#23define.Sys_deletefile.....17#0A#23
define.Sys_renamefile.....18#0A#0A#23define.Sys_get
vec.........21#0A#23define.Sys_freevec........22#0A
#23define.Sys_loadseg........23#0A#23define.Sys_glo
bin.........24#0A#23define.Sys_unloadseg......25#0A
#23define.Sys_muldiv.........26#0A#23define.Sys_int
flag........28#0A#23define.Sys_setraster......29#0A
#23define.Sys_cputime........30#0A#23define.Sys_fil
emodtime....31#0A#23define.Sys_setprefix......32#0A
#23define.Sys_getprefix......33#0A#23define.Sys_gra
phics.......34......./*.Windows.CE.only.*/#0A#0A#23
define.Sys_seek...........38#0A#23define.Sys_tell..
.........39#0A#23define.Sys_waitirq........40#0A#23
define.Sys_lockirq........41#0A#23define.Sys_unlock
irq......42#0A#23define.Sys_devcom.........43#0A#23
define.Sys_ftime..........44#0A#23define.Sys_usleep
.........45#0A#23define.Sys_filesize.......46#0A#23
define.Sys_openreadwrite..47#0A#0A#23define.Sys_get
sysval......48#0A#23define.Sys_putsysval......49#0A
#23define.Sys_shellcom.......50#0A#23define.Sys_get
pid.........51#0A#23define.Sys_dumpmem........52#0A
#23define.Sys_callnative.....53#0A#0A

######natbcpl/sysc/clib.c#
/*#0A**.This.is.CLIB.for.BCPL.compiled.into.native.
code#0A**#0A**.It.is.based.on.cintsys#2Ec.from.the.
BCPL.Cintcode.system.and.is#0A**.meant.to.run.on.mo
st.machines.with.a.Unix-like.C.libraries#2E#0A**#0A
**.(c).Copyright:..Martin.Richards..4.September.200
9#0A**#0A*/#0A#0A/*#0AChange.History#0A#0A04/09/09#0A
Started.to.make.changes.for.the.Vax.under.VMS#0A#0A
10/04/06#0AMade.change.to.natbcpl.to.make.rdch.read
.the.command.argument.characters.before#0Areading.f
rom.stdin,.for.compatibility.with.cintsys#2E#0A#0A2
1/04/04#0AMade.many.changes.and.improvements.sugges
ted.by.Colin.Liebenrood#0A#0A07/11/96#0ASystematic.
changes.to.allow.64.bit.implementation.on.the.ALPHA
#0A#0A23/07/96#0AFirst.implementation#0A*/#0A#0A#23
include.<stdio#2Eh>#0A#23include.<stdlib#2Eh>#0A#23
include.<signal#2Eh>#0A#23include.<string#2Eh>#0A#0A
#23if.defined(forVmsItanium).||.defined(forVmsVax)#0A
#23include.<sys/timeb#2Eh>#0A#23else#0A#23include.<
sys/timeb#2Eh>#0A#23endif#0A#0A/*.bcpl#2Eh.contains
.machine/system.dependent.#23defines..*/#0A#23inclu
de."bcpl#2Eh"#0A#0Astatic.BCPLWORD.result2;#0Astati
c.BCPLWORD.prefix;#0ABCPLWORD.rootnode[Rtn_upb+1];#0A
static.char.*parms;../*.vector.of.command-line.argu
ments.*/#0Astatic.int..parmp#3D1;./*.subscript.of.n
ext.command-line.character#2E.*/#0Astatic.int..ttyi
np;../*.#3D1.if.stdin.is.a.tty,.#3D0.otherwise.*/#0A
#0A/*.prototypes.for.forward.references.*/#0Astatic
.BCPLWORD.muldiv(BCPLWORD.a,.BCPLWORD.b,.BCPLWORD.c
);#0Astatic.char.*b2c_fname(BCPLWORD.bstr,.char.*cs
tr);#0Astatic.char.*vmsfname(char.*name,.char.*vaxn
ame);#0Astatic.char.*b2c_str(BCPLWORD.bstr,.char.*c
str);#0Astatic.BCPLWORD.c2b_str(char.*cstr,.BCPLWOR
D.bstr);#0A#0A/*.Function.normally.defined.in.graph
ics#2Ec..*/#0Aextern.BCPLWORD.sysGraphics(BCPLWORD.
*p);#0ABCPLWORD.sysGraphics(BCPLWORD.*p).{.return.0
;.}./*.Dummy.definition.*/#0A#0A#23define.Globword.
.....0x8F8F0000L#0A#23define.Gn_result2....10#0A#0A
int.badimplementation(void)#0A{.int.bad.#3D.0,.A#3D
'A';#0A..SIGNEDCHAR.c.#3D.(SIGNEDCHAR)255;#0A..if(s
izeof(BCPLWORD)!#3D(1<<B2Wsh)).{#0A.......PRINTF("S
ize.of.a.BCPL.word.is.not.%d\n",.1<<B2Wsh);#0A.....
..bad.#3D.1;#0A..}#0A..if(A!#3D65).{#0A.......PRINT
F("Character.set.is.not.ASCII\n");#0A.......bad.#3D
.1;#0A..}#0A..if.(c/-1.!#3D.1).{#0A....PRINTF("Ther
e.is.a.problem.with.SIGNEDCHAR\n");#0A....bad.#3D.1
;#0A..}#0A..return.bad;#0A}#0A#0Avoid.initfpvec(voi
d)....{.return;.}#0ABCPLWORD.newfno(FILE.*fp)...{.r
eturn.WD.fp;.}#0ABCPLWORD.freefno(BCPLWORD.fno).{.r
eturn.fno;.}#0AFILE.*findfp(BCPLWORD.fno)..{.return
.(FILE.*)fno;.}#0A#0A/*.storage.for.SIGINT.handler.
*/#0Avoid.(*old_handler)(int);#0A#0Avoid.handler(in
t.sig)#0A{.#0A..printf("SIGINT.received\n");#0A..ol
d_handler.#3D.signal(SIGINT,.old_handler);#0A..clos
e_keyb();#0A..exit(20);#0A}#0A#0Aint.main(int.argc,
.char.*argv[])#0A{.int.i;....../*.for.FOR.loops..*/
#0A#0A..if.(.badimplementation().)#0A..{.printf("Th
is.implementation.of.C.is.not.suitable\n");#0A....r
eturn.20;#0A..}#0A#0A../*.Try.to.reconstruct.the.co
mmand.line.arguments.from.argv.*/#0A..parms.#3D.(ch
ar.*)(MALLOC(256));#0A#0A..{.int.p#3D0;#0A....parms
[0].#3D.0;#0A#0A....for.(i#3D1;.i<argc;.i++).{#0A..
....char.*arg.#3D.argv[i];#0A......int.len.#3D.strl
en(arg);#0A......int.j;#0A......int.is_string.#3D.0
;./*.#3D1.if.arg.contains.",.space,.or.newline#2Ewh
ite.space.*/#0A....../*printf("clib:.getting.comman
d.line,.len#3D%d\n",.len);.*/#0A......for.(j#3D0;.j
<len;.j++)#0A........if(.arg[j]#3D#3D'"'.||.arg[j]#3D
#3D'.'.||.arg[j]#3D#3D'\n').is_string.#3D.1;#0A....
../*printf("clib:.getting.command.line,.is_string#3D
%d\n",.is_string);.*/#0A......parms[++p].#3D.'.';#0A
......if(is_string)#0A......{.parms[++p].#3D.'"';#0A
........for.(j#3D0;.j<len;.j++)#0A........{.int.ch.
#3D.arg[j];#0A..........if(ch#3D#3D'\n').{.parms[p+
+].#3D.'*';.parms[++p].#3D.'n';.}#0A..........if(ch
#3D#3D'"')..{.parms[p++].#3D.'*';.parms[++p].#3D.'"
';.}#0A#09..else.parms[++p].#3D.ch;#0A........}#0A.
.......parms[++p].#3D.'"';#0A......}.else.{#0A.....
...for.(j#3D0;.j<len;.j++).parms[++p].#3D.arg[j];#0A
......}#0A....}#0A....parms[++p].#3D.'\n';../*.Put.
a.newline.at.the.end.of.the.argument.string.*/#0A..
..parms[0].#3D.p;./*.Fill.in.the.BCPL.string.length
.*/#0A....parmp.#3D.1;..../*.Subscript.of.the.first
.character.of.the.*/#0A................../*.command
-line.argument.*/#0A#0A..../*printf("clib:.args:.le
n#3D%d\n",.parms[0]);.*/#0A..../*for(i#3D1;.i<#3Dpa
rms[0];i++).printf("parm[%d]#3D%d\n",.i,.parms[i]);
.*/#0A..../*printf("\n");.*/#0A..}#0A#0A../*..parms
.#3D.(BCPLWORD.*)(MALLOC(argc+1));.*/#0A../*parms[0
].#3D.argc.>.1.?.argc.:.0;.*/#0A../*for.(i.#3D.0;.i
.<.argc;.i++).{.*/#0A../*..BCPLWORD.v.#3D.(BCPLWORD
)(MALLOC(1+strlen(argv[i]).>>.B2Wsh)).>>.B2Wsh;.*/#0A
../*..c2b_str(argv[i],.v);.*/#0A../*..parms[1+i].#3D
.v;.*/#0A../*}.*/#0A#0A..old_handler.#3D.signal(SIG
INT,.handler);#0A..initfpvec();#0A#0A..BCPLWORD.*gl
obbase..#3D.(BCPLWORD.*)(calloc((gvecupb.+1),.1<<B2
Wsh));#0A..if(globbase#3D#3D0).#0A....{.printf("una
ble.to.allocate.space.for.globbase\n");#0A......exi
t(20);#0A....}#0A#0A..BCPLWORD.*stackbase.#3D.(BCPL
WORD.*)(calloc((stackupb+1),.1<<B2Wsh));#0A..if(sta
ckbase#3D#3D0).#0A....{.printf("unable.to.allocate.
space.for.stackbase\n");#0A......exit(20);#0A....}#0A
#0A..for(i#3D0;.i<#3DRtn_upb;.i++).rootnode[i].#3D.
0;#0A#0A..globbase[0].#3D.gvecupb;#0A#0A..for.(i#3D
1;i<#3Dgvecupb;i++).globbase[i].#3D.Globword.+.i;#0A
..globbase[Gn_rootnode].#3D.((BCPLWORD)rootnode)>>B
2Wsh;#0A#0A..for.(i#3D0;i<#3Dstackupb;i++).stackbas
e[i].#3D.0;#0A#0A../*..printf("clib:.gvecupb#3D%d.s
tackupb#3D%d\n",.gvecupb,.stackupb);.*/#0A../*.init
sections,.gvecupb.and.stackupb.are.defined.in.the.f
ile.*/#0A../*.(typically).initprog#2Ec.created.by.a
.call.of.the.command.makeinit#2E.*/#0A..initsection
s(globbase);#0A..ttyinp.#3D.init_keyb();#0A#0A../*.
Enter.BCPL.start.function:.callstart.is.defined.in.
mlib#2Es.*/#0A..BCPLWORD.res.#3D.callstart(stackbas
e,.globbase);#0A#0A..close_keyb();#0A#0A..if.(res).
printf("\nExecution.finished,.return.code.%ld\n",.(
long)res);#0A#0A..free(globbase);#0A..free(stackbas
e);#0A..free(parms);#0A#0A..return.res;#0A}#0A#0A#0A
BCPLWORD.muldiv(BCPLWORD.a,.BCPLWORD.b,.BCPLWORD.c)
#0A{.unsigned.BCPLWORD.q#3D0,.r#3D0,.qn,.rn;#0A..un
signed.BCPLWORD.ua,.ub,.uc;#0A..int.qneg#3D0,.rneg#3D
0;#0A../*..printf("muldiv:.a#3D%d.b#3D%d.c#3D%d\n",
.a,.b,.c);.*/#0A..if(c#3D#3D0).c#3D1;#0A..if(a<0).{
.qneg#3D!qneg;.rneg#3D!rneg;.ua.#3D.-a;.}#0A..else.
.............................ua.#3D..a;#0A..if(b<0)
.{.qneg#3D!qneg;.rneg#3D!rneg;.ub.#3D.-b;.}#0A..els
e..............................ub.#3D..b;#0A..if(c<
0).{.qneg#3D!qneg;.............uc.#3D.-c;.}#0A..els
e..............................uc.#3D..c;#0A..#0A..
qn.#3D.ub./.uc;#0A..rn.#3D.ub.%.uc;#0A..#0A..while(
ua)#0A..{.if(ua&1).{.q.+#3D.qn;#0A...............r.
+#3D.rn;#0A...............if(r>#3Dc).{.q++;.r.-#3D.
uc;.}#0A.............}#0A....ua.>>#3D.1;#0A....qn.<
<#3D.1;#0A....rn.<<#3D.1;#0A....if(rn>#3Duc).{qn++;
.rn.-#3D.uc;.}#0A..}#0A..result2.#3D.rneg.?.-r.:.r;
#0A..return.qneg.?.-q.:.q;#0A}#0A#0Astatic.char.chb
uf1[256],.chbuf2[256];./*.to.hold.filenames.*/#0Ast
atic.char.chbuf3[256],.chbuf4[256];./*.to.hold.file
names.*/#0A#0Aint.tracing.#3D.0;#0Aint.filetracing.
#3D.0;#0A#0Aint.relfilename(char.*name)#0A{.if(name
[0]#3D#3DFILE_SEP_CH.||#0A...../*.The.following.is.
fiddle.for.MSDOS/Windows.*/#0A.....FILE_SEP_CH#3D#3D
'\\'.&&.'A'<#3Dname[0].&&.name[0]<#3D'Z'.&&.name[1]
#3D#3D':')#0A.......return.0;./*.Absolute.file.name
s.don't.use.paths.*/#0A..return.1;.#0A}#0A#0A/*.pat
hinput.does.not.use.any.of.chbuf1,.chbuf2.or.chbuf3
#2E.*/#0AFILEPT.pathinput(char.*name,.char.*pathnam
e)#0A/*.If.pathname.is.not.null,.name.is.looked.up.
in.the.directories#0A...it.specified,.otherwise.nam
e.is.looked.up.in.the.current.directory#0A*/#0A{.FI
LEPT.fp.#3D.0;#0A#0A../*.Look.through.the.PATH.dire
ctories.if.pathname.is.given#2E.*/#0A..if.(pathname
).{#0A....char.str[256];#0A....char.*filename.#3D.&
str[0];#0A....int.itemsep.#3D.FILE_SEP_CH#3D#3D'/'.
?.':'.:.';';#0A#23if.defined(forVmsItanium).||.defi
ned(forVmsVax)#0A....itemsep.#3D.';';#0A#23endif#0A
..../*PRINTFS("pathinput:.searching.for.%s.in.path.
%s\n",.name,.pathname);.*/#0A....if.(relfilename(na
me))#0A....{.char.*path.#3D.getenv(pathname);#0A...
...if(filetracing).{#0A........PRINTFS("pathinput:.
using.%s",.pathname);#0A........PRINTFS(".#3D.%s\n"
,.path);#0A......}#0A....../*PRINTFS("pathinput:.se
arching.directories.%s\n",.path);.*/#0A....../*.Try
.prefixing.with.each.directory.in.the.path#2E.*/#0A
......while(path.&&.fp#3D#3D0)#0A......{.char.*f#3D
filename;#0A........char.*n#3Dname;#0A........while
(*path#3D#3Ditemsep).path++;#0A........if(*path#3D#3D
0).break;#0A......../*.Copy.the.directory.name.into
.filename.*/#0A........while(*path!#3D0.&&.*path!#3D
itemsep)#0A........{.char.ch.#3D.*path++;#0A.......
...if(ch#3D#3D'/'.||.ch#3D#3D'\\').ch.#3D.FILE_SEP_
CH;#0A..........*f++.#3D.ch;#0A........}#0A........
/*.Insert.a.filename.seperator.if.necessary#2E.*/#0A
........if(f[-1]!#3DFILE_SEP_CH).*f++.#3D.FILE_SEP_
CH;#0A#0A......../*.Append.the.given.file.name.*/#0A
........while(*n)#0A........{.char.ch.#3D.*n++;#0A.
.........if(ch#3D#3D'/'.||.ch#3D#3D'\\').ch.#3D.FIL
E_SEP_CH;#0A..........*f++.#3D.ch;#0A........}#0A..
......*f.#3D.0;#0A#23if.defined(forVmsItanium).||.d
efined(forVmsVax)#0A........filename.#3D.vmsfname(f
ilename,.chbuf4);#0A#23endif#0A........fp.#3D.fopen
(filename,."rb");#0A........if(filetracing)#0A.....
...{.PRINTFS("Trying:.%s.-.",.filename);#0A#09..if(
fp).{#0A............PRINTF("found\n");#0A#09..}.els
e.{#0A............PRINTF("not.found\n");#0A#09..}#0A
........}#0A......}#0A....}#0A..}.else.{#0A..../*.I
f.pathname.was.NULL,.search.the.current.directory.*
/#0A..../*PRINTFS("Searching.for.%s.in.the.current.
directory\n",.name);.*/#0A#23if.defined(forVmsItani
um).||.defined(forVmsVax)#0A....fp.#3D.fopen(vmsfna
me(name,.chbuf4),."rb");#0A#23else#0A....fp.#3D.fop
en(name,."rb");#0A#23endif#0A....if(filetracing)#0A
....{.PRINTFS("Trying:.%s.in.the.current.directory.
-.",.name);#0A......if(fp).{#0A........PRINTF("foun
d\n");#0A......}.else.{#0A........PRINTF("not.found
\n");#0A......}#0A....}#0A..}#0A#0A../*if(fp#3D#3D0
).PRINTFS("pathinput:.failed.to.find.%s.anywhere\n"
,.name);.*/#0A../*else......PRINTF("pathinput:.succ
ess\n");.*/#0A#0A..return.fp;#0A}#0A/*#0AFILE.*path
input(char.*name,.char.*pathname)#0A{.FILE.*fp.#3D.
fopen(name,."r");#0A..char.filename[1024];#0A..int.
itemsep.#3D.FILE_SEP_CH#3D#3D'/'.?.':'.:.';';#0A..i
f.(fp#3D#3D0)#0A..{.if.(pathname.&&.relfilename(nam
e))#0A....{.char.*path.#3D.getenv(pathname);#0A....
..while(path.&&.fp#3D#3D0)#0A......{.char.*f#3Dfile
name,#0A.............*n#3Dname;#0A........while(*pa
th#3D#3Ditemsep).path++;#0A........if(*path#3D#3D0)
.break;#0A........while(*path!#3D0.&&.*path!#3Ditem
sep).*f++.#3D.*path++;#0A........if(f[-1]!#3DFILE_S
EP_CH).*f++.#3D.FILE_SEP_CH;#0A........while(*n).*f
++.#3D.*n++;#0A........*f.#3D.0;#0A........fp.#3D.f
open(filename,."r");#0A......}#0A....}#0A..}#0A..re
turn.fp;#0A}#0A*/#0A#0A/*.dosys(P,.G).called.from.m
lib#2Es.in.response.to#0A**.BCPL.call.res.:#3D.sys(
n,.x,.y,.#2E#2E#2E#2E)#2E.Arguments.p.&.g.are.the#0A
**.OCODE.stack-pointer.P.and.Global.vector.pointer.
G#2E.The.arguments#0A**.to.sys().are.n.#3D.p[3],.x.
#3D.p[4].#2E#2E#2E#2E#0A**.sys(0,.r).is.trapped.in.
mlib#2Es#0A*/#0A#0ABCPLWORD.dosys(register.BCPLWORD
.*p,.register.BCPLWORD.*g)#0A{.register.BCPLWORD.i;
#0A#0A..switch((int)(p[3]))#0A..{.default:.printf("
\nBad.sys.%ld\n",.(long)p[3]);..return.p[3];#0A..#0A
..../*#0A....case.Sys_setcount:.set.count..........
.....--.done.in.cinterp#0A....case.Sys_quit:.....re
turn.from.interpreter.--.done.in.cinterp#0A#0A....c
ase.Sys_rti:......sys(Sys_rti,.regs)......--.done.i
n.cinterp..Cintpos#0A....case.Sys_saveregs:.sys(Sys
_saveregs,.regs).--.done.in.cinterp..Cintpos#0A....
case.Sys_setst:....sys(Sys_setst,.st)......--.done.
in.cinterp..Cintpos#0A....case.Sys_tracing:..//.sys
(Sys_tracing,.b)#0A......tracing.#3D.W[p+4];#0A....
..return.0;#0A....case.Sys_watch:....sys(Sys_watch,
.addr)....--.done.in.cinterp#0A#0A....case..Sys_tal
ly:.........//.sys(Sys_tally,.flag)#0A......if(W[p+
4]).{#0A........tallylim.#3D.tallyupb;#0A........fo
r(i#3D1;.i<#3Dtallylim;.i++).tallyv[i].#3D.0;#0A...
...}.else.{#0A........tallylim.#3D.0;#0A......}#0A.
.....return.0;#0A.....#0A....case.Sys_interpret:.//
.call.interpreter.(recursively)#0A....{.BCPLWORD.re
gsv.#3D.W[p+4];#0A......if(W[regsv+7]<0).return.CIN
TASM..(regsv,.W);#0A......return.interpret(regsv,.W
);#0A....}#0A....*/#0A#0A....case.Sys_sardch:#0A...
.{.BCPLWORD.ch;#0A....../*printf("parmp#3D%d.parms[
0]#3D%d\n",.parmp,.parms[0]);.*/#0A......if(parmp<#3D
parms[0]).{../*.Added.MR.10/04/06.*/#0A......../*.R
ead.the.command.arguments.(without.echo).first#2E.*
/#0A......../*printf("sardch:.parmp#3D%d.parms[0]#3D
%d\n",.parmp,.parms[0]);.*/#0A......../*printf("sar
dch:.returning.%d\n",.parms[parmp]);.*/#0A........r
eturn.parms[parmp++];#0A......}#0A......ch.#3D.Read
ch();#0A......if.(ttyinp).{../*.echo.tty.input.only
.*/#0A........if.(ch>#3D0).putchar((char)ch);#0A...
.....if(ch#3D#3D13).{.ch.#3D.10;.putchar(10);.}#0A.
.......fflush(stdout);#0A......}#0A......return.ch;
#0A....}#0A#0A....case.Sys_sawrch:#0A......if(p[4].
#3D#3D.10).putchar(13);#0A......putchar((char)p[4])
;#0A......fflush(stdout);#0A......return.0;#0A#0A..
..case.Sys_read:../*.bytesread.:#3D.sys(Sys_read,.f
p,.buf,.bytecount).*/#0A....{.FILE.*fp.#3D.findfp(p
[4]);#0A......char.*bbuf.#3D.(char.*)(p[5]<<B2Wsh);
#0A......BCPLWORD.len...#3D.p[6];#0A......len.#3D.f
read(bbuf,.(size_t)1,.(size_t)len,.fp);#0A......ret
urn.len;#0A....}#0A#0A....case.Sys_write:#0A....{.F
ILE.*fp.#3D.findfp(p[4]);#0A......char.*bbuf.#3D.(c
har.*)(p[5]<<B2Wsh);#0A......BCPLWORD.len.#3D.p[6];
#0A......len.#3D.WD.fwrite(bbuf,.(size_t)1,.(size_t
)len,.fp);#0A......fflush(fp);#0A......return.len;#0A
....}#0A#0A....case.Sys_openread:#0A....{.char.*nam
e.#3D.b2c_fname(p[4],.chbuf1);#0A......FILEPT.fp;#0A
#23if.defined(forVmsItanium).||.defined(forVmsVax)#0A
......name.#3D.vaxfname(name,.chbuf4);#0A#23endif#0A
#0A......fp.#3D.pathinput(name,....................
/*.Filename.*/#0A.....................b2c_str(p[5],
.chbuf2));../*.Environment.variable.*/#0A......if(f
p#3D#3D0).return.0L;#0A......return.newfno(fp);#0A.
...}#0A#0A....case.Sys_openwrite:#0A....{.char.*nam
e.#3D.b2c_fname(p[4],.chbuf1);#0A......FILEPT.fp;#0A
#23if.defined(forVmsItanium).||.defined(forVmsVax)#0A
......name.#3D.vaxfname(name,.chbuf4);#0A#23endif#0A
#0A......fp.#3D.fopen(name,."wb");#0A......if(fp#3D
#3D0).return.0L;#0A......return.newfno(fp);#0A....}
#0A#0A....case.Sys_openreadwrite:#0A....{.char.*nam
e.#3D.b2c_fname(p[4],.chbuf1);#0A......FILEPT.fp;#0A
#23if.defined(forVmsItanium).||.defined(forVmsVax)#0A
......name.#3D.vaxfname(name,.chbuf4);#0A#23endif#0A
#0A.......fp.#3D.fopen(name,."rb+");#0A......if(fp#3D
#3D0).fp.#3D.fopen(name,."wb+");#0A......if(fp#3D#3D
0).return.0L;#0A......return.newfno(fp);#0A....}#0A
#0A....case.Sys_close:#0A....{.BCPLWORD.res.#3D.!.f
close(findfp(p[4]));#0A......freefno(p[4]);#0A.....
.return.res;#0A....}#0A#0A....case.Sys_deletefile:#0A
....{.char.*name.#3D.b2c_fname(p[4],.chbuf1);#0A...
...FILEPT.fp;#0A#23if.defined(forVmsItanium).||.def
ined(forVmsVax)#0A......name.#3D.vaxfname(name,.chb
uf4);#0A......{./*.Append.';*'.to.name.*/#0A.......
.int.len.#3D.0;#0A........while(name[len]).len++;#0A
........name[len].#3D.';';#0A........name[len].#3D.
'*';#0A........name[len].#3D.0;#0A......}#0A#23endi
f#0A......return.!.REMOVE(name);#0A....}#0A#0A....c
ase.Sys_renamefile:#0A....{.char.*name1.#3D.b2c_fna
me(p[4],.chbuf1);#0A......char.*name2.#3D.b2c_fname
(p[5],.chbuf2);#0A......int.len.#3D.0;#0A#23if.defi
ned(forVmsItanium).||.defined(forVmsVax)#0A......na
me1.#3D.vaxfname(name1,.chbuf3);#0A......name2.#3D.
vaxfname(name2,.chbuf4);#0A......{./*.Append.';*'.t
o.name2.*/#0A........len.#3D.0;#0A........while(nam
e2[len]).len++;#0A........name2[len].#3D.';';#0A...
.....name2[len].#3D.'*';#0A........name2[len].#3D.0
;#0A......}#0A#23endif#0A......REMOVE(name2);#0A#23
if.defined(forVmsItanium).||.defined(forVmsVax)#0A.
.....name2[len].#3D.0;#0A#23endif#0A......return.!.
rename(name1,.name2);#0A....}#0A#0A....case.Sys_get
vec:#0A......return.((BCPLWORD)(malloc((1+p[4])<<B2
Wsh)))>>B2Wsh;#0A#0A....case.Sys_freevec:#0A......f
ree((void.*)(p[4]<<B2Wsh));.return.-1;#0A/*#0A....c
ase.Sys_loadseg:#0A......return.loadseg(b2c_str(p[4
],.chbuf1));#0A....case.Sys_globin:#0A......return.
globin(p[4],.g);#0A....case.Sys_unloadseg:#0A......
unloadseg(p[4]);....................return.0;#0A*/#0A
#0A....case.Sys_muldiv:#0A....{.BCPLWORD.res.#3D..m
uldiv(p[4],.p[5],.p[6]);#0A......g[Gn_result2].#3D.
result2;#0A......return.res;#0A....}#0A#0A....case.
Sys_intflag:#0A......return.intflag().?.-1L.:.0L;#0A
#0A/*#0A....case.Sys_setraster:#0A......return.setr
aster(p[4],.p[5]);#0A*/#0A#0A....case.Sys_cputime:.
/*.Return.CPU.time.in.milliseconds..*/#0A......retu
rn.muldiv(clock(),.1000,.TICKS_PER_SEC);#0A#0A....c
ase.Sys_filemodtime:./*.Return.time.of.last.modific
ation.of.file#0A.............................whose.
name.is.in.p[4]..*/#0A....{.struct.stat.buf;#0A....
..char.*name.#3D.b2c_fname(p[4],.chbuf1);#0A......F
ILEPT.fp;#0A#23if.defined(forVmsItanium).||.defined
(forVmsVax)#0A......name.#3D.vaxfname(name,.chbuf4)
;#0A#23endif#0A......if.(stat(name,.&buf)).return.0
;#0A......return.buf#2Est_mtime;#0A....}#0A#0A....c
ase.Sys_setprefix:./*.Set.the.file.prefix.string..*
/#0A......prefix.#3D.p[4];#0A......return.prefix;#0A
#0A....case.Sys_getprefix:./*.Return.the.file.prefi
x.string..*/#0A......return.prefix;#0A#0A....case.S
ys_graphics:./*.Perform.an.operation.on.the.graphic
s.window..*/#0A......return.sysGraphics(p);#0A#0A..
..case.Sys_seek:../*.res.:#3D.seek(fd,.pos)...*/#0A
....{.FILEPT.fp.#3D.findfp(p[4]);#0A......BCPLWORD.
pos.#3D.p[5];#0A......BCPLWORD.res.#3D.fseek(fp,.po
s,.SEEK_SET);#0A....../*printf("fseek.#3D>.res#3D%d
.errno#3D%d\n",.res,.errno);.*/#0A....../*g[Gn_resu
lt2].#3D.errno;.*/#0A......return.res#3D#3D0.?.-1.:
.0;./*.res#3D0.succ,.res#3D-1.error..*/#0A....}#0A#0A
....case.Sys_tell:./*.pos.:#3D.sys(Sys_tell,fd)..*/
#0A....{.FILE.*fp.#3D.findfp(p[4]);#0A......BCPLWOR
D.pos.#3D.ftell(fp);#0A....../*g[Gn_result2].#3D.er
rno;.*/#0A......return.pos;./*.>#3D0.succ,.-1#3Derr
or.*/#0A....}#0A#0A....case.Sys_waitirq:./*.Wait.fo
r.irq.*/#0A....../*#0A......pthread_mutex_lock..(..
.......&irq_mutex);#0A......pthread_cond_wait...(&i
rq_cv,.&irq_mutex);#0A......pthread_mutex_unlock(..
.......&irq_mutex);#0A......*/#0A......return.0;#0A
#0A....case.Sys_lockirq:./*.Stop.all.devices.from.m
odifying.*/#0A....................../*.packets.or.g
enerating.interrupts.*/#0A....../*#0A......pthread_
mutex_lock(&irq_mutex);#0A......*/#0A......return.0
;#0A#0A....case.Sys_unlockirq:./*.Allow.devices.to.
modify.packets.*/#0A......................../*.and.
generate.interrput.*/#0A....../*#0A......pthread_mu
tex_unlock(&irq_mutex);#0A......*/#0A......return.0
;#0A#0A.....case.Sys_devcom:./*.res.:#3D.sys(Sys_de
vcom,.com,.arg).*/#0A.......return.0;./*devcommand(
W[p+4],.W[p+5],.W[p+6]);.*/#0A#0A.....case.Sys_ftim
e:./*.return.result.of.calling.ftime.*/#0A.....{.st
ruct.timeb.tb;#0A.......BCPLWORD.*v.#3D.(BCPLWORD*)
(p[4]<<2);#0A.......ftime(&tb);#0A#0A......./*.****
************.BEWARE.************************.*/#0A.
....../*.The.date.will.OVERFLOW.on.19-Jan-2038.at.3
:14:07.*/#0A.......v[0].#3D.0;./*(BCPLWORD)(tb#2Eti
me>>32);.*/#0A.......v[1].#3D.(BCPLWORD)tb#2Etime;.
./*.Seconds.since.epoch.*/#0A.......v[2].#3D.tb#2Em
illitm;...../*.milli-seconds.*/#0A.......v[3].#3D.t
b#2Etimezone;..../*.Minutes.west.of.Greenwich.*/#0A
.......v[4].#3D.tb#2Edstflag;...../*.non.zero.#3D>.
Daylight.saving.time#0A............................
.....applies.*/#0A#0A.......daylight.#3D.1;........
../*.Fudge.for.windows.*/#0A.......daylight.#3D.0;.
........./*.Fudge.for.windows.MR.31/10/03.*/#0A....
...tzset();.............../*.Should.be.done.separat
ely.*/#0A......./*#0A.......printf("cintpos:.timezo
ne#3D%d.daylight#3D%d.%s.%s\n",#0A...............(B
CPLWORD)timezone,(BCPLWORD)daylight,.tzname[0],#0A#09
.......tzname[1]);#0A.......*/#0A.......if(((BCPLWO
RD)timezone)%3600#3D#3D0)./*.Fudge.for.windows.*/#0A
.........v[1].-#3D.(BCPLWORD)timezone;..../*.Correc
t.for.timezone.*/#0A.......if.(daylight)#0A........
.v[1].+#3D.60*60;............./*.Add.one.hour.in.DS
T.*/#0A.......v[1].+#3D.rootnode[Rtn_adjclock].*.60
;./*.Add.adjustment.*/#0A.......return.-1;#0A.....}
#0A#0A.....case.Sys_usleep:./*.usleep.for.some.micr
o-seconds.*/#0A.......return.usleep(p[4]);#0A......
........#0A.....case.Sys_filesize:../*.res.:#3D.sys
(Sys_filesize,.fd)...*/#0A.....{.FILE.*fp...#3D.fin
dfp(p[4]);#0A.......BCPLWORD.pos..#3D.ftell(fp);#0A
.......BCPLWORD.rc...#3D.fseek(fp,.0,.SEEK_END);#0A
.......BCPLWORD.size.#3D.ftell(fp);#0A.......rc..#3D
.fseek(fp,.pos,.SEEK_SET);#0A.......if.(rc).size.#3D
.-1;#0A.......return.size;./*.>#3D0.succ,.-1#3Derro
r..*/#0A.....}#0A#0A.....case.Sys_getsysval:./*.res
.:#3D.sys(Sys_getsysval,.addr).*/#0A.....{.BCPLWORD
.*addr.#3D.(BCPLWORD*)p[4];#0A.......return.*addr;#0A
.....}#0A#0A.....case.Sys_putsysval:./*.res.:#3D.sy
s(Sys_putsysval,.addr,.val).*/#0A.....{.BCPLWORD.*a
ddr.#3D.(BCPLWORD*)p[4];#0A.......*addr.#3D.p[5];#0A
.......return.0;#0A.....}#0A#0A.....case.Sys_shellc
om:./*.res.:#3D.sys(Sys_shellcom,.comstr).*/#0A....
.{.char.*comstr.#3D.(char*)(p[4]<<2);#0A.......int.
i;#0A.......char.com[256];#0A.......int.len.#3D.str
len(comstr);#0A.......for(i#3D0;.i<len;.i++).com[i]
.#3D.comstr[i+1];#0A.......com[len].#3D.0;#0A......
./*#0A.......printf("\ndosys:.calling.shell.command
.%s\n",.com);#0A.......*/#0A.......return.system(co
m);#0A.....}#0A#0A.....case.Sys_getpid:./*.res.:#3D
.sys(Sys_getpid).*/#0A.......return.getpid();#0A#0A
.....case.Sys_dumpmem:./*.sys(Sys_dumpmem,.context)
.*/#0A.......printf("\nCintpos.memory.not.dumped.to
.DUMP#2Emem\n");#0A.......return.0;#0A#0A.....case.
Sys_callnative:#0A.....{./*.Call.native.code#2E.*/#0A
.......int(*rasmfn)(void).#3D.(int(*)(void))&p[4];#0A
.......return.rasmfn();#0A.....}..............#0A#0A
.....case.135:./*.Return.system.date.and.time.in.VE
C.5.*/#0A.....{.time_t.clk.#3D.time(0);#0A.......st
ruct.tm.*now.#3D.gmtime(&clk);#0A.......BCPLWORD.*a
rg.#3D.PT(p[4].<<.B2Wsh);#0A.......arg[0].#3D.now->
tm_year+1900;#0A.......arg[1].#3D.now->tm_mon+1;#0A
.......arg[2].#3D.now->tm_mday;#0A.......arg[3].#3D
.now->tm_hour;#0A.......arg[4].#3D.now->tm_min;#0A.
......arg[5].#3D.now->tm_sec;#0A.......return.0;#0A
.....}#0A#0A.....case.136:./*.Return.current.direct
ory.in.VEC.1.+.256/bytesperword.*/#0A.....{.getcwd(
chbuf1,.256);#0A.......c2b_str(chbuf1,.p[4]);#0A...
....return.0;#0A.....}#0A#0A....case.137:#0A......r
eturn.(BCPLWORD)parms.>>.B2Wsh;#0A..}#0A}.#0A#0Acha
r.*vmsfname(char.*name,.char.*vmsname).{#0A/*#0AThi
s.function.converts.a.BCPL.filename.to.a.VMS.filena
me#0AExamples:#0A#0AName.........................VM
S.name#0A#0Aecho#2Eb.......................echo#2Eb
#0Acom/echo#2Eb...................[#2Ecom]echo#2Eb#0A
/mrich177/distribution/bcpl#2Eg/libhdr#2Eh#0A......
.......................[mrich177#2Edistribution#2Eb
cpl#2Eg]libhdr#2Eh#0Avd10$disk:/mrich177/junk#2Eb..
.vd10$disk:[mrich177]junk#2Eb#0A#2E#2E/cintcode/com
/bcplfe#2Eb.....[-#2Ecintcode#2Ecom]bcplfe#2Eb#0A*/
#0A..int.ch,.i#3D0,.j#3D0,.len#3D0,.lastslashpos#3D
-1;#0A../*.If.name.contains.a.colon,.copy.all#0A...
..characters.up.to.and.including.the.colon#2E#0A..*
/#0A..while.(1).{#0A....int.ch.#3D.name[i];#0A....i
f.(ch#3D#3D0).break;./*.No.colon.in.name.*/#0A....i
f.(ch#3D#3D':').{#0A....../*.Copy.up.to.and.includi
ng.the.colon.*/#0A......while.(len<#3Di).{.vmsname[
len].#3D.name[len];.len++;.}#0A......j.#3D.len;#0A.
.....break;#0A....}#0A....i++;#0A..}#0A../*.Find.po
sition.of.last.slash,.if.any.*/#0A..while.(1).{#0A.
...int.ch.#3D.name[j];#0A....if(ch#3D#3D0).break;#0A
....if(ch#3D#3D'/').lastslashpos.#3D.j;#0A....j++;#0A
..}#0A#0A../*.No.slashes..#3D>.nothing#0A.....Leadi
ng./...#3D>.[#0A.....Slashes.but.no.leading.slash.s
o.insert.[#2E.or.[-#0A#0A.....name.is.then.copied.c
onverting.all.slashes.except.the.leading#0A.....and
.last.ones.to.dots,.and.converting.the.last.slash.t
o.]#2E#0A..*/#0A..j.#3D.i;#0A..if(name[j]#3D#3D'/')
.{#0A..../*.if.leading.slash.but.not.the.last.conve
rt.it.to.[.*/#0A....if.(j!#3Dlastslashpos).vmsname[
len++].#3D.'[';#0A....j++;#0A..}.else.{#0A....if.(l
astslashpos>#3D0).{#0A....../*.Slashes.but.no.leadi
ng.slash,.so.insert.[#2E.or.[-..*/#0A......vmsname[
len++].#3D.'[';#0A......if(name[j]!#3D'#2E'.||.name
[j+1]!#3D'#2E').{#0A........vmsname[len++].#3D.'#2E
';#0A......}#0A....}#0A..}#0A#0A..while.(1).{#0A...
./*.Replace.last./.by.]#0A.......and.non.last./.by.
#2E#0A.......and.#2E#2E.by.-#0A....*/#0A....int.ch.
#3D.name[j];#0A....if(ch#3D#3D'#2E'.&&.name[j+1]#3D
#3D'#2E').{#0A....../*.Convert.#2E#2E.to.-.*/#0A...
...ch.#3D.'-';#0A......j++;#0A....}#0A....if(ch#3D#3D
'/').{#0A......if.(j#3D#3Dlastslashpos).ch.#3D.']';
#0A......else.................ch.#3D.'#2E';#0A....}
#0A....vmsname[len++].#3D.ch;#0A....if(ch#3D#3D0).b
reak;#0A....j++;#0A..}#0A..return.vmsname;#0A}#0A#0A
/*.b2c_fname.converts.the.BCPL.string.for.a.file.na
me.to.a.C.character#0A**.string#2E..The.character.'
/'.(or.'\').is.treated.as.a.separator.and.is#0A**.c
onverted.to.FILE_SEP_CH.('/'.for.unix,.'\'.for.MSDO
S.or.':'.for.MAC)#2E#0A**.If.prefix.is.set.and.the.
filename.is.relative,.the.prefix.is.prepended#2E#0A
*/#0Achar.*b2c_fname(BCPLWORD.bstr,.char.*.cstr)#0A
{..char.*bp.#3D.(char*)(bstr<<2);#0A...int.len;#0A.
..int.i#3D0;#0A...if.(bstr#3D#3D0).return.0;./*.No.
path.given.*/#0A...len.#3D.*bp++;#0A...if.(prefix.&
&.relfilename((char*)bstr))#0A...{./*.Prepend.the.f
ilename.with.prefix.*/#0A.....char.*pfxp.#3D.(char*
)(prefix<<2);#0A.....int.pfxlen.#3D.*pfxp++;#0A....
.while(pfxlen--)#0A.....{.char.ch.#3D.*pfxp++;#0A..
.....if(ch#3D#3D'/'.||.ch#3D#3D'\\'.||.ch#3D#3D':')
.ch.#3D.FILE_SEP_CH;#0A.......cstr[i++].#3D.ch;#0A.
....}#0A.....if.(cstr[i-1].!#3D.FILE_SEP_CH).cstr[i
++].#3D.FILE_SEP_CH;#0A...}#0A#0A...while.(len--)#0A
...{.char.ch.#3D.*bp++;#0A.....if(ch#3D#3D'/'.||.ch
#3D#3D'\\'.||.ch#3D#3D':').ch.#3D.FILE_SEP_CH;#0A..
...cstr[i++].#3D.ch;#0A...}#0A...cstr[i].#3D.0;#0A.
../*if.(prefix).printfs("filename.#3D.%s\n",.cstr);
.*/#0A.../*printfs("b2c_fname:.cstr.#3D.%s\n",.cstr
);.*/#0A...return.cstr;#0A}#0A#0A/*.b2c_str.convert
s.the.BCPL.string.for.a.file.name.to.a.C.character#0A
**.string#2E..The.character.'/'.(or.'\').is.treated
.as.a.separator.and.is#0A**.converted.to.FILE_SEP_C
H.('/'.for.unix,.'\'.for.MSDOS.or.':'.for.MAC)#0A*/
#0Achar.*b2c_str(BCPLWORD.bstr,.char.*.cstr)#0A{..c
har.*bp,.i,.len;#0A...if.(bstr#3D#3D0).return.0;#0A
...bp.#3D.(char.*)(bstr<<B2Wsh);#0A...len.#3D.*bp++
;#0A...for(i.#3D.0;.i<len;.i++)#0A...{.char.ch.#3D.
*bp++;#0A.....if(ch#3D#3D'/'.||.ch#3D#3D'\\').ch.#3D
.FILE_SEP_CH;#0A.....cstr[i].#3D.ch;#0A...}#0A...cs
tr[len].#3D.0;#0A...return.cstr;#0A}.#0A#0A/*#0A**.
c2b_str.converts.a.C.string.into.a.BCPL.string#0A*/
#0ABCPLWORD.c2b_str(char.*cstr,.BCPLWORD.bstr).{#0A
..char.*bp.#3D.(char.*)(bstr.<<.B2Wsh);#0A..int.len
.#3D.0;#0A..while.(cstr[len]).{#0A....bp[len+1].#3D
.cstr[len];#0A......++len;#0A..}#0A..bp[0].#3D.len;
#0A..return.bstr;#0A}#0A

######natbcpl/sysc/initcmpltest.c#
//.Initialisation.file.written.by.MakeInit.version.
1#2E8#0A#23include."bcpl#2Eh"#0A#0AWORD.stackupb#3D
10000;#0AWORD.gvecupb#3D1000;#0A#0A//.BCPL.sections
#0Aextern.BLIB(WORD.*);.#09//.file.(run-time.librar
y)#0Aextern.cmpltest(WORD.*);.#09//.file.#2E#2E/bcp
lprogs/tests/cmpltest#2Eb#0Aextern.DLIB(WORD.*);.#09
//.file.(system.dependent.library)#0A#0Avoid.initse
ctions(WORD.*g).{#0A....BLIB(g);.#09//.file.(run-ti
me.library)#0A....cmpltest(g);.#09//.file.#2E#2E/bc
plprogs/tests/cmpltest#2Eb#0A....DLIB(g);.#09//.fil
e.(system.dependent.library)#0A#0A....return;#0A}#0A


######natbcpl/sysc/kblib.c#
/*.this.module.defines.the.machine.dependent.keyboa
rd.interface#0A#0A...int.Readch(void).....returns.t
he.ASCII.code.for.the.next.key.pressed#0A..........
..............without.echo#2E#0A...int.init_keyb(vo
id)..initialises.the.keyboard.interface#2E#0A...int
.close_keyb(void).restores.the.keyboard.to.its.orig
inal.state#2E#0A...int.intflag(void)....returns.1.i
f.interrupt.key.combination.pressed#2E#0A#0AFollowi
ng.Colin.Liebenrood's.suggestion.(for.LINUX),#0A#0A
...init_keyb.return.1.is.stdin.is.a.tty,.0.otherwis
e#0Aand#0A...Readch().return.endstreamch.if.the.std
in.is.exhausted.or.^D.read#2E#0A*/#0A#0A#23include.
<stdio#2Eh>#0A#23include.<stdlib#2Eh>#0A#0A/*.bcpl#2E
h.contains.machine/system.dependent.#23defines..*/#0A
#23include."bcpl#2Eh"#0A#0A#23if.defined(forMIPS).|
|.defined(forSUN4).||.defined(forALPHA)#0A#23includ
e.<sys/ioctl#2Eh>#0A#23include.<sgtty#2Eh>#0A#0Aint
.init_keyb(void)#0A{.struct.sgttyb.ttyb;#0A#0A..ioc
tl(0,.TIOCGETP,.&ttyb);#0A..ttyb#2Esg_flags.#3D.CBR
EAK+EVENP+ODDP+CRMOD;#0A..ioctl(0,.TIOCSETP,.&ttyb)
;#0A..return.0;#0A}#0A#0Aint.close_keyb(void)#0A{.s
truct.sgttyb.ttyb;#0A..ioctl(0,.TIOCGETP,.&ttyb);#0A
..ttyb#2Esg_flags.#3D.ECHO+EVENP+ODDP+CRMOD;#0A..io
ctl(0,.TIOCSETP,.&ttyb);#0A..return.0;#0A}#0A#0Aint
.Readch(void)#0A{.return.getchar();#0A}#0A#0Aint.in
tflag(void)#0A{.return.0;#0A}#0A#23endif#0A#0A#23if
.defined(forLINUX).||.defined(forSPARC)#0A#23includ
e.<unistd#2Eh>#0A#23include.<stdio#2Eh>#0A#23includ
e.<stdlib#2Eh>#0A#23include.<termios#2Eh>#0A#0A/*.U
se.this.variable.to.remember.original.terminal.attr
ibutes#2E..*/#0A.....#0Astruct.termios.saved_attrib
utes;#0A.....#0Avoid#0Areset_input_mode.(void)#0A{#0A
..tcsetattr.(STDIN_FILENO,.TCSANOW,.&saved_attribut
es);#0A}#0A.....#0Avoid#0Aset_input_mode.(void)#0A{
#0A..struct.termios.tattr;#0A#0A..if.(!isatty(STDIN
_FILENO)).return;..#0A...#0A../*.Save.the.terminal.
attributes.so.we.can.restore.them.later#2E..*/#0A..
tcgetattr.(STDIN_FILENO,.&saved_attributes);#0A..at
exit.(reset_input_mode);#0A#0A../*.Set.the.funny.te
rminal.modes#2E..*/#0A..tcgetattr.(STDIN_FILENO,.&t
attr);#0A..tattr#2Ec_lflag.&#3D.~(ICANON|ECHO);./*.
Clear.ICANON.and.ECHO#2E...*/#0A..tattr#2Ec_cc[VMIN
].#3D.1;#0A..tattr#2Ec_cc[VTIME].#3D.0;#0A..tcsetat
tr.(STDIN_FILENO,.TCSAFLUSH,.&tattr);#0A}#0A.....#0A
int.Readch()#0A{.char.ch;#0A..if.(.read(STDIN_FILEN
O,.&ch,.1).)#0A....return.ch#3D#3D0x04.?.-1.:.ch;#0A
.#0A..return.-1;.//.endstreamch#0A}#0A#0Aint.init_k
eyb(void)#0A{.#0A..if.(.isatty(STDIN_FILENO).).{#0A
....set_input_mode();#0A....return.1;#0A..}#0A..ret
urn.0;#0A}#0A#0A#0Aint.close_keyb(void)#0A{.return.
0;#0A}#0A#0Aint.intflag(void)#0A{.return.0;#0A}#0A#23
endif#0A#0A#23ifdef.forMAC#0A#23include.<console#2E
h>#0A#0Aint.Readch(void)#0A{.int.ch.#3D.EOF;#0A..wh
ile.(ch#3D#3DEOF).ch.#3D.getchar();./*.horrible!!!!
.*/#0A..return.ch;#0A}#0A#0Aint.init_keyb(void)#0A{
.console_options#2Etitle.#3D."\pBCPL.Cintcode";#0A.
.console_options#2Epause_atexit.#3D.0;#0A..cshow(st
din);#0A..csetmode(C_RAW,.stdin);#0A..return.0;#0A}
#0A#0Aint.close_keyb()#0A{.return.0;#0A}#0A#0Aint.i
ntflag(void)#0A{.long.theKeys[4];#0A..GetKeys(theKe
ys);#0A..return.theKeys[1]#3D#3D0x8005;../*.Command
-Option-Shift.depressed..*/#0A}#0A#23endif#0A#0A#23
ifdef.forMSDOS#0Aextern.int.getch(void);#0A#0Aint.R
eadch()#0A{.return.getch();#0A}#0A#0Aint.init_keyb(
void)#0A{.return.0;#0A}#0A#0Aint.close_keyb(void)#0A
{.return.0;#0A}#0A#0Aint.intflag(void)#0A{.return.0
;#0A}#0A#23endif#0A#0A#23ifdef.forOS2#0A#23include.
<conio#2Eh>#0A#0Aint.Readch(void)#0A{.int.ch.#3D.ge
tch();#0A..return.ch;#0A}#0A#0Aint.init_keyb(void)#0A
{.return.0;#0A}#0A#0Aint.close_keyb(void)#0A{.retur
n.0;#0A}#0A#0Aint.intflag(void)#0A{.return.0;#0A}#0A
#23endif#0A#0A#0A

######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

######natbcpl/vax/mlib.mar#
;.Mlib.for.the.VAX.under.VMS.--.Under.development#0A
#0A;.Implemented.by.Martin.Richards.(c).7.September
.2009#0A#09#0A;.C.Linkage.on.the.Vax:#0A;...On.entr
y.0(SP)...is.the.return.address#0A;............4(SP
)...is.the.first.argument#0A;............8(SP)...is
.the.second.argument#0A;............etc#0A;#0A;...?
??.must.be.preserved#0A;#0A;...result.in.R0#0A#0A#0A
#09#2EALIGN.LONG#0A#0A........#2Eentry.callstart,^<
r2,r3,r4,r5,r6,r7,r8>#0A#0A.MOVL.4(SP),R11....;.M/C
.address.of.G#0A.MOVL.8(SP),R10....;.M/C.address.of
.P#0A#0A;.Register.usage.while.executing.BCPL.compi
led.code#0A#0A;.R11...The.G.pointer#0A;.R10...The.P
.pointer#0A;.R9....#3D.zero#0A;.R8....A..First.argu
ment.at.a.function.call#0A;.R7....B#0A;.R6....C#0A;
.R2....entry.address.at.call#0A;.R1....P.increment.
in.byte.at.function.call#0A#0A...clrl.r9#0A#0A...;.
make.sure.global.3.(sys).is.defined#0A...MOVAL.sys,
.4*3(R11)#0A...;.make.sure.global.6.(changeco).is.d
efined#0A...MOVL.changeco,.4*6(R11)#0A...;.make.sur
e.global.5.(muldiv).is.defined#0A...MOVL.muldiv,.4*
5(R11)#0A#0A...;.BCPL.call.of.clihook(stackupb)#0A.
..MOVL.stackupb,R8#0A...CLRL.R1#0A...MOVL.4*4(R11),
R2....;.clihook#0A...JSB..(R2)#0A...MOVL.R8,R0....;
.return.the.result.of.start#0A...#0A;.and.then.retu
rn#0A...RET#0A#0A...#09#2EALIGN.LONG#0A#0A...;.res.
#3D.sys(n,.x,.y,.z)..the.BCPL.callable.sys.function
#0Asys:#0A.PUSHL.R10........;.save.old.P#0A.PUSHL.R
2.........;.save.entry.point#0A.ADDL..R1,R10.....;.
Increment.P#0A.MOVL..R8,(R10)...;.P!0..:#3D.arg1#0A
#0A.PUSHL.R11#0A.PUSHL.R10#0A.CALLS..#232,dosys...;
.calling.dosys(p,.g)#0A.MOVL.R0,R8........;.put.res
ult.in.Cintcode.A.register#0A#0A.TSTL.(SP)+........
;.return.sequence#0A.MOVL.(SP)+,R10#0A.RSB#0A#0Acha
ngeco:#0A.MOVL.R10,0(R1)...;.NP!0.:#3D.P#0A.MOVL.R1
,R10......;.P....:#3D.NP#0A.popl.R1#0A.MOVL.R1,4(R1
0)...;.P!1..:#3D.return.address#0A.MOVL.R2,8(R10)..
.;.P!2..:#3D.entry.address#0A.MOVL.R8,12(R10)..;.P!
3..:#3D.arg1#0A#0A.MOVL.(R10),R1#0A.MOVL.4*7(R11),R
2#0A.MOVL.R1,(,R2,4)........;.!currco.:#3D.!p#0A.MO
VL.4(R10),R2..........;.pc.:#3D.p!1#0A.MOVL.16(R10)
,R1#0A.MOVL.R1,4*7(R11)........;.currco.:#3D.cptr#0A
.MOVL.0(,R1,4),R10.......;.p.:#3D.!cptr#0A.JMP.(R2)
#0A#0Amuldiv:#0A.PUSHL.R10#0A.PUSHL.R2#0A.ADDL..R1,
R10#0A#0A.MOVL.4(R10),R7#0A.MOVL.8(R10),R6#0A.EMUL.
R8,R7,#230,R4...;.R8.*.R7.#3D>.R4,.R5#0A.EDIV.R6,R4
,R8,.4*10(R11)...;.(R4,R5)/R6.#3D>.R8,.rem->result2
#0A#0A.TSTL.(SP)+........;.return.sequence#0A.MOVL.
(SP)+,R10#0A.RSB#0A#0A

######cintcode/com/sial-vax.b#
/*#0AThis.is.an.sial.to.vax.code.generator#0Aimplem
ented.by.Martin.Richards.(c).7.August.2009#0A#0AVax
.register.usage#0A#0AR11...G,.m/c.address.of.global
.0#0AR10...P,.m/c.address.of.the.current.function.s
tack.frame#0AR9....#3D0.(to.simplify.indirection.an
d.logical.right.shift)#0AR8....Sial.A.register#0AR7
....Sial.B.register#0AR6....Sial.C.register#0AR2...
.Function.entry.point.at.time.of.call#0AR1....P.poi
nter.increment#0A#0A#0AP.stack.frame#0A#0A#2E#2E#2E
...<args.and.locals>.#2E#2E#2E#0A........^#0A......
..|#0A........P.(#3DR10)#0A#0ASP.stack.frame#0A#0A.
.....<old.P>.<entry.address>.<return.address>..#2E#2E
#2E#0A.......^#0A.......|#0A.......SP#0A#0ABCPL.Cal
ling.sequence#0A#0A....KPG.k.n....#3D>......First.a
rgument,.if.any,.in.A.(R8)#0A......................
.MOVL..4*n(R11),R2......;.E..:#3D.G!n#0A...........
............MOVL..#234*k,R1..........;.R1.:#3D.4*k#0A
.......................JSR...(R2).............;.J.t
o.function#0A#0A#0A....ENTRY.n.Lm.C1.#2E#2E#2E.Cn.#3D
>#0A..............................................;
.first.arg,.if.any,.in.A.(#3DR8)#0A................
..............................;.sp!0.#3D.<return.ad
dress>#0A.......................PUSHL.R10..........
....;.push.<old.P>#0A.......................PUSHL.R
2...............;.push.<entry.point>#0A............
...........ADDL.R1,R10............;.P.:#3D.P.+.R1.(
#3Dk)#0A.......................MOVL.R8,(R10).......
...;.Store.first.arg,.if.any#0A....................
..........................;.Other.args.in.P!1,.P!2,
.#2E#2E#2E#0A#0A....RTN.....#3D>.........TSTL.(SP)+
.............;.pop.<entry.point>#0A................
.......MOVL.(SP)+,R10.........;.P.:#3D.<old.P>#0A..
.....................RSB....................;.PC.:#3D
.<return.address>#0A#0A#0A*/#0A#0ASECTION."sial-vax
"#0A#0AGET."libhdr"#0AGET."sial#2Eh"#0A#0AGLOBAL.{#0A
sialin:ug#0Aasmout#0Astdin#0Astdout#0Amodstarted#0A
#0Ardf;.rdp;.rdg;.rdk;.rdw;.rdl;.rdc#0Ardcode#0A#0A
pval;.gval;.kval;.wval;.lval;.mval#0A#0Ascan#0Acvf;
.cvfp;.cvfg;.cvfk;.cvfw;.cvfl#0A#0Asectname;.modlet
ter;.charv;.labnumber#0A}#0A#0ALET.start().#3D.VALO
F#0A{.LET.argv.#3D.VEC.20#0A..LET.v....#3D.VEC.20#0A
..LET.cv...#3D.VEC.256/bytesperword#0A#0A..sectname
.:#3D.v#0A..sectname%0.:#3D.0#0A..modstarted.:#3D.F
ALSE#0A#0A..modletter.:#3D.'A'#0A..charv.:#3D.cv#0A
..labnumber.:#3D.0#0A#0A..asmout.:#3D.0#0A..stdout.
:#3D.output()#0A..IF.rdargs("FROM,TO/K",.argv,.20)#3D
0.DO#0A..{.writes("Bad.args.for.sial-vax*n")#0A....
RESULTIS.20#0A..}#0A..IF.argv!0#3D0.DO.argv!0.:#3D.
"prog#2Esial"#0A..IF.argv!1#3D0.DO.argv!1.:#3D."pro
g#2Emar"#0A..sialin.:#3D.findinput(argv!0)#0A..IF.s
ialin#3D0.DO#0A..{.writef("Trouble.with.file.%s*n",
.argv!0)#0A....RESULTIS.20#0A..}#0A..asmout.:#3D.fi
ndoutput(argv!1)#0A...#0A..UNLESS.asmout.DO#0A..{.w
ritef("Trouble.with.file.%s*n",.argv!1)#0A.....RESU
LTIS.20#0A..}#0A...#0A..writef("Converting.%s.to.%s
*n",.argv!0,.argv!1)#0A..selectinput(sialin)#0A..se
lectoutput(asmout)#0A#0A..writef(";.Code.generated.
by.sial-vax*n*n")#0A#0A..scan()#0A..endread()#0A..U
NLESS.asmout#3Dstdout.DO.endwrite()#0A..selectoutpu
t(stdout)#0A..writef("Conversion.complete*n")#0A..R
ESULTIS.0#0A}#0A#0AAND.nextlab().#3D.VALOF#0A{.labn
umber.:#3D.labnumber+1#0A..RESULTIS.labnumber#0A}#0A
#0A//.argument.may.be.of.form.Ln#0AAND.rdcode(let).
#3D.VALOF#0A{.LET.a,.ch,.neg.#3D.0,.?,.FALSE#0A#0A.
.ch.:#3D.rdch().REPEATWHILE.ch#3D'*s'.|.ch#3D'*n'#0A
#0A..IF.ch#3Dendstreamch.RESULTIS.-1#0A#0A..UNLESS.
ch#3Dlet.DO.error("Bad.item,.looking.for.%c.found.%
c*n",.let,.ch)#0A#0A..ch.:#3D.rdch()#0A#0A..IF.ch#3D
'-'.DO.{.neg.:#3D.TRUE;.ch.:#3D.rdch().}#0A#0A..WHI
LE.'0'<#3Dch<#3D'9'.DO.{.a.:#3D.10*a.+.ch.-.'0';.ch
.:#3D.rdch()..}#0A#0A..RESULTIS.neg.->.-a,.a#0A}#0A
#0AAND.rdf().#3D.rdcode('F')#0AAND.rdp().#3D.VALOF.
{.pval.:#3D.rdcode('P');.RESULTIS.pval.}#0AAND.rdg(
).#3D.VALOF.{.gval.:#3D.rdcode('G');.RESULTIS.gval.
}#0AAND.rdk().#3D.VALOF.{.kval.:#3D.rdcode('K');.RE
SULTIS.kval.}#0AAND.rdw().#3D.VALOF.{.wval.:#3D.rdc
ode('W');.RESULTIS.wval.}#0AAND.rdl().#3D.VALOF.{.l
val.:#3D.rdcode('L');.RESULTIS.lval.}#0AAND.rdm().#3D
.VALOF.{.mval.:#3D.rdcode('M');.RESULTIS.mval.}#0AA
ND.rdc().#3D.rdcode('C')#0A#0AAND.error(mess,.a,.b,
.c).BE#0A{.LET.out.#3D.output()#0A..UNLESS.out#3Dst
dout.DO#0A..{.selectoutput(stdout)#0A....writef(mes
s,.a,.b,.c)#0A....selectoutput(out)#0A..}#0A..write
f(mess,.a,.b,.c)#0A}#0A#0AAND.scan().BE#0A{.LET.op.
#3D.rdf()#0A#0A..IF.op#3D-1.RETURN.//.EOF.reached#0A
#0A..UNLESS.modstarted.DO#0A..{.WHILE.op#3Df_sectio
n.|.op#3Df_modstart.TEST.op#3Df_section#0A....THEN.
{.cvfs("SECTION").//.Name.of.section#0A...........F
OR.i.#3D.0.TO.charv%0.DO.sectname%i.:#3D.charv%i#0A
...........op.:#3D.rdf()#0A.........}#0A....ELSE.{.
cvf("MODSTART").//.Start.of.module#0A...........op.
:#3D.rdf()#0A.........}#0A#0A....//.If.there.is.no.
section.name.this.module.is.called.MAIN#0A....IF.se
ctname%0#3D0.DO#0A....{.LET.s.#3D."MAIN"#0A......FO
R.i.#3D.0.TO.s%0.DO.sectname%i.:#3D.s%i#0A....}#0A#0A
....writef("*n.#2EPSECT.%s,LONG",.sectname)#0A....w
ritef("*n.#2ETITLE.%s.generated.by.sial-vax",.sectn
ame)#0A....writef("*n%s::",.sectname)#0A....writef(
"*n.#2EEXTRN.#2EFINISH")#0A....writef("*n.#2ELONG.1
000$")#0A....modstarted.:#3D.TRUE#0A..}#0A#0A..SWIT
CHON.op.INTO#0A#0A..{.DEFAULT:.......error(";.Bad.o
p.%n*n",.op);.LOOP#0A#0A....CASE.-1:.......RETURN#0A
......#0A....CASE.f_lp:.....cvfp("LP").//.a.:#3D.P!
n#0A...................writef("*n.MOVL.%n(R10),R8",
.4*pval)#0A...................ENDCASE#0A....CASE.f_
lg:.....cvfg("LG").//.a.:#3D.G!n#0A................
...writef("*n.MOVL.%n(R11),R8",.4*gval)#0A.........
..........ENDCASE#0A....CASE.f_ll:.....cvfl("LL")./
/.a.:#3D.!Ln#0A...................writef("*n.MOVL.%
n$,R8",.lval)#0A...................ENDCASE#0A#0A...
.CASE.f_llp:....cvfp("LLP").//.a.:#3D.@.P!n#0A.....
..............writef("*n.MOVAL.%n(R10),R8",.4*pval)
#0A...................writef("*n.DIVL2.#234,R8")#0A
...................ENDCASE#0A....CASE.f_llg:....cvf
g("LLG").//.a.:#3D.@.G!n#0A...................write
f("*n.MOVAL.%n(R11),R8",.4*gval)#0A................
...writef("*n.DIVL2.#234,R8")#0A...................
ENDCASE#0A....CASE.f_lll:....cvfl("LLL").//.a.:#3D.
@.!Ln#0A...................writef("*n.MOVAL.%n$,R8"
,.lval)#0A...................writef("*n.DIVL2.#234,
R8")#0A...................ENDCASE#0A....CASE.f_lf:.
....cvfl("LF").//.a.:#3D.byte.address.of.Ln#0A.....
..............writef("*n.MOVAL.%n$,R8",.lval)#0A...
................ENDCASE#0A....CASE.f_lw:.....cvfm("
LW")#0A...................writef("*n.MOVL.%n$,R8",.
mval+10000)#0A...................ENDCASE#0A#0A....C
ASE.f_l:......cvfk("L").//.a.:#3D.n#0A.............
......IF.kval#3D0.DO.{.writef("*n.CLRL.R8");.ENDCAS
E.}#0A...................writef("*n.MOVL.#23%n,R8",
.kval)#0A...................ENDCASE#0A....CASE.f_lm
:.....cvfk("LM").//.a.:#3D.-n#0A...................
writef("*n.MOVL.#23-%n,R8",.kval)#0A...............
....ENDCASE#0A#0A....CASE.f_sp:.....cvfp("SP").//.P
!n.:#3D.a#0A...................writef("*n.MOVL.R8,%
n(R10)",.4*pval)#0A...................ENDCASE#0A...
.CASE.f_sg:.....cvfg("SG").//.G!n.:#3D.a#0A........
...........writef("*n.MOVL.R8,%n(R11)",.4*gval)#0A.
..................ENDCASE#0A....CASE.f_sl:.....cvfl
("SL").//.!Ln.:#3D.a#0A...................writef("*
n.MOVL.R8,%n$",.lval)#0A...................ENDCASE#0A
#0A....CASE.f_ap:.....cvfp("AP").//.a.:#3D.a.+.P!n#0A
...................writef("*n.ADDL2.%n(R10),R8",.4*
pval)#0A...................ENDCASE#0A....CASE.f_ag:
.....cvfg("AG").//.a.:#3D.a.+.G!n#0A...............
....writef("*n.ADDL2.%n(R11),R8",.4*gval)#0A.......
............ENDCASE#0A....CASE.f_a:......cvfk("A").
//.a.:#3D.a.+.n#0A...................IF.kval#3D0.EN
DCASE#0A...................IF.kval#3D1..DO.{.writef
("*n.INCL.R8");.ENDCASE.}#0A...................IF.k
val#3D-1.DO.{.writef("*n.DECL.R8");.ENDCASE.}#0A...
................writef("*n.ADDL2.#23%n,R8",.kval)#0A
...................ENDCASE#0A....CASE.f_s:......cvf
k("S")..//.a.:#3D.a.-.k#0A...................IF.kva
l#3D0.ENDCASE#0A...................IF.kval#3D1..DO.
{.writef("*n.DECL.R8");.ENDCASE.}#0A...............
....IF.kval#3D-1.DO.{.writef("*n.INCL.R8");.ENDCASE
.}#0A...................writef("*n.SUBL2.#23%n,R8",
.kval)#0A...................ENDCASE#0A#0A....CASE.f
_lkp:....cvfkp("LKP").//.a.:#3D.P!n!k#0A...........
........writef("*n.MOVL.%n(R10),R1",.4*pval)#0A....
...............writef("*n.MOVL.%n(R9)[R1],R8",.4*kv
al)#0A...................ENDCASE#0A....CASE.f_lkg:.
...cvfkg("LKG").//.a.:#3D.G!n!k#0A.................
..writef("*n.MOVL.%n(R11),R1",.4*gval)#0A..........
.........writef("*n.MOVL.%n(R9)[R1],R8",.4*kval)#0A
...................ENDCASE#0A....CASE.f_rv:.....cvf
("RV")..//.a.:#3D.!.a#0A...................writef("
*n.MOVL.(R9)[R8],R8")#0A...................ENDCASE#0A
....CASE.f_rvp:....cvfp("RVP").//.a.:#3D.P!n!a#0A..
.................writef("*n.ADDL2.%n(R10),R8",.4*pv
al)#0A...................writef("*n.MOVL.(R9)[R8],R
8")#0A...................ENDCASE#0A....CASE.f_rvk:.
...cvfk("RVK").//.a.:#3D.a!k#0A...................w
ritef("*n.MOVL.%n(R9)[R8],R8",.4*kval)#0A..........
.........ENDCASE#0A....CASE.f_st:.....cvf("ST").//.
!a.:#3D.b#0A...................writef("*n.MOVL.R7,(
R9)[R8]")#0A...................ENDCASE#0A....CASE.f
_stp:....cvfp("STP").//.P!n!a.:#3D.b#0A............
.......writef("*n.MOVL.%n(R10),R1",.4*pval)#0A.....
..............writef("*n.ADDL2.R8,R1")#0A..........
.........writef("*n.MOVL.R7,(R9)[R1]")#0A..........
.........ENDCASE#0A....CASE.f_stk:....cvfk("STK")./
/.a!k.:#3D.b#0A...................writef("*n.MOVL.R
7,%n(R9)[R8]",.4*kval)#0A...................ENDCASE
#0A....CASE.f_stkp:...cvfkp("STKP")..//.P!n!k.:#3D.
a#0A...................writef("*n.MOVL.%n(R10),R1",
.4*pval)#0A...................writef("*n.MOVL.R8,%n
(R9)[R1]",.4*kval)#0A...................ENDCASE#0A.
...CASE.f_skg:....cvfkg("SKG").//.G!n!k.:#3D.a#0A..
.................writef("*n.MOVL.%n(R11),R1",.4*gva
l)#0A...................writef("*n.MOVL.R8,%n(R9)[R
1]",.4*kval)#0A...................ENDCASE#0A....CAS
E.f_xst:....cvf("XST").//.!b.:#3D.a#0A.............
......writef("*n.MOVL.R8,(R9)[R7]")#0A.............
......ENDCASE#0A#0A....CASE.f_k:......cvfp("K").//.
Call..a(b,#2E#2E#2E).incrementing.P.by.n#0A........
...........writef("*n.MOVL.R8,R2")...//.R1.#3D.<ent
ry.point>#0A...................writef("*n.MOVL.R7,R
8")...//.R8.#3D.<first.arg>,.if.any#0A.............
......writef("*n.MOVL.#23%n,R1",.4*pval).//.R1.#3D.
increment#0A...................writef("*n.JSR.(R2)"
).....//.Subroutine.jump#0A...................ENDCA
SE#0A....CASE.f_kpg:....cvfpg("KPG").//.Call.Gg(a,#2E
#2E#2E).incrementing.P.by.k#0A...................wr
itef("*n.MOVL.%n(R11),R2",.4*gval)#0A..............
.....writef("*n.MOVL.#23%n,R1",.4*pval)#0A.........
..........writef("*n.JSR.(R2)")#0A.................
..ENDCASE#0A#0A....CASE.f_neg:....cvf("NEG").//.a.:
#3D.-.a#0A...................writef("*n.MNEGL.R8,R8
").#0A...................ENDCASE#0A....CASE.f_not:.
...cvf("NOT").//.a.:#3D.~.a#0A...................wr
itef("*n.MCOML.R8,R8").#0A...................ENDCAS
E#0A....CASE.f_abs:....cvf("ABS").//.a.:#3D.ABS.a#0A
.................{.LET.lab.#3D.nextlab()#0A........
...........writef("*n.TSTL..R8")#0A................
...writef("*n.BGEL..%n$",.lab)#0A..................
.writef("*n.MNEGL.R8,R8")#0A...................writ
ef("*n%n$:",.lab)#0A...................ENDCASE#0A..
...............}#0A#0A....CASE.f_xdiv:...cvf("XDIV"
).//.a.:#3D.a./.b#0A...................writef("*n.D
IVL2.R7,R8")#0A...................ENDCASE#0A....CAS
E.f_xrem:...cvf("XREM").//.a.:#3D.a.REM.b#0A.......
............writef("*n.MOVL..R8,R3")#0A............
.......writef("*n.ASHQ..#23-32,R2")#0A.............
......writef("*n.EDIV..R7,R2,R8,R4")#0A............
.......writef("*n.MOVL..R4,R8")#0A.................
..ENDCASE#0A....CASE.f_xsub:...cvf("XSUB").//.a.:#3D
.a.-.b#0A...................writef("*n.SUBL2.R7,R8"
)#0A...................ENDCASE#0A#0A....CASE.f_mul:
....cvf("MUL").//.a.:#3D.b.*.a;.c.:#3D.?#0A........
...........writef("*n.MULL2.R7,R8")#0A.............
......ENDCASE#0A....CASE.f_div:....cvf("DIV")..//.a
.:#3D.b./.a;.c.:#3D.?#0A...................writef("
*n.DIVL3..R8,R7,R8")#0A...................ENDCASE#0A
....CASE.f_rem:....cvf("REM").//.a.:#3D.b.REM.a;.c.
:#3D.?#0A...................writef("*n.MOVL..R7,R3"
)#0A...................writef("*n.ASHQ..#23-32,R2")
#0A...................writef("*n.EDIV..R8,R2,R7,R4"
)#0A...................writef("*n.MOVL..R4,R8")#0A.
..................ENDCASE#0A....CASE.f_add:....cvf(
"ADD").//.a.:#3D.b.+.a#0A...................writef(
"*n.ADDL2.R7,R8")#0A...................ENDCASE#0A..
..CASE.f_sub:....cvf("SUB").//.a.:#3D.b.-.a#0A.....
..............writef("*n.SUBL3.R8,R7,R8")#0A.......
............ENDCASE#0A#0A....CASE.f_eq:.....cvf("EQ
").//.a.:#3D.b.#3D.a#0A.................{.LET.lab.#3D
.nextlab()#0A...................writef("*n.CLRL.R4"
)#0A...................writef("*n.CMPL.R7,R8")#0A..
.................writef("*n.BNEQ.%n$",.lab)#0A.....
..............writef("*n.DECL.R4")#0A..............
.....writef("*n%n$:",.lab)#0A...................wri
tef("*n.MOVL.R4,R8")#0A...................ENDCASE#0A
.................}#0A....CASE.f_ne:.....cvf("NE")./
/.a.:#3D.b.~#3D.a#0A.................{.LET.lab.#3D.
nextlab()#0A...................writef("*n.CLRL.R4")
#0A...................writef("*n.CMPL.R7,R8")#0A...
................writef("*n.BEQL.%n$",.lab)#0A......
.............writef("*n.DECL.R4")#0A...............
....writef("*n%n$:",.lab)#0A...................writ
ef("*n.MOVL.R4,R8")#0A...................ENDCASE#0A
.................}#0A....CASE.f_ls:.....cvf("LS")./
/.a.:#3D.b.<.a#0A.................{.LET.lab.#3D.nex
tlab()#0A...................writef("*n.CLRL.R4")#0A
...................writef("*n.CMPL.R7,R8")#0A......
.............writef("*n.BGEQ.%n$",.lab)#0A.........
..........writef("*n.DECL.R4")#0A..................
.writef("*n%n$:",.lab)#0A...................writef(
"*n.MOVL.R4,R8")#0A...................ENDCASE#0A...
..............}#0A....CASE.f_gr:.....cvf("GR").//.a
.:#3D.b.>.a#0A.................{.LET.lab.#3D.nextla
b()#0A...................writef("*n.CLRL.R4")#0A...
................writef("*n.CMPL.R7,R8")#0A.........
..........writef("*n.BLEQ.%n$",.lab)#0A............
.......writef("*n.DECL.R4")#0A...................wr
itef("*n%n$:",.lab)#0A...................writef("*n
.MOVL.R4,R8")#0A...................ENDCASE#0A......
...........}#0A....CASE.f_le:.....cvf("LE").//.a.:#3D
.b.<#3D.a#0A.................{.LET.lab.#3D.nextlab(
)#0A...................writef("*n.CLRL.R4")#0A.....
..............writef("*n.CMPL.R7,R8")#0A...........
........writef("*n.BGTR.%n$",.lab)#0A..............
.....writef("*n.DECL.R4")#0A...................writ
ef("*n%n$:",.lab)#0A...................writef("*n.M
OVL.R4,R8")#0A...................ENDCASE#0A........
.........}#0A....CASE.f_ge:.....cvf("GE").//.a.:#3D
.b.>#3D.a#0A.................{.LET.lab.#3D.nextlab(
)#0A...................writef("*n.CLRL.R4")#0A.....
..............writef("*n.CMPL.R7,R8")#0A...........
........writef("*n.BLSS.%n$",.lab)#0A..............
.....writef("*n.DECL.R4")#0A...................writ
ef("*n%n$:",.lab)#0A...................writef("*n.M
OVL.R4,R8")#0A...................ENDCASE#0A........
.........}#0A....CASE.f_eq0:....cvf("EQ0").//.a.:#3D
.a.#3D.0#0A.................{.LET.lab.#3D.nextlab()
#0A...................writef("*n.CLRL.R4")#0A......
.............writef("*n.TSTL.R8")#0A...............
....writef("*n.BNEQ.%n$",.lab)#0A..................
.writef("*n.DECL.R4")#0A...................writef("
*n%n$:",.lab)#0A...................writef("*n.MOVL.
R4,R8")#0A...................ENDCASE#0A............
.....}#0A....CASE.f_ne0:....cvf("NE0").//.a.:#3D.a.
~#3D.0#0A.................{.LET.lab.#3D.nextlab()#0A
...................writef("*n.CLRL.R4")#0A.........
..........writef("*n.TSTL.R8")#0A..................
.writef("*n.BEQL.%n$",.lab)#0A...................wr
itef("*n.DECL.R4")#0A...................writef("*n%
n$:",.lab)#0A...................writef("*n.MOVL.R4,
R8")#0A...................ENDCASE#0A...............
..}#0A....CASE.f_ls0:....cvf("LS0").//.a.:#3D.a.<.0
#0A...................writef("*n.ASHL.#23-32,R8")#0A
...................ENDCASE#0A....CASE.f_gr0:....cvf
("GR0").//.a.:#3D.a.>.0#0A...................writef
("*n.SUBL3.#231,R8,R4")#0A...................writef
("*n.ORL2.R8,R4")#0A...................writef("*n.A
SHL.#23-32,R4,R8")#0A...................writef("*n.
MCOML.R8,R8")#0A...................ENDCASE#0A....CA
SE.f_le0:....cvf("LE0").//.a.:#3D.a.<#3D.0#0A......
.............writef("*n.SUBL3.#231,R8,R4")#0A......
.............writef("*n.ORL2.R8,R4")#0A............
.......writef("*n.ASHL.#23-32,R4,R8")#0A...........
........ENDCASE#0A....CASE.f_ge0:....cvf("GE0").//.
a.:#3D.a.>#3D.0#0A...................writef("*n.ASH
L.#23-32,R8")#0A...................writef("*n.MCOML
.R8,R8")#0A...................ENDCASE#0A#0A....CASE
.f_lsh:....cvf("LSH").//.a.:#3D.b.<<.a;.b.:#3D.?#0A
...................writef("*n.ASHL.R8,R7,R8")#0A...
................ENDCASE#0A....CASE.f_rsh:....cvf("R
SH").//.a.:#3D.b.>>.a;.b.:#3D.?#0A.................
..writef("*n.MNEGL.R8,R4")#0A...................wri
tef("*n.MOVL.R7,R8")#0A...................writef("*
n.ASHQ.R4,R8,R8")#0A...................ENDCASE#0A..
..CASE.f_and:....cvf("AND").//.a.:#3D.b.&.a.#0A....
...............writef("*n.ANDL2.R7,R8").#0A........
...........ENDCASE#0A....CASE.f_or:.....cvf("OR")./
/.a.:#3D.b.|.a.#0A...................writef("*n.ORL
2.R7,R8").#0A...................ENDCASE#0A....CASE.
f_xor:....cvf("XOR").//.a.:#3D.b.NEQV.a#0A.........
..........writef("*n.XORL2.R7,R8").#0A.............
......ENDCASE#0A....CASE.f_eqv:....cvf("EQV").//.a.
:#3D.b.EQV.a.#0A...................writef("*n.XORL2
.R7,R8").#0A...................writef("*n.MNOTL.R8,
R8").#0A...................ENDCASE#0A#0A....CASE.f_
gbyt:...cvf("GBYT").//.a.:#3D.b.%.a#0A.............
......writef("*n.MULL3.#234,R7,R4").#0A............
.......writef("*n.MOVZBL.(R4)[R8],R8").#0A.........
..........ENDCASE#0A....CASE.f_xgbyt:..cvf("XGBYT")
.//.a.:#3D.a.%.b.#0A...................writef("*n.M
ULL3.#234,R8,R4").#0A...................writef("*n.
MOVZBL.(R4)[R7],R8").#0A...................ENDCASE#0A
....CASE.f_pbyt:...cvf("PBYT").//.b.%.a.:#3D.c#0A..
.................writef("*n.MULL3.#234,R7,R4").#0A.
..................writef("*n.MOVB.R6,(R4)[R8]").#0A
...................ENDCASE#0A....CASE.f_xpbyt:..cvf
("XPBYT").//.a.%.b.:#3D.c.#0A...................wri
tef("*n.MULL3.#234,R8,R4").#0A...................wr
itef("*n.MOVB.R6,(R4)[R7]").#0A...................E
NDCASE#0A#0A//.swb.......Kn.Ld.K1.L1.#2E#2E#2E.Kn.L
n...Binary.chop.switch,.Ld.default#0A....CASE.f_swb
:....cvswb()#0A...................ENDCASE#0A#0A//.s
wl.......Kn.Ld.L1.#2E#2E#2E.Ln.........Label.vector
.switch,.Ld.default#0A....CASE.f_swl:....cvswl()#0A
...................ENDCASE#0A#0A....CASE.f_xch:....
cvf("XCH").//.swap.a.and.b#0A...................wri
tef("*n.MOVL.R8,R4")#0A...................writef("*
n.MOVL.R7,R8")#0A...................writef("*n.MOVL
.R4,R8")#0A...................ENDCASE#0A....CASE.f_
atb:....cvf("ATB").//.b.:#3D.a#0A..................
.writef("*n.MOVL.R8,R7")#0A...................ENDCA
SE#0A....CASE.f_atc:....cvf("ATC").//.c.:#3D.a#0A..
.................writef("*n.MOVL.R8,R6")#0A........
...........ENDCASE#0A....CASE.f_bta:....cvf("BTA").
//.a.:#3D.b#0A...................writef("*n.MOVL.R7
,R8")#0A...................ENDCASE#0A....CASE.f_btc
:....cvf("BTC").//.c.:#3D.b#0A...................wr
itef("*n.MOVL.R7,R6")#0A...................ENDCASE#0A
....CASE.f_atblp:..cvfp("ATBLP").//.b.:#3D.a;.a.:#3D
.P!n#0A...................writef("*n.MOVL.R8,R7")#0A
...................writef("*n.MOVL.%n(R10),R8",.4*p
val)#0A...................ENDCASE#0A....CASE.f_atbl
g:..cvfg("ATBLG").//.b.:#3D.a;.a.:#3D.G!n#0A.......
............writef("*n.MOVL.R8,R7")#0A.............
......writef("*n.MOVL.%n(R11),R8",.4*gval)#0A......
.............ENDCASE#0A....CASE.f_atbl:...cvfk("ATB
L").//.b.:#3D.a;.a.:#3D.k#0A...................writ
ef("*n.MOVL.R8,R7")#0A...................writef("*n
.MOVL.#23%n,R8",.kval)#0A...................ENDCASE
#0A#0A....CASE.f_j:......cvfl("J").//.jump.to.Ln#0A
...................writef("*n.JMP.%n$",.lval)#0A...
................ENDCASE#0A....CASE.f_rtn:....cvf("R
TN").//.procedure.return#0A...................write
f("*n.TSTL.(SP)+")......//.Pop.entry.point#0A......
.............writef("*n.MOVL.(SP)+,R10")..//.P.:#3D
.old.P#0A...................writef("*n.RSB").......
......//.return#0A...................ENDCASE#0A....
CASE.f_goto:...cvf("GOTO").//.jump.to.a#0A.........
..........writef("*n.JMP.(R8)")#0A.................
..ENDCASE#0A#0A....CASE.f_ikp:....cvfkp("IKP").//.a
.:#3D.P!n.+.k;.P!n.:#3D.a#0A...................writ
ef("*n.MOVL.%n(R10),R8",.4*pval)#0A................
...TEST.kval#3D1#0A...................THEN.writef("
*n.INCL.R8")#0A...................ELSE.TEST.kval#3D
-1#0A........................THEN.writef("*n.DECL.R
8")#0A........................ELSE.writef("*n.ADDL2
.#23%n,R8",.kval)#0A...................writef("*n.M
OVL.R8,%n(R10)",.4*pval)#0A...................ENDCA
SE#0A....CASE.f_ikg:....cvfkg("IKG").//.a.:#3D.G!n.
+.k;.G!n.:#3D.a#0A...................writef("*n.MOV
L.%n(R11),R8",.4*gval)#0A...................TEST.kv
al#3D1#0A...................THEN.writef("*n.INCL.R8
")#0A...................ELSE.TEST.kval#3D-1#0A.....
...................THEN.writef("*n.DECL.R8")#0A....
....................ELSE.writef("*n.ADDL2.#23%n,R8"
,.kval)#0A...................writef("*n.MOVL.R8,%n(
R11)",.4*gval)#0A...................ENDCASE#0A....C
ASE.f_ikl:....cvfkl("IKL").//.a.:#3D.!Ln.+.k;.!Ln.:
#3D.a#0A...................writef("*n.MOVL.%n$,R8",
.lval)#0A...................TEST.kval#3D1#0A.......
............THEN.writef("*n.INCL.R8")#0A...........
........ELSE.TEST.kval#3D-1#0A.....................
...THEN.writef("*n.DECL.R8")#0A....................
....ELSE.writef("*n.ADDL2.#23%n,R8",.kval)#0A......
.............writef("*n.MOVL.R8,%n$",.lval)#0A.....
..............ENDCASE#0A....CASE.f_ip:.....cvfp("IP
").//.a.:#3D.P!n.+.a;.P!n.:#3D.a#0A................
...writef("*n.ADDL2.%n(R10),R8",.4*pval)#0A........
...........writef("*n.MOVL.R8,%n(R10)",.4*pval)#0A.
..................ENDCASE#0A....CASE.f_ig:.....cvfg
("IG").//.a.:#3D.G!n.+.a;.G!n.:#3D.a#0A............
.......writef("*n.ADDL2.%n(R11),R8",.4*gval)#0A....
...............writef("*n.MOVL.R8,%n(R11)",.4*gval)
#0A...................ENDCASE#0A....CASE.f_il:.....
cvfl("IL").//.a.:#3D.!Ln.+.a;.!Ln.:#3D.a#0A........
...........writef("*n.ADDL2.%n$,R8",.lval)#0A......
.............writef("*n.MOVL.R8,%n$",.lval)#0A.....
..............ENDCASE#0A#0A....CASE.f_jeq:....cvfl(
"JEQ").//.Jump.to.Ln.if.b.#3D.a#0A.................
..writef("*n.CMPL.R8,R7")#0A...................writ
ef("*n.BEQL.%n$",.lval)#0A...................ENDCAS
E#0A....CASE.f_jne:....cvfl("JNE").//.Jump.to.Ln.if
.b.~#3D.a#0A...................writef("*n.CMPL.R8,R
7")#0A...................writef("*n.BNEQ.%n$",.lval
)#0A...................ENDCASE#0A....CASE.f_jls:...
.cvfl("JLS").//.Jump.to.Ln.if.b.<.a#0A.............
......writef("*n.CMPL.R8,R7")#0A...................
writef("*n.BLSS.%n$",.lval)#0A...................EN
DCASE#0A....CASE.f_jgr:....cvfl("JGR").//.Jump.to.L
n.if.b.>.a#0A...................writef("*n.CMPL.R8,
R7")#0A...................writef("*n.BGTR.%n$",.lva
l)#0A...................ENDCASE#0A....CASE.f_jle:..
..cvfl("JLE").//.Jump.to.Ln.if.b.<#3D.a#0A.........
..........writef("*n.CMPL.R8,R7")#0A...............
....writef("*n.BLEQ.%n$",.lval)#0A.................
..ENDCASE#0A....CASE.f_jge:....cvfl("JGE").//.Jump.
to.Ln.if.b.>#3D.a#0A...................writef("*n.C
MPL.R8,R7")#0A...................writef("*n.BGEQ.%n
$",.lval)#0A...................ENDCASE#0A#0A....CAS
E.f_jeq0:...cvfl("JEQ0").//.Jump.to.Ln.if.a.#3D.0#0A
...................writef("*n.TSTL.R8")#0A.........
..........writef("*n.BEQL.%n$",.lval)#0A...........
........ENDCASE#0A....CASE.f_jne0:...cvfl("JNE0")./
/.Jump.to.Ln.if.a.~#3D.0#0A...................write
f("*n.TSTL.R8")#0A...................writef("*n.BNE
Q.%n$",.lval)#0A...................ENDCASE#0A....CA
SE.f_jls0:...cvfl("JLS0").//.Jump.to.Ln.if.a.<.0#0A
...................writef("*n.TST.R8")#0A..........
.........writef("*n.BLSS.%n$",.lval)#0A............
.......ENDCASE#0A....CASE.f_jgr0:...cvfl("JGR0").//
.Jump.to.Ln.if.a.>.0#0A...................writef("*
n.TSTL.R8")#0A...................writef("*n.BGRT.%n
$",.lval)#0A...................ENDCASE#0A....CASE.f
_jle0:...cvfl("JLE0").//.Jump.to.Ln.if.a.<#3D.0#0A.
..................writef("*n.TSTL.R8")#0A..........
.........writef("*n.BLEQ.%n$",.lval)#0A............
.......ENDCASE#0A....CASE.f_jge0:...cvfl("JGE0").//
.Jump.to.Ln.if.a.>#3D.0#0A...................writef
("*n.TSTL.R8")#0A...................writef("*n.BGEQ
.%n$",.lval)#0A...................ENDCASE#0A....CAS
E.f_jge0m:..cvfm("JGE0M").//.Jump.to.Mn.if.a.>#3D.0
#0A...................writef("*n.TSTL.R8")#0A......
.............writef("*n.BGRT.%n$",.mval+10000)#0A..
.................ENDCASE#0A#0A....//.The.following.
five.opcodes.are.never.generated.by#0A....//.the.BC
PL.compiler#0A....CASE.f_brk:....cvf("BRK").//.Brea
kpoint.instruction#0A...................writef("*n.
unimplemented")#0A...................ENDCASE#0A....
CASE.f_nop:....cvf("NOP").//.No.operation#0A.......
............ENDCASE#0A....CASE.f_chgco:..cvf("CHGCO
").//.Change.coroutine#0A...................writef(
"*n.unimplemented")#0A...................ENDCASE#0A
....CASE.f_mdiv:...cvf("MDIV").//.a.:#3D.Muldiv(P!3
,.P!4,.P!5).#0A...................writef("*n.unimpl
emented")#0A...................ENDCASE#0A....CASE.f
_sys:....cvf("SYS").//.System.function#0A..........
.........writef("*n.unimplemented")#0A.............
......ENDCASE#0A#0A....CASE.f_modend:...cvf("MODEND
").//.End.of.module#0A.....................writef("
*n1000$:").#0A.....................writef("*n.#2EEN
D*n").#0A.....................modletter.:#3D.modlet
ter+1#0A.....................modstarted.:#3D.FALSE#0A
.....................ENDCASE#0A....CASE.f_global:..
.cvglobal().//.Global.initialisation.data#0A.......
..............ENDCASE#0A....CASE.f_string:...cvstri
ng().//.String.constant#0A.....................ENDC
ASE#0A....CASE.f_const:....cvconst().//.Large.integ
er.constant#0A.....................ENDCASE#0A#0A...
.CASE.f_static:...cvstatic().//.Static.variable.or.
table#0A.....................ENDCASE#0A....CASE.f_m
lab:.....cvfm("MLAB").//.Destination.of.jge0m#0A...
..................writef("*n%n$:",.mval+10000)#0A..
...................ENDCASE#0A....CASE.f_lab:......c
vfl("LAB").//.Program.label#0A.....................
writef("*n%n$:",.lval)#0A.....................ENDCA
SE#0A....CASE.f_lstr:.....cvfm("LSTR").//.a.:#3D.Mn
...(pointer.to.string)#0A.....................write
f("*n.MOVAL.%n$,R8",.mval+10000)#0A................
.....writef("*n.DIVL2.S^4,R8")#0A..................
...ENDCASE#0A....CASE.f_entry:....cventry().//.Star
t.of.a.function#0A.....................ENDCASE#0A..
}#0A#0A..newline()#0A}.REPEAT#0A#0AAND.cvf(s)...BE.
writef(";.%s",.s)#0AAND.cvfp(s)..BE.writef(";.%t7.P
%n",.s,.rdp())#0AAND.cvfkp(s).BE.writef(";.%t7.K%n.
P%n",.s,.rdk(),.rdp())#0AAND.cvfg(s)..BE.writef(";.
%t7.G%n",.s,.rdg())#0AAND.cvfkg(s).BE.writef(";.%t7
.K%n.G%n",.s,.rdk(),.rdg())#0AAND.cvfkl(s).BE.write
f(";.%t7.K%n.L%n",.s,.rdk(),.rdl())#0AAND.cvfpg(s).
BE.writef(";.%t7.P%n.G%n",.s,.rdp(),.rdg())#0AAND.c
vfk(s)..BE.writef(";.%t7.K%n",.s,.rdk())#0AAND.cvfw
(s)..BE.writef(";.%t7.W%n",.s,.rdw())#0AAND.cvfl(s)
..BE.writef(";.%t7.L%n",.s,.rdl())#0AAND.cvfm(s)..B
E.writef(";.%t7.M%n",.s,.rdm())#0A#0AAND.cvswl().BE
#0A{.LET.n.#3D.rdk()#0A..LET.l.#3D.rdl()#0A..LET.la
b.#3D.nextlab()#0A..writef(";.SWL.K%n.L%n",.n,.l)#0A
..writef("*n.TSTL.R8")#0A..writef("*n.BLSS.%n$",.l)
#0A..writef("*n.CMPL.#23%n,R8",.n)#0A..writef("*n.B
GRT.%n$",.l)#0A..writef("*n.JMP.@L%n(R9)[R8]",.lab)
#0A..writef("*n.#2EALIGN.LONG")#0A..writef("*n%n$:"
,.lab)#0A..FOR.i.#3D.1.TO.n.DO#0A..{.writef("*n;.%n
$",.rdl())#0A....writef("*n.#2ELONG.%n$",.lval)#0A.
.}#0A}#0A#0AAND.cvswb().BE#0A{.LET.n.#3D.rdk()#0A..
LET.l.#3D.rdl()#0A..writef(";.SWB.K%n.L%n",.n,.l)..
//.A.naive.implementation.of.swb#0A..FOR.i.#3D.1.TO
.n.DO.#0A..{.LET.k.#3D.rdk()#0A....LET.l.#3D.rdl()#0A
....writef("*n;.K%n.L%n",.k,.l)#0A....writef("*n.CM
PL.#23%n,R8",.k)#0A....writef("*n.BGEQ.%n$",.l)#0A.
.}#0A..writef("*n.JMP.%n$",.l)#0A}#0A#0AAND.cvgloba
l().BE#0A{.LET.n.#3D.rdk()#0A..writef(";.GLOBAL.K%n
*n",.n)#0A..IF.sectname%0#3D0.FOR.i.#3D.0.TO.4.DO.s
ectname%i.:#3D."prog"%i#0A..writef("*n#2Eglobl.%s*n
",.sectname)#0A..writef("%s::*n",.sectname)#0A..FOR
.i.#3D.1.TO.n.DO#0A..{.LET.g.#3D.rdg()#0A....LET.n.
#3D.rdl()#0A....writef(";.G%n.L%n*n",.g,.n)#0A....w
ritef(".MOVL.%n$,%n(R8)*n",.n,.4*g)#0A..}#0A..write
f(";.G%n",.rdg())#0A..writef("*n.RSB*n")#0A}#0A#0AA
ND.cvglobal1().BE#0A{.LET.n.#3D.rdk()#0A..writef("*
n;.GLOBAL.K%n",.n)#0A..IF.sectname%0#3D0.FOR.i.#3D.
0.TO.4.DO.sectname%i.:#3D."prog"%i#0A..writef("*n#2E
ALIGN.LONG")#0A..writef("*n#2ELONG.-1")#0A..FOR.i.#3D
.1.TO.n.DO#0A..{.LET.g.#3D.rdg()#0A....LET.n.#3D.rd
l()#0A....writef("*n;.G%n.L%n*n",.g,.n)#0A....write
f("*n.#2ELONG.%i4,.%n$",.g,.n)#0A..}#0A..writef("*n
;.G%n",.rdg())#0A..writef("*n.#2ELONG.%i4",.gval)#0A
}#0A#0AAND.rdchars().#3D.VALOF#0A{.LET.n.#3D.rdk()#0A
..charv%0.:#3D.n#0A..FOR.i.#3D.1.TO.n.DO.charv%i.:#3D
.rdc()#0A..RESULTIS.n#0A}#0A#0AAND.cvstring().BE#0A
{.LET.lab.#3D.rdm()#0A..LET.n.#3D.rdchars()#0A..wri
tef(";.STRING..M%n.K%n",.lab,.n)#0A..FOR.i.#3D.1.TO
.n.DO.writef(".C%n",.charv%i)#0A..writef("*n.#2EALI
GN.LONG")#0A..writef("*n%n$:",.lab+10000)#0A..FOR.i
.#3D.0.TO.n.DO.writef("*n.#2EBYTE.%n",.charv%i)#0A}
#0A#0AAND.cvconst().BE#0A{.LET.lab.#3D.rdm()#0A..LE
T.w.#3D.rdw()#0A..writef(";.CONST...M%n.W%n",.lab,.
w)#0A..writef("*n.#2EALIGN.LONG")#0A..writef("*n%n$
:",.lab+10000)#0A..writef("*n.#2ELONG.%n",.w)#0A}#0A
#0AAND.cvstatic().BE#0A{.LET.lab.#3D.rdl()#0A..LET.
n.#3D.rdk()#0A..writef(";.STATIC..L%n.K%n",.lab,.n)
#0A..writef("*n.#2EALIGN.LONG")#0A..writef("*n%n$:"
,.lab)#0A..FOR.i.#3D.1.TO.n.DO.{.writef("*n;.W%n",.
rdw())#0A......................writef("*n.#2ELONG.%
n",.wval)#0A....................}#0A}#0A#0AAND.cvfs
(s).BE#0A{.LET.n.#3D.rdchars()#0A..writef(";.%t7.K%
n",.s,.n)#0A..FOR.i.#3D.1.TO.n.DO.writef(".C%n",.ch
arv%i)#0A}#0A#0AAND.cventry().BE#0A{.LET.n.#3D.rdch
ars()#0A..LET.op.#3D.rdf()#0A..LET.lab.#3D.rdl()#0A
..writef("*n*n;.Entry.to:.%s*n",.charv)#0A..writef(
";.%t7.K%n",."ENTRY",.n)#0A..FOR.i.#3D.1.TO.n.DO.wr
itef(".C%n",.charv%i)#0A..newline()#0A..TEST.op#3Df
_lab.THEN.writef(";.LAB.....L%n*n",.lab)#0A........
........ELSE.writef(";.Bad.op.F%n.L%n*n",.op,.lab)#0A
..FOR.i.#3D.n+1.TO.11.DO.charv%i.:#3D.'.'#0A..IF.n>
11.DO.charv!0.:#3D.11#0A..writef("*n.#2ELONG.^X%x8"
,charv!0)#0A..writef("*n.#2ELONG.^X%x8",charv!1)#0A
..writef("*n.#2ELONG.^X%x8",charv!2)#0A#0A..writef(
"*n%n$:",.lab)#0A..writef("*n.PUSHL.R10")........//
.Save.old.Pointer#0A..writef("*n.PUSHL.R2")........
.//.Save.entry.point#0A..writef("*n.ADDL.R1,R10")..
....//.P.:#3D.P.+.increment#0A..writef("*n.MOVL.R8,
(R10)")....//.Save.first.argument#0A}#0A

######cintcode/com/bcplfe.b#
//.This.is.the.BCPL.syntax.analyser#0A#0A//.Impleme
nted.by.Martin.Richards.(c).May.2009#0A#0A#0A/*.Cha
nge.history#0A#0A10/07/09#0AStopped.'#2E'.terminati
ng.GET.streams.so.that.GET.streams.can.contain#0Ase
veral.sections.separated.by.dots#2E.BEWARE:.this.is
.an.incompatible#0Achange,.since.the.first.section.
of.a.GET.stream.has.in.the.past.been#0Aused.as.a.he
ader#2E#0ARe-organised.the.compiler.into.g/bcplfecg
#2Eh,.bcplfe#2Eb.and.bcplcgcin#2Eb,#0Aand.reallocat
ing.most.of.the.compiler.globals#2E#0A#0A08/05/09#0A
Increased.the.default.treesize.to.200000#2E#0A#0A03
/07/07#0AModified.the.treatment.of.*#23.escapes.in.
string.and.character.constants#0Ato.allow.both.UTF8
.and.GB2312.encoding#2E.Added.compiler.options.UTF8
#0Aand.GB2312.to.set.the.default.encoding#2E.*#23U.
and.*#23G.in.a.string.and#0Acharacter.constant.temp
orarily.set.the.encoding.to.UTF8.and.GB2312,#0Aresp
ectively,.overriding.the.default.setting#2E.In.GB23
12.mode,.*#23dddd#0Acontains.up.to.4.decimal.digits
#2E.See.the.BCPL.manual#2E#0A#0A27/06/07#0AAdded.th
e.Unicode.escape.sequences.*#23hhhh.and.*#23#23hhhh
hhhh.to.string#0Aand.character.constants#2E.Within.
string.they.are.converted.to.the#0Acorresponding.UT
F8.sequence.of.bytes.and.within.a.character.constan
t#0Athey.yield.the.corresponding.Unicode.integer#2E
.See.the.last.few.tests#0Ain.com/cmpltest#2Eb#0A#0A
27/07/06#0AChanged.the.implementation.of.the.GET.di
rective.to.make.it.system#0Aindependent#2E.Performg
et.now.obtains.the.headers.environment.variable#0Af
rom.the.root.node.(rootnode!rtn_hdrsvar).this.is.no
rmally.either#0A"BCPLHDRS".or."POSHDRS"#2E.If.the.h
eader.file.does.not.end.in.#2Eh.or.#2Eb,#0A#2Eh.is.
appended#2E.The.search.order.is.as.follows:#0A#0A(1
).The.current.directory#2E#0A(2).The.directories.sp
ecified.by.the.headers.environment.variable,#0A....
if.set#2E#0A(3).The.subdirectory.g/.of.the.root.spe
cified.by.the.environment#0A....variable.rootnode!r
tn_rootvar,.if.set#2E#0A#0A05/04/06#0AMended.a.bug.
in.trans.concerning.the.tranlation.of.SKIP#2E#0A#0A
18/01/06#0ABased.on.Dave.Lewis's.suggestion,#0Ain.o
utputsection(),.add:#0A...IF.objline1%0.DO.writef("
%s*n",.objline1)#0Awhere.objline1.is.the.first.line
.of.file.objline1.if.it.can.be.found#0Ain.the.curre
nt.directory.or.in.the.HDRS.directory#2E.This.will.
typically#0Aput.a.line.such.as:#0A#23!/usr/local/bi
n/cintsys.-c#0Aas.the.first.line.of.the.compiled.ob
ject.module#2E.This.line.is.ignored#0Aby.the.CLI.bu
t.may.be.useful.under.Linux#2E.If.objline1.cannot.b
e.found#0Ano.such.line.is.inserted.at.the.start.of.
the.object.module#2E#0A#0A30/8/05#0ADefined.the.fun
ction.default_hdrs().near.the.start.to.allow.easy.c
hange#0Afrom.cintsys.to.cintpos.versions.of.the.com
piler#2E#0A.#0A22/6/05#0AAdded.the.empty.command.SK
IP.and.let.empty.blocks.be.equivalent.to#0ASKIP#2E.
Empty.section.brackets.are.now.also.allowed.after.M
ANIFEST,#0ASTATIC.and.GLOBAL#2E..These.changes.make
.program.development.marginally#0Aeasier#2E#0A#0A17
/6/04#0AMade.GET.first.look.in.the.current.director
y#2E#0AAdded.argument.HDRS.to.allow.the.environment
.variable.specifying#0Athe.headers.directory.to.be.
changed#2E.The.default.is.BCPLHDRS#2E#0A#0A23/4/04#0A
Update.the.standard.BCPL.compiler.with.all.the.Cint
pos.extensions#0Aincluding.cross.referencing.and.11
.character.names#2E#0AMake.GET.directives.use.the.B
CPLHDRS.environment.variable#2E#0A#0A11/6/02#0AChan
ged.square.brackets.to.mean.subscription.with.same.
precedence#0Aand.function.calls#2E#0A#0A18/3/02#0AU
se.HDRPATH.and.BCPLPATH.in.GET.directives#2E#0A#0A1
4/1/02#0AAdded.XREF.option.to.output.name.informati
on.during.compilation#2E#0A#0A11/7/01#0AAdded.langu
age.extensions.for.the.Ford.dialect.of.BCPL#2E#0Ai#2E
e#2E.modified.performget#0A.....added.SLCT.and.OF.(
also.::)#0A.....added.||.comments#0A.....treesize.s
et.to.100000#0A#0A15/1/01#0AComplain.if.global.numb
er.is.larger.than.65535#2E#0A#0A10/8/00#0AChange.th
e.maximum.number.of.error.messages.from.30.to.10#2E
#0A#0A14/12/99#0AMade./.*.#2E#2E#2E.*./..comments.n
est#2E#0AAllow.the.constants.in.MANIFEST,.STATIC.an
d.GLOBAL.declarations.#0Ato.be.optional#2E.If.absen
t.the.value.is.one.greater.than.the#0Aprevious.valu
e#2E.Unless.specified.the.first.value.is.zero,.so#0A
MANIFEST.{.a;.b#3D10;.c.}.declares.a,.b.and.c.to.be
.0,.10.and.11,#0Arespectively#2E#0A#0A9/6/99#0AMade
.changes.to.buffer.OCODE.in.memory#2E.When.bcpl.is.
called#0Awithout.the.TO.argument.it.writes.numeric.
ocode.to.the.file.ocode#2E#0ALex.treats.CR.(13).cor
rectly.to.improve.convenience.when.running#0Aunder.
Windows.and.WindowsCE#2E#0A#0A26/2/99#0AAdded.BIN.o
ption.to.the.compiler.to.generate.a.binary.(rather.
than#0Ahex).hunk.format.for.the.compiled.code#2E.Th
is.is.primarily.for.the#0AWindows.CE.version.of.the
.cintcode.system.where.compactness.is#0Aparticularl
y.important#2E.There.is.a.related.change.to.loadseg
.in#0Acintmain#2Ec#0A#0A17/11/98#0AChanged.the.work
spacesize.to.40000.and.added.the.SIZE.keyword#0Ato.
allow.the.user.to.specify.this.size#2E#0A#0A9/11/98
#0AMade.GET.directives.search.the.current.working.d
irectory#0Athen.directories.given.by.the.shell.vari
able.BCPLPATH,.if.set#2E#0AIt.uses.the.BLIB.functio
n.pathfindinput#2E#0A#0A15/12/96#0ACorrect.a.bug.in
.cellwithname#0A#0A16/8/96#0AAdded.one.line.to.read
number.to.allow.underscores.in.numbers.after.#0Athe
.first.digit#2E#0A#0A7/6/96#0AImplement.the.method.
application.operator.for.object.oriented#0Aprogramm
ing.in.BCPL#2E.E.#23.(E1,.E2,#2E#2E#2E,.En).is.equi
valent.to#0A((!E1)!E)(E1,.E2,#2E#2E#2E,.En)#0A#0A24
/12/95#0AImproved.the.efficiency.of.cellwithname.in
.TRN.(using.the.hash.chain#0Alink.in.name.node)#2E#0A
Improved.the.efficiency.of.outputsection.in.CG.by.i
ntroducing#0Awrhex2.and.wrword_at#2E#0A#0A24/7/95#0A
Removed.bug.in.atbinfo,.define.addinfo_b.change.som
e.global.numbers#2E#0AImplement.constant.folding.in
.TRN#2E#0A#0A13/7/95#0AAllowed.{.and.}.to.represent
.untagged.section.brackets#2E#0A#0A22/6/93#0ARevers
e.order.in.SWB.and.have.a.minimum.of.7.cases#0Ato.a
llow.faster.interpreter#2E#0A#0A2/6/93#0AChanged.co
de.for.SWB.to.use.heap-like.binary.tree#2E#0A#0A19/
5/93#0APut.in.code.to.compile.BTC.and.XPBYT.instruc
tions#2E#0A#0A23/4/93#0AAllowed.the.codegenerator.t
o.compiler.the.S.instruction#2E#0A#0A21/12/92#0ACur
ed.bug.in.compilation.of.(b.->.f,.g)(1,2,3)#0A#0A24
/11/92.#0ACured.bug.in.compilation.of.a,.b.:#3D.s%0
.>.0,.s%1.#3D.'!'#0A#0A23/7/92:#0ARenamed.nextlab.a
s.newlab,.load.as.loadval.in.the.CG#2E#0APut.back.s
impler.hashing.function.in.lookupword#2E#0ARemoved.
rdargs.fudge#2E#0ARemoved.S2.compiler.option#2E#0AC
ured.bug.concerning.the.closing.of.gostream.when.eq
ual.to.stdout#2E#0A*/#0A#0ASECTION."BCPL"#0A#0AGET.
"libhdr"#0AGET."bcplfecg"#0A.#0ALET.default_hdrs().
#3D.VALOF.//.Changed.MR.12/07/09#0A{.LET.hdrs.#3D.r
ootnode!rtn_hdrsvar.//.Typically."BCPLHDRS".or."POS
HDRS".or.0#0A..IF.hdrs.RESULTIS.hdrs#0A..RESULTIS."
BCPLHDRS"#0A}#0A.#0AGLOBAL.{#0A//.Globals.used.in.L
EX#0Achbuf:feg#0Adecval;.getstreams;.charv#0Ahdrs..
//.MR.10/7/04#0A#0Aworkvec#0Areadnumber;.rdstrch#0A
token;.wordnode;.ch#0Ardtag;.performget#0Alex;.dsw;
.declsyswords;.nlpending#0Alookupword;.rch#0Asource
namev;.sourcefileno;.sourcefileupb#0Askiptag;.wrchb
uf;.chcount;.lineno#0Anulltag;.rec_p;.rec_l#0A.#0A/
/.Globals.used.in.SYN#0Ardblockbody;..rdsect#0Arnam
elist;.rname#0Ardef;.rcom#0Ardcdefs#0Aformtree;.syn
err;.opname#0Arexplist;.rdseq#0Amk1;.mk2;.mk3#0Amk4
;.mk5;.mk6;.mk7#0Anewvec#0Arnexp;.rexp;.rbexp#0A}#0A
.#0A.#0AMANIFEST.{#0Ac_backspace.#3D..8#0Ac_tab....
...#3D..9#0Ac_newline...#3D.10#0Ac_newpage...#3D.12
#0Ac_return....#3D.13#0Ac_escape....#3D.27#0Ac_spac
e.....#3D.32#0A}#0A#0ALET.start().#3D.VALOF#0A{.LET
.treesize.#3D.0#0A..AND.argv.#3D.VEC.50#0A..AND.arg
form.#3D."FROM/A,TO/K,VER/K,SIZE/K/N,TREE/S,NONAMES
/S,*#0A................*D1/S,D2/S,OENDER/S,EQCASES/
S,BIN/S,XREF/S,GDEFS/S,HDRS/K,*#0A................*
GB2312/S,UTF8/S,SAVESIZE/K/N"#0A..LET.stdout.#3D.ou
tput()#0A..LET.objline1vec.#3D.VEC.256/bytesperword
#0A..objline1.:#3D.objline1vec#0A..objline1%0.:#3D.
0#0A..errmax...:#3D.10#0A..errcount.:#3D.0#0A..fin_
p,.fin_l.:#3D.level(),.fin#0A#0A..treevec......:#3D
.0#0A..obuf.........:#3D.0#0A..sourcestream.:#3D.0#0A
..ocodeout.....:#3D.0#0A..gostream.....:#3D.0#0A..g
etstreams...:#3D.0#0A#0A..sysprint.:#3D.stdout#0A..
selectoutput(sysprint)#0A.#0A..writef("*nBCPL.(7.Se
pt.2009)*n")#0A#0A..//.Allocate.vector.for.source.f
ile.names#0A..sourcefileupb.:#3D.1000#0A..sourcenam
ev.:#3D.getvec(sourcefileupb)#0A..UNLESS.sourcename
v.DO#0A..{.writef("Insufficient.space.available*n")
#0A....errcount.:#3D.1#0A....GOTO.fin#0A..}#0A..sou
rcefileno.:#3D.0#0A..FOR.i.#3D.0.TO.sourcefileupb.D
O.sourcenamev!0.:#3D.0...#0A.#0A..IF.rdargs(argform
,.argv,.50)#3D0.DO.{.writes("Bad.arguments*n")#0A..
....................................errcount.:#3D.1
#0A......................................GOTO.fin#0A
....................................}#0A..treesize.
:#3D.200_000#0A..IF.argv!3.DO.treesize.:#3D.!argv!3
#0A..IF.treesize<10_000.DO.treesize.:#3D.10_000#0A.
.obufsize.:#3D.treesize/4#0A#0A..prtree........:#3D
.argv!4#0A..savespacesize.:#3D.3#0A#0A..//.Code.gen
erator.options.#0A#0A..naming.:#3D.TRUE#0A..debug.:
#3D.0#0A..bigender.:#3D.(!"AAA".&.255).#3D.'A'.//.#3D
TRUE.if.running.on.a.bigender#0A..IF.argv!5.DO.nami
ng...:#3D.FALSE..........//.NONAMES#0A..IF.argv!6.D
O.debug....:#3D.debug+1........//.D1#0A..IF.argv!7.
DO.debug....:#3D.debug+2........//.D2#0A..IF.argv!8
.DO.bigender.:#3D.~bigender......//.OENDER#0A..eqca
ses..:#3D.argv!9......................//.EQCASES#0A
..bining...:#3D.argv!10.....................//.BIN.
(binary.hunk)#0A..xrefing..:#3D.argv!11............
.........//.XREF#0A..gdefsing.:#3D.argv!12.........
............//.GDEFS#0A..hdrs.....:#3D.argv!13.....
................//.HDRS#0A..defaultencoding.:#3D.UT
F8#0A..IF.argv!14.DO.defaultencoding.:#3D.GB2312.//
.GB2312#0A..IF.argv!15.DO.defaultencoding.:#3D.UTF8
...//.UTF8#0A..encoding.:#3D.defaultencoding#0A..IF
.argv!16.DO.savespacesize.:#3D.!(argv!16).//.SAVESI
ZE#0A#0A..UNLESS.hdrs.DO#0A....hdrs.:#3D.default_hd
rs()................//.Use.the.default.HDRS#0A.....
.....................................//.(typically.
BCPLHDRS.or.POSHDRS)#0A#0A..{.//.Feature.added.by.M
R.17/01/06#0A....//.If.file.objline1.can.be.found,.
its.first.line.will.be.written#0A....//.at.the.star
t.of.the.compiled.Cintcode.file#2E.It.first.looks.i
n.the#0A....//.current.directory.then.the.HDRS.dire
ctory.and.finally.it.tries#0A....//.g/objline1.in.t
he.system.root.directory#2E#0A....LET.line1stream.#3D
.findinput("objline1")#0A....LET.len.#3D.0#0A....UN
LESS.line1stream.DO#0A......line1stream.:#3D.pathfi
ndinput("objline1",.hdrs)#0A....UNLESS.line1stream.
IF.rootnode!rtn_rootvar.DO#0A......line1stream.:#3D
.pathfindinput("g/objline1",.rootnode!rtn_rootvar)#0A
....#0A....IF.line1stream.DO#0A....{.//.Copy.first.
line.of.objline1.into.string.objline1#0A......selec
tinput(line1stream)#0A......WHILE.len<255.DO#0A....
..{.LET.ch.#3D.rdch()#0A........IF.ch#3D'*n'.|.ch#3D
endstreamch.BREAK#0A........len.:#3D.len+1#0A......
..objline1%len.:#3D.ch#0A......}#0A......endread()#0A
....}#0A....objline1%0.:#3D.len#0A....objline1writt
en.:#3D.FALSE#0A..}#0A#0A..sourcestream.:#3D.findin
put(argv!0)......//.FROM#0A..sourcenamev!0.:#3D.arg
v!0#0A..sourcefileno..:#3D.0#0A#0A..IF.sourcestream
#3D0.DO.{.writef("Trouble.with.file.%s*n",.argv!0)#0A
.........................errcount.:#3D.1#0A........
.................GOTO.fin#0A.......................
}#0A#0A..selectinput(sourcestream)#0A.#0A..TEST.arg
v!1..........//.TO#0A..THEN.{.gostream.:#3D.findout
put(argv!1)#0A.........IF.gostream#3D0.DO#0A.......
..{.writef("Trouble.with.code.file.%s*n",.argv!1)#0A
...........errcount.:#3D.1#0A...........GOTO.fin#0A
.........}#0A.......}#0A..ELSE.{.ocodeout.:#3D.find
output("ocode")#0A.........IF.ocodeout#3D0.DO#0A...
......{.writes("Trouble.with.file.ocode*n")#0A.....
......errcount.:#3D.1#0A...........GOTO.fin#0A.....
....}#0A.......}#0A#0A..treevec.:#3D.getvec(treesiz
e)#0A..obuf....:#3D.getvec(obufsize)#0A#0A..IF.tree
vec#3D0.|.obuf#3D0.DO#0A..{.writes("Insufficient.me
mory*n")#0A....errcount.:#3D.1#0A....GOTO.fin#0A..}
#0A...#0A..UNLESS.argv!2#3D0.DO.......//.VER#0A..{.
sysprint.:#3D.findoutput(argv!2)#0A....IF.sysprint#3D
0.DO#0A....{.sysprint.:#3D.stdout#0A......writef("T
rouble.with.file.%s*n",.argv!2)#0A......errcount.:#3D
.1#0A......GOTO.fin#0A....}#0A..}#0A#0A..selectoutp
ut(sysprint)#0A#0A..//.Now.syntax.analyse,.translat
e.and.code-generate.each.section#0A..{.LET.b.#3D.VE
C.64/bytesperword#0A....chbuf.:#3D.b#0A....FOR.i.#3D
.0.TO.63.DO.chbuf%i.:#3D.0#0A....//.Sourcefile.0.is
.always.the.FROM.argument.filename#0A....//.others.
are.GET.files#0A....sourcenamev!0.:#3D.argv!0#0A...
.sourcefileno.:#3D.0#0A....FOR.i.#3D.1.TO.sourcefil
eupb.DO.sourcenamev!i.:#3D.0.//.Done.for.safety#0A.
...chcount,.lineno.:#3D.0,.(sourcefileno<<20).+.1#0A
....token,.decval.:#3D.0,.0#0A....rch()#0A.#0A....{
.//.Start.of.loop.to.process.each.section#0A......L
ET.tree.#3D.?#0A......treep.:#3D.treevec.+.treesize
#0A......obufp.:#3D.0#0A......obuft.:#3D.obufsize.*
.bytesperword#0A#0A......tree.:#3D.formtree()#0A...
...IF.tree#3D0.BREAK#0A#0A......//writef("Tree.size
.%n*n",.treesize+treevec-treep)#0A.#0A......IF.prtr
ee.DO.{.writes("Parse.Tree*n")#0A..................
...plist(tree,.0,.20)#0A.....................newlin
e()#0A...................}#0A..#0A......UNLESS.errc
ount#3D0.GOTO.fin#0A.#0A......translate(tree)#0A#0A
......obufq.:#3D.obufp.....//.Prepare.to.read.from.
OCODE.buffer#0A......obufp.:#3D.0#0A#0A......TEST.a
rgv!1#3D0#0A......THEN.writeocode()..//.Write.OCODE
.file.if.no.TO.argument#0A......ELSE.codegenerate(t
reevec,.treesize)#0A....}.REPEATWHILE.token#3Ds_dot
#0A..}#0A...#0Afin:#0A..IF.getstreams....DO.{.LET.p
.#3D.getstreams#0A........................getstream
s.:#3D.!p#0A........................freevec(p)#0A..
....................}#0A..IF.treevec.......DO.freev
ec(treevec)#0A..IF.obuf..........DO.freevec(obuf)#0A
..IF.sourcenamev...DO.freevec(sourcenamev)#0A..IF.s
ourcestream..DO.{.selectinput(sourcestream);.endrea
d().}#0A..IF.ocodeout......DO.{.selectoutput(ocodeo
ut)#0A........................UNLESS.ocodeout#3Dstd
out.DO.endwrite()#0A......................}#0A..IF.
gostream......DO.{.selectoutput(gostream)#0A.......
.................UNLESS.gostream#3Dstdout.DO.endwri
te()#0A......................}#0A..UNLESS.sysprint#3D
stdout.DO.{.selectoutput(sysprint);.endwrite().}#0A
#0A..selectoutput(stdout)#0A//abort(7777)#0A..RESUL
TIS.errcount#3D0.->.0,.20#0A}#0A#0A//.*************
.OCODE.I/O.Routines.**************************#0A#0A
/*#0AThe.OCODE.buffer.variables.are:#0A#0Aobuf.....
....is.the.OCODE.buffer.--.(obuf#3Dworkvec)#0Aobufp
........position.of.next.byte.in.the.OCODE.buffer#0A
obufq........another.pointer.into.the.OCODE.buffer#0A
obuft........end.of.the.OCODE.buffer#2E#0Aobufsize.
....size.of.obuf.(in.words)#0A*/#0A#0AAND.writeocod
e().BE#0A{.LET.layout.#3D.0#0A..selectoutput(ocodeo
ut)#0A#0A..UNTIL.obufp>#3Dobufq.DO#0A..{.writef(".%
n",.rdn())#0A....layout.:#3D.layout+1#0A....UNLESS.
layout.REM.16.DO.newline()#0A..}#0A..newline()#0A..
selectoutput(sysprint)#0A..writef("OCODE.size:.%i5/
%n*n",.obufq,.obuft)#0A}#0A#0AAND.rdn().#3D.VALOF#0A
{.LET.byte.#3D.obuf%obufp#0A..IF.obufp>#3Dobufq.RES
ULTIS.0#0A..obufp.:#3D.obufp+1#0A..IF.byte<223.RESU
LTIS.byte#0A..IF.byte#3D223.RESULTIS.-1#0A..RESULTI
S.(byte&31).+.(rdn()<<5)#0A}#0A#0AAND.wrn(n).BE#0A{
.IF.obufp>#3Dobuft.DO#0A..{.errmax.:#3D.0.//.Make.i
t.fatal#0A....trnerr("More.workspace.needed.for.OCO
DE.buffer*n")#0A..}#0A..IF.-1<#3Dn<223.DO....//.Thi
s.is.the.normal.case#0A..{.IF.n#3D-1.DO.n.:#3D.223#0A
....obuf%obufp.:#3D.n#0A....obufp.:#3D.obufp.+.1#0A
....RETURN#0A..}#0A..obuf%obufp.:#3D.224.+.(n&31)#0A
..obufp.:#3D.obufp.+.1#0A..n.:#3D.n>>5#0A}.REPEAT#0A
#0A//.*************.End.of..OCODE.I/O.Routines.****
***************#0A..#0ALET.lex().BE#0A{.nlpending.:
#3D.FALSE#0A.#0A..{.SWITCHON.ch.INTO#0A.#0A....{.DE
FAULT:#0A............{.LET.badch.#3D.ch#0A.........
.....ch.:#3D.'*s'#0A..............synerr("Illegal.c
haracter.%x2",.badch)#0A............}#0A#0A......CA
SE.'*n':#0A...............lineno.:#3D.lineno.+.1#0A
......CASE.'*p':#0A...............nlpending.:#3D.TR
UE..//.IGNORABLE.CHARACTERS#0A......CASE.'*c':#0A..
....CASE.'*t':#0A......CASE.'*s':#0A...............
rch().REPEATWHILE.ch#3D'*s'#0A...............LOOP#0A
#0A......CASE.'0':CASE.'1':CASE.'2':CASE.'3':CASE.'
4':#0A......CASE.'5':CASE.'6':CASE.'7':CASE.'8':CAS
E.'9':#0A..............token.:#3D.s_number#0A......
........decval.:#3D.readnumber(10,.100)#0A.........
.....RETURN#0A.#0A......CASE.'a':CASE.'b':CASE.'c':
CASE.'d':CASE.'e':#0A......CASE.'f':CASE.'g':CASE.'
h':CASE.'i':CASE.'j':#0A......CASE.'k':CASE.'l':CAS
E.'m':CASE.'n':CASE.'o':#0A......CASE.'p':CASE.'q':
CASE.'r':CASE.'s':CASE.'t':#0A......CASE.'u':CASE.'
v':CASE.'w':CASE.'x':CASE.'y':#0A......CASE.'z':#0A
......CASE.'A':CASE.'B':CASE.'C':CASE.'D':CASE.'E':
#0A......CASE.'F':CASE.'G':CASE.'H':CASE.'I':CASE.'
J':#0A......CASE.'K':CASE.'L':CASE.'M':CASE.'N':CAS
E.'O':#0A......CASE.'P':CASE.'Q':CASE.'R':CASE.'S':
CASE.'T':#0A......CASE.'U':CASE.'V':CASE.'W':CASE.'
X':CASE.'Y':#0A......CASE.'Z':#0A..............toke
n.:#3D.lookupword(rdtag(ch))#0A..............IF.tok
en#3Ds_get.DO.{.performget();.LOOP..}#0A...........
...RETURN#0A.#0A......CASE.'$':#0A..............rch
()#0A..............IF.ch#3D'$'.|.ch#3D'<'.|.ch#3D'>
'.DO#0A..............{.LET.k.#3D.ch#0A.............
...token.:#3D.lookupword(rdtag('<'))#0A............
....//.token.#3D.s_true.............if.the.tag.is.s
et#0A................//......#3D.s_false.or.s_name.
.otherwise#0A.#0A................//.$>tag...marks.t
he.end.of.a.conditional#0A................//.......
..skipping.section#0A................IF.k#3D'>'.DO#0A
................{.IF.skiptag#3Dwordnode.DO#0A......
................skiptag.:#3D.0...//.Matching.$>tag.
found#0A..................LOOP#0A................}#0A
.#0A................UNLESS.skiptag#3D0.LOOP#0A#0A..
..............//.Only.process.$<tag.and.$$tag.if.no
t.skipping#0A.#0A................//.$$tag..compleme
nts.the.value.of.a.tag#0A................IF.k#3D'$'
.DO#0A................{.h1!wordnode.:#3D.token#3Ds_
true.->.s_false,.s_true#0A..................LOOP#0A
................}#0A.#0A................//.$<tag#0A
................IF.token#3Ds_true.LOOP......//.Don'
t.skip.if.set#0A#0A................//.tag.is.false.
so.skip.until.matching.$>tag.or.EOF#0A.............
...skiptag.:#3D.wordnode#0A................UNTIL.sk
iptag#3D0.|.token#3Ds_dot.|.token#3Ds_eof.DO.lex()#0A
................skiptag.:#3D.0#0A................RE
TURN#0A..............}#0A.#0A..............UNLESS.c
h#3D'('.|.ch#3D')'.DO.synerr("'$'.out.of.context")#0A
..............token.:#3D.ch#3D'('.->.s_lsect,.s_rse
ct#0A..............lookupword(rdtag('$'))#0A.......
.......RETURN#0A.#0A......CASE.'{':.token,.wordnode
.:#3D.s_lsect,.nulltag;.BREAK#0A......CASE.'}':.tok
en,.wordnode.:#3D.s_rsect,.nulltag;.BREAK#0A#0A....
..CASE.'#23':#0A..............token.:#3D.s_number#0A
..............rch()#0A..............IF.'0'<#3Dch<#3D
'7'.DO#0A..............{.decval.:#3D.readnumber(.8,
.100)#0A................RETURN#0A..............}#0A
..............IF.ch#3D'b'.|.ch#3D'B'.DO#0A.........
.....{.rch()#0A................decval.:#3D.readnumb
er(.2,.100)#0A................RETURN#0A............
..}#0A..............IF.ch#3D'o'.|.ch#3D'O'.DO#0A...
...........{.rch()#0A................decval.:#3D.re
adnumber(.8,.100)#0A................RETURN#0A......
........}#0A..............IF.ch#3D'x'.|.ch#3D'X'.DO
#0A..............{.rch()#0A................decval.:
#3D.readnumber(16,.100)#0A................RETURN#0A
..............}#0A..............token.:#3D.s_mthap#0A
..............RETURN#0A.#0A......CASE.'[':.token.:#3D
.s_sbra;......BREAK#0A......CASE.']':.token.:#3D.s_
sket;......BREAK#0A......CASE.'(':.token.:#3D.s_lpa
ren;....BREAK#0A......CASE.')':.token.:#3D.s_rparen
;....BREAK.#0A......CASE.'?':.token.:#3D.s_query;..
...BREAK#0A......CASE.'+':.token.:#3D.s_plus;......
BREAK#0A......CASE.',':.token.:#3D.s_comma;.....BRE
AK#0A......CASE.';':.token.:#3D.s_semicolon;.BREAK#0A
......CASE.'@':.token.:#3D.s_lv;........BREAK#0A...
...CASE.'&':.token.:#3D.s_logand;....BREAK#0A......
CASE.'#3D':.token.:#3D.s_eq;........BREAK#0A......C
ASE.'!':.token.:#3D.s_vecap;.....BREAK#0A......CASE
.'%':.token.:#3D.s_byteap;....BREAK#0A......CASE.'*
*':token.:#3D.s_mult;......BREAK#0A......CASE.'|':.
token.:#3D.s_logor;.....BREAK#0A......CASE.'#2E':.t
oken.:#3D.s_dot;.......BREAK#0A#0A.#0A......CASE.'/
':#0A..............rch()#0A..............IF.ch#3D'\
'.DO.{.token.:#3D.s_logand;.BREAK.}#0A.............
.IF.ch#3D'/'.DO#0A..............{.rch().REPEATUNTIL
.ch#3D'*n'.|.ch#3Dendstreamch#0A................LOO
P#0A..............}#0A.#0A..............IF.ch#3D'**
'.DO#0A..............{.LET.depth.#3D.1#0A#0A.......
.........{.rch()#0A..................IF.ch#3D'**'.D
O#0A..................{.rch().REPEATWHILE.ch#3D'**'
#0A....................IF.ch#3D'/'.DO.{.depth.:#3D.
depth-1;.LOOP.}#0A..................}#0A...........
.......IF.ch#3D'/'.DO#0A..................{.rch()#0A
....................IF.ch#3D'**'.DO.{.depth.:#3D.de
pth+1;.LOOP.}#0A..................}#0A.............
.....IF.ch#3D'*n'.DO.lineno.:#3D.lineno+1#0A.......
...........IF.ch#3Dendstreamch.DO.synerr("Missing.'
**/'")#0A................}.REPEATUNTIL.depth#3D0#0A
#0A................rch()#0A................LOOP#0A.
.............}#0A#0A..............token.:#3D.s_div#0A
..............RETURN#0A.#0A......CASE.'~':#0A......
........rch()#0A..............IF.ch#3D'#3D'.DO.{.to
ken.:#3D.s_ne;.....BREAK.}#0A..............token.:#3D
.s_not#0A..............RETURN#0A.#0A......CASE.'\':
#0A..............rch()#0A..............IF.ch#3D'/'.
DO.{.token.:#3D.s_logor;..BREAK.}#0A..............I
F.ch#3D'#3D'.DO.{.token.:#3D.s_ne;.....BREAK.}#0A..
............token.:#3D.s_not#0A..............RETURN
#0A.#0A......CASE.'<':.rch()#0A..............IF.ch#3D
'#3D'.DO.{.token.:#3D.s_le;.....BREAK.}#0A.........
.....IF.ch#3D'<'.DO.{.token.:#3D.s_lshift;.BREAK.}#0A
..............token.:#3D.s_ls#0A..............RETUR
N#0A.#0A......CASE.'>':.rch()#0A..............IF.ch
#3D'#3D'.DO.{.token.:#3D.s_ge;.....BREAK.}#0A......
........IF.ch#3D'>'.DO.{.token.:#3D.s_rshift;.BREAK
.}#0A..............token.:#3D.s_gr#0A..............
RETURN#0A.#0A......CASE.'-':.rch()#0A..............
IF.ch#3D'>'.DO.{.token.:#3D.s_cond;.BREAK..}#0A....
..........token.:#3D.s_minus#0A..............RETURN
#0A.#0A......CASE.':':.rch()#0A..............IF.ch#3D
'#3D'.DO.{.token.:#3D.s_ass;.BREAK..}#0A...........
...IF.ch#3D':'.DO.{.token.:#3D.s_of;..BREAK..}..//.
Inserted.11/7/01#0A..............token.:#3D.s_colon
#0A..............RETURN#0A.#0A......CASE.'"':#0A...
........{.LET.len.#3D.0#0A.............rch()#0A....
.........encoding.:#3D.defaultencoding.//.encoding.
for.*#23.escapes#0A#0A.............UNTIL.ch#3D'"'.D
O#0A.............{.LET.code.#3D.rdstrch()#0A.......
........TEST.result2#0A...............THEN.{.//.A..
*#23.code.found#2E#0A......................//.Conve
rt.it.to.UTF8.or.GB2312.format#2E#0A...............
.......TEST.encoding#3DGB2312#0A...................
...THEN.{.//.Convert.to.GB2312.sequence#0A.........
....................IF.code>#23x7F.DO#0A...........
..................{.LET.hi.#3D.code../..100.+.160#0A
...............................LET.lo.#3D.code.MOD.
100.+.160#0A...............................IF.len>#3D
254.DO.synerr("Bad.string.constant")#0A............
...................TEST.bigender#0A................
...............THEN.{.charv%(len+1).:#3D.hi.#0A....
..................................charv%(len+2).:#3D
.lo#0A....................................}#0A.....
..........................ELSE.{.charv%(len+1).:#3D
.lo.#0A......................................charv%
(len+2).:#3D.hi#0A.................................
...}#0A...............................len.:#3D.len.
+.2#0A...............................LOOP#0A.......
......................}#0A.........................
....IF.len>#3D255.DO.synerr("Bad.string.constant")#0A
.............................charv%(len+1).:#3D.cod
e.//.Ordinary.ASCII.char#0A........................
.....len.:#3D.len.+.1#0A...........................
..LOOP#0A...........................}#0A...........
...........ELSE.{.//.Convert.to.UTF8.sequence#0A...
..........................IF.code<#3D#23x7F.DO#0A..
...........................{.IF.len>#3D255.DO.syner
r("Bad.string.constant")#0A........................
.......charv%(len+1).:#3D.code...//.0xxxxxxx#0A....
...........................len.:#3D.len.+.1#0A.....
..........................LOOP#0A..................
...........}#0A.............................IF.code
<#3D#23x7FF.DO#0A.............................{.IF.
len>#3D254.DO.synerr("Bad.string.constant")#0A.....
..........................charv%(len+1).:#3D.#23b11
00_0000+(code>>6)..//.110xxxxx#0A..................
.............charv%(len+2).:#3D.#23x80+(.code....&#23
x3F)..//.10xxxxxx#0A...............................
len.:#3D.len.+.2#0A...............................L
OOP#0A.............................}#0A............
.................IF.code<#3D#23xFFFF.DO#0A.........
....................{.IF.len>#3D253.DO.synerr("Bad.
string.constant")#0A...............................
charv%(len+1).:#3D.#23b1110_0000+(code>>12).//.1110
xxxx#0A...............................charv%(len+2)
.:#3D.#23x80+((code>>6)&#23x3F)..//.10xxxxxx#0A....
...........................charv%(len+3).:#3D.#23x8
0+(.code....&#23x3F)..//.10xxxxxx#0A...............
................len.:#3D.len.+.3#0A................
...............LOOP#0A.............................
}#0A.............................IF.code<#3D#23x1F_
FFFF.DO#0A.............................{.IF.len>#3D
252.DO.synerr("Bad.string.constant")#0A............
...................charv%(len+1).:#3D.#23b1111_0000
+(code>>18).//.11110xxx#0A.........................
......charv%(len+2).:#3D.#23x80+((code>>12)&#23x3F)
.//.10xxxxxx#0A...............................charv
%(len+3).:#3D.#23x80+((code>>.6)&#23x3F).//.10xxxxx
x#0A...............................charv%(len+4).:#3D
.#23x80+(.code.....&#23x3F).//.10xxxxxx#0A.........
......................len.:#3D.len.+.4#0A..........
.....................LOOP#0A.......................
......}#0A.............................IF.code<#3D#23
x3FF_FFFF.DO#0A.............................{.IF.le
n>#3D251.DO.synerr("Bad.string.constant")#0A.......
........................charv%(len+1).:#3D.#23b1111
_1000+(code>>24).//.111110xx#0A....................
...........charv%(len+2).:#3D.#23x80+((code>>18)&#23
x3F).//.10xxxxxx#0A...............................c
harv%(len+3).:#3D.#23x80+((code>>12)&#23x3F).//.10x
xxxxx#0A...............................charv%(len+4
).:#3D.#23x80+((code>>.6)&#23x3F).//.10xxxxxx#0A...
............................charv%(len+5).:#3D.#23x
80+(.code.....&#23x3F).//.10xxxxxx#0A..............
.................len.:#3D.len.+.5#0A...............
................LOOP#0A............................
.}#0A.............................IF.code<#3D#23x7F
FF_FFFF.DO#0A.............................{.IF.len>
#3D250.DO.synerr("Bad.string.constant")#0A.........
......................charv%(len+1).:#3D.#23b1111_1
100+(code>>30).//.1111110x#0A......................
.........charv%(len+2).:#3D.#23x80+((code>>24)&#23x
3F).//.10xxxxxx#0A...............................ch
arv%(len+3).:#3D.#23x80+((code>>18)&#23x3F).//.10xx
xxxx#0A...............................charv%(len+4)
.:#3D.#23x80+((code>>12)&#23x3F).//.10xxxxxx#0A....
...........................charv%(len+5).:#3D.#23x8
0+((code>>.6)&#23x3F).//.10xxxxxx#0A...............
................charv%(len+6).:#3D.#23x80+(.code...
..&#23x3F).//.10xxxxxx#0A..........................
.....len.:#3D.len.+.6#0A...........................
....LOOP#0A.............................}#0A.......
......................synerr("Bad.Unicode.character
")#0A...........................}#0A...............
.....}#0A...............ELSE.{.//.Not.a.Unicode.cha
racter#0A......................IF.len#3D255.DO.syne
rr("Bad.string.constant")#0A......................l
en.:#3D.len.+.1#0A......................charv%len.:
#3D.code#0A....................}#0A.............}#0A
.#0A.............charv%0.:#3D.len#0A.............wo
rdnode.:#3D.newvec(len/bytesperword+2)#0A..........
...h1!wordnode.:#3D.s_string#0A.............FOR.i.#3D
.0.TO.len.DO.(@h2!wordnode)%i.:#3D.charv%i#0A......
.......token.:#3D.s_string#0A.............BREAK#0A.
.........}#0A.#0A......CASE.'*'':#0A..............r
ch()#0A..............encoding.:#3D.defaultencoding#0A
..............decval.:#3D.rdstrch()#0A.............
.token.:#3D.s_number#0A..............UNLESS.ch#3D'*
''.DO.synerr("Bad.character.constant")#0A..........
....BREAK#0A.#0A.#0A......CASE.endstreamch:#0A.....
.........IF.getstreams.DO#0A..............{.//.Retu
rn.from.a.'GET'.stream#0A................LET.p.#3D.
getstreams#0A................endread()#0A..........
......ch...........:#3D.h4!getstreams#0A...........
.....lineno.......:#3D.h3!getstreams#0A............
....sourcestream.:#3D.h2!getstreams#0A.............
...getstreams...:#3D.h1!getstreams#0A..............
..freevec(p).//.Free.the.GET.node#0A...............
.selectinput(sourcestream)#0A................LOOP#0A
..............}#0A..............//.endstreamch.#3D>
.EOF.only.at.outermost.GET.level.#0A..............t
oken.:#3D.s_eof#0A..............RETURN#0A....}#0A..
}.REPEAT#0A.#0A..rch()#0A}#0A.#0ALET.lookupword(wor
d).#3D.VALOF#0A{.LET.len,.i.#3D.word%0,.0#0A..LET.h
ashval.#3D.19609.//.This.and.31397.are.primes#2E#0A
..FOR.j.#3D.0.TO.len.DO.hashval.:#3D.(hashval.NEQV.
word%j).*.31397#0A..hashval.:#3D.(hashval>>1).REM.n
ametablesize#0A#0A..wordnode.:#3D.nametable!hashval
#0A.#0A..UNTIL.wordnode#3D0.|.i>len.TEST.(@h3!wordn
ode)%i#3Dword%i#0A...........................THEN.i
.:#3D.i+1#0A...........................ELSE.wordnod
e,.i.:#3D.h2!wordnode,.0#0A.#0A..UNLESS.wordnode.DO
#0A..{.wordnode.:#3D.newvec(len/bytesperword+2)#0A.
...h1!wordnode,.h2!wordnode.:#3D.s_name,.nametable!
hashval#0A....FOR.i.#3D.0.TO.len.DO.(@h3!wordnode)%
i.:#3D.word%i#0A....nametable!hashval.:#3D.wordnode
#0A..}#0A.#0A..RESULTIS.h1!wordnode#0A}#0A.#0AAND.d
sw(word,.sym).BE.{.lookupword(word);.h1!wordnode.:#3D
.sym..}#0A.#0AAND.declsyswords().BE#0A{.dsw("AND",.
s_and)#0A..dsw("ABS",.s_abs)#0A..dsw("BE",.s_be)#0A
..dsw("BREAK",.s_break)#0A..dsw("BY",.s_by)#0A..dsw
("CASE",.s_case)#0A..dsw("DO",.s_do)#0A..dsw("DEFAU
LT",.s_default)#0A..dsw("EQ",.s_eq)#0A..dsw("EQV",.
s_eqv)#0A..dsw("ELSE",.s_else)#0A..dsw("ENDCASE",.s
_endcase)#0A..dsw("FALSE",.s_false)#0A..dsw("FOR",.
s_for)#0A..dsw("FINISH",.s_finish)#0A..dsw("GOTO",.
s_goto)#0A..dsw("GE",.s_ge)#0A..dsw("GR",.s_gr)#0A.
.dsw("GLOBAL",.s_global)#0A..dsw("GET",.s_get)#0A..
dsw("IF",.s_if)#0A..dsw("INTO",.s_into)#0A..dsw("LE
T",.s_let)#0A..dsw("LV",.s_lv)#0A..dsw("LE",.s_le)#0A
..dsw("LS",.s_ls)#0A..dsw("LOGOR",.s_logor)#0A..dsw
("LOGAND",.s_logand)#0A..dsw("LOOP",.s_loop)#0A..ds
w("LSHIFT",.s_lshift)#0A..dsw("MANIFEST",.s_manifes
t)#0A..dsw("MOD",.s_rem)#0A..dsw("NE",.s_ne)#0A..ds
w("NEEDS",.s_needs)#0A..dsw("NEQV",.s_neqv)#0A..dsw
("NOT",.s_not)#0A..dsw("OF",.s_of).................
..//.Inserted.11/7/01#0A..dsw("OR",.s_else)#0A..dsw
("RESULTIS",.s_resultis)#0A..dsw("RETURN",.s_return
)#0A..dsw("REM",.s_rem)#0A..dsw("RSHIFT",.s_rshift)
#0A..dsw("RV",.s_rv)#0A..dsw("REPEAT",.s_repeat)#0A
..dsw("REPEATWHILE",.s_repeatwhile)#0A..dsw("REPEAT
UNTIL",.s_repeatuntil)#0A..dsw("SECTION",.s_section
)#0A..dsw("SKIP",.s_skip)...............//.Added.22
/6/05#0A..dsw("SLCT",.s_slct)...............//.Inse
rted.11/7/01#0A..dsw("STATIC",.s_static)#0A..dsw("S
WITCHON",.s_switchon)#0A..dsw("TO",.s_to)#0A..dsw("
TEST",.s_test)#0A..dsw("TRUE",.s_true)#0A..dsw("THE
N",.s_do)#0A..dsw("TABLE",.s_table)#0A..dsw("UNLESS
",.s_unless)#0A..dsw("UNTIL",.s_until)#0A..dsw("VEC
",.s_vec)#0A..dsw("VALOF",.s_valof)#0A..dsw("WHILE"
,.s_while)#0A..dsw("XOR",.s_neqv)#0A..dsw("$",.0)#0A
.#0A..nulltag.:#3D.wordnode#0A}.#0A.#0ALET.rch().BE
#0A{.ch.:#3D.rdch()#0A..chcount.:#3D.chcount.+.1#0A
..chbuf%(chcount&63).:#3D.ch#0A}#0A.#0AAND.wrchbuf(
).BE#0A{.writes("*n#2E#2E#2E")#0A..FOR.p.#3D.chcoun
t-63.TO.chcount.DO#0A..{.LET.k.#3D.chbuf%(p&63)#0A.
...IF.0<k<255.DO.wrch(k)#0A..}#0A..newline()#0A}#0A
.#0A.#0AAND.rdtag(ch1).#3D.VALOF#0A{.LET.len.#3D.1#0A
..IF.eqcases.&.'a'<#3Dch1<#3D'z'.DO.ch1.:#3D.ch1.+.
'A'.-.'a'#0A..charv%1.:#3D.ch1#0A.#0A..{.rch()#0A..
..UNLESS.'a'<#3Dch<#3D'z'.|.'A'<#3Dch<#3D'Z'.|#0A..
.........'0'<#3Dch<#3D'9'.|.ch#3D'#2E'.|.ch#3D'_'.B
REAK#0A....IF.eqcases.&.'a'<#3Dch<#3D'z'.DO.ch.:#3D
.ch.+.'A'.-.'a'#0A....len.:#3D.len+1#0A....charv%le
n.:#3D.ch#0A..}.REPEAT#0A.#0A..charv%0.:#3D.len#0A.
.RESULTIS.charv#0A}#0A#0AAND.catstr(s1,.s2).#3D.VAL
OF#0A//.Concatenate.strings.s1.and.s2.leaving.the.r
esult.in.s1#2E#0A//.s1.is.assumed.to.be.able.to.hol
d.a.string.of.length.255#2E#0A//.The.resulting.stri
ng.is.truncated.to.length.255,.if.necessary#2E.#0A{
.LET.len.#3D.s1%0#0A..LET.n.#3D.len#0A..FOR.i.#3D.1
.TO.s2%0.DO#0A..{.n.:#3D.n+1#0A....IF.n>255.BREAK#0A
....s1%n.:#3D.s2%i#0A..}#0A..s1%0.:#3D.n#0A}.#0A.#0A
AND.performget().BE#0A{.LET.stream.#3D.?#0A..LET.le
n.#3D.0#0A..lex()#0A..UNLESS.token#3Ds_string.DO.sy
nerr("Bad.GET.directive")#0A..len.:#3D.charv%0#0A#0A
..//.Append.#2Eh.to.the.GET.filename.does.not.end.i
n.#2Eh.or.#2Eb#0A..UNLESS.len>#3D2.&.charv%(len-1)#3D
'#2E'.&.#0A.........(charv%len#3D'h'.|.charv%len#3D
'b').DO#0A..{.len.:#3D.len+2#0A....charv%0,.charv%(
len-1),.charv%len.:#3D.len,.'#2E',.'h'#0A..}#0A#0A.
.FOR.i.#3D.1.TO.charv%0.IF.charv%i#3D':'.DO.charv%i
.:#3D.'/'#0A#0A..//.First.look.in.the.current.direc
tory#0A..//writef("Searching.for.*"%s*".in.the.curr
ent.directory*n",.charv)#0A..stream.:#3D.findinput(
charv)#0A#0A..//.Then.try.the.headers.directories#0A
..//UNLESS.stream.DO.writef("Searching.for.*"%s*".i
n.%s*n",.charv,.hdrs)#0A..UNLESS.stream.DO.stream.:
#3D.pathfindinput(charv,.hdrs)#0A#0A..//.Finally.pr
epend.g/.and.lookup.in.the.system.root.directory#0A
..UNLESS.stream.DO#0A..{.LET.filename.#3D.VEC.256/b
ytesperword#0A....filename%0.:#3D.0#0A....catstr(fi
lename,."g/")#0A....catstr(filename,.charv)#0A..../
/writef("Searching.for.*"%s*".in.%s*n",.filename,.r
ootnode!rtn_rootvar)#0A....stream.:#3D.pathfindinpu
t(filename,.rootnode!rtn_rootvar)#0A..}#0A#0A..UNLE
SS.stream.DO#0A..{.synerr("Unable.to.find.GET.file.
%s",.charv)#0A....RETURN#0A..}#0A#0A..IF.sourcefile
no>#3Dsourcefileupb.DO#0A..{.synerr("Too.many.GET.f
iles")#0A....RETURN#0A..}#0A#0A..{.LET.len.#3D.char
v%0#0A....LET.node.#3D.getvec(4.+.len/bytesperword)
#0A....LET.str.#3D.@node!4#0A#0A....UNLESS.node.DO.
synerr("getvec.failure.in.performget")#0A#0A....FOR
.i.#3D.0.TO.len.DO.str%i.:#3D.charv%i#0A....sourcef
ileno.:#3D.sourcefileno+1#0A....sourcenamev!sourcef
ileno.:#3D.str#0A....node!0,.node!1,.node!2,.node!3
.:#3D.getstreams,.sourcestream,.lineno,.ch#0A....ge
tstreams.:#3D.node#0A..}#0A..sourcestream.:#3D.stre
am#0A..selectinput(sourcestream)#0A..lineno.:#3D.(s
ourcefileno<<20).+.1#0A..rch()#0A}#0A.#0AAND.readnu
mber(radix,.digs).#3D.VALOF#0A//.Read.a.binary,.oct
al,.decimal.or.hexadecimal.unsigned.number#0A//.wit
h.between.1.and.digs.digits#2E.Underlines.are.allow
ed#2E#0A//.This.function.is.used.for.numerical.cons
tants.and.numerical#0A//.escapes.in.string.and.char
acter.constants#2E#0A{.LET.i,.res.#3D.0,.0#0A.#0A..
{.UNLESS.ch#3D'_'.DO.//.ignore.underlines#0A....{.L
ET.d.#3D.value(ch)#0A......IF.d>#3Dradix.BREAK#0A..
....i.:#3D.i+1.......//.Increment.count.of.digits#0A
......res.:#3D.radix*res.+.d#0A....}#0A....rch()#0A
..}.REPEATWHILE.i<digs#0A#0A..UNLESS.i.DO.synerr("B
ad.number")#0A..RESULTIS.res#0A}#0A.#0A.#0AAND.valu
e(ch).#3D.'0'<#3Dch<#3D'9'.->.ch-'0',#0A...........
.....'A'<#3Dch<#3D'F'.->.ch-'A'+10,#0A.............
...'a'<#3Dch<#3D'f'.->.ch-'a'+10,#0A...............
.100#0A.#0AAND.rdstrch().#3D.VALOF#0A{.//.Return.th
e.integer.code.for.the.next.string.character#0A..//
.Set.result2#3DTRUE.if.*#23.character.code.was.foun
d,.otherwise.FALSE#0A..LET.k.#3D.ch#0A#0A..IF.k#3D'
*n'.|.k#3D'*p'.DO#0A..{.lineno.:#3D.lineno+1#0A....
synerr("Unescaped.newline.character")#0A..}#0A.#0A.
.IF.k#3D'**'.DO#0A..{.rch()#0A....k.:#3D.ch#0A....I
F.'a'<#3Dk<#3D'z'.DO.k.:#3D.k.+.'A'.-.'a'#0A....SWI
TCHON.k.INTO#0A....{.CASE.'*n':#0A......CASE.'*c':#0A
......CASE.'*p':#0A......CASE.'*s':#0A......CASE.'*
t':.WHILE.ch#3D'*n'.|.ch#3D'*c'.|.ch#3D'*p'.|.ch#3D
'*s'.|.ch#3D'*t'.DO#0A.................{.IF.ch#3D'*
n'.DO.lineno.:#3D.lineno+1#0A...................rch
()#0A.................}#0A.................IF.ch#3D
'**'.DO.{.rch();.LOOP..}#0A#0A......DEFAULT:...syne
rr("Bad.string.or.character.constant,.ch#3D%n",.ch)
#0A.........#0A......CASE.'**':#0A......CASE.'*'':#0A
......CASE.'"':....................ENDCASE#0A......
...#0A......CASE.'T':..k.:#3D.c_tab;.......ENDCASE#0A
......CASE.'S':..k.:#3D.c_space;.....ENDCASE#0A....
..CASE.'N':..k.:#3D.c_newline;...ENDCASE#0A......CA
SE.'E':..k.:#3D.c_escape;....ENDCASE#0A......CASE.'
B':..k.:#3D.c_backspace;.ENDCASE#0A......CASE.'P':.
.k.:#3D.c_newpage;...ENDCASE#0A......CASE.'C':..k.:
#3D.c_return;....ENDCASE#0A.........#0A......CASE.'
X':..//.*xhh..--.A.character.escape.in.hexadecimal#0A
.................rch()#0A.................k.:#3D.re
adnumber(16,2)#0A.................result2.:#3D.FALS
E#0A.................RESULTIS.k#0A#0A......CASE.'#23
':..//.*#23u...set.UTF8.mode#0A.................//.
*#23g...set.GB2312.mode#0A.................//.In.UT
F8.mode#0A.................//.....*#23hhhh.or.*#23#23
hhhhhhhh..--.a.Unicode.character#0A................
.//.In.GB2312#0A.................//.....*#23dddd...
..............--.A.GB2312.code#0A...............{.L
ET.digs.#3D.4#0A.................rch()#0A..........
.......IF.ch#3D'u'.|.ch#3D'U'.DO.{.encoding.:#3D.UT
F8;...rch();.LOOP.}#0A.................IF.ch#3D'g'.
|.ch#3D'G'.DO.{.encoding.:#3D.GB2312;.rch();.LOOP.}
#0A.................TEST.encoding#3DGB2312#0A......
...........THEN.{.#0A........................k.:#3D
.readnumber(10,.digs)#0A//sawritef("rdstrch:.GB2312
:.%i4*n",.k)#0A......................}#0A..........
.......ELSE.{.IF.ch#3D'#23'.DO.{.rch();.digs.:#3D.8
.}#0A........................k.:#3D.readnumber(16,.
digs)#0A//sawritef("rdstrch:.Unicode:.%x4*n",.k)#0A
......................}#0A.................result2.
:#3D.TRUE#0A.................RESULTIS.k#0A.........
......}#0A#0A......CASE.'0':CASE.'1':CASE.'2':CASE.
'3':CASE.'4':#0A......CASE.'5':CASE.'6':CASE.'7':#0A
.................//.*ooo.--.A.character.escape.in.o
ctal.#0A.................k.:#3D.readnumber(8,3)#0A.
................IF.k>255.DO.#0A....................
...synerr("Bad.string.or.character.constant")#0A...
..............result2.:#3D.FALSE#0A................
.RESULTIS.k#0A....}#0A..}#0A...#0A..rch()#0A..resul
t2.:#3D.FALSE#0A..RESULTIS.k#0A}.REPEAT#0A#0ALET.ne
wvec(n).#3D.VALOF#0A{.treep.:#3D.treep.-.n.-.1;#0A.
.IF.treep<#3Dtreevec.DO#0A..{.errmax.:#3D.0..//.Mak
e.it.fatal#0A....synerr("More.workspace.needed")#0A
..}#0A..RESULTIS.treep#0A}#0A.#0AAND.mk1(x).#3D.VAL
OF#0A{.LET.p.#3D.newvec(0)#0A..p!0.:#3D.x#0A..RESUL
TIS.p#0A}#0A.#0AAND.mk2(x,.y).#3D.VALOF#0A{.LET.p.#3D
.newvec(1)#0A..p!0,.p!1.:#3D.x,.y#0A..RESULTIS.p#0A
}#0A.#0AAND.mk3(x,.y,.z).#3D.VALOF#0A{.LET.p.#3D.ne
wvec(2)#0A..p!0,.p!1,.p!2.:#3D.x,.y,.z#0A..RESULTIS
.p#0A}#0A.#0AAND.mk4(x,.y,.z,.t).#3D.VALOF#0A{.LET.
p.#3D.newvec(3)#0A..p!0,.p!1,.p!2,.p!3.:#3D.x,.y,.z
,.t#0A..RESULTIS.p#0A}#0A.#0AAND.mk5(x,.y,.z,.t,.u)
.#3D.VALOF#0A{.LET.p.#3D.newvec(4)#0A..p!0,.p!1,.p!
2,.p!3,.p!4.:#3D.x,.y,.z,.t,.u#0A..RESULTIS.p#0A}#0A
.#0AAND.mk6(x,.y,.z,.t,.u,.v).#3D.VALOF#0A{.LET.p.#3D
.newvec(5)#0A..p!0,.p!1,.p!2,.p!3,.p!4,.p!5.:#3D.x,
.y,.z,.t,.u,.v#0A..RESULTIS.p#0A}#0A.#0AAND.mk7(x,.
y,.z,.t,.u,.v,.w).#3D.VALOF#0A{.LET.p.#3D.newvec(6)
#0A..p!0,.p!1,.p!2,.p!3,.p!4,.p!5,.p!6.:#3D.x,.y,.z
,.t,.u,.v,.w#0A..RESULTIS.p#0A}#0A.#0AAND.formtree(
).#3D..VALOF#0A{.LET.res.#3D.0#0A#0A..nametablesize
.:#3D.541#0A#0A..charv......:#3D.newvec(256/bytespe
rword).....#0A..nametable..:#3D.newvec(nametablesiz
e).#0A..FOR.i.#3D.0.TO.nametablesize.DO.nametable!i
.:#3D.0#0A..skiptag.:#3D.0#0A..declsyswords()#0A.#0A
..rec_p,.rec_l.:#3D.level(),.rec#0A.#0A..token,.dec
val.:#3D.0,.0#0A#0A..lex()#0A//sawritef("formtree:.
token#3D%n.cis#3D%n*n",.token,.cis)#0A..IF.token#3D
s_query.DO............//.For.debugging.lex#2E#0A..{
.lex()#0A....writef("token.#3D%i3.ln#3D%i5.%12t..de
cval.#3D.%i8...charv.#3D.%s*n",#0A............token
,.lineno&#23xFFFFF,.opname(token),.decval,........c
harv)#0A....IF.token#3Ds_eof.RESULTIS.0#0A..}.REPEA
T#0A#0Arec:res.:#3D.token#3Ds_section.->.rprog(s_se
ction),#0A...........token#3Ds_needs...->.rprog(s_n
eeds),.rdblockbody(TRUE)#0A//sawritef("section.ende
d.with.%s*n",.opname(token))#0A..UNLESS.token#3Ds_d
ot.|.token#3Ds_eof.DO.synerr("Incorrect.termination
")#0A.#0A..RESULTIS.res#0A}#0A.#0AAND.rprog(thing).
#3D.VALOF#0A{.LET.a.#3D.0#0A..lex()#0A..a.:#3D.rbex
p()#0A..UNLESS.h1!a#3Ds_string.DO.synerr("Bad.SECTI
ON.or.NEEDS.name")#0A..RESULTIS.mk3(thing,.a,#0A...
..............token#3Ds_needs.->.rprog(s_needs),#0A
.................................rdblockbody(TRUE))
.//.TRUE#3Doutmost.level#0A}#0A.#0A.#0AAND.synerr(m
ess,.a).BE#0A{.LET.fno.#3D.lineno>>20#0A..LET.ln.#3D
.lineno.&.#23xFFFFF#0A..LET.filename.#3D.sourcename
v!fno#0A..errcount.:#3D.errcount.+.1#0A..writef("*n
Error.near.")#0A..IF.filename.DO.writef("%s",.filen
ame)#0A..writef("[%n]:..",.ln)#0A..writef(mess,.a)#0A
..wrchbuf()#0A..IF.errcount.>.errmax.DO#0A..{.write
s("*nCompilation.aborted*n")#0A....longjump(fin_p,.
fin_l)#0A..}#0A..nlpending.:#3D.FALSE#0A.#0A..UNTIL
.token#3Ds_lsect.|.token#3Ds_rsect.|#0A........toke
n#3Ds_let.|.token#3Ds_and.|#0A........token#3Ds_dot
.|.token#3Ds_eof.|.nlpending.DO.lex()#0A#0A..IF.tok
en#3Ds_and.DO.token.:#3D.s_let#0A..longjump(rec_p,.
rec_l)#0A}#0A.#0ALET.rdblockbody(outerlevel).#3D.VA
LOF#0A{.LET.p,.l.#3D.rec_p,.rec_l#0A..LET.a,.ln.#3D
.0,.?#0A.#0A..rec_p,.rec_l.:#3D.level(),.recover#0A
#0Arecover:..#0A..IF.token#3Ds_semicolon.DO.lex()#0A
.#0A..ln.:#3D.lineno#0A...#0A..SWITCHON.token.INTO#0A
..{.CASE.s_manifest:#0A....CASE.s_static:#0A....CAS
E.s_global:#0A..............{.LET.op.#3D.token#0A..
..............lex()#0A................a.:#3D.rdsect
(rdcdefs,.op#3Ds_global->s_colon,s_eq)#0A..........
......a.:#3D.mk4(op,.a,.rdblockbody(outerlevel),.ln
)#0A................ENDCASE#0A..............}#0A.#0A
.#0A....CASE.s_let:.lex()#0A................a.:#3D.
rdef(outerlevel)#0A................WHILE.token#3Ds_
and.DO#0A................{.LET.ln1.#3D.lineno#0A...
...............lex()#0A..................a.:#3D.mk4
(s_and,.a,.rdef(outerlevel),.ln1)#0A...............
.}#0A................a.:#3D.mk4(s_let,.a,.rdblockbo
dy(outerlevel),.ln)#0A................ENDCASE#0A.#0A
....DEFAULT:....IF.outerlevel.DO#0A................
{.errmax.:#3D.0.//.Make.it.fatal#2E#0A.............
.....synerr("Bad.outer.level.declaration")#0A......
..........}#0A................a.:#3D.rdseq()#0A....
............UNLESS.token#3Ds_rsect.DO.synerr("Error
.in.command")#0A.#0A....CASE.s_rsect:IF.outerlevel.
DO.lex()#0A....CASE.s_dot:#0A....CASE.s_eof:#0A..}#0A
.#0A..rec_p,.rec_l.:#3D.p,.l#0A..RESULTIS.a#0A}#0A.
#0AAND.rdseq().#3D.VALOF#0A{.LET.a.#3D.0#0A...IF.to
ken#3Ds_semicolon.DO.lex()#0A...a.:#3D.rcom()#0A...
IF.token#3Ds_rsect.|.token#3Ds_dot.|.token#3Ds_eof.
RESULTIS.a#0A...RESULTIS.mk3(s_seq,.a,.rdseq())#0A}
#0A#0AAND.rdcdefs(sep).#3D.VALOF#0A{.LET.res,.id.#3D
.0,.0#0A...LET.ptr.#3D.@res#0A...LET.p,.l.#3D.rec_p
,.rec_l#0A...LET.kexp.#3D.0#0A#0A.#0A...{.LET.ln.#3D
.lineno#0A......rec_p,.rec_l.:#3D.level(),.recov#0A
......kexp.:#3D.0#0A......id.:#3D.rname()#0A......I
F.token#3Dsep.DO.kexp.:#3D.rnexp(0)#0A......!ptr.:#3D
.mk5(s_constdef,.0,.id,.kexp,.ln)#0A......ptr.:#3D.
@h2!(!ptr)#0A#0Arecov:IF.token#3Ds_semicolon.DO.lex
()#0A...}.REPEATWHILE.token#3Ds_name#0A.#0A...rec_p
,.rec_l.:#3D.p,.l#0A...RESULTIS.res#0A}#0A.#0AAND.r
dsect(r,.arg).#3D.VALOF#0A//.Used.only.for.MANIFEST
,.STATIC.and.GLOBAL.declarations,#0A//.SWITCHON.com
mands.and.blocks#2E#0A{.LET.tag,.res.#3D.wordnode,.
0#0A...UNLESS.token#3Ds_lsect.DO.synerr("'{'.or.'$(
'.expected")#0A...lex()#0A...UNLESS.token#3Ds_rsect
.DO.res.:#3D.r(arg).//.Allow.{.}..MR.22/6/05#0A...U
NLESS.token#3Ds_rsect.DO.synerr("'}'.or.'$)'.expect
ed")#0A...TEST.tag#3Dwordnode.THEN.lex()#0A........
.............ELSE.IF.wordnode#3Dnulltag.DO#0A......
....................{.token.:#3D.0#0A..............
..............synerr("Untagged.'$)'.mismatch")#0A..
........................}#0A...//.res#3D0.for.empty
.section.brackets.{.}#0A...RESULTIS.res#0A}#0A#0AAN
D.rnamelist().#3D.VALOF#0A{.LET.a.#3D.rname()#0A...
UNLESS.token#3Ds_comma.RESULTIS.a#0A...lex()#0A...R
ESULTIS.mk3(s_comma,.a,.rnamelist())#0A}#0A#0AAND.r
name().#3D.VALOF#0A{.LET.a.#3D.wordnode#0A...UNLESS
.token#3Ds_name.DO.synerr("Name.expected")#0A...lex
()#0A...RESULTIS.a#0A}#0A.#0ALET.rbexp().#3D.VALOF#0A
{.LET.a,.op.#3D.0,.token#0A.#0A...SWITCHON.token.IN
TO#0A.#0A...{.DEFAULT:.synerr("Error.in.expression"
)#0A#0A......CASE.s_query:..lex()#0A...............
......RESULTIS.mk1(s_query)#0A.#0A......CASE.s_true
:#0A......CASE.s_false:#0A......CASE.s_name:#0A....
..CASE.s_string:.a.:#3D.wordnode#0A................
.....lex()#0A.....................RESULTIS.a#0A.#0A
......CASE.s_number:.a.:#3D.mk2(s_number,.decval)#0A
.....................lex()#0A.....................R
ESULTIS.a#0A#0A......CASE.s_slct:.{.LET.len,.sh,.of
fset.#3D.0,.0,.0..//.Inserted.11/7/01#0A#0A........
.............//.Allow...SLCT.offset#0A.............
........//.or......SLCT.sh:offset#0A...............
......//.or......SLCT.len:sh:offset#0A#0A..........
...........offset.:#3D.rnexp(0)#0A#0A..............
.......IF.token#3Ds_colon.DO#0A....................
.{.sh.:#3D.offset#0A.......................offset.:
#3D.rnexp(0)#0A.....................}#0A...........
..........IF.token#3Ds_colon.DO#0A.................
....{.len.:#3D.sh#0A.......................sh.:#3D.
offset#0A.......................offset.:#3D.rnexp(0
)#0A.....................}#0A#0A...................
..RESULTIS.mk4(s_slct,.len,.sh,.offset)#0A.........
..........}#0A.#0A......CASE.s_lparen:.a.:#3D.rnexp
(0)#0A.....................UNLESS.token#3Ds_rparen.
DO.synerr("')'.missing")#0A.....................lex
()#0A.....................RESULTIS.a#0A.#0A......CA
SE.s_valof:..lex()#0A.....................RESULTIS.
mk2(s_valof,.rcom())#0A.#0A......CASE.s_vecap:..op.
:#3D.s_rv#0A......CASE.s_lv:#0A......CASE.s_rv:....
.RESULTIS.mk2(op,.rnexp(7))#0A.#0A......CASE.s_plus
:...RESULTIS.rnexp(5)#0A.#0A......CASE.s_minus:..a.
:#3D.rnexp(5)#0A.....................TEST.h1!a#3Ds_
number.THEN.h2!a.:#3D.-.h2!a#0A....................
....................ELSE.a.:#3D.mk2(s_neg,.a)#0A...
..................RESULTIS.a#0A.#0A......CASE.s_abs
:....RESULTIS.mk2(s_abs,.rnexp(5))#0A.#0A......CASE
.s_not:....RESULTIS.mk2(s_not,.rnexp(3))#0A.#0A....
..CASE.s_table:..lex()#0A.....................RESUL
TIS.mk2(s_table,.rexplist())#0A..}#0A}#0A.#0AAND.rn
exp(n).#3D.VALOF.{.lex();.RESULTIS.rexp(n).}#0A.#0A
AND.rexp(n).#3D.VALOF#0A{.LET.a,.b,.p.#3D.rbexp(),.
0,.0#0A#0A...UNTIL.nlpending.DO.#0A...{.LET.op.#3D.
token#0A.#0A......SWITCHON.op.INTO#0A.#0A......{.DE
FAULT:.......RESULTIS.a#0A.#0A.........CASE.s_lpare
n:.lex()#0A........................b.:#3D.0#0A.....
...................UNLESS.token#3Ds_rparen.DO.b.:#3D
.rexplist()#0A........................UNLESS.token#3D
s_rparen.DO.synerr("')'.missing")#0A...............
.........lex()#0A........................a.:#3D.mk4
(s_fnap,.a,.b,.0)#0A........................LOOP#0A
.#0A.........CASE.s_mthap:{.LET.e1.#3D.0#0A........
.................lex()#0A.........................U
NLESS.token#3Ds_lparen.DO.synerr("'('.missing")#0A.
........................lex()#0A...................
......b.:#3D.0#0A.........................UNLESS.to
ken#3Ds_rparen.DO.b.:#3D.rexplist()#0A.............
............IF.b#3D0.DO.synerr("argument.expression
.missing")#0A.........................UNLESS.token#3D
s_rparen.DO.synerr("')'.missing")#0A...............
..........lex()#0A.........................TEST.h1!
b#3Ds_comma#0A.........................THEN.e1.:#3D
.h2!b#0A.........................ELSE.e1.:#3D.b#0A.
........................a.:#3D.mk3(s_vecap,.mk2(s_r
v,.e1),.a)#0A.........................a.:#3D.mk4(s_
fnap,.a,.b,.0)#0A.........................LOOP#0A..
....................}#0A.#0A.........CASE.s_sbra:..
.b.:#3D.rnexp(0)...//.Inserted.11/6/02#0A..........
..............UNLESS.token#3Ds_sket.DO.synerr("']'.
missing")#0A........................lex()#0A.......
.................a.:#3D.mk3(s_vecap,.a,.b)#0A......
..................LOOP#0A.#0A.........CASE.s_of:...
..p.:#3D.8;.ENDCASE.//.Inserted.11/7/01#0A#0A......
...CASE.s_vecap:..p.:#3D.8;.ENDCASE#0A.........CASE
.s_byteap:.p.:#3D.8;.ENDCASE.//.Changed.from.7.on.1
6.Dec.1999#0A.........CASE.s_mult:#0A.........CASE.
s_div:#0A.........CASE.s_rem:....p.:#3D.6;.ENDCASE#0A
.........CASE.s_plus:#0A.........CASE.s_minus:..p.:
#3D.5;.ENDCASE#0A.#0A.........CASE.s_eq:CASE.s_le:C
ASE.s_ls:#0A.........CASE.s_ne:CASE.s_ge:CASE.s_gr:
#0A........................IF.n>#3D4.RESULTIS.a#0A.
.......................b.:#3D.rnexp(4)#0A..........
..............a.:#3D.mk3(op,.a,.b)#0A..............
..........WHILE..s_eq<#3Dtoken<#3Ds_ge.DO#0A.......
.................{.LET.c.#3D.b#0A..................
.........op.:#3D.token#0A..........................
.b.:#3D.rnexp(4)#0A...........................a.:#3D
.mk3(s_logand,.a,.mk3(op,.c,.b))#0A................
........}#0A........................LOOP#0A.#0A....
.....CASE.s_lshift:#0A.........CASE.s_rshift:.IF.n>
#3D4.RESULTIS.a#0A........................a.:#3D.mk
3(op,.a,.rnexp(4))#0A........................LOOP#0A
#0A.........CASE.s_logand:.p.:#3D.3;.ENDCASE#0A....
.....CASE.s_logor:..p.:#3D.2;.ENDCASE#0A.........CA
SE.s_eqv:#0A.........CASE.s_neqv:...p.:#3D.1;.ENDCA
SE#0A.#0A.........CASE.s_cond:...IF.n>#3D1.RESULTIS
.a#0A........................b.:#3D.rnexp(0)#0A....
....................UNLESS.token#3Ds_comma.DO#0A...
............................synerr("Bad.conditional
.expression")#0A........................a.:#3D.mk4(
s_cond,.a,.b,.rnexp(0))#0A........................L
OOP#0A......}#0A......#0A......IF.n>#3Dp.RESULTIS.a
#0A......a.:#3D.mk3(op,.a,.rnexp(p))#0A...}#0A...#0A
...RESULTIS.a#0A}#0A.#0ALET.rexplist().#3D.VALOF#0A
{.LET.res,.a.#3D.0,.rexp(0)#0A...LET.ptr.#3D.@res#0A
.#0A...WHILE.token#3Ds_comma.DO.{.!ptr.:#3D.mk3(s_c
omma,.a,.0)#0A............................ptr.:#3D.
@h3!(!ptr)#0A............................a.:#3D.rne
xp(0)#0A.........................}#0A...!ptr.:#3D.a
#0A...RESULTIS.res#0A}#0A.#0ALET.rdef(outerlevel).#3D
.VALOF#0A{.LET.n.#3D.rnamelist()#0A...LET.ln.#3D.li
neno#0A#0A...SWITCHON.token.INTO#0A.#0A...{.CASE.s_
lparen:#0A........{.LET.a.#3D.0#0A...........lex()#0A
...........UNLESS.h1!n#3Ds_name.DO.synerr("Bad.form
al.parameter")#0A...........IF.token#3Ds_name.DO.a.
:#3D.rnamelist()#0A...........UNLESS.token#3Ds_rpar
en.DO.synerr("')'.missing")#0A...........lex()#0A.#0A
...........IF.token#3Ds_be.DO#0A...........{.lex()#0A
..............RESULTIS.mk6(s_rtdef,.n,.a,.rcom(),.0
,.ln)#0A...........}#0A.#0A...........IF.token#3Ds_
eq.RESULTIS.mk6(s_fndef,.n,.a,.rnexp(0),.0,.ln)#0A.
#0A...........synerr("Bad.procedure.heading")#0A...
.....}#0A.#0A......DEFAULT:.synerr("Bad.declaration
")#0A.#0A......CASE.s_eq:#0A...........IF.outerleve
l.DO.synerr("Bad.outer.level.declaration")#0A......
.....lex()#0A...........IF.token#3Ds_vec.DO#0A.....
......{.UNLESS.h1!n#3Ds_name.DO.synerr("Name.requir
ed.before.#3D.VEC")#0A..............RESULTIS.mk4(s_
vecdef,.n,.rnexp(0),.ln)#0A...........}#0A.........
..RESULTIS.mk4(s_valdef,.n,.rexplist(),.ln)#0A...}#0A
}#0A.#0ALET.rbcom().#3D.VALOF#0A{.LET.a,.b,.op,.ln.
#3D.0,.0,.token,.lineno#0A.#0A..SWITCHON.token.INTO
#0A..{.DEFAULT:.RESULTIS.0#0A.#0A....CASE.s_name:CA
SE.s_number:CASE.s_string:CASE.s_lparen:#0A....CASE
.s_true:CASE.s_false:CASE.s_lv:CASE.s_rv:CASE.s_vec
ap:#0A....CASE.s_slct:........//.Inserted.11/7/01#0A
....CASE.s_plus:CASE.s_minus:CASE.s_abs:CASE.s_not:
#0A....CASE.s_table:CASE.s_valof:CASE.s_query:#0A..
..........//.All.tokens.that.can.start.an.expressio
n#2E#0A............a.:#3D.rexplist()#0A.#0A........
....IF.token#3Ds_ass.DO#0A............{.op.:#3D.tok
en#0A...............lex()#0A...............RESULTIS
.mk4(op,.a,.rexplist(),.ln)#0A............}#0A.#0A.
...........IF.token#3Ds_colon.DO#0A............{.UN
LESS.h1!a#3Ds_name.DO.synerr("Unexpected.':'")#0A..
.............lex()#0A...............RESULTIS.mk5(s_
colon,.a,.rbcom(),.0,.ln)#0A............}#0A.#0A...
.........IF.h1!a#3Ds_fnap.DO#0A............{.h1!a,.
h4!a.:#3D.s_rtap,.ln#0A...............RESULTIS.a#0A
............}#0A.#0A............synerr("Error.in.co
mmand")#0A............RESULTIS.a#0A.#0A....CASE.s_g
oto:#0A....CASE.s_resultis:#0A............RESULTIS.
mk3(op,.rnexp(0),.ln)#0A.#0A....CASE.s_if:#0A....CA
SE.s_unless:#0A....CASE.s_while:#0A....CASE.s_until
:#0A............a.:#3D.rnexp(0)#0A............IF.to
ken#3Ds_do.DO.lex()#0A............RESULTIS.mk4(op,.
a,.rcom(),.ln)#0A.#0A....CASE.s_test:#0A...........
.a.:#3D.rnexp(0)#0A............IF.token#3Ds_do.DO.l
ex()#0A............b.:#3D.rcom()#0A............UNLE
SS.token#3Ds_else.DO.synerr("ELSE.missing")#0A.....
.......lex()#0A............RESULTIS.mk5(s_test,.a,.
b,.rcom(),.ln)#0A.#0A....CASE.s_for:#0A.........{.L
ET.i,.j,.k.#3D.0,.0,.0#0A............lex()#0A......
......a.:#3D.rname()#0A............UNLESS.token#3Ds
_eq.DO.synerr("'#3D'.missing")#0A............i.:#3D
.rnexp(0)#0A............UNLESS.token#3Ds_to.DO.syne
rr("TO.missing")#0A............j.:#3D.rnexp(0)#0A..
..........IF.token#3Ds_by.DO.k.:#3D.rnexp(0)#0A....
........IF.token#3Ds_do.DO.lex()#0A............RESU
LTIS.mk7(s_for,.a,.i,.j,.k,.rcom(),.ln)#0A.........
}#0A.#0A....CASE.s_skip:#0A....CASE.s_loop:#0A....C
ASE.s_break:#0A....CASE.s_return:#0A....CASE.s_fini
sh:#0A....CASE.s_endcase:#0A............lex()#0A...
.........RESULTIS.mk2(op,.ln)#0A.#0A....CASE.s_swit
chon:#0A............a.:#3D.rnexp(0)#0A............U
NLESS.token#3Ds_into.DO.synerr("INTO.missing")#0A..
..........lex()#0A............{.LET.skipln.#3D.line
no#0A..............b.:#3D.rdsect(rdseq)#0A.........
.....UNLESS.b.DO#0A................b.:#3D.mk2(s_ski
p,.skipln).........//.MR.5/4/06#0A............}#0A.
...........RESULTIS.mk4(s_switchon,.a,.b,.ln)#0A.#0A
....CASE.s_case:#0A............a.:#3D.rnexp(0)#0A..
..........UNLESS.token#3Ds_colon.DO.synerr("Bad.CAS
E.label")#0A............lex()#0A............RESULTI
S.mk4(s_case,.a,.rbcom(),.ln)#0A.#0A....CASE.s_defa
ult:#0A............lex()#0A............UNLESS.token
#3Ds_colon.DO.synerr("Bad.DEFAULT.label")#0A.......
.....lex()#0A............RESULTIS.mk3(s_default,.rb
com(),.ln)#0A.#0A....CASE.s_lsect:#0A............a.
:#3D.rdsect(rdblockbody,.FALSE)#0A............UNLES
S.a.DO#0A..............a.:#3D.mk2(s_skip,.ln)......
..//.MR.5/4/06#0A............RESULTIS.a#0A..}#0A}#0A
#0AAND.rcom().#3D.VALOF#0A{.LET.a.#3D.rbcom()#0A.#0A
...//.Empty.section.brackets.{.}.form.SKIP.nodes,.M
R.22/6/05#0A...IF.a#3D0.DO.synerr("Error.in.command
")#0A.#0A...WHILE.token#3Ds_repeat.|.token#3Ds_repe
atwhile.|.token#3Ds_repeatuntil.DO#0A...{.LET.op,.l
n.#3D.token,.lineno#0A......UNLESS.op#3Ds_repeat.{.
a.:#3D.mk4(op,.a,.rnexp(0),.ln);.LOOP.}#0A......a.:
#3D.mk3(op,.a,.ln)#0A......lex()#0A...}#0A.#0A...RE
SULTIS.a#0A}#0A/*#0ALET.plist(x).BE#0A{.writef("*nN
ame.table.contents,.size.#3D.%n*n",.nametablesize)#0A
...FOR.i.#3D.0.TO.nametablesize-1.DO#0A...{.LET.p,.
n.#3D.nametable!i,.0#0A......UNTIL.p#3D0.DO.p,.n.:#3D
.p!1,.n+1#0A......writef("%i3:%n",.i,.n)#0A......p.
:#3D.nametable!i#0A......UNTIL.p#3D0.DO.{.writef(".
%s",.p+2);.p.:#3D.p!1..}#0A......newline()#0A...}#0A
}#0A*/#0ALET.plist(x,.n,.d).BE#0A{.LET.size,.ln.#3D
.0,.0#0A...LET.v.#3D.TABLE.0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0#0A#0A...IF.x#3D0.DO.{.writes("Nil")
;.RETURN..}#0A.#0A...SWITCHON.h1!x.INTO#0A...{.CASE
.s_number:.writen(h2!x);.........RETURN#0A.#0A.....
.CASE.s_name:...writes(x+2);..........RETURN#0A.#0A
......CASE.s_string:.writef("*"%s*"",x+1);.RETURN#0A
.#0A......CASE.s_for:....size,.ln.:#3D.6,.h7!x;..EN
DCASE#0A.#0A......CASE.s_fndef:CASE.s_rtdef:#0A....
.................size,.ln.:#3D.4,.h6!x;..ENDCASE#0A
#0A......CASE.s_cond:#0A......CASE.s_slct:.......//
.Inserted.11/7/01#0A.....................size.:#3D.
4;............ENDCASE#0A.#0A......CASE.s_test:CASE.
s_constdef:#0A.....................size,.ln.:#3D.4,
.h5!x;..ENDCASE#0A.#0A......CASE.s_needs:CASE.s_sec
tion:CASE.s_vecap:CASE.s_byteap:CASE.s_fnap:#0A....
..CASE.s_of:..//.Inserted.11/7/01#0A......CASE.s_mu
lt:CASE.s_div:CASE.s_rem:CASE.s_plus:CASE.s_minus:#0A
......CASE.s_eq:CASE.s_ne:CASE.s_ls:CASE.s_gr:CASE.
s_le:CASE.s_ge:#0A......CASE.s_lshift:CASE.s_rshift
:CASE.s_logand:CASE.s_logor:#0A......CASE.s_eqv:CAS
E.s_neqv:CASE.s_comma:#0A......CASE.s_seq:#0A......
...............size.:#3D.3;............ENDCASE#0A..
...................#0A......CASE.s_valdef:CASE.s_ve
cdef:#0A.....................size,.ln.:#3D.3,.h4!x;
..ENDCASE#0A#0A......CASE.s_colon:#0A..............
.......size,.ln.:#3D.3,.h5!x;..ENDCASE#0A.#0A......
CASE.s_and:#0A......CASE.s_ass:CASE.s_rtap:CASE.s_i
f:CASE.s_unless:#0A......CASE.s_while:CASE.s_until:
CASE.s_repeatwhile:#0A......CASE.s_repeatuntil:#0A.
.....CASE.s_switchon:CASE.s_case:CASE.s_let:#0A....
..CASE.s_manifest:CASE.s_static:CASE.s_global:#0A..
...................size,.ln.:#3D.3,.h4!x;..ENDCASE#0A
.#0A......CASE.s_valof:CASE.s_lv:CASE.s_rv:CASE.s_n
eg:CASE.s_not:#0A......CASE.s_table:CASE.s_abs:#0A.
....................size.:#3D.2;............ENDCASE
#0A.#0A......CASE.s_goto:CASE.s_resultis:CASE.s_rep
eat:CASE.s_default:#0A.....................size,.ln
.:#3D.2,.h3!x;..ENDCASE#0A.#0A......CASE.s_true:CAS
E.s_false:CASE.s_query:#0A.....................size
.:#3D.1;............ENDCASE#0A......#0A......CASE.s
_skip:.//.MR.22/6/05#0A......CASE.s_loop:CASE.s_bre
ak:CASE.s_return:#0A......CASE.s_finish:CASE.s_endc
ase:#0A.....................size,.ln.:#3D.1,.h2!x;.
.ENDCASE#0A#0A......DEFAULT:.......size.:#3D.1#0A..
.}#0A.#0A...IF.n#3Dd.DO.{.writes("Etc");.RETURN.}#0A
.#0A//...writef("Op.%n",.h1!x)#0A...writef(opname(h
1!x),.h1!x)#0A//.IF.ln>0.DO.writef("..line.%n",.ln)
#0A...IF.ln>0.DO#0A...{.LET.fno.#3D.ln>>20#0A.....L
ET.lno.#3D.ln.&.#23xFFFFF#0A.....LET.filename.#3D.s
ourcenamev!fno#0A.....writef("..")#0A.....IF.filena
me.DO.writef("%s",.filename)#0A.....writef("[%n]",.
lno)#0A...}#0A...FOR.i.#3D.2.TO.size.DO.{.newline()
#0A...........................FOR.j#3D0.TO.n-1.DO.w
rites(.v!j.)#0A...........................writes("*
*-")#0A...........................v!n.:#3D.i#3Dsize
->"..","!."#0A...........................plist(h1!(
x+i-1),.n+1,.d)#0A........................}#0A}#0A.
#0AAND.opname(op).#3D.VALOF.SWITCHON.op.INTO#0A{.DE
FAULT:............RESULTIS."Op.%n"#0A#0A..CASE.s_ab
s:.........RESULTIS."ABS"#0A..CASE.s_and:.........R
ESULTIS."AND"#0A..CASE.s_ass:.........RESULTIS."ASS
"#0A..CASE.s_be:..........RESULTIS."BE"#0A..CASE.s_
by:..........RESULTIS."BY"#0A..CASE.s_break:.......
RESULTIS."BREAK"#0A..CASE.s_byteap:......RESULTIS."
BYTEAP"#0A..CASE.s_case:........RESULTIS."CASE"#0A.
.CASE.s_colon:.......RESULTIS."COLON"#0A..CASE.s_co
mma:.......RESULTIS."COMMA"#0A..CASE.s_cond:.......
.RESULTIS."COND"#0A..CASE.s_constdef:....RESULTIS."
CONSTDEF"#0A..CASE.s_default:.....RESULTIS."DEFAULT
"#0A..CASE.s_div:.........RESULTIS."DIV"#0A..CASE.s
_do:..........RESULTIS."DO"#0A..CASE.s_dot:........
.RESULTIS."DOT"#0A..CASE.s_else:........RESULTIS."E
LSE"#0A..CASE.s_eof:.........RESULTIS."EOF"#0A..CAS
E.s_endcase:.....RESULTIS."ENDCASE"#0A..CASE.s_eq:.
.........RESULTIS."EQ"#0A..CASE.s_eqv:.........RESU
LTIS."EQV"#0A..CASE.s_false:.......RESULTIS."FALSE"
#0A..CASE.s_finish:......RESULTIS."FINISH"#0A..CASE
.s_fnap:........RESULTIS."FNAP"#0A..CASE.s_fndef:..
.....RESULTIS."FNDEF"#0A..CASE.s_for:.........RESUL
TIS."FOR"#0A..CASE.s_ge:..........RESULTIS."GE"#0A.
.CASE.s_get:.........RESULTIS."GET"#0A..CASE.s_glob
al:......RESULTIS."GLOBAL"#0A..CASE.s_goto:........
RESULTIS."GOTO"#0A..CASE.s_gr:..........RESULTIS."G
R"#0A..CASE.s_if:..........RESULTIS."IF"#0A..CASE.s
_into:........RESULTIS."INTO"#0A..CASE.s_le:.......
...RESULTIS."LE"#0A..CASE.s_let:.........RESULTIS."
LET"#0A..CASE.s_logand:......RESULTIS."LOGAND"#0A..
CASE.s_logor:.......RESULTIS."LOGOR"#0A..CASE.s_loo
p:........RESULTIS."LOOP"#0A..CASE.s_lparen:......R
ESULTIS."LPAREN"#0A..CASE.s_ls:..........RESULTIS."
LS"#0A..CASE.s_lsect:.......RESULTIS."LSECT"#0A..CA
SE.s_lshift:......RESULTIS."LSHIFT"#0A..CASE.s_lv:.
.........RESULTIS."LV"#0A..CASE.s_manifest:....RESU
LTIS."MANIFEST"#0A..CASE.s_mthap:.......RESULTIS."M
THAP"#0A..CASE.s_minus:.......RESULTIS."MINUS"#0A..
CASE.s_mult:........RESULTIS."MULT"#0A..CASE.s_name
:........RESULTIS."NAME"#0A..CASE.s_ne:..........RE
SULTIS."NE"#0A..CASE.s_needs:.......RESULTIS."NEEDS
"#0A..CASE.s_neg:.........RESULTIS."NEG"#0A..CASE.s
_neqv:........RESULTIS."NEQV"#0A..CASE.s_not:......
...RESULTIS."NOT"#0A..CASE.s_number:......RESULTIS.
"NUMBER"#0A..CASE.s_of:..........RESULTIS."OF"#0A..
CASE.s_plus:........RESULTIS."PLUS"#0A..CASE.s_quer
y:.......RESULTIS."QUERY"#0A..CASE.s_rem:.........R
ESULTIS."REM"#0A..CASE.s_repeat:......RESULTIS."REP
EAT"#0A..CASE.s_repeatuntil:.RESULTIS."REPEATUNTIL"
#0A..CASE.s_repeatwhile:.RESULTIS."REPEATWHILE"#0A.
.CASE.s_resultis:....RESULTIS."RESULTIS"#0A..CASE.s
_return:......RESULTIS."RETURN"#0A..CASE.s_rparen:.
.....RESULTIS."RPAREN"#0A..CASE.s_rshift:......RESU
LTIS."RSHIFT"#0A..CASE.s_rsect:.......RESULTIS."RSE
CT"#0A..CASE.s_rtap:........RESULTIS."RTAP"#0A..CAS
E.s_rtdef:.......RESULTIS."RTDEF"#0A..CASE.s_rv:...
.......RESULTIS."RV"#0A..CASE.s_sbra:........RESULT
IS."SBRA"#0A..CASE.s_section:.....RESULTIS."SECTION
"#0A..CASE.s_semicolon:...RESULTIS."SEMICOLON"#0A..
CASE.s_seq:.........RESULTIS."SEQ"#0A..CASE.s_sket:
........RESULTIS."SKET"#0A..CASE.s_skip:........RES
ULTIS."SKIP"#0A..CASE.s_static:......RESULTIS."STAT
IC"#0A..CASE.s_string:......RESULTIS."STRING"#0A..C
ASE.s_switchon:....RESULTIS."SWITCHON"#0A..CASE.s_t
able:.......RESULTIS."TABLE"#0A..CASE.s_test:......
..RESULTIS."TEST"#0A..CASE.s_to:..........RESULTIS.
"TO"#0A..CASE.s_true:........RESULTIS."TRUE"#0A..CA
SE.s_unless:......RESULTIS."UNLESS"#0A..CASE.s_unti
l:.......RESULTIS."UNTIL"#0A..CASE.s_valdef:......R
ESULTIS."VALDEF"#0A..CASE.s_valof:.......RESULTIS."
VALOF"#0A..CASE.s_vec:.........RESULTIS."VEC"#0A..C
ASE.s_vecap:.......RESULTIS."VECAP"#0A..CASE.s_vecd
ef:......RESULTIS."VECDEF"#0A..CASE.s_while:.......
RESULTIS."WHILE"#0A}#0A#0A//#2E#0A#0A//SECTION."TRN
"#0A#0A//....TRNHDR#0A.#0A//GET."libhdr"#0A//GET."b
cplfecg"#0A.#0AGLOBAL..{#0Atrnext:trng#0Atrans;.dec
lnames;.decldyn#0Adeclstat;.checkdistinct;.addname;
.cellwithname#0Atransdef;.scanlabel#0Adecllabels;.u
ndeclare#0Ajumpcond;.transswitch;.transfor#0Aassign
;.load;.fnbody;.loadlv;.loadlist#0Aisconst.evalcons
t;.transname;.xref#0Anextlab;.labnumber#0Anewblk#0A
dvec;.dvece;.dvecp;.dvect#0Acaselist;.casecount#0Ac
ontext;.comline;.procname#0Aresultlab;.defaultlab;.
endcaselab#0Alooplab;.breaklab;.ssp;.vecssp#0Agdefl
ist;.gdefcount#0Aoutstring;.out1;.out2#0A}#0A#0ALET
.nextlab().#3D.VALOF#0A{.labnumber.:#3D.labnumber.+
.1#0A..RESULTIS.labnumber#0A}#0A.#0AAND.trnerr(mess
,.a).BE#0A{.LET.fno.#3D.comline>>20#0A..LET.lno.#3D
.comline.&.#23xFFFFF#0A..LET.filename.#3D.sourcenam
ev!fno#0A..writes("Error.")#0A..UNLESS.procname#3D0
.DO.writef("in.%s.",.@h3!procname)#0A..writef("near
.")#0A..IF.filename.DO.writef("%s",.filename)#0A..w
ritef("[%n]:.",.lno)#0A..writef(mess,.a)#0A..newlin
e()#0A..errcount.:#3D.errcount.+.1#0A..IF.errcount.
>#3D.errmax.DO.{.writes("*nCompilation.aborted*n")#0A
.............................longjump(fin_p,.fin_l)
#0A...........................}#0A}#0A#0AAND.newblk
(x,.y,.z).#3D.VALOF#0A{.LET.p.#3D.dvect.-.3#0A..IF.
dvece>p.DO.{.errmax.:#3D.0........//.Make.it.fatal#2E
#0A..................trnerr("More.workspace.needed"
)#0A................}#0A..p!0,.p!1,.p!2.:#3D.x,.y,.
z#0A..dvect.:#3D.p#0A..RESULTIS.p#0A}#0A#0AAND.tran
slate(x).BE#0A{.dvec,..dvect.:#3D.treevec,.treep#0A
..h1!dvec,.h2!dvec,.h3!dvec.:#3D.0,.0,.0#0A..dvece.
:#3D.dvec+3#0A..dvecp.:#3D.dvece#0A//selectoutput(s
ysprint)#0A..FOR.i.#3D.0.TO.nametablesize-1.DO#0A..
{.LET.name.#3D.nametable!i#0A....UNTIL.name#3D0.DO#0A
....{.LET.next.#3D.h2!name#0A......h2!name.:#3D.0./
/.Mark.undeclared#0A//...writef("Undeclare.%s*n",.n
ame+2)#0A......name.:#3D.next#0A....}#0A..}#0A#0A..
gdeflist,.gdefcount.:#3D.0,.0#0A..caselist,.casecou
nt,.defaultlab.:#3D.0,.-1,.0#0A..resultlab,.breakla
b,.looplab,.endcaselab.:#3D.-2,.-2,.-2,.-2#0A..cont
ext,.comline,.procname,.labnumber.:#3D.0,.1,.0,.0#0A
..ssp,.vecssp.:#3D.savespacesize,.savespacesize#0A#0A
..WHILE.x~#3D0.&.(h1!x#3Ds_section.|.h1!x#3Ds_needs
).DO#0A..{.LET.op,.a.#3D.h1!x,.h2!x#0A....out1(op)#0A
....outstring(@h2!a)#0A....x:#3Dh3!x#0A..}#0A#0A..t
rans(x,.0)#0A..out2(s_global,.gdefcount)#0A..UNTIL.
gdeflist#3D0.DO.{.out2(h2!gdeflist,.h3!gdeflist)#0A
........................gdeflist.:#3D.h1!gdeflist#0A
......................}..#0A}#0A#0ALET.trnext(next)
.BE.{.IF.next<0.DO.out1(s_rtrn)#0A.................
.....IF.next>0.DO.out2(s_jump,.next)#0A............
........}#0A.#0ALET.trans(x,.next).BE#0A//.x.......
is.the.command.to.translate#0A//.next<0..compile.x.
followed.by.RTRN#0A//.next>0..compile.x.followed.by
.JUMP.next#0A//.next#3D0..compile.x.only#0A{.LET.sw
.#3D.FALSE#0A...IF.x#3D0.DO.{.trnext(next);.RETURN.
}#0A.#0A...SWITCHON.h1!x.INTO#0A...{.DEFAULT:.trner
r("Compiler.error.in.Trans");.RETURN#0A.#0A......CA
SE.s_let:#0A......{.LET.cc.#3D.casecount#0A........
.LET.e,.s,.s1.#3D.dvece,.ssp,.0#0A.........LET.v.#3D
.vecssp#0A.........casecount.:#3D.-1.//.Disallow.CA
SE.and.DEFAULT.labels#0A.........context,.comline.:
#3D.x,.h4!x#0A.........declnames(h2!x)#0A.........c
heckdistinct(e)#0A.........vecssp,.s1.:#3D.ssp,.ssp
#0A.........ssp.:#3D.s#0A.........context,.comline.
:#3D.x,.h4!x#0A.........transdef(h2!x)#0A.........U
NLESS.ssp#3Ds1.DO.trnerr("Lhs.and.rhs.do.not.match"
)#0A.........UNLESS.ssp#3Dvecssp.DO.{.ssp.:#3D.vecs
sp;.out2(s_stack,.ssp).}#0A.........out1(s_store)#0A
.........decllabels(h3!x)#0A.........trans(h3!x,.ne
xt)#0A.........vecssp.:#3D.v#0A.........UNLESS.ssp#3D
s.DO.out2(s_stack,.s)#0A.........ssp.:#3D.s#0A.....
....casecount.:#3D.cc#0A.........undeclare(e)#0A...
......RETURN#0A......}#0A.#0A......CASE.s_static:#0A
......CASE.s_global:#0A......CASE.s_manifest:#0A...
...{.LET.cc.#3D.casecount#0A.........LET.e,.s.#3D.d
vece,.ssp#0A.........AND.op.#3D.h1!x#0A.........AND
.y,.n.#3D.h2!x,.0#0A.........LET.prevk.#3D.-1#0A...
......#0A.........casecount.:#3D.-1.//.Disallow.CAS
E.and.DEFAULT.labels#0A.........context,.comline.:#3D
.x,.h4!x#0A.#0A.........UNTIL.y#3D0.DO#0A.........{
.context,.comline.:#3D.y,.h5!y#0A............n.:#3D
.h4!y.->.evalconst(h4!y),.prevk+1#0A............con
text,.comline.:#3D.y,.h5!y#0A............prevk.:#3D
.n#0A............IF.op#3Ds_static.DO.{.LET.k.#3D.n#0A
.................................n.:#3D.nextlab()#0A
.................................out2(s_datalab,.n)
#0A.................................out2(s_itemn,.k
)#0A..............................}#0A............I
F.op#3Ds_global.UNLESS.0<#3Dn<#3D65535.DO#0A.......
........trnerr("Global.number.too.large.for:.%s*n",
.@h3!(h3!y))#0A............addname(h3!y,.op,.n)#0A.
...........IF.xrefing.DO.xref(h3!y,#0A.............
..................(op#3Ds_global->"G:",op#3Ds_stati
c->"S:","M:"),#0A...............................n,#0A
...............................s_constdef#0A.......
.......................)#0A............y.:#3D.h2!y#0A
.........}#0A.#0A.........decllabels(h3!x)#0A......
...trans(h3!x,.next)#0A.........ssp.:#3D.s#0A......
...casecount.:#3D.cc#0A.........undeclare(e)#0A....
.....RETURN#0A......}#0A.#0A.#0A......CASE.s_ass:#0A
.........context,.comline.:#3D.x,.h4!x#0A.........a
ssign(h2!x,.h3!x)#0A.........trnext(next)#0A.......
..RETURN#0A.#0A......CASE.s_rtap:#0A......{.LET.s.#3D
.ssp#0A.........context,.comline.:#3D.x,.h4!x#0A...
......ssp.:#3D.ssp+savespacesize#0A.........out2(s_
stack,.ssp)#0A.........loadlist(h3!x)#0A.........lo
ad(h2!x)#0A.........out2(s_rtap,.s)#0A.........ssp.
:#3D.s#0A.........trnext(next)#0A.........RETURN#0A
......}#0A.#0A......CASE.s_goto:#0A.........context
,.comline.:#3D.x,.h3!x#0A.........load(h2!x)#0A....
.....out1(s_goto)#0A.........ssp.:#3D.ssp-1#0A.....
....RETURN#0A.#0A......CASE.s_colon:#0A.........con
text,.comline.:#3D.x,.h5!x#0A.........out2(s_lab,.h
4!x)#0A.........trans(h3!x,.next)#0A.........RETURN
#0A.#0A......CASE.s_unless:.sw.:#3D.TRUE#0A......CA
SE.s_if:#0A.........context,.comline.:#3D.x,.h4!x#0A
.........TEST.next>0.THEN.{.jumpcond(h2!x,.sw,.next
)#0A.............................trans(h3!x,.next)#0A
..........................}#0A.....................
ELSE.{.LET.l.#3D.nextlab()#0A......................
.......jumpcond(h2!x,.sw,.l)#0A....................
.........trans(h3!x,.next)#0A......................
.......out2(s_lab,.l)#0A...........................
..trnext(next)#0A..........................}#0A....
.....RETURN#0A.#0A......CASE.s_test:#0A......{.LET.
l,.m.#3D.nextlab(),.0#0A.........context,.comline.:
#3D.x,.h5!x#0A.........jumpcond(h2!x,.FALSE,.l)#0A.
........#0A.........TEST.next#3D0.THEN.{.m.:#3D.nex
tlab();.trans(h3!x,.m).}#0A.....................ELS
E.trans(h3!x,.next)#0A.....................#0A.....
....out2(s_lab,.l)#0A.........trans(h4!x,.next)#0A.
........UNLESS.m#3D0.DO.out2(s_lab,.m)#0A.........R
ETURN#0A......}#0A.#0A......CASE.s_loop:#0A........
.context,.comline.:#3D.x,.h2!x#0A.........IF.loopla
b<0.DO.trnerr("Illegal.use.of.LOOP")#0A.........IF.
looplab#3D0.DO.looplab.:#3D.nextlab()#0A.........ou
t2(s_jump,.looplab)#0A.........RETURN#0A.#0A......C
ASE.s_break:#0A.........context,.comline.:#3D.x,.h2
!x#0A.........IF.breaklab#3D-2.DO.trnerr("Illegal.u
se.of.BREAK")#0A.........IF.breaklab#3D-1.DO.{.out1
(s_rtrn);.RETURN.}#0A.........IF.breaklab#3D.0.DO.b
reaklab.:#3D.nextlab()#0A.........out2(s_jump,.brea
klab)#0A.........RETURN#0A.#0A......CASE.s_return:#0A
.........context,.comline.:#3D.x,.h2!x#0A.........o
ut1(s_rtrn)#0A.........RETURN#0A.#0A......CASE.s_sk
ip:..//.MR.05/4/06#0A.........trnext(next)#0A......
...RETURN#0A#0A......CASE.s_finish:#0A.........cont
ext,.comline.:#3D.x,.h2!x#0A.........out1(s_finish)
#0A.........RETURN#0A.#0A......CASE.s_resultis:#0A.
........context,.comline.:#3D.x,.h3!x#0A.........IF
.resultlab#3D-1.DO.{.fnbody(h2!x);.RETURN.}#0A.....
....UNLESS.resultlab>0.DO.trnerr("RESULTIS.out.of.c
ontext")#0A.........load(h2!x)#0A.........out2(s_re
s,.resultlab)#0A.........ssp.:#3D.ssp.-.1#0A.......
..RETURN#0A.#0A......CASE.s_while:.sw.:#3D.TRUE#0A.
.....CASE.s_until:#0A......{.LET.l,.m.#3D.nextlab()
,.next#0A.........LET.bl,.ll.#3D.breaklab,.looplab#0A
.........context,.comline.:#3D.x,.h4!x#0A.........b
reaklab,.looplab.:#3D.next,.0#0A.........IF.next<#3D
0.DO.m.:#3D.nextlab()#0A.........IF.next.#3D0.DO.br
eaklab.:#3D.m#0A.........jumpcond(h2!x,.~sw,.m)#0A.
........out2(s_lab,.l)#0A.........trans(h3!x,.0)#0A
.........UNLESS.looplab#3D0.DO.out2(s_lab,.looplab)
#0A.........context,.comline.:#3D.x,.h4!x#0A.......
..jumpcond(h2!x,.sw,.l)#0A.........IF.next<#3D0.DO.
out2(s_lab,.m)#0A.........trnext(next)#0A.........b
reaklab,.looplab.:#3D.bl,.ll#0A.........RETURN#0A..
....}#0A.#0A......CASE.s_repeatwhile:.sw.:#3D.TRUE#0A
......CASE.s_repeatuntil:#0A......{.LET.l,.bl,.ll.#3D
.nextlab(),.breaklab,.looplab#0A.........context,.c
omline.:#3D.x,.h4!x#0A.........breaklab,.looplab.:#3D
.next,.0#0A.........out2(s_lab,.l)#0A.........trans
(h2!x,.0)#0A.........UNLESS.looplab#3D0.DO.out2(s_l
ab,.looplab)#0A.........context,.comline.:#3D.x,.h4
!x#0A.........jumpcond(h3!x,.sw,.l)#0A#0A//.......U
NLESS.breaklab#3D0.DO.out2(s_lab,.breaklab)#0A.....
....IF.next#3D0.&.breaklab>0.DO.out2(s_lab,.breakla
b)#0A#0A.........trnext(next)#0A.........breaklab,.
looplab.:#3D.bl,.ll#0A.........RETURN#0A......}#0A.
#0A......CASE.s_repeat:#0A......{.LET.bl,.ll.#3D.br
eaklab,.looplab#0A.........context,.comline.:#3D.x,
.h4!x#0A.........breaklab,.looplab.:#3D.next,.nextl
ab()#0A.........out2(s_lab,.looplab)#0A#0A.........
trans(h2!x,.looplab)#0A#0A.........IF.next#3D0.&.br
eaklab>0.DO.out2(s_lab,.breaklab)#0A#0A.........bre
aklab,.looplab.:#3D.bl,.ll#0A.........RETURN#0A....
..}#0A.#0A......CASE.s_case:#0A......{.LET.l,.k,.cl
.#3D.nextlab(),.?,.caselist#0A.........context,.com
line.:#3D.x,.h4!x#0A.........k.:#3D.evalconst(h2!x)
#0A.........IF.casecount<0.DO.trnerr("CASE.label.ou
t.of.context")#0A.........UNTIL.cl#3D0.DO#0A.......
..{.IF.h2!cl#3Dk.DO.trnerr("'CASE.%n:'.occurs.twice
",.k)#0A............cl.:#3D.h1!cl#0A.........}#0A..
.......caselist.:#3D.newblk(caselist,.k,.l)#0A.....
....casecount.:#3D.casecount.+.1#0A.........out2(s_
lab,.l)#0A.........trans(h3!x,.next)#0A.........RET
URN#0A......}#0A.#0A......CASE.s_default:#0A.......
..context,.comline.:#3D.x,.h3!x#0A.........IF.casec
ount<0.|.defaultlab~#3D0.DO.trnerr("Bad.DEFAULT.lab
el")#0A.........defaultlab.:#3D.nextlab()#0A.......
..out2(s_lab,.defaultlab)#0A.........trans(h2!x,.ne
xt)#0A.........RETURN#0A.#0A......CASE.s_endcase:#0A
.........context,.comline.:#3D.x,.h2!x#0A.........I
F.endcaselab#3D-2.DO.trnerr("Illegal.use.of.ENDCASE
")#0A.........IF.endcaselab#3D-1.DO.out1(s_rtrn)#0A
.........//.endcaselab.is.never.equal.to.0#0A......
...IF.endcaselab>0..DO.out2(s_jump,.endcaselab)#0A.
........RETURN#0A.#0A......CASE.s_switchon:#0A.....
....transswitch(x,.next)#0A.........RETURN#0A.#0A..
....CASE.s_for:#0A.........transfor(x,.next)#0A....
.....RETURN#0A.#0A......CASE.s_seq:#0A.........tran
s(h2!x,.0)#0A.........x.:#3D.h3!x#0A...}#0A}.REPEAT
#0A#0ALET.declnames(x).BE.UNLESS.x#3D0.SWITCHON.h1!
x.INTO#0A.#0A{..DEFAULT:.......trnerr("Compiler.err
or.in.Declnames")#0A...................RETURN#0A.#0A
....CASE.s_vecdef:#0A....CASE.s_valdef:.context,.co
mline.:#3D.x,.h4!x#0A...................decldyn(h2!
x)#0A...................RETURN#0A.#0A....CASE.s_rtd
ef:#0A....CASE.s_fndef:..context,.comline.:#3D.x,.h
6!x#0A...................h5!x.:#3D.nextlab()#0A....
...............declstat(h2!x,.h5!x)#0A.............
......RETURN#0A.#0A....CASE.s_and:....declnames(h2!
x)#0A...................declnames(h3!x)#0A}#0A.#0AA
ND.decldyn(x).BE.UNLESS.x#3D0.DO#0A.#0A{.IF.h1!x#3D
s_name..DO.{.addname(x,.s_local,.ssp)#0A...........
..............//IF.xrefing.DO.xref(x,."P:",.ssp,.h1
!context)#0A.........................ssp.:#3D.ssp.+
.1#0A.........................RETURN#0A............
..........}#0A.#0A...IF.h1!x#3Ds_comma.DO.{.addname
(h2!x,.s_local,.ssp)#0A.........................//I
F.xrefing.DO.xref(h2!x,."P:",.ssp,.h1!context)#0A..
.......................ssp.:#3D.ssp.+.1#0A.........
................decldyn(h3!x)#0A...................
......RETURN#0A......................}#0A.#0A...trn
err("Compiler.error.in.Decldyn")#0A}#0A.#0AAND.decl
stat(x,.lab).BE#0A{.LET.c.#3D.cellwithname(x)#0A.#0A
..TEST.h2!c#3Ds_global.THEN.{.LET.gn.#3D.h3!c#0A...
.........................gdeflist.:#3D.newblk(gdefl
ist,.gn,.lab)#0A............................gdefcou
nt.:#3D.gdefcount.+.1#0A...........................
.addname(x,.s_global,.gn)#0A.......................
.....IF.xrefing.DO.xref(x,."G:",.gn,.h1!context)#0A
............................IF.gdefsing.DO.writef("
G%i3.#3D.%s*n",.gn,.@h3!x)#0A......................
....}#0A.....................ELSE.{.addname(x,.s_la
bel,.lab)#0A............................IF.xrefing.
DO.xref(x,."F:",.lab,.h1!context)#0A...............
...........}#0A}#0A.#0AAND.decllabels(x).BE#0A{.LET
.e.#3D.dvece#0A..scanlabels(x)#0A..checkdistinct(e)
#0A}#0A.#0AAND.checkdistinct(p).BE#0A{.LET.lim.#3D.
dvece.-.3#0A..FOR.q.#3D.p.TO.lim-3.BY.3.DO#0A..{.LE
T.n.#3D.h1!q#0A....FOR.c.#3D.q+3.TO.lim.BY.3.DO#0A.
.......IF.h1!c#3Dn.DO.trnerr("Name.%s.defined.twice
",.@h3!n)#0A..}#0A}#0A.#0AAND.addname(name,.k,.a).B
E#0A{.LET.p.#3D.dvece.+.3#0A..IF.p>dvect.DO.trnerr(
"More.workspace.needed")#0A..h1!dvece,.h2!dvece,.h3
!dvece.:#3D.name,.k,.a#0A..h2!name.:#3D.dvece.//.Re
member.the.declaration#0A..dvece.:#3D.p#0A}#0A.#0AA
ND.undeclare(e).BE.#0A{.FOR.t.#3D.e.TO.dvece-3.BY.3
.DO#0A..{.LET.name.#3D.h1!t#0A....h2!name.:#3D.0...
//.Forget.its.declaration#0A..}#0A..dvece.:#3D.e#0A
}#0A#0AAND.cellwithname(n).#3D.VALOF#0A{.LET.t.#3D.
h2!n#0A..IF.t.RESULTIS.t..//.It.has.been.looked.up.
before#0A..t.:#3D.dvece#0A..t.:#3D.t.-.3.REPEATUNTI
L.h1!t#3Dn.|.h1!t#3D0#0A..h2!n.:#3D.t..//.Associate
.the.name.with.declaration.item#0A..RESULTIS.t#0A}#0A
.#0AAND.scanlabels(x).BE.UNLESS.x#3D0.SWITCHON.h1!x
.INTO#0A.#0A{.CASE.s_colon:...context,.comline.:#3D
.x,.h5!x#0A..................h4!x.:#3D.nextlab()#0A
..................declstat(h2!x,.h4!x)#0A.#0A..CASE
.s_if:.CASE.s_unless:.CASE.s_while:.CASE.s_until:#0A
..CASE.s_switchon:.CASE.s_case:#0A.................
.scanlabels(h3!x)#0A..................RETURN#0A.#0A
..CASE.s_seq:.....scanlabels(h3!x)#0A.#0A..CASE.s_r
epeat:.CASE.s_repeatwhile:.CASE.s_repeatuntil:#0A..
CASE.s_default:.scanlabels(h2!x)#0A................
..RETURN#0A.#0A..CASE.s_test:....scanlabels(h3!x)#0A
..................scanlabels(h4!x)#0A..DEFAULT:....
....RETURN#0A}#0A.#0AAND.transdef(x).BE#0A{.LET.ctx
t,.ln.#3D.context,.comline#0A..transdyndefs(x)#0A..
context,.comline.:#3D.ctxt,.ln#0A..IF.statdefs(x).D
O.{.LET.l,.s#3D.nextlab(),.ssp#0A..................
....out2(s_jump,.l)#0A......................transst
atdefs(x)#0A......................ssp.:#3D.s#0A....
..................out2(s_stack,.ssp)#0A............
..........out2(s_lab,.l)#0A....................}#0A
..context,.comline.:#3D.ctxt,.ln#0A}#0A.#0A.#0AAND.
transdyndefs(x).BE.SWITCHON.h1!x.INTO#0A{.CASE.s_an
d:....transdyndefs(h2!x)#0A.................transdy
ndefs(h3!x)#0A.................RETURN#0A.#0A..CASE.
s_vecdef:.context,.comline.:#3D.x,.h4!x#0A.........
........out2(s_llp,.vecssp)#0A.................ssp.
:#3D.ssp.+.1#0A.................vecssp.:#3D.vecssp.
+.1.+.evalconst(h3!x)#0A.................RETURN#0A.
#0A..CASE.s_valdef:.context,.comline.:#3D.h3!x,.h4!
x#0A.................loadlist(h3!x)#0A.#0A..DEFAULT
:.......RETURN#0A}#0A.#0AAND.transstatdefs(x).BE.SW
ITCHON.h1!x.INTO#0A{.CASE.s_and:..transstatdefs(h2!
x)#0A...............transstatdefs(h3!x)#0A.........
......RETURN#0A.#0A..CASE.s_fndef:#0A..CASE.s_rtdef
:#0A.............{.LET.e,.p.#3D.dvece,.dvecp#0A....
...........AND.oldpn.#3D.procname#0A...............
AND.bl,.ll.#3D.breaklab,..looplab#0A...............
AND.rl,.el.#3D.resultlab,.endcaselab#0A............
...AND.cl,.cc.#3D.caselist,..casecount#0A..........
.....breaklab,..looplab....:#3D.-2,.-2#0A..........
.....resultlab,.endcaselab.:#3D.-2,.-2#0A..........
.....caselist,..casecount..:#3D..0,.-1#0A..........
.....procname.:#3D.h2!x#0A...............context,.c
omline.:#3D.x,.h6!x#0A...............out2(s_entry,.
h5!x)#0A...............outstring(@h3!procname)#0A..
.............ssp.:#3D.savespacesize#0A.............
..dvecp.:#3D.dvece#0A...............context,.comlin
e.:#3D.x,.h6!x#0A...............decldyn(h3!x)#0A...
............checkdistinct(e)#0A...............conte
xt,.comline.:#3D.h4!x,.h6!x#0A...............declla
bels(h4!x)#0A...............out2(s_save,.ssp)#0A...
............context,.comline.:#3D.h4!x,.h6!x#0A....
...........TEST.h1!x#3Ds_rtdef.THEN.trans(h4!x,.-1)
#0A.................................ELSE.fnbody(h4!
x)#0A...............out1(s_endproc)#0A.#0A.........
......breaklab,..looplab....:#3D.bl,.ll#0A.........
......resultlab,.endcaselab.:#3D.rl,.el#0A.........
......caselist,..casecount..:#3D.cl,.cc#0A.........
......procname.:#3D.oldpn#0A...............dvecp.:#3D
.p#0A...............undeclare(e)#0A.............}#0A
.#0A..DEFAULT:.....RETURN#0A}#0A.#0AAND.statdefs(x)
.#3D.h1!x#3Ds_fndef.|.h1!x#3Ds_rtdef.->.TRUE,#0A...
...............h1!x.~#3D.s_and...............->.FAL
SE,#0A..................statdefs(h2!x).............
.->.TRUE,#0A..................statdefs(h3!x)#0A.#0A
.#0ALET.jumpcond(x,.b,.l).BE#0A{.LET.sw.#3D.b#0A#0A
..SWITCHON.h1!x.INTO#0A..{.CASE.s_false:..b.:#3D.NO
T.b#0A....CASE.s_true:...IF.b.DO.out2(s_jump,.l)#0A
...................RETURN#0A.#0A....CASE.s_not:....
jumpcond(h2!x,.NOT.b,.l)#0A...................RETUR
N#0A.#0A....CASE.s_logand:.sw.:#3D.NOT.sw#0A....CAS
E.s_logor:..TEST.sw.THEN.{.jumpcond(h2!x,.b,.l)#0A.
.................................jumpcond(h3!x,.b,.
l)#0A..................................RETURN#0A...
.............................}#0A.#0A..............
.............ELSE.{.LET.m.#3D.nextlab()#0A.........
.........................jumpcond(h2!x,.NOT.b,.m)#0A
..................................jumpcond(h3!x,.b,
.l)#0A..................................out2(s_lab,
.m)#0A..................................RETURN#0A..
..............................}#0A.#0A....DEFAULT:.
......load(x)#0A...................out2(b.->.s_jt,.
s_jf,.l)#0A...................ssp.:#3D.ssp.-.1#0A..
.................RETURN#0A..}#0A}#0A.#0AAND.transsw
itch(x,.next).BE#0A{.LET.cl,.cc.#3D.caselist,.casec
ount.#0A..LET.dl,.el.#3D.defaultlab,.endcaselab#0A.
.LET.l,.dlab.#3D.nextlab(),.?#0A..caselist,.casecou
nt,.defaultlab.:#3D.0,.0,.0#0A..endcaselab.:#3D.nex
t#3D0.->.nextlab(),.next#0A.#0A..context,.comline.:
#3D.x,.h4!x#0A..out2(s_jump,.l)#0A..trans(h3!x,.end
caselab)#0A.#0A..context,.comline.:#3D.x,.h4!x#0A..
out2(s_lab,.l)#0A..load(h2!x)#0A#0A..dlab.:#3D.defa
ultlab>0.->.defaultlab,#0A..........endcaselab>0.->
.endcaselab,#0A..........nextlab()#0A#0A..out2(s_sw
itchon,.casecount);.out1(dlab).#0A..UNTIL.caselist#3D
0.DO.{.out2(h2!caselist,.h3!caselist)#0A...........
.............caselist.:#3D.h1!caselist#0A..........
............}#0A..ssp.:#3D.ssp.-.1#0A#0A..IF.next#3D
0................DO...out2(s_lab,.endcaselab)#0A..I
F.next<0.&.defaultlab#3D0.DO.{.out2(s_lab,.dlab)#0A
................................out1(s_rtrn)#0A....
..........................}#0A#0A..defaultlab,.endc
aselab.:#3D.dl,.el#0A..caselist,...casecount..:#3D.
cl,.cc#0A}#0A.#0AAND.transfor(x,.next).BE#0A{.LET.e
,.m,.blab.#3D.dvece,.nextlab(),.0#0A..LET.bl,.ll.#3D
.breaklab,.looplab#0A..LET.cc.#3D.casecount#0A..LET
.k,.n,.step.#3D.0,.0,.1#0A..LET.s.#3D.ssp#0A#0A..ca
secount.:#3D.-1..//.Disallow.CASE.and.DEFAULT.label
s#2E...#0A..breaklab,.looplab.:#3D.next,.0#0A...#0A
..context,.comline.:#3D.x,.h7!x#0A.#0A..addname(h2!
x,.s_local,.s)#0A..load(h3!x).......//.The.initial.
value#0A.#0A..//.Set.k,.n.to.load.the.end.limit#0A.
.TEST.h1!(h4!x)#3Ds_number.THEN....k,.n.:#3D.s_ln,.
h2!(h4!x)#0A..........................ELSE.{.k,.n.:
#3D.s_lp,.ssp#0A.................................lo
ad(h4!x)#0A...............................}#0A.#0A.
.UNLESS.h5!x#3D0.DO.step.:#3D.evalconst(h5!x)#0A.#0A
..out1(s_store)#0A...#0A..TEST.k#3Ds_ln.&.h1!(h3!x)
#3Ds_number..//.check.for.constant.limits.#0A..THEN
.{.LET.initval.#3D.h2!(h3!x)#0A.........IF.step>#3D
0.&.initval>n.|.step<0.&.initval<n.DO#0A.........{.
TEST.next<0#0A...........THEN.out1(s_rtrn)#0A......
.....ELSE.TEST.next>0#0A................THEN.out2(s
_jump,.next)#0A................ELSE.{.blab.:#3D.bre
aklab>0.->.breaklab,.nextlab()#0A..................
.....out2(s_jump,.blab)#0A.....................}#0A
.........}#0A.......}#0A..ELSE.{.IF.next<#3D0.DO.bl
ab.:#3D.nextlab()#0A.........out2(s_lp,.s)#0A......
...out2(k,.n)#0A.........out1(step>#3D0.->.s_gr,.s_
ls)#0A.........out2(s_jt,.next>0.->.next,.blab)#0A.
......}#0A#0A..IF.breaklab#3D0.&.blab>0.DO.breaklab
.:#3D.blab#0A...#0A..context,.comline.:#3D.x,.h7!x#0A
..decllabels(h6!x)#0A..context,.comline.:#3D.x,.h7!
x#0A..out2(s_lab,.m)#0A..trans(h6!x,.0)#0A..UNLESS.
looplab#3D0.DO.out2(s_lab,.looplab)#0A..out2(s_lp,.
s);.out2(s_ln,.step);.out1(s_plus);.out2(s_sp,.s)#0A
..out2(s_lp,s);.out2(k,n);.out1(step>#3D0.->.s_le,.
s_ge)#0A..out2(s_jt,.m)#0A.#0A..IF.next<#3D0.TEST.b
lab>0.#0A.............THEN..................out2(s_
lab,.blab)#0A.............ELSE.IF.breaklab>0.DO.out
2(s_lab,.breaklab)#0A..trnext(next)#0A..casecount.:
#3D.cc#0A..breaklab,.looplab,.ssp.:#3D.bl,.ll,.s#0A
..out2(s_stack,.ssp)#0A..undeclare(e)#0A}#0A.#0ALET
.load(x).BE#0A{.LET.op.#3D.h1!x#0A#0A..IF.isconst(x
).DO#0A..{.out2(s_ln,.evalconst(x))#0A....ssp.:#3D.
ssp.+.1#0A....RETURN#0A..}#0A.#0A..SWITCHON.op.INTO
#0A..{.DEFAULT:..........trnerr("Compiler.error.in.
Load")#0A......................out2(s_ln,.0)#0A....
..................ssp.:#3D.ssp.+.1#0A..............
........RETURN#0A.#0A....CASE.s_of:......{.LET.slct
.#3D.evalconst(h2!x).//.Inserted.11/7/01#0A........
..............LET.len.#3D.slct>>24#0A..............
........LET.sh..#3D.slct>>16.&.255#0A..............
........LET.offset.#3D.slct.&.#23xFFFF#0A..........
............load(h3!x)#0A......................IF.o
ffset.DO.{.out2(s_ln,.offset);.out1(s_plus).}#0A...
...................out1(s_rv)#0A...................
...IF.sh.DO.{.out2(s_ln,.sh);.out1(s_rshift).}#0A..
....................IF.len>0.&.len+sh<32.DO....//.A
ssume.a.32.bit.m/c#0A......................{.LET.ma
sk.#3D.(1<<len)-1#0A........................out2(s_
ln,.mask)#0A........................out1(s_logand)#0A
......................}#0A......................RET
URN#0A....................}#0A#0A....CASE.s_byteap:
....op:#3Ds_getbyte#0A#0A....CASE.s_div:.CASE.s_rem
:.CASE.s_minus:#0A....CASE.s_ls:.CASE.s_gr:.CASE.s_
le:.CASE.s_ge:#0A....CASE.s_lshift:.CASE.s_rshift:#0A
......................load(h2!x);.load(h3!x);.out1(
op)#0A......................ssp.:#3D.ssp.-.1#0A....
..................RETURN#0A.#0A....CASE.s_vecap:.CA
SE.s_mult:.CASE.s_plus:.CASE.s_eq:.CASE.s_ne:#0A...
.CASE.s_logand:.CASE.s_logor:.CASE.s_eqv:.CASE.s_ne
qv:#0A.........{.LET.a,.b.#3D.h2!x,.h3!x#0A........
...TEST.h1!a#3Ds_name.|#0A................h1!a#3Ds_
number.THEN.{.load(b);.load(a).}#0A................
..............ELSE.{.load(a);.load(b).}#0A.........
..TEST.op#3Ds_vecap.THEN.out2(s_plus,.s_rv)#0A.....
......................ELSE.out1(op)#0A...........ss
p.:#3D.ssp.-.1#0A...........RETURN#0A.........}#0A.
#0A....CASE.s_neg:.CASE.s_not:.CASE.s_rv:.CASE.s_ab
s:#0A......................load(h2!x)#0A...........
...........out1(op)#0A......................RETURN#0A
.#0A....CASE.s_true:.CASE.s_false:.CASE.s_query:#0A
......................out1(op)#0A..................
....ssp.:#3D.ssp.+.1#0A......................RETURN
#0A.#0A....CASE.s_lv:........loadlv(h2!x);.RETURN#0A
.#0A....CASE.s_number:....out2(s_ln,.h2!x);.ssp.:#3D
.ssp.+.1;.RETURN#0A.#0A....CASE.s_string:....out1(s
_lstr)#0A......................outstring(@.h2!x)#0A
......................ssp.:#3D.ssp.+.1#0A..........
............RETURN#0A.#0A....CASE.s_name:......tran
sname(x,.s_lp,.s_lg,.s_ll,.s_lf,.s_ln)#0A..........
............ssp.:#3D.ssp.+.1#0A....................
..RETURN#0A.#0A....CASE.s_valof:...{.LET.e,.rl,.cc.
#3D.dvece,.resultlab,.casecount#0A.................
.....casecount.:#3D.-1.//.Disallow.CASE.&.DEFAULT.l
abels#0A......................resultlab.:#3D.nextla
b()#0A......................decllabels(h2!x)#0A....
..................trans(h2!x,.0)#0A................
......out2(s_lab,.resultlab)#0A....................
..out2(s_rstack,.ssp)#0A......................ssp.:
#3D.ssp.+.1#0A......................resultlab,.case
count.:#3D.rl,.cc#0A......................undeclare
(e)#0A......................RETURN#0A..............
......}#0A.#0A....CASE.s_fnap:....{.LET.s.#3D.ssp#0A
......................ssp.:#3D.ssp.+.savespacesize#0A
......................out2(s_stack,.ssp)#0A........
..............loadlist(h3!x)#0A....................
..load(h2!x)#0A......................out2(s_fnap,.s
)#0A......................ssp.:#3D.s.+.1#0A........
..............RETURN#0A....................}#0A.#0A
....CASE.s_cond:....{.LET.l,.m.#3D.nextlab(),.nextl
ab()#0A......................LET.s.#3D.ssp#0A......
................jumpcond(h2!x,.FALSE,.m)#0A........
..............load(h3!x)#0A......................ou
t2(s_res,l)#0A......................ssp.:#3D.s;.out
2(s_stack,.ssp)#0A......................out2(s_lab,
.m)#0A......................load(h4!x)#0A..........
............out2(s_res,l)#0A......................o
ut2(s_lab,.l)#0A......................out2(s_rstack
,s)#0A......................RETURN#0A..............
......}#0A.#0A....CASE.s_table:...{.LET.m.#3D.nextl
ab()#0A......................out2(s_datalab,.m)#0A.
.....................x.:#3D.h2!x#0A................
......WHILE.h1!x#3Ds_comma.DO#0A...................
...{.out2(s_itemn,.evalconst(h2!x))#0A.............
...........x.:#3D.h3!x#0A......................}#0A
......................out2(s_itemn,.evalconst(x))#0A
......................out2(s_lll,.m)#0A............
..........ssp.:#3D.ssp.+.1#0A......................
RETURN#0A....................}#0A..}#0A}#0A#0AAND.f
nbody(x).BE.SWITCHON.h1!x.INTO#0A{.DEFAULT:........
.load(x)#0A...................out1(s_fnrn)#0A......
.............ssp.:#3D.ssp.-.1#0A...................
RETURN#0A...................#0A..CASE.s_valof:.{.LE
T.e,.rl,.cc.#3D.dvece,.resultlab,.casecount#0A.....
.............casecount.:#3D.-1.//.Disallow.CASE.&.D
EFAULT.labels#0A..................resultlab.:#3D.-1
#0A..................decllabels(h2!x)#0A...........
.......trans(h2!x,.-1)#0A..................resultla
b,.casecount.:#3D.rl,.cc#0A..................undecl
are(e)#0A..................RETURN#0A...............
.}#0A#0A..CASE.s_cond:..{.LET.l.#3D.nextlab()#0A...
...............jumpcond(h2!x,.FALSE,.l)#0A.........
.........fnbody(h3!x)#0A..................out2(s_la
b,.l)#0A..................fnbody(h4!x)#0A..........
......}#0A}#0A.#0A.#0AAND.loadlv(x).BE#0A{.UNLESS.x
#3D0.SWITCHON.h1!x.INTO#0A..{.DEFAULT:.........ENDC
ASE#0A.#0A....CASE.s_name:.....transname(x,.s_llp,.
s_llg,.s_lll,.0,.0)#0A.....................ssp.:#3D
.ssp.+.1#0A.....................RETURN#0A.#0A....CA
SE.s_rv:.......load(h2!x)#0A.....................RE
TURN#0A.#0A....CASE.s_vecap:.{.LET.a,.b.#3D.h2!x,.h
3!x#0A....................IF.h1!a#3Ds_name.DO.a,.b.
:#3D.h3!x,.h2!x#0A....................load(a)#0A...
.................load(b)#0A....................out1
(s_plus)#0A....................ssp.:#3D.ssp.-.1#0A.
...................RETURN#0A..................}#0A.
.}#0A#0A..trnerr("Ltype.expression.needed")#0A..out
2(s_ln,.0)#0A..ssp.:#3D.ssp.+.1#0A}#0A.#0AAND.loadl
ist(x).BE.UNLESS.x#3D0.TEST.h1!x#3Ds_comma#0A......
........................THEN.{.loadlist(h2!x);.load
list(h3!x).}#0A..............................ELSE.l
oad(x)#0A#0ALET.isconst(x).#3D.VALOF#0A{.IF.x#3D0.R
ESULTIS.FALSE#0A.#0A..SWITCHON.h1!x.INTO#0A..{.CASE
.s_name:#0A........{.LET.c.#3D.cellwithname(x)#0A..
........RESULTIS.h2!c#3Ds_manifest#0A........}#0A.#0A
....CASE.s_number:#0A....CASE.s_slct:#0A....CASE.s_
true:#0A....CASE.s_false:..RESULTIS.TRUE#0A.#0A....
CASE.s_neg:#0A....CASE.s_abs:#0A....CASE.s_not:....
RESULTIS.isconst(h2!x)#0A.......#0A....CASE.s_mult:
#0A....CASE.s_div:#0A....CASE.s_rem:#0A....CASE.s_p
lus:#0A....CASE.s_minus:#0A....CASE.s_lshift:#0A...
.CASE.s_rshift:#0A....CASE.s_logor:#0A....CASE.s_lo
gand:#0A....CASE.s_eqv:#0A....CASE.s_neqv:...IF.isc
onst(h2!x).&.isconst(h3!x).RESULTIS.TRUE#0A#0A....D
EFAULT:.......RESULTIS.FALSE#0A#0A...}#0A}#0A#0ALET
.evalconst(x).#3D.VALOF#0A{.LET.a,.b.#3D.0,.0#0A#0A
..IF.x#3D0.DO.{.trnerr("Compiler.error.in.Evalconst
")#0A..............RESULTIS.0#0A............}#0A.#0A
..SWITCHON.h1!x.INTO#0A..{.CASE.s_name:.{.LET.c.#3D
.cellwithname(x)#0A...................LET.k,.a.#3D.
h2!c,.h3!c#0A...................IF.k#3Ds_manifest.D
O#0A...................{.IF.xrefing.DO.xref(x,."M:"
,.a,.s_const)#0A.....................RESULTIS.a#0A.
..................}#0A...................IF.k.DO.tr
nerr("%s.must.be.a.manifest.constant",.@h3!x)#0A...
................trnerr("Name.'%s'.not.declared",.@h
3!x)#0A...................RESULTIS.0#0A............
.....}#0A.#0A....CASE.s_number:.RESULTIS.h2!x#0A...
.CASE.s_true:...RESULTIS.TRUE#0A....CASE.s_false:..
RESULTIS.FALSE#0A....CASE.s_query:..RESULTIS.0#0A.#0A
....CASE.s_slct:.{.LET.len,.sh,.offset.#3D.0,.0,.0.
....//.Inserted.11/7/01#0A...................IF.h2!
x.DO.len....:#3D.evalconst(h2!x)#0A................
...IF.h3!x.DO.sh.....:#3D.evalconst(h3!x)#0A.......
............IF.h4!x.DO.offset.:#3D.evalconst(h4!x)#0A
...................UNLESS.0<#3Dlen<#3D255.&.0<#3Dsh
<#3D255.&.0<#3Doffset<#3D#23xFFFF.DO#0A............
...........trnerr("A.field.too.large.in.a.SLCT.expr
ession")#0A...................RESULTIS.len<<24.|.sh
<<16.|.offset#0A.................}#0A#0A....CASE.s_
neg:#0A....CASE.s_abs:#0A....CASE.s_not:....a.:#3D.
evalconst(h2!x)#0A...................ENDCASE#0A....
...#0A....CASE.s_mult:#0A....CASE.s_div:#0A....CASE
.s_rem:#0A....CASE.s_plus:#0A....CASE.s_minus:#0A..
..CASE.s_lshift:#0A....CASE.s_rshift:#0A....CASE.s_
logor:#0A....CASE.s_logand:#0A....CASE.s_eqv:#0A...
.CASE.s_neqv:...a,.b.:#3D.evalconst(h2!x),.evalcons
t(h3!x)#0A...................ENDCASE#0A#0A....DEFAU
LT:#0A..}#0A....#0A..SWITCHON.h1!x.INTO#0A..{.CASE.
s_neg:....RESULTIS..-..a#0A....CASE.s_abs:....RESUL
TIS.ABS.a#0A....CASE.s_not:....RESULTIS.NOT.a#0A...
....#0A....CASE.s_mult:...RESULTIS.a...*....b#0A...
.CASE.s_plus:...RESULTIS.a...+....b#0A....CASE.s_mi
nus:..RESULTIS.a...-....b#0A....CASE.s_lshift:.RESU
LTIS.a...<<...b#0A....CASE.s_rshift:.RESULTIS.a...>
>...b#0A....CASE.s_logor:..RESULTIS.a...|....b#0A..
..CASE.s_logand:.RESULTIS.a...&....b#0A....CASE.s_e
qv:....RESULTIS.a..EQV...b#0A....CASE.s_neqv:...RES
ULTIS.a..NEQV..b#0A....CASE.s_div:....UNLESS.b#3D0.
RESULTIS.a.../....b#0A....CASE.s_rem:....UNLESS.b#3D
0.RESULTIS.a..REM...b#0A.......#0A....DEFAULT:#0A..
}#0A#0A..trnerr("Error.in.manifest.expression")#0A.
.RESULTIS.0#0A}#0A#0AAND.assign(x,.y).BE#0A{.IF.x#3D
0.|.y#3D0.DO.{.trnerr("Compiler.error.in.assign")#0A
....................RETURN#0A..................}#0A
#0A..UNLESS.(h1!x#3Ds_comma)#3D(h1!y#3Ds_comma).DO#0A
..................{.trnerr("Bad.simultaneous.assign
ment")#0A....................RETURN#0A.............
.....}#0A.#0A..SWITCHON.h1!x.INTO#0A..{.CASE.s_comm
a:..assign(h2!x,.h2!y)#0A...................assign(
h3!x,.h3!y)#0A...................RETURN#0A.#0A....C
ASE.s_name:...load(y)#0A...................transnam
e(x,.s_sp,.s_sg,.s_sl,.0,.0)#0A...................s
sp.:#3D.ssp.-.1#0A...................RETURN#0A.#0A.
...CASE.s_byteap:.load(y)#0A...................load
(h2!x)#0A...................load(h3!x)#0A..........
.........out1(s_putbyte)#0A...................ssp:#3D
ssp-3#0A...................RETURN#0A.#0A....CASE.s_
rv:#0A....CASE.s_vecap:..load(y)#0A................
...loadlv(x)#0A...................out1(s_stind)#0A.
..................ssp.:#3D.ssp.-.2#0A..............
.....RETURN#0A.#0A....CASE.s_of:...{.LET.slct.#3D.e
valconst(h2!x).//.Inserted.11/7/01#0A..............
.....LET.len.#3D.slct>>24#0A...................LET.
sh..#3D.slct>>16.&.255#0A...................LET.off
set.#3D.slct.&.#23xFFFF#0A...................LET.ma
sk.#3D.-1#0A...................IF.len>0.DO.mask.:#3D
.(1<<len)-1#0A...................mask.:#3D.mask<<sh
#0A//writef("Compiling.(SLCT.%n:%n:%n).OF.x.:#3D.y*
n",.len,.sh,.offset)#0A//writef("Load.y*n")#0A.....
..............load(y)#0A...................IF.sh.DO
#0A...................{.out2(s_ln,.sh)#0A..........
...........out1(s_lshift)#0A//writef("lshift.by.%n*
n",.sh)#0A...................}#0A#0A...............
....UNLESS.mask#3D-1.DO#0A...................{.load
(h3!x)#0A.....................IF.offset.DO#0A......
...............{.out2(s_ln,.offset)#0A.............
..........out1(s_plus)#0A.....................}#0A.
....................out1(s_rv)#0A..................
...out1(s_neqv)#0A.....................ssp.:#3D.ssp
-1#0A//writef("xor.x!%n*n",.offset)#0A.............
........out2(s_ln,.mask)#0A.....................out
1(s_logand).//.bits.to.change.in.x#0A//writef("mask
.with.%bW*n",.mask)#0A#0A.....................load(
h3!x)#0A.....................IF.offset.DO#0A.......
..............{.out2(s_ln,.offset)#0A..............
.........out1(s_plus)#0A.....................}#0A..
...................out1(s_rv)#0A...................
..out1(s_neqv)#0A//writef("xor.with.x!%n*n",.offset
)#0A.....................ssp.:#3D.ssp-1#0A.........
..........}#0A#0A...................load(h3!x)#0A..
.................IF.offset.DO#0A...................
{.out2(s_ln,.offset)#0A.....................out1(s_
plus)#0A...................}#0A...................o
ut1(s_stind)#0A//writef("store.in.x!%n*n",.offset)#0A
...................ssp.:#3D.ssp-2#0A//writef("stind
*n")#0A...................RETURN#0A................
.}#0A#0A....DEFAULT:.......trnerr("Ltype.expression
.needed")#0A..}#0A}#0A.#0A.#0AAND.transname(x,.p,.g
,.l,.f,.n).BE#0A{.LET.c.#3D.cellwithname(x)#0A..LET
.k,.a.#3D.h2!c,.h3!c#0A.#0A..SWITCHON.k.INTO#0A..{.
DEFAULT:........trnerr("Name.'%s'.not.declared",.@h
3!x)#0A...#0A....CASE.s_global:..out2(g,.a)#0A.....
...............IF.xrefing.DO.xref(x,."G:",.a,.g)#0A
....................RETURN#0A.#0A....CASE.s_local:.
..IF.c<dvecp.DO#0A.........................trnerr("
Dynamic.free.variable.'%s'.used",.@h3!x)#0A........
............out2(p,.a)#0A....................//IF.x
refing.DO.xref(x,."P:",.a,.p)#0A...................
.RETURN#0A.#0A....CASE.s_static:..out2(l,.a)#0A....
................IF.xrefing.DO.xref(x,."S:",.a,.l)#0A
....................RETURN#0A.#0A....CASE.s_label:.
..IF.f#3D0.DO#0A....................{.trnerr("Misus
e.of.entry.name.'%s'",.@h3!x)#0A...................
...f.:#3D.p#0A....................}#0A.............
.......out2(f,.a)#0A....................IF.xrefing.
DO.xref(x,."F:",.a,.f)#0A....................RETURN
#0A#0A....CASE.s_manifest:IF.n#3D0.DO#0A...........
.........{.trnerr("Misuse.of.MANIFEST.name.'%s'",.@
h3!x)#0A......................n.:#3D.p#0A..........
..........}#0A....................out2(n,.a)#0A....
................IF.xrefing.DO.xref(x,."M:",.a,.n)#0A
..}#0A}#0A#0AAND.xref(x,.kstr,.n,.op).BE#0A{.LET.na
me.#3D.@h3!x#0A..LET.fno.#3D.comline>>20#0A..LET.ln
o.#3D.comline.&.#23xFFFFF#0A..LET.file.#3D.sourcena
mev!fno#0A..writef("%s.%s%n.",.name,.kstr,.n)#0A#0A
..SWITCHON.op.INTO#0A..{.DEFAULT:.........writef("o
p%n",.op);.ENDCASE#0A....CASE.s_fndef:....writef("F
N");.......ENDCASE#0A....CASE.s_rtdef:....writef("R
T");.......ENDCASE#0A....CASE.s_valdef:...writef("V
AL");......ENDCASE#0A....CASE.s_vecdef:...writef("V
EC");......ENDCASE#0A....CASE.s_constdef:.writef("D
EF");......ENDCASE#0A....CASE.s_const:....writef("M
AN");......ENDCASE#0A....CASE.s_colon:....writef("L
AB");......ENDCASE#0A....CASE.s_sp:.......writef("S
P");.......ENDCASE#0A....CASE.s_sg:.......writef("S
G");.......ENDCASE#0A....CASE.s_sl:.......writef("S
L");.......ENDCASE#0A....CASE.s_llp:......writef("L
LP");......ENDCASE#0A....CASE.s_llg:......writef("L
LG");......ENDCASE#0A....CASE.s_lll:......writef("L
LL");......ENDCASE#0A....CASE.s_lp:.......writef("L
P");.......ENDCASE#0A....CASE.s_lg:.......writef("L
G");.......ENDCASE#0A....CASE.s_ll:.......writef("L
L");.......ENDCASE#0A....CASE.s_lf:.......writef("L
F");.......ENDCASE#0A....CASE.s_ln:.......writef("L
N");.......ENDCASE#0A..}#0A..wrch('.')#0A..IF.file.
DO.writef("%s",.file)#0A..writef("[%n].",.lno)#0A#0A
..prctxt(context)#0A#0A..newline()#0A}#0A#0AAND.prc
txt(x).BE.IF.x.DO.#0A{.LET.op.#3D.h1!x#0A..SWITCHON
.op.INTO#0A..{.DEFAULT:..prctxte(x,.4,.0);.RETURN#0A
#0A....CASE.s_fndef:#0A.........writef("LET.")#0A..
.......prctxte(h2!x,.5,.0)#0A.........wrch('(')#0A.
........prctxte(h3!x,.7,.0)#0A.........writef(")#3D
#2E#2E")#0A.........RETURN#0A#0A....CASE.s_rtdef:#0A
.........writef("LET.")#0A.........prctxte(h2!x,.5,
.0)#0A.........wrch('(')#0A.........prctxte(h3!x,.7
,.0)#0A.........writef(")BE#2E#2E")#0A.........RETU
RN#0A#0A....CASE.s_valdef:#0A.........writef("LET."
)#0A.........prctxte(h2!x,.5,.0)#0A.........writef(
"#3D")#0A.........prctxte(h3!x,.5,.0)#0A.........RE
TURN#0A#0A....CASE.s_vecdef:#0A.........writef("LET
.")#0A.........prctxte(h2!x,.5,.0)#0A.........write
f("#3DVEC.")#0A.........prctxte(h3!x,.5,.0)#0A.....
....RETURN#0A#0A....CASE.s_constdef:#0A.........prc
txte(h3!x,.5,.0)#0A.........writef("#3D")#0A.......
..prctxte(h4!x,.5,.0)#0A.........RETURN#0A#0A....CA
SE.s_let:#0A.........writef("LET.")#0A.........prct
xtd(h2!x,.2)#0A.........writef(";.")#0A.........prc
txtc(h3!x,.2)#0A.........RETURN#0A.#0A....CASE.s_st
atic:....writef("STATIC#2E#2E");....RETURN#0A....CA
SE.s_global:....writef("GLOBAL#2E#2E");....RETURN#0A
....CASE.s_manifest:..writef("MANIFEST#2E#2E");..RE
TURN#0A#0A....CASE.s_ass:#0A.........prctxte(h2!x,.
4,.0)#0A.........writef(":#3D")#0A.........prctxte(
h3!x,.4,.0)#0A.........RETURN#0A.#0A....CASE.s_rtap
:#0A.........prctxte(h2!x,.2,.12)#0A.........writef
("(")#0A.........prctxte(h3!x,.3,.0)#0A.........wri
tef(")")#0A.........RETURN#0A.#0A....CASE.s_goto:#0A
.........writef("GOTO.")#0A.........prctxte(h2!x,.4
,.0)#0A.........RETURN#0A.#0A....CASE.s_colon:#0A..
.......prctxte(h2!x,.2,.0)#0A.........writef(":")#0A
.........prctxt(h3!x,.3)#0A.........RETURN#0A.#0A..
..CASE.s_unless:#0A....CASE.s_if:#0A....CASE.s_whil
e:#0A....CASE.s_until:#0A.........writef(op#3Ds_unl
ess->"UNLESS.",#0A................op#3Ds_if->"IF.",
#0A................op#3Ds_until->"UNTIL.",#0A......
.........."WHILE."#0A...............)#0A.........pr
ctxte(h2!x,.4,.0)#0A.........writef(".DO.")#0A.....
....prctxtc(h3!x,.3)#0A.........RETURN#0A#0A.#0A...
.CASE.s_test:#0A.........writef("TEST.")#0A........
.prctxte(h2!x,.4,.0)#0A.........writef(".THEN.")#0A
.........prctxtc(h3!x,.2)#0A.........writef(".ELSE.
")#0A.........prctxtc(h4!x,.2)#0A.........RETURN#0A
.#0A....CASE.s_loop:#0A.........writef("LOOP")#0A..
.......RETURN#0A.#0A....CASE.s_skip:#0A.........wri
tef("{}")#0A.........RETURN#0A.#0A....CASE.s_break:
#0A.........writef("BREAK")#0A.........RETURN#0A.#0A
....CASE.s_return:#0A.........writef("RETURN")#0A..
.......RETURN#0A.#0A....CASE.s_finish:#0A.........w
ritef("FINISH")#0A.........RETURN#0A.#0A....CASE.s_
resultis:#0A.........writef("RESULTIS.")#0A........
.prctxte(h2!x,.4,.0)#0A.........RETURN#0A.#0A....CA
SE.s_repeatwhile:#0A....CASE.s_repeatuntil:#0A.....
....prctxtc(h2!x,.4)#0A.........writef(op#3Ds_repea
twhile.->.".REPEATWHILE.",.".REPEATUNTIL.")#0A.....
....prctxte(h3!x,.4,.0)#0A.........RETURN#0A.#0A...
.CASE.s_repeat:#0A.........prctxtc(h2!x,.4)#0A.....
....writef(".REPEAT")#0A.........RETURN#0A.#0A....C
ASE.s_case:#0A.........writef("CASE.")#0A.........p
rctxte(h2!x,.4,.0)#0A.........writef(":#2E#2E.")#0A
.........RETURN#0A.#0A....CASE.s_default:#0A.......
..writef("DEFAULT:#2E#2E")#0A.........RETURN#0A.#0A
....CASE.s_endcase:#0A.........writef("ENDCASE")#0A
.........RETURN#0A.#0A....CASE.s_switchon:#0A......
...writef("SWITCHON.")#0A.........prctxte(h2!x,.4,.
0)#0A.........writef(".INTO#2E#2E")#0A.........RETU
RN#0A.#0A....CASE.s_for:#0A.........writef("FOR.")#0A
.........prctxte(h2!x,.4,.0)#0A.........writef("#3D
")#0A.........prctxte(h3!x,.4,.0)#0A.........writef
(".TO.")#0A.........prctxte(h4!x,.4,.0)#0A.........
IF.h5!x.DO.{.writef(".BY.");.prctxte(h5!x,.4,.0).}#0A
.........writef(".DO#2E#2E")#0A.........RETURN#0A.#0A
....CASE.s_seq:#0A.........prctxtc(h2!x,.4)#0A.....
....writef(";")#0A.........prctxtc(h3!x,.4)#0A.....
....RETURN#0A..}#0A}#0A#0AAND.prctxtd(x,.d).BE.writ
ef("#2E#2E")#0AAND.prctxtc(x,.d).BE.writef("#2E#2E"
)#0A#0AAND.prctxte(x,.d,.prec).BE.IF.x.DO#0A{.LET.o
p.#3D.h1!x#0A#0A..SWITCHON.op.INTO#0A..{.DEFAULT:.E
NDCASE#0A#0A....CASE.s_number:.#0A.................
{.LET.n.#3D.h2!x#0A...................TEST.-1_000_0
00<#3Dn<#3D1_000_000#0A...................THEN.writ
ef("%n",.n)#0A...................ELSE.writef("#23x%
x8",.n)#0A...................RETURN#0A.............
....}.#0A....CASE.s_name:...writef("%s",.@h3!x);...
.....RETURN#0A....CASE.s_true:...writef("TRUE");...
..........RETURN#0A....CASE.s_false:..writef("FALSE
");............RETURN#0A....CASE.s_query:..wrch('?'
);..................RETURN#0A#0A....CASE.s_string:.
#0A.................{.LET.s.#3D.@h2!x#0A...........
........LET.len.#3D.s%0#0A...................wrch('
"')#0A...................FOR.i.#3D.1.TO.len.DO#0A..
.................{.LET.ch.#3D.s%i#0A...............
......IF.i#3D6.&.len>6+8.DO.{.writef("'");.LOOP.}#0A
.....................IF.i<#3D6.|.i>len-8.DO.//.Firs
t.5.and.last.8.chars#0A.....................{.SWITC
HON.ch.INTO#0A.......................{.CASE.'**':.w
ritef("****");.LOOP#0A.........................CASE
.'*"':.writef("***"");.LOOP#0A.....................
....CASE.'*n':.writef("**n");..LOOP#0A.............
..........}#0A.......................UNLESS.32<#3Dc
h<#3D127.DO.ch.:#3D.'?'#0A.......................wr
ch(ch)#0A.....................}#0A.................
..}#0A...................wrch('"')#0A..............
.....RETURN#0A.................}#0A#0A..}#0A#0A..IF
.d#3D0.DO.{.writef("#2E#2E#2E");.RETURN.}#0A#0A..IF
.prec>#3D12.DO.{.wrch('(');.prctxte(x,.d,.0);.wrch(
')');.RETURN.}#0A#0A..SWITCHON.op.INTO#0A..{.DEFAUL
T:.ENDCASE#0A#0A....CASE.s_fnap:#0A.........prctxte
(h2!x,.d-1,.11)#0A.........wrch('(')#0A.........prc
txte(h3!x,.d-1,.0)#0A.........wrch(')')#0A.........
RETURN#0A..}#0A#0A..IF.prec>#3D11.DO.{.wrch('(');.p
rctxte(x,.d,.0);.wrch(')');.RETURN.}#0A#0A..SWITCHO
N.op.INTO#0A..{.DEFAULT:.ENDCASE#0A#0A....CASE.s_of
:#0A....CASE.s_byteap:#0A....CASE.s_vecap:#0A......
...prctxte(h2!x,.d-1,.10)#0A.........writes(op#3Ds_
of->"::",.op#3Ds_byteap->"%",."!")#0A.........prctx
te(h3!x,.d-1,.10)#0A.........RETURN#0A#0A....CASE.s
_rv:#0A....CASE.s_lv:#0A.........writef(op#3Ds_rv->
"!","@")#0A.........prctxte(h2!x,.d-1,.10)#0A......
...RETURN#0A..}#0A#0A..IF.prec>#3D10.DO.{.wrch('(')
;.prctxte(x,.d,.0);.wrch(')');.RETURN.}#0A#0A..SWIT
CHON.op.INTO#0A..{.DEFAULT:.ENDCASE#0A....CASE.s_mu
lt:.CASE.s_div:.CASE.s_rem:#0A.........prctxte(h2!x
,.d-1,.9)#0A.........writef(op#3Ds_mult->"**",.op#3D
s_div->"/",.".REM.")#0A.........prctxte(h3!x,.d-1,.
9)#0A.........RETURN#0A..}#0A#0A..IF.prec>#3D9.DO.{
.wrch('(');.prctxte(x,.d,.0);.wrch(')');.RETURN.}#0A
#0A..SWITCHON.op.INTO#0A..{.DEFAULT:.ENDCASE#0A....
CASE.s_plus:#0A....CASE.s_minus:#0A.........prctxte
(h2!x,.d-1,.8)#0A.........writef(op#3Ds_plus->"+","
-")#0A.........prctxte(h3!x,.d-1,.8)#0A.........RET
URN#0A#0A....CASE.s_neg:#0A....CASE.s_abs:#0A......
...writef(op#3Ds_neg->"-","ABS.")#0A.........prctxt
e(h2!x,.d-1,.8)#0A.........RETURN#0A#0A..}#0A#0A..I
F.prec>#3D8.DO.{.wrch('(');.prctxte(x,.d,.0);.wrch(
')');.RETURN.}#0A#0A..SWITCHON.op.INTO#0A..{.DEFAUL
T:.ENDCASE#0A....CASE.s_eq:.CASE.s_ne:#0A.........p
rctxte(h2!x,.d-1,.7)#0A.........writef(op#3Ds_eq->"
#3D","~#3D")#0A.........prctxte(h3!x,.d-1,.7)#0A...
......RETURN#0A....CASE.s_ls:.CASE.s_gr:#0A........
.prctxte(h2!x,.d-1,.7)#0A.........writef(op#3Ds_ls-
>"<",">")#0A.........prctxte(h3!x,.d-1,.7)#0A......
...RETURN#0A....CASE.s_le:.CASE.s_ge:#0A.........pr
ctxte(h2!x,.d-1,.7)#0A.........writef(op#3Ds_le->"<
#3D",">#3D")#0A.........prctxte(h3!x,.d-1,.7)#0A...
......RETURN#0A..}#0A#0A..IF.prec>#3D7.DO.{.wrch('(
');.prctxte(x,.d,.0);.wrch(')');.RETURN.}#0A#0A..SW
ITCHON.op.INTO#0A..{.DEFAULT:.ENDCASE#0A....CASE.s_
lshift:.CASE.s_rshift:#0A.........prctxte(h2!x,.d-1
,.6)#0A.........writef(op#3Ds_lshift->"<<",">>")#0A
.........prctxte(h3!x,.d-1,.6)#0A.........RETURN#0A
..}#0A#0A..IF.prec>#3D6.DO.{.wrch('(');.prctxte(x,.
d,.0);.wrch(')');.RETURN.}#0A#0A..SWITCHON.op.INTO#0A
..{.DEFAULT:.ENDCASE#0A....CASE.s_not:#0A.........w
rch('~')#0A.........prctxte(h2!x,.d-1,.5)#0A.......
..RETURN#0A..}#0A#0A..IF.prec>#3D5.DO.{.wrch('(');.
prctxte(x,.d,.0);.wrch(')');.RETURN.}#0A#0A..SWITCH
ON.op.INTO#0A..{.DEFAULT:.ENDCASE#0A....CASE.s_loga
nd:#0A.........prctxte(h2!x,.d-1,.4)#0A.........wrc
h('&')#0A.........prctxte(h3!x,.d-1,.4)#0A.........
RETURN#0A..}#0A#0A..IF.prec>#3D4.DO.{.wrch('(');.pr
ctxte(x,.d,.0);.wrch(')');.RETURN.}#0A#0A..SWITCHON
.op.INTO#0A..{.DEFAULT:.ENDCASE#0A....CASE.s_logor:
#0A.........prctxte(h2!x,.d-1,.3)#0A.........wrch('
|')#0A.........prctxte(h3!x,.d-1,.3)#0A.........RET
URN#0A..}#0A#0A..IF.prec>#3D3.DO.{.wrch('(');.prctx
te(x,.d,.0);.wrch(')');.RETURN.}#0A#0A..SWITCHON.op
.INTO#0A..{.DEFAULT:.ENDCASE#0A....CASE.s_eqv:#0A..
..CASE.s_neqv:#0A.........prctxte(h2!x,.d-1,.2)#0A.
........writef(op#3Ds_eqv->".EQV.",".XOR.")#0A.....
....prctxte(h3!x,.d-1,.2)#0A.........RETURN#0A#0A..
}#0A#0A..IF.prec>#3D2.DO.{.wrch('(');.prctxte(x,.d,
.0);.wrch(')');.RETURN.}#0A#0A..SWITCHON.op.INTO#0A
..{.DEFAULT:.ENDCASE#0A....CASE.s_cond:#0A.........
prctxte(h2!x,.d-1,.1)#0A.........writef("->")#0A...
......prctxte(h3!x,.d-1,.1)#0A.........writef(",")#0A
.........prctxte(h4!x,.d-1,.1)#0A.........RETURN#0A
..}#0A#0A..IF.prec>#3D1.DO.{.wrch('(');.prctxte(x,.
d,.0);.wrch(')');.RETURN.}#0A#0A..SWITCHON.op.INTO#0A
..{.DEFAULT:.writef("Op%n",.op);.RETURN#0A#0A....CA
SE.s_table:#0A.........writef("TABLE.")#0A.........
prctxte(h2!x,.d-1,.0)#0A.........RETURN#0A.........
#0A....CASE.s_valof:#0A.........writef("VALOF.{")#0A
.........prctxtc(h2!x,.d-1)#0A.........wrch('}')#0A
.........RETURN#0A#0A....CASE.s_comma:#0A.........p
rctxte(h2!x,.d-1,.0)#0A.........writef(",")#0A.....
....prctxte(h3!x,.d-1,.0)#0A.........RETURN#0A..}#0A
}#0A#0A#0AAND.out1(x).BE.wrn(x)#0A.#0AAND.out2(x,.y
).BE.{.out1(x);.out1(y).}#0A.#0AAND.outstring(s).BE
.FOR.i.#3D.0.TO.s%0.DO.out1(s%i)#0A

######cintcode/com/makeinit.b#
/*.MakeInit.--.Construct.an.initialisation.file.for
.a#0A*..multi-file.NATBCPL.application#2E#0A*..Writ
ten.by.Colin.Liebenrood..(cjlieben@waitrose#2Ecom)#0A
*#0A*..Slightly.modified.by.Martin.Richards.(mr@cl#2E
cam#2Eac#2Euk)#0A*..to.give.it.the.following.usage:
#0A*#0A*.makeinit.aaa#2Eb.bbb#2Eb.#2E#2E#2E.kkk#2Eb
.to.init#2Ec.stacksize.20000.gsize.2000#0A*#0A*.$Lo
g:.makeinit#2Eb,v.$#0A*#0A*.Revision.1#2E9..2009/09
/07.12:50:13..martin#0A*.Used.BCPLWORD.instead.of.W
ORD.plus.other.minor.changes#0A*.Changed.performget
.to.be.compatible.with.the.latest.bcplfe#0A*#0A*.Re
vision.1#2E8..2004/04/25.07:38:23..martin#0A*.Made.
GET.directives.use.BCPLHDRS.environment.variable#0A
*#0A*.Revision.1#2E7..2004/04/21.16:35:00..martin#0A
*.Changed.rdargs.format.to.",,,,,,,,,,TO/k/a,STKSIZ
E/k,GLOBSIZE/k"#0A*#0A*.Revision.1#2E6..2004/04/03.
14:53:05..colin#0A*.Revised.order.of.arguments,.to.
allow.input.from.stdin.with.named.output.only#0A*.U
se.rdargs()-style.command.line#2E..Protect.against.
no.files.in.input-list#2E#0A*.Tidy.version-number.d
isplay#2E#0A*#0A*.Revision.1#2E5..2004/04/01.16:12:
22..colin#0A*.Made.target.stack-size.and.global.vec
tor.size.into.parameters#2E#0A*.Altered.emitted.cod
e.to.conform.to.revised.function.prototypes.in.bcpl
#2Eh#0A*#0A*.Revision.1#2E4..2004/03/21.17:45:13..c
olin#0A*.Fix.coding.error#0A*#0A*.Revision.1#2E3..2
004/03/21.17:42:03..colin#0A*.Fully.working?.with.c
omments.updated#0A*#0A*.Revision.1#2E2..2004/03/19.
20:17:00..colin#0A*.Handling.multiple.files.and.sto
ring.section-names#2E.Wrong.status.returns#0A*#0A*.
Revision.1#2E1..2004/03/18.15:54:10..colin#0A*.Init
ial.revision#0A*#0A*#0A*/#0A#0ASECTION."MakeInit"#0A
#0AGET."libhdr"#0A.#0AMANIFEST.{.#0A//.Used.in.scan
forsection(),.lex().and.friends#0As_number#3D1;.s_n
ame;.s_string;.s_true;.s_false#0As_div;.s_logand;.s
_needs;.s_section#0As_end;.s_lsect;.s_rsect;.s_get#0A
s_dot;.s_eof#0A#0Ah1#3D0;.h2;.h3;.h4............//.
.Selectors#0Abt_name#3D0;.bt_left;.bt_right;.bt_fil
e#0A#0Ac_backspace.#3D..8........//.Character.const
ants#0Ac_tab.......#3D..9#0Ac_newline...#3D.10#0Ac_
newpage...#3D.12#0Ac_return....#3D.13#0Ac_escape...
.#3D.27#0Ac_space.....#3D.32#0A#0Anametablesize.#3D
.541#0Aworksize......#3D.40000#0Astoresize.....#3D.
5000#0A}#0A.#0AGLOBAL.{#0A//.Variables.for.scanfors
ection().etc#0Agetstreams:ug;.charv;.token;.wordnod
e;.ch#0Ahdrs#0Askiptag;.lineno;.nametable#0Atreep;.
treevec;.sourcestream#0Ascanerror;.sectionseen#0A#0A
//.Global.variables#0Acurrentfile;.storevec;.storev
p#0Asections;.stacksize;.gvecsize#0A}#0A.#0A#0ALET.
start().#3D.VALOF#0A{.LET.inputstream,.outputstream
.#3D.?,.?#0A..AND.work.#3D.?#0A..AND.fileseen,.runo
k.#3D.0,1#0A..LET.argv.#3D.VEC.100#0A..LET.version.
#3D.VEC.5#0A#0A..UNLESS.rdargs(",,,,,,,,,,,TO/A/K,S
TKSIZE/K,GLOBSIZE/K",.argv,.100).DO.{#0A....writes(
"Bad.arguments*n")#0A....RESULTIS.20#0A..}#0A#0A..o
utputstream.:#3D.findoutput(argv.!.11)#0A..IF.outpu
tstream.#3D.0.DO.{#0A....writef("Cannot.open.file.%
s*n",.argv.!.11)#0A....RESULTIS.20#0A..}#0A#0A//.de
fault.allocations.for.user.program...#0A..stacksize
.:#3D.10000#0A..IF.argv!12.DO.{#0A....stacksize.:#3D
.str2numb(argv!12)#0A....IF.stacksize.<.10000.DO.st
acksize.:#3D.10000#0A..}#0A#0A..gvecsize.:#3D.1000#0A
..IF.argv!13.DO.{#0A....gvecsize.:#3D.str2numb(argv
!13)#0A....IF.gvecsize.<.500.DO.gvecsize.:#3D.500#0A
..}#0A#0A..hdrs.:#3D.0#0A#0A..writef("MakeInit.vers
ion.%s*n",.getversion(version))#0A#0A//.Allocate.wo
rking.memory.for.scanning.the.files#0A..work.:#3D.g
etvec(worksize)#0A..UNLESS.work.DO#0A..{.writes("In
sufficient.memory*n")#0A....RESULTIS.20#0A..}#0A#0A
//.Allocate.storage.for.information.found#0A..store
vec.:#3D.getvec(storesize)#0A..UNLESS.storevec.DO.{
#0A....writes("Insufficient.memory(store)*n")#0A...
.RESULTIS.20#0A..}#0A#0A..storevp.:#3D.storevec+sto
resize#0A#0A//.Initialise.the.storage.and.add.a.uni
versal.entry#0A..sections.:#3D.0#0A..recordsection(
"BLIB",."(run-time.library)")#0A..recordsection("DL
IB",."(system.dependent.library)")#0A#0A..FOR.i.#3D
.0.TO.10.DO#0A..{#0A....//.Scan.the.input-file.for.
filenames#2E.Pass.each.name.found.to#0A....//.scanf
orsection().to.extract.any.SECTION."#2E#2E#2E".entr
ies.found,.#0A....//.which.are.stored.in.storevec,.
anchored.at.global.sections#2E#0A....LET.file.#3D.a
rgv!i#0A....UNLESS.file.LOOP#0A....fileseen.:#3D.fi
leseen.+.1#0A....scanforsection(file,.work)#0A....I
F.scanerror.>.0.DO.runok.:#3D.0#0A..}#0A#0A//.outpu
t.the.new.file#0A..IF.fileseen.&.runok.DO.{#0A....L
ET.op.#3D.output()#0A....selectoutput(outputstream)
#0A....writeinitfile()#0A....UNLESS.outputstream#3D
op.DO.endwrite()#0A....selectoutput(op)#0A..}#0A#0A
..UNLESS.fileseen.DO.writes("Error.-.no.file(s).see
n*n")#0A#0A..freevec(work)#0A..freevec(storevec)#0A
#0A..RESULTIS.fileseen.&.runok.->.0,.10.#0A}#0A#0A/
/.Extract.version-number.from.Revision.string#0AAND
.getversion(v).#3D.VALOF.{#0A..LET.version.#3D."$Re
vision:.1#2E9.$".//.updated.by.RCS#0A..AND.len,.s,.
d.#3D.0,.1,.1#0A#0A..len.:#3D.version%0#0A..UNTIL.(
'0'.<#3D.version%s.<#3D.'9').|.s.#3D.len.DO.s.:#3D.
s.+.1#0A..UNTIL.version%s.#3D.'.'.|.s.#3D.len.DO.{#0A
....v%d.:#3D.version%s#0A....s.:#3D.s.+.1;.d.:#3D.d
.+.1#0A..}#0A..v%0.:#3D.d-1#0A..RESULTIS.v#0A}#0A#0A
//.Scan.file.for.SECTION."#2E#2E#2E#2E".entries,.us
ing.workspace.for#0A//.working.memory#2E#0AAND.scan
forsection(file,.workspace).BE.{#0A..treevec.:#3D.w
orkspace#0A..treep.:#3D.treevec.+.worksize#0A#0A..s
ourcestream.:#3D.findinput(file)#0A..IF.sourcestrea
m#3D0.DO.{.#0A....writef("Trouble.with.file.%s*n",.
file)#0A....scanerror.:#3D.1#0A....RETURN#0A..}#0A#0A
..currentfile.:#3D.newstring(file)#0A..selectinput(
sourcestream)#0A..scanerror.:#3D.0#0A..sectionseen.
:#3D.0#0A..lineno.:#3D.1#0A..rch()#0A..getstreams.:
#3D.0#0A..charv......:#3D.newvec(256/bytesperword).
....#0A..nametable..:#3D.newvec(nametablesize).#0A.
.FOR.i.#3D.0.TO.nametablesize.DO.nametable!i.:#3D.0
#0A..skiptag.:#3D.0#0A..declsyswords()#0A#0A..UNTIL
.(ch#3Dendstreamch.&.getstreams#3D0).|.scanerror.DO
.{.#0A....lex()#0A....IF.token.#3D.s_section.{#0A..
....lex()#0A......IF.token.#3D.s_string.DO.{#0A....
....recordsection(charv,.currentfile)#0A........sec
tionseen.:#3D.1#0A......}#0A....}#0A..}#0A#0A..endr
ead()#0A..UNLESS.sectionseen.DO.{#0A....writef("No.
Section.seen.in.file.%s*n",.currentfile)#0A....scan
error.:#3D.1#0A..}#0A..RETURN#0A}#0A#0A//.Record.a.
section-entry.in.store,.using.a.binary-tree.structu
re,.so.that#0A//.eventual.output.is.in.ascending.al
phabetic.order.of.section.name#2E#0A//.Duplicate.se
ction-names.are.errors.and.are.reported.as.such#2E#0A
AND.recordsection(s,.f).BE.{#0A..LET.p.#3D.@section
s#0A..LET.node.#3D.!p#0A#0A..UNTIL.node#3D0.DO.{#0A
....LET.cmp.#3D.cmpstr(s,.node!bt_name)#0A....IF.cm
p.#3D.0.DO.{#0A......writef("Duplicate.section.%s.i
n.%s.and.%s*n",.s,.f,.node!bt_file)#0A......scanerr
or.:#3D.scanerror+1#0A......RETURN#0A....}#0A....#0A
....p.:#3D.node.+.(cmp.<.0.->.bt_left,.bt_right)#0A
....node.:#3D.!p#0A..}#0A#0A..node.:#3D.newstorevec
(bt_file)#0A..node!bt_name.:#3D.newstring(s)#0A..no
de!bt_left,.node!bt_right.:#3D.0,.0#0A..node!bt_fil
e.:#3D.f#0A..!p.:#3D.node#0A}#0A#0A//.Compare.two.s
trings,.ignoring.case#0AAND.cmpstr(s1,.s2).#3D.VALO
F#0A{.LET.len1,.len2.#3D.s1%0,.s2%0#0A..FOR.i.#3D.1
.TO.len1.DO#0A..{.LET.ch1,.ch2.#3D.s1%i,.s2%i#0A...
.IF.i>len2..RESULTIS.1#0A....IF.'a'<#3Dch1<#3D'z'.D
O.ch1:#3Dch1-'a'+'A'#0A....IF.'a'<#3Dch2<#3D'z'.DO.
ch2:#3Dch2-'a'+'A'#0A....IF.ch1>ch2.RESULTIS.1#0A..
..IF.ch1<ch2.RESULTIS.-1#0A..}#0A..IF.len1<len2.RES
ULTIS.-1#0A..RESULTIS.0#0A}#0A#0A//.Allocate.storag
e.for.section.and.file.names#0AAND.newstorevec(n).#3D
.VALOF.{#0A..storevp.:#3D.storevp.-.n.-.1#0A..IF.st
orevp.<#3D.storevec.DO.{#0A....writes("Out.of.store
.space*n")#0A....stop(20)#0A..}#0A#0A..RESULTIS.sto
revp#0A}#0A#0A//.Allocate.space.for.a.copy.of.strin
g.s.in.the.store#0AAND.newstring(s).#3D.VALOF.{#0A.
.LET.size.#3D.1.+.s%0./.bytesperword#0A..LET.str.#3D
.newstorevec(size)#0A..FOR.i.#3D.0.TO.s%0#0A...str%
i.:#3D.s%i#0A#0A..RESULTIS.str#0A}#0A#0A//.Write.th
e.initialisation.file,.using.the.section-names.foun
d#2E#0AAND.writeinitfile().BE.{#0A..LET.version.#3D
.VEC.5#0A..writef("/**.Initialisation.file.written.
by.MakeInit.version.%s..**/*n",#0A........getversio
n(version))#0A..writes("#23include.*"bcpl#2Eh*"*n")
#0A..writef("*nint.stackupb#3D%n;*n",.stacksize)#0A
..writef("*nint.gvecupb#3D%n;*n",..gvecsize)#0A..wr
ites("*n/**.BCPL.sections..**/*n")#0A..//.List.refe
rences.to.other.modules#0A..listsects(sections,."ex
tern.%s(BCPLWORD.**g);.*t/**.file.%s..**/*n")#0A..n
ewline()#0A..//.List.initsections().functions#0A..w
rites("void.initsections(BCPLWORD.**g).{*n")#0A..li
stsects(sections,.".......%s(g);.*t/**.file.%s..**/
*n")#0A..writes("*n.......return;*n}*n")#0A}#0A#0A/
/.List.store.entries.in.order.(binary.tree.in-order
.traverse),.using#0A//.the.passed.writef.format.for
.section-name.and.file-name#0AAND.listsects(p,.fmt)
.BE.{#0A...UNLESS.p.#3D.0.DO.{#0A.....listsects(p!b
t_left,.fmt)#0A.....writef(fmt,.p!bt_name,.p!bt_fil
e)#0A.....listsects(p!bt_right,.fmt)#0A...}#0A}#0A#0A
//.lex().returns.the.next.relevant.symbol.from.the.
current.input-stream,.in#0A//.globals.token.and.cha
rv#2E.This.routine.and.those.it.uses.have.been.extr
acted#0A//.from.the.compiler.(bcpl#2Eb).and.simplif
ied.for.this.purpose#2E#0AAND.lex().BE#0A{#0A..{.SW
ITCHON.ch.INTO#0A#0A....{.DEFAULT:#0A............{.
LET.badch.#3D.ch#0A..............ch.:#3D.'*s'#0A...
...........synerr("Illegal.character.%x2",.badch)#0A
............}#0A#0A......CASE.'*p':#0A......CASE.'*
n':.lineno.:#3D.lineno.+.1#0A#0A......CASE.'*c':#0A
......CASE.'*t':#0A......CASE.'*s':#0A.............
...rch().REPEATWHILE.ch#3D'*s'#0A................LO
OP#0A#0A......CASE.'0':CASE.'1':CASE.'2':CASE.'3':C
ASE.'4':#0A......CASE.'5':CASE.'6':CASE.'7':CASE.'8
':CASE.'9':#0A......CASE.'_':#0A................rch
();.LOOP#0A.#0A......CASE.'a':CASE.'b':CASE.'c':CAS
E.'d':CASE.'e':#0A......CASE.'f':CASE.'g':CASE.'h':
CASE.'i':CASE.'j':#0A......CASE.'k':CASE.'l':CASE.'
m':CASE.'n':CASE.'o':#0A......CASE.'p':CASE.'q':CAS
E.'r':CASE.'s':CASE.'t':#0A......CASE.'u':CASE.'v':
CASE.'w':CASE.'x':CASE.'y':#0A......CASE.'z':#0A...
...CASE.'A':CASE.'B':CASE.'C':CASE.'D':CASE.'E':#0A
......CASE.'F':CASE.'G':CASE.'H':CASE.'I':CASE.'J':
#0A......CASE.'K':CASE.'L':CASE.'M':CASE.'N':CASE.'
O':#0A......CASE.'P':CASE.'Q':CASE.'R':CASE.'S':CAS
E.'T':#0A......CASE.'U':CASE.'V':CASE.'W':CASE.'X':
CASE.'Y':#0A......CASE.'Z':#0A...............token.
:#3D.lookupword(rdtag(ch))#0A...............IF.toke
n#3Ds_get.DO.{.performget();.LOOP..}#0A............
...RETURN#0A.#0A......CASE.'$':#0A...............rc
h()#0A...............IF.ch#3D'$'.|.ch#3D'<'.|.ch#3D
'>'.DO#0A...............{.LET.k.#3D.ch#0A..........
.......token.:#3D.lookupword(rdtag('<'))#0A........
.........//.token.#3D.s_true.............if.the.tag
.is.set#0A.................//......#3D.s_false.or.s
_name..otherwise#0A.#0A.................//.$>tag...
marks.the.end.of.a.conditional#0A................./
/.........skipping.section#0A.................IF.k#3D
'>'.DO#0A.................{.IF.skiptag#3Dwordnode.D
O#0A......................skiptag.:#3D.0...//.Match
ing.$>tag.found#0A...................LOOP#0A.......
..........}#0A.#0A.................UNLESS.skiptag#3D
0.LOOP#0A#0A.................//.Only.process.$<tag.
and.$$tag.if.not.skipping#0A.#0A.................//
.$$tag..complements.the.value.of.a.tag#0A..........
.......IF.k#3D'$'.DO#0A.................{.h1!wordno
de.:#3D.token#3Ds_true.->.s_false,.s_true#0A.......
............LOOP#0A.................}#0A.#0A.......
..........//.$<tag#0A.................IF.token#3Ds_
true.LOOP......//.Don't.skip.if.set#0A#0A..........
.......//.tag.is.false.so.skip.until.matching.$>tag
.or.EOF#0A.................skiptag.:#3D.wordnode#0A
.................UNTIL.skiptag#3D0.|.token#3Ds_end.
DO.lex()#0A.................skiptag.:#3D.0#0A......
...........LOOP#0A..............}#0A.#0A...........
...UNLESS.ch#3D'('.|.ch#3D')'.DO.synerr("'$'.out.of
.context")#0A..............token.:#3D.ch#3D'('.->.s
_lsect,.s_rsect#0A..............lookupword(rdtag('$
'))#0A..............LOOP.//RETURN#0A.#0A......CASE.
'/':#0A...............rch()#0A...............IF.ch#3D
'\'.DO.{.token.:#3D.s_logand;.BREAK.}#0A...........
....IF.ch#3D'/'.DO#0A...............{.rch().REPEATU
NTIL.ch#3D'*n'.|.ch#3Dendstreamch#0A...............
..LOOP#0A...............}#0A.#0A...............IF.c
h#3D'**'.DO#0A...............{.LET.depth.#3D.1#0A#0A
.................{.rch()#0A...................IF.ch
#3D'**'.DO#0A...................{.rch().REPEATWHILE
.ch#3D'**'#0A.....................IF.ch#3D'/'.DO.{.
.depth.:#3D.depth-1;.LOOP.}#0A...................}#0A
...................IF.ch#3D'/'.DO#0A...............
....{.rch()#0A.....................IF.ch#3D'**'.DO.
{..depth.:#3D.depth+1;.LOOP.}#0A...................
}#0A...................IF.ch#3D'*n'.DO.lineno.:#3D.
lineno+1#0A...................IF.ch#3Dendstreamch.D
O.synerr("Missing.'**/'")#0A.................}.REPE
ATUNTIL.depth#3D0#0A#0A.................rch()#0A...
..............LOOP#0A...............}#0A#0A........
.......token.:#3D.s_div#0A...............LOOP#0A#0A
......CASE.'#23':#0A...............token.:#3D.s_num
ber#0A...............rch()#0A...............IF.'0'<
#3Dch<#3D'7'....DO.{........readnumber(8);..LOOP..}
#0A...............IF.ch#3D'b'.|.ch#3D'B'.DO.{.rch()
;.readnumber(2);..LOOP..}#0A...............IF.ch#3D
'o'.|.ch#3D'O'.DO.{.rch();.readnumber(8);..LOOP..}#0A
...............IF.ch#3D'x'.|.ch#3D'X'.DO.{.rch();.r
eadnumber(16);.LOOP..}#0A...............LOOP#0A.#0A
......CASE.'#2E':.token.:#3D.s_dot;.......BREAK#0A#0A
......CASE.'{':.CASE.'}':.#0A......CASE.'[':.CASE.'
(':.CASE.']':.CASE.')':.CASE.'?':.#0A......CASE.'+'
:.CASE.',':.CASE.';':.CASE.'@':.CASE.'&':.#0A......
CASE.'|':.CASE.'#3D':.CASE.'!':.CASE.'%':.CASE.'**'
:#0A......CASE.'~':.CASE.'\':.CASE.'<':.CASE.'>':..
CASE.'-':#0A......CASE.':':.#0A................rch(
)#0A................LOOP#0A#0A......CASE.'"':#0A...
...........{.LET.len.#3D.0#0A................rch()#0A
.#0A................UNTIL.ch#3D'"'.DO#0A...........
.....{.IF.len#3D255.DO.synerr("Bad.string.constant"
)#0A..................len.:#3D.len.+.1#0A..........
........charv%len.:#3D.rdstrch()#0A................
}#0A.#0A................charv%0.:#3D.len#0A........
........token.:#3D.s_string#0A................BREAK
#0A..............}#0A.#0A......CASE.'*'':#0A.......
........rch()#0A...............rdstrch()#0A........
.......token.:#3D.s_number#0A...............UNLESS.
ch#3D'*''.DO.synerr("Bad.character.constant")#0A...
............BREAK#0A.#0A.......CASE.endstreamch:#0A
..............IF.getstreams.DO#0A..............{.//
.Return.from.a.'GET'.stream#0A................LET.p
.#3D.getstreams#0A................endread()#0A.....
...........ch...........:#3D.h4!getstreams#0A......
..........lineno.......:#3D.h3!getstreams#0A.......
.........sourcestream.:#3D.h2!getstreams#0A........
........getstreams...:#3D.h1!getstreams#0A.........
.......freevec(p).//.Free.the.GET.node#0A..........
......selectinput(sourcestream)#0A................L
OOP#0A..............}#0A..............//.endstreamc
h.#3D>.EOF.only.at.outermost.GET.level.#0A.........
.....token.:#3D.s_eof#0A..............RETURN#0A....
}#0A..}.REPEAT#0A.#0A..rch()#0A}#0A#0A//.Access.and
.maintain.a.symbol-table.for.lex()#0AAND.lookupword
(word).#3D.VALOF#0A{.LET.len,.i.#3D.word%0,.0#0A..L
ET.hashval.#3D.19609.//.This.and.31397.are.primes#2E
#0A..FOR.i.#3D.0.TO.len.DO.hashval.:#3D.(hashval.NE
QV.word%i).*.31397#0A..hashval.:#3D.(hashval>>1).RE
M.nametablesize#0A#0A..wordnode.:#3D.nametable!hash
val#0A.#0A..UNTIL.wordnode#3D0.|.i>len.TEST.(@h3!wo
rdnode)%i#3Dword%i#0A...........................THE
N.i.:#3D.i+1#0A...........................ELSE.word
node,.i.:#3D.h2!wordnode,.0#0A.#0A..IF.wordnode#3D0
.DO#0A..{.wordnode.:#3D.newvec(len/bytesperword+3)#0A
....h1!wordnode,.h2!wordnode.:#3D.s_name,.nametable
!hashval#0A....FOR.i.#3D.0.TO.len.DO.(@h3!wordnode)
%i.:#3D.word%i#0A....nametable!hashval.:#3D.wordnod
e#0A..}#0A.#0A..RESULTIS.h1!wordnode#0A}#0A.#0A//.S
ymbol-table.initialisation#0AAND.dsw(word,.sym).BE.
{.lookupword(word);.h1!wordnode.:#3D.sym..}#0A.#0AA
ND.declsyswords().BE#0A{.dsw("GET",.s_get)#0A..dsw(
"NEEDS",.s_needs)#0A..dsw("SECTION",.s_section)#0A.
.dsw("$",.0)#0A}.#0A.#0A//.lex().support-routines#0A
AND.rch().BE.{#0A....ch:#3D.rdch()#0A}#0A.#0AAND.rd
tag(ch1).#3D.VALOF#0A{.LET.len.#3D.1#0A..charv%1.:#3D
.ch1#0A.#0A..{.rch()#0A....UNLESS.'a'<#3Dch<#3D'z'.
|.'A'<#3Dch<#3D'Z'.|#0A...........'0'<#3Dch<#3D'9'.
|.ch#3D'#2E'.|.ch#3D'_'.BREAK#0A....len.:#3D.len+1#0A
....charv%len.:#3D.ch#0A..}.REPEAT#0A.#0A..charv%0.
:#3D.len#0A..RESULTIS.charv#0A}#0A.#0AAND.catstr(s1
,.s2).#3D.VALOF#0A//.Concatenate.strings.s1.and.s2.
leaving.the.result.in.s1#2E#0A//.s1.is.assumed.to.b
e.able.to.hold.a.string.of.length.255#2E#0A//.The.r
esulting.string.is.truncated.to.length.255,.if.nece
ssary#2E.#0A{.LET.len.#3D.s1%0#0A..LET.n.#3D.len#0A
..FOR.i.#3D.1.TO.s2%0.DO#0A..{.n.:#3D.n+1#0A....IF.
n>255.BREAK#0A....s1%n.:#3D.s2%i#0A..}#0A..s1%0.:#3D
.n#0A}.#0A.#0AAND.performget().BE#0A{.LET.stream.#3D
.?#0A..LET.len.#3D.0#0A..lex()#0A..UNLESS.token#3Ds
_string.DO.synerr("Bad.GET.directive")#0A..len.:#3D
.charv%0#0A#0A..//.Append.#2Eh.to.the.GET.filename.
does.not.end.in.#2Eh.or.#2Eb#0A..UNLESS.len>#3D2.&.
charv%(len-1)#3D'#2E'.&.#0A.........(charv%len#3D'h
'.|.charv%len#3D'b').DO#0A..{.len.:#3D.len+2#0A....
charv%0,.charv%(len-1),.charv%len.:#3D.len,.'#2E',.
'h'#0A..}#0A#0A..FOR.i.#3D.1.TO.charv%0.IF.charv%i#3D
':'.DO.charv%i.:#3D.'/'#0A#0A..//.First.look.in.the
.current.directory#0A..//writef("Searching.for.*"%s
*".in.the.current.directory*n",.charv)#0A..stream.:
#3D.findinput(charv)#0A#0A..//.Then.try.the.headers
.directories#0A..//UNLESS.stream.DO.writef("Searchi
ng.for.*"%s*".in.%s*n",.charv,.hdrs)#0A..UNLESS.str
eam.DO.stream.:#3D.pathfindinput(charv,.hdrs)#0A#0A
..//.Finally.prepend.g/.and.lookup.in.the.system.ro
ot.directory#0A..UNLESS.stream.DO#0A..{.LET.filenam
e.#3D.VEC.256/bytesperword#0A....filename%0.:#3D.0#0A
....catstr(filename,."g/")#0A....catstr(filename,.c
harv)#0A....//writef("Searching.for.*"%s*".in.%s*n"
,.filename,.rootnode!rtn_rootvar)#0A....stream.:#3D
.pathfindinput(filename,.rootnode!rtn_rootvar)#0A..
}#0A#0A..UNLESS.stream.DO#0A..{.synerr("Unable.to.f
ind.GET.file.%s",.charv)#0A....RETURN#0A..}#0A#0A..
{.LET.len.#3D.charv%0#0A....LET.node.#3D.getvec(4.+
.len/bytesperword)#0A....LET.str.#3D.@node!4#0A#0A.
...UNLESS.node.DO.synerr("getvec.failure.in.perform
get")#0A#0A....FOR.i.#3D.0.TO.len.DO.str%i.:#3D.cha
rv%i#0A//....sourcefileno.:#3D.sourcefileno+1#0A//.
...sourcenamev!sourcefileno.:#3D.str#0A....node!0,.
node!1,.node!2,.node!3.:#3D.getstreams,.sourcestrea
m,.lineno,.ch#0A....getstreams.:#3D.node#0A..}#0A#0A
..sourcestream.:#3D.stream#0A..selectinput(sourcest
ream)#0A..lineno.:#3D.1#0A..rch()#0A}#0A.#0AAND.per
formget1().BE#0A{.LET.stream.#3D.?#0A..//LET.filena
me.#3D.VEC.50#0A..LET.len.#3D.0#0A..lex()#0A..UNLES
S.token#3Ds_string.DO.synerr("Bad.GET.directive")#0A
..len.:#3D.charv%0#0A#0A..//.Append.#2Eh.to.the.GET
.filename.does.not.end.in.#2Eh.or.#2Eb#0A..UNLESS.l
en>#3D2.&.charv%(len-1)#3D'#2E'.&.#0A.........(char
v%len#3D'h'.|.charv%len#3D'b').DO#0A..{.len.:#3D.le
n+2#0A....charv%0,.charv%(len-1),.charv%len.:#3D.le
n,.'#2E',.'h'#0A..}#0A#0A..FOR.i.#3D.1.TO.charv%0.I
F.charv%i#3D':'.DO.charv%i.:#3D.'/'#0A#0A..//.First
.look.in.the.current.directory#0A..//writef("Search
ing.for.*"%s*".in.the.current.directory*n",.charv)#0A
..stream.:#3D.findinput(charv)#0A#0A..//.Then.try.t
he.headers.directories#0A..//UNLESS.stream.DO.write
f("Searching.for.*"%s*".in.%s*n",.charv,.hdrs)#0A..
UNLESS.stream.DO.stream.:#3D.pathfindinput(charv,."
BCPLHDRS")#0A#0A..//.Finally.prepend.g/.and.lookup.
in.the.system.root.directory#0A..UNLESS.stream.DO#0A
..{.LET.filename.#3D.VEC.256/bytesperword#0A....fil
ename%0.:#3D.0#0A....catstr(filename,."g/")#0A....c
atstr(filename,.charv)#0A....//writef("Searching.fo
r.*"%s*".in.%s*n",.filename,.rootnode!rtn_rootvar)#0A
....stream.:#3D.pathfindinput(filename,."BCPLROOT")
#0A..}#0A#0A..UNLESS.stream.DO#0A..{.synerr("Unable
.to.find.GET.file.%s",.charv)#0A....RETURN#0A..}#0A
#0A..getstreams.:#3D.list4(getstreams,.sourcestream
,.lineno,.ch)#0A..sourcestream.:#3D.stream#0A..sele
ctinput(sourcestream)#0A..lineno.:#3D.1#0A..rch()#0A
}#0A.#0A//AND.performget().BE#0A//{.LET.stream.#3D.
?#0A//..lex()#0A//..UNLESS.token#3Ds_string.DO.syne
rr("Bad.GET.directive")#0A//..stream.:#3D.pathfindi
nput(charv,."BCPLPATH")#0A//..TEST.stream#3D0#0A//.
.THEN.synerr("Unable.to.find.GET.file.%s",.charv)#0A
//..ELSE.{.getstreams.:#3D.list4(getstreams,.source
stream,.lineno,.ch)#0A//.........sourcestream.:#3D.
stream#0A//.........selectinput(sourcestream)#0A//.
........lineno.:#3D.1#0A//.........rch()#0A//......
.}#0A//}#0A#0A.#0AAND.readnumber(radix).BE#0A{.LET.
d.#3D.ch#3D'_'.->.0,.value(ch)#0A..IF.d>#3Dradix.DO
.synerr("Bad.number")#0A.#0A..{.rch()#0A....IF.ch#3D
'_'.LOOP#0A....d.:#3D.value(ch)#0A....IF.d>#3Dradix
.RETURN#0A..}.REPEAT#0A}#0A.#0A.#0AAND.value(ch).#3D
.'0'<#3Dch<#3D'9'.->.ch-'0',#0A................'A'<
#3Dch<#3D'F'.->.ch-'A'+10,#0A................'a'<#3D
ch<#3D'f'.->.ch-'a'+10,#0A................100#0A.#0A
AND.rdstrch().#3D.VALOF#0A{.LET.k.#3D.ch#0A#0A..IF.
k#3D'*n'.|.k#3D'*p'.DO#0A..{.lineno.:#3D.lineno+1#0A
....synerr("Unescaped.newline.character")#0A..}#0A.
#0A..IF.k#3D'**'.DO#0A..{.rch()#0A....k.:#3D.ch#0A.
...IF.'a'<#3Dk<#3D'z'.DO.k.:#3D.k.+.'A'.-.'a'#0A...
.SWITCHON.k.INTO#0A....{.CASE.'*n':#0A......CASE.'*
p':#0A......CASE.'*s':#0A......CASE.'*t':.WHILE.ch#3D
'*n'.|.ch#3D'*p'.|.ch#3D'*s'.|.ch#3D'*t'.DO#0A.....
............{.IF.ch#3D'*n'.|.ch#3D'*p'.DO.lineno.:#3D
.lineno+1#0A...................rch()#0A............
.....}#0A.................IF.ch#3D'**'.DO.{.rch();.
LOOP..}#0A#0A......DEFAULT:...synerr("Bad.string.or
.character.constant")#0A.........#0A......CASE.'**'
:#0A......CASE.'*'':#0A......CASE.'"':.............
.......ENDCASE#0A.......#0A......CASE.'T':..k.:#3D.
c_tab;.......ENDCASE#0A......CASE.'S':..k.:#3D.c_sp
ace;.....ENDCASE#0A......CASE.'N':..k.:#3D.c_newlin
e;...ENDCASE#0A......CASE.'E':..k.:#3D.c_escape;...
.ENDCASE#0A......CASE.'B':..k.:#3D.c_backspace;.END
CASE#0A......CASE.'P':..k.:#3D.c_newpage;...ENDCASE
#0A......CASE.'C':..k.:#3D.c_return;....ENDCASE#0A.
........#0A......CASE.'X':..RESULTIS.readoctalorhex
(16,2)#0A.........#0A......CASE.'0':CASE.'1':CASE.'
2':CASE.'3':CASE.'4':#0A......CASE.'5':CASE.'6':CAS
E.'7':CASE.'8':CASE.'9':#0A.................k:#3Dva
lue(ch)*64+readoctalorhex(8,2)#0A.................I
F.k>255.DO.#0A....................synerr("Bad.strin
g.or.character.constant")#0A.................RESULT
IS.k#0A......ENDCASE#0A....}#0A..}#0A...#0A..rch()#0A
..RESULTIS.k#0A}.REPEAT#0A.#0A.#0AAND.readoctalorhe
x(radix,.digits).#3D.VALOF#0A{.LET.answer,.dig.#3D.
0,.?#0A..FOR.j.#3D.1.TO.digits.DO#0A..{.rch()#0A...
.dig.:#3D.value(ch)#0A....IF.dig.>.radix.DO.synerr(
"Bad.string.or.character.constant")#0A....answer:#3D
answer*radix.+.dig#0A..}#0A..rch()#0A..RESULTIS.ans
wer#0A}#0A#0A#0AAND.newvec(n).#3D.VALOF#0A{.treep.:
#3D.treep.-.n.-.1;#0A..IF.treep<#3Dtreevec.DO#0A...
..synerr("More.workspace.needed")#0A#0A..RESULTIS.t
reep#0A}#0A#0AAND.list4(x,.y,.z,.t).#3D.VALOF#0A{.L
ET.p.#3D.newvec(3)#0A..p!0,.p!1,.p!2,.p!3.:#3D.x,.y
,.z,.t#0A..RESULTIS.p#0A}#0A.#0AAND.synerr(mess,.a,
.b).BE.{#0A..writef("*nError.near.line.%n:..",.line
no)#0A..writef(mess,.a,.b)#0A..//writef(".in.file.%
s*n",.currentfile)#0A..newline()#0A..scanerror.:#3D
.1#0A}#0A

######cintcode/com/cmpltest.b#
SECTION."cmpltest"#0A#0A//GET."libhdr"#0A#0AGLOBAL.
$(.start:1;.sys:3.$)#0A#0A//.THIS.IS.A.UNIVERSAL.CO
DE-GENERATOR.TEST.PROGRAM#0A//.WRITTEN.BY.M#2E.RICH
ARDS.ORIGINALLY.TO.TEST.THE#0A//.CII.10070.CODE-GEN
ERATOR#2E#0A#0A//.The.version.includes.tests.for.th
e.BCPL.Cintcode.compiler#0A//.and.the.version.using
.the.compact.internal.assembly.language#0A//.ie.it.
will.test.all.patterns.generated.by.cvsial386,.for.
instance#2E#0A#0A//.The.ONLY.free.variable.of.this.
program.is:.sys..(or.wrch)#0A#0AGLOBAL.$(.f:200;.g:
401;.h:602#0A..........testno:203;.failcount:204#0A
..........v:205;.testcount:206;.quiet:207;.t:208#0A
..........bitsperword:210;.msb:211;.allones:212..$)
#0A#0ASTATIC.$(.a#3D10;.b#3D11;.c#3D12;.w#3D0..$)#0A
#0AMANIFEST.$(.k0#3D0;.k1#3D1;.k2#3D2..$)#0A#0ALET.
wrc(ch).BE.sys(11,ch)...//wrch(ch)#0A#0AAND.wrs(s).
BE#0A..FOR.i.#3D.1.TO.s%0.DO.wrc(s%i)#0A#0AAND.nl()
.BE.wrc('*n')#0A#0AAND.wrd(n,.d).BE.//wrx(n,8)#0A//
/*#0A$(.LET.t.#3D.VEC.30#0A...AND.i,.k.#3D.0,.-n#0A
...IF.n<0.DO.d,.k.:#3D.d-1,.n#0A...t!i,.i,.k.:#3D.-
(k.REM.10),.i+1,.k/10.REPEATUNTIL.k#3D0#0A...FOR.j.
#3D.i+1.TO.d.DO.wrc('*s')#0A...IF.n<0.DO.wrc('-')#0A
...FOR.j.#3D.i-1.TO.0.BY.-1.DO.wrc(t!j+'0')#0A$)#0A
//*/#0AAND.wrn(n).BE.wrd(n,.0)#0A#0AAND.wrx(n,.d).B
E#0A$(.IF.d>1.DO.wrx(n>>4,.d-1)#0A...wrc((n&15)!TAB
LE.'0','1','2','3','4','5','6','7',#0A.............
.......'8','9','A','B','C','D','E','F'.)#0A$)#0A#0A
LET.t(x,.y).#3D.VALOF#0A...$(.testcount.:#3D.testco
unt.+.1#0A......wrd(testno,.3)#0A......wrc('.')#0A.
.....wrd(x,.21)#0A......wrc('.')#0A......TEST.x#3Dy
#0A.........THEN.wrs("OK")#0A.........ELSE.$(.wrs("
FAILED,.it.should.be.")#0A.................wrd(y,.2
1)#0A.................failcount.:#3D.failcount.+.1.
.$)#0A......nl()#0A......testno.:#3D.testno.+.1#0A.
.....RESULTIS.y..$)#0A#0A#0ALET.t1(a,b,c,d,e,f,g).#3D
.t(a+b+c+d+e+f,.g)#0A#0ALET.start(parm).#3D.VALOF#0A
$(..LET.v1.#3D.VEC.200#0A....AND.v2.#3D.VEC.200#0A.
...wrs("*nCgtester.on.a.")#0A....bitsperword,.msb,.
allones.:#3D.1,.1,.1#0A....UNTIL.(msb<<1)#3D0.DO#0A
......bitsperword,.msb,.allones.:#3D.bitsperword+1,
.msb<<1,.allones<<1.|.1#0A...#0A...wrd(bitsperword,
.0)#0A...wrs(".bit.implementation.of.BCPL*n*n")#0A.
...#0A....tester(0,.1,.2,.v1,.v2)#0A#0A//{.LET.n.#3D
.1...//.special.test.for.the.<<.and.>>.operators#0A
//..FOR.i.#3D.-5.TO.80.DO.writef("%i4.%xP*n",.i,.1<
<i)#0A//..FOR.i.#3D.-5.TO.80.DO.writef("%i4.%xP*n",
.i,.msb>>i)#0A//}#0A....#0A....RESULTIS.0#0A$)#0A#0A
#0AAND.tester(x,.y,.z,.v1,.v2).BE#0A$(.LET.n0,.n1,.
n2,.n3,.n4.#3D.0,.1,.2,.3,.4#0A...LET.n5,.n6,.n7,.n
8,.n9.#3D.5,.6,.7,.8,.9#0A...LET.oct1775.#3D.#23177
5#0A#0A//..wrs("*NCgtester.entered*N")#0A#0A//..FIR
ST.INITIALIZE.CERTAIN.VARIABLES#0A#0A....f,.g,.h.:#3D
.100,.101,.102#0A....testno,.testcount,.failcount.:
#3D.0,.0,.0#0A....v,.w.:#3D.v1,.v2#0A#0A....FOR.i.#3D
.0.TO.200.DO.v!i,.w!i.:#3D.1000+i,.10000+i#0A#0A#0A
....quiet.:#3D.FALSE#0A#0A//..TEST.SIMPLE.VARIABLES
.AND.EXPRESSIONS#0A#0A....testno.:#3D.1#0A#0A....t(
a+b+c,.33)........//.1#0A....t(f+g+h,.303)#0A....t(
x+y+z,.3)#0A#0A....t(123+321-400,.44)..//.4#0A....t
(x#3D0,.TRUE)#0A....t(y#3D0,.FALSE)#0A....t(!(@y+x)
,.1)#0A....t(!(@b+x),.11)#0A....t(!(@g+x),.101)#0A#0A
....x,.a,.f.:#3D.5,.15,.105#0A....t(x,.5)..........
..//.10#0A....t(a,.15)#0A....t(f,.105)#0A#0A....v!1
,.v!2.:#3D.1234,.5678#0A....t(v!1,.1234).......//.1
3#0A....t(v!z,.5678)#0A#0A....t(x*a,.75).........//
..15#0A....t(1*x+2*y+3*z+f*4,433)#0A....t(x*a+a*x,.
150)#0A#0A....t(100/(a-a+2),.50).//..18#0A....t(a/x
,.3)#0A....t(a/-x,.-3)#0A....t((-a)/x,.-3)#0A....t(
(-a)/(-x),.3)#0A....t((a+a)/a,.2)#0A....t((a*x)/(x*
a),.1)#0A....t((a+b)*(x+y)*123/(6*123),.26)#0A#0A..
..t(n7.REM.2,.1)......//..26#0A....t(f.REM.100,.5)#0A
....t(a.REM.x,.0)#0A#0A....t(-f,.-105).......//..29
#0A#0A....f.:#3D.105#0A....t(f.#3D.105,.TRUE)...//.
30#0A....t(f~#3D.105,.FALSE)#0A....t(f.<.105,.FALSE
)#0A....t(f>#3D.105,.TRUE)#0A....t(f.>.105,.FALSE)#0A
....t(f<#3D.105,.TRUE)#0A#0A....f.:#3D.104#0A....t(
f.#3D.105,.FALSE)..//.36#0A....t(f~#3D.105,.TRUE)#0A
....t(f.<.105,.TRUE)#0A....t(f>#3D.105,.FALSE)#0A..
..t(f.>.105,.FALSE)#0A....t(f<#3D.105,.TRUE)#0A#0A.
...f.:#3D.0#0A....t(f.#3D.0,.TRUE)....//.42#0A....t
(f~#3D.0,.FALSE)#0A....t(f.<.0,.FALSE)#0A....t(f>#3D
.0,.TRUE)#0A....t(f.>.0,.FALSE)#0A....t(f<#3D.0,.TR
UE)#0A#0A....f.:#3D.1#0A....t(f.#3D.0,.FALSE)...//.
48#0A....t(f~#3D.0,.TRUE)#0A....t(f.<.0,.FALSE)#0A.
...t(f>#3D.0,.TRUE)#0A....t(f.>.0,.TRUE)#0A....t(f<
#3D.0,.FALSE)#0A#0A....testno.:#3D.60#0A#0A....t(oc
t1775<<3,.#2317750)..//.60#0A....t(oct1775>>3,.#231
77)#0A....t(oct1775<<z+1,.#2317750)#0A....t(oct1775
>>z+1,.#23177)#0A#0A..{.LET.b1100.#3D.#23b1100#0A..
..LET.b1010.#3D.#23b1010#0A....LET.yes,.no.#3D.TRUE
,.FALSE#0A#0A....testno.:#3D.70#0A#0A....t(b1100&#23
B1010,.#23B1000)....//..70#0A....t(b1100.|.#23B1010
,.#23B1110)#0A....t((b1100.EQV...#23B1010).&.#23B11
111,.#23B11001)#0A....t(b1100.NEQV..#23B1010,.#23B0
110)#0A#0A....t(NOT.yes,.no).........//.74#0A....t(
NOT.no,.yes)#0A....t(NOT(b1100.EQV.-b1010),.b1100.N
EQV.-b1010)#0A..}#0A....testno.:#3D.80#0A....f.:#3D
.105#0A....t(-f,.-105)...............//.80#0A#0A...
.t(!v,.1000)...............//.81#0A....t(v!0,.1000)
#0A....t(v!1,.1234)#0A....t(v!(!v-998),.5678)#0A#0A
....testno.:#3D.90#0A#0A....t(!w,.10000)...........
...//.90#0A....t(w!0,.10000)#0A....t(0!w,.10000)#0A
....t(1!w,.10001)#0A....t(w!1,.10001)#0A....t(!(w+2
00),.10200)#0A#0A....a.:#3D.TRUE#0A....b.:#3D.FALSE
#0A#0A....IF.a.DO.x.:#3D.16#0A....t(x,.16).........
.........//.96#0A....x.:#3D.16#0A#0A....IF.b.DO.x.:
#3D.15#0A....t(x,.16)..................//.97#0A....
x.:#3D.15#0A#0A....$(.LET.w.#3D.VEC.20#0A.......a.:
#3D.l1#0A.......GOTO.a#0A....l2:.wrs("GOTO.ERROR*N"
)#0A........failcount.:#3D.failcount+1..$)#0A#0Al1:
.a.:#3D.VALOF.RESULTIS.11#0A....t(a,.11)...........
.......//.98#0A#0A....testno.:#3D.100..//.TEST.SIMU
LATED.STACK.ROUTINES#0A#0A....$(.LET.v1.#3D.VEC.1#0A
.......v1!0,.v1!1.:#3D.-1,.-2#0A.......$(.LET.v2.#3D
.VEC.10#0A..........FOR.i.#3D.0.TO.10.DO.v2!i.:#3D.
-i#0A..........t(v2!5,.-5)..$).......//..101#0A....
...t(v1!1,.-2)..$)..........//..102#0A#0A....x.:#3D
.x.+.t(x,15,.t(f,.105),.t(a,.11)).-.15...//.103-105
#0A....t(x,.15)....................................
.//.106#0A#0A....x.:#3D.x+1#0A....t(x,.16)...//.107
#0A....x.:#3D.x-1#0A....t(x,.15)...//.108#0A....x.:
#3D.x+7#0A....t(x,22)....//.109#0A....x.:#3D.x-22#0A
....t(x,.0)....//.110#0A....x.:#3D.x+15#0A....t(x,.
15)...//.111#0A....x.:#3D.x.+.f#0A....t(x,.120)..//
.112#0A....x.:#3D.1#0A#0A....testno.:#3D.130#0A....
f.:#3D.105#0A....t(f.#3D.105.->.1,.2,.1)...//.130#0A
....t(f~#3D.105.->.1,.2,.2)#0A....t(f.<.105.->.1,.2
,.2)#0A....t(f>#3D.105.->.1,.2,.1)#0A....t(f.>.105.
->.1,.2,.2)#0A....t(f<#3D.105.->.1,.2,.1)#0A#0A....
f.:#3D.104#0A....t(f.#3D.105.->.1,.2,.2)..//.136#0A
....t(f~#3D.105.->.1,.2,.1)#0A....t(f.<.105.->.1,.2
,.1)#0A....t(f>#3D.105.->.1,.2,.2)#0A....t(f.>.105.
->.1,.2,.2)#0A....t(f<#3D.105.->.1,.2,.1)#0A#0A....
f.:#3D.0#0A....t(f.#3D.0.->.1,.2,.1)....//.142#0A..
..t(f~#3D.0.->.1,.2,.2)#0A....t(f.<.0.->.1,.2,.2)#0A
....t(f>#3D.0.->.1,.2,.1)#0A....t(f.>.0.->.1,.2,.2)
#0A....t(f<#3D.0.->.1,.2,.1)#0A#0A....f.:#3D.1#0A..
..t(f.#3D.0.->.1,.2,.2)...//.148#0A....t(f~#3D.0.->
.1,.2,.1)#0A....t(f.<.0.->.1,.2,.2)#0A....t(f>#3D.0
.->.1,.2,.1)#0A....t(f.>.0.->.1,.2,.1)#0A....t(f<#3D
.0.->.1,.2,.2)#0A#0A....testno.:#3D.200..//.TEST.SW
ITCHON.COMMANDS#0A#0A$(sw.LET.s1,.s1f.#3D.0,.0#0A..
...AND.s2,.s2f.#3D.0,.0#0A.....AND.s3,.s3f.#3D.0,.0
#0A.....FOR.i.#3D.-200.TO.200.DO#0A.....$(.LET.x.#3D
.7#0A........SWITCHON.i.INTO#0A.........$(.DEFAULT:
.s1.:#3D.s1+1000;.ENDCASE#0A............CASE.-1000:
.s1f.:#3D.s1f.+.i;.ENDCASE#0A............CASE.-200:
.s1.:#3D.s1.+.1#0A............CASE.-190:.s1.:#3D.s1
.+.1#0A............CASE.-180:.s1.:#3D.s1.+.1#0A....
........CASE...-5:.s1.:#3D.s1.+.1#0A............CAS
E....0:.s1.:#3D.s1.+.1#0A............CASE.-145:.s1.
:#3D.s1.+.1#0A............CASE....7:.s1.:#3D.s1.+.1
#0A............CASE....8:.s1.:#3D.s1.+.1#0A........
....CASE..200:.s1.:#3D.s1.+.1#0A............CASE..1
90:.s1.:#3D.s1.+.1#0A............CASE..100:.s1.:#3D
.s1.+.1#0A............CASE...90:.s1.:#3D.s1.+.1#0A.
...........CASE..199:.s1.:#3D.s1.+.1#0A............
CASE...95:.s1.:#3D.s1.+.1#0A............CASE...76:.
s1.:#3D.s1.+.1#0A............CASE...88:.s1.:#3D.s1.
+.1#0A............CASE...99:.s1.:#3D.s1.+.1#0A.....
.......CASE..-98:.s1.:#3D.s1.+.1#0A............CASE
...11:.s1.:#3D.s1.+.1#0A............CASE...12:.s1.:
#3D.s1.+.1#0A............CASE...13:.s1.:#3D.s1.+.1#0A
............CASE...41:.s1.:#3D.s1.+.1#0A...........
.CASE...91:.s1.:#3D.s1.+.1#0A............CASE...92:
.s1.:#3D.s1.+.1#0A............CASE...71:.s1.:#3D.s1
.+.1#0A............CASE...73:.s1.:#3D.s1.+.1#0A....
........CASE...74:.s1.:#3D.s1.+.1#0A............CAS
E...81:.s1.:#3D.s1.+.1#0A............CASE...82:.s1.
:#3D.s1.+.1#0A............CASE...61:.s1.:#3D.s1.+.1
#0A............CASE.-171:.s1.:#3D.s1.+.1#0A........
....CASE.-162:.s1.:#3D.s1.+.1..$)#0A#0A........SWIT
CHON.i+10000.INTO#0A.........$(.DEFAULT:.s2.:#3D.s2
+1000;.ENDCASE#0A............CASE.10020:.s2.:#3D.s2
.+.1#0A............CASE.10021:.s2.:#3D.s2.+.1#0A...
.........CASE.10022:.s2.:#3D.s2.+.1#0A............C
ASE.10023:.s2.:#3D.s2.+.1#0A............CASE.10024:
.s2.:#3D.s2.+.1#0A............CASE.10025:.s2.:#3D.s
2.+.1#0A............CASE.10026:.s2.:#3D.s2.+.1#0A..
..........CASE.10027:.s2.:#3D.s2.+.1#0A............
CASE.10028:.s2.:#3D.s2.+.1#0A............CASE.10029
:.s2.:#3D.s2.+.1#0A............CASE.10010:.s2.:#3D.
s2.+.1#0A............CASE.10011:.s2.:#3D.s2.+.1#0A.
...........CASE.10012:.s2.:#3D.s2.+.1#0A...........
.CASE.10013:.s2.:#3D.s2.+.1#0A............CASE.1001
4:.s2.:#3D.s2.+.1#0A............CASE.10015:.s2.:#3D
.s2.+.1..$)#0A#0A........SWITCHON.i*100.INTO#0A....
.....$(.DEFAULT:.s3.:#3D.s3+1000;.ENDCASE#0A.......
.....CASE.-100000:.s3f.:#3D.s3f.+.i;.ENDCASE#0A....
........CASE.-20000:.s3.:#3D.s3.+.1#0A............C
ASE.-19000:.s3.:#3D.s3.+.1#0A............CASE.-1800
0:.s3.:#3D.s3.+.1#0A............CASE...-500:.s3.:#3D
.s3.+.1#0A............CASE....000:.s3.:#3D.s3.+.1#0A
............CASE.-14500:.s3.:#3D.s3.+.1#0A.........
...CASE....700:.s3.:#3D.s3.+.1#0A............CASE..
..800:.s3.:#3D.s3.+.1#0A............CASE..20000:.s3
.:#3D.s3.+.1#0A............CASE..19000:.s3.:#3D.s3.
+.1#0A............CASE..10000:.s3.:#3D.s3.+.1#0A...
.........CASE...9000:.s3.:#3D.s3.+.1#0A............
CASE..19900:.s3.:#3D.s3.+.1#0A............CASE...95
00:.s3.:#3D.s3.+.1#0A............CASE...7600:.s3.:#3D
.s3.+.1#0A............CASE...8800:.s3.:#3D.s3.+.1#0A
............CASE...9900:.s3.:#3D.s3.+.1#0A.........
...CASE..-9800:.s3.:#3D.s3.+.1#0A............CASE..
.1100:.s3.:#3D.s3.+.1#0A............CASE...1200:.s3
.:#3D.s3.+.1#0A............CASE...1300:.s3.:#3D.s3.
+.1#0A............CASE...4100:.s3.:#3D.s3.+.1#0A...
.........CASE...9100:.s3.:#3D.s3.+.1#0A............
CASE...9200:.s3.:#3D.s3.+.1#0A............CASE...71
00:.s3.:#3D.s3.+.1#0A............CASE...7300:.s3.:#3D
.s3.+.1#0A............CASE...7400:.s3.:#3D.s3.+.1#0A
............CASE...8100:.s3.:#3D.s3.+.1#0A.........
...CASE...8200:.s3.:#3D.s3.+.1#0A............CASE..
.6100:.s3.:#3D.s3.+.1#0A............CASE.-17100:.s3
.:#3D.s3.+.1#0A............CASE.-16200:.s3.:#3D.s3.
+.1..$)#0A#0A.....$)#0A.....t(s1f,.0)..............
..........................//.200#0A.....t(s2f,.0)..
......................................//.201#0A....
.t(s3f,.0)......................................../
/.202#0A.....t(s1,.(401-32)*1000.+.32*(32+1)/2)..//
369528.....//.203#0A.....t(s2,.(401-16)*1000.+.16*(
16+1)/2)..//385136.....//.204#0A.....t(s3,.(401-32)
*1000.+.32*(32+1)/2)..//369528.....//.205#0A$)sw#0A
#0A....testno.:#3D.250..//.TEST.FUNCTION.CALLING#0A
#0A......t1(1,2,3,4,5,6,.21)#0A......t1(t(1,1),.t(2
,2),.t(3,3),.t(4,4),.t(5,5),.t(6,6),#0A.........t(2
1,21))#0A......t1(VALOF.RESULTIS.1,#0A.........VALO
F.RESULTIS.2,#0A.........VALOF.RESULTIS.3,#0A......
...VALOF.RESULTIS.4,#0A.........VALOF.RESULTIS.5,#0A
.........VALOF.RESULTIS.6,#0A.........21)#0A......t
1(VALOF.RESULTIS.1,#0A.........t(2,2),#0A.........V
ALOF.RESULTIS.3,#0A.........t(4,4),#0A.........VALO
F.RESULTIS.5,#0A.........t(6,6),#0A.........21)#0A.
....t1(.1,.t(2,2),.VALOF.RESULTIS.3,#0A.........4,.
t(5,5),.VALOF.RESULTIS.6,#0A.........21)#0A.....t1(
!v,v!0,v!200,!w,w!0,w!200,.2*1000+1200+2*10000+1020
0)#0A.....(t1+(x+x)/x-2)(1,1,1,1,1,1,6)#0A#0A.....t
estno.:#3D.300..//.TEST.EXPRESSION.OPERATORS#0A#0A.
....f.:#3D.105#0A.....t((2+3)+f+6,116)#0A.....t(f+2
+3+6,116)#0A.....t(6+3+2+f,.116)#0A.....t(f-104,.1)
#0A.....t((x+2)#3D(x+2)->99,98,.99)#0A.....t(f<f+1-
>21,22,.21)#0A.....t(f>f+1->31,32,.32)#0A.....t(f<#3D
105->41,42,.41)#0A.....t(f>#3D105->51,52,.51)#0A#0A
....testno.:#3D.400..//.TEST.REGISTER.ALLOCATION.ET
C#2E#0A#0A....x.:#3D.0#0A....y.:#3D.1#0A....z.:#3D.
2#0A....t(x,.0)#0A....t(y,.1)#0A....t(z,.2)#0A....f
,g,h.:#3D.101,102,103#0A....a,b,c.:#3D.11,12,13#0A.
...t(x+1,1)#0A....t(f+1,.102)#0A....t(a+1,.12)#0A..
..t(!(@a*2/2+f-101),11)#0A....a.:#3D.@f#0A....t(!a,
.101)#0A....b.:#3D.@g#0A....a.:#3D.@b#0A....t(!!a,.
102)#0A....w!0.:#3D.@w!1#0A....w!1.:#3D.@h#0A....t(
z*y+(w!0)!0!0-2,.103)#0A....t(z*y+w!1!0-2,.103)#0A.
...t(t(123,123),t(123,123))#0A#0A....testno.:#3D.50
0.//.test.16.and.32..bit.cintcode.operands#0A#0A...
.x.:#3D.100#0A....t(x*x,.10000)...............//.LH
#0A....t(x*x*x*x,.100000000).......//.LW#0A....t(x*
x+10000,.20000).........//.AH#0A....t(x*x+100000000
,.100010000).//.AW#0A....t(x*x-10000,.0)...........
..//.SH#0A....t(x*x-100000000,.-99990000).//.AW#0A#0A
....testno.:#3D.600#0A#0A....locals(103,104,105,106
,107,108,109,110,111,112,113,114,115,116,117)#0A#0A
#0A....testno.:#3D.700#0A#0A....a.:#3D.1#0A....b.:#3D
.msb#0A....c.:#3D..allones#0A....t(a<<0,.1)#0A....t
(a<<1,.2)#0A....t(a<<2,.4)#0A....t(a<<bitsperword-1
,.msb)#0A....t(a<<bitsperword,.....0)#0A....t(a<<bi
tsperword+1,...0)#0A#0A....t(a>>0,.1)#0A....t(b>>bi
tsperword-1,.1)#0A....t(c>>bitsperword-1,.1)#0A....
t(b>>bitsperword,...0)#0A....t(c>>bitsperword,...0)
#0A#0A....testno.:#3D.800#0A....a,.b,.c.:#3D.20,.-3
0,.0#0A....t(ABS.a,.20)#0A....t(ABS.b,.30)#0A....t(
ABS.c,.0)#0A#0A....v!0.:#3D.1001#0A....t(v!0,.1001)
#0A....v!1.:#3D.1002#0A....t(v!1,.1002)#0A....v!2.:
#3D.1003#0A....t(v!2,.1003)#0A....v!3.:#3D.1004#0A.
...t(v!3,.1004)#0A....v!4.:#3D.1005#0A....t(v!4,.10
05)#0A#0A....w!0.:#3D.2001#0A....t(w!0,.2001)#0A...
.w!1.:#3D.2002#0A....t(w!1,.2002)#0A....w!2.:#3D.20
03#0A....t(w!2,.2003)#0A....w!3.:#3D.2004#0A....t(w
!3,.2004)#0A....w!4.:#3D.2005#0A....t(w!4,.2005)#0A
#0A....w%0.:#3D.21#0A....t(w%0,.21)#0A....w%1.:#3D.
22#0A....t(w%1,.22)#0A....w%2.:#3D.23#0A....t(w%2,.
23)#0A....w%3.:#3D.3#0A....t(w%3,.3).//.compiles.xp
byt.instruction#0A#0A....a.:#3D.10#0A....b.:#3D.a<<
5#0A....w%4.:#3D.a..//.compiles.a.btc.instruction#0A
....t(w%4,.10)#0A#0A....a,.b,.g.:#3D.100,101,300#0A
....a.:#3D.a+1#0A....t(a,.101)#0A....a.:#3D.a+b#0A.
...t(a,.202)#0A....g.:#3D.g+b#0A....t(g,.401)#0A#0A
....g.:#3D.8#0A....b.:#3D.3#0A....a.:#3D.g.REM.b#0A
....t(a,.2)#0A#0A....g.:#3D.20#0A....b.:#3D.12#0A..
..a.:#3D.g.-.b#0A....t(a,.8)#0A#0A....testno.:#3D.8
50#0A#0A....//.Test.Unicode.character.and.string.es
capes#0A....//.assuming.the.compiler.has.UTF8.as.th
e.default.encoding#2E#0A....t('*#231234',.#23x1234)
#0A....t("*#231234"%0,.3)................//.0001.00
10.0011.0100#0A....t("*#231234"%1,.#23b1110_0001)..
....//.0001#0A....t("*#231234"%2,.#23b10_001000)...
...//......0010.00#0A....t("*#231234"%3,.#23b10_110
100)......//.............11.0100#0A#0A....t('*#23#23
1234_5678',.#23x1234_5678)#0A....t("*#23#231234_567
8"%0,.6)..........//.0001.0010.0011.0100.0101.0110.
0111.1000#0A....t("*#23#231234_5678"%1,.#23b1111110
_0)//..0#0A....t("*#23#231234_5678"%2,.#23b10_01001
0)//...01.0010#0A....t("*#23#231234_5678"%3,.#23b10
_001101)//...........0011.01#0A....t("*#23#231234_5
678"%4,.#23b10_000101)//..................00.0101#0A
....t("*#23#231234_5678"%5,.#23b10_011001)//.......
...................0110.01#0A....t("*#23#231234_567
8"%6,.#23b10_111000)//.............................
....11.1000#0A#0A....//.Test.GB2312.character.and.s
tring.escapes#0A....//.assuming.the.compiler.has.UT
F8.as.the.default.encoding#2E#0A....t('*#23g*#23456
6',.4566)#0A....t("*#23g*#234566"%0,.2).....//.row.
45..col.66..#3D.character.'foreign'#0A....t("*#23g*
#234566"%1,.#23xE2)..//.#23xE2.#3D.66.+.160#0A....t
("*#23g*#234566"%2,.#23xCD)..//.#23xCD.#3D.45.+.160
#0A#0A....nl()#0A....wrn(testcount)#0A....wrs(".TES
TS.COMPLETED,.")#0A....wrn(failcount)#0A....wrs(".F
AILURE(S)*N")#0A$)#0A#0A#0A#0AAND.locals(p3,p4,p5,p
6,p7,p8,p9,p10,p11,p12,p13,p14,p15,p16,p17).BE#0A$(
.t(p3,.103)#0A...t(p4,.104)#0A...t(p5,.105)#0A...t(
p6,.106)#0A...t(p7,.107)#0A...t(p8,.108)#0A...t(p9,
.109)#0A...t(p10,110)#0A...t(p11,111)#0A...t(p12,11
2)#0A...t(p13,113)#0A...t(p14,114)#0A...t(p15,115)#0A
...t(p16,116)#0A...t(p17,117)#0A#0A$)#0A

######+#
